paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-05 22:28:06 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ Initial import

Browse Source 
git-svn-id: trunk@92 -
This commit is contained in:
fpc 2005-05-25 07:57:17 +00:00
parent 523d3e6ced
commit 4c55f2bc34
5 changed files with 938 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
.gitattributes vendored
View File

@ -6317,6 +6317,10 @@ utils/simulator/mm64.pas svneol=native#text/plain
utils/simulator/simbase.pas svneol=native#text/plain
utils/simulator/simlib.pas svneol=native#text/plain
utils/svn2cl.pp svneol=native#text/plain
utils/svn2cvs/svn2cvs.lpi svneol=native#text/plain
utils/svn2cvs/svn2cvs.pp svneol=native#text/plain
utils/svn2cvs/test.xml svneol=native#text/plain
utils/svn2cvs/vers.pp svneol=native#text/plain
utils/tply/COPYING -text
utils/tply/Makefile -text
utils/tply/Makefile.fpc svneol=native#text/plain

193
utils/svn2cvs/svn2cvs.lpi Normal file
View File

@ -0,0 +1,193 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<PathDelim Value="/"/>
<Version Value="5"/>
<General>
<Flags>
<MainUnitHasUsesSectionForAllUnits Value="False"/>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
</Flags>
<MainUnit Value="0"/>
<ActiveEditorIndexAtStart Value="0"/>
<IconPath Value="./"/>
<TargetFileExt Value=""/>
<Title Value="svn2cvs"/>
</General>
<JumpHistory Count="30" HistoryIndex="29">
<Position1>
<Filename Value="svn2cvs.pp"/>
<Caret Line="367" Column="69" TopLine="338"/>
</Position1>
<Position2>
<Filename Value="svn2cvs.pp"/>
<Caret Line="364" Column="12" TopLine="344"/>
</Position2>
<Position3>
<Filename Value="svn2cvs.pp"/>
<Caret Line="370" Column="28" TopLine="347"/>
</Position3>
<Position4>
<Filename Value="svn2cvs.pp"/>
<Caret Line="23" Column="4" TopLine="1"/>
</Position4>
<Position5>
<Filename Value="svn2cvs.pp"/>
<Caret Line="365" Column="12" TopLine="345"/>
</Position5>
<Position6>
<Filename Value="svn2cvs.pp"/>
<Caret Line="376" Column="1" TopLine="345"/>
</Position6>
<Position7>
<Filename Value="svn2cvs.pp"/>
<Caret Line="25" Column="1" TopLine="2"/>
</Position7>
<Position8>
<Filename Value="svn2cvs.pp"/>
<Caret Line="396" Column="8" TopLine="376"/>
</Position8>
<Position9>
<Filename Value="svn2cvs.pp"/>
<Caret Line="397" Column="25" TopLine="377"/>
</Position9>
<Position10>
<Filename Value="svn2cvs.pp"/>
<Caret Line="395" Column="1" TopLine="377"/>
</Position10>
<Position11>
<Filename Value="svn2cvs.pp"/>
<Caret Line="406" Column="1" TopLine="380"/>
</Position11>
<Position12>
<Filename Value="svn2cvs.pp"/>
<Caret Line="357" Column="38" TopLine="337"/>
</Position12>
<Position13>
<Filename Value="svn2cvs.pp"/>
<Caret Line="358" Column="1" TopLine="337"/>
</Position13>
<Position14>
<Filename Value="svn2cvs.pp"/>
<Caret Line="425" Column="1" TopLine="394"/>
</Position14>
<Position15>
<Filename Value="svn2cvs.pp"/>
<Caret Line="40" Column="19" TopLine="1"/>
</Position15>
<Position16>
<Filename Value="svn2cvs.pp"/>
<Caret Line="442" Column="1" TopLine="408"/>
</Position16>
<Position17>
<Filename Value="svn2cvs.pp"/>
<Caret Line="27" Column="50" TopLine="1"/>
</Position17>
<Position18>
<Filename Value="svn2cvs.pp"/>
<Caret Line="508" Column="3" TopLine="476"/>
</Position18>
<Position19>
<Filename Value="svn2cvs.pp"/>
<Caret Line="5" Column="19" TopLine="1"/>
</Position19>
<Position20>
<Filename Value="svn2cvs.pp"/>
<Caret Line="135" Column="7" TopLine="97"/>
</Position20>
<Position21>
<Filename Value="svn2cvs.pp"/>
<Caret Line="165" Column="16" TopLine="161"/>
</Position21>
<Position22>
<Filename Value="svn2cvs.pp"/>
<Caret Line="438" Column="16" TopLine="438"/>
</Position22>
<Position23>
<Filename Value="svn2cvs.pp"/>
<Caret Line="279" Column="3" TopLine="259"/>
</Position23>
<Position24>
<Filename Value="svn2cvs.pp"/>
<Caret Line="369" Column="6" TopLine="363"/>
</Position24>
<Position25>
<Filename Value="svn2cvs.pp"/>
<Caret Line="334" Column="1" TopLine="301"/>
</Position25>
<Position26>
<Filename Value="svn2cvs.pp"/>
<Caret Line="31" Column="23" TopLine="1"/>
</Position26>
<Position27>
<Filename Value="svn2cvs.pp"/>
<Caret Line="335" Column="57" TopLine="315"/>
</Position27>
<Position28>
<Filename Value="svn2cvs.pp"/>
<Caret Line="391" Column="45" TopLine="368"/>
</Position28>
<Position29>
<Filename Value="svn2cvs.pp"/>
<Caret Line="161" Column="1" TopLine="161"/>
</Position29>
<Position30>
<Filename Value="svn2cvs.pp"/>
<Caret Line="404" Column="1" TopLine="381"/>
</Position30>
</JumpHistory>
<Units Count="2">
<Unit0>
<CursorPos X="16" Y="322"/>
<EditorIndex Value="0"/>
<Filename Value="svn2cvs.pp"/>
<IsPartOfProject Value="True"/>
<Loaded Value="True"/>
<TopLine Value="294"/>
<UnitName Value="svn2cvs"/>
<UsageCount Value="38"/>
</Unit0>
<Unit1>
<CursorPos X="32" Y="26"/>
<EditorIndex Value="1"/>
<Filename Value="/home/michael/fpc/fcl/inc/process.pp"/>
<Loaded Value="True"/>
<TopLine Value="4"/>
<UnitName Value="process"/>
<UsageCount Value="19"/>
</Unit1>
</Units>
<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>
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="2">
<Item1>
<Name Value="ECodetoolError"/>
</Item1>
<Item2>
<Name Value="EFOpenError"/>
</Item2>
</Exceptions>
</Debugging>
</CONFIG>

521
utils/svn2cvs/svn2cvs.pp Normal file
View File

@ -0,0 +1,521 @@
{$mode objfpc}
{$H+}
program svn2cvs;
uses Classes,sysutils,process,DOM,xmlread,custapp,IniFiles;
Const
SGlobal = 'Global';
KeyCVSBin = 'CVSBinary';
KeySVNBin = 'SVNBinary';
KeySVNURL = 'SVNURL';
KeyCVSROOT = 'CVSROOT';
KeyRepository = 'CVSRepository';
KeyRevision = 'Revision';
KeyWorkDir = 'WorkingDir';
Resourcestring
SErrFailedToCheckOut = 'Failed to check out SVN repository';
SErrFailedToInitCVS = 'Failed to initialize CVS: ';
SErrNoRepository = 'Cannot initialize CVS: no CVS Repository specified';
SErrDirectoryFailed = 'Failed to create directory : %s';
SErrFailedToGetVersions = 'Failed to retrieve SVN versions';
SErrInValidSVNLog = 'Invalid SVN log.';
SErrUpdateFailed = 'Update to revision %d failed.';
SErrFailedToCommit = 'Failed to commit to CVS.';
SErrFailedToRemove = 'Failed to remove file: %s';
SErrFailedToAddDirectory = 'Failed to add directory to CVS: %s';
SErrFailedToAddFile = 'Failed to add file to CVS: %s';
SErrDirectoryNotInCVS = 'Directory not in CVS: %s';
SLogRevision = 'Revision %s by %s :';
SConvertingRevision = 'Converting revision : %d';
SWarnUnknownAction = 'Warning: Unknown action: "%s" for filename : "%s"';
SWarnErrorInLine = 'Warning: Erroneous file line : %s';
SExecuting = 'Executing: %s';
Type
{ TSVN2CVSApp }
TVersion = Class(TCollectionItem)
private
FAuthor: String;
FDate: string;
FLogMessage: String;
FRevision: Integer;
Public
Property Revision : Integer read FRevision;
Property LogMessage : String Read FLogMessage;
Property Date : string Read FDate;
Property Author : String Read FAuthor;
end;
{ TVersions }
TVersions = Class(TCollection)
private
function GetVersion(Index : INteger): TVersion;
procedure SetVersion(Index : INteger; const AValue: TVersion);
Protected
procedure ConvertLogEntry(E : TDomElement);
public
Procedure LoadFromXML(Doc : TXMlDocument);
property Versions[Index : INteger] : TVersion Read GetVersion Write SetVersion; Default;
end;
{ TSVN2CVSApp }
TSVN2CVSApp = Class(TCustomApplication)
Public
SVNBin : String;
CVSBin : String;
versions : TVersions;
WorkingDir : String;
StartRevision : Integer;
SVNURL : String;
CVSROOT : String;
CVSRepository : String;
Function RunCmd(Cmd: String; CmdOutput: TStream): Boolean;
Function RunSVN(Cmd : String; CmdOutput : TStream) : Boolean;
Function RunCVS(Cmd : String; CmdOutput : TStream) : Boolean;
Function UpdateSVN(Version : TVersion; Files : TStrings) : Boolean;
Procedure WriteLogMessage(Version : TVersion);
Procedure UpdateEntry(AFileName : String);
Procedure DeleteEntry(AFileName : String);
Procedure DoCVSEntries(Version : TVersion;Files : TStrings);
procedure CheckInCVS;
procedure CheckOutSVN(Files : TStrings);
Procedure ConvertVersion(Version : TVersion);
Procedure ConvertRepository;
procedure GetVersions;
procedure ProcessConfigFile;
Function ProcessArguments : Boolean;
Procedure DoRun; override;
end;
AppError = Class(Exception);
{ TVersions }
function TVersions.GetVersion(Index : INteger): TVersion;
begin
Result:=Items[Index] as Tversion;
end;
procedure TVersions.SetVersion(Index : INteger; const AValue: TVersion);
begin
Items[Index]:=AValue;
end;
procedure TVersions.ConvertLogEntry(E : TDomElement);
Function GetNodeText(N : TDomNode) : String;
begin
N:=N.FirstChild;
If N<>Nil then
Result:=N.NodeValue;
end;
Var
N : TDomNode;
V : TVersion;
begin
V:=Add as TVersion;
V.FRevision:=StrToIntDef(E['revision'],-1);
N:=E.FirstChild;
While (N<>Nil) do
begin
If (N.NodeType=ELEMENT_NODE) then
begin
if (N.NodeName='author') then
V.FAuthor:=GetNodeText(N)
else If (N.NodeName='date') then
V.FDate:=GetNodeText(N)
else If (N.NodeName='msg') then
V.FLogMessage:=GetNodeText(N);
end;
N:=N.NextSibling;
end;
end;
procedure TVersions.LoadFromXML(Doc: TXMlDocument);
var
L : TDomNode;
E : TDomElement;
begin
L:=Doc.FirstChild;
While (L<>Nil) and not ((L.NodeType=ELEMENT_NODE) and (L.NodeName='log')) do
L:=L.NextSibling;
if (L=Nil) then
Raise AppError.Create(SErrInValidSVNLog);
L:=L.FirstChild;
While (L<>Nil) do
begin
If (L.NodeType=ELEMENT_NODE) and (L.NodeName='logentry') then
E:=TDomElement(L);
ConvertLogEntry(E);
L:=L.NextSibling;
end;
end;
{ TSVN2CVSApp }
function TSVN2CVSApp.RunCmd(Cmd: String; CmdOutput: TStream): Boolean;
Var
Buf : Array[1..4096] of Byte;
Count : Integer;
begin
With TProcess.Create(Self) do
Try
CommandLine:=cmd;
Writeln(Format(SExecuting,[CommandLine]));
if (CmdOutput<>Nil) then
Options:=[poUsePipes];
Execute;
If (CmdOutPut=Nil) then
WaitOnExit
else
Repeat
Count:=Output.Read(Buf,SizeOf(Buf));
If (Count>0) then
cmdOutput.Write(Buf,Count);
Until (Count=0);
Result:=(ExitStatus=0);
finally
Free;
end;
end;
function TSVN2CVSApp.RunSVN(Cmd: String; CmdOutput: TStream): Boolean;
begin
Result:=RunCmd(SVNbin+' '+Cmd,CmdOutput);
end;
function TSVN2CVSApp.RunCVS(Cmd: String; CmdOutput: TStream): Boolean;
begin
Result:=RunCmd(CVSbin+' '+Cmd,CmdOutput);
end;
procedure TSVN2CVSApp.CheckOutSVN(Files : TStrings);
Var
S : TStringStream;
begin
S:=TStringStream.Create('');
Try
if not RunSVN(Format('co -r %d %s .',[StartRevision,SVNURL]),S) then
Raise AppError.Create(SErrFailedToCheckOut);
Files.Text:=S.DataString;
Finally
FreeAndNil(S);
end;
end;
procedure TSVN2CVSApp.CheckInCVS;
Var
F : Text;
begin
If not ForceDirectories(WorkingDir+'CVS') then
Try
AssignFile(F,WorkingDir+'CVS/Root');
Rewrite(F);
Try
Writeln(F,CVSRoot);
Finally
CloseFile(F);
end;
AssignFile(F,WorkingDir+'CVS/Repository');
Rewrite(F);
Try
Writeln(F,CVSRepository);
Finally
Close(F);
end;
AssignFile(F,WorkingDir+'CVS/Entries');
Rewrite(F);
Try
// Do nothing.
Finally
Close(F);
end;
except
On E : Exception do
begin
E.Message:=SErrFailedToInitCVS+E.Message;
Raise;
end;
end;
end;
procedure TSVN2CVSApp.Convertrepository;
Var
InitCVS,INITSVN : Boolean;
I : Integer;
Files : TStringList;
begin
If Not DirectoryExists(WorkingDir) then
begin
if Not ForceDirectories(WorkingDir) then
Raise AppError.CreateFmt(SErrDirectoryFailed,[WorkingDir]);
InitSVN:=True;
InitCVS:=true;
end
else
begin
if Not DirectoryExists(WorkingDir+'.svn') then
InitSVN:=True;
if Not DirectoryExists(WorkingDir+'CVS') then
InitCVS:=True;
end;
ChDir(WorkingDir);
if InitCVS and (CVSRepository='') then
Raise AppError.Create(SErrNoRepository);
if InitSVN then
begin
Files:=TStringList.Create;
Try
CheckoutSVN(Files);
if InitCVS then
begin
CheckinCVS;
DoCVSEntries(Nil,Files);
end
else
DoCVSEntries(Nil,Files);
finally
FreeAndNil(Files);
end;
end;
GetVersions;
For I:=0 to Versions.Count-1 do
ConvertVersion(Versions[i]);
end;
procedure TSVN2CVSApp.GetVersions;
Var
S : TStringStream;
Doc : TXMLDocument;
begin
Versions:=TVersions.Create(TVersion);
S:=TStringStream.Create('');
Try
if not RunSVN(Format('log --xml -r %d:HEAD',[StartRevision]),S) then
Raise AppError(SErrFailedToGetVersions);
S.Position:=0;
ReadXMLFile(Doc,S);
Try
Versions.LoadFromXML(Doc);
finally
Doc.Free;
end;
Finally
S.Free;
end;
end;
procedure TSVN2CVSApp.ConvertVersion(Version: TVersion);
Var
Files : TStringList;
begin
Writeln(Format(SConvertingRevision,[Version.revision]));
Files:=TStringList.Create;
Try
If Not UpdateSVN(Version,Files) then
Raise AppError.CreateFmt(SErrUpdateFailed,[Version.Revision]);
DoCVSEntries(Version,Files);
Finally
Files.Free;
end;
end;
Function TSVN2CVSApp.UpdateSVN(Version : TVersion; Files : TStrings) : Boolean;
Var
S : TStringStream;
begin
S:=TStringStream.Create('');
Try
Result:=RunSVN(Format('up -r %d',[version.revision]),S);
if Result then
Files.Text:=S.DataString;
Finally
S.Free;
end;
end;
Procedure TSVN2CVSApp.WriteLogMessage(Version : TVersion);
Var
F : Text;
begin
AssignFile(F,'logmsg.txt');
Rewrite(F);
Try
Writeln(F,Format(SLogRevision,[Version.Revision,Version.Author]));
Writeln(F, Version.LogMessage);
Finally
CloseFile(F);
end;
end;
Procedure TSVN2CVSApp.DoCVSEntries(Version : TVersion;Files : TStrings);
Var
I,P : Integer;
Action : Char;
FileName : String;
begin
For I:=0 to Files.Count-1 do
begin
FileName:=trim(Files[i]);
P:=Pos(' ',FileName);
if (P=0) then
Writeln(StdErr,Format(SWarnErrorInLine,[FileName]))
else
begin
Action:=FileName[1];
system.Delete(FileName,1,P);
FileName:=Trim(FileName);
end;
Case UpCase(action) of
'U' : UpdateEntry(FileName);
'D' : DeleteEntry(FileName);
else
Writeln(stdErr,Format(SWarnUnknownAction,[Action,FileName]));
end;
end;
WriteLogMessage(version);
Try
If not RunCVS('commit -m -F logmsg.txt .',Nil) then
Raise AppError.Create(SErrFailedToCommit);
Finally
if not DeleteFile('logmsg.txt') then
Writeln(StdErr,'Warning: failed to remove log message file.');
end;
end;
Procedure TSVN2CVSApp.UpdateEntry(AFileName : String);
Var
FD : String;
L : TStringList;
I : Integer;
Found : Boolean;
begin
If ((FileGetAttr(AFileName) and faDirectory)<>0) then
begin
if Not RunCVS('add '+AFileName,Nil) then
Raise AppError.CreateFmt(SErrFailedToAddDirectory,[AFileName]);
end
else // Check if file is under CVS control by checking the Entries file.
begin
FD:=ExtractFilePath(AFileName);
If not DirectoryExists(FD+'Entries') then
Raise AppError.CreateFmt(SErrDirectoryNotInCVS,[FD]);
Found:=False;
L:=TStringList.Create;
Try
L.LoadFromFile(FD+'Entries');
Found:=False;
I:=0;
While (not found) and (I<L.Count) do
begin
Inc(I);
end;
if not found then
if Not RunCVS('add '+AFileName,Nil) then
Raise AppError.CreateFmt(SErrFailedToAddFile,[AFileName]);
finally
L.Free;
end;
end;
end;
Procedure TSVN2CVSApp.DeleteEntry(AFileName : String);
begin
If ((FileGetAttr(AFileName) and faDirectory)=0) then
if Not RunCVS('rm '+AFileName,Nil) then
Raise AppError.CreateFmt(SErrFailedToRemove,[AFileName]);
end;
procedure TSVN2CVSApp.DoRun;
begin
If Not ProcessArguments then
exit;
ConvertRepository;
end;
procedure TSVN2CVSApp.ProcessConfigFile;
begin
With TMemIniFile.Create(GetAppConfigFile(False)) do
try
SVNURL:=ReadString(SGlobal,KeySVNURL,'');
CVSROOT:=ReadString(SGlobal,KeyCVSROOT,'');
CVSRepository:=ReadString(SGlobal,KeyRepository,'');
WorkingDir:=ReadString(SGLobal,KeyWorkDir,'');
StartRevision:=ReadInteger(SGlobal,KeyRevision,-1)+1;
SVNBin:=ReadString(SGlobal,KeySVNBin,'svn');
CVSBin:=ReadString(SGlobal,KeyCVSBin,'cvs');
finally
Free;
end;
end;
function TSVN2CVSApp.ProcessArguments: Boolean;
begin
ProcessConfigFile;
if HasOption('s','svn-repository') then
SVNURL:=GetOptionValue('s','svn-repository');
if HasOption('c','cvsroot') then
CVSROOT:=GetOptionValue('c','cvsroot');
if HasOption('c','cvsrepository') then
CVSROOT:=GetOptionValue('p','cvsrepository');
if HasOption('r','revision') then
StartRevision:=StrToIntDef(GetOptionValue('c'),0);
if HasOption('d','directory') then
WorkingDir:=GetOptionValue('d','directory');
Result:=(SVNUrl<>'') and (CVSROOT<>'');
If Result then
begin
If (WorkingDir='') then
WorkingDir:=GetCurrentDir;
WorkingDir:=IncludeTrailingPathDelimiter(WorkingDir);
end;
end;
begin
With TSVN2CVSApp.Create(Nil) do
try
Initialize;
Run;
Finally
free;
end;
end.

86
utils/svn2cvs/test.xml Normal file
View File

@ -0,0 +1,86 @@
<?xml version="1.0" encoding="utf-8"?>
<log>
<logentry
revision="42">
<author>fpc</author>
<date>2005-05-21T09:42:41.620737Z</date>
<msg> * log and id tags removed
</msg>
</logentry>
<logentry
revision="35">
<author>florian</author>
<date>2005-05-19T22:16:53.958853Z</date>
<msg> * fixed comparisation of booleans and nulls in variants, fixes bug 3953
</msg>
</logentry>
<logentry
revision="34">
<author>florian</author>
<date>2005-05-19T22:13:11.823700Z</date>
<msg> * createguid fixed
</msg>
</logentry>
<logentry
revision="33">
<author>michael</author>
<date>2005-05-19T21:14:45.797276Z</date>
<msg>+ Removed VER1_0 defines</msg>
</logentry>
<logentry
revision="27">
<author>michael</author>
<date>2005-05-19T17:31:25.033833Z</date>
<msg>+ Implementation of CreateGUID</msg>
</logentry>
<logentry
revision="20">
<author>fpc</author>
<date>2005-05-18T20:24:09.513140Z</date>
<msg> * property svn:mime-type for most files in main branch fixed
</msg>
</logentry>
<logentry
revision="19">
<author>fpc</author>
<date>2005-05-18T16:53:52.841566Z</date>
<msg> * eol style property in main branch fixed
</msg>
</logentry>
<logentry
revision="16">
<author>fpc</author>
<date>2005-05-18T16:16:11.495319Z</date>
<msg> * property svn:eol-style: native set
</msg>
</logentry>
<logentry
revision="15">
<author>marco</author>
<date>2005-05-18T08:57:17.758875Z</date>
<msg> * Patch from maillist for read() on a file with only a few numerical digits
in them and no crlf
</msg>
</logentry>
<logentry
revision="13">
<author>florian</author>
<date>2005-05-17T22:27:53.833452Z</date>
<msg>* format(%u",[&lt;qword&gt;]); fixed
* made test working</msg>
</logentry>
<logentry
revision="7">
<author>peter</author>
<date>2005-05-16T20:59:02.681395Z</date>
<msg> * post 2.0.0 fixes from cvs
</msg>
</logentry>
<logentry
revision="1">
<author>fpc</author>
<date>2005-05-16T18:37:41.817974Z</date>
<msg>initial import</msg>
</logentry>
</log>

134
utils/svn2cvs/vers.pp Normal file
View File

@ -0,0 +1,134 @@
{$mode objfpc}
{$h+}
program vers;
uses Classes,sysutils,process,DOM,xmlread,custapp,IniFiles;
Type
{ TVersion }
TVersion = Class(TCollectionItem)
private
FAuthor: String;
FDate: string;
FLogMessage: String;
FRevision: Integer;
Public
Property Revision : Integer read FRevision;
Property LogMessage : String Read FLogMessage;
Property Date : string Read FDate;
Property Author : String Read FAuthor;
end;
{ TVersions }
TVersions = Class(TCollection)
private
function GetVersion(Index : INteger): TVersion;
procedure SetVersion(Index : INteger; const AValue: TVersion);
Protected
procedure ConvertLogEntry(E : TDomElement);
public
Procedure LoadFromXML(Doc : TXMlDocument);
property Versions[Index : INteger] : TVersion Read GetVersion Write SetVersion; Default;
end;
AppError = Class(Exception);
Resourcestring
SErrInValidSVNLog = 'INvalid SVN log';
{ TVersions }
function TVersions.GetVersion(Index : INteger): TVersion;
begin
Result:=Items[Index] as Tversion;
end;
procedure TVersions.SetVersion(Index : INteger; const AValue: TVersion);
begin
Items[Index]:=AValue;
end;
procedure TVersions.ConvertLogEntry(E : TDomElement);
Function GetNodeText(N : TDomNode) : String;
begin
N:=N.FirstChild;
If N<>Nil then
Result:=N.NodeValue;
end;
Var
N : TDomNode;
V : TVersion;
begin
V:=Add as TVersion;
V.FRevision:=StrToIntDef(E['revision'],-1);
N:=E.FirstChild;
While (N<>Nil) do
begin
If (N.NodeType=ELEMENT_NODE) then
begin
if (N.NodeName='author') then
V.FAuthor:=GetNodeText(N)
else If (N.NodeName='date') then
V.FDate:=GetNodeText(N)
else If (N.NodeName='msg') then
V.FLogMessage:=GetNodeText(N);
end;
N:=N.NextSibling;
end;
end;
procedure TVersions.LoadFromXML(Doc: TXMlDocument);
var
L : TDomNode;
E : TDomElement;
begin
L:=Doc.FirstChild;
While (L<>Nil) and not ((L.NodeType=ELEMENT_NODE) and (L.NodeName='log')) do
L:=L.NextSibling;
if (L=Nil) then
Raise AppError.Create(SErrInValidSVNLog);
L:=L.FirstChild;
While (L<>Nil) do
begin
If (L.NodeType=ELEMENT_NODE) and (L.NodeName='logentry') then
E:=TDomElement(L);
ConvertLogEntry(E);
L:=L.NextSibling;
end;
end;
Var
Doc : TXMLDocument;
F : TFileStream;
I : Integer;
begin
With TVersions.Create(TVersion) do
Try
F:=TFileStream.Create('test.xml',fmOpenRead);
Try
ReadXMLFile(Doc,F);
Writeln('Got ',Count,' revisions');
LoadFromXml(Doc);
For I:=0 to count-1 do
begin
Writeln('Revision ',I,' : ');
Writeln('Revision : ',Versions[i].Revision);
Writeln('Author : ',Versions[i].Author);
Writeln('Date : ',Versions[i].Date);
Writeln('Message : ',Versions[i].LogMessage);
end;
finally
F.Free;
end;
Finally
Free;
end;
end.