Changeset 13 for trunk/Units

Timestamp:

May 30, 2015, 1:02:36 PM (10 years ago)

Author:

chronos

Message:

• Added: New test form where general functionality of selected backend can be tested.
• Added: Basic git backend implementation.
• Added: Project group form and ability to open/save group of projects as configuration to XML file.

Location:

trunk/Units

Files:

• UBackend.pas (modified) (3 diffs)
• UProject.pas (modified) (7 diffs)
• UVCS.pas (modified) (8 diffs)

trunk/Units/UBackend.pas

@@ -10 +10 @@
 type
   TWorkingCopyClass = class of TWorkingCopy;
+  TRepositoryClass = class of TRepository;
 
   { TBackend }
@@ -15 +16 @@
   TBackend = class
     Name: string;
+    HomePage: string;
     WorkingCopyClass: TWorkingCopyClass;
+    RepositoryClass: TRepositoryClass;
+    function IsRepository(Directory: string): Boolean; virtual;
     function IsWorkingCopy(Directory: string): Boolean; virtual;
   end;
@@ -22 +26 @@
 
 { TBackend }
+
+function TBackend.IsRepository(Directory: string): Boolean;
+begin
+  Result := False;
+end;
 
 function TBackend.IsWorkingCopy(Directory: string): Boolean;

trunk/Units/UProject.pas

@@ -6 +6 @@
 
 uses
-  Classes, SysUtils, UVCS, UBackend;
+  Classes, SysUtils, UVCS, UBackend, Contnrs, DOM, XMLRead, XMLWrite, UXMLUtils,
+  FileUtil;
 
 type
@@ -22 +23 @@
   public
     WorkingCopy: TWorkingCopy;
+    Repository: TRepository;
     procedure Open(Directory: string);
     constructor Create;
     destructor Destroy; override;
+    procedure LoadXMLNOde(Node: TDOMNode);
+    procedure SaveXMLNOde(Node: TDOMNode);
     property Backend: TBackend read FBackend write SetBackend;
     property Directory: string read GetDirectory write SetDirectory;
@@ -30 +34 @@
   end;
 
+  { TProjects }
+
+  TProjects = class(TObjectList)
+    procedure LoadXMLNode(Node: TDOMNode);
+    procedure SaveXMLNode(Node: TDOMNode);
+  end;
+
+  { TProjectGroup }
+
+  TProjectGroup = class
+    FileName: string;
+    Projects: TProjects;
+    constructor Create;
+    destructor Destroy; override;
+    procedure LoadFromFile(FileName: string);
+    procedure SaveToFile(FileName: string);
+  end;
+
 
 implementation
 
-uses
-  USubversion;
+resourcestring
+  SWrongFileFormat = 'Wrong file format';
+
+{ TProjects }
+
+procedure TProjects.LoadXMLNode(Node: TDOMNode);
+var
+  NewProject: TProject;
+  Node2: TDOMNode;
+begin
+  Node2 := Node.FirstChild;
+  while Assigned(Node2) and (Node2.NodeName = 'Project') do begin
+    NewProject := TProject.Create;
+    NewProject.LoadXMLNode(Node2);
+    Add(NewProject);
+    Node2 := Node2.NextSibling;
+  end;
+end;
+
+procedure TProjects.SaveXMLNode(Node: TDOMNode);
+var
+  I: Integer;
+  NewNode: TDOMNode;
+begin
+  for I := 0 to Count - 1 do begin;
+    NewNode := Node.OwnerDocument.CreateElement('Project');
+    Node.AppendChild(NewNode);
+    TProject(Items[I]).SaveXMLNode(NewNode);
+  end;
+end;
+
+
+{ TProjectGroup }
+
+constructor TProjectGroup.Create;
+begin
+  Projects := TProjects.Create;
+end;
+
+destructor TProjectGroup.Destroy;
+begin
+  Projects.Free;
+  inherited Destroy;
+end;
+
+procedure TProjectGroup.LoadFromFile(FileName: string);
+var
+  Doc: TXMLDocument;
+  RootNode: TDOMNode;
+  Node: TDOMNode;
+  Node2: TDOMNode;
+begin
+  Self.FileName := FileName;
+  ReadXMLFile(Doc, UTF8Decode(FileName));
+  with Doc do try
+    if Doc.DocumentElement.NodeName <> 'ProjectGroup' then
+      raise Exception.Create(SWrongFileFormat);
+    RootNode := Doc.DocumentElement;
+    with RootNode do begin
+      Node := FindNode('Projects');
+      if Assigned(Node) then Projects.LoadXMLNode(Node);
+    end;
+  finally
+    Doc.Free;
+  end;
+end;
+
+procedure TProjectGroup.SaveToFile(FileName: string);
+var
+  NewNode: TDOMNode;
+  Doc: TXMLDocument;
+  RootNode: TDOMNode;
+begin
+  if FileName = '' then Exit;
+  Self.FileName := FileName;
+  Doc := TXMLDocument.Create;
+  with Doc do try
+    RootNode := CreateElement('ProjectGroup');
+    AppendChild(RootNode);
+    with RootNode do begin
+      NewNode := OwnerDocument.CreateElement('Projects');
+      AppendChild(NewNode);
+      Projects.SaveXMLNode(NewNode);
+    end;
+    ForceDirectoriesUTF8(ExtractFileDir(FileName));
+    WriteXMLFile(Doc, UTF8Decode(FileName));
+  finally
+    Doc.Free;
+  end;
+end;
 
 { TProject }
@@ -44 +154 @@
   FreeAndNil(WorkingCopy);
   WorkingCopy := AValue.WorkingCopyClass.Create;
+  FreeAndNil(Repository);
+  Repository := AValue.RepositoryClass.Create;
 end;
 
@@ -64 +176 @@
 begin
   WorkingCopy.RepositoryURL := AValue;
+  Repository.Path := AValue;
 end;
 
@@ -74 +187 @@
 begin
   WorkingCopy := TWorkingCopy.Create;
+  Repository := TRepository.Create;
 end;
 
@@ -79 +193 @@
 begin
   WorkingCopy.Free;
+  Repository.Free;
   inherited Destroy;
 end;
 
+procedure TProject.LoadXMLNOde(Node: TDOMNode);
+begin
+  RepositoryURL := ReadString(Node, 'RepositoryURL', '');
+  Directory := ReadString(Node, 'Directory', '');
+end;
+
+procedure TProject.SaveXMLNOde(Node: TDOMNode);
+begin
+  WriteString(Node, 'RepositoryURL', RepositoryURL);
+  WriteString(Node, 'Directory', Directory);
+end;
+
 end.
 

trunk/Units/UVCS.pas

@@ -36 +36 @@
     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;
     ExecutionOutput: TStringList;
     procedure Checkout; virtual;
@@ -48 +52 @@
     procedure Refresh; virtual;
     procedure Add(FileName: string); virtual;
+    procedure Remove(FileName: string); virtual;
     procedure GetLog(FileName: string; Log: TLogList); virtual;
     constructor Create;
@@ -55 +60 @@
   end;
 
+  { TRepository }
+
   TRepository = class
+  protected
+    procedure ExecuteProcess(Command: string; Parameters: array of string); virtual;
+  public
+    ExecutionOutput: TStringList;
     Path: string;
-  end;
-
-
+    procedure Init; virtual;
+    constructor Create;
+    destructor Destroy; override;
+  end;
+
+
+function URLFromDirectory(DirName: string; Relative: Boolean): string;
 
 implementation
@@ -66 +81 @@
   UFormConsole;
 
-{ TLogItem }
-
-constructor TLogItem.Create;
-begin
-  Messages := TStringList.Create;
-  ChangedFiles := TStringList.Create;
-end;
-
-destructor TLogItem.Destroy;
-begin
-  Messages.Free;
-  ChangedFiles.Free;
-  inherited Destroy;
-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);
+function URLFromDirectory(DirName: string; Relative: Boolean): string;
+begin
+  Result := DirName;
+  if Relative then Result := GetCurrentDirUTF8 + DirectorySeparator + Result;
+  Result := 'file:///' + StringReplace(Result, DirectorySeparator, '/', [rfReplaceAll]);
+end;
+
+{ TRepository }
+
+procedure TRepository.ExecuteProcess(Command: string;
+  Parameters: array of string);
 begin
   FormConsole.Executable := Command;
@@ -107 +102 @@
 end;
 
+procedure TRepository.Init;
+begin
+
+end;
+
+constructor TRepository.Create;
+begin
+  ExecutionOutput := TStringList.Create;
+  Path := '';
+end;
+
+destructor TRepository.Destroy;
+begin
+  FreeAndNil(ExecutionOutput);
+  inherited Destroy;
+end;
+
+{ TLogItem }
+
+constructor TLogItem.Create;
+begin
+  Messages := TStringList.Create;
+  ChangedFiles := TStringList.Create;
+end;
+
+destructor TLogItem.Destroy;
+begin
+  Messages.Free;
+  ChangedFiles.Free;
+  inherited Destroy;
+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);
+begin
+  FormConsole.Executable := Command;
+  FormConsole.EnvironmentVariables.Assign(EnvVars);
+  FormConsole.Parameters.Clear;
+  FormConsole.Parameters.AddStrings(Parameters);
+  if DirectoryExistsUTF8(Path) then FormConsole.WorkingDir := Path
+    else FormConsole.WorkingDir := '';
+  FormConsole.ShowModal;
+  ExecutionOutput.Assign(FormConsole.Log);
+end;
+
 function TWorkingCopy.GetNext(var Text: string; Separator: string): string;
 begin
@@ -158 +212 @@
 end;
 
+procedure TWorkingCopy.Remove(FileName: string);
+begin
+
+end;
+
 procedure TWorkingCopy.GetLog(FileName: string; Log: TLogList);
 begin
@@ -166 +225 @@
 begin
   ExecutionOutput := TStringList.Create;
+  EnvVars := TStringList.Create;
   FPath := '';
   FRepositoryURL := '';
@@ -172 +232 @@
 destructor TWorkingCopy.Destroy;
 begin
+  FreeAndNil(EnvVars);
   FreeAndNil(ExecutionOutput);
   inherited Destroy;