initial import of fpsvnsync

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

applications/fpsvnsync/fpsvnsync.lpi

@@ -0,0 +1,203 @@
+<?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="2">
+      <Item1>
+        <PackageName Value="svnpkg"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="FCL"/>
+      </Item2>
+    </RequiredPackages>
+    <Units Count="21">
+      <Unit0>
+        <Filename Value="fpsvnsync.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="fpsvnsync"/>
+        <CursorPos X="30" Y="33"/>
+        <TopLine Value="307"/>
+        <EditorIndex Value="0"/>
+        <UsageCount Value="133"/>
+        <Loaded Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="..\..\..\..\fpc\2.1\fcl\inc\custapp.pp"/>
+        <UnitName Value="CustApp"/>
+        <CursorPos X="3" Y="166"/>
+        <TopLine Value="188"/>
+        <UsageCount Value="62"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="..\test\testsvncommand.pas"/>
+        <UnitName Value="TestSvnCommand"/>
+        <CursorPos X="15" Y="9"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="9"/>
+      </Unit2>
+      <Unit3>
+        <Filename Value="..\svncommand.pas"/>
+        <UnitName Value="SvnCommand"/>
+        <CursorPos X="58" Y="96"/>
+        <TopLine Value="76"/>
+        <UsageCount Value="67"/>
+      </Unit3>
+      <Unit4>
+        <Filename Value="..\svnclasses.pas"/>
+        <UnitName Value="SvnClasses"/>
+        <CursorPos X="35" Y="476"/>
+        <TopLine Value="541"/>
+        <UsageCount Value="67"/>
+      </Unit4>
+      <Unit5>
+        <Filename Value="..\..\..\..\fpc\2.1\fcl\xml\xmlread.pp"/>
+        <UnitName Value="XMLRead"/>
+        <CursorPos X="16" Y="886"/>
+        <TopLine Value="866"/>
+        <UsageCount Value="61"/>
+      </Unit5>
+      <Unit6>
+        <Filename Value="..\..\..\..\fpc\2.1\fcl\inc\process.pp"/>
+        <UnitName Value="process"/>
+        <CursorPos X="1" Y="186"/>
+        <TopLine Value="153"/>
+        <UsageCount Value="9"/>
+      </Unit6>
+      <Unit7>
+        <Filename Value="..\..\..\..\lazarus\lcl\stringhashlist.pas"/>
+        <UnitName Value="StringHashList"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="55"/>
+      </Unit7>
+      <Unit8>
+        <Filename Value="..\..\..\..\lazarus\lcl\fpcadds.pas"/>
+        <UnitName Value="FPCAdds"/>
+        <CursorPos X="1" Y="75"/>
+        <TopLine Value="46"/>
+        <UsageCount Value="61"/>
+      </Unit8>
+      <Unit9>
+        <Filename Value="..\..\..\..\fpc\2.1\rtl\win\sysutils.pp"/>
+        <UnitName Value="sysutils"/>
+        <CursorPos X="3" Y="333"/>
+        <TopLine Value="329"/>
+        <UsageCount Value="55"/>
+      </Unit9>
+      <Unit10>
+        <Filename Value="..\..\..\..\fpc\2.1\fcl\inc\contnrs.pp"/>
+        <UnitName Value="contnrs"/>
+        <CursorPos X="34" Y="61"/>
+        <TopLine Value="42"/>
+        <UsageCount Value="22"/>
+      </Unit10>
+      <Unit11>
+        <Filename Value="..\..\..\..\fpc\2.1\rtl\objpas\classes\classesh.inc"/>
+        <CursorPos X="64" Y="147"/>
+        <TopLine Value="128"/>
+        <UsageCount Value="22"/>
+      </Unit11>
+      <Unit12>
+        <Filename Value="..\..\..\..\fpc\2.1\rtl\objpas\sysutils\filutilh.inc"/>
+        <CursorPos X="10" Y="85"/>
+        <TopLine Value="62"/>
+        <UsageCount Value="15"/>
+      </Unit12>
+      <Unit13>
+        <Filename Value="..\..\..\..\fpc\2.1\compiler\aasmtai.pas"/>
+        <UnitName Value="aasmtai"/>
+        <CursorPos X="30" Y="176"/>
+        <TopLine Value="156"/>
+        <UsageCount Value="8"/>
+      </Unit13>
+      <Unit14>
+        <Filename Value="..\..\..\..\fpc\2.1\compiler\cgbase.pas"/>
+        <UnitName Value="cgbase"/>
+        <CursorPos X="7" Y="177"/>
+        <TopLine Value="157"/>
+        <UsageCount Value="8"/>
+      </Unit14>
+      <Unit15>
+        <Filename Value="..\..\..\..\lazarus\lcl\fileutil.pas"/>
+        <UnitName Value="FileUtil"/>
+        <CursorPos X="10" Y="111"/>
+        <TopLine Value="91"/>
+        <UsageCount Value="13"/>
+      </Unit15>
+      <Unit16>
+        <Filename Value="..\..\..\..\lazarus\lcl\include\fileutil.inc"/>
+        <CursorPos X="3" Y="1194"/>
+        <TopLine Value="1186"/>
+        <UsageCount Value="13"/>
+      </Unit16>
+      <Unit17>
+        <Filename Value="..\..\..\..\fpc\2.1\rtl\win32\initc.pp"/>
+        <UnitName Value="initc"/>
+        <CursorPos X="6" Y="18"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="11"/>
+      </Unit17>
+      <Unit18>
+        <Filename Value="..\..\..\..\fpc\2.1\rtl\inc\ctypes.pp"/>
+        <UnitName Value="ctypes"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="11"/>
+      </Unit18>
+      <Unit19>
+        <Filename Value="..\..\..\..\fpc\2.1\rtl\win\wininc\messages.inc"/>
+        <CursorPos X="54" Y="1165"/>
+        <TopLine Value="1138"/>
+        <UsageCount Value="10"/>
+      </Unit19>
+      <Unit20>
+        <Filename Value="..\..\..\..\fpc\2.1\rtl\inc\objpash.inc"/>
+        <CursorPos X="8" Y="264"/>
+        <TopLine Value="254"/>
+        <UsageCount Value="9"/>
+      </Unit20>
+    </Units>
+    <JumpHistory Count="0" HistoryIndex="-1"/>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="5"/>
+    <PathDelim Value="\"/>
+    <CodeGeneration>
+      <Generate Value="Faster"/>
+    </CodeGeneration>
+    <Linking>
+      <Debugging>
+        <GenerateDebugInfo Value="True"/>
+      </Debugging>
+    </Linking>
+    <Other>
+      <CustomOptions Value="-Faheaptrc
+"/>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+</CONFIG>

applications/fpsvnsync/fpsvnsync.lpr

@@ -0,0 +1,345 @@
+{ $Id }
+{ svnsync-like utility written with freepascal
+
+  fpsvnsync synchronizes two svn repositories without the need to set
+  revision properties.
+
+  Copyright (C) 2007 Vincent Snijders (vincents@freepascal.org)
+
+  This source is free software; you can redistribute it and/or modify it under
+  the terms of the GNU General Public License as published by the Free
+  Software Foundation; either version 2 of the License, or (at your option)
+  any later version.
+
+  This code 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 General Public License for more
+  details.
+
+  A copy of the GNU General Public License is available on the World Wide Web
+  at <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing
+  to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+  MA 02111-1307, USA.
+}
+program fpsvnsync;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Classes, SysUtils, CustApp,
+  FileUtil,
+  SvnClasses, SvnCommand;
+  
+type
+
+  { TSvnMirrorApp }
+
+  TSvnMirrorApp = class(TCustomApplication)
+  private
+    FSourceWC: string;
+    FDestWC: string;
+    function GetRevision(Directory: string): integer;
+    function GetRepositoryRoot(Directory: string): string;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure Run;
+  end;
+
+{ TSvnMirrorApp }
+
+function TSvnMirrorApp.GetRevision(Directory: string): integer;
+var
+  SvnInfo: TSvnInfo;
+begin
+  SvnInfo := TSvnInfo.Create(Directory);
+  Result := SvnInfo.Entry.Revision;
+  SvnInfo.Free;
+end;
+
+function TSvnMirrorApp.GetRepositoryRoot(Directory: string): string;
+var
+  SvnInfo: TSvnInfo;
+begin
+  SvnInfo := TSvnInfo.Create(Directory);
+  Result := SvnInfo.Entry.Repository.Root;
+  SvnInfo.Free;
+end;
+
+procedure TSvnMirrorApp.Run;
+var
+  SourceHead: integer;
+  Revision: integer;
+  XmlOutput: TMemoryStream;
+  SvnResult: LongInt;
+  SvnLog: TSvnLog;
+  SubPath: string;
+  DestRoot: string;
+  
+  procedure GetLog;
+  var
+    Command: string;
+  begin
+    writeln('Getting log message for revision ', Revision);
+    Command := Format('log --xml -v -r%d %s', [Revision,FSourceWC]);
+    SvnLog.LoadFromCommand(command);
+    SvnLog.LogEntry[0].SortPaths;
+    SubPath := SvnLog.LogEntry[0].CommonPath;
+    writeln('Finding common path from log messages: ', SubPath);
+  end;
+  
+  procedure UpdateWC(const WorkingDir, SubPath: string; Revision: integer);
+  var
+    Command: string;
+    UpdatePath: string;
+    RevisionStr: string;
+  begin
+    UpdatePath := WorkingDir+SubPath;
+    if Revision > 0 then
+      RevisionStr := IntToStr(Revision)
+    else
+      RevisionStr := 'HEAD';
+    writeln(format('Updating %s to revision %s', [UpdatePath, RevisionStr]));
+    Command := Format('up -r%s %s', [RevisionStr, UpdatePath]);
+    writeln('svn ', Command);
+    SvnResult := ExecuteSvnCommand(Command);
+  end;
+
+  procedure GetDiff;
+  var
+    Command: string;
+    Diff: TStrings;
+  begin
+    writeln('Getting diffs between revision ', Revision-1,' and ', Revision);
+    Command := Format('diff -c%d %s', [Revision, FSourceWC+SubPath]);
+    writeln('svn ', Command);
+    XmlOutput.Clear;
+    SvnResult := ExecuteSvnCommand(Command, XmlOutput);
+    XmlOutput.Position := 0;
+    Diff := TStringList.Create;
+    Diff.LoadFromStream(XmlOutput);
+    writeln('Diff contains ', Diff.Count, ' lines');
+    if pos('Property changes on', Diff.Text)>0 then begin
+      writeln('Properties changed');
+      writeln(Diff.Text);
+      Diff.Free;
+      halt(1);
+    end;
+    Diff.Free;
+  end;
+  
+  procedure DeleteFiles;
+  var
+    LogEntry: TLogEntry;
+    LogPath: TLogPath;
+    i: integer;
+    DestFile: string;
+  begin
+    LogEntry := SvnLog.LogEntry[0];
+    for i := 0 to LogEntry.PathCount-1 do begin
+      LogPath := LogEntry.Path[i];
+      if LogPath.Action=caDelete then begin
+        DestFile := FDestWC + LogPath.Path;
+        writeln('Deleting ', DestFile);
+        ExecuteSvnCommand('delete '+DestFile);
+      end;
+    end;
+  end;
+
+  procedure CopyChanges;
+  var
+    LogEntry: TLogEntry;
+    LogPath: TLogPath;
+    i: integer;
+    SourceFile, DestFile, Command: string;
+  begin
+    LogEntry := SvnLog.LogEntry[0];
+    for i := 0 to LogEntry.PathCount-1 do begin
+      LogPath := LogEntry.Path[i];
+      DestFile := FDestWC + LogPath.Path;
+      if LogPath.Action in [caModify, caAdd] then begin
+        SourceFile := FSourceWC + LogPath.Path;
+        if LogPath.CopyFromPath<>'' then begin
+          Command := format('copy -r%d %s%s %s',
+            [LogPath.CopyFromRevision,
+             DestRoot, LogPath.CopyFromPath, DestFile]);
+          writeln('svn '+ Command);
+          ExecuteSvnCommand(Command);
+        end;
+        writeln('Copy ', SourceFile, ' to ', DestFile);
+        if DirectoryExists(SourceFile) then
+          ForceDirectory(DestFile)
+        else
+          CopyFile(SourceFile, DestFile, true);
+        if LogPath.Action=caAdd then begin
+          writeln('svn add '+ DestFile);
+          writeln('Result: ',ExecuteSvnCommand('add '+DestFile));
+        end;
+      end;
+    end;
+  end;
+  
+  procedure ApplyPropChanges;
+  var
+    SourcePropInfo: TSvnPropInfo;
+    DestPropInfo: TSvnPropInfo;
+    i: Integer;
+
+    function CreatePropInfo(const BaseDir: string): TSvnPropInfo;
+    var
+      Files: TStrings;
+    begin
+      Result := TSvnPropInfo.Create;
+      Files := SvnLog.LogEntry[0].GetFileList(BaseDir);
+      Result.LoadForFiles(Files);
+      Files.Free;
+    end;
+    
+    procedure CopyFileProp(SourceProp, DestProp: TSvnFileProp);
+    var
+      j: integer;
+      Command: string;
+    begin
+      if SourceProp.Properties.Text=DestProp.Properties.Text then exit;
+      
+      writeln('Properties changed for ', DestProp.FileName);
+      writeln('Source properties');
+      writeln(SourceProp.Properties.Text);
+      writeln('Destination properties');
+      writeln(DestProp.Properties.Text);
+
+      for j:=0 to DestProp.Properties.Count-1 do begin
+        Command := format('propdel %s %s',
+          [DestProp.Properties.Names[j], DestProp.FileName]);
+        writeln('svn ', Command);
+        writeln('svn result: ', ExecuteSvnCommand(Command));
+      end;
+      for j:=0 to SourceProp.Properties.Count-1 do begin
+        Command := format('propset %s "%s" %s',
+          [SourceProp.Properties.Names[j],
+           SourceProp.Properties.ValueFromIndex[j],
+           DestProp.FileName]);
+        writeln('svn ', Command);
+        writeln('svn result: ', ExecuteSvnCommand(Command));
+      end;
+    end;
+    
+  begin
+    SourcePropInfo := CreatePropInfo(FSourceWC);
+    DestPropInfo := CreatePropInfo(FDestWC);
+    
+    if SourcePropInfo.FileCount<>DestPropInfo.FileCount then begin
+        writeln('FileName number mismatch: ',
+          SourcePropInfo.FileCount, '<>', DestPropInfo.FileCount);
+        halt(2);
+    end;
+
+    for i := 0 to SourcePropInfo.FileCount-1 do begin
+      if Copy(SourcePropInfo[i].FileName, length(FSourceWC)+1, 4000) <>  Copy(DestPropInfo[i].FileName, Length(FDestWC)+1, 4000)  then begin
+        writeln('FileName mismatch: ',
+          SourcePropInfo[i].FileName, '<>', DestPropInfo[i].FileName);
+        halt(3);
+      end;
+      CopyFileProp(SourcePropInfo[i], DestPropInfo[i]);
+    end;
+
+    SourcePropInfo.Free;
+    DestPropInfo.Free;
+  end;
+  
+  procedure CommitChanges;
+  var
+    Command: string;
+    MessageFile: string;
+    Message: TStrings;
+    LogEntry: TLogEntry;
+  begin
+    writeln('Commit to destination');
+    LogEntry := SvnLog.LogEntry[0];
+    MessageFile := SysUtils.GetTempFileName;
+    Message := TStringList.Create;
+    Message.Add(SvnLog.LogEntry[0].Message);
+    Message.Add(
+      Format('Commited by %s at %s', [LogEntry.Author, LogEntry.DisplayDate]));
+    Message.SaveToFile(MessageFile);
+    writeln(Message.Text);
+    Message.Free;
+    Command := Format('commit -F "%s" %s', [MessageFile, FDestWC+LogEntry.CommonPath]);
+    writeln('svn ', Command);
+    writeln('svn commit result: ', ExecuteSvnCommand(Command));
+    DeleteFile(MessageFile);
+  end;
+  
+begin
+  SourceHead := GetRevision('-rHEAD '+FSourceWC);
+  writeln(FSourceWC, ' HEAD at revision ', SourceHead);
+
+  Revision := GetRevision('-rHEAD '+FDestWC);
+  writeln(FDestWC, ' HEAD at revision ', Revision);
+
+  DestRoot := GetRepositoryRoot(FDestWC);
+  writeln('------');
+  XmlOutput := TMemoryStream.Create;
+
+  SvnLog := TSvnLog.Create;
+  while (Revision<SourceHead) do begin
+    inc(Revision);
+    
+    GetLog;
+    
+    UpdateWC(FDestWC, SvnLog.LogEntry[0].CommonPath, Revision-1);
+    UpdateWC(FSourceWC, SvnLog.LogEntry[0].CommonPath, Revision);
+
+    writeln('Doing adds/deletes');
+    DeleteFiles;
+    CopyChanges;
+    //GetDiff;
+    ApplyPropChanges;
+    CommitChanges;
+
+    writeln;
+    //break;
+    //if Revision>10670 then break;
+  end;
+
+  XmlOutput.Free;
+  SvnLog.Free;
+end;
+
+constructor TSvnMirrorApp.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  if ParamCount=2 then begin
+    FSourceWC := ParamStr(1);
+    FDestWC := ParamStr(2);
+  end
+  else
+  begin
+    FSourceWC := 'd:\lazarus\lazmirror\source';
+    FDestWC := 'd:\lazarus\lazmirror\dest';
+    FSourceWC := 'c:\lazarus\lazmirror\source';
+    FDestWC := 'c:\lazarus\lazmirror\dest';
+  end;
+
+end;
+
+destructor TSvnMirrorApp.Destroy;
+begin
+  inherited Destroy;
+end;
+
+var
+  SvnMirrorApp: TSvnMirrorApp;
+
+begin
+  SvnMirrorApp := TSvnMirrorApp.Create(nil);
+  try
+    SvnMirrorApp.Run;
+  finally
+    SvnMirrorApp.Free;
+  end;
+end.
+