source: trunk/UFormMain.pas

unit UFormMain;

{$mode Delphi}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Menus,
  ComCtrls, ExtCtrls, StdCtrls, UExternalTool, fgl, UXMLUtils, UJobProgressView,
  dateutils, URegistry, Registry;

type
  THistoryItem = class
    HumanName: string;
    UserName: string;
    Time: TDateTime;
    Operation: string;
    Location: string;
    Comment: string;
    ElementType: string;
    Command: string;
    LabelName: string;
  end;

  THistoryItems = class(TFPGObjectList<THistoryItem>)
  end;

  { TFormMain }

  TFormMain = class(TForm)
    ButtonBrowse: TButton;
    ButtonLoadHistory: TButton;
    ButtonBuild: TButton;
    EditDir: TEdit;
    JobProgressView1: TJobProgressView;
    Label1: TLabel;
    ListView1: TListView;
    Panel1: TPanel;
    procedure ButtonBrowseClick(Sender: TObject);
    procedure ButtonBuildClick(Sender: TObject);
    procedure ButtonLoadHistoryClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure ListView1Data(Sender: TObject; Item: TListItem);
  private
    procedure LoadConfig;
    function ParseLine(var Line: string; Separator: string): string;
    procedure JobBuild(Job: TJob);
    procedure JobLoad(Job: TJob);
    procedure Load;
    procedure Build;
    function EscapeString(Text: string): string;
    procedure SaveConfig;
  public
    History: THistoryItems;
    BaseDir: string;
    procedure ReloadList;
  end;

var
  FormMain: TFormMain;


implementation

const
  DefaultRegKey = '\Software\Chronosoft\CC2SVN';

{$R *.lfm}

{ TFormMain }

procedure TFormMain.FormShow(Sender: TObject);
begin
  LoadConfig;
  ReloadList;
end;

procedure TFormMain.ButtonBrowseClick(Sender: TObject);
var
  OutDir: string;
begin
  if SelectDirectory('Select ClearCase directory', EditDir.Text, OutDir) then
    EditDir.Text := OutDir;
end;

procedure TFormMain.ButtonBuildClick(Sender: TObject);
begin
  Build;
end;

procedure TFormMain.ButtonLoadHistoryClick(Sender: TObject);
begin
  Load;
  ReloadList;
end;

procedure TFormMain.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
  SaveConfig;
end;

procedure TFormMain.FormCreate(Sender: TObject);
begin
  History := THistoryItems.Create;
end;

procedure TFormMain.FormDestroy(Sender: TObject);
begin
  FreeAndNil(History);
end;

procedure TFormMain.ListView1Data(Sender: TObject; Item: TListItem);
begin
  if Item.Index < History.Count then
  with THistoryItem(History[Item.Index]) do begin
    Item.Caption := DateTimeToStr(Time);
    Item.SubItems.Add(UserName);
    Item.SubItems.Add(Operation);
    Item.SubItems.Add(Location);
    Item.SubItems.Add(ElementType);
    Item.SubItems.Add(Command);
    Item.SubItems.Add(Comment);
    Item.SubItems.Add(LabelName);
  end;
end;

procedure TFormMain.Load;
begin
  JobProgressView1.Clear;
  JobProgressView1.AddJob('Load ClearCase history', JobLoad);
  JobProgressView1.Start;
end;

procedure TFormMain.JobBuild(Job: TJob);
var
  I: Integer;
  FileName: string;
  SourceFileName: string;
  Lines: TStringList;
  PendingChanges: Boolean;
  LastUserName: string;
  LastComment: string;
  LastTime: TDateTime;
const
  CommitCombineTimeTolerance = 5 * OneMinute;

procedure CommitChanges(UserName, Comment: string; Time: TDateTime);
begin
  if UserName <> '' then begin
    SVN(['add', '*', '-q', '--force'], GetCurrentDir + '\work');
    SVN(['commit', '-m "' + EscapeString(Comment) + '"', '--username', UserName], GetCurrentDir + '\work');
    SVN(['propset', 'svn:date', '--revprop', '-r', 'HEAD', DateTimeToXMLTime(Time, False)], GetCurrentDir + '\work');
  end;
  PendingChanges := False;
end;

begin
  Job.Progress.Max := History.Count;
  BaseDir := EditDir.Text;
  ExecuteProcessOut(SVNAdminPath, ['create', 'repo']);

  // Allow change of svn:date property
  Lines := TStringList.Create;
  Lines.Text := 'exit /b 0';
  Lines.SaveToFile(GetCurrentDir + '\repo\hooks\pre-revprop-change.bat');
  Lines.Free;

  PendingChanges := False;
  SVN(['checkout', 'file:///' + GetCurrentDir + '\repo', GetCurrentDir + '\work']);
  for I := History.Count - 1 downto 0 do
  with THistoryItem(History[I]) do begin
    if Operation = 'create version' then begin
      FileName := GetCurrentDir + '\work\trunk\' + Location;
      if Pos('@@', FileName) > 0 then
        FileName := Copy(FileName, 1, Pos('@@', FileName) - 1);
      ForceDirectories(ExtractFileDir(FileName));
      SourceFileName := BaseDir + DirectorySeparator + Location;
      if FileExists(SourceFileName) and
      (Length(SourceFileName) >= 2) and
      not ((SourceFileName[Length(SourceFileName)] = '0') and
      (SourceFileName[Length(SourceFileName) - 1] = '\')) then begin
        // Merge multiple check-ins to single commit if
        // comment is the same and
        // username is the same
        // time between commits is less then defined tolerance
        if (LastComment <> Comment) or
        (LastUserName <> UserName) or
        (LastTime < (Time - CommitCombineTimeTolerance)) then
          CommitChanges(LastUserName, LastComment, LastTime);

        CopyFile(SourceFileName, FileName);
        PendingChanges := True;

        LastUserName := UserName;
        LastComment := Comment;
        LastTime := Time;
      end;
    end;
    Job.Progress.Increment;
    if Job.Terminate then Break;
  end;
  if PendingChanges then CommitChanges(LastUserName, LastComment, LastTime);
end;

procedure TFormMain.JobLoad(Job: TJob);
type
  TParseState = (psTime, psHumanName, psUserName, psOperation, psLocation,
    psElementType, psCommand, psComment, psNewLine);
var
  Lines: TStringList;
  HistoryItem: THistoryItem;
  Content: string;
  State: TParseState;
  Text: string;
  StartIndex: Integer;
  I: Integer;
begin
  Lines := TStringList.Create;
{$IF 0}
  Lines.Text := ClearTool(['lshistory', '-recurse', '-minor', '-nco',
    '-fmt "%d|%Fu|%u|%e|%n|%m|%o|%Nc|\n"'], EditDir.Text);
{$ELSE}
  Lines.LoadFromFile('log.txt');
{$ENDIF}
  Content := Lines.Text;
  Job.Progress.Max := Length(Content);
  StartIndex := 1;
  State := psTime;
  I := 1;
  while I < Length(Content) do begin
    if Content[I] = '|' then begin
      Text := Copy(Content, StartIndex, I - StartIndex);
      StartIndex := I + 1;
      if State = psTime then begin
        HistoryItem := THistoryItem.Create;
        HistoryItem.Time := XMLTimeToDateTime(Text);
        State := psHumanName;
      end else
      if State = psHumanName then begin
        HistoryItem.HumanName := Text;
        State := psUserName;
      end else
      if State = psUserName then begin
        HistoryItem.UserName := Text;
        State := psOperation;
      end else
      if State = psOperation then begin
        HistoryItem.Operation := Text;
        State := psLocation;
      end else
      if State = psLocation then begin
        HistoryItem.Location := Text;
        State := psElementType;
      end else
      if State = psElementType then begin
        HistoryItem.ElementType := Text;
        State := psCommand;
      end else
      if State = psCommand then begin
        HistoryItem.Command := Text;
        State := psComment;
      end else
      if State = psComment then begin
        HistoryItem.Comment := Text;
        History.Add(HistoryItem);
        State := psNewLine;
      end;
    end else
    if State = psNewLine then begin
      if Content[I] = #10 then begin
        State := psTime;
        StartIndex := I + 1;
      end;
    end;
    Inc(I);

    Job.Progress.Value := I;
    if Job.Terminate then Break;
  end;
  Lines.Free;
end;

procedure TFormMain.Build;
begin
  JobProgressView1.Clear;
  JobProgressView1.AddJob('Build SVN versions', JobBuild);
  JobProgressView1.Start;
end;

function TFormMain.EscapeString(Text: string): string;
begin
  Result := StringReplace(Text, '"', '\"', [rfReplaceAll]);
end;

procedure TFormMain.ReloadList;
begin
  ListView1.Items.Count := History.Count;
  ListView1.Refresh;
end;

function TFormMain.ParseLine(var Line: string; Separator: string): string;
begin
  Result := Copy(Line, 1, Pos(Separator, Line) - 1);
  Delete(Line, 1, Length(Result) + Length(Separator));
end;

procedure TFormMain.SaveConfig;
begin
  with TRegistryEx.Create do
  try
    RootKey := HKEY_CURRENT_USER;
    OpenKey(DefaultRegKey, True);
    WriteString('CCDir', EditDir.Text);
  finally
    Free;
  end;
end;

procedure TFormMain.LoadConfig;
begin
  ClearToolPath := 'C:\Program Files\IBM\RationalSDLC\ClearCase\bin\cleartool.exe';
  with TRegistryEx.Create do
  try
    RootKey := HKEY_CURRENT_USER;
    OpenKey(DefaultRegKey, True);
    EditDir.Text := ReadStringWithDefault('CCDir', EditDir.Text);
  finally
    Free;
  end;
end;

end.