tprojectstatusunit.pas

CVS IDE plugin for Borland Delphi this is a good program,i like this kind of practise

(* $Id: TProjectStatusunit.pas,v 1.19 2002/12/30 21:39:56 turbo Exp $
 *
 * Determine CVS state of a file or files in the current project
 * Also contains TCvsEntries, a class for parsing CVS/Entries, and building
 * a collection with the information from that file
 *
 * Copyright 2001 by Thomas Bleier
 * For license details see LICENSE.txt
 *)

unit TProjectStatusunit;
{$I BORCVS.inc}
interface
uses
  Classes,
  Windows;
//---------------------------------------------------------------------------
type
  TCvsFileStatus = class(TObject)
  public
(* line: a line from a CVS\Entries file
 * directory: the directory for that entry, with trailing backslash
 *)
    Filename: string;
    Revision: string;
    Timestamp: SystemTime;
//    Timestamp: string;
    Conflict: string;
    Options: string;
    Tagdate: string;
    function IsValid: boolean;
    function GetNiceTagdateString: string;
    constructor create(line: string = ''; directory: string = '');
  end;
//---------------------------------------------------------------------------

type
  TCvsEntries = class(TObject)
  private
  protected
    FEntries: TStringList;
    function ReadStatus(directory: string; fRecurseSubdir: boolean): boolean;
    function FileChanged(const afile: TCvsFileStatus): boolean;
    function GetStatus(filename: string; var Status: TCvsFileStatus): boolean;
  public
    constructor create;
    destructor destroy; override;
    procedure Clear;
  end;

//---------------------------------------------------------------------------
  TProjectStatus = class
  private
  protected
    FEntries: TCvsEntries;
    FProjectFiles: TStringList;
  public
    constructor create;
    destructor destroy; override;
    procedure Clear;
    procedure ReadStatus(files: TStrings; fLowerCase: boolean = true); overload;
    procedure ReadStatus(directory: string; fRecurse: boolean = true); overload;
    function GetStatus(filename: string; var Status: TCvsFileStatus): boolean;
    function IsFileChanged(const afile: TCvsFileStatus): boolean;
    procedure GetFilesNotInCvs(files: TStrings);
    procedure GetFilesOnlyInCvs(files: TStrings);
    procedure GetCvsFiles(files: TStrings);
  end;
//---------------------------------------------------------------------------

implementation
uses
  sysutils,
  TToolsApiHelperunit,
  UtilityUnit,
  PELDebugit;
//---------------------------------------------------------------------------

procedure LineToStrings(const Fnutte: string; const divider: char; mStrings:
  TStrings);
var
  strg: string;
  i: integer;
begin
  strg := Fnutte;
  mStrings.BeginUpdate;
  mStrings.Clear;
  if (Length(strg) > 0) then
  begin
    i := Pos(divider, strg);
    while (i > 0) do
    begin
      mStrings.Add(copy(strg, 1, i - 1));
      Delete(strg, 1, i);
      i := Pos(divider, strg);
    end;
// Mysterious fix to remove trailing null char ( in some versions /Cases )
    mStrings.Add(strpas(pchar(strg)));
  end;
  mStrings.EndUpdate;
end;

function FileInfo(const FileName: string; var FindData: TWin32FindData):
  boolean;
var
  Handle: THandle;
begin
  Handle := FindFirstFile(PChar(FileName), FindData);
  if Handle <> INVALID_HANDLE_VALUE then
  begin
    Windows.FindClose(Handle);
    result := true;
  end
  else
  begin
    Fillchar(FindData, sizeof(FindData), #0);
    result := false;
  end;
end;

//---------------------------------------------------------------------------
// TCvsFileStatus
//---------------------------------------------------------------------------

constructor TCvsFileStatus.create(line: string; directory: string);
var
  ts: TstringList;
  i:integer;
begin
  try
    if (line <> '') then
    begin
      ts := TstringList.Create;
      try
        LineToStrings(line, '/', ts);
        case ts.count of
          6:
            begin
              Filename := directory + ts[1];
              Revision := ts[2];
              i:=pos('+', ts[3]);
              if  i > 0 then
              begin
                Conflict:= copy(ts[3],1,i-1);
                Timestamp :=CVSTimeToSystemTime(copy(ts[3],i+1,maxint));
              end
              else

              begin
                Timestamp := CVSTimeToSystemTime(ts[3]);
              end;
              Options := ts[4];
              Tagdate := ts[5];
            end;
        else
          begin
            DebugStrF('TCvsFileStatus.create(line: "%s" ; directory: "%s")',[line,directory]);
          end;
        end;
      finally
        ts.Free;
      end;
    end;
  except
    Filename := '';
  end;
end;
//---------------------------------------------------------------------------

function TCvsFileStatus.IsValid: boolean;
begin
  result := Filename <> '';
end;
//---------------------------------------------------------------------------

function TCvsFileStatus.GetNiceTagdateString: string;
begin
  result := copy(Tagdate, 2, maxint);
end;

{ TCvsEntries }

procedure TCvsEntries.Clear;
begin
  DebugStr('TCvsEntries.Clear');
  FEntries.Clear;
end;

constructor TCvsEntries.create;
begin
//  DebugStr('TCvsEntries.create');
  inherited create;
  FEntries := TStringList.Create;
end;

destructor TCvsEntries.destroy;
begin
  FEntries.Free;
  inherited;
end;

function TCvsEntries.FileChanged(const afile: TCvsFileStatus): boolean;
var
  FindData: TWin32FindData;
  DiskTime: SystemTime;
//  tempFileTime: FileTime;
//  tempDiskTime: SystemTime;
begin
  result := false;
  if (afile.IsValid()) then
  begin
    if FileInfo(afile.Filename, FindData) then
    begin
  { TODO  -oturbo -cBUG : must care for the DST Bug !
for the time beeing the compare routine disregards exactly 1 hour diff}
      FileTimeToSystemTime(FindData.ftLastWriteTime, DiskTime);
      result := not IsSameSystemTime(afile.Timestamp, DiskTime);
// debugging
//      LocalFileTimeToFileTime(FindData.ftLastWriteTime, tempFileTime);
//      FileTimeToSystemTime(tempFileTime, tempDiskTime);
//      DebugStrF('%s CVS: %s Disk: %s Test: %s ', [afile.Filename, SystemTimeString(afile.Timestamp), SystemTimeString(DiskTime), SystemTimeString(tempDiskTime)]);
    end;
  end;
end;

function TCvsEntries.GetStatus(filename: string; var Status: TCvsFileStatus):
  boolean;
var
  i: integer;
begin
  Result := false;
  i := FEntries.IndexOf(Filename);
  if i > -1 then
  begin
    Status := TCvsFileStatus(FEntries.Objects[i]);
    Result := true;
  end;
end;

function TCvsEntries.ReadStatus(directory: string;
  fRecurseSubdir: boolean): boolean;
var
  line, tmp,
    entriesfile: string;
//    rootfile: string;
  entries: TStringList;
  i, p, e: integer;
  ent: TCvsFileStatus;
begin
  // also process Entries.Log!!!

  result := false;
  directory := IncludeTrailingPathDelimiter(directory);
  entriesfile := directory + 'CVS\Entries';
//  rootfile := directory + 'CVS\root';
//  if (FileExists(rootfile)) then
//  begin
//    entries := TStringList.Create;
//    try
//      entries.LoadFromFile(rootfile);
//      if entries.Count = 1 then
//      begin
//        FCVSROOTS.Add(entries[0]);
//      end;
//    finally
//      entries.Free;
//    end;
//  end;
  if (FileExists(entriesfile)) then
  begin
    entries := TStringList.Create;
    try
      DebugStrF('TCvsEntries.ReadStatus(%s,fRecurseSubdir)', [entriesfile]);
      entries.LoadFromFile(entriesfile);
      for i := 0 to entries.Count - 1 do
      begin
        line := entries.Strings[i];
        if (line <> '') then
        begin
          case line[1] of
            'D':
              begin
                if (fRecurseSubdir) then
                begin
                  if (Length(line) > 3) and (line[2] = '/') then
                  begin
                    tmp := Copy(line, 3, MAXINT);
                    p := Pos('/', tmp);
                    if (p > 0) then
                    begin
                      ReadStatus(directory + Copy(tmp, 1, p - 1),
                        fRecurseSubdir);
                    end;
                  end;
                end;
              end;

            '/':
              begin
                ent := TCvsFileStatus.create(line, directory);
                if (ent.IsValid) then
                begin
                  e := FEntries.IndexOf(LowerCase(ent.Filename));
                  if e >= 0 then
                  begin
                    FEntries.Objects[e].Free;
                    FEntries.Objects[e] := ent;
                  end
                  else
                  begin
                    FEntries.AddObject(LowerCase(ent.Filename), ent);
                  end;
                end;
              end;
          end;
        end;
      end;
    finally
      entries.Free;
    end;
    result := true;
  end;
end;

{ TProjectStatus }

procedure TProjectStatus.Clear;
begin
//  DebugStr('TProjectStatus.Clear');
  FProjectFiles.Clear;
  FEntries.clear;
end;

constructor TProjectStatus.create;
begin
//  DebugStr('TProjectStatus.create');
  inherited create;
  FProjectFiles := TStringList.Create;
  FEntries := TCvsEntries.create;
end;

destructor TProjectStatus.destroy;
begin
  FEntries.Free;
  FProjectFiles.Free;
  inherited Destroy;
end;

procedure TProjectStatus.GetCvsFiles(files: TStrings);
var
  i: integer;
begin
  files.Clear;
  for i := 0 to FEntries.FEntries.Count - 1 do
  begin
    files.Add(FEntries.FEntries.Names[i]);
  end
end;

procedure TProjectStatus.GetFilesNotInCvs(files: TStrings);
var
  i: integer;
  afile: string;
  Status: TCvsFileStatus;
begin
  files.Clear;
  for i := 0 to FProjectFiles.Count - 1 do
  begin
    afile := FProjectFiles.Strings[i];
    if not GetStatus(afile, Status) then
    begin
      files.Add(afile);
    end;
  end;
end;

procedure TProjectStatus.GetFilesOnlyInCvs(files: TStrings);
var
  i: integer;
  afile: string;
begin
  files.Clear;
  for i := 0 to FEntries.FEntries.Count - 1 do
  begin
    afile := FEntries.FEntries.Names[i];
    if (FProjectFiles.IndexOf(afile) < 0) then
      files.Add(afile);
  end;
end;

function TProjectStatus.GetStatus(filename: string; var Status: TCvsFileStatus):
  boolean;
begin
  result := FEntries.GetStatus(LowerCase(filename), Status);
end;

function TProjectStatus.IsFileChanged(
  const afile: TCvsFileStatus): boolean;
//var
//  i:integer;
begin
  result := FEntries.FileChanged(afile);
//  FEntries.FEntries.IndexOf(afile.Filename)
//  FEntries.FileChanged()
//  return FEntries.FileChanged(afile);
//end;
//  if result then
//  begin
//    DebugStrF('TProjectStatus.IsFileChanged(%s)=%s',[afile.Filename,BoolString(result)]);
//  end;
end;

procedure TProjectStatus.ReadStatus(files: TStrings; fLowerCase: boolean);
var
  directories: TStringList;
  i, count: integer;
  dir, filename: string;
begin
  directories := TStringList.Create;
  try
    FProjectFiles.Clear;
    count := files.Count;
    for i := 0 to count - 1 do
    begin
      filename := files.Strings[i];
      if (fLowerCase) then
      begin
        FProjectFiles.Add(LowerCase(filename));
      end
      else
      begin
        FProjectFiles.Add(filename);
      end;
      dir := LowerCase(ExtractFilePath(filename));
      if (directories.IndexOf(dir) < 0) then
      begin
        directories.Add(dir);
        FEntries.ReadStatus(dir, false);
      end;
    end;
  finally
    directories.Free;
  end;
end;

procedure TProjectStatus.ReadStatus(directory: string; fRecurse: boolean);
begin
  FEntries.ReadStatus(directory, fRecurse);
end;

end.