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

snapshot monitor tool:

Browse Source 
* allow 2 hour time difference
* centralized fpc and lazarus version numbers

git-svn-id: trunk@11127 -
This commit is contained in:
vincents 2007-05-11 16:38:16 +00:00
parent 0312cb2ee4
commit 52d30339d8
6 changed files with 98 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
tools/snapshots/checksnapshots.lpi
View File

@ -15,7 +15,6 @@
</VersionInfo>
<PublishOptions>
<Version Value="2"/>
<IgnoreBinaries Value="False"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>

1
tools/snapshots/checksnapshotsgui.lpi
View File

@ -14,7 +14,6 @@
</VersionInfo>
<PublishOptions>
<Version Value="2"/>
<IgnoreBinaries Value="False"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>

56
tools/snapshots/monitorcfg.pas
View File

@ -5,7 +5,7 @@ unit MonitorCfg;
interface
uses
contnrs, dom, xmlread;
strutils, contnrs, dom, xmlread;
type
TServerType = (stFtp, stHttp);
@ -13,21 +13,33 @@ type
TServer = class;
TFile = class;
TReplaceStringEvent = function (const value: string):string of object;
{ TMonitorConfig }
TMonitorConfig = class
private
FFileName: string;
FFPCDevelVersion: string;
FFPCFixesVersion: string;
FFPCReleaseVersion: string;
FLazVersion: string;
FServers: TFPObjectList;
function GetServer(index: integer): TServer;
function GetServerCount: integer;
procedure AddServer(const ServerNode: TDOMNode);
procedure ReadVersions(const VersionNode: TDOMNode);
function ServerReplaceString(const value: string): string;
public
constructor Create;
destructor Destroy; override;
procedure Load(const AFileName: string);
procedure AddServer(AServer: TServer);
property FileName: string read FFileName write FFileName;
property LazVersion: string read FLazVersion;
property FPCReleaseVersion: string read FFPCReleaseVersion;
property FPCFixesVersion: string read FFPCFixesVersion;
property FPCDevelVersion: string read FFPCDevelVersion;
property Servers[index: integer] : TServer read GetServer;
property ServerCount: integer read GetServerCount;
end;
@ -38,6 +50,7 @@ type
private
FFiles: TFPObjectList;
FDescription: string;
FOnReplaceString: TReplaceStringEvent;
FServerType: TServerType;
function GetFile(index: integer): TFile;
function GetFileCount: integer;
@ -50,6 +63,7 @@ type
property ServerType : TServerType read FServerType write FServerType;
property Files[index: integer] : TFile read GetFile;
property FileCount: integer read GetFileCount;
property OnReplaceString: TReplaceStringEvent read FOnReplaceString write FOnReplaceString;
end;
{ TFile }
@ -66,6 +80,15 @@ type
implementation
function GetAttributeValue(const ANode: TDomNode; const AName: string): string;
var
Attribute: TDOMNode;
begin
Attribute := ANode.Attributes.GetNamedItem(AName);
if assigned(Attribute) then
Result := Attribute.NodeValue;
end;
{ TServer }
function TServer.GetFile(index: integer): TFile;
@ -81,15 +104,11 @@ end;
procedure TServer.AddFile(const ServerNode: TDOMNode);
var
NewFile: TFile;
Attribute: TDOMNode;
begin
NewFile := TFile.Create;
Attribute := ServerNode.Attributes.GetNamedItem('Description');
if assigned(Attribute) then
NewFile.Description := Attribute.NodeValue;
Attribute := ServerNode.Attributes.GetNamedItem('Mask');
if assigned(Attribute) then
NewFile.Mask := Attribute.NodeValue;
NewFile.Description := OnReplaceString(GetAttributeValue(ServerNode, 'Description'));
NewFile.Mask := OnReplaceString(GetAttributeValue(ServerNode, 'Mask'));
AddFile(NewFile);
end;
@ -134,6 +153,7 @@ var
Node: TDomNode;
begin
Server := TServer.Create;
Server.OnReplaceString := @ServerReplaceString;
Attribute := ServerNode.Attributes.GetNamedItem('Name');
if assigned(Attribute) then
Server.Description := Attribute.NodeValue;
@ -152,6 +172,22 @@ begin
AddServer(Server);
end;
procedure TMonitorConfig.ReadVersions(const VersionNode: TDOMNode);
begin
FLazVersion := GetAttributeValue(VersionNode, 'Lazarus');
FFPCReleaseVersion := GetAttributeValue(VersionNode, 'FPC_Release');
FFPCFixesVersion := GetAttributeValue(VersionNode, 'FPC_Fixes');
FFPCDevelVersion := GetAttributeValue(VersionNode, 'FPC_Devel');
end;
function TMonitorConfig.ServerReplaceString(const value: string): string;
begin
Result := AnsiReplaceStr(Value, '$LAZVER', LazVersion);
Result := AnsiReplaceStr(Result, '$FPCRELEASEVER', FPCReleaseVersion);
Result := AnsiReplaceStr(Result, '$FPCFIXESVER', FPCFixesVersion);
Result := AnsiReplaceStr(Result, '$FPCDEVELVER', FPCDevelVersion);
end;
constructor TMonitorConfig.Create;
begin
FServers := TFPObjectList.Create;
@ -175,7 +211,9 @@ begin
Node := XmlDoc.DocumentElement.FirstChild;
while Node<>nil do begin
if Node.NodeName='Server' then
AddServer(Node);
AddServer(Node)
else if Node.NodeName='Version' then
ReadVersions(Node);
Node := Node.NextSibling;
end;
finally

64
tools/snapshots/monitorconfig.xml
View File

@ -1,73 +1,79 @@
<?xml version="1.0" ?>
<CONFIG LazVersion="0.9.21">
<CONFIG>
<Version
Lazarus="0.9.23"
FPC_Release="2.0.4"
FPC_Fixes="2.1.5"
FPC_Devel="2.3.1"
/>
<Server Type="ftp" Name="Snapshot on scenergy">
<File
Mask="lazarus-0.9.23-*-src.zip"
Mask="lazarus-$LAZVER-*-src.zip"
Description="Lazarus source zip"
/>
<File
Mask="lazarus-0.9.23-*-src.tar.bz2"
Mask="lazarus-$LAZVER-*-src.tar.bz2"
Description="Lazarus source bzip2"
/>
<File
Mask="Lazarus-0.9.23-fpc-2.0.4-*-win32.exe"
Description="Lazarus win32 fpc 2.0.4"
Mask="Lazarus-$LAZVER-fpc-$FPCRELEASEVER-*-win32.exe"
Description="Lazarus win32 with fpc fixes branch ($FPCRELEASEVER)"
/>
<File
Mask="Lazarus-0.9.23-fpc-2.1.3-*-win32.exe"
Description="Lazarus win32 fpc 2.1.3"
Mask="Lazarus-$LAZVER-fpc-$FPCFIXESVER-*-win32.exe"
Description="Lazarus win32 with fpc fixes branch ($FPCFIXESVER)"
/>
<File
Mask="Lazarus-0.9.23-fpc-2.1.3-*-win64.exe"
Description="Lazarus win64 fpc 2.1.3"
Mask="Lazarus-$LAZVER-fpc-$FPCFIXESVER-*-win64.exe"
Description="Lazarus win64 with fpc fixes branch ($FPCFIXESVER)"
/>
<File
Mask="fpc-2.0.4-*-powerpc-macosx.dmg"
Description="fpc 2.0.4 Mac OS X powerpc"
Mask="fpc-$FPCRELEASEVER-*-powerpc-macosx.dmg"
Description="fpc $FPCRELEASEVER Mac OS X powerpc"
/>
<File
Mask="fpcsrc-2.0.4-*-powerpc-macosx.dmg"
Description="fpc source 2.0.4 Mac OS X powerpc"
Mask="fpcsrc-$FPCRELEASEVER-*-powerpc-macosx.dmg"
Description="fpc source $FPCRELEASEVER Mac OS X powerpc"
/>
<File
Mask="lazarus-0.9.23-*-powerpc-macosx.dmg"
Mask="lazarus-$LAZVER-*-powerpc-macosx.dmg"
Description="lazarus Mac OS X powerpc"
/>
<File
Mask="fpc-2.1.3-*-i386-macosx.dmg"
Description="fpc 2.1.3 Mac OS X i386"
Mask="fpc-$FPCFIXESVER-*-i386-macosx.dmg"
Description="fpc $FPCFIXESVER Mac OS X i386"
/>
<File
Mask="fpcsrc-2.1.3-*-i386-macosx.dmg"
Description="fpc source 2.1.3 Mac OS X i386"
Mask="fpcsrc-$FPCFIXESVER-*-i386-macosx.dmg"
Description="fpc source $FPCFIXESVER Mac OS X i386"
/>
<File
Mask="lazarus-0.9.23-*-i386-macosx.dmg"
Mask="lazarus-$LAZVER-*-i386-macosx.dmg"
Description="lazarus Mac OS X i386"
/>
<File
Mask="fpc-2.0.4-*.src.rpm"
Description="fpc 2.0.4 source rpm"
Mask="fpc-$FPCRELEASEVER-*.src.rpm"
Description="fpc $FPCRELEASEVER source rpm"
/>
<File
Mask="fpc-2.0.4-*.i386.rpm"
Description="fpc 2.0.4 i386 rpm"
Mask="fpc-$FPCRELEASEVER-*.i386.rpm"
Description="fpc $FPCRELEASEVER i386 rpm"
/>
<File
Mask="fpc-src-2.0.4-*.i386.rpm"
Description="fpc source 2.0.4 i386 rpm"
Mask="fpc-src-$FPCRELEASEVER-*.i386.rpm"
Description="fpc source $FPCRELEASEVER i386 rpm"
/>
<File
Mask="lazarus-*.i386.rpm"
Description="lazarus i386 rpm"
/>
<File
Mask="fpc-2.0.4-*.x86_64.rpm"
Description="fpc 2.0.4 x86_64 rpm"
Mask="fpc-$FPCRELEASEVER-*.x86_64.rpm"
Description="fpc $FPCRELEASEVER x86_64 rpm"
/>
<File
Mask="fpc-src-2.0.4-*.x86_64.rpm"
Description="fpc source 2.0.4 x86_64 rpm"
Mask="fpc-src-$FPCRELEASEVER-*.x86_64.rpm"
Description="fpc source $FPCRELEASEVER x86_64 rpm"
/>
<File
Mask="lazarus-*.x86_64.rpm"

2
tools/snapshots/snapshotsuptodate.pas
View File

@ -121,7 +121,7 @@ begin
FtpFile := TFtpFile(MatchingFiles.Objects[0]);
AssertTrue(
FtpFile.FileName +' is too old: ' + DateTimeToStr(FtpFile.FileDate),
(Now - FtpFile.FileDate) < 1.0);
(Now - FtpFile.FileDate) < (26/24));
end;
procedure InitFromXml;

19
tools/snapshots/testmonitorcfg.pas
View File

@ -9,6 +9,8 @@ uses
type
{ TTestMonitorCfg }
TTestMonitorCfg= class(TTestCase)
private
FMonitorCfg: TMonitorConfig;
@ -17,6 +19,7 @@ type
procedure TearDown; override;
published
procedure Test;
procedure TestVersion;
end;
implementation
@ -25,18 +28,26 @@ procedure TTestMonitorCfg.Test;
var
Server : TServer;
begin
FMonitorCfg.Load('monitorconfig.xml');
AssertEquals('Wrong number of servers', 1, FMonitorCfg.ServerCount);
Server := FMonitorCfg.Servers[0];
AssertEquals(ord(stFtp), ord(Server.ServerType));
AssertEquals('Snapshot on scenergy', Server.Description);
AssertEquals('Wrong number of files', 7, Server.FileCount);
AssertEquals('Wrong number of files', 18, Server.FileCount);
end;
procedure TTestMonitorCfg.TestVersion;
begin
AssertEquals('Wrong Lazarus Version', '0.9.23', FMonitorCfg.LazVersion);
AssertEquals('Wrong FPC Release Version', '2.0.4', FMonitorCfg.FPCReleaseVersion);
AssertEquals('Wrong FPC Fixes Version', '2.1.5', FMonitorCfg.FPCFixesVersion);
AssertEquals('Wrong FPC Devel Version', '2.3.1', FMonitorCfg.FPCDevelVersion);
end;
procedure TTestMonitorCfg.SetUp;
begin
FMonitorCfg := TMonitorConfig.Create;
end;
FMonitorCfg.Load('monitorconfig.xml');
end;
procedure TTestMonitorCfg.TearDown;
begin
@ -45,6 +56,6 @@ end;
initialization
//RegisterTest(TTestMonitorCfg);
RegisterTest(TTestMonitorCfg);
end.