pkgoptions.pp 22 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690
  1. {
  2. This file is part of the Free Pascal Utilities
  3. Copyright (c) 1999-2000 by the Free Pascal development team
  4. See the file COPYING.FPC, included in this distribution,
  5. for details about the copyright.
  6. This program is distributed in the hope that it will be useful,
  7. but WITHOUT ANY WARRANTY; without even the implied warranty of
  8. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  9. **********************************************************************}
  10. {$mode objfpc}
  11. {$h+}
  12. unit pkgoptions;
  13. interface
  14. uses Classes, Sysutils, Inifiles, fprepos, fpTemplate;
  15. Const
  16. UnitConfigFileName = 'fpunits.conf';
  17. ManifestFileName = 'manifest.xml';
  18. MirrorsFileName = 'mirrors.xml';
  19. PackagesFileName = 'packages.xml';
  20. VersionsFileName = 'versions-%s.dat';
  21. CurrentConfigVersion = 4;
  22. Type
  23. { TGlobalOptions }
  24. TGlobalOptions = Class(TPersistent)
  25. private
  26. FSaveInifileChanges : Boolean;
  27. FConfigVersion : Integer;
  28. FRemoteMirrorsURL,
  29. FRemoteRepository,
  30. FLocalRepository,
  31. FCompilerConfigDir,
  32. FArchivesDir,
  33. FBuildDir,
  34. FDownloader,
  35. FDefaultCompilerConfig,
  36. FFPMakeCompilerConfig : String;
  37. // Parameter options
  38. FCompilerConfig : String;
  39. FAllowBroken,
  40. FInstallGlobal,
  41. FRecoveryMode : Boolean;
  42. FOptionParser: TTemplateParser;
  43. FShowLocation: Boolean;
  44. FSkipConfigurationFiles: boolean;
  45. FSkipFixBrokenAfterInstall: boolean;
  46. function GetOptString(Index: integer): String;
  47. procedure SetOptString(Index: integer; const AValue: String);
  48. procedure UpdateLocalRepositoryOption;
  49. Public
  50. Constructor Create;
  51. destructor Destroy; override;
  52. Procedure InitGlobalDefaults;
  53. Procedure LoadGlobalFromFile(const AFileName : String);
  54. Procedure SaveGlobalToFile(const AFileName : String);
  55. procedure LogValues;
  56. // Is set when the inifile has an old version number (which is also the case when a new file is generated)
  57. Property SaveInifileChanges : Boolean Read FSaveInifileChanges;
  58. Property ConfigVersion : Integer read FConfigVersion;
  59. function LocalPackagesFile:string;
  60. function LocalMirrorsFile:string;
  61. function LocalVersionsFile(const ACompilerConfig:String):string;
  62. Published
  63. Property RemoteMirrorsURL : String Index 0 Read GetOptString Write SetOptString;
  64. // 1 is unused
  65. Property RemoteRepository : String Index 2 Read GetOptString Write SetOptString;
  66. Property LocalRepository : String Index 3 Read GetOptString Write SetOptString;
  67. Property BuildDir : String Index 4 Read GetOptString Write SetOptString;
  68. Property ArchivesDir : String Index 5 Read GetOptString Write SetOptString;
  69. Property CompilerConfigDir : String Index 6 Read GetOptString Write SetOptString;
  70. Property DefaultCompilerConfig : String Index 8 Read GetOptString Write SetOptString;
  71. Property FPMakeCompilerConfig : String Index 9 Read GetOptString Write SetOptString;
  72. Property Downloader: String Index 10 Read GetOptString Write SetOptString;
  73. // Parameters
  74. Property CompilerConfig : String Read FCompilerConfig Write FCompilerConfig;
  75. Property InstallGlobal : Boolean Read FInstallGlobal Write FInstallGlobal;
  76. Property RecoveryMode : Boolean Read FRecoveryMode Write FRecoveryMode;
  77. Property AllowBroken : Boolean Read FAllowBroken Write FAllowBroken;
  78. Property ShowLocation : Boolean Read FShowLocation Write FShowLocation;
  79. Property SkipConfigurationFiles: boolean read FSkipConfigurationFiles write FSkipConfigurationFiles;
  80. Property SkipFixBrokenAfterInstall: boolean read FSkipFixBrokenAfterInstall write FSkipFixBrokenAfterInstall;
  81. end;
  82. { TCompilerOptions }
  83. TCompilerOptions = Class(TPersistent)
  84. private
  85. FSaveInifileChanges: Boolean;
  86. FConfigVersion : Integer;
  87. FCompiler,
  88. FCompilerVersion,
  89. FLocalInstallDir,
  90. FGlobalInstallDir,
  91. FLocalPrefix,
  92. FGlobalPrefix: String;
  93. FCompilerCPU: TCPU;
  94. FCompilerOS: TOS;
  95. FOptionParser: TTemplateParser;
  96. FOptions: TStrings;
  97. function GetOptions: TStrings;
  98. function GetOptString(Index: integer): String;
  99. procedure SetOptString(Index: integer; const AValue: String);
  100. procedure SetCompilerCPU(const AValue: TCPU);
  101. procedure SetCompilerOS(const AValue: TOS);
  102. Public
  103. Constructor Create;
  104. Destructor Destroy; override;
  105. Procedure InitCompilerDefaults;
  106. Procedure LoadCompilerFromFile(const AFileName : String);
  107. Procedure SaveCompilerToFile(const AFileName : String);
  108. procedure LogValues(const ACfgName:string);
  109. procedure UpdateLocalRepositoryOption;
  110. procedure CheckCompilerValues;
  111. Function LocalUnitDir:string;
  112. Function GlobalUnitDir:string;
  113. Function HasOptions: boolean;
  114. // Is set when the inifile has an old version number (which is also the case when a new file is generated)
  115. Property SaveInifileChanges : Boolean Read FSaveInifileChanges;
  116. Property ConfigVersion : Integer read FConfigVersion;
  117. Published
  118. Property Compiler : String Index 1 Read GetOptString Write SetOptString;
  119. Property CompilerTarget : String Index 2 Read GetOptString Write SetOptString;
  120. Property CompilerVersion : String Index 3 Read GetOptString Write SetOptString;
  121. Property GlobalInstallDir : String Index 4 Read GetOptString Write SetOptString;
  122. Property LocalInstallDir : String Index 5 Read GetOptString Write SetOptString;
  123. Property GlobalPrefix : String Index 6 Read GetOptString Write SetOptString;
  124. Property LocalPrefix : String Index 7 Read GetOptString Write SetOptString;
  125. Property Options : TStrings read GetOptions;
  126. Property CompilerOS : TOS Read FCompilerOS Write SetCompilerOS;
  127. Property CompilerCPU : TCPU Read FCompilerCPU Write SetCompilerCPU;
  128. end;
  129. var
  130. GlobalOptions : TGlobalOptions;
  131. CompilerOptions : TCompilerOptions;
  132. FPMakeCompilerOptions : TCompilerOptions;
  133. Implementation
  134. uses
  135. pkgglobals,
  136. pkgmessages;
  137. Const
  138. DefaultMirrorsURL = 'http://www.freepascal.org/repository/'+MirrorsFileName;
  139. {$ifdef localrepository}
  140. DefaultRemoteRepository = 'file://'+{$I %HOME%}+'/repository/';
  141. {$else}
  142. DefaultRemoteRepository = 'auto';
  143. {$endif}
  144. // ini file keys
  145. SDefaults = 'Defaults';
  146. // All configs
  147. KeyConfigVersion = 'ConfigVersion';
  148. // Global config
  149. KeyRemoteMirrorsURL = 'RemoteMirrors';
  150. KeyRemoteRepository = 'RemoteRepository';
  151. KeyLocalRepository = 'LocalRepository';
  152. KeyArchivesDir = 'ArchivesDir';
  153. KeyBuildDir = 'BuildDir';
  154. KeyCompilerConfigDir = 'CompilerConfigDir';
  155. KeyCompilerConfig = 'CompilerConfig';
  156. KeyFPMakeCompilerConfig = 'FPMakeCompilerConfig';
  157. KeyDownloader = 'Downloader';
  158. // Compiler dependent config
  159. KeyGlobalPrefix = 'GlobalPrefix';
  160. KeyLocalPrefix = 'LocalPrefix';
  161. KeyGlobalInstallDir = 'GlobalInstallDir';
  162. KeyLocalInstallDir = 'LocalInstallDir';
  163. KeyCompiler = 'Compiler' ;
  164. KeyCompilerOS = 'OS';
  165. KeyCompilerCPU = 'CPU';
  166. KeyCompilerVersion = 'Version';
  167. {*****************************************************************************
  168. TGlobalOptions
  169. *****************************************************************************}
  170. constructor TGlobalOptions.Create;
  171. begin
  172. FOptionParser := TTemplateParser.Create;
  173. FOptionParser.Values['AppConfigDir'] := GetAppConfigDir(false);
  174. FOptionParser.Values['UserDir'] := GetUserDir;
  175. InitGlobalDefaults;
  176. end;
  177. destructor TGlobalOptions.Destroy;
  178. begin
  179. FOptionParser.Free;
  180. inherited Destroy;
  181. end;
  182. function TGlobalOptions.GetOptString(Index: integer): String;
  183. begin
  184. Case Index of
  185. 0 : Result:=FRemoteMirrorsURL;
  186. 2 : Result:=FRemoteRepository;
  187. 3 : Result:=FOptionParser.ParseString(FLocalRepository);
  188. 4 : Result:=FOptionParser.ParseString(FBuildDir);
  189. 5 : Result:=FOptionParser.ParseString(FArchivesDir);
  190. 6 : Result:=FOptionParser.ParseString(FCompilerConfigDir);
  191. 8 : Result:=FDefaultCompilerConfig;
  192. 9 : Result:=FFPMakeCompilerConfig;
  193. 10 : Result:=FDownloader;
  194. else
  195. Error('Unknown option');
  196. end;
  197. end;
  198. procedure TGlobalOptions.SetOptString(Index: integer; const AValue: String);
  199. begin
  200. If AValue=GetOptString(Index) then
  201. Exit;
  202. Case Index of
  203. 1 : FRemoteMirrorsURL:=AValue;
  204. 2 : FRemoteRepository:=AValue;
  205. 3 : begin
  206. FLocalRepository:=AValue;
  207. UpdateLocalRepositoryOption;
  208. end;
  209. 4 : FBuildDir:=FixPath(AValue);
  210. 5 : FArchivesDir:=FixPath(AValue);
  211. 6 : FCompilerConfigDir:=FixPath(AValue);
  212. 8 : FDefaultCompilerConfig:=AValue;
  213. 9 : FFPMakeCompilerConfig:=AValue;
  214. 10 : FDownloader:=AValue;
  215. else
  216. Error('Unknown option');
  217. end;
  218. end;
  219. procedure TGlobalOptions.UpdateLocalRepositoryOption;
  220. begin
  221. FOptionParser.Values['LocalRepository'] := LocalRepository;
  222. end;
  223. function TGlobalOptions.LocalPackagesFile:string;
  224. begin
  225. Result:=LocalRepository+PackagesFileName;
  226. end;
  227. function TGlobalOptions.LocalMirrorsFile:string;
  228. begin
  229. Result:=LocalRepository+MirrorsFileName;
  230. end;
  231. function TGlobalOptions.LocalVersionsFile(const ACompilerConfig:String):string;
  232. begin
  233. Result:=LocalRepository+Format(VersionsFileName,[ACompilerConfig]);
  234. end;
  235. Procedure TGlobalOptions.InitGlobalDefaults;
  236. begin
  237. FConfigVersion:=CurrentConfigVersion;
  238. // Retrieve Local fppkg directory
  239. {$ifdef unix}
  240. if IsSuperUser then
  241. begin
  242. if DirectoryExists('/usr/local/lib/fpc') then
  243. FLocalRepository:='/usr/local/lib/fpc/fppkg/'
  244. else
  245. FLocalRepository:='/usr/lib/fpc/fppkg/';
  246. end
  247. else
  248. FLocalRepository:='{UserDir}.fppkg/';
  249. {$else}
  250. FLocalRepository:=IncludeTrailingPathDelimiter(GetAppConfigDir(IsSuperUser));
  251. {$endif}
  252. UpdateLocalRepositoryOption;
  253. // Directories
  254. FBuildDir:='{LocalRepository}build'+PathDelim;
  255. FArchivesDir:='{LocalRepository}archives'+PathDelim;
  256. FCompilerConfigDir:='{LocalRepository}config'+PathDelim;
  257. // Remote
  258. FRemoteMirrorsURL:=DefaultMirrorsURL;
  259. FRemoteRepository:=DefaultRemoteRepository;
  260. // Other config
  261. FDefaultCompilerConfig:='default';
  262. FFPMakeCompilerConfig:='default';
  263. // Downloader
  264. {$if defined(unix) or defined(windows)}
  265. FDownloader:='lnet';
  266. {$else}
  267. FDownloader:='base';
  268. {$endif}
  269. // Parameter defaults
  270. FCompilerConfig:=FDefaultCompilerConfig;
  271. FInstallGlobal:=False;
  272. FRecoveryMode:=False;
  273. FAllowBroken:=False;
  274. end;
  275. procedure TGlobalOptions.LoadGlobalFromFile(const AFileName: String);
  276. Var
  277. Ini : TMemIniFile;
  278. begin
  279. try
  280. Ini:=TMemIniFile.Create(AFileName);
  281. With Ini do
  282. begin
  283. FConfigVersion:=ReadInteger(SDefaults,KeyConfigVersion,0);
  284. if (FConfigVersion<>CurrentConfigVersion) then
  285. begin
  286. Log(vlDebug,SLogUpgradingConfig,[AFileName]);
  287. FSaveInifileChanges:=true;
  288. if FConfigVersion<1 then
  289. begin
  290. FRemoteRepository:='auto';
  291. end;
  292. if FConfigVersion<3 then
  293. begin
  294. // Directories
  295. FBuildDir:=FLocalRepository+'build'+PathDelim;
  296. FArchivesDir:=FLocalRepository+'archives'+PathDelim;
  297. FCompilerConfigDir:=FLocalRepository+'config'+PathDelim;
  298. end;
  299. if (FConfigVersion>CurrentConfigVersion) then
  300. Error(SErrUnsupportedConfigVersion,[AFileName]);
  301. end;
  302. FRemoteMirrorsURL:=ReadString(SDefaults,KeyRemoteMirrorsURL,FRemoteMirrorsURL);
  303. FRemoteRepository:=ReadString(SDefaults,KeyRemoteRepository,FRemoteRepository);
  304. FLocalRepository:=ReadString(SDefaults,KeyLocalRepository,FLocalRepository);
  305. UpdateLocalRepositoryOption;
  306. FBuildDir:=FixPath(ReadString(SDefaults,KeyBuildDir,FBuildDir));
  307. FArchivesDir:=FixPath(ReadString(SDefaults,KeyArchivesDir,FArchivesDir));
  308. FCompilerConfigDir:=FixPath(ReadString(SDefaults,KeyCompilerConfigDir,FCompilerConfigDir));
  309. FDefaultCompilerConfig:=ReadString(SDefaults,KeyCompilerConfig,FDefaultCompilerConfig);
  310. FFPMakeCompilerConfig:=ReadString(SDefaults,KeyFPMakeCompilerConfig,FFPMakeCompilerConfig);
  311. FDownloader:=ReadString(SDefaults,KeyDownloader,FDownloader);
  312. end;
  313. finally
  314. Ini.Free;
  315. end;
  316. end;
  317. procedure TGlobalOptions.SaveGlobalToFile(const AFileName: String);
  318. Var
  319. Ini : TIniFile;
  320. begin
  321. if FileExists(AFileName) then
  322. BackupFile(AFileName);
  323. try
  324. Ini:=TIniFile.Create(AFileName);
  325. With Ini do
  326. begin
  327. WriteInteger(SDefaults,KeyConfigVersion,CurrentConfigVersion);
  328. WriteString(SDefaults,KeyLocalRepository,FLocalRepository);
  329. WriteString(SDefaults,KeyBuildDir,FBuildDir);
  330. WriteString(SDefaults,KeyArchivesDir,FArchivesDir);
  331. WriteString(SDefaults,KeyCompilerConfigDir,FCompilerConfigDir);
  332. WriteString(SDefaults,KeyRemoteMirrorsURL,FRemoteMirrorsURL);
  333. WriteString(SDefaults,KeyRemoteRepository,FRemoteRepository);
  334. WriteString(SDefaults,KeyCompilerConfig,FDefaultCompilerConfig);
  335. WriteString(SDefaults,KeyFPMakeCompilerConfig,FFPMakeCompilerConfig);
  336. WriteString(SDefaults,KeyDownloader,FDownloader);
  337. FSaveInifileChanges:=False;
  338. end;
  339. Ini.UpdateFile;
  340. finally
  341. Ini.Free;
  342. end;
  343. end;
  344. procedure TGlobalOptions.LogValues;
  345. begin
  346. Log(vlDebug,SLogGlobalCfgHeader);
  347. Log(vlDebug,SLogGlobalCfgRemoteMirrorsURL,[FRemoteMirrorsURL]);
  348. Log(vlDebug,SLogGlobalCfgRemoteRepository,[FRemoteRepository]);
  349. Log(vlDebug,SLogGlobalCfgLocalRepository,[LocalRepository]);
  350. Log(vlDebug,SLogGlobalCfgBuildDir,[BuildDir]);
  351. Log(vlDebug,SLogGlobalCfgArchivesDir,[ArchivesDir]);
  352. Log(vlDebug,SLogGlobalCfgCompilerConfigDir,[CompilerConfigDir]);
  353. Log(vlDebug,SLogGlobalCfgDefaultCompilerConfig,[FDefaultCompilerConfig]);
  354. Log(vlDebug,SLogGlobalCfgFPMakeCompilerConfig,[FFPMakeCompilerConfig]);
  355. Log(vlDebug,SLogGlobalCfgDownloader,[FDownloader]);
  356. end;
  357. {*****************************************************************************
  358. TCompilerOptions
  359. *****************************************************************************}
  360. constructor TCompilerOptions.Create;
  361. begin
  362. FOptionParser := TTemplateParser.Create;
  363. FOptionParser.Values['AppConfigDir'] := GetAppConfigDir(false);
  364. FOptionParser.Values['UserDir'] := GetUserDir;
  365. end;
  366. destructor TCompilerOptions.Destroy;
  367. begin
  368. FOptionParser.Free;
  369. if assigned(FOptions) then
  370. FreeAndNil(FOptions);
  371. inherited Destroy;
  372. end;
  373. function TCompilerOptions.GetOptString(Index: integer): String;
  374. begin
  375. Case Index of
  376. 1 : Result:=FCompiler;
  377. 2 : Result:=MakeTargetString(CompilerCPU,CompilerOS);
  378. 3 : Result:=FCompilerVersion;
  379. 4 : Result:=FOptionParser.ParseString(FGlobalInstallDir);
  380. 5 : Result:=FOptionParser.ParseString(FLocalInstallDir);
  381. 6 : Result:=FixPath(FOptionParser.ParseString(FGlobalPrefix));
  382. 7 : Result:=FixPath(FOptionParser.ParseString(FLocalPrefix));
  383. else
  384. Error('Unknown option');
  385. end;
  386. end;
  387. function TCompilerOptions.GetOptions: TStrings;
  388. begin
  389. if not assigned(FOptions) then
  390. begin
  391. FOptions := TStringList.Create;
  392. FOptions.Delimiter:=' ';
  393. end;
  394. Result := FOptions;
  395. end;
  396. procedure TCompilerOptions.SetOptString(Index: integer; const AValue: String);
  397. begin
  398. If AValue=GetOptString(Index) then
  399. Exit;
  400. Case Index of
  401. 1 : FCompiler:=AValue;
  402. 2 : StringToCPUOS(AValue,FCompilerCPU,FCompilerOS);
  403. 3 : FCompilerVersion:=AValue;
  404. 4 : FGlobalInstallDir:=FixPath(AValue);
  405. 5 : FLocalInstallDir:=FixPath(AValue);
  406. 6 : begin
  407. FGlobalPrefix:=AValue;
  408. FOptionParser.Values['GlobalPrefix'] := GlobalPrefix;
  409. end;
  410. 7 : begin
  411. FLocalPrefix:=AValue;
  412. FOptionParser.Values['LocalPrefix'] := LocalPrefix;
  413. end
  414. else
  415. Error('Unknown option');
  416. end;
  417. end;
  418. procedure TCompilerOptions.SetCompilerCPU(const AValue: TCPU);
  419. begin
  420. if FCompilerCPU=AValue then
  421. exit;
  422. FCompilerCPU:=AValue;
  423. end;
  424. procedure TCompilerOptions.UpdateLocalRepositoryOption;
  425. begin
  426. FOptionParser.Values['LocalRepository'] := GlobalOptions.LocalRepository;
  427. end;
  428. procedure TCompilerOptions.CheckCompilerValues;
  429. var
  430. AVersion : string;
  431. ACpu : TCpu;
  432. AOs : TOS;
  433. begin
  434. if Compiler='' then
  435. Exit;
  436. if (CompilerCPU=cpuNone) or
  437. (CompilerOS=osNone) or
  438. (CompilerVersion='') then
  439. begin
  440. GetCompilerInfo(Compiler,'-iVTPTO',AVersion,ACpu,AOs);
  441. if CompilerCPU=cpuNone then
  442. CompilerCPU := ACpu;
  443. if CompilerOS=osNone then
  444. CompilerOS:=AOs;
  445. if CompilerVersion='' then
  446. CompilerVersion:=AVersion;
  447. end;
  448. end;
  449. procedure TCompilerOptions.SetCompilerOS(const AValue: TOS);
  450. begin
  451. if FCompilerOS=AValue then
  452. exit;
  453. FCompilerOS:=AValue;
  454. end;
  455. function TCompilerOptions.LocalUnitDir:string;
  456. var ALocalInstallDir: string;
  457. begin
  458. if LocalInstallDir<>'' then
  459. ALocalInstallDir:=LocalInstallDir
  460. else if LocalPrefix<>'' then
  461. {$ifdef unix}
  462. ALocalInstallDir:=LocalPrefix+'lib'+PathDelim+'fpc'+PathDelim+FCompilerVersion+PathDelim;
  463. {$else unix}
  464. ALocalInstallDir:=LocalPrefix;
  465. {$endif}
  466. if ALocalInstallDir<>'' then
  467. result:=ALocalInstallDir+'units'+PathDelim+CompilerTarget+PathDelim
  468. else
  469. result:='';
  470. end;
  471. function TCompilerOptions.GlobalUnitDir:string;
  472. var AGlobalInstallDir: string;
  473. begin
  474. if GlobalInstallDir<>'' then
  475. AGlobalInstallDir:=GlobalInstallDir
  476. else if GlobalPrefix<>'' then
  477. {$ifdef unix}
  478. AGlobalInstallDir:=GlobalPrefix+'lib'+PathDelim+'fpc'+PathDelim+FCompilerVersion+PathDelim;
  479. {$else unix}
  480. AGlobalInstallDir:=GlobalPrefix;
  481. {$endif}
  482. if AGlobalInstallDir<>'' then
  483. result:=AGlobalInstallDir+'units'+PathDelim+CompilerTarget+PathDelim
  484. else
  485. result:='';
  486. end;
  487. function TCompilerOptions.HasOptions: boolean;
  488. begin
  489. result := assigned(FOptions);
  490. end;
  491. procedure TCompilerOptions.InitCompilerDefaults;
  492. begin
  493. FConfigVersion:=CurrentConfigVersion;
  494. if fcompiler = '' then
  495. FCompiler:=ExeSearch('fpc'+ExeExt,GetEnvironmentVariable('PATH'));
  496. if FCompiler='' then
  497. Raise EPackagerError.Create(SErrMissingFPC);
  498. // Detect compiler version/target from -i option
  499. GetCompilerInfo(FCompiler,'-iVTPTO',FCompilerVersion,FCompilerCPU,FCompilerOS);
  500. // Temporary hack to workaround bug in fpc.exe that doesn't support spaces
  501. // We retrieve the real binary
  502. if FCompilerVersion='2.2.0' then
  503. FCompiler:=GetCompilerInfo(FCompiler,'-PB');
  504. Log(vlDebug,SLogDetectedCompiler,[FCompiler,FCompilerVersion,MakeTargetString(FCompilerCPU,FCompilerOS)]);
  505. // Use the same algorithm as the compiler, see options.pas
  506. // Except that the prefix is extracted and GlobalInstallDir is set using
  507. // that prefix
  508. {$ifdef Unix}
  509. FGlobalPrefix:='/usr/local/';
  510. if not DirectoryExists(FGlobalPrefix+'lib/fpc/'+FCompilerVersion+'/') and
  511. DirectoryExists('/usr/lib/fpc/'+FCompilerVersion+'/') then
  512. FGlobalPrefix:='/usr/';
  513. {$else unix}
  514. FGlobalPrefix:=ExtractFilePath(FCompiler)+'..'+PathDelim;
  515. if not(DirectoryExists(FGlobalPrefix+PathDelim+'units')) and
  516. not(DirectoryExists(FGlobalPrefix+PathDelim+'rtl')) then
  517. FGlobalPrefix:=FGlobalPrefix+'..'+PathDelim;
  518. FGlobalPrefix:=ExpandFileName(FGlobalInstallDir);
  519. {$endif unix}
  520. Log(vlDebug,SLogDetectedPrefix,['global',FGlobalPrefix]);
  521. // User writable install directory
  522. if not IsSuperUser then
  523. begin
  524. FLocalPrefix:= '{LocalRepository}';
  525. Log(vlDebug,SLogDetectedPrefix,['local',FLocalPrefix]);
  526. end;
  527. FGlobalInstallDir:=FixPath(GetEnvironmentVariable('FPCDIR'));
  528. {$ifndef Unix}
  529. FGlobalInstallDir:=ExpandFileName(FGlobalInstallDir);
  530. {$endif unix}
  531. if FGlobalInstallDir<>'' then
  532. Log(vlDebug,SLogFPCDirEnv,[FGlobalInstallDir]);
  533. end;
  534. procedure TCompilerOptions.LoadCompilerFromFile(const AFileName: String);
  535. Var
  536. Ini : TMemIniFile;
  537. begin
  538. try
  539. Ini:=TMemIniFile.Create(AFileName);
  540. With Ini do
  541. begin
  542. FConfigVersion:=ReadInteger(SDefaults,KeyConfigVersion,0);
  543. if (FConfigVersion<>CurrentConfigVersion) then
  544. begin
  545. Log(vlDebug,SLogUpgradingConfig,[AFileName]);
  546. FSaveInifileChanges:=true;
  547. if (FConfigVersion>CurrentConfigVersion) then
  548. Error(SErrUnsupportedConfigVersion,[AFileName]);
  549. end;
  550. GlobalPrefix:=ReadString(SDefaults,KeyGlobalPrefix,FGlobalPrefix);
  551. LocalPrefix:=ReadString(SDefaults,KeyLocalPrefix,FLocalPrefix);
  552. FGlobalInstallDir:=FixPath(ReadString(SDefaults,KeyGlobalInstallDir,FGlobalInstallDir));
  553. FLocalInstallDir:=FixPath(ReadString(SDefaults,KeyLocalInstallDir,FLocalInstallDir));
  554. FCompiler:=ReadString(SDefaults,KeyCompiler,FCompiler);
  555. FCompilerOS:=StringToOS(ReadString(SDefaults,KeyCompilerOS,OSToString(CompilerOS)));
  556. FCompilerCPU:=StringToCPU(ReadString(SDefaults,KeyCompilerCPU,CPUtoString(CompilerCPU)));
  557. FCompilerVersion:=ReadString(SDefaults,KeyCompilerVersion,FCompilerVersion);
  558. end;
  559. finally
  560. Ini.Free;
  561. end;
  562. end;
  563. procedure TCompilerOptions.SaveCompilerToFile(const AFileName: String);
  564. Var
  565. Ini : TIniFile;
  566. begin
  567. if FileExists(AFileName) then
  568. BackupFile(AFileName);
  569. try
  570. Ini:=TIniFile.Create(AFileName);
  571. With Ini do
  572. begin
  573. WriteInteger(SDefaults,KeyConfigVersion,CurrentConfigVersion);
  574. WriteString(SDefaults,KeyGlobalPrefix,FGlobalPrefix);
  575. WriteString(SDefaults,KeyLocalPrefix,FLocalPrefix);
  576. WriteString(SDefaults,KeyGlobalInstallDir,FGlobalInstallDir);
  577. WriteString(SDefaults,KeyLocalInstallDir,FLocalInstallDir);
  578. WriteString(SDefaults,KeyCompiler,FCompiler);
  579. WriteString(SDefaults,KeyCompilerOS,OSToString(CompilerOS));
  580. WriteString(SDefaults,KeyCompilerCPU,CPUtoString(CompilerCPU));
  581. WriteString(SDefaults,KeyCompilerVersion,FCompilerVersion);
  582. FSaveInifileChanges:=False;
  583. end;
  584. Ini.UpdateFile;
  585. finally
  586. Ini.Free;
  587. end;
  588. end;
  589. procedure TCompilerOptions.LogValues(const ACfgName:string);
  590. begin
  591. Log(vlDebug,SLogCompilerCfgHeader,[ACfgName]);
  592. Log(vlDebug,SLogCompilerCfgCompiler,[FCompiler]);
  593. Log(vlDebug,SLogCompilerCfgTarget,[MakeTargetString(CompilerCPU,CompilerOS)]);
  594. Log(vlDebug,SLogCompilerCfgVersion,[FCompilerVersion]);
  595. Log(vlDebug,SLogCompilerCfgGlobalInstallDir,[GlobalInstallDir]);
  596. Log(vlDebug,SLogCompilerCfgLocalInstallDir,[LocalInstallDir]);
  597. Log(vlDebug,SLogCompilerCfgGlobalPrefix,[GlobalPrefix]);
  598. Log(vlDebug,SLogCompilerCfgLocalPrefix,[LocalPrefix]);
  599. end;
  600. initialization
  601. GlobalOptions:=TGlobalOptions.Create;
  602. CompilerOptions:=TCompilerOptions.Create;
  603. FPMakeCompilerOptions:=TCompilerOptions.Create;
  604. finalization
  605. FreeAndNil(GlobalOptions);
  606. FreeAndNil(CompilerOptions);
  607. FreeAndNil(FPMakeCompilerOptions);
  608. end.