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

tools: snapshots monitor: use masks unit to match file names, it supports ????? like masks too.

Browse Source 
git-svn-id: trunk@14929 -
This commit is contained in:
vincents 2008-04-22 09:04:42 +00:00
parent 8a7e588df6
commit 9b8fd9c590
4 changed files with 34 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
tools/snapshots/checksnapshotsgui.lpi
View File

@ -2,7 +2,7 @@
<CONFIG> <CONFIG>
<ProjectOptions> <ProjectOptions>
<PathDelim Value="\"/> <PathDelim Value="\"/>
<Version Value="5"/> <Version Value="6"/>
<General> <General>
<SessionStorage Value="InProjectDir"/> <SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/> <MainUnit Value="0"/>

2
tools/snapshots/ftplistertest.pas
View File

@ -51,7 +51,7 @@ begin
FtpFile := TFtpFile.Create(FtpLine); FtpFile := TFtpFile.Create(FtpLine);
try try
AssertEquals('Wrong file name:', 'Lazarus-0.9.19-fpc-2.0.4-20061022-win32.exe', FtpFile.FileName); AssertEquals('Wrong file name:', 'Lazarus-0.9.19-fpc-2.0.4-20061022-win32.exe', FtpFile.FileName);
AssertEquals('Wrong file date', '22-10-2007 14:34:00', DateTimeToStr(FtpFile.FileDate)); AssertEquals('Wrong file date', '22-10-2008 14:34:00', DateTimeToStr(FtpFile.FileDate));
finally finally
FtpFile.Free; FtpFile.Free;
end; end;

28
tools/snapshots/monitorconfig.xml
View File

@ -17,16 +17,32 @@
/> />
<File <File
Mask="Lazarus-$LAZVER-fpc-$FPCRELEASEVER-*-win32.exe" Mask="Lazarus-$LAZVER-fpc-$FPCRELEASEVER-*-win32.exe"
Description="Lazarus win32 with fpc fixes branch ($FPCRELEASEVER)" Description="Lazarus win32 with fpc release ($FPCRELEASEVER)"
/> />
<File <File
Mask="Lazarus-$LAZVER-fpc-$FPCFIXESVER-*-win32.exe" Mask="Lazarus-$LAZVER-fpc-$FPCFIXESVER-????????-win32.exe"
Description="Lazarus win32 with fpc fixes branch ($FPCFIXESVER)" Description="Lazarus win32 with fpc fixes branch ($FPCFIXESVER)"
/> />
<File
Mask="Lazarus-$LAZVER-fpc-$FPCFIXESVER-????????-cross-arm-wince-win32.exe"
Description="Lazarus win32 cross arm-wince with fpc fixes branch ($FPCFIXESVER)"
/>
<File
Mask="Lazarus-$LAZVER-fpc-$FPCDEVELVER-????????-win32.exe"
Description="Lazarus win32 with fpc development branch ($FPCDEVELVER)"
/>
<File
Mask="Lazarus-$LAZVER-fpc-$FPCRELEASEVER-*-win64.exe"
Description="Lazarus win64 with fpc release ($FPCRELEASEVER)"
/>
<File <File
Mask="Lazarus-$LAZVER-fpc-$FPCFIXESVER-*-win64.exe" Mask="Lazarus-$LAZVER-fpc-$FPCFIXESVER-*-win64.exe"
Description="Lazarus win64 with fpc fixes branch ($FPCFIXESVER)" Description="Lazarus win64 with fpc fixes branch ($FPCFIXESVER)"
/> />
<File
Mask="Lazarus-$LAZVER-fpc-$FPCDEVELVER-*-win64.exe"
Description="Lazarus win64 with fpc fixes branch ($FPCDEVELVER)"
/>
<File <File
Mask="fpc-$FPCRELEASEVER-*-powerpc-macosx.dmg" Mask="fpc-$FPCRELEASEVER-*-powerpc-macosx.dmg"
Description="fpc $FPCRELEASEVER Mac OS X powerpc" Description="fpc $FPCRELEASEVER Mac OS X powerpc"
@ -40,12 +56,12 @@
Description="lazarus Mac OS X powerpc" Description="lazarus Mac OS X powerpc"
/> />
<File <File
Mask="fpc-$FPCFIXESVER-*-i386-macosx.dmg" Mask="fpc-$FPCRELEASEVER-*-i386-macosx.dmg"
Description="fpc $FPCFIXESVER Mac OS X i386" Description="fpc $FPCRELEASEVER Mac OS X i386"
/> />
<File <File
Mask="fpcsrc-$FPCFIXESVER-*-i386-macosx.dmg" Mask="fpcsrc-$FPCRELEASEVER-*-i386-macosx.dmg"
Description="fpc source $FPCFIXESVER Mac OS X i386" Description="fpc source $FPCRELEASEVER Mac OS X i386"
/> />
<File <File
Mask="lazarus-$LAZVER-*-i386-macosx.dmg" Mask="lazarus-$LAZVER-*-i386-macosx.dmg"

26
tools/snapshots/snapshotsuptodate.pas
View File

@ -22,7 +22,7 @@ type
property MatchingFiles: TStrings read GetMatchingFiles; property MatchingFiles: TStrings read GetMatchingFiles;
public public
class function FileMaskSuite(const AName, AFileMask: string): TTestSuite; class function FileMaskSuite(const AName, AFileMask: string): TTestSuite;
constructor Create(const AName, AFileMask, ATestName: string); constructor Create(const AName, AFileMask, ATestName: string); reintroduce;
destructor Destroy; override; destructor Destroy; override;
published published
procedure TestHookUp; procedure TestHookUp;
@ -33,7 +33,7 @@ type
implementation implementation
uses uses
monitorcfg; monitorcfg, masks;
var var
FileList: TStrings; FileList: TStrings;
@ -53,25 +53,19 @@ end;
function TFtpMonitorTestcase.GetMatchingFiles: TStrings; function TFtpMonitorTestcase.GetMatchingFiles: TStrings;
var var
i: integer; i: integer;
starpos: integer; FileMask: TMask;
FirstPart, LastPart: string; FtpFile: TFtpFile;
FtpFile : TFtpFile;
begin begin
if not assigned(FMatchingFiles) then begin if not assigned(FMatchingFiles) then begin
starpos := pos('*', FFileMask); FileMask := TMask.Create(FFileMask);
if starpos=0 then
Fail('Invalid Filemask: '+ FFileMask);
FirstPart := Copy(FFileMask, 1, starpos-1);
LastPart := Copy(FFileMask, starpos + 1, Length(FFileMask)-starpos);
FMatchingFiles := TStringList.Create; FMatchingFiles := TStringList.Create;
for i := 0 to Files.Count-1 do begin for i := 0 to Files.Count-1 do
begin
FtpFile := TFtpFile.Create(Files[i]); FtpFile := TFtpFile.Create(Files[i]);
if (copy(FtpFile.FileName, 1, starpos-1)=FirstPart) if FileMask.Matches(FtpFile.FileName) then
and (copy(FtpFile.FileName, Length(FtpFile.FileName)-Length(LastPart)+1, Length(LastPart))=LastPart) then FMatchingFiles.AddObject(FtpFile.FileName, FtpFile);
FMatchingFiles.AddObject(FtpFile.FileName, FtpFile)
else
FtpFile.Free;
end; end;
FileMask.Free;
end; end;
Result := FMatchingFiles; Result := FMatchingFiles;
end; end;