svn: added unit for executing svn commands and capturing the output

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@99 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/svn/svnclasses.pas

@@ -1,3 +1,32 @@
+{ Classes for interpreting the output of svn commands
+
+  Copyright (C) 2007 Vincent Snijders vincents@freepascal.org
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version with the following modification:
+
+  As a special exception, the copyright holders of this library give you
+  permission to link this library with independent modules to produce an
+  executable, regardless of the license terms of these independent modules,and
+  to copy and distribute the resulting executable under terms of your choice,
+  provided that you also meet, for each linked independent module, the terms
+  and conditions of the license of that module. An independent module is a
+  module which is not derived from or based on this library. If you modify
+  this library, you may extend this exception to your version of the library,
+  but you are not obligated to do so. If you do not wish to do so, delete this
+  exception statement from your version.
+
+  This program is distributed in the hope that it will be useful, but WITHOUT
+  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+  FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  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;
 
 {$mode objfpc}{$H+}

components/svn/svncommand.pas

@@ -0,0 +1,99 @@
+{ Classes for interpreting the output of svn commands
+
+  Copyright (C) 2007 Vincent Snijders vincents@freepascal.org
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version with the following modification:
+
+  As a special exception, the copyright holders of this library give you
+  permission to link this library with independent modules to produce an
+  executable, regardless of the license terms of these independent modules,and
+  to copy and distribute the resulting executable under terms of your choice,
+  provided that you also meet, for each linked independent module, the terms
+  and conditions of the license of that module. An independent module is a
+  module which is not derived from or based on this library. If you modify
+  this library, you may extend this exception to your version of the library,
+  but you are not obligated to do so. If you do not wish to do so, delete this
+  exception statement from your version.
+
+  This program is distributed in the hope that it will be useful, but WITHOUT
+  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+  FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+unit SvnCommand;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils,
+  process,
+  FileUtil;
+
+function ExecuteSvnCommand(const Command: string; Output: TStream): integer;
+
+var
+  SvnExecutable: string;
+
+implementation
+
+procedure InitializeSvnExecutable;
+begin
+  if FileExists(SvnExecutable) then exit;
+{$IFDEF windows}
+  SvnExecutable := GetEnvironmentVariable('ProgramFiles') + '\Subversion\bin\svn.exe';
+{$ENDIF}
+  if not FileExists(SvnExecutable) then
+    SvnExecutable := FindDefaultExecutablePath('svn');
+  if not FileExists(SvnExecutable) then
+    raise Exception.Create('No svn executable found');
+end;
+
+function ExecuteSvnCommand(const Command: string; Output: TStream): integer;
+var
+  SvnProcess: TProcess;
+  
+  function ReadOutput: boolean;
+  // returns true if output was actually read
+  const
+    BufSize = 4096;
+  var
+    Buffer: array[0..BufSize-1] of byte;
+    ReadBytes: integer;
+  begin
+    Result := false;
+    while SvnProcess.Output.NumBytesAvailable>0 do begin
+      ReadBytes := SvnProcess.Output.Read(Buffer, BufSize);
+      Output.Write(Buffer, ReadBytes);
+      Result := true;
+    end;
+  end;
+begin
+  if SvnExecutable='' then InitializeSvnExecutable;
+
+  SvnProcess := TProcess.Create(nil);
+  try
+    SvnProcess.CommandLine := SvnExecutable + ' ' + Command;
+    SvnProcess.Options := [poUsePipes];
+    SvnProcess.Execute;
+    while SvnProcess.Running do begin
+      if not ReadOutput then
+        Sleep(100);
+    end;
+    ReadOutput;
+    Result := SvnProcess.ExitStatus;
+  finally
+    SvnProcess.Free;
+  end;
+end;
+
+end.
+

components/svn/svnpkg.lpk

@@ -16,17 +16,24 @@
         <CompilerPath Value="$(CompPath)"/>
       </Other>
     </CompilerOptions>
-    <Files Count="1">
+    <Files Count="2">
       <Item1>
         <Filename Value="svnclasses.pas"/>
         <UnitName Value="svnclasses"/>
       </Item1>
+      <Item2>
+        <Filename Value="svncommand.pas"/>
+        <UnitName Value="SvnCommand"/>
+      </Item2>
     </Files>
-    <RequiredPkgs Count="1">
+    <RequiredPkgs Count="2">
       <Item1>
+        <PackageName Value="LCL"/>
+      </Item1>
+      <Item2>
         <PackageName Value="FCL"/>
         <MinVersion Major="1" Valid="True"/>
-      </Item1>
+      </Item2>
     </RequiredPkgs>
     <UsageOptions>
       <UnitPath Value="$(PkgOutDir)\"/>

components/svn/svnpkg.pas

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

components/svn/test/fpcunitsvnpkg.lpi

@@ -38,7 +38,7 @@
         <PackageName Value="FCL"/>
       </Item4>
     </RequiredPackages>
-    <Units Count="2">
+    <Units Count="3">
       <Unit0>
         <Filename Value="fpcunitsvnpkg.lpr"/>
         <IsPartOfProject Value="True"/>
@@ -49,6 +49,11 @@
         <IsPartOfProject Value="True"/>
         <UnitName Value="TestSvnClasses"/>
       </Unit1>
+      <Unit2>
+        <Filename Value="testsvncommand.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="TestSvnCommand"/>
+      </Unit2>
     </Units>
   </ProjectOptions>
   <CompilerOptions>
@@ -59,10 +64,11 @@
     </CodeGeneration>
     <Linking>
       <Debugging>
-        <UseHeaptrc Value="True"/>
+        <UseLineInfoUnit Value="False"/>
       </Debugging>
     </Linking>
     <Other>
+      <CustomOptions Value="-Faheaptrc"/>
       <CompilerPath Value="$(CompPath)"/>
     </Other>
   </CompilerOptions>

components/svn/test/fpcunitsvnpkg.lpr

@@ -3,7 +3,7 @@ program fpcunitsvnpkg;
 {$mode objfpc}{$H+}
 
 uses
-  Interfaces, Forms, GuiTestRunner, TestSvnClasses, svnpkg;
+  Interfaces, Forms, GuiTestRunner, TestSvnClasses, svnpkg, TestSvnCommand;
 
 begin
   Application.Initialize;

components/svn/test/testsvncommand.pas

@@ -0,0 +1,68 @@
+unit TestSvnCommand;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testregistry,
+  SvnCommand, svnclasses;
+
+type
+
+  { TTestSvnCommand }
+
+  TTestSvnCommand= class(TTestCase)
+  published
+    procedure TestHookUp; 
+    procedure TestGetInfo;
+  end; 
+
+implementation
+
+procedure TTestSvnCommand.TestHookUp; 
+var
+  SvnExitCode : integer;
+  XmlOutput: TMemoryStream;
+begin
+  try
+    XmlOutput:= TMemoryStream.Create;
+    SvnExitCode := ExecuteSvnCommand('log --xml -rHEAD', XmlOutput);
+    AssertEquals('Unexpected exit code', 0, SvnExitCode);
+    AssertTrue('No XmlOuput', XmlOutput.Size>0)
+  finally
+    XmlOutput.Free;
+  end;
+end;
+
+procedure TTestSvnCommand.TestGetInfo;
+var
+  SvnExitCode : integer;
+  XmlOutput: TMemoryStream;
+  SvnInfo: TSvnInfo;
+begin
+  try
+    XmlOutput:= TMemoryStream.Create;
+    SvnExitCode := ExecuteSvnCommand('info --xml .', XmlOutput);
+    AssertEquals('Unexpected exit code', 0, SvnExitCode);
+    AssertTrue('No XmlOuput', XmlOutput.Size>0);
+    SvnInfo := TSvnInfo.Create;
+    try
+      XmlOutput.Position := 0;
+      SvnInfo.LoadFromStream(XmlOutput);
+      AssertEquals('Wrong repository UUID',
+        '8e941d3f-bd1b-0410-a28a-d453659cc2b4',
+        SvnInfo.Entry.Repository.UUID);
+    finally
+      SvnInfo.Free;
+    end;
+  finally
+    XmlOutput.Free;
+  end;
+end;
+
+initialization
+
+  RegisterTest(TTestSvnCommand); 
+end.
+