source: trunk/Units/VCS.pas

unit VCS;

interface

uses
  Classes, SysUtils, LazFileUtils, Generics.Collections;

type

  { TLogItem }

  TLogItem = class
    Author: string;
    Actions: string;
    Time: TDateTime;
    Revision: string;
    Messages: TStringList;
    ChangedFiles: TStringList;
    constructor Create;
    destructor Destroy; override;
  end;

  TLogItems = class(TObjectList<TLogItem>)
  end;

  TFileStatusState = (fssNonVersioned, fssAdded, fssRemoved, fssModified, fssNotModified);

  { TFileStatus }

  TFileStatus = class
    FileName: string;
    Version: string;
    Author: string;
    Time: TDateTime;
    State: TFileStatusState;
    procedure Assign(Source: TFileStatus);
  end;

  { TFileStatuses }

  TFileStatuses = class(TObjectList<TFileStatus>)
    function SearchByName(Name: string): TFileStatus;
  end;

  { TWorkingCopy }

  TWorkingCopy = class
  private
    FPath: string;
    FRepositoryURL: string;
    procedure SetPath(AValue: string);
    procedure SetRepositoryURL(AValue: string);
  protected
    EnvVars: TStringList;
    procedure ExecuteProcess(Command: string; Parameters: array of string); virtual;
    function GetNext(var Text: string; Separator: string): string;
  public
    UserName: string;
    Password: string;
    Email: string;
    SilentExecution: Boolean;
    ExecutionOutput: TStringList;
    procedure Checkout; virtual;
    procedure Update; virtual;
    procedure CleanUp; virtual;
    procedure Commit(Message: string); virtual;
    procedure Move(Source, Dest: string); virtual;
    procedure Merge; virtual;
    procedure Refresh; virtual;
    procedure Add(FileName: string); virtual;
    procedure Remove(FileName: string); virtual;
    procedure GetLog(FileName: string; Log: TLogItems); virtual;
    procedure GetStatus(FileName: string; Status: TFileStatuses); virtual;
    constructor Create;
    destructor Destroy; override;
    property RepositoryURL: string read FRepositoryURL write SetRepositoryURL;
    property Path: string read FPath write SetPath;
  end;

  { TRepository }

  TRepository = class
  protected
    procedure ExecuteProcess(Command: string; Parameters: array of string); virtual;
  public
    ExecutionOutput: TStringList;
    Path: string;
    SilentExecution: Boolean;
    procedure Init; virtual;
    constructor Create;
    destructor Destroy; override;
  end;

function URLFromDirectory(DirName: string; Relative: Boolean): string;

const
  FileStatusStateText: array[TFileStatusState] of string = ('Not versioned',
    'Added', 'Removed', 'Modified', 'Normal');


implementation

uses
  FormConsole;

function URLFromDirectory(DirName: string; Relative: Boolean): string;
begin
  Result := DirName;
  if Relative then Result := GetCurrentDir + DirectorySeparator + Result;
  Result := 'file:///' + StringReplace(Result, DirectorySeparator, '/', [rfReplaceAll]);
end;

{ TFileStatus }

procedure TFileStatus.Assign(Source: TFileStatus);
begin
  FileName := Source.FileName;
  Version := Source.Version;
  Time := Source.Time;
  Author := Source.Author;
  State := Source.State;
end;

{ TFileStatuses }

function TFileStatuses.SearchByName(Name: string): TFileStatus;
var
  I: Integer;
begin
  I := 0;
  while (I < Count) and (TFileStatus(Items[I]).FileName <> Name) do Inc(I);
  if I < Count then Result := TFileStatus(Items[I])
    else Result := nil;
end;

{ TRepository }

procedure TRepository.ExecuteProcess(Command: string;
  Parameters: array of string);
var
  FormConsole: TFormConsole;
begin
  FormConsole := TFormConsole.Create(nil);
  try
    FormConsole.Executable := Command;
    FormConsole.Parameters.Clear;
    FormConsole.Parameters.AddStrings(Parameters);
    if DirectoryExists(Path) then FormConsole.WorkingDir := Path
      else FormConsole.WorkingDir := '';
    if SilentExecution then FormConsole.Perform
      else FormConsole.ShowModal;
    ExecutionOutput.Assign(FormConsole.Log);
  finally
    FormConsole.Free;
  end;
end;

procedure TRepository.Init;
begin
end;

constructor TRepository.Create;
begin
  ExecutionOutput := TStringList.Create;
  Path := '';
end;

destructor TRepository.Destroy;
begin
  FreeAndNil(ExecutionOutput);
  inherited;
end;

{ TLogItem }

constructor TLogItem.Create;
begin
  Messages := TStringList.Create;
  ChangedFiles := TStringList.Create;
end;

destructor TLogItem.Destroy;
begin
  FreeAndNil(Messages);
  FreeAndNil(ChangedFiles);
  inherited;
end;

{ TWorkingCopy }

procedure TWorkingCopy.SetPath(AValue: string);
begin
  if FPath = AValue then Exit;
  FPath := AValue;
  Refresh;
end;

procedure TWorkingCopy.SetRepositoryURL(AValue: string);
begin
  if FRepositoryURL = AValue then Exit;
  FRepositoryURL := AValue;
end;

procedure TWorkingCopy.ExecuteProcess(Command: string; Parameters: array of string);
var
  FormConsole: TFormConsole;
begin
  FormConsole := TFormConsole.Create(nil);
  try
    FormConsole.Executable := Command;
    FormConsole.EnvironmentVariables.Assign(EnvVars);
    FormConsole.Parameters.Clear;
    FormConsole.Parameters.AddStrings(Parameters);
    if DirectoryExists(Path) then FormConsole.WorkingDir := Path
      else FormConsole.WorkingDir := '';
    if SilentExecution then FormConsole.Perform
      else FormConsole.ShowModal;
    ExecutionOutput.Assign(FormConsole.Log);
  finally
    FormConsole.Free;
  end;
end;

function TWorkingCopy.GetNext(var Text: string; Separator: string): string;
begin
  if Pos(Separator, Text) > 0 then begin
    Result := Copy(Text, 1, Pos(Separator, Text) - 1);
    Delete(Text, 1, Pos(Separator, Text) + Length(Separator));
  end else begin
    Result := Text;
    Text := '';
  end;
end;

procedure TWorkingCopy.Checkout;
begin
end;

procedure TWorkingCopy.Update;
begin
end;

procedure TWorkingCopy.CleanUp;
begin
end;

procedure TWorkingCopy.Commit(Message: string);
begin
end;

procedure TWorkingCopy.Move(Source, Dest: string);
begin
end;

procedure TWorkingCopy.Merge;
begin
end;

procedure TWorkingCopy.Refresh;
begin
end;

procedure TWorkingCopy.Add(FileName: string);
begin
end;

procedure TWorkingCopy.Remove(FileName: string);
begin
end;

procedure TWorkingCopy.GetLog(FileName: string; Log: TLogItems);
begin
  Log.Clear;
end;

procedure TWorkingCopy.GetStatus(FileName: string; Status: TFileStatuses);
begin
  Status.Clear;
end;

constructor TWorkingCopy.Create;
begin
  ExecutionOutput := TStringList.Create;
  EnvVars := TStringList.Create;
  FPath := '';
  FRepositoryURL := '';
end;

destructor TWorkingCopy.Destroy;
begin
  FreeAndNil(EnvVars);
  FreeAndNil(ExecutionOutput);
  inherited;
end;

end.