1 {
2 ***************************************************************************
3 * *
4 * This source is free software; you can redistribute it and/or modify *
5 * it under the terms of the GNU General Public License as published by *
6 * the Free Software Foundation; either version 2 of the License, or *
7 * (at your option) any later version. *
8 * *
9 * This code is distributed in the hope that it will be useful, but *
10 * WITHOUT ANY WARRANTY; without even the implied warranty of *
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
12 * General Public License for more details. *
13 * *
14 * A copy of the GNU General Public License is available on the World *
15 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
16 * obtain it by writing to the Free Software Foundation, *
17 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
18 * *
19 ***************************************************************************
20
21 Author: Balázs Székely
22 Abstract:
23 Implementation of the serializable package class. Information about the
24 repository packages are stored in a json file. After the JSON is downloaded
25 it gets serialized to a package list.}
26
27 unit opkman_serializablepackages;
28
29 {$mode objfpc}{$H+}
30
31 interface
32
33 uses
34 Classes, SysUtils, Variants, contnrs, dateutils, fpjson, jsonparser,
35 // LazUtils
36 FileUtil, Laz2_XMLCfg, LazFileUtils,
37 // IdeIntf
38 PackageDependencyIntf, PackageIntf,
39 // OpkMan
40 opkman_common, opkman_const, opkman_options;
41
42 type
43 TPackageState = (
44 psRepository,
45 psDownloaded,
46 psExtracted,
47 psInstalled,
48 psError);
49 TPackageStates = set of TPackageState;
50
51 TChangeType = (ctAdd, ctRemove);
52 TSortType = (stName, stDate);
53 TSortOrder = (soAscendent, soDescendent);
54
55 {$M+}
56 TPackageVersion = class(TPkgVersion)
57 published
58 property Major;
59 property Minor;
60 property Release;
61 property Build;
62 property IsNullVersion;
63 end;
64 {$M-}
65
66 { TPackageDependency }
67
68 TPackageDependency = class(TCollectionItem)
69 private
70 FMaxVersion: TPackageVersion;
71 FMinVersion: TPackageVersion;
72 FPkgFileName: String;
73 procedure SetMinVersion(const AValue: TPackageVersion);
74 procedure SetMaxVersion(const AValue: TPackageVersion);
75 public
76 procedure Assign(ASource: TPersistent); override;
77 constructor Create(ACollection: TCollection); override;
78 destructor Destroy; override;
79 published
80 property PkgFileName: String read FPkgFileName write FPkgFileName;
81 property MinVersion: TPackageVersion read FMinVersion write SetMinVersion;
82 property MaxVersion: TPackageVersion read FMaxVersion write SetMaxVersion;
83 end;
84
85 { TPackageDependencies }
86
87 TPackageDependencies = class(TCollection)
88 private
GetDependencynull89 function GetDependency(AIndex: Integer): TPackageDependency;
90 procedure SetDependency(AIndex: Integer; const AValue: TPackageDependency);
91 public
GetDependenciesAsStringnull92 function GetDependenciesAsString(const AIsDisplayString: Boolean): String;
93 procedure SetDependenciesAsString(const AValue: String);
94 property Dependencies[AIndex: Integer]: TPackageDependency read GetDependency write SetDependency; default;
95 end;
96
97 { TLazarusPackage }
98
99 TLazarusPackage = class(TCollectionItem)
100 private
101 FName: String;
102 FDescription: String;
103 FAuthor: String;
104 FLicense: String;
105 FPackageState: TPackageState;
106 FPackageStates: TPackageStates;
107 FPackageType: TLazPackageType;
108 FLazCompatibility: String;
109 FFPCCompatibility: String;
110 FSupportedWidgetSet: String;
111 FPackageRelativePath: String;
112 FPackageAbsolutePath: String;
113 FInstalledFileName: String;
114 FInstalledFileVersion: String;
115 FInstalledFileDescription: String;
116 FInstalledFileLincese: String;
117 FUpdateVersion: String;
118 FForceNotify: Boolean;
119 FInternalVersion: Integer;
120 FInternalVersionOld: Integer;
121 FHasUpdate: Boolean;
122 FVersion: TPackageVersion;
123 FVersionAsString: String;
124 FDependencies: TPackageDependencies;
125 FDependenciesAsString: String;
126 FChecked: Boolean;
GetVersionAsStringnull127 function GetVersionAsString: String;
GetDependenciesAsStringnull128 function GetDependenciesAsString: String;
129 procedure SetVersionAsString(const AValue: String);
130 procedure SetDependenciesAsString(const AValue: String);
GetInstallablenull131 function GetInstallable: Boolean;
132 public
133 constructor Create; reintroduce;
134 destructor Destroy; override;
135 public
136 procedure RefreshHasUpdate;
137 property Version: TPackageVersion read FVersion write FVersion;
138 property Dependencies: TPackageDependencies read FDependencies write FDependencies;
139 property PackageStates: TPackageStates read FPackageStates write FPackageStates;
140 property PackageState: TPackageState read FPackageState write FPackageState;
141 property InstalledFileName: String read FInstalledFileName write FInstalledFileName;
142 property InstalledFileVersion: String read FInstalledFileVersion write FInstalledFileVersion;
143 property UpdateVersion: String read FUpdateVersion write FUpdateVersion;
144 property PackageAbsolutePath: String read FPackageAbsolutePath write FPackageAbsolutePath;
145 property Checked: Boolean read FChecked write FChecked;
146 property IsInstallable: Boolean read GetInstallable;
147 property ForceNotify: Boolean read FForceNotify write FForceNotify;
148 property InternalVersion: Integer read FInternalVersion write FInternalVersion;
149 property InternalVersionOld: Integer read FInternalVersionOld write FInternalVersionOld;
150 property HasUpdate: Boolean read FHasUpdate write FHasUpdate;
151 property InstalledFileDescription: String read FInstalledFileDescription write FInstalledFileDescription;
152 property InstalledFileLincese: String read FInstalledFileLincese write FInstalledFileLincese;
153 published
154 property Name: String read FName write FName;
155 property Author: String read FAuthor write FAuthor;
156 property Description: String read FDescription write FDescription;
157 property PackageRelativePath: string read FPackageRelativePath write FPackageRelativePath;
158 property VersionAsString: String read GetVersionAsString write SetVersionAsString;
159 property LazCompatibility: String read FLazCompatibility write FLazCompatibility;
160 property FPCCompatibility: String read FFPCCompatibility write FFPCCompatibility;
161 property SupportedWidgetSet: String read FSupportedWidgetSet write FSupportedWidgetSet;
162 property PackageType: TLazPackageType read FPackageType write FPackageType;
163 property License: String read FLicense write FLicense;
164 property DependenciesAsString: String read GetDependenciesAsString write SetDependenciesAsString;
165 end;
166
167 {TMetaPackage}
168
169 TMetaPackage = class(TCollectionItem)
170 private
171 FName: String;
172 FDisplayName: String;
173 FCategory: String;
174 FCommunityDescription: String;
175 FRepositoryFileName: String;
176 FRepositoryFileSize: Int64;
177 FRepositoryFileHash: String;
178 FChecked: Boolean;
179 FRepositoryDate: TDateTime;
180 FPackageState: TPackageState;
181 FPackageStates: TPackageStates;
182 FPackageBaseDir: String;
183 FHomePageURL: String;
184 FDownloadURL: String;
185 FDownloadZipURL: String;
186 FHasUpdate: Boolean;
187 FDisableInOPM: Boolean;
188 FSVNURL: String;
189 FUpdateSize: Int64;
190 FIsDirZipped: Boolean;
191 FZippedBaseDir: String;
192 FRating: Integer;
193 FLazarusPackages: TCollection;
GetDownloadablenull194 function GetDownloadable: Boolean;
GetExtractablenull195 function GetExtractable: Boolean;
196 public
197 constructor Create; reintroduce;
198 destructor Destroy; override;
199 procedure ChangePackageStates(const AChangeType: TChangeType; APackageState: TPackageState);
FindLazarusPackagenull200 function FindLazarusPackage(const APackageName: String): TLazarusPackage;
201 public
202 property PackageStates: TPackageStates read FPackageStates;
203 property PackageState: TPackageState read FPackageState;
204 property IsDownloadable: Boolean read GetDownloadable;
205 property IsExtractable: Boolean read GetExtractable;
206 property UpdateSize: Int64 read FUpdateSize write FUpdateSize;
207 property IsDirZipped: Boolean read FIsDirZipped write FIsDirZipped;
208 property ZippedBaseDir: String read FZippedBaseDir write FZippedBaseDir;
209 property DownloadZipURL: String read FDownloadZipURL write FDownloadZipURL;
210 property HasUpdate: Boolean read FHasUpdate write FHasUpdate;
211 property DisableInOPM: Boolean read FDisableInOPM write FDisableInOPM;
212 property Rating: Integer read FRating write FRating;
213 published
214 property Name: String read FName write FName;
215 property DisplayName: String read FDisplayName write FDisplayName;
216 property Category: String read FCategory write FCategory;
217 property CommunityDescription: string read FCommunityDescription write FCommunityDescription;
218 property Checked: Boolean read FChecked write FChecked;
219 property RepositoryFileName: String read FRepositoryFileName write FRepositoryFileName;
220 property RepositoryFileSize: int64 read FRepositoryFileSize write FRepositoryFileSize;
221 property RepositoryFileHash: String read FRepositoryFileHash write FRepositoryFileHash;
222 property RepositoryDate: TDateTime read FRepositoryDate write FRepositoryDate;
223 property PackageBaseDir: String read FPackageBaseDir write FPackageBaseDir;
224 property LazarusPackages: TCollection read FLazarusPackages write FLazarusPackages;
225 property HomePageURL: String read FHomePageURL write FHomePageURL;
226 property DownloadURL: String read FDownloadURL write FDownloadURL;
227 property SVNURL: String read FSVNURL write FSVNURL;
228 end;
229
230 { TSerializablePackages }
231
232 TFindPackageBy = (fpbPackageName, fpbRepositoryFilename);
233
234 TSerializablePackages = class
235 private
236 FMetaPackages: TCollection;
237 FLastError: String;
238 FOnProcessJSON: TNotifyEvent;
239 FOnUpdatePackageLinks: TNotifyEvent;
GetCountnull240 function GetCount: Integer;
GetDownloadCountnull241 function GetDownloadCount: Integer;
GetExtractCountnull242 function GetExtractCount: Integer;
GetInstallCountnull243 function GetInstallCount: Integer;
GetItemnull244 function GetItem(const AIndex: Integer): TMetaPackage;
245 procedure SetItem(const AIndex: Integer; const AMetaPackage: TMetaPackage);
246 procedure DoGetPackageDependencies(const APkgFileName: String; ASL: TStringList; ALevel: Integer);
JSONToPackageDatanull247 function JSONToPackageData(const APackageData: TJSONData; var AMetaPackage: TMetaPackage): Boolean;
JSONToLazarusPackagesnull248 function JSONToLazarusPackages(const APackageData: TJSONData; var AMetaPackage: TMetaPackage): Boolean;
PackageDataToJSONnull249 function PackageDataToJSON(AMetaPackage: TMetaPackage; var APackageData: TJSONObject): Boolean;
LazarusPackagesToJSONnull250 function LazarusPackagesToJSON(AMetaPackage: TMetaPackage; var ALazarusPkgsArr: TJSONArray): Boolean;
IsPackageDownloadednull251 function IsPackageDownloaded(const AMetaPackage: TMetaPackage): Boolean;
IsPackageExtractednull252 function IsPackageExtracted(const AMetaPackage: TMetaPackage): Boolean;
IsPackageInstallednull253 function IsPackageInstalled(const ALazarusPkg: TLazarusPackage; const APackageBaseDir: String): Boolean;
AtLeastOneLazPkgInstallednull254 function AtLeastOneLazPkgInstalled(const AMetaPackage: TMetaPackage): Boolean;
GetPackageVersionnull255 function GetPackageVersion(const APath: String): String;
GetPackageDescriptionnull256 function GetPackageDescription(const APath: String): String;
GetPackageLicensenull257 function GetPackageLicense(const APath: String): String;
258 public
259 constructor Create;
260 destructor Destroy; override;
261 public
262 procedure Clear;
AddMetaPackagenull263 function AddMetaPackage(const AName: String): TMetaPackage;
264 procedure DeletePackage(const AIndex: Integer);
AddPackageFromJSONnull265 function AddPackageFromJSON(JSON: TJSONStringType): Boolean;
FindMetaPackagenull266 function FindMetaPackage(const AValue: String; const AFindPackageBy: TFindPackageBy): TMetaPackage;
FindMetaPackageByLazarusPackagenull267 function FindMetaPackageByLazarusPackage(const ALazarusPackage: TLazarusPackage): TMetaPackage;
FindPackageIndexnull268 function FindPackageIndex(const AValue: String; const AFindPackageBy: TFindPackageBy): Integer;
FindLazarusPackagenull269 function FindLazarusPackage(const APackageName: String): TLazarusPackage;
JSONToPackagesnull270 function JSONToPackages(JSON: TJSONStringType): Boolean;
PackagesToJSONnull271 function PackagesToJSON(var JSON: TJSONStringType): Boolean;
272 procedure GetPackageDependencies(const APkgFileName: String; List: TObjectList; Recurse, OnlyUnresolved: Boolean);
273 procedure GetPackageStates;
274 procedure RemoveErrorState;
275 procedure RemoveCheck;
276 procedure MarkRuntimePackages;
Cleanupnull277 function Cleanup: Integer;
IsDependencyOknull278 function IsDependencyOk(PackageDependency: TPackageDependency; DependencyPackage: TLazarusPackage): Boolean;
IsInstalledVersionOknull279 function IsInstalledVersionOk(PackageDependency: TPackageDependency; InstalledVersion: String): Boolean;
GetPackageInstallStatenull280 function GetPackageInstallState(const AMetaPackage: TMetaPackage): Integer; overload;
281 procedure DeleteDownloadedZipFiles;
282 procedure Sort(const ASortType: TSortType; const ASortOrder: TSortOrder);
QuickStatisticsnull283 function QuickStatistics: String;
284 public
285 property Count: Integer read GetCount;
286 property DownloadCount: Integer read GetDownloadCount;
287 property ExtractCount: Integer read GetExtractCount;
288 property InstallCount: Integer read GetInstallCount;
289 property Items[Index: Integer]: TMetaPackage read GetItem write SetItem;
290 property LastError: String read FlastError;
291 property OnProcessJSON: TNotifyEvent read FOnProcessJSON write FOnProcessJSON;
292 property OnUpdatePackageLinks: TNotifyEvent read FOnUpdatePackageLinks write FOnUpdatePackageLinks;
293 end;
294
295 var
296 SerializablePackages: TSerializablePackages = nil;
297
298
299 implementation
300
301 { TPackageDependency }
302
303 procedure TPackageDependency.SetMinVersion(const AValue: TPackageVersion);
304 begin
305 FMinVersion.Assign(AValue);
306 end;
307
308 procedure TPackageDependency.SetMaxVersion(const AValue: TPackageVersion);
309 begin
310 FMaxVersion.Assign(AValue);
311 end;
312
313 procedure TPackageDependency.Assign(ASource: TPersistent);
314 var
315 Source: TPackageDependency;
316 begin
317 if ASource is TPackageDependency then
318 begin
319 Source := ASource as TPackageDependency;
320 FPkgFileName := Source.PkgFileName;
321 if Assigned(Source.MinVersion) then
322 FMinVersion.Assign(Source.MinVersion);
323 if Assigned(Source.MaxVersion) then
324 FMaxVersion.Assign(Source.MaxVersion);
325 end
326 else
327 inherited Assign(Source);
328 end;
329
330 constructor TPackageDependency.Create(ACollection: TCollection);
331 begin
332 inherited Create(ACollection);
333 FMinVersion := TPackageVersion.Create;
334 FMaxVersion := TPackageVersion.Create;
335 end;
336
337 destructor TPackageDependency.Destroy;
338 begin
339 if Assigned(FMinVersion) then
340 FMinVersion.Free;
341 if Assigned(fMaxVersion) then
342 FMaxVersion.Free;
343 inherited Destroy;
344 end;
345
346 { TPackageDependencies }
347
TPackageDependencies.GetDependencynull348 function TPackageDependencies.GetDependency(AIndex: Integer): TPackageDependency;
349 begin
350 Result := TPackageDependency(Items[AIndex]);
351 end;
352
353 procedure TPackageDependencies.SetDependency(AIndex: Integer;
354 const AValue: TPackageDependency);
355 begin
356 Items[AIndex] := AValue;
357 end;
358
TPackageDependencies.GetDependenciesAsStringnull359 function TPackageDependencies.GetDependenciesAsString(const AIsDisplayString: Boolean): String;
360 var
361 I: Integer;
362 MinVer, MaxVer: String;
363 begin
364 Result := '';
365 for I := 0 to Count - 1 do
366 begin
367 MinVer := '';
368 MaxVer := '';
369 if not Dependencies[I].FMinVersion.IsNullVersion then
370 begin
371 if AIsDisplayString then
372 MinVer := '(>=' + IntToStr(Dependencies[I].FMinVersion.Major) + '.' + IntToStr(Dependencies[I].FMinVersion.Minor) + ')'
373 else
374 MinVer := '(' + Dependencies[I].FMinVersion.AsString + ')';
375 end;
376 if not Dependencies[I].FMaxVersion.IsNullVersion then
377 begin
378 if AIsDisplayString then
379 MaxVer := '(<=' + IntToStr(Dependencies[I].FMaxVersion.Major) + '.' + IntToStr(Dependencies[I].FMaxVersion.Minor) + ')'
380 else
381 MaxVer := '(' + Dependencies[I].FMaxVersion.AsString + ')'
382 end;
383 if Result = '' then
384 Result := Dependencies[I].PkgFileName + MinVer + MaxVer
385 else
386 Result := Result + ', ' + Dependencies[I].PkgFileName + MinVer + MaxVer;
387 end;
388 end;
389
390 procedure TPackageDependencies.SetDependenciesAsString(const AValue: String);
391 var
392 PackageDependency: TPackageDependency;
393 SL: TStringList;
394 P1, P2: Integer;
395 Str: String;
396 I: Integer;
397 begin
398 SL := TStringList.Create;
399 try
400 SL.Delimiter := ',';
401 SL.DelimitedText := AValue;
402 for I := 0 to SL.Count - 1 do
403 begin
404 Str := Trim(SL.Strings[I]);
405 PackageDependency := TPackageDependency(Self.Add);
406 if not Assigned(PackageDependency.FMinVersion) then
407 PackageDependency.FMinVersion := TPackageVersion.Create;
408 if not Assigned(PackageDependency.FMaxVersion) then
409 PackageDependency.FMaxVersion := TPackageVersion.Create;
410 P1 := Pos('(', Str);
411 P2 := Pos(')', Str);
412 if (P1 <> 0) and (P2 <> 0) then
413 begin
414 PackageDependency.PkgFileName := Trim(Copy(Str, 1, P1 - 1));
415 PackageDependency.FMinVersion.AsString := Trim(Copy(Str, P1 + 1, P2 - P1 - 1));
416 System.Delete(Str, 1, P2);
417 if Length(Trim(Str)) > 0 then
418 PackageDependency.FMaxVersion.AsString := Trim(Copy(Str, 2, Length(Str) - 2));
419 end
420 else
421 PackageDependency.PkgFileName := Trim(Str);
422 end;
423 finally
424 SL.Free;
425 end;
426 end;
427
428 { TLazarusPackage }
429
TLazarusPackage.GetVersionAsStringnull430 function TLazarusPackage.GetVersionAsString: String;
431 begin
432 Result := IntToStr(FVersion.Major) + '.' + IntToStr(FVersion.Minor) + '.' +
433 IntToStr(FVersion.Release) + '.' + IntToStr(FVersion.Build);
434 end;
435
436 procedure TLazarusPackage.SetVersionAsString(const AValue: String);
437 begin
438 if not Assigned(FVersion) then
439 begin
440 if not Assigned(FVersion) then
441 FVersion := TPackageVersion.Create;
442 FVersion.AsString := AValue;
443 end;
444 FVersionAsString := AValue;
445 end;
446
GetDependenciesAsStringnull447 function TLazarusPackage.GetDependenciesAsString: String;
448 begin
449 Result := FDependencies.GetDependenciesAsString(False);
450 end;
451
452 procedure TLazarusPackage.SetDependenciesAsString(const AValue: String);
453 begin
454 if not Assigned(FDependencies) then
455 begin
456 FDependencies := TPackageDependencies.Create(TPackageDependency);
457 FDependencies.SetDependenciesAsString(AValue);
458 end;
459 FDependenciesAsString := AValue;
460 end;
461
GetInstallablenull462 function TLazarusPackage.GetInstallable: Boolean;
463 begin
464 case PackageAction of
465 paDownloadTo:
466 Result := False;
467 paInstall, paUpdate:
468 Result := (Checked) and
469 (psExtracted in PackageStates) and
470 (not (psError in PackageStates));
471 end;
472 end;
473
474 constructor TLazarusPackage.Create;
475 begin
476 FVersion := TPackageVersion.Create;
477 FVersion.Clear;
478 PackageStates := [];
479 FDependencies := TPackageDependencies.Create(TPackageDependency);
480 end;
481
482 destructor TLazarusPackage.Destroy;
483 begin
484 if Assigned(FVersion) then
485 FreeAndNil(FVersion);
486 if Assigned(FDependencies) then
487 FreeAndNil(FDependencies);
488 inherited Destroy;
489 end;
490
491 procedure TLazarusPackage.RefreshHasUpdate;
492 begin
493 FHasUpdate := (FUpdateVersion <> '') and (FInstalledFileVersion <> '') and
494 (
495 ((not FForceNotify) {and (FUpdateVersion > FInstalledFileVersion)}) or
496 ((FForceNotify) and (FInternalVersion > FInternalVersionOld))
497 );
498 end;
499
500 { TMetaPackage }
GetDownloadablenull501 function TMetaPackage.GetDownloadable: Boolean;
502 begin
503 case PackageAction of
504 paDownloadTo, paUpdate:
505 Result := (Checked) and (not (psError in PackageStates));
506 paInstall:
507 Result := (Checked) and
508 (psRepository in PackageStates) and
509 (not (psError in PackageStates)) and
510 ((Options.ForceDownloadAndExtract) or ((not (psDownloaded in PackageStates)) and (not (psExtracted in PackageStates))));
511 end;
512 end;
513
TMetaPackage.GetExtractablenull514 function TMetaPackage.GetExtractable: Boolean;
515 begin
516 case PackageAction of
517 paDownloadTo, paUpdate:
518 Result := (Checked) and (not (psError in PackageStates));
519 paInstall:
520 Result := (Checked) and
521 (psDownloaded in PackageStates) and
522 (not (psError in PackageStates)) and
523 ((Options.ForceDownloadAndExtract) or ((not (psExtracted in PackageStates)) and (not (psInstalled in PackageStates))));
524 end;
525 end;
526
527 constructor TMetaPackage.Create;
528 begin
529 FLazarusPackages := TCollection.Create(TLazarusPackage);
530 end;
531
532 destructor TMetaPackage.Destroy;
533 var
534 I: Integer;
535 begin
536 FLazarusPackages.Clear;
537 for I := FLazarusPackages.Count - 1 downto 0 do
538 FLazarusPackages.Items[I].Free;
539 FLazarusPackages.Free;
540 inherited Destroy;
541 end;
542
543 procedure TMetaPackage.ChangePackageStates(const AChangeType: TChangeType;
544 APackageState: TPackageState);
545 var
546 I: Integer;
547 LazarusPkg: TLazarusPackage;
548 begin
549 if APackageState = psInstalled then
550 Exit;
551 //propagate states to package files
552 case AChangeType of
553 ctAdd:
554 begin
555 FPackageStates := FPackageStates + [APackageState];
556 for I := 0 to LazarusPackages.Count - 1 do
557 begin
558 LazarusPkg := TLazarusPackage(LazarusPackages.Items[I]);
559 LazarusPkg.PackageStates := LazarusPkg.PackageStates + [APackageState];
560 LazarusPkg.PackageState := APackageState;
561 end;
562 end;
563 ctRemove:
564 begin
565 FPackageStates := FPackageStates - [APackageState];
566 for I := 0 to LazarusPackages.Count - 1 do
567 begin
568 LazarusPkg := TLazarusPackage(LazarusPackages.Items[I]);
569 LazarusPkg.PackageStates := LazarusPkg.PackageStates - [APackageState];
570 end;
571 end;
572 end;
573 end;
574
TMetaPackage.FindLazarusPackagenull575 function TMetaPackage.FindLazarusPackage(const APackageName: String): TLazarusPackage;
576 var
577 I: Integer;
578 begin
579 for I := 0 to FLazarusPackages.Count - 1 do
580 begin
581 Result := TLazarusPackage(FLazarusPackages.Items[I]);
582 if UpperCase(Result.Name) = UpperCase(APackageName) then
583 Exit;
584 end;
585 Result := nil;
586 end;
587
588 { TSerializablePackages }
589
590 constructor TSerializablePackages.Create;
591 begin
592 FMetaPackages := TCollection.Create(TMetaPackage);
593 end;
594
595 destructor TSerializablePackages.Destroy;
596 begin
597 Clear;
598 FMetaPackages.Free;
599 inherited Destroy;
600 end;
601
602 procedure TSerializablePackages.Clear;
603 var
604 I: Integer;
605 begin
606 for I := Count - 1 downto 0 do
607 Items[I].Free;
608 FMetaPackages.Clear;
609 end;
610
GetCountnull611 function TSerializablePackages.GetCount: Integer;
612 begin
613 Result := FMetaPackages.Count;
614 end;
615
TSerializablePackages.GetDownloadCountnull616 function TSerializablePackages.GetDownloadCount: Integer;
617 var
618 I: Integer;
619 begin
620 Result := 0;
621 for I := 0 to Count - 1 do
622 if Items[I].IsDownloadable then
623 Inc(Result);
624 end;
625
TSerializablePackages.GetExtractCountnull626 function TSerializablePackages.GetExtractCount: Integer;
627 var
628 I: Integer;
629 begin
630 Result := 0;
631 for I := 0 to Count - 1 do
632 if Items[I].IsExtractable then
633 Inc(Result);
634 end;
635
GetInstallCountnull636 function TSerializablePackages.GetInstallCount: Integer;
637 var
638 I, J: Integer;
639 begin
640 Result := 0;
641 for I := 0 to Count - 1 do
642 for J := 0 to Items[I].FLazarusPackages.Count - 1 do
643 if TLazarusPackage(Items[I].FLazarusPackages.Items[J]).IsInstallable then
644 Inc(Result);
645 end;
646
GetItemnull647 function TSerializablePackages.GetItem(const AIndex: Integer): TMetaPackage;
648 begin
649 if AIndex > FMetaPackages.Count - 1 then
650 Exit(nil);
651 Result := TMetaPackage(FMetaPackages.Items[AIndex]);
652 end;
653
654 procedure TSerializablePackages.SetItem(const AIndex: Integer; const AMetaPackage: TMetaPackage);
655 begin
656 if AIndex > FMetaPackages.Count - 1 then
657 Exit;
658 FMetaPackages.Items[AIndex] := AMetaPackage;
659 end;
660
661 procedure TSerializablePackages.DoGetPackageDependencies(const APkgFileName: String;
662 ASL: TStringList; ALevel: Integer);
663 var
664 LazarusPkg: TLazarusPackage;
665 D2, D1: TPackageDependency;
666 I, J: Integer;
667 begin
668 if (ALevel > 10) then
669 Exit;
670 LazarusPkg := FindLazarusPackage(APkgFileName);
671 if LazarusPkg = nil then
672 Exit;
673 for I := 0 to LazarusPkg.Dependencies.Count - 1 do
674 begin
675 D1 := LazarusPkg.Dependencies[I];
676 J := ASL.IndexOf(APkgFileName);
677 If J = -1 then
678 begin
679 D2 := TPackageDependency.Create(nil);
680 D2.Assign(D1);
681 ASL.AddObject(D2.PkgFileName, D2);
682 end
683 else
684 begin
685 D2 := ASL.Objects[J] as TPackageDependency;
686 if D1.MinVersion.Compare(D2.MinVersion) > 0 then
687 D2.MinVersion.Assign(D1.MinVersion);
688 end;
689 if (ALevel >= 0) and (J = -1) Then
690 DoGetPackageDependencies(D2.PkgFileName, ASL, ALevel + 1);
691 end;
692 end;
693
AddMetaPackagenull694 function TSerializablePackages.AddMetaPackage(const AName: String): TMetaPackage;
695 var
696 MetaPackage: TMetaPackage;
697 begin
698 MetaPackage := FindMetaPackage(AName, fpbPackageName);
699 if MetaPackage <> nil then
700 begin
701 FLastError := rsMainFrm_PackageNameAlreadyExists;
702 Exit(nil);
703 end;
704 Result := TMetaPackage(FMetaPackages.Add);
705 Result.FLazarusPackages := TCollection.Create(TLazarusPackage);
706 Result.Name := AName;
707 end;
708
709 procedure TSerializablePackages.DeletePackage(const AIndex: Integer);
710 begin
711 if AIndex > FMetaPackages.Count - 1 then
712 Exit;
713 FMetaPackages.Delete(AIndex);
714 end;
715
TSerializablePackages.AddPackageFromJSONnull716 function TSerializablePackages.AddPackageFromJSON(JSON: TJSONStringType): Boolean;
717 var
718 Data: TJSONData;
719 Parser: TJSONParser;
720 I: Integer;
721 MetaPackage: TMetaPackage;
722 begin
723 if Trim(JSON) = '' then
724 Exit(False);
725 Result := True;
726 Parser := TJSONParser.Create(JSON){%H-};
727 try
728 Data := Parser.Parse;
729 try
730 MetaPackage := nil;
731 try
732 if Data.JSONType = jtObject then
733 begin
734 for I := 0 to Data.Count - 1 do
735 begin
736 if Data.Items[I].JSONType = jtObject then
737 begin
738 if not JSONToPackageData(Data.Items[I], MetaPackage) then
739 Result := False;
740 end
741 else if Data.Items[I].JSONType = jtArray then
742 begin
743 if not JSONToLazarusPackages(Data.Items[I], MetaPackage) then
744 Result := False;
745 end;
746 end;
747 end;
748 except
749 Result := False;
750 end;
751 finally
752 Data.Free;
753 end;
754 finally
755 Parser.Free;
756 end;
757 end;
758
TSerializablePackages.FindMetaPackagenull759 function TSerializablePackages.FindMetaPackage(const AValue: String;
760 const AFindPackageBy: TFindPackageBy): TMetaPackage;
761 var
762 I: Integer;
763 NeedToBreak: Boolean;
764 begin
765 Result := nil;
766 for I := 0 to Count - 1 do
767 begin
768 case AFindPackageBy of
769 fpbPackageName: NeedToBreak := UpperCase(Items[I].Name) = UpperCase(AValue);
770 fpbRepositoryFilename: NeedToBreak := UpperCase(Items[I].RepositoryFileName) = UpperCase(AValue)
771 end;
772 if NeedToBreak then
773 begin
774 Result := Items[I];
775 Break;
776 end;
777 end;
778 end;
779
TSerializablePackages.FindMetaPackageByLazarusPackagenull780 function TSerializablePackages.FindMetaPackageByLazarusPackage(
781 const ALazarusPackage: TLazarusPackage): TMetaPackage;
782 var
783 I, J: Integer;
784 begin
785 Result := nil;
786 for I := 0 to Count - 1 do
787 begin
788 for J := 0 to Items[I].FLazarusPackages.Count - 1 do
789 begin
790 if ALazarusPackage.Equals(TLazarusPackage(Items[I].FLazarusPackages.Items[J])) then
791 begin
792 Result := Items[I];
793 Break;
794 end;
795 end;
796 end;
797 end;
798
TSerializablePackages.FindPackageIndexnull799 function TSerializablePackages.FindPackageIndex(const AValue: String;
800 const AFindPackageBy: TFindPackageBy): Integer;
801 var
802 I: Integer;
803 NeedToBreak: Boolean;
804 begin
805 Result := -1;
806 for I := 0 to Count - 1 do
807 begin
808 case AFindPackageBy of
809 fpbPackageName: NeedToBreak := Items[I].Name = AValue;
810 fpbRepositoryFilename: NeedToBreak := Items[I].RepositoryFileName = AValue
811 end;
812 if NeedToBreak then
813 begin
814 Result := I;
815 Break;
816 end;
817 end;
818 end;
819
820
FindLazarusPackagenull821 function TSerializablePackages.FindLazarusPackage(const APackageName: String): TLazarusPackage;
822 var
823 I, J: Integer;
824 begin
825 Result := nil;
826 for I := 0 to Count - 1 do
827 begin
828 for J := 0 to Items[I].FLazarusPackages.Count - 1 do
829 begin
830 if UpperCase(TLazarusPackage(Items[I].FLazarusPackages.Items[J]).Name) = UpperCase(APackageName) then
831 begin
832 Result := TLazarusPackage(Items[I].FLazarusPackages.Items[J]);
833 Break;
834 end;
835 end;
836 end;
837 end;
838
TSerializablePackages.JSONToPackageDatanull839 function TSerializablePackages.JSONToPackageData(const APackageData: TJSONData;
840 var AMetaPackage: TMetaPackage): Boolean;
841 var
842 PackageData: TJSONObject;
843 begin
844 Result := True;
845 try
846 PackageData := TJSONObject(APackageData);
847 AMetaPackage := TMetaPackage(FMetaPackages.Add);
848 //need to change
849 AMetaPackage.Name := PackageData.Get('Name');
850 AMetaPackage.DisplayName := PackageData.Get('DisplayName');
851 AMetaPackage.Category := PackageData.Get('Category');
852 AMetaPackage.CommunityDescription := PackageData.Get('CommunityDescription');
853 AMetaPackage.RepositoryFileName := PackageData.Get('RepositoryFileName');
854 AMetaPackage.RepositoryFileSize := PackageData.Get('RepositoryFileSize');
855 AMetaPackage.RepositoryFileHash := PackageData.Get('RepositoryFileHash');
856 AMetaPackage.RepositoryDate := VarToDateTime(PackageData.Get('RepositoryDate'));
857 AMetaPackage.PackageBaseDir := PackageData.Get('PackageBaseDir');
858 if AMetaPackage.PackageBaseDir <> '' then
859 AMetaPackage.PackageBaseDir := StringReplace(AMetaPackage.PackageBaseDir, '\/', PathDelim, [rfReplaceAll]);;
860 AMetaPackage.HomePageURL := PackageData.Get('HomePageURL');
861 AMetaPackage.DownloadURL := PackageData.Get('DownloadURL');
862 AMetaPackage.SVNURL := PackageData.Get('SVNURL');
863 except
864 on E: Exception do
865 begin
866 Result := False;
867 FlastError := '"' + AMetaPackage.Name + '": ' + E.Message;
868 end;
869 end;
870 end;
871
TSerializablePackages.JSONToLazarusPackagesnull872 function TSerializablePackages.JSONToLazarusPackages(const APackageData: TJSONData;
873 var AMetaPackage: TMetaPackage): Boolean;
874 var
875 LazarusPkgsArr: TJSONArray;
876 LazarusPkgsObj: TJSONObject;
877 LazarusPkg: TLazarusPackage;
878 I: Integer;
879 begin
880 Result := True;
881 try
882 LazarusPkgsArr := TJSONArray(APackageData);
883 AMetaPackage.LazarusPackages := TCollection.Create(TLazarusPackage);
884 for I := 0 to LazarusPkgsArr.Count - 1 do
885 begin
886 if LazarusPkgsArr.Items[I].JSONType = jtObject then
887 begin
888 LazarusPkgsObj := TJSONObject(LazarusPkgsArr.Items[I]);
889 LazarusPkg := TLazarusPackage(AMetaPackage.LazarusPackages.Add);
890 //need to change
891 LazarusPkg.Name := LazarusPkgsObj.Get('Name');
892 LazarusPkg.Description := LazarusPkgsObj.Get('Description');
893 LazarusPkg.Author := LazarusPkgsObj.Get('Author');
894 LazarusPkg.License := LazarusPkgsObj.Get('License');
895 LazarusPkg.PackageRelativePath := LazarusPkgsObj.Get('RelativeFilePath');
896 if LazarusPkg.PackageRelativePath <> '' then
897 LazarusPkg.PackageRelativePath := StringReplace(LazarusPkg.PackageRelativePath, '\/', PathDelim, [rfReplaceAll]);
898 LazarusPkg.VersionAsString := LazarusPkgsObj.Get('VersionAsString');
899 LazarusPkg.LazCompatibility := LazarusPkgsObj.Get('LazCompatibility');
900 LazarusPkg.FPCCompatibility := LazarusPkgsObj.Get('FPCCompatibility');
901 LazarusPkg.SupportedWidgetSet := LazarusPkgsObj.Get('SupportedWidgetSet');
902 LazarusPkg.PackageType := TLazPackageType(LazarusPkgsObj.Get('PackageType'));
903 {the package type wasn't changed in the packagelist.json to preserve compatibility with older versions, we need to convert from old to new
904 Old --> TPackageType = (ptRunAndDesignTime, ptDesignTime, ptRunTime, ptRunTimeOnly);
905 New --> TLazPackageType = (lptRunTime, lptDesignTime, lptRunAndDesignTime, lptRunTimeOnly);}
906 case Ord(LazarusPkg.PackageType) of
907 0: LazarusPkg.PackageType := lptRunAndDesignTime;
908 1: LazarusPkg.PackageType := lptDesignTime;
909 2: LazarusPkg.PackageType := lptRunTime;
910 3: LazarusPkg.PackageType := lptRunTimeOnly;
911 end;
912 LazarusPkg.DependenciesAsString := LazarusPkgsObj.Get('DependenciesAsString');
913 end;
914 end;
915 except
916 on E: Exception do
917 begin
918 Result := False;
919 FlastError := '"' + LazarusPkg.Name + '": ' + E.Message;
920 end;
921 end;
922 end;
923
JSONToPackagesnull924 function TSerializablePackages.JSONToPackages(JSON: TJSONStringType): Boolean;
925 var
926 Data: TJSONData;
927 Parser: TJSONParser;
928 I: Integer;
929 MetaPackage: TMetaPackage;
930 begin
931 Clear;
932 if Trim(JSON) = '' then
933 Exit(False);
934 Result := True;
935 Parser := TJSONParser.Create(JSON){%H-};
936 try
937 Data := Parser.Parse;
938 try
939 MetaPackage := nil;
940 try
941 if Data.JSONType = jtObject then
942 begin
943 for I := 0 to Data.Count - 1 do
944 begin
945 if Assigned(FOnProcessJSON) then
946 FOnProcessJSON(Self);
947 if Data.Items[I].JSONType = jtObject then
948 begin
949 if not JSONToPackageData(Data.Items[I], MetaPackage) then
950 Result := False;
951 end
952 else if Data.Items[I].JSONType = jtArray then
953 begin
954 if not JSONToLazarusPackages(Data.Items[I], MetaPackage) then
955 Result := False;
956 end;
957 end;
958 if Result then
959 GetPackageStates;
960 end;
961 except
962 Result := False;
963 end;
964 finally
965 Data.Free;
966 end;
967 finally
968 Parser.Free;
969 end;
970 if Result then
971 if Assigned(FOnUpdatePackageLinks) then
972 FOnUpdatePackageLinks(Self);
973 end;
974
LazarusPackagesToJSONnull975 function TSerializablePackages.LazarusPackagesToJSON(AMetaPackage: TMetaPackage;
976 var ALazarusPkgsArr: TJSONArray): Boolean;
977 var
978 LazarusPkg: TLazarusPackage;
979 LazarusPkgObj: TJSONObject;
980 I: Integer;
981 RelPath: String;
982 begin
983 Result := True;
984 try
985 ALazarusPkgsArr := TJSONArray.Create;
986 for I := 0 to AMetaPackage.FLazarusPackages.Count - 1 do
987 begin
988 LazarusPkg := TLazarusPackage(AMetaPackage.FLazarusPackages.Items[I]);
989 LazarusPkgObj := TJSONObject.Create;
990 //need to change
991 LazarusPkgObj.Add('Name', LazarusPkg.Name);
992 LazarusPkgObj.Add('Description', LazarusPkg.Description);
993 LazarusPkgObj.Add('Author', LazarusPkg.Author);
994 LazarusPkgObj.Add('License', LazarusPkg.License);
995 RelPath := LazarusPkg.PackageRelativePath;
996 if Trim(RelPath) <> '' then
997 begin
998 RelPath := AppendPathDelim(RelPath);
999 RelPath := StringReplace(RelPath, PathDelim, '\/', [rfReplaceAll]);
1000 end;
1001 LazarusPkgObj.Add('RelativeFilePath', RelPath);
1002 LazarusPkgObj.Add('VersionAsString', LazarusPkg.VersionAsString);
1003 LazarusPkgObj.Add('LazCompatibility', LazarusPkg.LazCompatibility);
1004 LazarusPkgObj.Add('FPCCompatibility', LazarusPkg.FPCCompatibility);
1005 LazarusPkgObj.Add('SupportedWidgetSet', LazarusPkg.SupportedWidgetSet);
1006 {the package type wasn't changed in the packagelist.json to preserve compatibility with older versions, we need to convert from new to old
1007 New --> TLazPackageType = (lptRunTime, lptDesignTime, lptRunAndDesignTime, lptRunTimeOnly);
1008 Old --> TPackageType = (ptRunAndDesignTime, ptDesignTime, ptRunTime, ptRunTimeOnly);}
1009 case Ord(LazarusPkg.PackageType) of
1010 0: LazarusPkg.PackageType := lptRunAndDesignTime;
1011 1: LazarusPkg.PackageType := lptDesignTime;
1012 2: LazarusPkg.PackageType := lptRunTime;
1013 3: LazarusPkg.PackageType := lptRunTimeOnly;
1014 end;
1015 LazarusPkgObj.Add('PackageType', Ord(LazarusPkg.PackageType));
1016 LazarusPkgObj.Add('DependenciesAsString', LazarusPkg.DependenciesAsString);
1017 ALazarusPkgsArr.Add(LazarusPkgObj);
1018 end;
1019 except
1020 on E: Exception do
1021 begin
1022 Result := False;
1023 FlastError := '"' + LazarusPkg.Name + '": ' + E.Message;
1024 end;
1025 end;
1026 end;
1027
TSerializablePackages.IsPackageDownloadednull1028 function TSerializablePackages.IsPackageDownloaded(const AMetaPackage: TMetaPackage): Boolean;
1029 var
1030 FileName: String;
1031 begin
1032 FileName := Options.LocalRepositoryArchiveExpanded + AMetaPackage.RepositoryFileName;
1033 Result := (FileExists(FileName)) and
1034 // (MD5Print(MD5File(FileName)) = AMetaPackage.RepositoryFileHash) and
1035 (FileUtil.FileSize(FileName) = AMetaPackage.RepositoryFileSize);
1036 end;
1037
IsPackageExtractednull1038 function TSerializablePackages.IsPackageExtracted(const AMetaPackage: TMetaPackage): Boolean;
1039 var
1040 I: Integer;
1041 LazarusPkg: TLazarusPackage;
1042 begin
1043 Result := True;
1044 for I := 0 to AMetaPackage.FLazarusPackages.Count - 1 do
1045 begin
1046 LazarusPkg := TLazarusPackage(AMetaPackage.FLazarusPackages.Items[I]);
1047 LazarusPkg.FPackageAbsolutePath := Options.LocalRepositoryPackagesExpanded + AMetaPackage.PackageBaseDir
1048 + LazarusPkg.FPackageRelativePath + LazarusPkg.Name;
1049 if not FileExists(LazarusPkg.FPackageAbsolutePath) then
1050 begin
1051 Result := False;
1052 Break;
1053 end;
1054 end;
1055 end;
1056
TSerializablePackages.GetPackageVersionnull1057 function TSerializablePackages.GetPackageVersion(const APath: String): String;
1058
VersionBoundnull1059 function VersionBound(const AVersion: Integer): Integer;
1060 begin
1061 if AVersion > 9999 then
1062 Result := 9999
1063 else if AVersion < 0 then
1064 Result := 0
1065 else
1066 Result := AVersion;
1067 end;
1068
GetVersionnull1069 function GetVersion(const AXMLConfig: TXMLConfig; const APath: String): String;
1070 var
1071 Major, Minor, Release, Build: Integer;
1072 begin
1073 Major := VersionBound(AXMLConfig.GetValue(APath + '/Major', 0));
1074 Minor := VersionBound(AXMLConfig.GetValue(APath + '/Minor', 0));
1075 Release := VersionBound(AXMLConfig.GetValue(APath + '/Release', 0));
1076 Build := VersionBound(AXMLConfig.GetValue(APath + '/Build', 0));
1077 Result := IntToStr(Major) + '.' + IntToStr(Minor) + '.' + IntToStr(Release) + '.' + IntToStr(Build);
1078 end;
1079
1080 var
1081 XMLConfig: TXMLConfig;
1082 begin
1083 Result := '-';
1084 XMLConfig := TXMLConfig.Create(APath);
1085 try
1086 Result := GetVersion(XMLConfig, 'Package/Version');
1087 finally
1088 XMLConfig.Free;
1089 end;
1090 end;
1091
TSerializablePackages.GetPackageDescriptionnull1092 function TSerializablePackages.GetPackageDescription(const APath: String): String;
1093 var
1094 XMLConfig: TXMLConfig;
1095 begin
1096 Result := '';
1097 XMLConfig := TXMLConfig.Create(APath);
1098 try
1099 Result := XMLConfig.GetValue('Package/Description/Value', '');
1100 finally
1101 XMLConfig.Free;
1102 end;
1103 end;
1104
TSerializablePackages.GetPackageLicensenull1105 function TSerializablePackages.GetPackageLicense(const APath: String): String;
1106 var
1107 XMLConfig: TXMLConfig;
1108 begin
1109 Result := '';
1110 XMLConfig := TXMLConfig.Create(APath);
1111 try
1112 Result := XMLConfig.GetValue('Package/License/Value', '');
1113 finally
1114 XMLConfig.Free;
1115 end;
1116 end;
1117
1118
TSerializablePackages.IsPackageInstallednull1119 function TSerializablePackages.IsPackageInstalled(const ALazarusPkg: TLazarusPackage;
1120 const APackageBaseDir: String): Boolean;
1121
CheckIDEPackagesnull1122 function CheckIDEPackages: Boolean;
1123 var
1124 IDEPkg: TIDEPackage;
1125 PkgExt: String;
1126 PkgName: String;
1127 begin
1128 Result := False;
1129 PkgExt := ExtractFileExt(ALazarusPkg.Name);
1130 PkgName := StringReplace(ALazarusPkg.Name, PkgExt, '', [rfIgnoreCase]);
1131 IDEPkg := PackageEditingInterface.IsPackageInstalled(PkgName);
1132 if IDEPkg <> nil then
1133 begin
1134 ALazarusPkg.InstalledFileName := IDEPkg.Filename;
1135 ALazarusPkg.InstalledFileVersion := IntToStr(IDEPkg.Version.Major) + '.' +
1136 IntToStr(IDEPkg.Version.Minor) + '.' +
1137 IntToStr(IDEPkg.Version.Release) + '.' +
1138 IntToStr(IDEPkg.Version.Build);
1139 if FileExists(ALazarusPkg.InstalledFileName) then
1140 begin
1141 ALazarusPkg.InstalledFileDescription := GetPackageDescription(IDEPkg.Filename);
1142 ALazarusPkg.InstalledFileLincese := GetPackageLicense(IDEPkg.Filename);
1143 end;
1144 Result := True;
1145 end;
1146 end;
1147
1148 var
1149 FileName, RepoPath: String;
1150 begin
1151 Result := False;
1152 case ALazarusPkg.PackageType of
1153 lptRunTime, lptRunTimeOnly:
1154 begin
1155 FileName := StringReplace(ALazarusPkg.Name, '.lpk', '.opkman', [rfIgnoreCase]);
1156 RepoPath := Options.LocalRepositoryPackagesExpanded + APackageBaseDir + ALazarusPkg.PackageRelativePath;
1157 Result := (psExtracted in ALazarusPkg.PackageStates) and FileExists(RepoPath + FileName);
1158 if Result then
1159 begin
1160 ALazarusPkg.InstalledFileName := RepoPath + ALazarusPkg.Name;
1161 if FileExists(ALazarusPkg.InstalledFileName) then
1162 begin
1163 ALazarusPkg.InstalledFileVersion := GetPackageVersion(ALazarusPkg.InstalledFileName);
1164 ALazarusPkg.InstalledFileDescription := GetPackageDescription(ALazarusPkg.InstalledFileName);
1165 ALazarusPkg.InstalledFileLincese := GetPackageLicense(ALazarusPkg.InstalledFileName);
1166 end;
1167 end
1168 else
1169 Result := CheckIDEPackages
1170 end;
1171 lptDesignTime, lptRunAndDesignTime:
1172 begin
1173 Result := CheckIDEPackages
1174 end;
1175 end;
1176 end;
1177
GetPackageInstallStatenull1178 function TSerializablePackages.GetPackageInstallState(const AMetaPackage: TMetaPackage): Integer;
1179 var
1180 I: Integer;
1181 LazarusPkg: TLazarusPackage;
1182 InstCnt: Integer;
1183 begin
1184 InstCnt := 0;
1185 for I := 0 to AMetaPackage.LazarusPackages.Count - 1 do
1186 begin
1187 LazarusPkg := TLazarusPackage(AMetaPackage.LazarusPackages.Items[I]);
1188 if IsPackageInstalled(LazarusPkg, AMetaPackage.PackageBaseDir) then
1189 Inc(InstCnt);
1190 end;
1191 case InstCnt of
1192 0: Result := 0;
1193 1..High(Integer):
1194 if InstCnt < AMetaPackage.LazarusPackages.Count then
1195 Result := 2
1196 else
1197 Result := 1;
1198 end;
1199 end;
1200
TSerializablePackages.PackageDataToJSONnull1201 function TSerializablePackages.PackageDataToJSON(AMetaPackage: TMetaPackage;
1202 var APackageData: TJSONObject): Boolean;
1203 var
1204 PackageBaseDir: String;
1205 begin
1206 //need to change
1207 Result := True;
1208 try
1209 APackageData := TJSONObject.Create;
1210 APackageData.Add('Name', AMetaPackage.Name);
1211 APackageData.Add('DisplayName', AMetaPackage.DisplayName);
1212 APackageData.Add('Category', AMetaPackage.Category);
1213 APackageData.Add('CommunityDescription', AMetaPackage.CommunityDescription);
1214 APackageData.Add('RepositoryFileName', AMetaPackage.RepositoryFileName);
1215 APackageData.Add('RepositoryFileSize', AMetaPackage.RepositoryFileSize);
1216 APackageData.Add('RepositoryFileHash', AMetaPackage.RepositoryFileHash);
1217 APackageData.Add('RepositoryDate', AMetaPackage.RepositoryDate);
1218 PackageBaseDir := AMetaPackage.PackageBaseDir;
1219 if Trim(PackageBaseDir) <> '' then
1220 begin
1221 PackageBaseDir := AppendPathDelim(PackageBaseDir);
1222 PackageBaseDir := StringReplace(PackageBaseDir, PathDelim, '\/', [rfReplaceAll]);
1223 end;
1224 APackageData.Add('PackageBaseDir', PackageBaseDir);
1225 APackageData.Add('HomePageURL', AMetaPackage.HomePageURL);
1226 APackageData.Add('DownloadURL', AMetaPackage.DownloadURL);
1227 APackageData.Add('SVNURL', AMetaPackage.SVNURL);
1228 except
1229 on E: Exception do
1230 begin
1231 Result := False;
1232 FlastError := '"' + AMetaPackage.Name + '": ' + E.Message;
1233 end;
1234 end;
1235 end;
1236
PackagesToJSONnull1237 function TSerializablePackages.PackagesToJSON(var JSON: TJSONStringType): Boolean;
1238 var
1239 PackageObject: TJSONObject;
1240 PackageData: TJSONObject;
1241 LazarusPkgsArr: TJSONArray;
1242 I: Integer;
1243 MetaPackage: TMetaPackage;
1244 begin
1245 Result := True;
1246 PackageObject := TJSONObject.Create;
1247 try
1248 LazarusPkgsArr := nil;
1249 PackageData := nil;
1250 try
1251 for I := 0 to FMetaPackages.Count - 1 do
1252 begin
1253 MetaPackage := TMetaPackage(FMetaPackages.Items[I]);
1254 if not LazarusPackagesToJSON(MetaPackage, LazarusPkgsArr) then
1255 Result := False;
1256 if not PackageDataToJSON(MetaPackage, PackageData) then
1257 Result := False;
1258 PackageObject.Add('PackageData' + IntToStr(I), PackageData);
1259 PackageObject.Add('PackageFiles' + IntToStr(I), LazarusPkgsArr);
1260 end;
1261 if Result then
1262 JSON := PackageObject.FormatJSON(DefaultFormat, DefaultIndentSize);
1263 except
1264 Result := False;
1265 end;
1266 finally
1267 PackageObject.Free;
1268 end;
1269 end;
1270
1271 procedure TSerializablePackages.GetPackageDependencies(const APkgFileName: String;
1272 List: TObjectList; Recurse, OnlyUnresolved: Boolean);
1273 var
1274 SL: TStringList;
1275 I, J: Integer;
1276 PackageName: String;
1277 Installed: Boolean;
1278 IDEPackage: TIDEPackage;
1279 LazarusPkg: TLazarusPackage;
1280 begin
1281 SL := TStringList.Create;
1282 try
1283 SL.Sorted := True;
1284 DoGetPackageDependencies(APkgFileName, SL, Ord(Recurse) - 1);
1285 if OnlyUnresolved then
1286 begin
1287 for I := SL.Count - 1 downto 0 do
1288 begin
1289 PackageName := TPackageDependency(SL.Objects[I]).PkgFileName + '.lpk';
1290 Installed := False;
1291 for J := 0 to PackageEditingInterface.GetPackageCount - 1 do
1292 begin
1293 IDEPackage := PackageEditingInterface.GetPackages(J);
1294 if UpperCase(ExtractFileName(IDEPackage.Filename)) = UpperCase(PackageName) then
1295 begin
1296 LazarusPkg := FindLazarusPackage(PackageName);
1297 if LazarusPkg <> nil then
1298 Installed := IsInstalledVersionOk(TPackageDependency(SL.Objects[I]), LazarusPkg.InstalledFileVersion)
1299 else
1300 Installed := True;
1301 Break;
1302 end;
1303 end;
1304 if Installed then
1305 SL.Objects[I].Free
1306 else
1307 List.Add(SL.Objects[I])
1308 end;
1309 end
1310 else
1311 for I := 0 to SL.Count - 1 do
1312 List.Add(SL.Objects[I]);
1313 finally
1314 SL.Free;
1315 end;
1316 end;
1317
1318 procedure TSerializablePackages.GetPackageStates;
1319 var
1320 I, J: Integer;
1321 LazarusPkg: TLazarusPackage;
1322 begin
1323 for I := 0 to Count - 1 do
1324 begin
1325 Items[I].FPackageState := psRepository;
1326 Items[I].ChangePackageStates(ctAdd, psRepository);
1327
1328 if IsPackageDownloaded(Items[I]) then
1329 Items[I].ChangePackageStates(ctAdd, psDownloaded)
1330 else
1331 Items[I].ChangePackageStates(ctRemove, psDownloaded);
1332
1333
1334 if IsPackageExtracted(Items[I]) then
1335 Items[I].ChangePackageStates(ctAdd, psExtracted)
1336 else
1337 Items[I].ChangePackageStates(ctRemove, psExtracted);
1338
1339 for J := 0 to Items[I].FLazarusPackages.Count - 1 do
1340 begin
1341 LazarusPkg := TLazarusPackage(Items[I].FLazarusPackages.Items[J]);
1342 if IsPackageInstalled(LazarusPkg, Items[I].PackageBaseDir) then
1343 begin
1344 LazarusPkg.PackageStates := LazarusPkg.PackageStates + [psInstalled];
1345 LazarusPkg.PackageState := psInstalled;
1346 end
1347 else
1348 LazarusPkg.PackageStates := LazarusPkg.PackageStates - [psInstalled];
1349 end;
1350 end;
1351 end;
1352
1353 procedure TSerializablePackages.RemoveErrorState;
1354 var
1355 I, J: Integer;
1356 LazarusPkg: TLazarusPackage;
1357 begin
1358 for I := 0 to Count - 1 do
1359 begin
1360 if psError in Items[I].PackageStates then
1361 Items[I].ChangePackageStates(ctRemove, psError);
1362 for J := 0 to Items[I].FLazarusPackages.Count - 1 do
1363 begin
1364 LazarusPkg := TLazarusPackage(Items[I].FLazarusPackages.Items[J]);
1365 if psError in LazarusPkg.PackageStates then
1366 LazarusPkg.PackageStates := LazarusPkg.PackageStates - [psError];
1367 end;
1368 end;
1369 end;
1370
1371 procedure TSerializablePackages.RemoveCheck;
1372 var
1373 I, J: Integer;
1374 MetaPkg: TMetaPackage;
1375 LazarusPkg: TLazarusPackage;
1376 begin
1377 for I := 0 to Count - 1 do
1378 begin
1379 MetaPkg := TMetaPackage(Items[I]);
1380 MetaPkg.Checked := False;
1381 for J := 0 to Items[I].FLazarusPackages.Count - 1 do
1382 begin
1383 LazarusPkg := TLazarusPackage(Items[I].FLazarusPackages.Items[J]);
1384 LazarusPkg.Checked := False;
1385 end;
1386 end;
1387 end;
1388
1389 procedure TSerializablePackages.MarkRuntimePackages;
1390 var
1391 I, J: Integer;
1392 FileName: String;
1393 LazarusPkg: TLazarusPackage;
1394 begin
1395 for I := 0 to Count - 1 do
1396 begin
1397 for J := 0 to Items[I].FLazarusPackages.Count - 1 do
1398 begin
1399 LazarusPkg := TLazarusPackage(Items[I].FLazarusPackages.Items[J]);
1400 if (LazarusPkg.Checked) and
1401 (psInstalled in LazarusPkg.PackageStates) and
1402 (not (psError in LazarusPkg.PackageStates)) and
1403 (LazarusPkg.PackageType in [lptRunTime, lptRunTimeOnly]) then
1404 begin
1405 FileName := StringReplace(LazarusPkg.Name, '.lpk', '.opkman', [rfIgnoreCase]);
1406 FileCreate(Options.LocalRepositoryPackagesExpanded + Items[I].PackageBaseDir + LazarusPkg.PackageRelativePath + FileName);
1407 end;
1408 end;
1409 end;
1410 end;
1411
AtLeastOneLazPkgInstallednull1412 function TSerializablePackages.AtLeastOneLazPkgInstalled(const AMetaPackage: TMetaPackage): Boolean;
1413 var
1414 I: Integer;
1415 begin
1416 Result := False;
1417 for I := 0 to AMetaPackage.LazarusPackages.Count - 1 do
1418 begin
1419 if IsPackageInstalled(TLazarusPackage(AMetaPackage.FLazarusPackages.Items[I]), AMetaPackage.PackageBaseDir) then
1420 begin
1421 Result := True;
1422 Break;
1423 end;
1424 end;
1425 end;
1426
Cleanupnull1427 function TSerializablePackages.Cleanup: Integer;
1428 var
1429 I: Integer;
1430 AlreadyCounted: Boolean;
1431 begin
1432 Result := 0;
1433 for I := 0 to Count - 1 do
1434 begin
1435 if not AtLeastOneLazPkgInstalled(Items[I]) then
1436 begin
1437 AlreadyCounted := False;
1438 if IsPackageDownloaded(Items[I]) then
1439 begin
1440 if DeleteFile(Options.LocalRepositoryArchiveExpanded + Items[I].RepositoryFileName) then
1441 begin
1442 Inc(Result);
1443 AlreadyCounted := True;
1444 end;
1445 end;
1446 if IsPackageExtracted(Items[I]) then
1447 begin
1448 if DirectoryExists(Options.LocalRepositoryPackagesExpanded + Items[I].PackageBaseDir) then
1449 begin
1450 DeleteDirectory(Options.LocalRepositoryPackagesExpanded + Items[I].PackageBaseDir, False);
1451 if not AlreadyCounted then
1452 Inc(Result);
1453 end;
1454 end;
1455 end;
1456 end;
1457 end;
1458
1459 procedure TSerializablePackages.DeleteDownloadedZipFiles;
1460 var
1461 I: Integer;
1462 begin
1463 for I := 0 to Count - 1 do
1464 begin
1465 case PackageAction of
1466 paInstall:
1467 begin
1468 if IsPackageDownloaded(Items[I]) then
1469 DeleteFile(Options.LocalRepositoryArchiveExpanded + Items[I].RepositoryFileName)
1470 end;
1471 paUpdate:
1472 begin
1473 if FileExists(Options.LocalRepositoryUpdateExpanded + Items[I].RepositoryFileName) then
1474 DeleteFile(Options.LocalRepositoryUpdateExpanded + Items[I].RepositoryFileName)
1475 end;
1476 end;
1477 end;
1478 end;
1479
SortByNameAscnull1480 function SortByNameAsc(Item1, Item2: TCollectionItem): Integer;
1481 var
1482 Package1, Package2: TMetaPackage;
1483 begin
1484 Package1 := TMetaPackage(Item1);
1485 Package2 := TMetaPackage(Item2);
1486 Result := CompareText(Package1.FDisplayName, Package2.FDisplayName);
1487 end;
1488
SortByNameDscnull1489 function SortByNameDsc(Item1, Item2: TCollectionItem): Integer;
1490 var
1491 Package1, Package2: TMetaPackage;
1492 begin
1493 Package1 := TMetaPackage(Item1);
1494 Package2 := TMetaPackage(Item2);
1495 Result := CompareText(Package2.FDisplayName, Package1.FDisplayName);
1496 end;
1497
SortByDateAscnull1498 function SortByDateAsc(Item1, Item2: TCollectionItem): Integer;
1499 var
1500 Package1, Package2: TMetaPackage;
1501 begin
1502 Package1 := TMetaPackage(Item1);
1503 Package2 := TMetaPackage(Item2);
1504 Result := CompareDateTime(Package1.RepositoryDate, Package2.RepositoryDate);
1505 end;
1506
SortByDateDscnull1507 function SortByDateDsc(Item1, Item2: TCollectionItem): Integer;
1508 var
1509 Package1, Package2: TMetaPackage;
1510 begin
1511 Package1 := TMetaPackage(Item1);
1512 Package2 := TMetaPackage(Item2);
1513 Result := CompareDateTime(Package2.RepositoryDate, Package1.RepositoryDate);
1514 end;
1515
1516 procedure TSerializablePackages.Sort(const ASortType: TSortType;
1517 const ASortOrder: TSortOrder);
1518 begin
1519 case ASortType of
1520 stName:
1521 if ASortOrder = soAscendent then
1522 FMetaPackages.Sort(@SortByNameAsc)
1523 else if ASortOrder = soDescendent then
1524 FMetaPackages.Sort(@SortByNameDsc);
1525 stDate:
1526 if ASortOrder = soAscendent then
1527 FMetaPackages.Sort(@SortByDateAsc)
1528 else if ASortOrder = soDescendent then
1529 FMetaPackages.Sort(@SortByDateDsc)
1530 end;
1531 end;
1532
TSerializablePackages.QuickStatisticsnull1533 function TSerializablePackages.QuickStatistics: String;
1534 var
1535 I, J: Integer;
1536 LazPackCnt: Integer;
1537 TotSize: Int64;
1538 begin
1539 LazPackCnt := 0;
1540 TotSize := 0;
1541 for I := 0 to Count - 1 do
1542 begin
1543 TotSize := TotSize + Items[I].RepositoryFileSize;
1544 for J := 0 to Items[I].FLazarusPackages.Count - 1 do
1545 Inc(LazPackCnt);
1546 end;
1547 Result := Format(rsPackagesFound, [IntToStr(SerializablePackages.Count), IntToStr(LazPackCnt), FormatSize(TotSize)]);
1548 end;
1549
TSerializablePackages.IsDependencyOknull1550 function TSerializablePackages.IsDependencyOk(PackageDependency: TPackageDependency;
1551 DependencyPackage: TLazarusPackage): Boolean;
1552 var
1553 MinVerOk: Boolean;
1554 MaxVerOk: Boolean;
1555 begin
1556 if PackageDependency.MinVersion.IsNullVersion then
1557 MinVerOk := True
1558 else
1559 MinVerOk := PackageDependency.MinVersion.Compare(DependencyPackage.Version) <= 0;
1560
1561 if PackageDependency.MaxVersion.IsNullVersion then
1562 MaxVerOk := True
1563 else
1564 MaxVerOk := PackageDependency.MaxVersion.Compare(DependencyPackage.Version) >= 0;
1565
1566 Result := (MinVerOk) and (MaxVerOk)
1567 end;
1568
IsInstalledVersionOknull1569 function TSerializablePackages.IsInstalledVersionOk(PackageDependency: TPackageDependency;
1570 InstalledVersion: String): Boolean;
1571 var
1572 MinVerOk: Boolean;
1573 MaxVerOk: Boolean;
1574 begin
1575 if PackageDependency.MinVersion.IsNullVersion then
1576 MinVerOk := True
1577 else
1578 MinVerOk := PackageDependency.MinVersion.AsString <= InstalledVersion;
1579
1580 if PackageDependency.MaxVersion.IsNullVersion then
1581 MaxVerOk := True
1582 else
1583 MaxVerOk := PackageDependency.MaxVersion.AsString >= InstalledVersion;
1584
1585 Result := (MinVerOk) and (MaxVerOk)
1586 end;
1587
1588 end.
1589
1590