fprepos.pp 25 KB

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