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

Opkman: Private repositories(step4).

Browse Source 
git-svn-id: trunk@55858 -
This commit is contained in:
balazs 2017-09-14 08:28:10 +00:00
parent f4679b14e6
commit b6a1099f7e
4 changed files with 202 additions and 59 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
components/onlinepackagemanager/opkman_const.pas
View File

@ -407,6 +407,7 @@ resourcestring
rsCreateRepositoryFrm_bDelete_Hint = 'Delete package from the current repository';
rsCreateRepositoryFrm_bCancel_Caption = 'Cancel';
rsCreateRepositoryFrm_bCancel_Hint = 'Close this dialog';
rsCreateRepositoryFrm_miRepDetails_Caption = 'Edit repository details';
rsCreateRepositoryFrm_VSTPackages_Column0 = 'Repository/Packages';
rsCreateRepositoryFrm_VSTDetails_Column0 = 'Description';
rsCreateRepositoryFrm_VSTDetails_Column1 = 'Data';
@ -436,11 +437,15 @@ resourcestring
rsCreateRepositoryFrm_Error2 = 'File ' + cRemoteJSONFile + ' not found.';
rsCreateRepositoryFrm_Error3 = 'Cannot save private repository: "%s". Error message: ' + sLineBreak + '"%s"';
rsCreateRepositoryFrm_Error4 = 'Cannot add package to repository!';
rsCreateRepositoryFrm_Error5 = 'Cannot delete package: "%s"!';
rsCreateRepositoryFrm_Info1 = 'The following directory: "%s" is not empty.' + sLineBreak + 'It''s recommended to save the repository to an empty directory. Continue?';
rsCreateRepositoryFrm_Info2 = 'The following directory: "%s" is read only.';
rsCreateRepositoryFrm_Info3 = 'The following repository package: "%s" is already in the current repository.' + sLineBreak + 'Each repository and lazarus package must be unique!';
rsCreateRepositoryFrm_Info4 = 'The following file: "%s" already exists in the current repository.';
rsCreateRepositoryFrm_Info5 = 'The following lazarus package: "%s" is already in the current repository.' + sLineBreak + 'Each repository and lazarus package must be unique!';
rsCreateRepositoryFrm_Info6 = 'Cannot locate package file: "%s"!';
rsCreateRepositoryFrm_Info7 = 'Package successfully added to repository.';
rsCreateRepositoryFrm_Conf1 = 'Are you sure you wish to delete package: "%s"?';
rsCreateRepositoryFrm_Conf2 = 'The following file: "%s" already exists in the current repository. Overwrite?';
//repository details
rsRepositoryDetailsFrm_Caption = 'Repository details';

15
components/onlinepackagemanager/opkman_createrepositoryfrm.lfm
View File

@ -220,6 +220,7 @@ object CreateRepositoryFrm: TCreateRepositoryFrm
}
GlyphShowMode = gsmAlways
NumGlyphs = 2
OnClick = bDeleteClick
ParentShowHint = False
ShowHint = True
TabOrder = 3
@ -1131,4 +1132,18 @@ object CreateRepositoryFrm: TCreateRepositoryFrm
left = 85
top = 32
end
object ODPack: TOpenDialog
DefaultExt = '.json'
Filter = '*.json|*.json'
left = 139
top = 84
end
object pm: TPopupMenu
left = 139
top = 37
object miRepDetails: TMenuItem
Caption = 'Repository details'
OnClick = miRepDetailsClick
end
end
end

225
components/onlinepackagemanager/opkman_createrepositoryfrm.pas
View File

@ -31,7 +31,7 @@ uses
Classes, SysUtils, FileUtil, fpjson,
// LCL
Forms, Controls, Graphics, Dialogs, ExtCtrls,
StdCtrls, Buttons,
StdCtrls, Buttons, Menus,
// LazUtils
LazFileUtils, LazUTF8,
// OpkMan
@ -57,20 +57,25 @@ type
bOpen: TButton;
bCreate: TButton;
imTree: TImageList;
miRepDetails: TMenuItem;
OD: TOpenDialog;
ODPack: TOpenDialog;
pnButtons: TPanel;
pnMessage: TPanel;
pnPackages: TPanel;
pnDetails: TPanel;
pm: TPopupMenu;
SD: TSaveDialog;
spMain: TSplitter;
tmWait: TTimer;
procedure bAddClick(Sender: TObject);
procedure bCreateClick(Sender: TObject);
procedure bDeleteClick(Sender: TObject);
procedure bOpenClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure miRepDetailsClick(Sender: TObject);
procedure pnButtonsResize(Sender: TObject);
procedure tmWaitTimer(Sender: TObject);
private
@ -81,7 +86,7 @@ type
procedure EnableDisableButtons(const AEnable: Boolean);
procedure ShowHideControls(const AType: Integer);
function LoadRepository(const AFileName: String): Boolean;
function SaveRepository(const AFileName: String): Boolean;
function SaveRepository(const AFileName: String; const AIsNew: Boolean): Boolean;
procedure PopulatePackageTree;
procedure AddNewPackage;
procedure AddExistingPackage;
@ -166,6 +171,7 @@ begin
bDelete.Hint := rsCreateRepositoryFrm_bDelete_Hint;
bCancel.Caption := rsCreateRepositoryFrm_bCancel_Caption;
bCancel.Hint := rsCreateRepositoryFrm_bCancel_Hint;
miRepDetails.Caption := rsCreateRepositoryFrm_miRepDetails_Caption;
EnableDisableButtons(True);
ShowHideControls(0);
@ -198,6 +204,7 @@ begin
TreeOptions.PaintOptions := [toHideFocusRect, toPopupMode, toShowButtons, toShowDropmark, toShowRoot, toThemeAware, toUseBlendedImages];
TreeOptions.SelectionOptions := [toRightClickSelect];
TreeOptions.AutoOptions := [toAutoTristateTracking];
PopupMenu := pm;
OnGetText := @VSTPackagesGetText;
OnGetImageIndex := @VSTPackagesGetImageIndex;
OnHeaderClick := @VSTPackagesHeaderClick;
@ -238,6 +245,7 @@ begin
TreeOptions.PaintOptions := [toHideFocusRect, toPopupMode, toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages];
TreeOptions.SelectionOptions := [toRightClickSelect, toFullRowSelect];
TreeOptions.AutoOptions := [toAutoTristateTracking];
PopupMenu := pm;
OnGetText := @VSTDetailsGetText;
OnGetImageIndex := @VSTDetailsGetImageIndex;
OnFreeNode := @VSTDetailsFreeNode;
@ -261,16 +269,12 @@ begin
FRepository.FDescription := RepositoryDetailsFrm.mDescription.Text;
if SD.Execute then
begin
if SaveRepository(SD.FileName) then
if SaveRepository(SD.FileName, True) then
begin
if RepositoryDetailsFrm.Address <> '' then
Options.RemoteRepository.Add(RepositoryDetailsFrm.Address);
if LoadRepository(SD.FileName) then
begin
PopulatePackageTree;
ShowHideControls(2);
EnableDisableButtons(True);
end;
end
else
GoTo ShowFormAgain;
@ -281,6 +285,49 @@ begin
end;
end;
procedure TCreateRepositoryFrm.bDeleteClick(Sender: TObject);
var
Node: PVirtualNode;
Data: PData;
PackageFile: String;
PackageIndex: Integer;
CanGo: Boolean;
JSON: TJSONStringType;
begin
Node := FVSTPackages.GetFirstSelected;
if Node <> nil then
begin
Data := FVSTPackages.GetNodeData(Node);
if Data^.FDataType = 1 then
begin
if MessageDlgEx(Format(rsCreateRepositoryFrm_Conf1, [Data^.FDisplayname]), mtConfirmation, [mbYes, mbNo], Self) = mrNo then
Exit;
CanGo := False;
PackageIndex := FSerializablePackages.FindPackageIndex(Data^.FName, fpbPackageName);
if PackageIndex <> -1 then
begin
PackageFile := ExtractFilePath(FRepository.FPath) + Data^.FRepositoryFileName;
FSerializablePackages.DeletePackage(PackageIndex);
JSON := '';
if FSerializablePackages.PackagesToJSON(JSON) then
begin
if SaveJSONToFile(ExtractFilePath(FRepository.FPath) + cRemoteJSONFile, JSON) then
begin
DeleteFile(PackageFile);
if LoadRepository(FRepository.FPath) then
begin
CanGo := True;
PopulatePackageTree;
end;
end;
end;
end;
if not CanGo then
MessageDlgEx(Format(rsCreateRepositoryFrm_Error5, [Data^.FDisplayname]), mtError, [mbOk], Self);
end;
end;
end;
function TCreateRepositoryFrm.IsDuplicatePackage(const AJSON: TJSONStringType;
const APackageFile: String): Boolean;
var
@ -304,13 +351,13 @@ begin
if not Result then
begin
for I := 0 to MetaPackage.LazarusPackages.Count - 1 do
for I := 0 to SP.Items[0].LazarusPackages.Count - 1 do
begin
LazarusPackage := FSerializablePackages.FindLazarusPackage(TLazarusPackage(MetaPackage.LazarusPackages.Items[I]).Name);
LazarusPackage := FSerializablePackages.FindLazarusPackage(TLazarusPackage(SP.Items[0].LazarusPackages.Items[I]).Name);
if LazarusPackage <> nil then
begin
Result := True;
MessageDlgEx(Format(rsCreateRepositoryFrm_Info5, [TLazarusPackage(MetaPackage.LazarusPackages.Items[I]).Name]), mtInformation, [mbOk], Self);
MessageDlgEx(Format(rsCreateRepositoryFrm_Info5, [TLazarusPackage(SP.Items[0].LazarusPackages.Items[I]).Name]), mtInformation, [mbOk], Self);
Break;
end;
end;
@ -318,14 +365,15 @@ begin
if not Result then
begin
TargetPackageFile := AppendPathDelim(ExtractFilePath(FRepository.FPath)) + ExtractFileName(APackageFile);
if FileExists(TargetPackageFile) then
if TargetPackageFile <> APackageFile then
begin
Result := True;
MessageDlgEx(Format(rsCreateRepositoryFrm_Info4, [TargetPackageFile]), mtInformation, [mbOk], Self);
end;
if FileExists(TargetPackageFile) then
if MessageDlgEx(Format(rsCreateRepositoryFrm_Conf2, [TargetPackageFile]), mtInformation, [mbYes, mbNo], Self) = mrNo then
Result := True;
if (not Result) and (not CopyFile(APackageFile, TargetPackageFile, True)) then
Result := True;
if (not Result) and (not CopyFile(APackageFile, TargetPackageFile, [cffOverwriteFile], True)) then
Result := True;
end;
end;
end;
end;
@ -369,18 +417,18 @@ begin
begin
CanGo := True;
PopulatePackageTree;
ShowHideControls(2);
EnableDisableButtons(True);
end;
end;
end;
end;
end;
end;
//DeleteFile(JSONFile);
DeleteDirectory(DestDir, False);
end;
if not CanGo then
MessageDlgEx(rsCreateRepositoryFrm_Error4, mtError, [mbOk], Self);
MessageDlgEx(rsCreateRepositoryFrm_Error4, mtError, [mbOk], Self)
else
MessageDlgEx(rsCreateRepositoryFrm_Info7, mtInformation, [mbOk], Self);
end;
end;
finally
@ -389,8 +437,51 @@ begin
end;
procedure TCreateRepositoryFrm.AddExistingPackage;
var
PackageFile: String;
JSONFile: String;
JSON: TJSONStringType;
CanGo: Boolean;
begin
ODPack.InitialDir := Options.LastPackagedirDst;
if ODPack.Execute then
begin
JSONFile := ODPack.FileName;
PackageFile := ChangeFileExt(JSONFile, '.zip');
if not FileExists(PackageFile) then
begin
MessageDlgEx(Format(rsCreateRepositoryFrm_Info5, [ExtractFileName(PackageFile)]), mtInformation, [mbOk], Self);
MessageDlgEx(rsCreateRepositoryFrm_Error4, mtError, [mbOk], Self);
Exit;
end;
CanGo := False;
if LoadJSONFromFile(JSONFile, JSON) then
begin
if not IsDuplicatePackage(JSON, PackageFile) then
begin
if FSerializablePackages.AddPackageFromJSON(JSON) then
begin
JSON := '';
if FSerializablePackages.PackagesToJSON(JSON) then
begin
if SaveJSONToFile(ExtractFilePath(FRepository.FPath) + cRemoteJSONFile, JSON) then
begin
if LoadRepository(FRepository.FPath) then
begin
CanGo := True;
PopulatePackageTree;
end;
end;
end;
end;
end;
end;
if not CanGo then
MessageDlgEx(rsCreateRepositoryFrm_Error4, mtError, [mbOk], Self)
else
MessageDlgEx(rsCreateRepositoryFrm_Info7, mtInformation, [mbOk], Self);
end;
end;
procedure TCreateRepositoryFrm.bAddClick(Sender: TObject);
@ -413,14 +504,8 @@ end;
procedure TCreateRepositoryFrm.bOpenClick(Sender: TObject);
begin
if OD.Execute then
begin
if LoadRepository(OD.FileName) then
begin
PopulatePackageTree;
ShowHideControls(2);
EnableDisableButtons(True);
end
end
end;
procedure TCreateRepositoryFrm.FormDestroy(Sender: TObject);
@ -435,19 +520,57 @@ begin
tmWait.Enabled := True;
end;
procedure TCreateRepositoryFrm.miRepDetailsClick(Sender: TObject);
var
RepositoryDetailsFrm: TRepositoryDetailsFrm;
Node: PVirtualNode;
Data: PData;
begin
RepositoryDetailsFrm := TRepositoryDetailsFrm.Create(Self);
try
RepositoryDetailsFrm.edName.Text := FRepository.FName;
RepositoryDetailsFrm.edAddress.Text := FRepository.FAddress;
RepositoryDetailsFrm.mDescription.Text := FRepository.FDescription;
RepositoryDetailsFrm.ShowModal;
if RepositoryDetailsFrm.ModalResult = mrOk then
begin
if FRepository.FName <> RepositoryDetailsFrm.edName.Text then
begin
Node := FVSTPackages.GetFirst;
if Node <> nil then
begin
Data := FVSTPackages.GetNodeData(Node);
if Data^.FDataType = 0 then
begin
Data^.FName := RepositoryDetailsFrm.edName.Text;
FVSTPackages.ReinitNode(Node, False);
FVSTPackages.RepaintNode(Node);
end;
end;
end;
FRepository.FName := RepositoryDetailsFrm.edName.Text;
FRepository.FAddress := RepositoryDetailsFrm.edAddress.Text;
FRepository.FDescription := RepositoryDetailsFrm.mDescription.Text;
if SaveRepository(FRepository.FPath, False) then
begin
if RepositoryDetailsFrm.Address <> '' then
Options.RemoteRepository.Add(RepositoryDetailsFrm.Address);
if LoadRepository(FRepository.FPath) then
PopulatePackageTree;
end;
end;
finally
RepositoryDetailsFrm.Free;
end;
end;
procedure TCreateRepositoryFrm.tmWaitTimer(Sender: TObject);
begin
tmWait.Enabled := False;
if (Options.LastPrivateRepository <> '') and
(FileExists(Options.LastPrivateRepository)) and
(FileExists(AppendPathDelim(ExtractFilePath(Options.LastPrivateRepository)) + cRemoteJSONFile)) then
if (Options.LastPrivateRepository <> '') and (FileExists(Options.LastPrivateRepository)) then
begin
if LoadRepository(Options.LastPrivateRepository) then
begin
PopulatePackageTree;
ShowHideControls(2);
EnableDisableButtons(True);
end;
end;
end;
@ -502,6 +625,7 @@ end;
function TCreateRepositoryFrm.LoadRepository(const AFileName: String): Boolean;
var
FS: TFileStream;
DestDir: String;
begin
Result := False;
FS := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite);
@ -514,6 +638,9 @@ begin
Caption := rsCreateRepositoryFrm_Caption + '(' + AFileName + ')';
Options.LastPrivateRepository := AFileName;
Options.Changed := True;
DestDir := AppendPathDelim(AppendPathDelim(ExtractFilePath(AFileName)) + 'Temp');
if DirectoryExists(DestDir) then
DeleteDirectory(DestDir, False);
Result := True;
except
on E: Exception do
@ -528,25 +655,22 @@ begin
end;
end;
function TCreateRepositoryFrm.SaveRepository(const AFileName: String): Boolean;
function TCreateRepositoryFrm.SaveRepository(const AFileName: String;
const AIsNew: Boolean): Boolean;
var
FS: TFileStream;
FHandle: THandle;
begin
Result := False;
if not IsDirectoryEmpty(ExtractFilePath(AFileName)) then
if (AIsNew) and (not IsDirectoryEmpty(ExtractFilePath(AFileName))) then
begin
if MessageDlgEx(Format(rsCreateRepositoryFrm_Info1, [ExtractFilePath(AFileName)]), mtConfirmation, [mbYes, mbNo], Self) = mrNo then
begin
Result := False;
Exit;
end;
end;
if not DirectoryIsWritable(ExtractFilePath(AFileName)) then
begin
MessageDlgEx(Format(rsCreateRepositoryFrm_Info1, [ExtractFilePath(AFileName)]), mtConfirmation, [mbOk], Self);
Result := False;
Exit;
end;
@ -556,12 +680,17 @@ begin
FS.WriteAnsiString(FRepository.FName);
FS.WriteAnsiString(FRepository.FAddress);
FS.WriteAnsiString(FRepository.FDescription);
FHandle := FileCreate(ExtractFilePath(AFileName) + cRemoteJSONFile);
if fHandle <> THandle(-1) then
if AIsNew then
begin
FHandle := FileCreate(ExtractFilePath(AFileName) + cRemoteJSONFile);
if fHandle <> THandle(-1) then
begin
Result := True;
FileClose(FHandle);
end;
end
else
Result := True;
FileClose(FHandle);
end;
except
on E: Exception do
MessageDlgEx(Format(rsCreateRepositoryFrm_Error3, [AFileName, E.Message]), mtError, [mbOk], Self);
@ -597,10 +726,8 @@ begin
MetaPackage := TMetaPackage(FSerializablePackages.Items[I]);
Node := FVSTPackages.AddChild(RootNode);
Data := FVSTPackages.GetNodeData(Node);
if Trim(MetaPackage.DisplayName) <> '' then
Data^.FName := MetaPackage.DisplayName
else
Data^.FName := MetaPackage.Name;
Data^.FDisplayName := MetaPackage.DisplayName;
Data^.FName := MetaPackage.Name;
Data^.FCategory := MetaPackage.Category;
Data^.FRepositoryFileName := MetaPackage.RepositoryFileName;
Data^.FRepositoryFileSize := MetaPackage.RepositoryFileSize;
@ -634,6 +761,8 @@ begin
FVSTPackages.FocusedNode := RootNode;
FVSTPackages.Expanded[RootNode] := True;
end;
ShowHideControls(2);
EnableDisableButtons(True);
end;
function TCreateRepositoryFrm.GetDisplayString(const AStr: String): String;
@ -704,7 +833,7 @@ begin
Data := FVSTPackages.GetNodeData(Node);
case Data^.FDataType of
0: CellText := FRepository.FName;
1: CellText := Data^.FName;
1: CellText := Data^.FDisplayName;
2: CellText := Data^.FName;
end;
end;

14
components/onlinepackagemanager/opkman_repositorydetailsfrm.pas
View File

@ -5,8 +5,8 @@ unit opkman_repositorydetailsfrm;
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ButtonPanel,
ExtCtrls, StdCtrls;
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
StdCtrls;
type
@ -81,19 +81,13 @@ begin
edName.SetFocus;
Exit;
end;
if (Trim(edAddress.Text) <> '') and (edAddress.Font.Color <> clGray) then
if Trim(edAddress.Text) <> '' then
begin
FAddress := Trim(edAddress.Text);
if FAddress[Length(FAddress)] <> '/' then
FAddress := FAddress + '/';
if IsDuplicateRepository(FAddress) then
begin
if MessageDlgEx(Format(rsRepositoryDetailsFrm_Info3, [FAddress]), mtInformation, [mbYes, mbNo], Self) = mrNo then
begin
edAddress.SetFocus;
Exit;
end;
end;
FAddress := '';
end;
ModalResult := mrOk;
end;