fprepos.pp 22 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895
  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. streamcoll,
  18. fpmktype;
  19. Const
  20. StreamVersion : Integer = 1;
  21. StreamSignature = $FEEF;
  22. Type
  23. { TFPVersion }
  24. TFPVersion = Class(TPersistent)
  25. private
  26. FMajor: Word;
  27. FMinor: Word;
  28. FRelease: Word;
  29. FSuffix: string;
  30. function GetAsString: String;
  31. function GetEmpty: Boolean;
  32. procedure SetAsString(const AValue: String);
  33. Public
  34. Procedure Assign(Source : TPersistent); override;
  35. Property AsString : String Read GetAsString Write SetAsString;
  36. Function CompareVersion(AVersion : TFPVersion) : Integer;
  37. Function SameVersion(AVersion : TFPVersion) : Boolean;
  38. Property Empty : Boolean Read GetEmpty;
  39. Published
  40. Property Release : Word Read FRelease Write FRelease;
  41. Property Major : Word Read FMajor Write FMajor;
  42. Property Minor : Word Read FMinor Write FMinor;
  43. Property Suffix : string Read FSuffix Write FSuffix;
  44. end;
  45. { TFPDependency }
  46. TFPDependency = Class(TStreamCollectionItem)
  47. private
  48. FMinVersion: TFPVersion;
  49. FPackageName: String;
  50. procedure SetMinVersion(const AValue: TFPVersion);
  51. Public
  52. Constructor Create(ACollection : TCollection); override;
  53. Destructor Destroy; override;
  54. Procedure LoadFromStream(Stream : TStream; Streamversion : Integer); override;
  55. Procedure SaveToStream(Stream : TStream); override;
  56. Procedure Assign(Source : TPersistent); override;
  57. Published
  58. Property PackageName : String Read FPackageName Write FPackageName;
  59. Property MinVersion : TFPVersion Read FMinVersion Write SetMinVersion;
  60. end;
  61. { TFPDepencencies }
  62. TFPDependencies = Class(TStreamCollection)
  63. private
  64. function GetDependency(Index : Integer): TFPDependency;
  65. procedure SetDependency(Index : Integer; const AValue: TFPDependency);
  66. public
  67. Function AddDependency(Const APackageName : String; AMinVersion : String = '') : TFPDependency;
  68. Property Dependencies[Index : Integer] : TFPDependency Read GetDependency Write SetDependency;default;
  69. end;
  70. { TFPPackage }
  71. TFPPackage = Class(TStreamCollectionItem)
  72. private
  73. FAuthor: String;
  74. FDescription: String;
  75. FEmail: String;
  76. FLicense: String;
  77. FName: String;
  78. FExternalURL: String;
  79. FFileName: String;
  80. FVersion: TFPVersion;
  81. FInstalledVersion: TFPVersion;
  82. FDependencies : TFPDependencies;
  83. FOSes : TOSES;
  84. FCPUs : TCPUS;
  85. function GetDependencies: TFPDependencies;
  86. function GetHasDependencies: Boolean;
  87. function GetFileName: String;
  88. procedure SetName(const AValue: String);
  89. procedure SetVersion(const AValue: TFPVersion);
  90. Protected
  91. Function CreateDependencies : TFPDependencies; virtual;
  92. Public
  93. Constructor Create(ACollection : TCollection); override;
  94. Destructor Destroy; override;
  95. Procedure LoadFromStream(Stream : TStream; Streamversion : Integer); override;
  96. Procedure SaveToStream(Stream : TStream); override;
  97. Procedure Assign(Source : TPersistent); override;
  98. Function AddDependency(Const APackageName : String; AMinVersion : String = '') : TFPDependency;
  99. Property HasDependencies : Boolean Read GetHasDependencies;
  100. Property Dependencies : TFPDependencies Read GetDependencies;
  101. Published
  102. Property Name : String Read FName Write SetName;
  103. Property Author : String Read FAuthor Write FAuthor;
  104. Property Version : TFPVersion Read FVersion Write SetVersion;
  105. Property InstalledVersion : TFPVersion Read FInstalledVersion Write FInstalledVersion;
  106. Property License : String Read FLicense Write FLicense;
  107. Property Description : String Read FDescription Write FDescription;
  108. Property ExternalURL : String Read FExternalURL Write FExternalURL;
  109. Property FileName : String Read GetFileName Write FFileName;
  110. Property Email : String Read FEmail Write FEmail;
  111. Property OSes : TOSes Read FOSes Write FOses;
  112. Property CPUs : TCPUs Read FCPUs Write FCPUs;
  113. end;
  114. { TFPPackages }
  115. TFPPackages = Class(TStreamCollection)
  116. private
  117. FVersion : Integer;
  118. function GetPackage(Index : Integer): TFPPackage;
  119. procedure SetPackage(Index : Integer; const AValue: TFPPackage);
  120. Protected
  121. Function CurrentStreamVersion : Integer; override;
  122. Public
  123. Function IndexOfPackage(PackageName : String) : Integer;
  124. Function FindPackage(PackageName : String) : TFPPackage;
  125. Function PackageByName(PackageName : String) : TFPPackage;
  126. Function AddPackage(PackageName : string) : TFPPackage;
  127. Property StreamVersion : Integer Read FVersion Write FVersion;
  128. Property Packages [Index : Integer] : TFPPackage Read GetPackage Write SetPackage; default;
  129. end;
  130. { TFPRepository }
  131. TFPRepository = Class(TComponent)
  132. Private
  133. FMaxDependencyLevel : Integer;
  134. FBackUpFiles: Boolean;
  135. FFileName: String;
  136. FPackageCount: Integer;
  137. FPackages : TFPPackages;
  138. function GetPackage(Index : Integer): TFPPackage;
  139. function GetPackageCount: Integer;
  140. Protected
  141. Property PackageCollection : TFPPackages Read FPackages;
  142. procedure CreatePackages; virtual;
  143. Procedure BackupFile(AFileName : String); virtual;
  144. Procedure DoGetPackageDependencies(PackageName : String; List : TStringList; Level : Integer); virtual;
  145. Public
  146. Constructor Create(AOwner : TComponent); override;
  147. Destructor Destroy; override;
  148. // Loading and Saving repository. Own format.
  149. Procedure LoadFromStream(Stream : TStream); Virtual;
  150. Procedure SaveToStream(Stream : TStream); Virtual;
  151. Procedure LoadFromFile(AFileName : String);
  152. Procedure SaveToFile(AFileName : String);
  153. Procedure Save;
  154. // Loading and Saving version numbers: List of Name=Value pairs.
  155. Procedure LoadStatusFromStream(Stream : TStream); virtual;
  156. Procedure SaveStatusToStream(Stream : TStream; InstalledStatus : Boolean); virtual;
  157. Procedure LoadStatusFromFile(AFileName : String);
  158. Procedure SaveStatusToFile(AFileName : String; InstalledStatus : Boolean);
  159. // Package management
  160. Function IndexOfPackage(PackageName : String) : Integer;
  161. Function FindPackage(PackageName : String) : TFPPackage;
  162. Function PackageByName(PackageName : String) : TFPPackage;
  163. Procedure DeletePackage(Index : Integer);
  164. Procedure RemovePackage(PackageName : string);
  165. Function AddPackage(PackageName : string) : TFPPackage;
  166. // Dependencies
  167. Procedure GetPackageDependencies(PackageName : String; List : TObjectList; Recurse : Boolean);
  168. // Properties
  169. Property FileName : String Read FFileName;
  170. Property Packages[Index : Integer] : TFPPackage Read GetPackage; default;
  171. Property PackageCount : Integer Read GetPackageCount;
  172. Property BackupFiles : Boolean Read FBackUpFiles Write FBackupFiles;
  173. Property MaxDependencyLevel : Integer Read FMaxDependencyLevel Write FMaxDependencyLevel;
  174. end;
  175. EPackage = Class(Exception);
  176. Const
  177. // Max level of dependency searching before we decide it's a circular dependency.
  178. DefaultMaxDependencyLevel = 15;
  179. Implementation
  180. uses
  181. typinfo,
  182. uriparser;
  183. ResourceString
  184. SErrPackageNotFound = 'Package "%s" not found.';
  185. SErrInvalidRepositorySig = 'Invalid repository stream. Stream signature incorrect';
  186. SErrBackupFailed = 'Failed to back up file "%s" to "%s".';
  187. SErrNoFileName = 'No filename for repository specified.';
  188. SErrDuplicatePackageName = 'Duplicate package name : "%s"';
  189. SErrMaxLevelExceeded = 'Maximum number of dependency levels exceeded (%d) at package "%s".';
  190. { TFPVersion }
  191. function TFPVersion.GetAsString: String;
  192. begin
  193. Result:=Format('%d.%d.%d',[Release,Major,Minor]);
  194. If (Suffix<>'') then
  195. Result:=Result+'-'+Suffix;
  196. end;
  197. function TFPVersion.GetEmpty: Boolean;
  198. begin
  199. Result:=(Release=0) and (Major=0) and (Minor=0) and (Suffix='');
  200. end;
  201. procedure TFPVersion.SetAsString(const AValue: String);
  202. Function NextDigit(sep : Char; var V : string) : integer;
  203. Var
  204. P : Integer;
  205. begin
  206. P:=Pos(Sep,V);
  207. If (P=0) then
  208. P:=Length(V)+1;
  209. Result:=StrToIntDef(Copy(V,1,P-1),-1);
  210. If Result<>-1 then
  211. Delete(V,1,P)
  212. else
  213. Result:=0;
  214. end;
  215. Var
  216. P : Integer;
  217. V : String;
  218. begin
  219. Release:=0;
  220. Major:=0;
  221. Minor:=0;
  222. Suffix:='';
  223. V:=AValue;
  224. Release:=NextDigit('.',V);
  225. Major:=NextDigit('.',V);
  226. Minor:=NextDigit('-',V);
  227. P:=Pos('-',V);
  228. If (P<>0) then
  229. Delete(V,1,P);
  230. Suffix:=V;
  231. end;
  232. procedure TFPVersion.Assign(Source: TPersistent);
  233. Var
  234. V : TFPVersion;
  235. begin
  236. if Source is TFPVersion then
  237. begin
  238. V:=Source as TFPVersion;
  239. Release:=V.Release;
  240. Major:=V.Major;
  241. Minor:=V.Minor;
  242. Suffix:=V.Suffix;
  243. end
  244. else
  245. inherited Assign(Source);
  246. end;
  247. function TFPVersion.CompareVersion(AVersion: TFPVersion): Integer;
  248. begin
  249. Result:=Release-AVersion.Release;
  250. If (Result=0) then
  251. begin
  252. Result:=Major-AVersion.Major;
  253. if (Result=0) then
  254. begin
  255. Result:=Minor-AVersion.Minor;
  256. If (Result=0) then
  257. Result:=CompareText(Suffix,AVersion.Suffix);
  258. end;
  259. end;
  260. end;
  261. function TFPVersion.SameVersion(AVersion: TFPVersion): Boolean;
  262. begin
  263. Result:=CompareVersion(AVersion)=0;
  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. Function TFPPackage.CreateDependencies : TFPDependencies;
  273. begin
  274. Result:=TFPDependencies.Create(TFPDependency);
  275. end;
  276. constructor TFPPackage.Create(ACollection: TCollection);
  277. begin
  278. inherited Create(ACollection);
  279. FVersion:=TFPVersion.Create;
  280. FInstalledVersion:=TFPVersion.Create;
  281. end;
  282. destructor TFPPackage.Destroy;
  283. begin
  284. FreeAndNil(FDependencies);
  285. FreeAndNil(FVersion);
  286. FreeAndNil(FInstalledVersion);
  287. inherited Destroy;
  288. end;
  289. procedure TFPPackage.SetName(const AValue: String);
  290. Var
  291. I : Integer;
  292. begin
  293. If (AValue<>FName) and (AValue<>'') then
  294. If (Collection<>Nil) and (Collection is TFPPackages) then
  295. // do not check while loading, this would slow down a lot !!
  296. if (not TFPPackages(Collection).Streaming) then
  297. If TFPPackages(Collection).IndexOfPackage(AValue)<>-1 then
  298. Raise EPackage.CreateFmt(SErrDuplicatePackageName,[AValue]);
  299. FName:=AValue;
  300. end;
  301. function TFPPackage.GetDependencies: TFPDependencies;
  302. begin
  303. If Not Assigned(FDependencies) then
  304. FDependencies:=CreateDependencies;
  305. Result:=FDependencies;
  306. end;
  307. function TFPPackage.GetHasDependencies: Boolean;
  308. begin
  309. Result:=Assigned(FDependencies) and (FDependencies.Count>0);
  310. end;
  311. function TFPPackage.GetFileName: String;
  312. var
  313. URI : TURI;
  314. begin
  315. if FFileName='' then
  316. begin
  317. URI:=ParseURI(ExternalURL);
  318. Result:=URI.Document;
  319. end
  320. else
  321. Result:=FFileName;
  322. end;
  323. procedure TFPPackage.LoadFromStream(Stream: TStream; Streamversion : Integer);
  324. Var
  325. B : Boolean;
  326. O : TOSes;
  327. C : TCPUs;
  328. I,J,Count : Integer;
  329. begin
  330. Version.AsString:=ReadString(Stream);
  331. Name:=ReadString(Stream);
  332. Author:=ReadString(Stream);
  333. License:=ReadString(Stream);
  334. Description:=ReadString(Stream);
  335. ExternalURL:=ReadString(Stream);
  336. FileName:=ReadString(Stream);
  337. Email:=ReadString(Stream);
  338. Count:=ReadInteger(Stream);
  339. O:=[];
  340. For I:=1 to Count do
  341. begin
  342. J:=GetEnumValue(TypeInfo(TOS),ReadString(Stream));
  343. If (J<>-1) then
  344. Include(O,TOS(J));
  345. end;
  346. OSEs:=O;
  347. Count:=ReadInteger(Stream);
  348. C:=[];
  349. For I:=1 to Count do
  350. begin
  351. J:=GetEnumValue(TypeInfo(TCPU),ReadString(Stream));
  352. If (J<>-1) then
  353. Include(C,TCPU(J));
  354. end;
  355. CPUS:=C;
  356. FreeAndNil(FDependencies);
  357. B:=ReadBoolean(Stream);
  358. If B then
  359. begin
  360. FDependencies:=CreateDependencies;
  361. FDependencies.LoadFromStream(Stream);
  362. end
  363. end;
  364. procedure TFPPackage.SaveToStream(Stream: TStream);
  365. Var
  366. Count : Integer;
  367. O : TOS;
  368. C : TCPU;
  369. begin
  370. WriteString(Stream,Version.AsString);
  371. WriteString(Stream,Name);
  372. WriteString(Stream,Author);
  373. WriteString(Stream,License);
  374. WriteString(Stream,Description);
  375. WriteString(Stream,ExternalURL);
  376. WriteString(Stream,FileName);
  377. WriteString(Stream,Email);
  378. { Write it like this, makes error checking easier when reading. }
  379. // OSes
  380. Count:=0;
  381. For O:=Low(TOS) to High(TOS) do
  382. If O in OSes then
  383. Inc(Count);
  384. WriteInteger(Stream,Count);
  385. For O:=Low(TOS) to High(TOS) do
  386. If O in OSes then
  387. WriteString(Stream,GetEnumName(TypeInfo(TOS),Ord(O)));
  388. // CPUs
  389. Count:=0;
  390. For C:=Low(TCPU) to High(TCPU) do
  391. If C in CPUS then
  392. Inc(Count);
  393. WriteInteger(Stream,Count);
  394. For C:=Low(TCPU) to High(TCPU) do
  395. If C in CPUS then
  396. WriteString(Stream,GetEnumName(TypeInfo(TCPU),Ord(C)));
  397. WriteBoolean(Stream,HasDependencies);
  398. If HasDependencies then
  399. FDependencies.SaveToStream(Stream);
  400. end;
  401. procedure TFPPackage.Assign(Source: TPersistent);
  402. Var
  403. P : TFPPackage;
  404. begin
  405. if Source is TFPPackage then
  406. begin
  407. P:=Source as TFPPackage;
  408. // This creates trouble if P has the same owning collection !!
  409. If P.Collection<>Collection then
  410. Name:=P.Name;
  411. Author:=P.Author;
  412. Version:=P.Version;
  413. Description:=P.Description;
  414. ExternalURL:=P.ExternalURL;
  415. FileName:=P.FileName;
  416. InstalledVersion:=P.Installedversion;
  417. If P.HasDependencies then
  418. Dependencies.Assign(P.Dependencies)
  419. else
  420. FreeAndNil(FDependencies);
  421. end
  422. else
  423. inherited Assign(Source);
  424. end;
  425. function TFPPackage.AddDependency(const APackageName: String;
  426. AMinVersion: String): TFPDependency;
  427. begin
  428. Result:=Dependencies.AddDependency(APackageName,AMinVersion);
  429. end;
  430. { TFPPackages }
  431. function TFPPackages.GetPackage(Index : Integer): TFPPackage;
  432. begin
  433. Result:=TFPPackage(Items[Index])
  434. end;
  435. procedure TFPPackages.SetPackage(Index : Integer; const AValue: TFPPackage);
  436. begin
  437. Items[Index]:=AValue;
  438. end;
  439. function TFPPackages.CurrentStreamVersion: Integer;
  440. begin
  441. Result:=FVersion;
  442. end;
  443. function TFPPackages.IndexOfPackage(PackageName: String): Integer;
  444. begin
  445. Result:=Count-1;
  446. While (Result>=0) and (CompareText(GetPackage(Result).Name,PackageName)<>0) do
  447. Dec(Result);
  448. end;
  449. function TFPPackages.FindPackage(PackageName: String): TFPPackage;
  450. Var
  451. I : Integer;
  452. begin
  453. I:=IndexOfPackage(PackageName);
  454. If (I=-1) then
  455. Result:=Nil
  456. else
  457. Result:=GetPackage(I);
  458. end;
  459. function TFPPackages.PackageByName(PackageName: String): TFPPackage;
  460. begin
  461. Result:=FindPackage(PackageName);
  462. If Result=Nil then
  463. Raise EPackage.CreateFmt(SErrPackageNotFound,[PackageName]);
  464. end;
  465. function TFPPackages.AddPackage(PackageName: string): TFPPackage;
  466. begin
  467. Result:=Add as TFPPackage;
  468. Try
  469. Result.Name:=PackageName;
  470. Except
  471. Result.Free;
  472. Raise;
  473. end;
  474. end;
  475. { TFPRepository }
  476. function TFPRepository.GetPackage(Index : Integer): TFPPackage;
  477. begin
  478. Result:=FPackages[Index];
  479. end;
  480. function TFPRepository.GetPackageCount: Integer;
  481. begin
  482. Result:=FPackages.Count;
  483. end;
  484. constructor TFPRepository.Create(AOwner: TComponent);
  485. begin
  486. inherited Create(AOwner);
  487. CreatePackages;
  488. FMaxDependencyLevel:=DefaultMaxDependencyLevel;
  489. end;
  490. procedure TFPRepository.CreatePackages;
  491. begin
  492. FPackages:=TFPPackages.Create(TFPPackage);
  493. FPackages.StreamVersion:=StreamVersion;
  494. end;
  495. procedure TFPRepository.BackupFile(AFileName: String);
  496. Var
  497. S : String;
  498. begin
  499. S:=AFileName+'.bak';
  500. if not RenameFile(AFileName,S) then
  501. Raise EPackage.CreateFmt(SErrBackupFailed,[AFileName,S]);
  502. end;
  503. destructor TFPRepository.Destroy;
  504. begin
  505. FreeAndNil(FPackages);
  506. inherited Destroy;
  507. end;
  508. procedure TFPRepository.LoadFromStream(Stream: TStream);
  509. Var
  510. I : Integer;
  511. V : Integer;
  512. begin
  513. Stream.ReadBuffer(I,SizeOf(Integer));
  514. If (I<>StreamSignature) then
  515. Raise EPackage.Create(SErrInvalidRepositorySig);
  516. Stream.ReadBuffer(V,SizeOf(V));
  517. FPackages.LoadFromStream(Stream);
  518. end;
  519. procedure TFPRepository.SaveToStream(Stream: TStream);
  520. Var
  521. i : Integer;
  522. begin
  523. I:=StreamSignature;
  524. Stream.WriteBuffer(I,SizeOf(Integer));
  525. I:=StreamVersion;
  526. Stream.WriteBuffer(I,SizeOf(Integer));
  527. FPackages.SaveToStream(Stream);
  528. end;
  529. procedure TFPRepository.LoadFromFile(AFileName: String);
  530. Var
  531. F : TFileStream;
  532. begin
  533. F:=TFileStream.Create(AFileName,fmopenRead);
  534. Try
  535. LoadFromStream(F);
  536. FFileName:=AFileName;
  537. Finally
  538. F.Free;
  539. end;
  540. end;
  541. procedure TFPRepository.SaveToFile(AFileName: String);
  542. Var
  543. F : TFileStream;
  544. S : String;
  545. begin
  546. If FileExists(AFileName) and BackupFiles then
  547. BackupFile(AFileName);
  548. F:=TFileStream.Create(AFileName,fmCreate);
  549. Try
  550. SaveToStream(F);
  551. FFileName:=AFileName;
  552. Finally
  553. F.Free;
  554. end;
  555. end;
  556. procedure TFPRepository.Save;
  557. begin
  558. If (FFileName='') then
  559. Raise EPackage.Create(SErrNoFileName);
  560. SaveToFile(FFileName);
  561. end;
  562. procedure TFPRepository.LoadStatusFromStream(Stream: TStream);
  563. Var
  564. L : TStrings;
  565. I : Integer;
  566. N,V : String;
  567. begin
  568. L:=TStringList.Create;
  569. Try
  570. L.LoadFromStream(Stream);
  571. For I:=0 to L.Count-1 do
  572. begin
  573. L.GetNameValue(I,N,V);
  574. If (N<>'') and (V<>'') then
  575. PackageByName(N).InstalledVersion.AsString:=V;
  576. end;
  577. Finally
  578. L.Free;
  579. end;
  580. end;
  581. procedure TFPRepository.SaveStatusToStream(Stream: TStream;InstalledStatus : Boolean);
  582. Var
  583. L : TStrings;
  584. I : Integer;
  585. begin
  586. L:=TStringList.Create;
  587. Try
  588. If InstalledStatus then
  589. For I:=0 to PackageCount-1 do
  590. With Packages[i] do
  591. L.Add(Name+'='+InstalledVersion.AsString)
  592. else
  593. For I:=0 to PackageCount-1 do
  594. With Packages[i] do
  595. L.Add(Name+'='+Version.AsString);
  596. L.SaveToStream(Stream);
  597. Finally
  598. L.Free;
  599. end;
  600. end;
  601. procedure TFPRepository.LoadStatusFromFile(AFileName: String);
  602. Var
  603. F : TFileStream;
  604. begin
  605. F:=TFileStream.Create(AFileName,fmOpenRead);
  606. Try
  607. LoadStatusFromStream(F);
  608. Finally
  609. F.Free;
  610. end;
  611. end;
  612. procedure TFPRepository.SaveStatusToFile(AFileName: String; InstalledStatus : Boolean);
  613. Var
  614. F : TFileStream;
  615. begin
  616. If FileExists(AFileName) and BackupFiles then
  617. BackupFile(AFileName);
  618. F:=TFileStream.Create(AFileName,fmCreate);
  619. Try
  620. SaveStatusToStream(F,InstalledStatus);
  621. Finally
  622. F.Free;
  623. end;
  624. end;
  625. function TFPRepository.IndexOfPackage(PackageName: String): Integer;
  626. begin
  627. Result:=FPackages.IndexOfPackage(PackageName);
  628. end;
  629. function TFPRepository.FindPackage(PackageName: String): TFPPackage;
  630. begin
  631. Result:=FPackages.FindPackage(PackageName);
  632. end;
  633. function TFPRepository.PackageByName(PackageName: String): TFPPackage;
  634. begin
  635. Result:=FPackages.PackageByName(PackageName);
  636. end;
  637. procedure TFPRepository.RemovePackage(PackageName: string);
  638. begin
  639. PackageByName(PackageName).Free;
  640. end;
  641. procedure TFPRepository.DeletePackage(Index : Integer);
  642. begin
  643. GetPackage(Index).Free;
  644. end;
  645. function TFPRepository.AddPackage(PackageName: string): TFPPackage;
  646. begin
  647. Result:=FPackages.AddPackage(PackageName);
  648. end;
  649. procedure TFPRepository.DoGetPackageDependencies(PackageName: String;
  650. List: TStringList; Level: Integer);
  651. Var
  652. P : TFPPackage;
  653. D2,D1 : TFPDependency;
  654. i,J : Integer;
  655. begin
  656. // If too many levels, bail out
  657. If (Level>FMaxDependencyLevel) then
  658. Raise EPackage.CreateFmt(SErrMaxLevelExceeded,[Level,PackageName]);
  659. // Check if it is a known package.
  660. P:=FindPackage(PackageName);
  661. If Assigned(P) and P.HasDependencies then
  662. For I:=0 to P.Dependencies.Count-1 do
  663. begin
  664. D1:=P.Dependencies[i];
  665. J:=List.IndexOf(PackageName);
  666. If J=-1 then
  667. begin
  668. // Dependency not yet in list.
  669. D2:=TFPDependency.Create(Nil);
  670. D2.Assign(D1);
  671. List.AddObject(D2.PackageName,D2);
  672. end
  673. else
  674. begin
  675. // Dependency already in list, compare versions.
  676. D2:=List.Objects[J] as TFPDependency;
  677. If D1.MinVersion.CompareVersion(D2.MinVersion)>0 then
  678. D2.MinVersion.Assign(D1.MinVersion);
  679. end;
  680. // If it was already in the list, we no longer recurse.
  681. If (Level>=0) and (J=-1) Then
  682. DoGetPackageDependencies(D2.PackageName,List,Level+1);
  683. end;
  684. end;
  685. procedure TFPRepository.GetPackageDependencies(PackageName: String;
  686. List: TObjectList; Recurse: Boolean);
  687. Var
  688. L : TStringList;
  689. I : Integer;
  690. begin
  691. L:=TStringList.Create;
  692. Try
  693. L.Sorted:=True;
  694. DoGetPackageDependencies(PackageName,L,Ord(Recurse)-1);
  695. For I:=0 to L.Count-1 do
  696. List.Add(L.Objects[i]);
  697. Finally
  698. // Freeing a stringlist does not free the objects.
  699. L.Free;
  700. end;
  701. end;
  702. { TFPDependency }
  703. procedure TFPDependency.SetMinVersion(const AValue: TFPVersion);
  704. begin
  705. FMinVersion.Assign(AValue);
  706. end;
  707. constructor TFPDependency.Create(ACollection: TCollection);
  708. begin
  709. inherited Create(ACollection);
  710. FMinVersion:=TFPVersion.Create;
  711. end;
  712. destructor TFPDependency.Destroy;
  713. begin
  714. FreeAndNil(FMinVersion);
  715. inherited Destroy;
  716. end;
  717. procedure TFPDependency.LoadFromStream(Stream: TStream; Streamversion: Integer
  718. );
  719. begin
  720. PackageName:=ReadString(Stream);
  721. MinVersion.AsString:=ReadString(Stream)
  722. end;
  723. procedure TFPDependency.SaveToStream(Stream: TStream);
  724. begin
  725. WriteString(Stream,PackageName);
  726. WriteString(Stream,MinVersion.AsString);
  727. end;
  728. procedure TFPDependency.Assign(Source: TPersistent);
  729. begin
  730. If Source is TFPDependency then
  731. With Source as TFPDependency do
  732. begin
  733. Self.PackageName:=PackageName;
  734. Self.MinVersion:=MinVersion;
  735. end
  736. else
  737. inherited Assign(Source);
  738. end;
  739. { TFPDependencies }
  740. function TFPDependencies.GetDependency(Index : Integer): TFPDependency;
  741. begin
  742. Result:=TFPDependency(Items[Index]);
  743. end;
  744. procedure TFPDependencies.SetDependency(Index : Integer;
  745. const AValue: TFPDependency);
  746. begin
  747. Items[Index]:=AValue;
  748. end;
  749. function TFPDependencies.AddDependency(const APackageName: String;
  750. AMinVersion: String): TFPDependency;
  751. begin
  752. Result:=Add as TFPDependency;
  753. Result.PackageName:=APackageName;
  754. If (AMinVersion<>'') then
  755. Result.MinVersion.AsString:=AMinVersion;
  756. end;
  757. end.