snapshot monitor tool:

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

git-svn-id: trunk@11127 -

tools/snapshots/checksnapshots.lpi

@@ -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>

tools/snapshots/checksnapshotsgui.lpi

@@ -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>

tools/snapshots/monitorcfg.pas

@@ -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');
+  NewFile.Description := OnReplaceString(GetAttributeValue(ServerNode, 'Description'));
-  if assigned(Attribute) then
+  NewFile.Mask := OnReplaceString(GetAttributeValue(ServerNode, 'Mask'));
-    NewFile.Description := Attribute.NodeValue;
+
-  Attribute := ServerNode.Attributes.GetNamedItem('Mask');
-  if assigned(Attribute) then
-    NewFile.Mask := Attribute.NodeValue;
   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

tools/snapshots/monitorconfig.xml

@@ -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"
+            Mask="Lazarus-$LAZVER-fpc-$FPCRELEASEVER-*-win32.exe"
-            Description="Lazarus win32 fpc 2.0.4"
+            Description="Lazarus win32 with fpc fixes branch ($FPCRELEASEVER)"
         />
         <File
-            Mask="Lazarus-0.9.23-fpc-2.1.3-*-win32.exe"
+            Mask="Lazarus-$LAZVER-fpc-$FPCFIXESVER-*-win32.exe"
-            Description="Lazarus win32 fpc 2.1.3"
+            Description="Lazarus win32 with fpc fixes branch ($FPCFIXESVER)"
         />
         <File
-            Mask="Lazarus-0.9.23-fpc-2.1.3-*-win64.exe"
+            Mask="Lazarus-$LAZVER-fpc-$FPCFIXESVER-*-win64.exe"
-            Description="Lazarus win64 fpc 2.1.3"
+            Description="Lazarus win64 with fpc fixes branch ($FPCFIXESVER)"
         />
         <File
-            Mask="fpc-2.0.4-*-powerpc-macosx.dmg"
+            Mask="fpc-$FPCRELEASEVER-*-powerpc-macosx.dmg"
-            Description="fpc 2.0.4 Mac OS X powerpc"
+            Description="fpc $FPCRELEASEVER Mac OS X powerpc"
         />
         <File
-            Mask="fpcsrc-2.0.4-*-powerpc-macosx.dmg"
+            Mask="fpcsrc-$FPCRELEASEVER-*-powerpc-macosx.dmg"
-            Description="fpc source 2.0.4 Mac OS X powerpc"
+            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"
+            Mask="fpc-$FPCFIXESVER-*-i386-macosx.dmg"
-            Description="fpc 2.1.3 Mac OS X i386"
+            Description="fpc $FPCFIXESVER Mac OS X i386"
         />
         <File
-            Mask="fpcsrc-2.1.3-*-i386-macosx.dmg"
+            Mask="fpcsrc-$FPCFIXESVER-*-i386-macosx.dmg"
-            Description="fpc source 2.1.3 Mac OS X i386"
+            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"
+            Mask="fpc-$FPCRELEASEVER-*.src.rpm"
-            Description="fpc 2.0.4 source rpm"
+            Description="fpc $FPCRELEASEVER source rpm"
         />
         <File
-            Mask="fpc-2.0.4-*.i386.rpm"
+            Mask="fpc-$FPCRELEASEVER-*.i386.rpm"
-            Description="fpc 2.0.4 i386 rpm"
+            Description="fpc $FPCRELEASEVER i386 rpm"
         />
         <File
-            Mask="fpc-src-2.0.4-*.i386.rpm"
+            Mask="fpc-src-$FPCRELEASEVER-*.i386.rpm"
-            Description="fpc source 2.0.4 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"
+            Mask="fpc-$FPCRELEASEVER-*.x86_64.rpm"
-            Description="fpc 2.0.4 x86_64 rpm"
+            Description="fpc $FPCRELEASEVER x86_64 rpm"
         />
         <File
-            Mask="fpc-src-2.0.4-*.x86_64.rpm"
+            Mask="fpc-src-$FPCRELEASEVER-*.x86_64.rpm"
-            Description="fpc source 2.0.4 x86_64 rpm"
+            Description="fpc source $FPCRELEASEVER x86_64 rpm"
         />
         <File
             Mask="lazarus-*.x86_64.rpm"

tools/snapshots/snapshotsuptodate.pas

@@ -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;

tools/snapshots/testmonitorcfg.pas

@@ -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,17 +28,25 @@ 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;
+  FMonitorCfg.Load('monitorconfig.xml');
 end;
 
 procedure TTestMonitorCfg.TearDown; 
@@ -45,6 +56,6 @@ end;
 
 initialization
 
-  //RegisterTest(TTestMonitorCfg);
+  RegisterTest(TTestMonitorCfg);
 end.