mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-07 08:58:23 +02:00
tools: initial check in of monitoring tool for snapshots, needs further clean up
git-svn-id: trunk@11003 -
This commit is contained in:
vincents
parent
029d4f6327
commit
be4e0c2b3c
11
.gitattributes
vendored
11
.gitattributes
vendored
@ -3030,6 +3030,17 @@ tools/lazres.lpi svneol=native#text/plain
|
||||
tools/lazres.pp svneol=native#text/pascal
|
||||
tools/lfm_to_lrs.sh svneol=native#text/plain
|
||||
tools/runwait.sh -text svneol=native#application/x-sh
|
||||
tools/snapshots/checksnapshots.lpi svneol=native#text/plain
|
||||
tools/snapshots/checksnapshots.lpr svneol=native#text/plain
|
||||
tools/snapshots/checksnapshotsgui.lpi svneol=native#text/plain
|
||||
tools/snapshots/checksnapshotsgui.lpr svneol=native#text/plain
|
||||
tools/snapshots/ftplister.pas svneol=native#text/plain
|
||||
tools/snapshots/ftplistertest.pas svneol=native#text/plain
|
||||
tools/snapshots/monitorcfg.pas svneol=native#text/plain
|
||||
tools/snapshots/monitorconfig.xml svneol=native#text/plain
|
||||
tools/snapshots/runchecksnapshots.bat svneol=native#text/plain
|
||||
tools/snapshots/snapshotsuptodate.pas svneol=native#text/plain
|
||||
tools/snapshots/testmonitorcfg.pas svneol=native#text/plain
|
||||
tools/svn2revisioninc.lpi svneol=native#text/plain
|
||||
tools/svn2revisioninc.pas svneol=native#text/plain
|
||||
tools/update_pkgfileslcl_inc.sh svneol=native#text/plain
|
||||
|
||||
464
tools/snapshots/checksnapshots.lpi
Normal file
464
tools/snapshots/checksnapshots.lpi
Normal file
@ -0,0 +1,464 @@
|
||||
<?xml version="1.0"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<PathDelim Value="\"/>
|
||||
<Version Value="5"/>
|
||||
<General>
|
||||
<MainUnit Value="0"/>
|
||||
<IconPath Value="./"/>
|
||||
<TargetFileExt Value=".exe"/>
|
||||
<Title Value="Lazarus snapshots monitor"/>
|
||||
<ActiveEditorIndexAtStart Value="6"/>
|
||||
</General>
|
||||
<VersionInfo>
|
||||
<ProjectVersion Value=""/>
|
||||
</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>
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
<CommandLineParams Value="-a -p"/>
|
||||
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="3">
|
||||
<Item1>
|
||||
<PackageName Value="lnetbase"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="FPCUnitConsoleRunner"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<PackageName Value="FCL"/>
|
||||
</Item3>
|
||||
</RequiredPackages>
|
||||
<Units Count="31">
|
||||
<Unit0>
|
||||
<Filename Value="checksnapshots.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="checksnapshots"/>
|
||||
<CursorPos X="57" Y="6"/>
|
||||
<TopLine Value="1"/>
|
||||
<EditorIndex Value="5"/>
|
||||
<UsageCount Value="218"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="snapshotsuptodate.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="SnapshotsUptodate"/>
|
||||
<CursorPos X="72" Y="46"/>
|
||||
<TopLine Value="29"/>
|
||||
<EditorIndex Value="0"/>
|
||||
<UsageCount Value="218"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit1>
|
||||
<Unit2>
|
||||
<Filename Value="..\..\components\fpcunit\console\consoletestrunner.pas"/>
|
||||
<UnitName Value="consoletestrunner"/>
|
||||
<CursorPos X="32" Y="30"/>
|
||||
<TopLine Value="1"/>
|
||||
<EditorIndex Value="4"/>
|
||||
<UsageCount Value="109"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit2>
|
||||
<Unit3>
|
||||
<Filename Value="..\..\..\fpc\fpcprojects\lnet\tags\release_0_4_0\examples\console\lftp\lftpclient.pas"/>
|
||||
<UnitName Value="lFTPClient"/>
|
||||
<CursorPos X="25" Y="146"/>
|
||||
<TopLine Value="12"/>
|
||||
<UsageCount Value="75"/>
|
||||
</Unit3>
|
||||
<Unit4>
|
||||
<Filename Value="..\..\..\fpc\fpcprojects\lnet\trunk\lib\lftp.pas"/>
|
||||
<UnitName Value="lFTP"/>
|
||||
<CursorPos X="3" Y="825"/>
|
||||
<TopLine Value="823"/>
|
||||
<UsageCount Value="66"/>
|
||||
</Unit4>
|
||||
<Unit5>
|
||||
<Filename Value="..\..\..\fpc\fpcprojects\lnet\trunk\examples\visual\ftp\main.pas"/>
|
||||
<UnitName Value="main"/>
|
||||
<CursorPos X="19" Y="102"/>
|
||||
<TopLine Value="322"/>
|
||||
<UsageCount Value="36"/>
|
||||
</Unit5>
|
||||
<Unit6>
|
||||
<Filename Value="..\testlpi.pas"/>
|
||||
<UnitName Value="TestLpi"/>
|
||||
<CursorPos X="1" Y="70"/>
|
||||
<TopLine Value="66"/>
|
||||
<UsageCount Value="24"/>
|
||||
</Unit6>
|
||||
<Unit7>
|
||||
<Filename Value="ftplister.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="ftplister"/>
|
||||
<CursorPos X="1" Y="55"/>
|
||||
<TopLine Value="25"/>
|
||||
<EditorIndex Value="1"/>
|
||||
<UsageCount Value="235"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit7>
|
||||
<Unit8>
|
||||
<Filename Value="ftplistertest.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="ftplistertest"/>
|
||||
<CursorPos X="53" Y="68"/>
|
||||
<TopLine Value="36"/>
|
||||
<EditorIndex Value="6"/>
|
||||
<UsageCount Value="232"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit8>
|
||||
<Unit9>
|
||||
<Filename Value="monitorconfig.xml"/>
|
||||
<CursorPos X="16" Y="22"/>
|
||||
<TopLine Value="12"/>
|
||||
<UsageCount Value="113"/>
|
||||
<SyntaxHighlighter Value="XML"/>
|
||||
</Unit9>
|
||||
<Unit10>
|
||||
<Filename Value="..\..\..\fpc\fpcprojects\lnet\trunk\lib\lhttp.pas"/>
|
||||
<UnitName Value="lhttp"/>
|
||||
<CursorPos X="75" Y="10"/>
|
||||
<TopLine Value="1"/>
|
||||
<UsageCount Value="5"/>
|
||||
</Unit10>
|
||||
<Unit11>
|
||||
<Filename Value="..\..\..\fpcbuild\2.0.4\fpcsrc\fcl\xml\xmlcfg.pp"/>
|
||||
<UnitName Value="XMLCfg"/>
|
||||
<CursorPos X="44" Y="136"/>
|
||||
<TopLine Value="128"/>
|
||||
<UsageCount Value="146"/>
|
||||
</Unit11>
|
||||
<Unit12>
|
||||
<Filename Value="..\..\..\fpc\fpcprojects\lnet\trunk\lib\lftp.pp"/>
|
||||
<UnitName Value="lFTP"/>
|
||||
<CursorPos X="3" Y="38"/>
|
||||
<TopLine Value="20"/>
|
||||
<EditorIndex Value="2"/>
|
||||
<UsageCount Value="126"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit12>
|
||||
<Unit13>
|
||||
<Filename Value="monitorcfg.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="MonitorCfg"/>
|
||||
<CursorPos X="1" Y="175"/>
|
||||
<TopLine Value="63"/>
|
||||
<EditorIndex Value="3"/>
|
||||
<UsageCount Value="230"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit13>
|
||||
<Unit14>
|
||||
<Filename Value="..\..\..\fpc\2.1\rtl\win32\classes.pp"/>
|
||||
<UnitName Value="Classes"/>
|
||||
<CursorPos X="13" Y="35"/>
|
||||
<TopLine Value="14"/>
|
||||
<UsageCount Value="113"/>
|
||||
</Unit14>
|
||||
<Unit15>
|
||||
<Filename Value="..\..\..\fpc\2.1\rtl\objpas\classes\classesh.inc"/>
|
||||
<CursorPos X="17" Y="483"/>
|
||||
<TopLine Value="465"/>
|
||||
<UsageCount Value="113"/>
|
||||
</Unit15>
|
||||
<Unit16>
|
||||
<Filename Value="..\..\..\fpc\2.1\fcl\inc\contnrs.pp"/>
|
||||
<UnitName Value="contnrs"/>
|
||||
<CursorPos X="3" Y="491"/>
|
||||
<TopLine Value="489"/>
|
||||
<UsageCount Value="113"/>
|
||||
</Unit16>
|
||||
<Unit17>
|
||||
<Filename Value="testmonitorcfg.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="TestMonitorCfg"/>
|
||||
<CursorPos X="5" Y="48"/>
|
||||
<TopLine Value="14"/>
|
||||
<UsageCount Value="168"/>
|
||||
</Unit17>
|
||||
<Unit18>
|
||||
<Filename Value="..\..\..\fpc\2.1\fcl\inc\custapp.pp"/>
|
||||
<UnitName Value="CustApp"/>
|
||||
<CursorPos X="90" Y="25"/>
|
||||
<TopLine Value="8"/>
|
||||
<UsageCount Value="82"/>
|
||||
</Unit18>
|
||||
<Unit19>
|
||||
<Filename Value="..\..\lcl\dialogs.pp"/>
|
||||
<UnitName Value="Dialogs"/>
|
||||
<CursorPos X="17" Y="566"/>
|
||||
<TopLine Value="493"/>
|
||||
<UsageCount Value="79"/>
|
||||
</Unit19>
|
||||
<Unit20>
|
||||
<Filename Value="..\..\..\fpc\2.1\compiler\x86\cgx86.pas"/>
|
||||
<UnitName Value="cgx86"/>
|
||||
<CursorPos X="49" Y="185"/>
|
||||
<TopLine Value="183"/>
|
||||
<UsageCount Value="65"/>
|
||||
</Unit20>
|
||||
<Unit21>
|
||||
<Filename Value="..\..\lcl\interfaces\win32\win32wsmenus.pp"/>
|
||||
<UnitName Value="Win32WSMenus"/>
|
||||
<CursorPos X="7" Y="580"/>
|
||||
<TopLine Value="27"/>
|
||||
<UsageCount Value="8"/>
|
||||
</Unit21>
|
||||
<Unit22>
|
||||
<Filename Value="..\..\..\..\projects\TAGraph\Component\TAGraph.pas"/>
|
||||
<UnitName Value="tagraph"/>
|
||||
<CursorPos X="1" Y="1"/>
|
||||
<TopLine Value="33"/>
|
||||
<UsageCount Value="10"/>
|
||||
</Unit22>
|
||||
<Unit23>
|
||||
<Filename Value="..\..\lcl\graphics.pp"/>
|
||||
<UnitName Value="Graphics"/>
|
||||
<CursorPos X="15" Y="913"/>
|
||||
<TopLine Value="895"/>
|
||||
<UsageCount Value="10"/>
|
||||
</Unit23>
|
||||
<Unit24>
|
||||
<Filename Value="..\..\lcl\interfaces\win32\win32listsl.inc"/>
|
||||
<CursorPos X="21" Y="144"/>
|
||||
<TopLine Value="104"/>
|
||||
<UsageCount Value="10"/>
|
||||
</Unit24>
|
||||
<Unit25>
|
||||
<Filename Value="..\..\..\fpc\2.1\rtl\objpas\classes\stringl.inc"/>
|
||||
<CursorPos X="62" Y="574"/>
|
||||
<TopLine Value="558"/>
|
||||
<UsageCount Value="10"/>
|
||||
</Unit25>
|
||||
<Unit26>
|
||||
<Filename Value="runchecksnapshots.bat"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<CursorPos X="67" Y="1"/>
|
||||
<TopLine Value="1"/>
|
||||
<UsageCount Value="27"/>
|
||||
<SyntaxHighlighter Value="None"/>
|
||||
</Unit26>
|
||||
<Unit27>
|
||||
<Filename Value="..\..\..\fpc\2.1\rtl\inc\wstringh.inc"/>
|
||||
<CursorPos X="10" Y="84"/>
|
||||
<TopLine Value="63"/>
|
||||
<UsageCount Value="12"/>
|
||||
</Unit27>
|
||||
<Unit28>
|
||||
<Filename Value="..\..\..\fpc\2.1\rtl\inc\wstrings.inc"/>
|
||||
<CursorPos X="20" Y="1458"/>
|
||||
<TopLine Value="1458"/>
|
||||
<UsageCount Value="10"/>
|
||||
</Unit28>
|
||||
<Unit29>
|
||||
<Filename Value="..\..\lcl\dbgrids.pas"/>
|
||||
<UnitName Value="DBGrids"/>
|
||||
<CursorPos X="15" Y="590"/>
|
||||
<TopLine Value="586"/>
|
||||
<UsageCount Value="12"/>
|
||||
</Unit29>
|
||||
<Unit30>
|
||||
<Filename Value="..\..\lcl\include\defaultbitbtnimages.inc"/>
|
||||
<CursorPos X="28" Y="513"/>
|
||||
<TopLine Value="477"/>
|
||||
<UsageCount Value="12"/>
|
||||
</Unit30>
|
||||
</Units>
|
||||
<JumpHistory Count="29" HistoryIndex="28">
|
||||
<Position1>
|
||||
<Filename Value="snapshotsuptodate.pas"/>
|
||||
<Caret Line="47" Column="1" TopLine="29"/>
|
||||
</Position1>
|
||||
<Position2>
|
||||
<Filename Value="ftplister.pas"/>
|
||||
<Caret Line="148" Column="1" TopLine="130"/>
|
||||
</Position2>
|
||||
<Position3>
|
||||
<Filename Value="ftplister.pas"/>
|
||||
<Caret Line="147" Column="1" TopLine="129"/>
|
||||
</Position3>
|
||||
<Position4>
|
||||
<Filename Value="ftplister.pas"/>
|
||||
<Caret Line="148" Column="1" TopLine="130"/>
|
||||
</Position4>
|
||||
<Position5>
|
||||
<Filename Value="ftplister.pas"/>
|
||||
<Caret Line="147" Column="1" TopLine="129"/>
|
||||
</Position5>
|
||||
<Position6>
|
||||
<Filename Value="ftplister.pas"/>
|
||||
<Caret Line="148" Column="1" TopLine="130"/>
|
||||
</Position6>
|
||||
<Position7>
|
||||
<Filename Value="ftplister.pas"/>
|
||||
<Caret Line="147" Column="1" TopLine="129"/>
|
||||
</Position7>
|
||||
<Position8>
|
||||
<Filename Value="ftplister.pas"/>
|
||||
<Caret Line="148" Column="1" TopLine="130"/>
|
||||
</Position8>
|
||||
<Position9>
|
||||
<Filename Value="ftplister.pas"/>
|
||||
<Caret Line="147" Column="1" TopLine="129"/>
|
||||
</Position9>
|
||||
<Position10>
|
||||
<Filename Value="ftplister.pas"/>
|
||||
<Caret Line="148" Column="1" TopLine="130"/>
|
||||
</Position10>
|
||||
<Position11>
|
||||
<Filename Value="ftplister.pas"/>
|
||||
<Caret Line="147" Column="1" TopLine="129"/>
|
||||
</Position11>
|
||||
<Position12>
|
||||
<Filename Value="ftplister.pas"/>
|
||||
<Caret Line="148" Column="1" TopLine="130"/>
|
||||
</Position12>
|
||||
<Position13>
|
||||
<Filename Value="ftplister.pas"/>
|
||||
<Caret Line="147" Column="1" TopLine="129"/>
|
||||
</Position13>
|
||||
<Position14>
|
||||
<Filename Value="ftplister.pas"/>
|
||||
<Caret Line="148" Column="1" TopLine="130"/>
|
||||
</Position14>
|
||||
<Position15>
|
||||
<Filename Value="ftplister.pas"/>
|
||||
<Caret Line="147" Column="1" TopLine="129"/>
|
||||
</Position15>
|
||||
<Position16>
|
||||
<Filename Value="ftplister.pas"/>
|
||||
<Caret Line="148" Column="1" TopLine="130"/>
|
||||
</Position16>
|
||||
<Position17>
|
||||
<Filename Value="ftplister.pas"/>
|
||||
<Caret Line="147" Column="1" TopLine="129"/>
|
||||
</Position17>
|
||||
<Position18>
|
||||
<Filename Value="ftplister.pas"/>
|
||||
<Caret Line="148" Column="1" TopLine="130"/>
|
||||
</Position18>
|
||||
<Position19>
|
||||
<Filename Value="ftplister.pas"/>
|
||||
<Caret Line="147" Column="1" TopLine="129"/>
|
||||
</Position19>
|
||||
<Position20>
|
||||
<Filename Value="ftplister.pas"/>
|
||||
<Caret Line="148" Column="1" TopLine="130"/>
|
||||
</Position20>
|
||||
<Position21>
|
||||
<Filename Value="ftplister.pas"/>
|
||||
<Caret Line="147" Column="1" TopLine="129"/>
|
||||
</Position21>
|
||||
<Position22>
|
||||
<Filename Value="ftplister.pas"/>
|
||||
<Caret Line="148" Column="1" TopLine="130"/>
|
||||
</Position22>
|
||||
<Position23>
|
||||
<Filename Value="ftplister.pas"/>
|
||||
<Caret Line="147" Column="1" TopLine="129"/>
|
||||
</Position23>
|
||||
<Position24>
|
||||
<Filename Value="ftplister.pas"/>
|
||||
<Caret Line="148" Column="1" TopLine="130"/>
|
||||
</Position24>
|
||||
<Position25>
|
||||
<Filename Value="ftplister.pas"/>
|
||||
<Caret Line="147" Column="1" TopLine="129"/>
|
||||
</Position25>
|
||||
<Position26>
|
||||
<Filename Value="ftplister.pas"/>
|
||||
<Caret Line="178" Column="1" TopLine="126"/>
|
||||
</Position26>
|
||||
<Position27>
|
||||
<Filename Value="ftplister.pas"/>
|
||||
<Caret Line="101" Column="35" TopLine="83"/>
|
||||
</Position27>
|
||||
<Position28>
|
||||
<Filename Value="checksnapshots.lpr"/>
|
||||
<Caret Line="6" Column="57" TopLine="1"/>
|
||||
</Position28>
|
||||
<Position29>
|
||||
<Filename Value="ftplistertest.pas"/>
|
||||
<Caret Line="16" Column="30" TopLine="15"/>
|
||||
</Position29>
|
||||
</JumpHistory>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="5"/>
|
||||
<PathDelim Value="\"/>
|
||||
<CodeGeneration>
|
||||
<Generate Value="Faster"/>
|
||||
</CodeGeneration>
|
||||
<Linking>
|
||||
<LinkSmart Value="True"/>
|
||||
</Linking>
|
||||
<Other>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<BreakPoints Count="11">
|
||||
<Item1>
|
||||
<Source Value="..\..\..\source\lazarus\ide\main.pp"/>
|
||||
<Line Value="5295"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Source Value="..\..\..\source\fpc\2.1\rtl\objpas\classes\stringl.inc"/>
|
||||
<Line Value="188"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Source Value="..\..\..\source\lazarus\lcl\lresources.pp"/>
|
||||
<Line Value="2114"/>
|
||||
</Item3>
|
||||
<Item4>
|
||||
<Source Value="..\..\..\source\lazarus\lcl\lresources.pp"/>
|
||||
<Line Value="2176"/>
|
||||
</Item4>
|
||||
<Item5>
|
||||
<Source Value="..\..\..\source\lazarus\lcl\lresources.pp"/>
|
||||
<Line Value="1075"/>
|
||||
</Item5>
|
||||
<Item6>
|
||||
<Source Value="..\..\..\source\lazarus\lcl\lresources.pp"/>
|
||||
<Line Value="1077"/>
|
||||
</Item6>
|
||||
<Item7>
|
||||
<Source Value="..\..\..\source\lazarus\ide\main.pp"/>
|
||||
<Line Value="9215"/>
|
||||
</Item7>
|
||||
<Item8>
|
||||
<Source Value="..\..\..\source\lazarus\lcl\lresources.pp"/>
|
||||
<Line Value="2530"/>
|
||||
</Item8>
|
||||
<Item9>
|
||||
<Source Value="snapshotsuptodate.pas"/>
|
||||
<Line Value="47"/>
|
||||
</Item9>
|
||||
<Item10>
|
||||
<Source Value="..\..\..\fpc\fpcprojects\lnet\trunk\lib\lftp.pp"/>
|
||||
<Line Value="904"/>
|
||||
</Item10>
|
||||
<Item11>
|
||||
<Source Value="..\..\..\fpc\fpcprojects\lnet\trunk\lib\lftp.pp"/>
|
||||
<Line Value="903"/>
|
||||
</Item11>
|
||||
</BreakPoints>
|
||||
<Watches Count="1">
|
||||
<Item1>
|
||||
<Expression Value="name"/>
|
||||
</Item1>
|
||||
</Watches>
|
||||
<Exceptions Count="1">
|
||||
<Item1>
|
||||
<Name Value="EAssertionFailedError"/>
|
||||
</Item1>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
27
tools/snapshots/checksnapshots.lpr
Normal file
27
tools/snapshots/checksnapshots.lpr
Normal file
@ -0,0 +1,27 @@
|
||||
program checksnapshots;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
Classes, consoletestrunner,
|
||||
SnapshotsUptodate, ftplistertest, TestMonitorCfg;
|
||||
|
||||
type
|
||||
|
||||
{ TLazTestRunner }
|
||||
|
||||
TMyTestRunner = class(TTestRunner)
|
||||
protected
|
||||
// override the protected methods of TTestRunner to customize its behavior
|
||||
end;
|
||||
|
||||
var
|
||||
Application: TMyTestRunner;
|
||||
|
||||
begin
|
||||
Application := TMyTestRunner.Create(nil);
|
||||
Application.Title:='Lazarus snapshots monitor';
|
||||
Application.Initialize;
|
||||
Application.Run;
|
||||
Application.Free;
|
||||
end.
|
||||
231
tools/snapshots/checksnapshotsgui.lpi
Normal file
231
tools/snapshots/checksnapshotsgui.lpi
Normal file
@ -0,0 +1,231 @@
|
||||
<?xml version="1.0"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<PathDelim Value="\"/>
|
||||
<Version Value="5"/>
|
||||
<General>
|
||||
<MainUnit Value="0"/>
|
||||
<IconPath Value="./"/>
|
||||
<TargetFileExt Value=".exe"/>
|
||||
<ActiveEditorIndexAtStart Value="0"/>
|
||||
</General>
|
||||
<VersionInfo>
|
||||
<ProjectVersion Value=""/>
|
||||
<Language Value=""/>
|
||||
<CharSet Value=""/>
|
||||
</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>
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="4">
|
||||
<Item1>
|
||||
<PackageName Value="lnetbase"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<PackageName Value="FPCUnitTestRunner"/>
|
||||
</Item3>
|
||||
<Item4>
|
||||
<PackageName Value="FCL"/>
|
||||
</Item4>
|
||||
</RequiredPackages>
|
||||
<Units Count="14">
|
||||
<Unit0>
|
||||
<Filename Value="checksnapshotsgui.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="checksnapshotsgui"/>
|
||||
<CursorPos X="21" Y="14"/>
|
||||
<TopLine Value="1"/>
|
||||
<EditorIndex Value="0"/>
|
||||
<UsageCount Value="127"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="..\..\components\fpcunit\guitestrunner.pas"/>
|
||||
<UnitName Value="GuiTestRunner"/>
|
||||
<CursorPos X="3" Y="38"/>
|
||||
<TopLine Value="20"/>
|
||||
<EditorIndex Value="6"/>
|
||||
<UsageCount Value="63"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit1>
|
||||
<Unit2>
|
||||
<Filename Value="..\..\..\fpc\2.1\compiler\systems\i_linux.pas"/>
|
||||
<UnitName Value="i_linux"/>
|
||||
<CursorPos X="44" Y="477"/>
|
||||
<TopLine Value="527"/>
|
||||
<EditorIndex Value="7"/>
|
||||
<UsageCount Value="63"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit2>
|
||||
<Unit3>
|
||||
<Filename Value="..\..\ide\buildlazdialog.pas"/>
|
||||
<UnitName Value="BuildLazDialog"/>
|
||||
<CursorPos X="44" Y="496"/>
|
||||
<TopLine Value="478"/>
|
||||
<EditorIndex Value="8"/>
|
||||
<UsageCount Value="63"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit3>
|
||||
<Unit4>
|
||||
<Filename Value="monitorcfg.pas"/>
|
||||
<UnitName Value="MonitorCfg"/>
|
||||
<CursorPos X="1" Y="131"/>
|
||||
<TopLine Value="107"/>
|
||||
<EditorIndex Value="9"/>
|
||||
<UsageCount Value="63"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit4>
|
||||
<Unit5>
|
||||
<Filename Value="testmonitorcfg.pas"/>
|
||||
<UnitName Value="TestMonitorCfg"/>
|
||||
<CursorPos X="32" Y="32"/>
|
||||
<TopLine Value="8"/>
|
||||
<EditorIndex Value="12"/>
|
||||
<UsageCount Value="63"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit5>
|
||||
<Unit6>
|
||||
<Filename Value="monitorconfig.xml"/>
|
||||
<CursorPos X="82" Y="16"/>
|
||||
<TopLine Value="1"/>
|
||||
<EditorIndex Value="10"/>
|
||||
<UsageCount Value="63"/>
|
||||
<Loaded Value="True"/>
|
||||
<SyntaxHighlighter Value="XML"/>
|
||||
</Unit6>
|
||||
<Unit7>
|
||||
<Filename Value="..\..\lcl\include\customform.inc"/>
|
||||
<CursorPos X="8" Y="1064"/>
|
||||
<TopLine Value="1044"/>
|
||||
<EditorIndex Value="11"/>
|
||||
<UsageCount Value="63"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit7>
|
||||
<Unit8>
|
||||
<Filename Value="..\..\lcl\lresources.pp"/>
|
||||
<UnitName Value="LResources"/>
|
||||
<CursorPos X="1" Y="2607"/>
|
||||
<TopLine Value="2589"/>
|
||||
<EditorIndex Value="13"/>
|
||||
<UsageCount Value="23"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit8>
|
||||
<Unit9>
|
||||
<Filename Value="checksnapshots.lpr"/>
|
||||
<UnitName Value="checksnapshots"/>
|
||||
<CursorPos X="1" Y="8"/>
|
||||
<TopLine Value="1"/>
|
||||
<EditorIndex Value="4"/>
|
||||
<UsageCount Value="23"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit9>
|
||||
<Unit10>
|
||||
<Filename Value="snapshotsuptodate.pas"/>
|
||||
<UnitName Value="SnapshotsUptodate"/>
|
||||
<CursorPos X="47" Y="8"/>
|
||||
<TopLine Value="5"/>
|
||||
<EditorIndex Value="1"/>
|
||||
<UsageCount Value="23"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit10>
|
||||
<Unit11>
|
||||
<Filename Value="ftplister.pas"/>
|
||||
<UnitName Value="ftplister"/>
|
||||
<CursorPos X="28" Y="91"/>
|
||||
<TopLine Value="63"/>
|
||||
<EditorIndex Value="2"/>
|
||||
<UsageCount Value="23"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit11>
|
||||
<Unit12>
|
||||
<Filename Value="..\..\..\fpc\2.1\rtl\objpas\sysutils\dati.inc"/>
|
||||
<CursorPos X="1" Y="489"/>
|
||||
<TopLine Value="471"/>
|
||||
<EditorIndex Value="3"/>
|
||||
<UsageCount Value="23"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit12>
|
||||
<Unit13>
|
||||
<Filename Value="ftplistertest.pas"/>
|
||||
<UnitName Value="ftplistertest"/>
|
||||
<CursorPos X="25" Y="60"/>
|
||||
<TopLine Value="45"/>
|
||||
<EditorIndex Value="5"/>
|
||||
<UsageCount Value="15"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit13>
|
||||
</Units>
|
||||
<JumpHistory Count="9" HistoryIndex="8">
|
||||
<Position1>
|
||||
<Filename Value="checksnapshots.lpr"/>
|
||||
<Caret Line="7" Column="28" TopLine="1"/>
|
||||
</Position1>
|
||||
<Position2>
|
||||
<Filename Value="ftplister.pas"/>
|
||||
<Caret Line="145" Column="1" TopLine="130"/>
|
||||
</Position2>
|
||||
<Position3>
|
||||
<Filename Value="ftplister.pas"/>
|
||||
<Caret Line="25" Column="32" TopLine="6"/>
|
||||
</Position3>
|
||||
<Position4>
|
||||
<Filename Value="checksnapshotsgui.lpr"/>
|
||||
<Caret Line="8" Column="1" TopLine="1"/>
|
||||
</Position4>
|
||||
<Position5>
|
||||
<Filename Value="ftplister.pas"/>
|
||||
<Caret Line="59" Column="16" TopLine="61"/>
|
||||
</Position5>
|
||||
<Position6>
|
||||
<Filename Value="ftplister.pas"/>
|
||||
<Caret Line="85" Column="10" TopLine="67"/>
|
||||
</Position6>
|
||||
<Position7>
|
||||
<Filename Value="ftplister.pas"/>
|
||||
<Caret Line="91" Column="16" TopLine="73"/>
|
||||
</Position7>
|
||||
<Position8>
|
||||
<Filename Value="checksnapshotsgui.lpr"/>
|
||||
<Caret Line="8" Column="1" TopLine="1"/>
|
||||
</Position8>
|
||||
<Position9>
|
||||
<Filename Value="checksnapshotsgui.lpr"/>
|
||||
<Caret Line="7" Column="28" TopLine="1"/>
|
||||
</Position9>
|
||||
</JumpHistory>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="5"/>
|
||||
<PathDelim Value="\"/>
|
||||
<CodeGeneration>
|
||||
<Generate Value="Faster"/>
|
||||
</CodeGeneration>
|
||||
<Other>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Watches Count="1">
|
||||
<Item1>
|
||||
<Expression Value="name"/>
|
||||
</Item1>
|
||||
</Watches>
|
||||
<Exceptions Count="1">
|
||||
<Item1>
|
||||
<Name Value="EAssertionFailedError"/>
|
||||
</Item1>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
14
tools/snapshots/checksnapshotsgui.lpr
Normal file
14
tools/snapshots/checksnapshotsgui.lpr
Normal file
@ -0,0 +1,14 @@
|
||||
program checksnapshotsgui;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
Interfaces, Forms, GuiTestRunner,
|
||||
SnapshotsUptodate, ftplistertest, TestMonitorCfg;
|
||||
|
||||
begin
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TGuiTestRunner, TestRunner);
|
||||
Application.Run;
|
||||
end.
|
||||
|
||||
188
tools/snapshots/ftplister.pas
Normal file
188
tools/snapshots/ftplister.pas
Normal file
@ -0,0 +1,188 @@
|
||||
unit ftplister;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
classes, sysutils,
|
||||
lnet, lftp;
|
||||
|
||||
type
|
||||
|
||||
{ TFTPLister }
|
||||
|
||||
TFTPLister = class
|
||||
private
|
||||
FFtp: TLFTPClient;
|
||||
FInternalStatus: TLFTPStatus;
|
||||
FDirList: string;
|
||||
procedure FtpError(const msg: string; aSocket: TLSocket);
|
||||
procedure FtpConnect(Sender: TLSocket);
|
||||
procedure FtpControl(Sender: TLSocket);
|
||||
procedure FtpReceive(Sender: TLSocket);
|
||||
procedure FtpSuccess(Sender: TLSocket; const aStatus: TLFTPStatus);
|
||||
procedure FtpFailure(Sender: TLSocket; const aStatus: TLFTPStatus);
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
function GetList(const server, dir: string): TStrings;
|
||||
end;
|
||||
|
||||
{ TFtpFile }
|
||||
|
||||
TFtpFile = class
|
||||
private
|
||||
FFileDate: TDateTime;
|
||||
FFileName: string;
|
||||
public
|
||||
constructor Create(AListLine: string);
|
||||
property FileName : string read FFileName;
|
||||
property FileDate : TDateTime read FFileDate;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
const
|
||||
MonthNames : array[1..12] of string[3] =
|
||||
('JAN', 'FEB', 'MAR', 'APR', 'MAY', 'JUN',
|
||||
'JUL', 'AUG', 'SEP', 'OCT', 'NOV', 'DEC');
|
||||
|
||||
constructor TFtpFile.Create(AListLine: string);
|
||||
{ example line
|
||||
lrwxrwxrwx 1 0 0 7 Jun 07 19:12 fpc -> pub/fpc
|
||||
-rw-r--r-- 1 1003 100 52533164 Jul 07 2006 lazarus-arm-wince-20060707.7z
|
||||
}
|
||||
var
|
||||
datestr: string;
|
||||
month:integer;
|
||||
year: string;
|
||||
timestr: string;
|
||||
|
||||
procedure ParseMonth(Name: string);
|
||||
begin
|
||||
Name := uppercase(Name);
|
||||
//writeln('Month: ', Name);
|
||||
month := 1;
|
||||
while (Name<>MonthNames[month]) and (month<high(MonthNames)) do
|
||||
inc(month);
|
||||
end;
|
||||
|
||||
function GetCurrentYear: string;
|
||||
var
|
||||
d,m,y: word;
|
||||
begin
|
||||
DecodeDate(Now, y, m, d);
|
||||
Result := IntToStr(y);
|
||||
end;
|
||||
begin
|
||||
FFileName := copy(AListLine, 57, length(AListLine)-56);
|
||||
//writeln(FFileName);
|
||||
ParseMonth(copy(AListLine, 44, 3));
|
||||
TimeStr := copy(AListLine, 51, 5);
|
||||
if pos(':', timestr)=0 then begin
|
||||
Year := Trim(timestr);
|
||||
timestr := '';
|
||||
end
|
||||
else
|
||||
Year := GetCurrentYear;
|
||||
datestr := copy(AListLine, 48, 2) + '-' + IntToStr(month) + '-'+ Year +
|
||||
' ' + timestr;
|
||||
ShortDateFormat := 'dd-mm-yyyy';
|
||||
FFileDate := StrToDateTime(datestr);
|
||||
end;
|
||||
|
||||
{ TFPTLister }
|
||||
|
||||
procedure TFTPLister.FtpReceive(Sender: TLSocket);
|
||||
var
|
||||
s: string;
|
||||
begin
|
||||
Write('D:');
|
||||
s := FFtp.GetDataMessage;
|
||||
if FInternalStatus = fsCWD then
|
||||
FDirList := FDirList + s;
|
||||
Writeln(s);
|
||||
end;
|
||||
|
||||
procedure TFTPLister.FtpSuccess(Sender: TLSocket; const aStatus: TLFTPStatus);
|
||||
begin
|
||||
FInternalStatus := aStatus;
|
||||
Writeln('Success on status: ' + FTPStatusToStr(aStatus));
|
||||
end;
|
||||
|
||||
procedure TFTPLister.FtpFailure(Sender: TLSocket; const aStatus: TLFTPStatus);
|
||||
begin
|
||||
Writeln('Failure on status: ' + FTPStatusToStr(aStatus));
|
||||
end;
|
||||
|
||||
procedure TFTPLister.FtpError(const msg: string; aSocket: TLSocket);
|
||||
begin
|
||||
Writeln('Error: ', msg);
|
||||
RunError(99);
|
||||
end;
|
||||
|
||||
procedure TFTPLister.FtpConnect(Sender: TLSocket);
|
||||
begin
|
||||
writeln('Connected');
|
||||
end;
|
||||
|
||||
procedure TFTPLister.FtpControl(Sender: TLSocket);
|
||||
var
|
||||
s: string;
|
||||
begin
|
||||
if FFtp.GetMessage(s) > 0 then
|
||||
writeln('C: ', s);
|
||||
end;
|
||||
|
||||
constructor TFTPLister.Create;
|
||||
begin
|
||||
FInternalStatus := fsNone;
|
||||
|
||||
FFtp := TLFTPClient.Create(nil);
|
||||
|
||||
FFtp.StatusSet := [fsAuth, fsType, fsCon, fsCWD, fsList]; // let's watch for these only, these will call OnSuccess or OnFailure
|
||||
FFtp.PipeLine := False; // this means CLIENT pipeline emulation
|
||||
FFtp.Timeout := 100;
|
||||
FFtp.OnConnect := @FtpConnect;
|
||||
FFtp.OnError := @FtpError;
|
||||
FFtp.OnReceive := @FtpReceive;
|
||||
FFtp.OnControl := @FtpControl;
|
||||
FFtp.OnSuccess := @FtpSuccess; // reports when "watched" status succesfuly finishes
|
||||
FFtp.OnFailure := @FtpFailure; // --||-- fails
|
||||
end;
|
||||
|
||||
destructor TFTPLister.Destroy;
|
||||
begin
|
||||
FFtp.Free;
|
||||
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TFTPLister.GetList(const server, dir: string): TStrings;
|
||||
begin
|
||||
Result := TStringList.Create;
|
||||
FFtp.Connect(server);
|
||||
|
||||
repeat
|
||||
FFtp.CallAction;
|
||||
until FFtp.Connected;
|
||||
|
||||
{ until here it's same }
|
||||
|
||||
{ Let's send all the commands at once (beware shitty servers, set pipeline to false for them) }
|
||||
FFtp.Authenticate('anonymous', '');
|
||||
FFtp.Binary:=True;
|
||||
FFtp.ChangeDirectory(dir);
|
||||
FFtp.List();
|
||||
|
||||
repeat
|
||||
FFtp.CallAction;
|
||||
until FInternalStatus = fsList; // we increate the status per successful operation
|
||||
|
||||
Result.Text := FDirList;
|
||||
FFtp.Disconnect;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
81
tools/snapshots/ftplistertest.pas
Normal file
81
tools/snapshots/ftplistertest.pas
Normal file
@ -0,0 +1,81 @@
|
||||
unit ftplistertest;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, ftplister,
|
||||
fpcunit, testregistry;
|
||||
|
||||
{ TFtpListerTestcase }
|
||||
type
|
||||
TFtpListerTestcase= class(TTestCase)
|
||||
private
|
||||
function GetFiles: TStrings;
|
||||
property Files : TStrings read GetFiles;
|
||||
published
|
||||
procedure TestHookUp;
|
||||
procedure TestFtpFile;
|
||||
procedure TestOldFtpFile;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
var
|
||||
FileList: TStrings;
|
||||
|
||||
function TFtpListerTestcase.GetFiles: TStrings;
|
||||
var
|
||||
FtpLister : TFTPLister;
|
||||
begin
|
||||
if FileList=nil then begin
|
||||
FTPLister := TFTPLister.Create;
|
||||
FileList := FTPLister.GetList('ftp.hu.freepascal.org', '/pub/lazarus');
|
||||
FTPLister.Free;
|
||||
end;
|
||||
Result := FileList;
|
||||
end;
|
||||
|
||||
procedure TFtpListerTestcase.TestHookUp;
|
||||
begin
|
||||
AssertTrue('No files retrieved', Files.Count>0);
|
||||
end;
|
||||
|
||||
procedure TFtpListerTestcase.TestFtpFile;
|
||||
var
|
||||
FtpFile : TFtpFile;
|
||||
const
|
||||
FtpLine = '-rw-r--r-- 1 1003 100 43560307 Oct 22 14:34 Lazarus-0.9.19-fpc-2.0.4-20061022-win32.exe';
|
||||
begin
|
||||
FtpFile := TFtpFile.Create(FtpLine);
|
||||
try
|
||||
AssertEquals('Wrong file name:', 'Lazarus-0.9.19-fpc-2.0.4-20061022-win32.exe', FtpFile.FileName);
|
||||
AssertEquals('Wrong file date', '22-10-2006 14:34', DateTimeToStr(FtpFile.FileDate));
|
||||
finally
|
||||
FtpFile.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFtpListerTestcase.TestOldFtpFile;
|
||||
var
|
||||
FtpFile : TFtpFile;
|
||||
const
|
||||
FtpLine = '-rw-r--r-- 1 1003 100 52533164 Jul 07 2006 lazarus-arm-wince-20060707.7z';
|
||||
begin
|
||||
FtpFile := TFtpFile.Create(FtpLine);
|
||||
try
|
||||
AssertEquals('Wrong file date', '07-07-2006', DateTimeToStr(FtpFile.FileDate));
|
||||
finally
|
||||
FtpFile.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterTest(TFtpListerTestcase);
|
||||
|
||||
finalization
|
||||
FileList.Free;
|
||||
|
||||
end.
|
||||
|
||||
192
tools/snapshots/monitorcfg.pas
Normal file
192
tools/snapshots/monitorcfg.pas
Normal file
@ -0,0 +1,192 @@
|
||||
unit MonitorCfg;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
contnrs, dom, xmlread;
|
||||
|
||||
type
|
||||
TServerType = (stFtp, stHttp);
|
||||
|
||||
TServer = class;
|
||||
TFile = class;
|
||||
|
||||
{ TMonitorConfig }
|
||||
|
||||
TMonitorConfig = class
|
||||
private
|
||||
FFileName: string;
|
||||
FServers: TFPObjectList;
|
||||
function GetServer(index: integer): TServer;
|
||||
function GetServerCount: integer;
|
||||
procedure AddServer(const ServerNode: TDOMNode);
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
procedure Load(const AFileName: string);
|
||||
procedure AddServer(AServer: TServer);
|
||||
property FileName: string read FFileName write FFileName;
|
||||
property Servers[index: integer] : TServer read GetServer;
|
||||
property ServerCount: integer read GetServerCount;
|
||||
end;
|
||||
|
||||
{ TServer }
|
||||
|
||||
TServer = class
|
||||
private
|
||||
FFiles: TFPObjectList;
|
||||
FDescription: string;
|
||||
FServerType: TServerType;
|
||||
function GetFile(index: integer): TFile;
|
||||
function GetFileCount: integer;
|
||||
procedure AddFile(const ServerNode: TDOMNode);
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
procedure AddFile(AFile: TFile);
|
||||
property Description : string read FDescription write FDescription;
|
||||
property ServerType : TServerType read FServerType write FServerType;
|
||||
property Files[index: integer] : TFile read GetFile;
|
||||
property FileCount: integer read GetFileCount;
|
||||
end;
|
||||
|
||||
{ TFile }
|
||||
|
||||
TFile = class
|
||||
private
|
||||
FDescription: string;
|
||||
FMask: string;
|
||||
public
|
||||
constructor Create;
|
||||
property Mask: string read FMask write FMask;
|
||||
property Description: string read FDescription write FDescription;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TServer }
|
||||
|
||||
function TServer.GetFile(index: integer): TFile;
|
||||
begin
|
||||
Result := TFile(FFiles[index]);
|
||||
end;
|
||||
|
||||
function TServer.GetFileCount: integer;
|
||||
begin
|
||||
Result := FFiles.Count;
|
||||
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;
|
||||
AddFile(NewFile);
|
||||
end;
|
||||
|
||||
constructor TServer.Create;
|
||||
begin
|
||||
FFiles := TFPObjectList.Create;
|
||||
end;
|
||||
|
||||
destructor TServer.Destroy;
|
||||
begin
|
||||
FFiles.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TServer.AddFile(AFile: TFile);
|
||||
begin
|
||||
FFiles.Add(AFile);
|
||||
end;
|
||||
|
||||
{ TFile }
|
||||
|
||||
constructor TFile.Create;
|
||||
begin
|
||||
end;
|
||||
|
||||
{ TMonitorConfig }
|
||||
|
||||
function TMonitorConfig.GetServer(index: integer): TServer;
|
||||
begin
|
||||
Result := TServer(FServers[index]);
|
||||
end;
|
||||
|
||||
function TMonitorConfig.GetServerCount: integer;
|
||||
begin
|
||||
Result := FServers.Count;
|
||||
end;
|
||||
|
||||
procedure TMonitorConfig.AddServer(const ServerNode: TDOMNode);
|
||||
var
|
||||
Server: TServer;
|
||||
Attribute: TDOMNode;
|
||||
Node: TDomNode;
|
||||
begin
|
||||
Server := TServer.Create;
|
||||
Attribute := ServerNode.Attributes.GetNamedItem('Name');
|
||||
if assigned(Attribute) then
|
||||
Server.Description := Attribute.NodeValue;
|
||||
Attribute := ServerNode.Attributes.GetNamedItem('Type');
|
||||
if assigned(Attribute) then
|
||||
if Attribute.NodeValue='ftp' then
|
||||
Server.ServerType := stFtp
|
||||
else if Attribute.NodeValue='http' then
|
||||
Server.ServerType := stHttp;
|
||||
Node := ServerNode.FirstChild;
|
||||
while Node<>nil do begin
|
||||
if Node.NodeName='File' then
|
||||
Server.AddFile(Node);
|
||||
Node := Node.NextSibling;
|
||||
end;
|
||||
AddServer(Server);
|
||||
end;
|
||||
|
||||
constructor TMonitorConfig.Create;
|
||||
begin
|
||||
FServers := TFPObjectList.Create;
|
||||
end;
|
||||
|
||||
destructor TMonitorConfig.Destroy;
|
||||
begin
|
||||
FServers.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TMonitorConfig.Load(const AFileName: string);
|
||||
var
|
||||
XmlDoc: TXMLDocument;
|
||||
Node: TDomNode;
|
||||
begin
|
||||
FFileName := AFileName;
|
||||
XmlDoc := nil;
|
||||
try
|
||||
ReadXMLFile(XmlDoc, FileName);
|
||||
Node := XmlDoc.DocumentElement.FirstChild;
|
||||
while Node<>nil do begin
|
||||
if Node.NodeName='Server' then
|
||||
AddServer(Node);
|
||||
Node := Node.NextSibling;
|
||||
end;
|
||||
finally
|
||||
XmlDoc.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMonitorConfig.AddServer(AServer: TServer);
|
||||
begin
|
||||
FServers.Add(AServer);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
77
tools/snapshots/monitorconfig.xml
Normal file
77
tools/snapshots/monitorconfig.xml
Normal file
@ -0,0 +1,77 @@
|
||||
<?xml version="1.0" ?>
|
||||
<CONFIG LazVersion="0.9.21">
|
||||
<Server Type="ftp" Name="Snapshot on scenergy">
|
||||
<File
|
||||
Mask="lazarus-0.9.21-*-src.zip"
|
||||
Description="Lazarus source zip"
|
||||
/>
|
||||
<File
|
||||
Mask="lazarus-0.9.21-*-src.tar.bz2"
|
||||
Description="Lazarus source bzip2"
|
||||
/>
|
||||
<File
|
||||
Mask="Lazarus-0.9.21-fpc-2.0.4-*-win32.exe"
|
||||
Description="Lazarus win32 fpc 2.0.4"
|
||||
/>
|
||||
<File
|
||||
Mask="Lazarus-0.9.21-fpc-2.1.1-*-win32.exe"
|
||||
Description="Lazarus win32 fpc 2.1.1"
|
||||
/>
|
||||
<File
|
||||
Mask="Lazarus-0.9.21-fpc-2.1.1-*-win64.exe"
|
||||
Description="Lazarus win64 fpc 2.1.1"
|
||||
/>
|
||||
<File
|
||||
Mask="fpc-2.0.4-*-powerpc-macosx.dmg"
|
||||
Description="fpc 2.0.4 Mac OS X powerpc"
|
||||
/>
|
||||
<File
|
||||
Mask="fpcsrc-2.0.4-*-powerpc-macosx.dmg"
|
||||
Description="fpc source 2.0.4 Mac OS X powerpc"
|
||||
/>
|
||||
<File
|
||||
Mask="lazarus-0.9.21-*-powerpc-macosx.dmg"
|
||||
Description="lazarus Mac OS X powerpc"
|
||||
/>
|
||||
<File
|
||||
Mask="fpc-2.1.1-*-i386-macosx.dmg"
|
||||
Description="fpc 2.1.1 Mac OS X i386"
|
||||
/>
|
||||
<File
|
||||
Mask="fpcsrc-2.1.1-*-i386-macosx.dmg"
|
||||
Description="fpc source 2.1.1 Mac OS X i386"
|
||||
/>
|
||||
<File
|
||||
Mask="lazarus-0.9.21-*-i386-macosx.dmg"
|
||||
Description="lazarus Mac OS X i386"
|
||||
/>
|
||||
<File
|
||||
Mask="fpc-2.0.4-*.src.rpm"
|
||||
Description="fpc 2.0.4 source rpm"
|
||||
/>
|
||||
<File
|
||||
Mask="fpc-2.0.4-*.i386.rpm"
|
||||
Description="fpc 2.0.4 i386 rpm"
|
||||
/>
|
||||
<File
|
||||
Mask="fpc-src-2.0.4-*.i386.rpm"
|
||||
Description="fpc source 2.0.4 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"
|
||||
/>
|
||||
<File
|
||||
Mask="fpc-src-2.0.4-*.x86_64.rpm"
|
||||
Description="fpc source 2.0.4 x86_64 rpm"
|
||||
/>
|
||||
<File
|
||||
Mask="lazarus-*.x86_64.rpm"
|
||||
Description="lazarus x86_64 rpm"
|
||||
/>
|
||||
</Server>
|
||||
</CONFIG>
|
||||
1
tools/snapshots/runchecksnapshots.bat
Normal file
1
tools/snapshots/runchecksnapshots.bat
Normal file
@ -0,0 +1 @@
|
||||
checksnapshots.exe -all -p --file=monitor.xml --stylesheet=fpcunit.xsl --format=xml
|
||||
165
tools/snapshots/snapshotsuptodate.pas
Normal file
165
tools/snapshots/snapshotsuptodate.pas
Normal file
@ -0,0 +1,165 @@
|
||||
unit SnapshotsUptodate;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, fpcunit, testregistry, ftplister;
|
||||
|
||||
type
|
||||
|
||||
{ TFtpMonitorTestcase }
|
||||
|
||||
TFtpMonitorTestcase= class(TTestCase)
|
||||
private
|
||||
FFileMask: string;
|
||||
FName: string;
|
||||
FMatchingFiles: TStrings;
|
||||
function GetFiles: TStrings;
|
||||
function GetMatchingFiles: TStrings;
|
||||
property Files : TStrings read GetFiles;
|
||||
property MatchingFiles: TStrings read GetMatchingFiles;
|
||||
public
|
||||
class function FileMaskSuite(const AName, AFileMask: string): TTestSuite;
|
||||
constructor Create(const AName, AFileMask, ATestName: string);
|
||||
destructor Destroy; override;
|
||||
published
|
||||
procedure TestHookUp;
|
||||
procedure NumberOfFiles;
|
||||
procedure IsUptodateTest;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
monitorcfg;
|
||||
|
||||
var
|
||||
FileList: TStrings;
|
||||
|
||||
function TFtpMonitorTestcase.GetFiles: TStrings;
|
||||
var
|
||||
FtpLister : TFTPLister;
|
||||
begin
|
||||
if FileList=nil then begin
|
||||
FTPLister := TFTPLister.Create;
|
||||
FileList := FTPLister.GetList('ftp.hu.freepascal.org', '/pub/lazarus');
|
||||
FTPLister.Free;
|
||||
end;
|
||||
Result := FileList;
|
||||
end;
|
||||
|
||||
function TFtpMonitorTestcase.GetMatchingFiles: TStrings;
|
||||
var
|
||||
i: integer;
|
||||
starpos: integer;
|
||||
FirstPart, LastPart: string;
|
||||
FtpFile : TFtpFile;
|
||||
begin
|
||||
if not assigned(FMatchingFiles) then begin
|
||||
starpos := pos('*', 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;
|
||||
for i := 0 to Files.Count-1 do begin
|
||||
FtpFile := TFtpFile.Create(Files[i]);
|
||||
if (copy(FtpFile.FileName, 1, starpos-1)=FirstPart)
|
||||
and (copy(FtpFile.FileName, Length(FtpFile.FileName)-Length(LastPart)+1, Length(LastPart))=LastPart) then
|
||||
FMatchingFiles.AddObject(FtpFile.FileName, FtpFile)
|
||||
else
|
||||
FtpFile.Free;
|
||||
end;
|
||||
end;
|
||||
Result := FMatchingFiles;
|
||||
end;
|
||||
|
||||
class function TFtpMonitorTestcase.FileMaskSuite(const AName, AFileMask: string
|
||||
): TTestSuite;
|
||||
begin
|
||||
Result := TTestSuite.Create(AName);
|
||||
Result.AddTest(Create(AName, AFileMask, 'NumberOfFiles'));
|
||||
Result.AddTest(Create(AName, AFileMask, 'IsUptodateTest'));
|
||||
end;
|
||||
|
||||
constructor TFtpMonitorTestcase.Create(const AName, AFileMask, ATestName: string);
|
||||
begin
|
||||
inherited CreateWithName(ATestName);
|
||||
FName := AName;
|
||||
FFileMask := AFileMask;
|
||||
end;
|
||||
|
||||
destructor TFtpMonitorTestcase.Destroy;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
if assigned(FMatchingFiles) then begin
|
||||
for i := 0 to FMatchingFiles.Count-1 do
|
||||
FMatchingFiles.Objects[i].Free;
|
||||
FMatchingFiles.Free;
|
||||
end;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TFtpMonitorTestcase.TestHookUp;
|
||||
begin
|
||||
AssertTrue('No files retrieved', Files.Count>0);
|
||||
end;
|
||||
|
||||
procedure TFtpMonitorTestcase.NumberOfFiles;
|
||||
begin
|
||||
AssertEquals('Wrong number of file matches for '+ FName, 1, MatchingFiles.Count);
|
||||
end;
|
||||
|
||||
procedure TFtpMonitorTestcase.IsUptodateTest;
|
||||
var
|
||||
FtpFile: TFtpFile;
|
||||
begin
|
||||
AssertTrue(MatchingFiles.Count>0);
|
||||
FtpFile := TFtpFile(MatchingFiles.Objects[0]);
|
||||
AssertTrue(
|
||||
FtpFile.FileName +' is too old: ' + DateTimeToStr(FtpFile.FileDate),
|
||||
(Now - FtpFile.FileDate) < 1.0);
|
||||
end;
|
||||
|
||||
procedure InitFromXml;
|
||||
var
|
||||
MonitorConfig: TMonitorConfig;
|
||||
ServerIdx: integer;
|
||||
|
||||
function CreateFileTestSuite(AFile: TFile) : TTestSuite;
|
||||
begin
|
||||
with AFile do
|
||||
Result := TFtpMonitorTestcase.FileMaskSuite(Description, Mask);
|
||||
end;
|
||||
|
||||
function CreateFtpServerTestSuite(Server: TServer): TTestSuite;
|
||||
var
|
||||
FileIdx: integer;
|
||||
begin
|
||||
Result := TTestSuite.Create(Server.Description);
|
||||
for FileIdx := 0 to Server.FileCount-1 do
|
||||
Result.AddTest(CreateFileTestSuite(Server.Files[FileIdx]));
|
||||
end;
|
||||
|
||||
begin
|
||||
MonitorConfig := TMonitorConfig.Create;
|
||||
try
|
||||
MonitorConfig.Load(ExtractFilePath(ParamStr(0)) + 'monitorconfig.xml');
|
||||
for ServerIdx := 0 to MonitorConfig.ServerCount-1 do
|
||||
GetTestRegistry.AddTest(
|
||||
CreateFtpServerTestSuite(MonitorConfig.Servers[ServerIdx]));
|
||||
finally
|
||||
MonitorConfig.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
initialization
|
||||
FileList := nil;
|
||||
InitFromXml;
|
||||
finalization
|
||||
FreeAndNil(FileList);
|
||||
end.
|
||||
|
||||
50
tools/snapshots/testmonitorcfg.pas
Normal file
50
tools/snapshots/testmonitorcfg.pas
Normal file
@ -0,0 +1,50 @@
|
||||
unit TestMonitorCfg;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, fpcunit, testregistry, monitorcfg;
|
||||
|
||||
type
|
||||
|
||||
TTestMonitorCfg= class(TTestCase)
|
||||
private
|
||||
FMonitorCfg: TMonitorConfig;
|
||||
protected
|
||||
procedure SetUp; override;
|
||||
procedure TearDown; override;
|
||||
published
|
||||
procedure Test;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
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);
|
||||
end;
|
||||
|
||||
procedure TTestMonitorCfg.SetUp;
|
||||
begin
|
||||
FMonitorCfg := TMonitorConfig.Create;
|
||||
end;
|
||||
|
||||
procedure TTestMonitorCfg.TearDown;
|
||||
begin
|
||||
FMonitorCfg.Free;
|
||||
end;
|
||||
|
||||
initialization
|
||||
|
||||
//RegisterTest(TTestMonitorCfg);
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user