added TSvnPropInfo class to hold svn proplist output

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@112 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
vsnijders 2007-03-04 22:59:58 +00:00
parent db352a016a
commit ac626de964
5 changed files with 290 additions and 6 deletions

View File

@ -27,16 +27,17 @@
along with this library; if not, write to the Free Software Foundation,
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}
unit svnclasses;
unit SvnClasses;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,
Classes, SysUtils, strutils,
contnrs,
DOM, XMLRead;
DOM, XMLRead,
SvnCommand;
type
@ -51,6 +52,7 @@ type
public
procedure LoadFromStream(s: TStream);
procedure LoadFromFile(FileName: string);
procedure LoadFromCommand(command: string);
end;
{ TCommit }
@ -112,6 +114,7 @@ type
procedure LoadFromXml(ADoc: TXMLDocument); override;
public
constructor Create;
constructor Create(const Uri: string);
destructor Destroy; override;
procedure Clear;
property Entry: TEntry read FEntry;
@ -142,13 +145,16 @@ type
FLogPaths: TFPObjectList;
FMessage: string;
FRevision: integer;
function GetCommonPath: string;
function GetLogPath(index: integer): TLogPath;
function GetLogPathCount: integer;
procedure LoadFromNode(ANode: TDOMElement);
procedure SortPaths;
public
constructor Create;
destructor Destroy; override;
property Author: string read FAuthor write FAuthor;
property CommonPath: string read GetCommonPath;
property Date: string read FDate write FDate;
property Message: string read FMessage write FMessage;
property Path[index: integer] :TLogPath read GetLogPath;
@ -171,6 +177,35 @@ type
property LogEntry[index: integer] :TLogEntry read GetLogEntry;
property LogEntryCount: integer read GetLogEntryCount;
end;
{ TSvnFileProp }
TSvnFileProp = class
private
FFileName: string;
FProperties: TStrings;
public
constructor Create;
destructor Destroy; override;
property FileName: string read FFileName;
property Properties: TStrings read FProperties;
end;
{ TSvnPropInfo }
TSvnPropInfo = class
private
FFiles: TFPObjectList;
function GetFile(index: integer): TSvnFileProp;
function GetFileCount: integer;
public
constructor Create;
destructor Destroy; override;
procedure LoadFromStream(s: TStream);
procedure LoadFromFile(FileName: string);
property FileItem[index: integer]: TSvnFileProp read GetFile; default;
property FileCount: integer read GetFileCount;
end;
implementation
@ -214,6 +249,21 @@ begin
end;
end;
procedure TSvnBase.LoadFromCommand(command: string);
var
XmlOutput: TMemoryStream;
begin
XmlOutput := TMemoryStream.Create;
try
ExecuteSvnCommand(command, XmlOutput);
//DumpStream(XmlOutput);
XmlOutput.Position := 0;
LoadFromStream(XmlOutput);
finally
XmlOutput.Free;
end;
end;
{ TSvnInfo }
procedure TSvnInfo.LoadFromXml(ADoc: TXMLDocument);
@ -228,6 +278,12 @@ begin
FEntry := TEntry.Create;
end;
constructor TSvnInfo.Create(const Uri: string);
begin
Create;
LoadFromCommand('info --xml '+Uri);
end;
destructor TSvnInfo.Destroy;
begin
FEntry.Free;
@ -385,6 +441,23 @@ begin
Result := TLogPath(FLogPaths[index]);
end;
function TLogEntry.GetCommonPath: string;
var
i: integer;
NextPath: string;
begin
if FLogPaths.Count = 0 then exit('');
Result := ExtractFilePath(Path[0].Path);
i := 1;
while i<FLogPaths.Count do begin
NextPath := Path[i].Path;
while (Copy(NextPath,1,length(Result))<>Result) do
Result := ExtractFilePath(ExtractFileDir(Result));
inc(i);
end;
end;
function TLogEntry.GetLogPathCount: integer;
begin
Result := FLogPaths.Count;
@ -417,6 +490,20 @@ begin
end;
end;
function PathCompare(Item1, Item2: Pointer): Integer;
var
Path1, Path2: TLogPath;
begin
Path1 := TLogPath(Item1);
Path2 := TLogPath(Item2);
Result := CompareStr(Path1.Path, Path2.Path);
end;
procedure TLogEntry.SortPaths;
begin
FLogPaths.Sort(@PathCompare);
end;
constructor TLogEntry.Create;
begin
inherited Create;
@ -448,5 +535,100 @@ begin
end;
end;
{ TSvnFileProp }
constructor TSvnFileProp.Create;
begin
FProperties := TStringList.Create;
end;
destructor TSvnFileProp.Destroy;
begin
FProperties.Free;
inherited Destroy;
end;
{ TSvnPropInfo }
function TSvnPropInfo.GetFile(index: integer): TSvnFileProp;
begin
Result := TSvnFileProp(FFiles[index]);
end;
function TSvnPropInfo.GetFileCount: integer;
begin
Result := FFiles.Count;
end;
constructor TSvnPropInfo.Create;
begin
FFiles := TFPObjectList.Create(true);
end;
destructor TSvnPropInfo.Destroy;
begin
FFiles.Free;
inherited Destroy;
end;
procedure TSvnPropInfo.LoadFromStream(s: TStream);
var
Lines: TStrings;
Line: string;
FileProp: TSvnFileProp;
i: Integer;
QuotePos, ColonPos: integer;
PropName, PropValue: String;
const
PropertiesOn = 'Properties on ';
begin
Lines := TStringList.Create;
try
Lines.LoadFromStream(s);
i := 0;
while (i<Lines.Count) do begin
Line := Lines[i];
if copy(Line, 1, length(PropertiesOn))=PropertiesOn then begin
FileProp := TSvnFileProp.Create;
QuotePos := PosEx('''', Line, Length(PropertiesOn)+2);
FileProp.FFileName :=
Copy(Line, Length(PropertiesOn)+2, QuotePos - Length(PropertiesOn)-2);
FFiles.Add(FileProp);
inc(i);
while (i<Lines.Count) do begin
Line := Lines[i];
if (Length(Line)<2) or (Line[1]<>' ') then begin
// new file, so unget line
dec(i);
break;
end;
ColonPos := Pos(' : ', Line);
PropName := Copy(Line, 3, ColonPos - 3);
PropValue := Copy(Line, ColonPos + 3, Length(Line)-ColonPos-2);
FileProp.Properties.Values[PropName] := PropValue;
inc(i);
end;
end
else
inc(i);
end;
finally
Lines.Free;
end;
end;
procedure TSvnPropInfo.LoadFromFile(FileName: string);
var
FileStream: TFileStream;
begin
FileStream := TFileStream.Create(FileName, fmOpenRead);
try
LoadFromStream(FileStream);
finally
FileStream.Free;
end;
end;
end.

View File

@ -39,6 +39,8 @@ uses
FileUtil;
function ExecuteSvnCommand(const Command: string; Output: TStream): integer;
function ExecuteSvnCommand(const Command: string): integer;
procedure DumpStream(const AStream: TStream);
var
SvnExecutable: string;
@ -95,5 +97,29 @@ begin
end;
end;
function ExecuteSvnCommand(const Command: string): integer;
var
Output: TMemoryStream;
begin
Output := TMemoryStream.Create;
try
Result := ExecuteSvnCommand(Command, Output);
finally
Output.Free;
end;
end;
procedure DumpStream(const AStream: TStream);
var
lines: TStrings;
begin
lines := TStringList.Create;
AStream.Position := 0;
lines.LoadFromStream(AStream);
writeln(lines.Text);
lines.Free;
end;
end.

View File

@ -7,7 +7,7 @@ unit svnpkg;
interface
uses
svnclasses, SvnCommand;
SvnClasses, SvnCommand;
implementation

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>
@ -64,11 +63,13 @@
</CodeGeneration>
<Linking>
<Debugging>
<GenerateDebugInfo Value="True"/>
<UseLineInfoUnit Value="False"/>
</Debugging>
</Linking>
<Other>
<CustomOptions Value="-Faheaptrc"/>
<CustomOptions Value="-Faheaptrc
"/>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>

View File

@ -16,13 +16,17 @@ type
private
function GetInfoFileName: string;
function GetLogFileName: string;
function GetPropFileName: string;
published
procedure TestHookUp;
procedure TestLoadInfo;
procedure TestInfoCreateUrl;
procedure TestLoadLog;
procedure TestLoadSimpleLogPaths;
procedure TestLoadComplexLogPaths;
procedure TestLoadLogTwice;
procedure TestLogCommonPath;
procedure TestPropList;
end;
implementation
@ -37,6 +41,11 @@ begin
Result := ExtractFilePath(ParamStr(0)) + 'log.xml';
end;
function TTestSvnClasses.GetPropFileName: string;
begin
Result := ExtractFilePath(ParamStr(0)) + 'proplist.txt';
end;
procedure TTestSvnClasses.TestHookUp;
procedure CheckFile(const FileName: string);
begin
@ -75,6 +84,20 @@ begin
end;
end;
procedure TTestSvnClasses.TestInfoCreateUrl;
var
SvnInfo: TSvnInfo;
begin
SvnInfo := TSvnInfo.Create('.');
try
AssertEquals('Wrong repository UUID',
'8e941d3f-bd1b-0410-a28a-d453659cc2b4',
SvnInfo.Entry.Repository.UUID);
finally
SvnInfo.Free;
end;
end;
procedure TTestSvnClasses.TestLoadLog;
var
SvnLog: TSvnLog;
@ -164,6 +187,58 @@ begin
end;
end;
procedure TTestSvnClasses.TestLogCommonPath;
var
SvnLog: TSvnLog;
procedure AssertCommonPath(i: integer;const ACommonPath: string);
var
LogEntry: TLogEntry;
begin
LogEntry := SvnLog.LogEntry[i];
AssertEquals('Wrong common path '+IntToStr(i), ACommonPath, LogEntry.CommonPath);
end;
begin
SvnLog := TSvnLog.Create;
try
SvnLog.LoadFromFile(GetLogFileName);
AssertEquals('Wrong number of log entries', 6, SvnLog.LogEntryCount);
AssertCommonPath(4, '/trunk/lcl/interfaces/win32/');
AssertCommonPath(5, '/trunk/lcl/interfaces/win32/');
AssertCommonPath(3, '/trunk/components/tachart/');
AssertCommonPath(0, '/trunk/');
finally
SvnLog.Free;
end;
end;
procedure TTestSvnClasses.TestPropList;
var
SvnPropInfo: TSvnPropInfo;
procedure AssertFileProp(i: integer; const FileName: string);
var
FileProp: TSvnFileProp;
begin
FileProp := SvnPropInfo.FileItem[i];
AssertEquals('Wrong file name', FileName, FileProp.FileName);
AssertEquals('Wrong number of properties', 2, FileProp.Properties.Count);
AssertEquals('Wrong property name', 'svn:mime-type', FileProp.Properties.Names[0]);
AssertEquals('Wrong property value', 'text/plain', FileProp.Properties.ValueFromIndex[0]);
end;
begin
SvnPropInfo := TSvnPropInfo.Create;
try
SvnPropInfo.LoadFromFile(GetPropFileName);
AssertEquals('Wrong number of files', 3, SvnPropInfo.FileCount);
AssertFileProp(0, 'testsvnclasses.pas');
AssertFileProp(1, 'testsvncommand.pas');
AssertFileProp(2, 'fpcunitsvnpkg.lpi');
finally
SvnPropInfo.Free;
end;
end;
initialization
RegisterTest(TTestSvnClasses);