fprepos.pp 26 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992
  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 fprepos;
  13. interface
  14. uses
  15. classes,sysutils,
  16. contnrs,
  17. fpmkunit,
  18. streamcoll;
  19. Const
  20. StreamVersion : Integer = 1;
  21. StreamSignature = $FEEF;
  22. type
  23. { TFPDependency }
  24. TFPDependency = Class(TStreamCollectionItem)
  25. private
  26. FOSes : TOSES;
  27. FCPUs : TCPUS;
  28. FMinVersion: TFPVersion;
  29. FPackageName: String;
  30. FRequireChecksum : cardinal;
  31. procedure SetMinVersion(const AValue: TFPVersion);
  32. Public
  33. Constructor Create(ACollection : TCollection); override;
  34. Destructor Destroy; override;
  35. Procedure LoadFromStream(Stream : TStream; Streamversion : Integer); override;
  36. Procedure SaveToStream(Stream : TStream); override;
  37. Procedure Assign(Source : TPersistent); override;
  38. Property OSes : TOSes Read FOSes Write FOses;
  39. Property CPUs : TCPUs Read FCPUs Write FCPUs;
  40. Published
  41. Property PackageName : String Read FPackageName Write FPackageName;
  42. Property MinVersion : TFPVersion Read FMinVersion Write SetMinVersion;
  43. Property RequireChecksum : Cardinal Read FRequireChecksum Write FRequireChecksum;
  44. end;
  45. { TFPDepencencies }
  46. TFPDependencies = Class(TStreamCollection)
  47. private
  48. function GetDependency(Index : Integer): TFPDependency;
  49. procedure SetDependency(Index : Integer; const AValue: TFPDependency);
  50. public
  51. Function AddDependency(const APackageName : String; const AMinVersion : String = '') : TFPDependency;
  52. Property Dependencies[Index : Integer] : TFPDependency Read GetDependency Write SetDependency;default;
  53. end;
  54. { TFPPackage }
  55. TFPPackage = Class(TStreamCollectionItem)
  56. private
  57. FAuthor: String;
  58. FCategory: String;
  59. FDescription: String;
  60. FEmail: String;
  61. FFPMakeOptionsString: string;
  62. FKeywords: String;
  63. FRecompileBroken: boolean;
  64. FSourcePath: string;
  65. FInstalledLocally: boolean;
  66. FIsFPMakeAddIn: boolean;
  67. FLicense: String;
  68. FName: String;
  69. FHomepageURL: String;
  70. FDownloadURL: String;
  71. FFileName: String;
  72. FSupport: String;
  73. FUnusedVersion: TFPVersion;
  74. FVersion: TFPVersion;
  75. FDependencies : TFPDependencies;
  76. FOSes : TOSES;
  77. FCPUs : TCPUS;
  78. // Installation info
  79. FChecksum : cardinal;
  80. FLocalFileName : String;
  81. function GetFileName: String;
  82. procedure SetName(const AValue: String);
  83. procedure SetUnusedVersion(const AValue: TFPVersion);
  84. procedure SetVersion(const AValue: TFPVersion);
  85. protected
  86. procedure LoadUnitConfigFromStringlist(Const AStringList: TStrings); virtual;
  87. Public
  88. Constructor Create(ACollection : TCollection); override;
  89. Destructor Destroy; override;
  90. Procedure LoadFromStream(Stream : TStream; Streamversion : Integer); override;
  91. Procedure SaveToStream(Stream : TStream); override;
  92. procedure LoadUnitConfigFromFile(Const AFileName: String);
  93. Procedure Assign(Source : TPersistent); override;
  94. Function AddDependency(Const APackageName : String; const AMinVersion : String = '') : TFPDependency;
  95. Property Dependencies : TFPDependencies Read FDependencies;
  96. // Only for installed packages: (is false for packages which are installed globally)
  97. Property InstalledLocally : boolean read FInstalledLocally write FInstalledLocally;
  98. Property UnusedVersion : TFPVersion Read FUnusedVersion Write SetUnusedVersion;
  99. Property RecompileBroken : boolean read FRecompileBroken write FRecompileBroken;
  100. Property OSes : TOSes Read FOSes Write FOses;
  101. Property CPUs : TCPUs Read FCPUs Write FCPUs;
  102. Published
  103. Property Name : String Read FName Write SetName;
  104. Property Author : String Read FAuthor Write FAuthor;
  105. Property Version : TFPVersion Read FVersion Write SetVersion;
  106. Property License : String Read FLicense Write FLicense;
  107. Property Description : String Read FDescription Write FDescription;
  108. Property Support : String Read FSupport Write FSupport;
  109. Property Keywords : String Read FKeywords Write FKeywords;
  110. Property Category : String Read FCategory Write FCategory;
  111. Property HomepageURL : String Read FHomepageURL Write FHomepageURL;
  112. Property DownloadURL : String Read FDownloadURL Write FDownloadURL;
  113. Property FileName : String Read GetFileName Write FFileName;
  114. Property Email : String Read FEmail Write FEmail;
  115. Property Checksum : Cardinal Read FChecksum Write FChecksum;
  116. Property IsFPMakeAddIn : boolean read FIsFPMakeAddIn write FIsFPMakeAddIn;
  117. // These properties are used to re-compile the package, when it's dependencies are changed.
  118. Property SourcePath : string read FSourcePath write FSourcePath;
  119. Property FPMakeOptionsString : string read FFPMakeOptionsString write FFPMakeOptionsString;
  120. // Manual package from commandline not in official repository
  121. Property LocalFileName : String Read FLocalFileName Write FLocalFileName;
  122. end;
  123. { TFPPackages }
  124. TFPPackages = Class(TStreamCollection)
  125. private
  126. FVersion : Integer;
  127. function GetPackage(Index : Integer): TFPPackage;
  128. procedure SetPackage(Index : Integer; const AValue: TFPPackage);
  129. Protected
  130. Function CurrentStreamVersion : Integer; override;
  131. Public
  132. Function IndexOfPackage(const APackageName : String) : Integer;
  133. Function FindPackage(const APackageName : String) : TFPPackage;
  134. Function PackageByName(const APackageName : String) : TFPPackage;
  135. Function AddPackage(const APackageName : string) : TFPPackage;
  136. Property StreamVersion : Integer Read FVersion Write FVersion;
  137. Property Packages [Index : Integer] : TFPPackage Read GetPackage Write SetPackage; default;
  138. end;
  139. TFPPackagesClass = class of TFPPackages;
  140. { TFPRepository }
  141. TFPRepository = Class(TComponent)
  142. Private
  143. FMaxDependencyLevel : Integer;
  144. FBackUpFiles: Boolean;
  145. FFileName: String;
  146. function GetPackage(Index : Integer): TFPPackage;
  147. function GetPackageCount: Integer;
  148. Protected
  149. FPackages : TFPPackages;
  150. procedure CreatePackages; virtual;
  151. Procedure BackupFile(const AFileName : String); virtual;
  152. Procedure DoGetPackageDependencies(const APackageName : String; List : TStringList; Level : Integer); virtual;
  153. Public
  154. Constructor Create(AOwner : TComponent); override;
  155. Destructor Destroy; override;
  156. // Loading and Saving repository. Own format.
  157. Procedure LoadFromStream(Stream : TStream); Virtual;
  158. Procedure SaveToStream(Stream : TStream); Virtual;
  159. Procedure LoadFromFile(const AFileName : String);
  160. Procedure SaveToFile(const AFileName : String);
  161. Procedure Save;
  162. // Package management
  163. Function IndexOfPackage(const APackageName : String) : Integer;
  164. Function FindPackage(const APackageName : String) : TFPPackage;
  165. Function PackageByName(const APackageName : String) : TFPPackage;
  166. Procedure DeletePackage(Index : Integer);
  167. Procedure RemovePackage(const APackageName : string);
  168. Function AddPackage(const APackageName : string) : TFPPackage;
  169. // Dependencies
  170. Procedure GetPackageDependencies(const APackageName : String; List : TObjectList; Recurse : Boolean);
  171. // Properties
  172. Property FileName : String Read FFileName;
  173. Property Packages[Index : Integer] : TFPPackage Read GetPackage; default;
  174. Property PackageCount : Integer Read GetPackageCount;
  175. Property BackupFiles : Boolean Read FBackUpFiles Write FBackupFiles;
  176. Property MaxDependencyLevel : Integer Read FMaxDependencyLevel Write FMaxDependencyLevel;
  177. Property PackageCollection : TFPPackages Read FPackages;
  178. end;
  179. TFPRepositoryClass = class of TFPRepository;
  180. { TFPMirror }
  181. TFPMirror = Class(TStreamCollectionItem)
  182. private
  183. FContact: String;
  184. FName: String;
  185. FURL: String;
  186. FWeight: Integer;
  187. Public
  188. Constructor Create(ACollection : TCollection); override;
  189. Destructor Destroy; override;
  190. Procedure LoadFromStream(Stream : TStream; Streamversion : Integer); override;
  191. Procedure SaveToStream(Stream : TStream); override;
  192. Procedure Assign(Source : TPersistent); override;
  193. Published
  194. Property Name : String Read FName Write FName;
  195. Property URL : String Read FURL Write FURL;
  196. Property Contact : String Read FContact Write FContact;
  197. Property Weight : Integer Read FWeight Write FWeight;
  198. end;
  199. { TFPMirrors }
  200. TFPMirrors = Class(TStreamCollection)
  201. private
  202. FVersion : Integer;
  203. function GetMirror(Index : Integer): TFPMirror;
  204. procedure SetMirror(Index : Integer; const AValue: TFPMirror);
  205. Protected
  206. Function CurrentStreamVersion : Integer; override;
  207. Public
  208. Function IndexOfMirror(const AMirrorName : String) : Integer;
  209. Function FindMirror(const AMirrorName : String) : TFPMirror;
  210. Function MirrorByName(const AMirrorName : String) : TFPMirror;
  211. Function AddMirror(const AMirrorName : string) : TFPMirror;
  212. Property StreamVersion : Integer Read FVersion Write FVersion;
  213. Property Mirrors [Index : Integer] : TFPMirror Read GetMirror Write SetMirror; default;
  214. end;
  215. EPackage = Class(Exception);
  216. EMirror = Class(Exception);
  217. Const
  218. // Max level of dependency searching before we decide it's a circular dependency.
  219. DefaultMaxDependencyLevel = 15;
  220. Function MakeTargetString(CPU : TCPU;OS: TOS) : String;
  221. Procedure StringToCPUOS(S : String; Var CPU : TCPU; Var OS: TOS);
  222. Implementation
  223. uses
  224. typinfo,
  225. pkgglobals,
  226. uriparser;
  227. const
  228. // Keys for unit config
  229. KeyName = 'Name';
  230. KeyVersion = 'Version';
  231. KeyChecksum = 'Checksum';
  232. KeyNeedLibC = 'NeedLibC';
  233. KeyDepends = 'Depends';
  234. KeyAddIn = 'FPMakeAddIn';
  235. KeySourcePath = 'SourcePath';
  236. KeyFPMakeOptions = 'FPMakeOptions';
  237. KeyCPU = 'CPU';
  238. KeyOS = 'OS';
  239. ResourceString
  240. SErrInvalidCPU = 'Invalid CPU name : "%s"';
  241. SErrInvalidOS = 'Invalid OS name : "%s"';
  242. SErrInvalidMode = 'Invalid compiler mode : "%s"';
  243. SErrInvalidTarget = 'Invalid compiler target: %s';
  244. SErrPackageNotFound = 'Package "%s" not found.';
  245. SErrInvalidRepositorySig = 'Invalid repository stream. Stream signature incorrect';
  246. SErrBackupFailed = 'Failed to back up file "%s" to "%s".';
  247. SErrNoFileName = 'No filename for repository specified.';
  248. SErrDuplicatePackageName = 'Duplicate package name : "%s"';
  249. SErrMaxLevelExceeded = 'Maximum number of dependency levels exceeded (%d) at package "%s".';
  250. SErrMirrorNotFound = 'Mirror "%s" not found.';
  251. Function MakeTargetString(CPU : TCPU;OS: TOS) : String;
  252. begin
  253. Result:=CPUToString(CPU)+'-'+OSToString(OS);
  254. end;
  255. Procedure StringToCPUOS(S : String; Var CPU : TCPU; Var OS: TOS);
  256. Var
  257. P : integer;
  258. begin
  259. P:=Pos('-',S);
  260. If (P=0) then
  261. Raise EPackage.CreateFmt(SErrInvalidTarget,[S]);
  262. CPU:=StringToCPU(Copy(S,1,P-1));
  263. OS:=StringToOs(Copy(S,P+1,Length(S)-P));
  264. end;
  265. { TFPPackage }
  266. procedure TFPPackage.SetVersion(const AValue: TFPVersion);
  267. begin
  268. if FVersion=AValue then
  269. exit;
  270. FVersion.Assign(AValue);
  271. end;
  272. constructor TFPPackage.Create(ACollection: TCollection);
  273. begin
  274. inherited Create(ACollection);
  275. FVersion:=TFPVersion.Create;
  276. FUnusedVersion:=TFPVersion.Create;
  277. FChecksum:=$ffffffff;
  278. FOSes:=AllOSes;
  279. FCPUs:=AllCPUs;
  280. FDependencies:=TFPDependencies.Create(TFPDependency);
  281. end;
  282. destructor TFPPackage.Destroy;
  283. begin
  284. FreeAndNil(FDependencies);
  285. FreeAndNil(FVersion);
  286. FreeAndNil(FUnusedVersion);
  287. inherited Destroy;
  288. end;
  289. procedure TFPPackage.SetName(const AValue: String);
  290. begin
  291. If (AValue<>FName) and (AValue<>'') then
  292. If (Collection<>Nil) and (Collection is TFPPackages) then
  293. // do not check while loading, this would slow down a lot !!
  294. if (not TFPPackages(Collection).Streaming) then
  295. If TFPPackages(Collection).IndexOfPackage(AValue)<>-1 then
  296. Raise EPackage.CreateFmt(SErrDuplicatePackageName,[AValue]);
  297. FName:=AValue;
  298. end;
  299. procedure TFPPackage.SetUnusedVersion(const AValue: TFPVersion);
  300. begin
  301. if FUnusedVersion=AValue then
  302. exit;
  303. FUnusedVersion.Assign(AValue);
  304. end;
  305. function TFPPackage.GetFileName: String;
  306. var
  307. URI : TURI;
  308. begin
  309. if FFileName='' then
  310. begin
  311. URI:=ParseURI(DownloadURL);
  312. Result:=URI.Document;
  313. end
  314. else
  315. Result:=FFileName;
  316. end;
  317. procedure TFPPackage.LoadFromStream(Stream: TStream; Streamversion : Integer);
  318. Var
  319. B : Boolean;
  320. O : TOSes;
  321. C : TCPUs;
  322. I,J,Count : Integer;
  323. begin
  324. Version.AsString:=ReadString(Stream);
  325. Name:=ReadString(Stream);
  326. Author:=ReadString(Stream);
  327. License:=ReadString(Stream);
  328. Description:=ReadString(Stream);
  329. HomepageURL:=ReadString(Stream);
  330. DownloadURL:=ReadString(Stream);
  331. FileName:=ReadString(Stream);
  332. Email:=ReadString(Stream);
  333. Count:=ReadInteger(Stream);
  334. O:=[];
  335. For I:=1 to Count do
  336. begin
  337. J:=GetEnumValue(TypeInfo(TOS),ReadString(Stream));
  338. If (J<>-1) then
  339. Include(O,TOS(J));
  340. end;
  341. OSEs:=O;
  342. Count:=ReadInteger(Stream);
  343. C:=[];
  344. For I:=1 to Count do
  345. begin
  346. J:=GetEnumValue(TypeInfo(TCPU),ReadString(Stream));
  347. If (J<>-1) then
  348. Include(C,TCPU(J));
  349. end;
  350. CPUS:=C;
  351. FDependencies.Clear;
  352. B:=ReadBoolean(Stream);
  353. If B then
  354. FDependencies.LoadFromStream(Stream);
  355. end;
  356. procedure TFPPackage.SaveToStream(Stream: TStream);
  357. Var
  358. Count : Integer;
  359. O : TOS;
  360. C : TCPU;
  361. begin
  362. WriteString(Stream,Version.AsString);
  363. WriteString(Stream,Name);
  364. WriteString(Stream,Author);
  365. WriteString(Stream,License);
  366. WriteString(Stream,Description);
  367. WriteString(Stream,HomepageURL);
  368. WriteString(Stream,DownloadURL);
  369. WriteString(Stream,FileName);
  370. WriteString(Stream,Email);
  371. { Write it like this, makes error checking easier when reading. }
  372. // OSes
  373. Count:=0;
  374. For O:=Low(TOS) to High(TOS) do
  375. If O in OSes then
  376. Inc(Count);
  377. WriteInteger(Stream,Count);
  378. For O:=Low(TOS) to High(TOS) do
  379. If O in OSes then
  380. WriteString(Stream,GetEnumName(TypeInfo(TOS),Ord(O)));
  381. // CPUs
  382. Count:=0;
  383. For C:=Low(TCPU) to High(TCPU) do
  384. If C in CPUS then
  385. Inc(Count);
  386. WriteInteger(Stream,Count);
  387. For C:=Low(TCPU) to High(TCPU) do
  388. If C in CPUS then
  389. WriteString(Stream,GetEnumName(TypeInfo(TCPU),Ord(C)));
  390. WriteBoolean(Stream,FDependencies.Count>0);
  391. If FDependencies.Count>0 then
  392. FDependencies.SaveToStream(Stream);
  393. end;
  394. procedure TFPPackage.LoadUnitConfigFromStringlist(const AStringList: TStrings);
  395. var
  396. L2 : TStrings;
  397. VOS : TOS;
  398. VCPU : TCPU;
  399. i,k : Integer;
  400. DepChecksum : Cardinal;
  401. DepName : String;
  402. D : TFPDependency;
  403. begin
  404. With AStringList do
  405. begin
  406. Version.AsString:=Values[KeyVersion];
  407. SourcePath:=Values[KeySourcePath];
  408. FPMakeOptionsString:=Values[KeyFPMakeOptions];
  409. Checksum:=Cardinal(StrToInt64Def(Values[KeyChecksum],$ffffffff));
  410. VCPU:=StringToCPU(Values[KeyCPU]);
  411. VOS:=StringToOS(Values[KeyOS]);
  412. OSes:=[VOS];
  413. CPUs:=[VCPU];
  414. L2:=TStringList.Create;
  415. L2.CommaText:=Values[KeyDepends];
  416. for i:=0 to L2.Count-1 do
  417. begin
  418. DepName:=L2[i];
  419. k:=Pos('|',DepName);
  420. if k>0 then
  421. begin
  422. DepChecksum:=StrToInt(Copy(DepName,k+1,Length(DepName)-k));
  423. DepName:=Copy(DepName,1,k-1);
  424. end
  425. else
  426. DepChecksum:=$ffffffff;
  427. D:=nil;
  428. for k:=0 to Dependencies.Count-1 do
  429. begin
  430. D:=Dependencies[k];
  431. if D.PackageName=DepName then
  432. break;
  433. D:=nil;
  434. end;
  435. if not assigned(D) then
  436. D:=AddDependency(DepName,'');
  437. D.RequireChecksum:=DepChecksum;
  438. end;
  439. FreeAndNil(L2);
  440. //NeedLibC:=Upcase(Values[KeyNeedLibC])='Y';
  441. IsFPMakeAddIn:=Upcase(Values[KeyAddIn])='Y';
  442. end;
  443. end;
  444. procedure TFPPackage.LoadUnitConfigFromFile(const AFileName: String);
  445. var
  446. L : TStrings;
  447. begin
  448. L:=TStringList.Create;
  449. Try
  450. ReadIniFile(AFileName,L);
  451. LoadUnitConfigFromStringlist(L);
  452. Finally
  453. L.Free;
  454. end;
  455. end;
  456. procedure TFPPackage.Assign(Source: TPersistent);
  457. Var
  458. P : TFPPackage;
  459. begin
  460. if Source is TFPPackage then
  461. begin
  462. P:=Source as TFPPackage;
  463. // This creates trouble if P has the same owning collection !!
  464. If P.Collection<>Collection then
  465. Name:=P.Name;
  466. Author:=P.Author;
  467. Version:=P.Version;
  468. Description:=P.Description;
  469. HomepageURL:=P.HomepageURL;
  470. DownloadURL:=P.DownloadURL;
  471. SourcePath:=P.SourcePath;
  472. FPMakeOptionsString:=P.FPMakeOptionsString;
  473. InstalledLocally:=P.InstalledLocally;
  474. OSes:=P.OSes;
  475. CPUs:=P.CPUs;
  476. FileName:=P.FileName;
  477. Checksum:=P.Checksum;
  478. Dependencies.Clear;
  479. Dependencies.Assign(P.Dependencies);
  480. end
  481. else
  482. inherited Assign(Source);
  483. end;
  484. function TFPPackage.AddDependency(Const APackageName : String; const AMinVersion : String = ''): TFPDependency;
  485. begin
  486. Result:=Dependencies.AddDependency(APackageName,AMinVersion);
  487. end;
  488. { TFPPackages }
  489. function TFPPackages.GetPackage(Index : Integer): TFPPackage;
  490. begin
  491. Result:=TFPPackage(Items[Index])
  492. end;
  493. procedure TFPPackages.SetPackage(Index : Integer; const AValue: TFPPackage);
  494. begin
  495. Items[Index]:=AValue;
  496. end;
  497. function TFPPackages.CurrentStreamVersion: Integer;
  498. begin
  499. Result:=FVersion;
  500. end;
  501. function TFPPackages.IndexOfPackage(const APackageName: String): Integer;
  502. begin
  503. Result:=Count-1;
  504. While (Result>=0) and (CompareText(GetPackage(Result).Name,APackageName)<>0) do
  505. Dec(Result);
  506. end;
  507. function TFPPackages.FindPackage(const APackageName: String): TFPPackage;
  508. Var
  509. I : Integer;
  510. begin
  511. I:=IndexOfPackage(APackageName);
  512. If (I=-1) then
  513. Result:=Nil
  514. else
  515. Result:=GetPackage(I);
  516. end;
  517. function TFPPackages.PackageByName(const APackageName: String): TFPPackage;
  518. begin
  519. Result:=FindPackage(APackageName);
  520. If Result=Nil then
  521. Raise EPackage.CreateFmt(SErrPackageNotFound,[APackageName]);
  522. end;
  523. function TFPPackages.AddPackage(const APackageName: string): TFPPackage;
  524. begin
  525. Result:=Add as TFPPackage;
  526. Try
  527. Result.Name:=APackageName;
  528. Except
  529. Result.Free;
  530. Raise;
  531. end;
  532. end;
  533. { TFPRepository }
  534. function TFPRepository.GetPackage(Index : Integer): TFPPackage;
  535. begin
  536. Result:=FPackages[Index];
  537. end;
  538. function TFPRepository.GetPackageCount: Integer;
  539. begin
  540. Result:=FPackages.Count;
  541. end;
  542. constructor TFPRepository.Create(AOwner: TComponent);
  543. begin
  544. inherited Create(AOwner);
  545. CreatePackages;
  546. FMaxDependencyLevel:=DefaultMaxDependencyLevel;
  547. end;
  548. procedure TFPRepository.CreatePackages;
  549. begin
  550. FPackages:=TFPPackages.Create(TFPPackage);
  551. FPackages.StreamVersion:=StreamVersion;
  552. end;
  553. procedure TFPRepository.BackupFile(const AFileName: String);
  554. Var
  555. S : String;
  556. begin
  557. S:=AFileName+'.bak';
  558. if not RenameFile(AFileName,S) then
  559. Raise EPackage.CreateFmt(SErrBackupFailed,[AFileName,S]);
  560. end;
  561. destructor TFPRepository.Destroy;
  562. begin
  563. FreeAndNil(FPackages);
  564. inherited Destroy;
  565. end;
  566. procedure TFPRepository.LoadFromStream(Stream: TStream);
  567. Var
  568. I : Integer;
  569. V : Integer;
  570. begin
  571. Stream.ReadBuffer(I,SizeOf(Integer));
  572. If (I<>StreamSignature) then
  573. Raise EPackage.Create(SErrInvalidRepositorySig);
  574. Stream.ReadBuffer(V,SizeOf(V));
  575. FPackages.LoadFromStream(Stream);
  576. end;
  577. procedure TFPRepository.SaveToStream(Stream: TStream);
  578. Var
  579. i : Integer;
  580. begin
  581. I:=StreamSignature;
  582. Stream.WriteBuffer(I,SizeOf(Integer));
  583. I:=StreamVersion;
  584. Stream.WriteBuffer(I,SizeOf(Integer));
  585. FPackages.SaveToStream(Stream);
  586. end;
  587. procedure TFPRepository.LoadFromFile(const AFileName: String);
  588. Var
  589. F : TFileStream;
  590. begin
  591. F:=TFileStream.Create(AFileName,fmopenRead);
  592. Try
  593. LoadFromStream(F);
  594. FFileName:=AFileName;
  595. Finally
  596. F.Free;
  597. end;
  598. end;
  599. procedure TFPRepository.SaveToFile(const AFileName: String);
  600. Var
  601. F : TFileStream;
  602. begin
  603. If FileExists(AFileName) and BackupFiles then
  604. BackupFile(AFileName);
  605. F:=TFileStream.Create(AFileName,fmCreate);
  606. Try
  607. SaveToStream(F);
  608. FFileName:=AFileName;
  609. Finally
  610. F.Free;
  611. end;
  612. end;
  613. procedure TFPRepository.Save;
  614. begin
  615. If (FFileName='') then
  616. Raise EPackage.Create(SErrNoFileName);
  617. SaveToFile(FFileName);
  618. end;
  619. function TFPRepository.IndexOfPackage(const APackageName: String): Integer;
  620. begin
  621. Result:=FPackages.IndexOfPackage(APackageName);
  622. end;
  623. function TFPRepository.FindPackage(const APackageName: String): TFPPackage;
  624. begin
  625. Result:=FPackages.FindPackage(APackageName);
  626. end;
  627. function TFPRepository.PackageByName(const APackageName: String): TFPPackage;
  628. begin
  629. Result:=FPackages.PackageByName(APackageName);
  630. end;
  631. procedure TFPRepository.RemovePackage(const APackageName: string);
  632. begin
  633. PackageByName(APackageName).Free;
  634. end;
  635. procedure TFPRepository.DeletePackage(Index : Integer);
  636. begin
  637. GetPackage(Index).Free;
  638. end;
  639. function TFPRepository.AddPackage(const APackageName: string): TFPPackage;
  640. begin
  641. Result:=FPackages.AddPackage(APackageName);
  642. end;
  643. procedure TFPRepository.DoGetPackageDependencies(const APackageName: String; List: TStringList; Level: Integer);
  644. Var
  645. P : TFPPackage;
  646. D2,D1 : TFPDependency;
  647. i,J : Integer;
  648. begin
  649. // If too many levels, bail out
  650. If (Level>FMaxDependencyLevel) then
  651. Raise EPackage.CreateFmt(SErrMaxLevelExceeded,[Level,APackageName]);
  652. // Check if it is a known package.
  653. P:=FindPackage(APackageName);
  654. If not Assigned(P) then
  655. exit;
  656. For I:=0 to P.Dependencies.Count-1 do
  657. begin
  658. D1:=P.Dependencies[i];
  659. J:=List.IndexOf(APackageName);
  660. If J=-1 then
  661. begin
  662. // Dependency not yet in list.
  663. D2:=TFPDependency.Create(Nil);
  664. D2.Assign(D1);
  665. List.AddObject(D2.PackageName,D2);
  666. end
  667. else
  668. begin
  669. // Dependency already in list, compare versions.
  670. D2:=List.Objects[J] as TFPDependency;
  671. If D1.MinVersion.CompareVersion(D2.MinVersion)>0 then
  672. D2.MinVersion.Assign(D1.MinVersion);
  673. end;
  674. // If it was already in the list, we no longer recurse.
  675. If (Level>=0) and (J=-1) Then
  676. DoGetPackageDependencies(D2.PackageName,List,Level+1);
  677. end;
  678. end;
  679. procedure TFPRepository.GetPackageDependencies(const APackageName: String; List: TObjectList; Recurse: Boolean);
  680. Var
  681. L : TStringList;
  682. I : Integer;
  683. begin
  684. L:=TStringList.Create;
  685. Try
  686. L.Sorted:=True;
  687. DoGetPackageDependencies(APackageName,L,Ord(Recurse)-1);
  688. For I:=0 to L.Count-1 do
  689. List.Add(L.Objects[i]);
  690. Finally
  691. // Freeing a stringlist does not free the objects.
  692. L.Free;
  693. end;
  694. end;
  695. { TFPDependency }
  696. procedure TFPDependency.SetMinVersion(const AValue: TFPVersion);
  697. begin
  698. FMinVersion.Assign(AValue);
  699. end;
  700. constructor TFPDependency.Create(ACollection: TCollection);
  701. begin
  702. inherited Create(ACollection);
  703. FMinVersion:=TFPVersion.Create;
  704. FOSes:=AllOSes;
  705. FCPUs:=AllCPUs;
  706. FRequireChecksum:=$ffffffff;
  707. end;
  708. destructor TFPDependency.Destroy;
  709. begin
  710. FreeAndNil(FMinVersion);
  711. inherited Destroy;
  712. end;
  713. procedure TFPDependency.LoadFromStream(Stream: TStream; Streamversion: Integer);
  714. begin
  715. PackageName:=ReadString(Stream);
  716. MinVersion.AsString:=ReadString(Stream)
  717. end;
  718. procedure TFPDependency.SaveToStream(Stream: TStream);
  719. begin
  720. WriteString(Stream,PackageName);
  721. WriteString(Stream,MinVersion.AsString);
  722. end;
  723. procedure TFPDependency.Assign(Source: TPersistent);
  724. var
  725. S : TFPDependency;
  726. begin
  727. If Source is TFPDependency then
  728. begin
  729. S:=Source as TFPDependency;
  730. FPackageName:=S.PackageName;
  731. FMinVersion.Assign(S.MinVersion);
  732. FOSes:=S.OSes;
  733. FCPUs:=S.CPUs;
  734. end
  735. else
  736. inherited Assign(Source);
  737. end;
  738. { TFPDependencies }
  739. function TFPDependencies.GetDependency(Index : Integer): TFPDependency;
  740. begin
  741. Result:=TFPDependency(Items[Index]);
  742. end;
  743. procedure TFPDependencies.SetDependency(Index : Integer; const AValue: TFPDependency);
  744. begin
  745. Items[Index]:=AValue;
  746. end;
  747. function TFPDependencies.AddDependency(const APackageName: String; const AMinVersion: String): TFPDependency;
  748. begin
  749. Result:=Add as TFPDependency;
  750. Result.PackageName:=APackageName;
  751. If (AMinVersion<>'') then
  752. Result.MinVersion.AsString:=AMinVersion;
  753. end;
  754. { TFPMirror }
  755. constructor TFPMirror.Create(ACollection: TCollection);
  756. begin
  757. inherited Create(ACollection);
  758. Weight:=100;
  759. end;
  760. destructor TFPMirror.Destroy;
  761. begin
  762. inherited Destroy;
  763. end;
  764. procedure TFPMirror.LoadFromStream(Stream: TStream; Streamversion : Integer);
  765. begin
  766. Name:=ReadString(Stream);
  767. URL:=ReadString(Stream);
  768. Contact:=ReadString(Stream);
  769. Weight:=ReadInteger(Stream);
  770. end;
  771. procedure TFPMirror.SaveToStream(Stream: TStream);
  772. begin
  773. WriteString(Stream,Name);
  774. WriteString(Stream,URL);
  775. WriteString(Stream,Contact);
  776. WriteInteger(Stream,Weight);
  777. end;
  778. procedure TFPMirror.Assign(Source: TPersistent);
  779. Var
  780. P : TFPMirror;
  781. begin
  782. if Source is TFPMirror then
  783. begin
  784. P:=Source as TFPMirror;
  785. // This creates trouble if P has the same owning collection !!
  786. If P.Collection<>Collection then
  787. Name:=P.Name;
  788. URL:=P.URL;
  789. Contact:=P.Contact;
  790. Weight:=P.Weight;
  791. end
  792. else
  793. inherited Assign(Source);
  794. end;
  795. { TFPMirrors }
  796. function TFPMirrors.GetMirror(Index : Integer): TFPMirror;
  797. begin
  798. Result:=TFPMirror(Items[Index])
  799. end;
  800. procedure TFPMirrors.SetMirror(Index : Integer; const AValue: TFPMirror);
  801. begin
  802. Items[Index]:=AValue;
  803. end;
  804. function TFPMirrors.CurrentStreamVersion: Integer;
  805. begin
  806. Result:=FVersion;
  807. end;
  808. function TFPMirrors.IndexOfMirror(const AMirrorName: String): Integer;
  809. begin
  810. Result:=Count-1;
  811. While (Result>=0) and (CompareText(GetMirror(Result).Name,AMirrorName)<>0) do
  812. Dec(Result);
  813. end;
  814. function TFPMirrors.FindMirror(const AMirrorName: String): TFPMirror;
  815. Var
  816. I : Integer;
  817. begin
  818. I:=IndexOfMirror(AMirrorName);
  819. If (I=-1) then
  820. Result:=Nil
  821. else
  822. Result:=GetMirror(I);
  823. end;
  824. function TFPMirrors.MirrorByName(const AMirrorName: String): TFPMirror;
  825. begin
  826. Result:=FindMirror(AMirrorName);
  827. If Result=Nil then
  828. Raise EMirror.CreateFmt(SErrMirrorNotFound,[AMirrorName]);
  829. end;
  830. function TFPMirrors.AddMirror(const AMirrorName: string): TFPMirror;
  831. begin
  832. Result:=Add as TFPMirror;
  833. Try
  834. Result.Name:=AMirrorName;
  835. Except
  836. Result.Free;
  837. Raise;
  838. end;
  839. end;
  840. end.