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

tools: lplupdate -x

Browse Source 
git-svn-id: trunk@62308 -
This commit is contained in:
mattias 2019-11-27 13:29:02 +00:00
parent e2fea199d7
commit 6e2e1b018f
2 changed files with 67 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
tools/lplupdate.lpi
View File

@ -1,35 +1,30 @@
<?xml version="1.0"?> <?xml version="1.0" encoding="UTF-8"?>
<CONFIG> <CONFIG>
<ProjectOptions> <ProjectOptions>
<Version Value="9"/> <Version Value="12"/>
<General> <General>
<Flags> <Flags>
<MainUnitHasCreateFormStatements Value="False"/> <MainUnitHasCreateFormStatements Value="False"/>
<CompatibilityMode Value="True"/>
</Flags> </Flags>
<SessionStorage Value="InIDEConfig"/> <SessionStorage Value="InIDEConfig"/>
<MainUnit Value="0"/>
<UseAppBundle Value="False"/> <UseAppBundle Value="False"/>
<ResourceType Value="res"/> <ResourceType Value="res"/>
</General> </General>
<i18n> <i18n>
<EnableI18N LFM="False"/> <EnableI18N LFM="False"/>
</i18n> </i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1"> <BuildModes Count="1">
<Item1 Name="Default" Default="True"/> <Item1 Name="Default" Default="True"/>
</BuildModes> </BuildModes>
<PublishOptions> <PublishOptions>
<Version Value="2"/> <Version Value="2"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
</PublishOptions> </PublishOptions>
<RunParams> <RunParams>
<local> <FormatVersion Value="2"/>
<FormatVersion Value="1"/> <Modes Count="1">
<LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> <Mode0 Name="default"/>
</local> </Modes>
</RunParams> </RunParams>
<RequiredPackages Count="1"> <RequiredPackages Count="1">
<Item1> <Item1>
@ -40,7 +35,6 @@
<Unit0> <Unit0>
<Filename Value="lplupdate.lpr"/> <Filename Value="lplupdate.lpr"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="lplupdate"/>
</Unit0> </Unit0>
</Units> </Units>
</ProjectOptions> </ProjectOptions>
@ -53,12 +47,6 @@
<IncludeFiles Value="$(ProjOutDir)"/> <IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths> </SearchPaths>
<Other>
<CompilerMessages>
<UseMsgFile Value="True"/>
</CompilerMessages>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions> </CompilerOptions>
<Debugging> <Debugging>
<Exceptions Count="3"> <Exceptions Count="3">

70
tools/lplupdate.lpr
View File

@ -92,6 +92,7 @@ type
TLPLUpdate = class(TCustomApplication) TLPLUpdate = class(TCustomApplication)
private private
FExecuteCommands: boolean;
FLazarusDir: string; FLazarusDir: string;
FLinksDir: string; FLinksDir: string;
FPkgDir: string; FPkgDir: string;
@ -123,6 +124,7 @@ type
property Verbose: Boolean read FVerbose write FVerbose; property Verbose: Boolean read FVerbose write FVerbose;
property Quiet: Boolean read FQuiet write FQuiet; property Quiet: Boolean read FQuiet write FQuiet;
property WriteCommands: boolean read FWriteCommands write FWriteCommands; property WriteCommands: boolean read FWriteCommands write FWriteCommands;
property ExecuteCommands: boolean read FExecuteCommands write FExecuteCommands;
end; end;
{ TLPLUpdate } { TLPLUpdate }
@ -134,7 +136,7 @@ var
Links: TLinks; Links: TLinks;
begin begin
// quick check parameters // quick check parameters
ErrorMsg:=CheckOptions('hvqlLpc','help verbose quiet lazarusdir pkgdir linksdir commands'); ErrorMsg:=CheckOptions('hvqlLpcx','help verbose quiet lazarusdir pkgdir linksdir commands');
if ErrorMsg<>'' then begin if ErrorMsg<>'' then begin
Error(ErrorMsg); Error(ErrorMsg);
Terminate; Terminate;
@ -173,13 +175,19 @@ begin
Error('links directory not found: '+LinksDir); Error('links directory not found: '+LinksDir);
WriteCommands:=HasOption('c','commands'); WriteCommands:=HasOption('c','commands');
ExecuteCommands:=HasOption('x','execute');
if Verbose then begin if Verbose then begin
writeln('TLPLUpdate.DoRun LazarusDir=',LazarusDir); writeln('Info: LazarusDir=',LazarusDir);
writeln('TLPLUpdate.DoRun PkgDir=',PkgDir); writeln('Info: PkgDir=',PkgDir);
writeln('TLPLUpdate.DoRun LinksDir=',LinksDir); writeln('Info: LinksDir=',LinksDir);
writeln('Info: Show commands: ',WriteCommands);
writeln('Info: Execute commands: ',ExecuteCommands);
end; end;
if WriteCommands and ExecuteCommands then
Error('Either -c or -x, not both');
Packages:=TPackages.create(true); Packages:=TPackages.create(true);
Links:=TLinks.create(true); Links:=TLinks.create(true);
try try
@ -343,17 +351,31 @@ procedure TLPLUpdate.WriteMissingLinks(Packages: TPackages; Links: TLinks);
var var
i: Integer; i: Integer;
Pkg: TPackage; Pkg: TPackage;
LinkFilename: String; LPLFilename, Line: String;
sl: TStringList;
begin begin
for i:=0 to Packages.Count-1 do begin for i:=0 to Packages.Count-1 do begin
Pkg:=Packages[i]; Pkg:=Packages[i];
if Links.FindLinkWithName(Pkg.Name)<>nil then continue; if Links.FindLinkWithName(Pkg.Name)<>nil then continue;
if not (Quiet and WriteCommands) then if not (Quiet and WriteCommands) then
writeln('Missing link ',Pkg.Name+'-'+Pkg.VersionAsString,' in '+CreateRelativePath(Pkg.Filename,PkgDir)); writeln('Missing link ',Pkg.Name+'-'+Pkg.VersionAsString,' in '+CreateRelativePath(Pkg.Filename,PkgDir));
LPLFilename:=CreateRelativePath(LinksDir,LazarusDir)+PathDelim+Pkg.Name+'-'+Pkg.VersionAsString+'.lpl';
Line:='$(LazarusDir)/'+StringReplace(CreateRelativePath(Pkg.Filename,PkgDir),'\','/',[rfReplaceAll]);
if WriteCommands then begin if WriteCommands then begin
LinkFilename:=CreateRelativePath(LinksDir,LazarusDir)+PathDelim+Pkg.Name+'-'+Pkg.VersionAsString+'.lpl'; writeln('echo '''+Line+''' > '+LPLFilename);
writeln('echo ''$(LazarusDir)/'+StringReplace(CreateRelativePath(Pkg.Filename,PkgDir),'\','/',[rfReplaceAll])+''' > '+LinkFilename); writeln('svn add '+LPLFilename);
writeln('svn add '+LinkFilename); end else if ExecuteCommands then begin
if not Quiet then
writeln('Info: creating '+LPLFilename);
sl:=TStringList.Create;
try
sl.Add(Line);
sl.SaveToFile(LPLFilename);
finally
sl.Free;
end;
if WriteCommands then
writeln('ToDo: svn add '+LPLFilename);
end; end;
end; end;
end; end;
@ -365,6 +387,7 @@ var
Pkg: TPackage; Pkg: TPackage;
Link: TLink; Link: TLink;
LinkFilename: String; LinkFilename: String;
sl: TStringList;
begin begin
for i:=0 to Links.Count-1 do begin for i:=0 to Links.Count-1 do begin
Link:=Links[i]; Link:=Links[i];
@ -377,6 +400,16 @@ begin
writeln('Wrong filename in link ',ExtractFileNameOnly(Link.LPLFilename),' should be '+LinkFilename); writeln('Wrong filename in link ',ExtractFileNameOnly(Link.LPLFilename),' should be '+LinkFilename);
if WriteCommands then begin if WriteCommands then begin
writeln('echo ''',LinkFilename+''' > '+Link.LPLFilename); writeln('echo ''',LinkFilename+''' > '+Link.LPLFilename);
end else if ExecuteCommands then begin
if not Quiet then
writeln('Info: fixing '+Link.LPLFilename+': '+LinkFilename);
sl:=TStringList.Create;
try
sl.Add(LinkFilename);
sl.SaveToFile(Link.LPLFilename);
finally
sl.Free;
end;
end; end;
end; end;
end; end;
@ -401,6 +434,11 @@ begin
end; end;
if WriteCommands then begin if WriteCommands then begin
writeln('svn rm ',CreateRelativePath(Link.LPLFilename,LazarusDir)); writeln('svn rm ',CreateRelativePath(Link.LPLFilename,LazarusDir));
end else if ExecuteCommands then begin
if not Quiet then
writeln('Info: deleting '+Link.LPLFilename);
if not DeleteFileUTF8(Link.LPLFilename) then
Error('unable to delete file "'+Link.LPLFilename+'"');
end; end;
end; end;
end; end;
@ -414,6 +452,7 @@ var
Link: TLink; Link: TLink;
j: Integer; j: Integer;
Pkg: TPackage; Pkg: TPackage;
NewLPLFilename, OldLPLFilename: String;
begin begin
for i:=0 to Links.Count-1 do begin for i:=0 to Links.Count-1 do begin
Link:=Links[i]; Link:=Links[i];
@ -430,8 +469,16 @@ begin
then begin then begin
if not (Quiet and WriteCommands) then if not (Quiet and WriteCommands) then
writeln('Version mismatch link ',ExtractFileNameOnly(Link.LPLFilename),' <> ',Pkg.VersionAsString,' in ',CreateRelativePath(Pkg.Filename,PkgDir)); writeln('Version mismatch link ',ExtractFileNameOnly(Link.LPLFilename),' <> ',Pkg.VersionAsString,' in ',CreateRelativePath(Pkg.Filename,PkgDir));
if WriteCommands then OldLPLFilename:=CreateRelativePath(Link.LPLFilename,LazarusDir);
writeln('svn mv ',CreateRelativePath(Link.LPLFilename,LazarusDir),' ',AppendPathDelim(CreateRelativePath(LinksDir,LazarusDir))+Pkg.Name+'-'+Pkg.VersionAsString+'.lpl'); NewLPLFilename:=AppendPathDelim(CreateRelativePath(LinksDir,LazarusDir))+Pkg.Name+'-'+Pkg.VersionAsString+'.lpl';
if WriteCommands then begin
writeln('svn mv ',OldLPLFilename,' ',NewLPLFilename);
end else if ExecuteCommands then begin
if not Quiet then
writeln('Info: renaming "'+OldLPLFilename+'" -> "'+NewLPLFilename+'"');
if not RenameFileUTF8(OldLPLFilename,NewLPLFilename) then
Error('Unable to rename file "'+OldLPLFilename+'" -> "'+NewLPLFilename+'"');
end;
end; end;
break; break;
end; end;
@ -472,6 +519,9 @@ begin
writeln(' The directory where to search for lpl files.'); writeln(' The directory where to search for lpl files.');
writeln(' Default is ',GetDefaultLinksDirectory); writeln(' Default is ',GetDefaultLinksDirectory);
writeln; writeln;
writeln('-x, --execute');
writeln(' Create, delete, rename, alter lpl files.');
writeln;
writeln('-v, --verbose'); writeln('-v, --verbose');
writeln; writeln;
writeln('-q, --quiet'); writeln('-q, --quiet');