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 This unit allows OPM to interact with the Lazarus package system}
24
25 unit opkman_intf;
26
27 {$mode objfpc}{$H+}
28
29 interface
30
31 uses
32 Classes, SysUtils, Forms, Dialogs, Controls, contnrs, fpjson,
33 // IdeIntf
34 LazIDEIntf, PackageIntf, PackageLinkIntf, PackageDependencyIntf, IDECommands,
35 // OPM
36 opkman_timer, opkman_downloader, opkman_serializablepackages, opkman_installer;
37
38 type
39
40 { TOPMInterfaceEx }
41
42 TOPMInterfaceEx = class(TOPMInterface)
43 private
44 FPackagesToDownload: TObjectList;
45 FPackagesToInstall: TObjectList;
46 FPackageDependecies: TObjectList;
47 FPackageLinks: TObjectList;
48 FWaitForIDE: TThreadTimer;
49 FNeedToInit: Boolean;
50 FBusyUpdating: Boolean;
51 procedure DoWaitForIDE(Sender: TObject);
52 procedure DoUpdatePackageLinks(Sender: TObject);
53 procedure InitOPM;
54 procedure SynchronizePackages;
55 procedure AddToDownloadList(const AName: String);
56 procedure AddToInstallList(const AName: String);
Downloadnull57 function Download(const ADstDir: String): TModalResult;
Extractnull58 function Extract(const ASrcDir, ADstDir: String; const AIsUpdate: Boolean = False): TModalResult;
Installnull59 function Install(var AInstallStatus: TInstallStatus; var ANeedToRebuild: Boolean): TModalResult;
ResolveDependenciesnull60 function ResolveDependencies: TModalResult;
CanInstallPackagesnull61 function CanInstallPackages: TModalResult;
62 public
63 constructor Create;
64 destructor Destroy; override;
65 public
DownloadPackagesnull66 function DownloadPackages(APkgLinks: TList): TModalResult; override;
InstallPackagesnull67 function InstallPackages(APkgLinks: TList; var ANeedToRebuild: Boolean): TModalResult; override;
IsPackageAvailablenull68 function IsPackageAvailable(APkgLink: TPackageLink; AType: Integer): Boolean; override;
FindOnlineLinknull69 function FindOnlineLink(const AName: String): TPackageLink; override;
70 end;
71
72 implementation
73
74 uses opkman_common, opkman_options, opkman_const, opkman_progressfrm, opkman_zipper,
75 opkman_intf_PackageListFrm;
76
77 { TOPMInterfaceEx }
78
79 constructor TOPMInterfaceEx.Create;
80 begin
81 FPackageLinks := TObjectList.Create(False);
82 FPackagesToDownload := TObjectList.Create(False);
83 FPackagesToInstall := TObjectList.Create(False);
84 FPackageDependecies := TObjectList.Create(False);
85 FNeedToInit := True;
86 FWaitForIDE := TThreadTimer.Create;
87 FWaitForIDE.Interval := 100;
88 FWaitForIDE.OnTimer := @DoWaitForIDE;
89 FWaitForIDE.StartTimer;
90 end;
91
92 destructor TOPMInterfaceEx.Destroy;
93 begin
94 if (PackageDownloader<>nil) and PackageDownloader.DownloadingJSON then
95 PackageDownloader.Cancel;
96 FWaitForIDE.StopTimer;
97 FWaitForIDE.Terminate;
98 FWaitForIDE.WaitFor;
99 FPackageLinks.Clear;
100 FPackageLinks.Free;
101 FPackagesToDownload.Clear;
102 FPackagesToDownload.Free;
103 FPackagesToInstall.Clear;
104 FPackagesToInstall.Free;
105 FPackageDependecies.Clear;
106 FPackageDependecies.Free;
107 PackageDownloader.Free;
108 SerializablePackages.Free;
109 Options.Free;
110 InstallPackageList.Free;
111 inherited Destroy;
112 end;
113
114 procedure TOPMInterfaceEx.DoWaitForIDE(Sender: TObject);
115 begin
116 if Assigned(LazarusIDE) and Assigned(PackageEditingInterface) then
117 begin
118 if FNeedToInit then
119 begin
120 InitOPM;
121 FNeedToInit := False;
122 FWaitForIDE.StopTimer;
123 FWaitForIDE.Interval := 5000;
124 FWaitForIDE.StartTimer;
125 end
126 else
127 begin
128 if (FPackageLinks.Count = 0) then
129 begin
130 if (not PackageDownloader.DownloadingJSON) and (not Application.Terminated) and (Options.CheckForUpdates <> 5) then
131 PackageDownloader.DownloadJSON(Options.ConTimeOut*1000, True);
132 Exit;
133 end;
134 if (not Application.terminated) then
135 if (not FBusyUpdating) then
136 if (Assigned(OnPackageListAvailable)) then
137 OnPackageListAvailable(Self);
138 end;
139 end;
140 end;
141
142 procedure TOPMInterfaceEx.InitOPM;
143 begin
144 InitLocalRepository;
145 Options := TOptions.Create(LocalRepositoryConfigFile);
146 SerializablePackages := TSerializablePackages.Create;
147 SerializablePackages.OnUpdatePackageLinks := @DoUpdatePackageLinks;
148 PackageDownloader := TPackageDownloader.Create(Options.RemoteRepository[Options.ActiveRepositoryIndex]);
149 InstallPackageList := TObjectList.Create(True);
150 end;
151
152 procedure TOPMInterfaceEx.DoUpdatePackageLinks(Sender: TObject);
153 begin
154 SynchronizePackages;
155 end;
156
TOPMInterfaceEx.FindOnlineLinknull157 function TOPMInterfaceEx.FindOnlineLink(const AName: String): TPackageLink;
158 var
159 I: Integer;
160 PackageLink: TPackageLink;
161 begin
162 Result := nil;
163 for I := 0 to FPackageLinks.Count - 1 do
164 begin
165 PackageLink := TPackageLink(FPackageLinks.Items[I]);
166 if UpperCase(PackageLink.Name) = UpperCase(AName) then
167 begin
168 Result := PackageLink;
169 Break;
170 end;
171 end;
172 end;
173
174 procedure TOPMInterfaceEx.SynchronizePackages;
175 var
176 I, J: Integer;
177 MetaPackage: TMetaPackage;
178 LazPackage: TLazarusPackage;
179 PackageLink: TPackageLink;
180 FileName, Name, URL: String;
181 begin
182 if FBusyUpdating then
183 Exit;
184 FBusyUpdating := True;
185 try
186 PkgLinks.ClearOnlineLinks;
187 FPackageLinks.Clear;
188 for I := 0 to SerializablePackages.Count - 1 do
189 begin
190 MetaPackage := SerializablePackages.Items[I];
191 for J := 0 to MetaPackage.LazarusPackages.Count - 1 do
192 begin
193 LazPackage := TLazarusPackage(MetaPackage.LazarusPackages.Items[J]);
194 FileName := Options.LocalRepositoryPackagesExpanded + MetaPackage.PackageBaseDir + LazPackage.PackageRelativePath + LazPackage.Name;
195 Name := StringReplace(LazPackage.Name, '.lpk', '', [rfReplaceAll, rfIgnoreCase]);
196 URL := Options.RemoteRepository[Options.ActiveRepositoryIndex] + MetaPackage.RepositoryFileName;
197 PackageLink := FindOnlineLink(Name);
198 if PackageLink = nil then
199 begin
200 PackageLink := PkgLinks.AddOnlineLink(FileName, Name, URL);
201 if PackageLink <> nil then
202 begin
203 PackageLink.Version.Assign(LazPackage.Version);
204 PackageLink.PackageType := LazPackage.PackageType;
205 PackageLink.OPMFileDate := MetaPackage.RepositoryDate;
206 PackageLink.Author := LazPackage.Author;
207 PackageLink.Description := LazPackage.Description;
208 PackageLink.License := LazPackage.License;
209 FPackageLinks.Add(PackageLink);
210 end;
211 end;
212 end;
213 end;
214 finally
215 FBusyUpdating := False;
216 end;
217 end;
218
219 procedure TOPMInterfaceEx.AddToDownloadList(const AName: String);
220 var
221 I, J: Integer;
222 MetaPackage: TMetaPackage;
223 LazPackage: TLazarusPackage;
224 begin
225 for I := 0 to SerializablePackages.Count - 1 do
226 begin
227 MetaPackage := SerializablePackages.Items[I];
228 for J := 0 to MetaPackage.LazarusPackages.Count - 1 do
229 begin
230 LazPackage := TLazarusPackage(MetaPackage.LazarusPackages.Items[J]);
231 if UpperCase(LazPackage.Name) = UpperCase(AName) then
232 begin
233 LazPackage.Checked := True;
234 MetaPackage.Checked := True;
235 FPackagesToInstall.Add(LazPackage);
236 Break;
237 end;
238 end;
239 end;
240 end;
241
242 procedure TOPMInterfaceEx.AddToInstallList(const AName: String);
243 var
244 I, J: Integer;
245 MetaPackage: TMetaPackage;
246 LazPackage: TLazarusPackage;
247 begin
248 for I := 0 to SerializablePackages.Count - 1 do
249 begin
250 MetaPackage := SerializablePackages.Items[I];
251 for J := 0 to MetaPackage.LazarusPackages.Count - 1 do
252 begin
253 LazPackage := TLazarusPackage(MetaPackage.LazarusPackages.Items[J]);
254 if UpperCase(LazPackage.Name) = UpperCase(AName) then
255 begin
256 FPackagesToInstall.Add(LazPackage);
257 Break;
258 end;
259 end;
260 end;
261 end;
262
ResolveDependenciesnull263 function TOPMInterfaceEx.ResolveDependencies: TModalResult;
264 var
265 I, J: Integer;
266 PackageList: TObjectList;
267 PkgFileName: String;
268 DependencyPkg: TLazarusPackage;
269 MetaPkg: TMetaPackage;
270 Msg: String;
271 begin
272 Result := mrNone;
273 FPackageDependecies.Clear;
274 for I := 0 to FPackagesToInstall.Count - 1 do
275 begin
276 PackageList := TObjectList.Create(True);
277 try
278 SerializablePackages.GetPackageDependencies(TLazarusPackage(FPackagesToInstall.Items[I]).Name, PackageList, True, True);
279 for J := 0 to PackageList.Count - 1 do
280 begin
281 PkgFileName := TPackageDependency(PackageList.Items[J]).PkgFileName + '.lpk';
282 DependencyPkg := SerializablePackages.FindLazarusPackage(PkgFileName);
283 if DependencyPkg <> nil then
284 begin
285 if (not DependencyPkg.Checked) and
286 (UpperCase(TLazarusPackage(FPackagesToInstall.Items[I]).Name) <> UpperCase(PkgFileName)) and
287 ((SerializablePackages.IsDependencyOk(TPackageDependency(PackageList.Items[J]), DependencyPkg)) and
288 ((not (DependencyPkg.PackageState = psInstalled)) or ((DependencyPkg.PackageState = psInstalled) and (not (SerializablePackages.IsInstalledVersionOk(TPackageDependency(PackageList.Items[J]), DependencyPkg.InstalledFileVersion)))))) then
289 begin
290 if (Result = mrNone) or (Result = mrYes) then
291 begin
292 Msg := Format(rsMainFrm_rsPackageDependency0, [TLazarusPackage(FPackagesToInstall.Items[I]).Name, DependencyPkg.Name]);
293 Result := MessageDlgEx(Msg, mtConfirmation, [mbYes, mbYesToAll, mbNo, mbNoToAll, mbCancel], nil);
294 if Result in [mrNo, mrNoToAll] then
295 if MessageDlgEx(rsMainFrm_rsPackageDependency1, mtInformation, [mbYes, mbNo], nil) <> mrYes then
296 Exit(mrCancel);
297 if (Result = mrNoToAll) or (Result = mrCancel) then
298 Exit(mrCancel);
299 end;
300 if Result in [mrYes, mrYesToAll] then
301 begin
302 DependencyPkg.Checked := True;
303 MetaPkg := SerializablePackages.FindMetaPackageByLazarusPackage(DependencyPkg);
304 if MetaPkg <> nil then
305 MetaPkg.Checked := True;
306 FPackageDependecies.Add(DependencyPkg);
307 end;
308 end;
309 end;
310 end;
311 finally
312 PackageList.Free;
313 end;
314 end;
315 Result := mrOk;
316 end;
317
CanInstallPackagesnull318 function TOPMInterfaceEx.CanInstallPackages: TModalResult;
319 var
320 I: Integer;
321 LazarusPkg: TLazarusPackage;
322 MetaPkg: TMetaPackage;
323 begin
324 Result := mrCancel;
325 IntfPackageListFrm := TIntfPackageListFrm.Create(nil);
326 try
327 IntfPackageListFrm.Position := poWorkAreaCenter;
328 IntfPackageListFrm.PopulateTree(FPackagesToInstall);
329 IntfPackageListFrm.ShowModal;
330 if IntfPackageListFrm.ModalResult = mrOk then
331 begin
332 for I := FPackagesToInstall.Count - 1 downto 0 do
333 begin
334 LazarusPkg := TLazarusPackage(FPackagesToInstall.Items[I]);
335 if IntfPackageListFrm.IsLazarusPackageChecked(LazarusPkg.Name) then
336 begin
337 LazarusPkg.Checked := True;
338 MetaPkg := SerializablePackages.FindMetaPackageByLazarusPackage(LazarusPkg);
339 if MetaPkg <> nil then
340 MetaPkg.Checked := True;
341 end
342 else
343 FPackagesToInstall.Delete(I);
344 end;
345 if FPackagesToInstall.Count > 0 then
346 Result := mrOK;
347 end;
348 finally
349 IntfPackageListFrm.Free;
350 end;
351 end;
352
TOPMInterfaceEx.Downloadnull353 function TOPMInterfaceEx.Download(const ADstDir: String): TModalResult;
354 begin
355 ProgressFrm := TProgressFrm.Create(nil);
356 try
357 ProgressFrm.Position := poWorkAreaCenter;
358 ProgressFrm.SetupControls(0);
359 PackageDownloader.OnPackageDownloadProgress := @ProgressFrm.DoOnPackageDownloadProgress;
360 PackageDownloader.OnPackageDownloadError := @ProgressFrm.DoOnPackageDownloadError;
361 PackageDownloader.OnPackageDownloadCompleted := @ProgressFrm.DoOnPackageDownloadCompleted;
362 PackageDownloader.DownloadPackages(ADstDir);
363 Result := ProgressFrm.ShowModal;
364 finally
365 ProgressFrm.Free;
366 end;
367 end;
368
369
TOPMInterfaceEx.Extractnull370 function TOPMInterfaceEx.Extract(const ASrcDir, ADstDir: String;
371 const AIsUpdate: Boolean): TModalResult;
372 begin
373 ProgressFrm := TProgressFrm.Create(nil);
374 try
375 ProgressFrm.Position := poWorkAreaCenter;
376 ProgressFrm.SetupControls(1);
377 PackageUnzipper := TPackageUnzipper.Create;
378 try
379 PackageUnzipper.OnZipProgress := @ProgressFrm.DoOnZipProgress;
380 PackageUnzipper.OnZipError := @ProgressFrm.DoOnZipError;
381 PackageUnzipper.OnZipCompleted := @ProgressFrm.DoOnZipCompleted;
382 PackageUnzipper.StartUnZip(ASrcDir, ADstDir, AIsUpdate);
383 Result := ProgressFrm.ShowModal;
384 finally
385 if Assigned(PackageUnzipper) then
386 PackageUnzipper := nil;
387 end;
388 finally
389 ProgressFrm.Free;
390 end;
391 end;
392
TOPMInterfaceEx.Installnull393 function TOPMInterfaceEx.Install(var AInstallStatus: TInstallStatus;
394 var ANeedToRebuild: Boolean): TModalResult;
395 begin
396 ProgressFrm := TProgressFrm.Create(nil);
397 try
398 ProgressFrm.Position := poWorkAreaCenter;
399 ProgressFrm.SetupControls(2);
400 Result := ProgressFrm.ShowModal;
401 if Result = mrOk then
402 begin
403 AInstallStatus := ProgressFrm.InstallStatus;
404 ANeedToRebuild := ProgressFrm.NeedToRebuild;
405 end;
406 finally
407 ProgressFrm.Free;
408 end;
409 end;
410
411
InstallPackagesnull412 function TOPMInterfaceEx.InstallPackages(APkgLinks: TList;
413 var ANeedToRebuild: Boolean): TModalResult;
414 var
415 I: Integer;
416 InstallStatus: TInstallStatus;
417 begin
418 FPackagesToInstall.Clear;
419 for I := 0 to APkgLinks.Count - 1 do
420 AddToInstallList(TPackageLink(APkgLinks.Items[I]).Name + '.lpk');
421
422 Result := CanInstallPackages;
423 if Result = mrCancel then
424 Exit;
425
426 Result := ResolveDependencies;
427 if Result = mrCancel then
428 Exit;
429 for I := 0 to FPackageDependecies.Count - 1 do
430 FPackagesToInstall.Insert(0, FPackageDependecies.Items[I]);
431
432
433 PackageAction := paInstall;
434 if SerializablePackages.DownloadCount > 0 then
435 begin
436 Result := Download(Options.LocalRepositoryArchiveExpanded);
437 SerializablePackages.GetPackageStates;
438 end;
439
440 if Result = mrOk then
441 begin
442 if SerializablePackages.ExtractCount > 0 then
443 begin
444 Result := Extract(Options.LocalRepositoryArchiveExpanded, Options.LocalRepositoryPackagesExpanded);
445 SerializablePackages.GetPackageStates;
446 end;
447
448 if Result = mrOk then
449 begin
450 if Options.DeleteZipAfterInstall then
451 SerializablePackages.DeleteDownloadedZipFiles;
452 if SerializablePackages.InstallCount > 0 then
453 begin
454 InstallStatus := isFailed;
455 ANeedToRebuild := False;
456 Result := Install(InstallStatus, ANeedToRebuild);
457 if Result = mrOk then
458 begin
459 SerializablePackages.MarkRuntimePackages;
460 SerializablePackages.GetPackageStates;
461 if (ANeedToRebuild) and ((InstallStatus = isSuccess) or (InstallStatus = isPartiallyFailed)) then
462 ANeedToRebuild := MessageDlgEx(rsOPMInterfaceRebuildConf, mtConfirmation, [mbYes, mbNo], nil) = mrYes;
463 end;
464 end;
465 end;
466 end;
467 SerializablePackages.RemoveErrorState;
468 SerializablePackages.RemoveCheck;
469 end;
470
DownloadPackagesnull471 function TOPMInterfaceEx.DownloadPackages(APkgLinks: TList): TModalResult;
472 var
473 I: Integer;
474 Name: String;
475 PkgLink: TPackageLink;
476 begin
477 Result := mrCancel;
478
479 FPackagesToDownload.Clear;
480 for I := 0 to APkgLinks.Count - 1 do
481 AddToDownloadList(TPackageLink(APkgLinks.Items[I]).Name + '.lpk');
482
483 Result := ResolveDependencies;
484 if Result = mrCancel then
485 Exit;
486 for I := 0 to FPackageDependecies.Count - 1 do
487 FPackagesToDownload.Insert(0, FPackageDependecies.Items[I]);
488
489 PackageAction := paInstall;
490 if SerializablePackages.DownloadCount > 0 then
491 begin
492 Result := Download(Options.LocalRepositoryArchiveExpanded);
493 SerializablePackages.GetPackageStates;
494 end;
495
496 if Result = mrOk then
497 begin
498 if SerializablePackages.ExtractCount > 0 then
499 begin
500 Result := Extract(Options.LocalRepositoryArchiveExpanded, Options.LocalRepositoryPackagesExpanded);
501 SerializablePackages.GetPackageStates;
502 end;
503
504 if Result = mrOk then
505 begin
506 if Options.DeleteZipAfterInstall then
507 SerializablePackages.DeleteDownloadedZipFiles;
508 for I := 0 to FPackageDependecies.Count - 1 do
509 begin
510 Name := StringReplace(TLazarusPackage(FPackageDependecies.Items[I]).Name, '.lpk', '', [rfReplaceAll, rfIgnoreCase]);
511 PkgLink := FindOnlineLink(Name);
512 if PkgLink <> nil then
513 begin
514 PkgLinks.AddUserLink(TLazarusPackage(FPackageDependecies.Items[I]).PackageAbsolutePath, Name);
515 PkgLinks.SaveUserLinks(True);
516 end;
517 end;
518 end;
519 end;
520 SerializablePackages.RemoveErrorState;
521 SerializablePackages.RemoveCheck;
522 end;
523
TOPMInterfaceEx.IsPackageAvailablenull524 function TOPMInterfaceEx.IsPackageAvailable(APkgLink: TPackageLink; AType: Integer): Boolean;
525 var
526 LazPackage: TLazarusPackage;
527 begin
528 Result := False;
529 LazPackage := SerializablePackages.FindLazarusPackage(APkgLink.Name + '.lpk');
530 if LazPackage <> nil then
531 begin
532 case AType of
533 0: Result := psDownloaded in LazPackage.PackageStates;
534 1: Result := psExtracted in LazPackage.PackageStates;
535 2: Result := psInstalled in LazPackage.PackageStates;
536 end;
537 end;
538 end;
539
540 end.
541