paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-19 04:49:40 +02:00
Code Issues Packages Projects Releases Wiki Activity

Packager: Improve creating packagelinks for online packages. Issue #32719, patch from Balázs.

Browse Source 
git-svn-id: trunk@56474 -
This commit is contained in:
juha 2017-11-23 14:17:03 +00:00
parent 3dfca3521a
commit d615063766
5 changed files with 56 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
components/ideintf/packagelinkintf.pas
View File

@ -54,7 +54,8 @@ type
protected
FFileDate: TDateTime;
FFileDateValid: boolean;
FFilename: string; // Filename or URL
FFilename: string;
FURL: String;
FLPLFileDate: TDateTime;
FLPLFilename: string;
FPackageType: TLazPackageType;
@ -72,8 +73,7 @@ type
property LPKFileDate: TDateTime read FFileDate write FFileDate;
// if relative it is relative to the LazarusDir
property LPKFilename: string read FFilename write SetFilename;
// URL is also stored in FFilename.
property LPKUrl: string read FFilename write FFilename;
property LPKUrl: string read FURL write FURL;
property LPLFilename: string read FLPLFilename write FLPLFilename;
property LPLFileDate: TDateTime read FLPLFileDate write FLPLFileDate;
property PackageType: TLazPackageType read FPackageType;
@ -92,8 +92,7 @@ type
function FindLinkWithFilename(const PkgName, LPKFilename: string): TPackageLink; virtual; abstract;
procedure IteratePackages(MustExist: boolean; Event: TIteratePackagesEvent;
Origins: TPkgLinkOrigins = AllPkgLinkOrigins); virtual; abstract;
function AddOnlineLink(const PkgFilename, PkgName: string;
PkgVersion: TPkgVersion): TPackageLink; virtual; abstract;
function AddOnlineLink(const PkgFilename, PkgName, PkgURL: string): TPackageLink; virtual; abstract;
function AddUserLink(APackage: TIDEPackage): TPackageLink; virtual; abstract;
// do not use this if package is open in IDE
function AddUserLink(const PkgFilename, PkgName: string): TPackageLink; virtual; abstract;
@ -112,22 +111,8 @@ var
PkgLinks: TPackageLinks;
OPMInterface: TOPMInterface;
function IsUrl(const AText: string): Boolean;
implementation
// This should be in FPC's StrUtils.
function StartsStr(const ASubText, AText: string): Boolean;
begin
Result := Copy(AText,1,Length(ASubText)) = ASubText;
end;
function IsUrl(const AText: string): Boolean;
begin
Result := (AText='') or StartsStr('http://', AText) or StartsStr('https://', AText);
end;
{ TPackageLink }
constructor TPackageLink.Create;

2
components/onlinepackagemanager/opkman_intf.pas
View File

@ -143,7 +143,7 @@ begin
URL := Options.RemoteRepository[Options.ActiveRepositoryIndex] + MetaPackage.RepositoryFileName;
if not IsInList(Name, URL) then
begin
// PackageLink := PkgLinks.AddOnlineLink(FileName, Name, URL);
PackageLink := PkgLinks.AddOnlineLink(FileName, Name, URL);
if PackageLink <> nil then
begin
PackageLink.Version.Assign(LazPackage.Version);

2
ide/lazarusidestrconsts.pas
View File

@ -5045,7 +5045,7 @@ resourcestring
lisA2PCreateNewFile = 'Create New File';
lisA2PCreateNewComp = 'Create New Component';
lisA2PCreateNewReq = 'Create New Requirement';
lisA2PFilename2 = 'Filename';
lisA2PFilename2 = 'Filename/URL';
lisLastOpened = 'Last opened';
lisFRIFindOrRenameIdentifier = 'Find or Rename Identifier';
lisHelpSelectorDialog = 'Help selector';

47
packager/packagelinks.pas
View File

@ -146,8 +146,7 @@ type
function FindLinkWithFilename(const PkgName, LPKFilename: string): TPackageLink; override;
procedure IteratePackages(MustExist: boolean; Event: TIteratePackagesEvent;
Origins: TPkgLinkOrigins = AllPkgLinkOrigins); override;
function AddOnlineLink(const PkgFilename, PkgName: string;
PkgVersion: TPkgVersion): TPackageLink; override;
function AddOnlineLink(const PkgFilename, PkgName, PkgURL: string): TPackageLink; override;
function AddUserLink(APackage: TIDEPackage): TPackageLink; override;
function AddUserLink(const PkgFilename, PkgName: string): TPackageLink; override;
procedure RemoveUserLink(Link: TPackageLink); override;
@ -268,8 +267,8 @@ end;
function TLazPackageLink.GetEffectiveFilename: string;
begin
Result:=LPKFilename;
if IsUrl(Result) or FilenameIsAbsolute(Result) then Exit;
Result:=TrimFilename(EnvironmentOptions.GetParsedLazarusDirectory+PathDelim+Result);
if not FilenameIsAbsolute(Result) then
Result:=TrimFilename(EnvironmentOptions.GetParsedLazarusDirectory+PathDelim+Result);
end;
procedure TLazPackageLink.Reference;
@ -1061,7 +1060,7 @@ begin
Result:=TLazPackageLink(CurNode.Data);
if CompareText(PkgName,Result.Name)<>0 then break;
// Treat URLs and filenames differently.
if IsUrl(LPKFilename) then begin
if Result.Origin = ploOnline then begin
if LPKFilename = Result.LPKFilename then exit;
end
else begin
@ -1175,36 +1174,34 @@ begin
IteratePackagesInTree(MustExist,FGlobalLinks,Event);
end;
function TLazPackageLinks.AddOnlineLink(const PkgFilename, PkgName: string;
PkgVersion: TPkgVersion): TPackageLink;
function TLazPackageLinks.AddOnlineLink(const PkgFilename, PkgName,
PkgURL: string): TPackageLink;
begin
DebugLn(['TLazPackageLinks.AddOnlineLink: PkgFilename=', PkgFilename,
', PkgName=', PkgName, ', PkgVersion=', PkgVersion.AsString]);
// check if link already exists
Result:=FindLinkWithFilename(PkgName,PkgFilename);
DebugLn(['TLazPackageLinks.AddOnlineLink: PkgFilename=', PkgFilename, ', PkgName=', PkgName]);
Result := FindLinkWithFilename(PkgName, PkgFilename);
if Assigned(Result) then
begin
Result.LastUsed:=Now;
Assert(Assigned(PkgVersion), 'TLazPackageLinks.AddOnlineLink: PkgVersion=Nil');
Result.Version.Assign(PkgVersion);
exit;
if Result.LPKUrl = PkgURL then
begin
Result := nil;
Exit;
end;
end;
// add online link
Result:=TLazPackageLink.Create;
Result := TLazPackageLink.Create;
Result.Reference;
Result.Name:=PkgName;
Result.LPKUrl:=PkgFilename; // Actually an URL
Result.Origin:=ploOnline;
if IsValidPkgName(Result.Name) {Result.IsMakingSense} then
if IsValidPkgName(PkgName) then
begin
Result.Name := PkgName;
Result.LPKFilename := PkgFilename;
Result.LPKUrl := PkgURL;
Result.Origin := ploOnline;
FOnlineLinks.Add(Result);
IncreaseChangeStamp;
Result.LastUsed:=Now;
Result.Version.Assign(PkgVersion);
end
else begin
Result.Release;
Result:=nil;
Result := nil;
end;
end;

39
packager/pkglinksdlg.pas
View File

@ -64,6 +64,7 @@ type
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
property Origin;
property LPKUrl;
property LPKInfo: TLPKInfo read FLPKInfo;
property Visible: boolean read FVisible write FVisible;
property IsValid: boolean read FIsValid write FIsValid;
@ -379,19 +380,34 @@ begin
ploUser : OriginStr:=lisPLDUser;
end;
PkgStringGrid.Cells[3,i]:=OriginStr;
if Link.IsValid then
s:=lrsPLDValid
else if (Info<>nil) and (Info.LPKError<>'') then
s:=Info.LPKError
else
s:=lrsPLDInvalid;
PkgStringGrid.Cells[4,i]:=s;
PkgStringGrid.Cells[5,i]:=Link.EffectiveFilename;
if Link.LastUsed=0 then
PkgStringGrid.Cells[6,i]:= lisNever
if Link.Origin = ploOnline then
s:=lrsPLDValid
else
PkgStringGrid.Cells[6,i]:= DateTimeToStr(Link.LastUsed);
begin
if Link.IsValid then
s:=lrsPLDValid
else if (Info<>nil) and (Info.LPKError<>'') then
s:=Info.LPKError
else
s:=lrsPLDInvalid;
end;
PkgStringGrid.Cells[4,i]:=s;
if Link.Origin = ploOnline then
PkgStringGrid.Cells[5,i]:=Link.LPKUrl
else
PkgStringGrid.Cells[5,i]:=Link.EffectiveFilename;
if Link.Origin = ploOnline then
PkgStringGrid.Cells[6,i]:= FormatDateTime('YYYY/MM/DD hh:mm:ss', Link.LPKFileDate)
else
begin
if Link.LastUsed=0 then
PkgStringGrid.Cells[6,i]:= lisNever
else
PkgStringGrid.Cells[6,i]:= FormatDateTime('YYYY/MM/DD hh:mm:ss', Link.LastUsed);
end;
inc(i);
end;
@ -496,6 +512,7 @@ begin
if Source is TLazPackageLink then begin
Link:=TLazPackageLink(Source);
Origin:=Link.Origin;
LPKUrl := Link.LPKUrl;
LPKFilename:=Link.LPKFilename;
LPLFilename:=Link.LPLFilename;
AutoCheckExists:=Link.AutoCheckExists;