(****************************************************************************
 * WANT - A build management tool.                                          *
 * Copyright (c) 2001-2003 Juancarlo Anez, Caracas, Venezuela.              *
 * All rights reserved.                                                     *
 *                                                                          *
 * This library is free software; you can redistribute it and/or            *
 * modify it under the terms of the GNU Lesser General Public               *
 * License as published by the Free Software Foundation; either             *
 * version 2.1 of the License, or (at your option) any later version.       *
 *                                                                          *
 * This library 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        *
 * Lesser General Public License for more details.                          *
 *                                                                          *
 * You should have received a copy of the GNU Lesser General Public         *
 * License along with this library; if not, write to the Free Software      *
 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA *
 ****************************************************************************)
{
    @brief Cvs tasks

    @author Juancarlo Aņez
    @author Radim Novotny <radimnov@seznam.cz>
    @author Bob Arnson <sf@bobs.org>
}

{ Notes:
    Code idea (and fragments) are taken from Ant java classes

    Cvs             attributes "error" and "append" are not implemented.
                    attributes "passfile" and "port" are not implemented too,
                    because CVSNT does not use these environment variables
                    (http://ant.apache.org/manual/CoreTasks/cvs.html)
    CvsTagDiff      attribute  "rootdir" is not implemented
                    (http://ant.apache.org/manual/CoreTasks/cvstagdiff.html)
    CvsPass         Added property emptypassword for login to CVS servers without
                    password specified (for example sourceforge CVS).
                    Only acceptable value for "emptypassword" is "true".
                    if CVSNT is used, default password file is not regular
                    file, but passwords are stored in Windows registry key
                    HKEY_CURRENT_USER/Software/Cvsnt/cvspass
                    This task (on MsWindows) is trying to write password to
                    registry and when it fails, then write password
                    to $HOME/.cvspass
                    On Linux it tries only $HOME/.cvspass
                    (http://ant.apache.org/manual/CoreTasks/cvspass.html)
    CvsChangeLog    Added two properties - dateformat and timeformat
                    These properties are used to format date or time written
                    into changelog (XML file). Default: yyyy-mm-dd and hh:mm
                    Format string is compatible with Delphi date-time format
                    string (see "Date-Time values, formatting" in Delphi help)
                    (http://ant.apache.org/manual/CoreTasks/changelog.html)

    DELPHI 5 COMPATIBILITY NOTE -----
    Note that because Delphi 5 lacks a AnsiToUtf8, characters that would be
    translated to UTF-8 will be output as-is. Anyone care to contribute a
    Delphi 5-compatible AnsiToUtf8? --Bob Arnson
}

unit CVSTasks;

interface

{$IFDEF VER130}
{$DEFINE MSWINDOWS}
{$ENDIF VER130}

uses
  SysUtils,
  Classes,
{$IFNDEF VER130}
  DateUtils,
{$ENDIF VER130}

  {$IFDEF MSWINDOWS}
  JclRegistry,
  Windows,
  {$ENDIF}
  JclSysInfo,
  JclFileUtils,

  XPerlRE,

  WildPaths,
  ExecTasks,
  WantClasses,
  IniFiles, {Hashed stringlist}
  Contnrs;  {TObjectList}

type
  {$IFDEF MSWINDOWS}
  THashedStringList = TStringList;
  {$ENDIF}

  // used in CvsChangelog
  TRCSFile = class
  private
    FFile         :string;
    FRevision     :string;
    FPrevRevision :string;
  public
    constructor Create(AName, ARevision: string);                overload;
    constructor Create(AName, ARevision, APrevRevision: string); overload;

    property FileName     :string  read FFile         write FFile;
    property Revision     :string  read FRevision     write FRevision;
    property PrevRevision :string  read FPrevRevision write FPrevRevision;
  end;

  // used in CvsChangelog
  TCvsEntry = class
  private
    FDate     :TDateTime;
    FAuthor   :string;
    FComment  :string;
    FFiles    :TObjectList;
  public
    constructor Create(ADate: TDateTime; AAuthor, AComment: string);
    destructor  Destroy; override;

    procedure AddFile(AFile, ARevision: string);                    overload;
    procedure AddFile(AFile, ARevision, APreviousRevision: string); overload;
    
    function  OutAsXML(ADateFormat, ATimeFormat: string): string;
  end;

  // used in CvsTagDiff
  TCvsTagEntry = class
  private
    FFileName     :string;
    FPrevRevision :string;
    FRevision     :string;
  public
    constructor Create(AFileName: string);                           overload;
    constructor Create(AFileName, ARevision: string);                overload;
    constructor Create(AFileName, ARevision, APrevRevision: string); overload;

    function ToString : string;

    property FileName      :string read FFileName      write FFileName;
    property PrevRevision  :string read FPrevRevision  write FPrevRevision;
    property Revision      :string read FRevision      write FRevision;
  end;

  // used in CvsChangelog
  TCvsChangeLogParser = class
  private
    FFile              :string;
    FDate              :string;
    FAuthor            :string;
    FComment           :string;
    FRevision          :string;
    FPreviousRevision  :string;

    FEntries :THashedStringList;
    FStatus  :integer;

    procedure ProcessComment(ALine: string);
    procedure ProcessFile(ALine: string);
    procedure ProcessDate(ALine: string);
    procedure ProcessGetPreviousRevision(ALine: string);
    procedure ProcessRevision(ALine: string);
    procedure SaveEntry;
    procedure Reset;
  public
    constructor Create;
    destructor  Destroy; override;

    procedure ProcessInputFile(AFile: string);

    class function  Parse(AInputFile: string): THashedStringList;
    class procedure OutputEntriesToXML(AOutputFile: string;
      AEntries: THashedStringList; ADateFormat, ATimeFormat: string);
  end;


  // used in CvsChangelog
  TCvsChangeLogUserElement = class(TScriptElement)
  protected
    FUserId       :string;
    FDisplayName  :string;
  published
    property userid      :string read FUserID      write FUserID;
    property displayname :string read FDisplayName write FDisplayName;
  public
    procedure Init;                 override;
    class function TagName: string; override;
  end;

  // Custom CVS Task - base class for other Cvs Tasks
  TCustomCVSTask = class(TCustomExecTask)
  protected
    FCompression      :boolean;
    FCompressionLevel :integer;
    FTag              :string;
    FCvsRoot          :string;
    FAlias: string;
    FCvsRsh           :string;
    FDate             :string;
    FPackage          :string;
    FCommand          :string;
    FDest             :string;
    FNoexec           :boolean;
    FQuiet            :boolean;

    function AddOption(AOption: string; AValue: string = '';
      AForceQuote: boolean = False): string;
    function BuildArguments: string; override;

    function BuildArgumentsGlobal   :string; virtual;
    function BuildArgumentsCommand  :string; virtual; abstract;
    function BuildArgumentsSpecific :string; virtual;
  public
    procedure Init; override;
  protected
    property command          :string  read FCommand          write FCommand;
    property compression      :boolean read FCompression      write FCompression;
    property compressionlevel :integer read FCompressionLevel write FCompressionLevel;
    property cvsroot          :string  read FCvsRoot          write FCvsRoot;
    property cvsrsh           :string  read FCvsRsh           write FCvsRsh;
    property dest             :string  read FDest             write FDest;
    property alias            :string  read FAlias            write FAlias;
    property package          :string  read FPackage          write FPackage;
    property tag              :string  read FTag              write FTag;
    property date             :string  read FDate             write FDate;
    property quiet            :boolean read FQuiet            write FQuiet;
    property noexec           :boolean read FNoexec           write FNoexec;
    property output;
    property failonerror;
  end;

  // this class is used internally to log most recent module tag
  // it is not globally visible Task (not registered task)
  TCvsMostRecentTag = class(TCustomCvsTask)
  private
    FMostRecentTag  :string;
    FModuleName     :string;
  protected
    function BuildArgumentsCommand  :string; override;
    function BuildArgumentsSpecific :string; override;
  public
    procedure Execute; override;

    property modulename    :string read FModuleName     write FModuleName;
    property mostrecenttag :string read FMostRecentTag;
  end;

  TCvsTask = class(TCustomCvsTask)
  public
    procedure Execute; override;
    function  BuildArgumentsCommand: string; override;
  published
    property alias;
    property command;
    property compression;
    property compressionlevel;
    property cvsroot;
    property cvsrsh;
    property dest;
    property package;
    property tag;
    property date;
    property quiet;
    property noexec;
    property output;
    property failonerror;
  end;

  TCvsTagDiffTask = class(TCustomCvsTask)
  private
    FStartTag             :string;
    FStartDate            :string;
    FEndTag               :string;
    FEndDate              :string;
    FDestFile             :string;
    FMostRecentModuleName :string;

    function  CopyToEnd(AString: string; AFrom: integer): string;
    function  ParseRDiffOutput(AOutput: string;
       var AParsedOutput: TObjectList): boolean;
    procedure WriteTagDiff (const AParsedOutput: TObjectList);
    function  WriteTagEntry(const AEntry: TCvsTagEntry): string;
    function  FindMostRecentTag: string;
  public
    procedure Execute; override;
    procedure Init;    override;
  protected
    function  BuildArgumentsCommand  :string; override;
    function  BuildArgumentsSpecific :string; override;
  published
    property compression;
    property compressionlevel;
    property cvsroot;
    property cvsrsh;
    property package;
    property quiet;
    property failonerror;

    property starttag  :string read FStartTag  write FStartTag;
    property startdate :string read FStartDate write FStartDate;
    property endtag    :string read FEndTag    write FEndTag;
    property enddate   :string read FEndDate   write FEndDate;
    property destfile  :string read FDestFile  write FDestFile;
    {
      this property is required only when starttag or endtag contains
      text "MOST RECENT", because of I don't know how to find most recent tag
      across all modules. This shoul be set to module (filename) which is
      in repository from project start (for example DPR file)
    }
    property mostrecentmodulename: string read fMostRecentModuleName
                                          write fMostRecentModuleName;
  end;

  TCvsPassTask = class(TCustomCvsTask)
  private
    FPassword      :string;
    FEmptyPassword :boolean;

    procedure ChangeCvsPassInHome;
    function  ScrambleCvsPassword(const APassword: string): string;
    procedure WritePasswordTo(aFileName: string);
    {$IFDEF MSWINDOWS}
    procedure ChangeCvsPassInRegistry;
    {$ENDIF MSWINDOWS}
  public
    procedure Init;    override;
    procedure Execute; override;
  published
    property cvsroot;
    property password      :string  read FPassword      write FPassword;
    property emptypassword :boolean read FEmptyPassword write FEmptyPassword;
  end;

  TCvsChangeLogTask = class(TCustomCvsTask)
  private
    FUserList   :TList;
    FStart      :string;
    FUsersFile  :string;
    FDaysInPast :string;
    FDir        :string;
    FDestFile   :string;
    FEnd        :string;
    FDateFormat :string;
    FTimeFormat :string;
  public
    constructor Create(AOwner: TScriptElement); override;
    destructor  Destroy;                        override;

    procedure Init;    override;
    procedure Execute; override;
    function  CreateUser(AUserID, ADisplayName: string): TCvsChangeLogUserElement;
      overload;
  protected
    function  BuildArgumentsCommand  :string; override;
    function  BuildArgumentsSpecific :string; override;
  published
    function CreateUser: TCvsChangeLogUserElement; overload;

    property dest       :string read FDest       write FDest;
    property dir        :string read FDir        write FDir;
    property destfile   :string read FDestFile   write FDestFile;
    property usersfile  :string read FUsersFile  write FUsersFile;
    property daysinpast :string read FDaysInPast write FDaysInPast;
    property start      :string read FStart      write FStart;
    property _end       :string read FEnd        write FEnd;
    // following properties are not included in Ant
    property dateformat :string read FDateFormat write FDateFormat;
    property timeformat :string read FTimeFormat write FTimeFormat;
  end;


implementation

const
  FILE_IS_NEW = ' is new; current revision ';
  FILE_HAS_CHANGED = ' changed from revision ';
  FILE_WAS_REMOVED = ' is removed';
  GET_FILE = 1;
  GET_DATE = 2;
  GET_COMMENT = 3;
  GET_REVISION = 4;
  GET_PREVIOUS_REV = 5;

var
  // for scramble cvs password
  PSW_SHIFTS: array [0..255] of byte =
   ( 0,   1,   2,   3,   4,   5,   6,   7,   8,   9,  10,  11,  12,  13,  14,  15,
    16,  17,  18,  19,  20,  21,  22,  23,  24,  25,  26,  27,  28,  29,  30,  31,
   114, 120,  53,  79,  96, 109,  72, 108,  70,  64,  76,  67, 116,  74,  68,  87,
   111,  52,  75, 119,  49,  34,  82,  81,  95,  65, 112,  86, 118, 110, 122, 105,
    41,  57,  83,  43,  46, 102,  40,  89,  38, 103,  45,  50,  42, 123,  91,  35,
   125,  55,  54,  66, 124, 126,  59,  47,  92,  71, 115,  78,  88, 107, 106,  56,
    36, 121, 117, 104, 101, 100,  69,  73,  99,  63,  94,  93,  39,  37,  61,  48,
    58, 113,  32,  90,  44,  98,  60,  51,  33,  97,  62,  77,  84,  80,  85, 223,
   225, 216, 187, 166, 229, 189, 222, 188, 141, 249, 148, 200, 184, 136, 248, 190,
   199, 170, 181, 204, 138, 232, 218, 183, 255, 234, 220, 247, 213, 203, 226, 193,
   174, 172, 228, 252, 217, 201, 131, 230, 197, 211, 145, 238, 161, 179, 160, 212,
   207, 221, 254, 173, 202, 146, 224, 151, 140, 196, 205, 130, 135, 133, 143, 246,
   192, 159, 244, 239, 185, 168, 215, 144, 139, 165, 180, 157, 147, 186, 214, 176,
   227, 231, 219, 169, 175, 156, 206, 198, 129, 164, 150, 210, 154, 177, 134, 127,
   182, 128, 158, 208, 162, 132, 167, 209, 149, 241, 153, 251, 237, 236, 171, 195,
   243, 233, 253, 240, 194, 250, 191, 155, 142, 137, 245, 235, 163, 242, 178, 152
   );

{$IFDEF VER130}
//
// utility functions that exist in Delphi 6 and later but not in Delphi 5
//

function FileIsReadOnly(const AFileName: string): boolean;
begin
  Result := FileGetAttr(AFileName) and faReadOnly > 0;
end;

function AnsiToUtf8(const AString: string): string;
begin
  Result := AString;
end;
{$ENDIF VER130}

  { Local function }
function ParseCVSDate(ADate: string): TDateTime;
var
  bConverted: boolean;
  bMonth: word;
begin
  Result := Now;
  // try to create TDateTime from string date in different format
  // Supported formats:
  // format used in system by current locale
  // [d]d.mm.yyyy            (24.9.2001)
  // yyyy-[m]m-[d]d [h]h:[m]m:[s]s   (2001-09-24 10:15:45)
  // yyyy/[m]m/[d]d [h]h:[m]m:[s]s   (2001/09/24 10:15:45)
  // yyyy-[m]m-[d]d            (2001-09-24)
  // yyyy/[m]m/[d]d            (2001/09/24)
  // [d]d MMM yyyy           (24 Sep 2001)

  bConverted := False;
  try { current Locale settings }
    Result     := StrToDate(ADate);
    bConverted := True;
  except
  end;

  if not bConverted then
  begin { dd.mm.yyyy }
    try
      if regex.Match('(\d?\d)\.(\d?\d)\.(\d\d\d\d)', ADate) then
      begin
        Result := EncodeDate(
                      StrToInt(regex.SubExp[3].Text),   {year}
                      StrToInt(regex.SubExp[2].Text),   {month}
                      StrToInt(regex.SubExp[1].Text));  {day}
        bConverted := True;
      end;
    except
    end;
  end;

  if not bConverted then
  begin { yyyy/mm/dd hh:mm:ss } { yyyy-mm-dd hh:mm:ss }
    try
      if regex.Match('(\d\d\d\d)[/-](\d?\d)[/-](\d?\d) (\d?\d):(\d?\d):(\d?\d)', ADate) then
      begin
        Result := EncodeDate(
                    StrToInt(regex.SubExp[1].Text),   {year}
                    StrToInt(regex.SubExp[2].Text),   {month}
                    StrToInt(regex.SubExp[3].Text));  {day}
        Result := Result + EncodeTime(
                    StrToInt(regex.SubExp[4].Text),   {hour}
                    StrToInt(regex.SubExp[5].Text),   {min}
                    StrToInt(regex.SubExp[6].Text),   {sec}
                    0);                               {msec}
        bConverted := True;
      end;
    except
    end;
  end;

  if not bConverted then
  begin { yyyy-mm-dd } { yyyy/mm/dd }
    try
      if regex.Match('(\d\d\d\d)[/-](\d?\d)[/-](\d?\d)', ADate) then
      begin
        Result := EncodeDate(
                    StrToInt(regex.SubExp[1].Text),  {year}
                    StrToInt(regex.SubExp[2].Text),  {month}
                    StrToInt(regex.SubExp[3].Text)); {day}
        bConverted := True;
      end;
    except
    end;
  end;

  if not bConverted then
  begin { dd MMM yyyy}
    try
      if regex.Match('(\d?\d) ([A-Z][a-z][a-z]) (\d\d\d\d)', ADate) then
      begin
        bMonth := 0;
        if regex.SubExp[2].Text = 'Jan' then bMonth := 1;
        if regex.SubExp[2].Text = 'Feb' then bMonth := 2;
        if regex.SubExp[2].Text = 'Mar' then bMonth := 3;
        if regex.SubExp[2].Text = 'Apr' then bMonth := 4;
        if regex.SubExp[2].Text = 'May' then bMonth := 5;
        if regex.SubExp[2].Text = 'Jun' then bMonth := 6;
        if regex.SubExp[2].Text = 'Jul' then bMonth := 7;
        if regex.SubExp[2].Text = 'Aug' then bMonth := 8;
        if regex.SubExp[2].Text = 'Sep' then bMonth := 9;
        if regex.SubExp[2].Text = 'Oct' then bMonth := 10;
        if regex.SubExp[2].Text = 'Nov' then bMonth := 11;
        if regex.SubExp[2].Text = 'Dec' then bMonth := 12;
        if bMonth <> 0 then
        begin
          Result := EncodeDate(
                       StrToInt(regex.SubExp[3].Text),   {year}
                       bMonth,                           {month}
                       StrToInt(regex.SubExp[1].Text));  {day}
          bConverted := True;
        end;
      end;
    except
    end;
  end;
  if not bConverted then Result := Now;
end;

{ TCustomCvsTask }

function TCustomCvsTask.AddOption(AOption, AValue: string; AForceQuote: boolean): string;
begin
  Result := ' ' + AOption;
  if AValue <> '' then
  begin
    if (Pos(' ', AValue) > 0) or AForceQuote
       then Result := Result + '"' + AValue + '"'
       else Result := Result + AValue;
  end;
end;

function TCustomCvsTask.BuildArguments: string;
begin
  BuildArgumentsGlobal;
  BuildArgumentsCommand;
  BuildArgumentsSpecific;

  Result := inherited BuildArguments;
end;

function TCustomCVSTask.BuildArgumentsGlobal: string;
begin
  // first add global CVS options
  if FQuiet then
  begin
    Log(vlVerbose, 'quiet=true');
    ArgumentList.Add('-q');
  end;
  if FNoexec then
  begin
    Log(vlVerbose, 'noexec=true');
    ArgumentList.Add('-n');
  end;
  if FCompression then
  begin
    if HasAttribute('compressionlevel') then
    begin
      if FCompressionLevel in [1..9] then
      begin
        Log(vlVerbose, 'compression=true');
        Log(vlVerbose, 'compressionlevel=' + IntToStr(FCompressionLevel));
        ArgumentList.Add(AddOption('-z', IntToStr(FCompressionLevel)));
      end
      else
      begin
        Log(vlWarnings, 'Invalid compressionlevel value (not in range 1-9): '
                        + IntToStr(FCompressionLevel));
      end;
    end
    else
    begin
      Log(vlVerbose, 'compression=true');
      ArgumentList.Add(AddOption('-z', '3'));
    end;
  end;
  if FCvsRoot <> '' then
  begin
    Log(vlVerbose, 'CVSROOT=' + FCvsRoot);
    ArgumentList.Add(AddOption('-d', FCvsRoot));
  end;
  if FCvsRsh <> '' then
  begin
    Log(vlVerbose, 'CVS_RSH=' + FCvsRsh);
    JclSysInfo.SetEnvironmentVar('CVS_RSH', FCvsRsh);
  end;
end;

function TCustomCVSTask.BuildArgumentsSpecific: string;
begin
  if FTag <> '' then
  begin
    Log(vlVerbose, 'tag=' + FTag);
    ArgumentList.Add(AddOption('-r', FTag, True));
  end;
  if fdate <> '' then
  begin
    Log(vlVerbose, 'date=' + FDate);
    ArgumentList.Add(AddOption('-D', FDate, True));
  end;
  if FPackage <> '' then
  begin
    Log(vlVerbose, 'package=' + FPackage);
    ArgumentList.Add(AddOption(FPackage));
  end;
end;

procedure TCustomCvsTask.Init;
begin
  {$IFDEF LINUX}
  Executable := 'cvs';
  {$ELSE}
  Executable := 'cvs.exe';
  {$ENDIF}
  inherited;
end;

{ TCvsTask }

function TCvsTask.BuildArgumentsCommand: string;
begin
  if FCommand <> '' then
  begin
    Log(vlVerbose, 'command=' + FCommand);
    ArgumentList.Add(AddOption(FCommand));
  end
  else
  begin
    Log(vlVerbose, 'command=checkout');
    ArgumentList.Add(AddOption('checkout'));
  end;
  if FAlias <> '' then
  begin
    Log(vlVerbose, 'alias=' + FAlias);
    ArgumentList.Add(AddOption('-d',FAlias));
  end;
end;

procedure TCvsTask.Execute;
var
  bOldDir: TPath;
begin
  bOldDir := CurrentDir;
  if FDest <> '' then
  begin
    ChangeDir(FDest, True);
  end;
  inherited;
  ChangeDir(bOldDir);
end;

{ TCvsTagDiffTask }

function TCvsTagDiffTask.BuildArgumentsCommand: string;
begin
  Log(vlVerbose, 'command=rdiff');
  ArgumentList.Add(AddOption('rdiff'));
end;

function TCvsTagDiffTask.BuildArgumentsSpecific: string;
begin
  ArgumentList.Add(AddOption('-s')); // short listing
  if FStartTag <> '' then
  begin
    if FStartTag = 'MOST RECENT' then
    begin
      Log(vlVerbose, 'trying to find most recent tag');
      FStartTag := FindMostRecentTag;
    end;
    Log(vlVerbose, 'starttag=' + FStartTag);
    ArgumentList.Add(AddOption('-r', FStartTag, True));
  end
  else if FStartDate <> '' then
  begin
    Log(vlVerbose, 'startdate=' + FStartDate);
    ArgumentList.Add(AddOption('-D', FStartDate, True));
  end;
  if FEndTag <> '' then
  begin
    if FEndTag = 'MOST RECENT' then
    begin
      Log(vlVerbose, 'trying to find most recent tag');
      FEndTag := FindMostRecentTag;
    end;
    Log(vlVerbose, 'endtag=' + FEndTag);
    ArgumentList.Add(AddOption('-r', FEndTag, True));
  end
  else if fendDate <> '' then
  begin
    Log(vlVerbose, 'enddate=' + FEndDate);
    ArgumentList.Add(AddOption('-D', FEndDate, True));
  end;
  inherited BuildArgumentsSpecific;
end;

function TCvsTagDiffTask.CopyToEnd(AString: string;
  AFrom: integer): string;
begin
  Result := Copy(AString, AFrom, Length(AString));
end;

procedure TCvsTagDiffTask.Execute;
var
  bRDiffOutput: TObjectList;
begin
  output := FileGetTempName('cvs');
  inherited;
  bRDiffOutput := TObjectList.Create;
  try
    if ParseRDiffOutput(output, bRDiffOutput) then WriteTagDiff(bRDiffOutput);
  finally
    SysUtils.DeleteFile(output);
    bRDiffOutput.Free;
  end;
end;

function TCvsTagDiffTask.FindMostRecentTag: string;
var
  bMRT: TCvsMostRecentTag;
begin
  bMRT := TCvsMostRecentTag.Create(self);
  try
    bMRT.Init;
    // copy attribute values from CvsTagDiffTask
    bMRT.compression      := FCompression;
    bMRT.compressionlevel := FCompressionlevel;
    bMRT.cvsroot          := FCvsRoot;
    bMRT.cvsrsh           := FCvsRsh;
    bMRT.package          := FPackage;
    bMRT.quiet            := FQuiet;
    bMRT.failonerror      := FFailOnError;
    bMRT.modulename       := FMostRecentModuleName;

    bMRT.Execute;
    Result := bMRT.mostrecenttag;
  finally
    bMRT.Free;
  end;
end;

procedure TCvsTagDiffTask.Init;
begin
  inherited;
  RequireAttribute('destfile');
  RequireAttribute('package');
  RequireAttribute('starttag|startdate');
  RequireAttribute('endtag|enddate');
  if (FStartTag = 'MOST RECENT') or (FEndtag = 'MOST RECENT') then
     RequireAttribute('mostrecentmodulename');
end;

function TCvsTagDiffTask.ParseRDiffOutput(AOutput: string;
  var AParsedOutput: TObjectList): boolean;
var
  i             : integer;
  bIndex        : integer;
  bNewIndex     : integer;
  bHeaderLength : integer;
  bRevSeparator : integer;
  bSL           : TStringList;
  bRevision     : string;
  bPrevRevision : string;
  bLine         : string;
  bFileName     : string;
begin
  Result := False;
  if Assigned(AParsedOutput) then
  begin
    bHeaderLength := 5 + Length(FPackage) + 2;
    bSL := TStringList.Create;
    try
      bSL.LoadFromFile(AOutput);
      for i := 0 to bSL.Count - 1 do
      begin
        bLine := CopyToEnd(bSL[i], bHeaderLength);
        bIndex := Pos(FILE_IS_NEW, bLine);
        if bIndex <> 0 then
        begin
          // it is a new file
          bFileName := Copy(bLine, 1, bIndex - 1);
          bRevision := CopyToEnd(bLine, bIndex + Length(FILE_IS_NEW));
          bNewIndex := AParsedOutput.Add(TCvsTagEntry.Create(bFileName, bRevision));
          Log(vlVerbose, TCvsTagEntry(AParsedOutput[bNewIndex]).ToString);
        end
        else
        begin
          bIndex := Pos(FILE_HAS_CHANGED, bLine);
          if bIndex <> 0 then
          begin
            // it is modified file
            bFileName := Copy(bLine, 1, bIndex - 1);
            bRevSeparator := Pos(' to ', bLine);
            bPrevRevision := Copy(bLine, bIndex + Length(FILE_HAS_CHANGED),
                                  bRevSeparator - (bIndex +Length(FILE_HAS_CHANGED)));
            // 4 is " to " length
            bRevision := CopyToEnd(bLine, bRevSeparator + 4);
            bNewIndex := AParsedOutput.Add(TCvsTagEntry.Create(bFileName,
                                                               bRevision,
                                                               bPrevRevision));
            Log(vlVerbose, TCvsTagEntry(AParsedOutput[bNewIndex]).ToString);
          end
          else
          begin
            bIndex := Pos(FILE_WAS_REMOVED, bLine);
            if bIndex <> 0 then
            begin
              // it is a removed file
              bFileName := Copy(bLine, 1, bIndex - 1);
              bNewIndex  := AParsedOutput.Add(TCvsTagEntry.Create(bFileName));
              Log(vlVerbose, TCvsTagEntry(AParsedOutput[bNewIndex]).ToString);
            end;
          end;
        end;
      end;
      Result := True;
    finally
      bSL.Free;
    end;
  end;
end;

procedure TCvsTagDiffTask.WriteTagDiff(const AParsedOutput: TObjectList);
var
  bFS :TFileStream;
  i   :integer;

  procedure StreamWriteString(const AString: string);
  var
    s: string;
  begin
    s := AnsiToUtf8(AString);
    bFS.WriteBuffer(s[1], Length(s));
  end;
begin
  bFS := TFileStream.Create(FDestfile, fmCreate);
  try
    StreamWriteString('<?xml version="1.0" encoding="UTF-8"?>'#13#10);
    StreamWriteString('<tagdiff ');
    if FStartTag <> '' then StreamWriteString('starttag="' + FStartTag + '" ')
    else
      StreamWriteString('startdate="' + FStartDate + '" ');
    if FEndTag <> '' then StreamWriteString('endtag="' + FEndTag + '" ')
    else
      StreamWriteString('enddate="' + FEndDate + '" ');
    StreamWriteString('>'#13#10);
    for i := 0 to AParsedOutput.Count - 1 do
    begin
      StreamWriteString(WriteTagEntry(TCvsTagEntry(AParsedOutput[i])));
    end;
    StreamWriteString('</tagdiff>'#13#10);
  finally
    bFS.Free;
  end;
end;

function TCvsTagDiffTask.WriteTagEntry(const AEntry: TCvsTagEntry): string;
begin
  Result := #9'<entry>'#13#10;
  Result := Result + #9#9'<file>'#13#10;
  Result := Result + #9#9#9'<name>' + AEntry.FileName + '</name>'#13#10;
  if AEntry.Revision <> '' then
    Result := Result + #9#9#9'<revision>' + AEntry.Revision + '</revision>'#13#10;
  if AEntry.PrevRevision <> '' then
    Result := Result + #9#9#9'<prevrevision>' + AEntry.PrevRevision
                     + '</prevrevision>'#13#10;
  Result := Result + #9#9'</file>'#13#10;
  Result := Result + #9'</entry>'#13#10;
end;

{ TCvsTagEntry }

constructor TCvsTagEntry.Create(AFileName: string);
begin
  FFileName     := AFileName;
  FPrevRevision := '';
  FRevision     := '';
end;

constructor TCvsTagEntry.Create(AFileName, ARevision: string);
begin
  FFileName     := AFileName;
  FRevision     := ARevision;
  FPrevRevision := '';
end;

constructor TCvsTagEntry.Create(AFileName, ARevision, APrevRevision: string);
begin
  FFileName     := AFileName;
  FPrevRevision := APrevRevision;
  FRevision     := ARevision;
end;

function TCvsTagEntry.ToString: string;
begin
  Result := '';
  Result := Result + FFileName;
  if (FRevision = '') and (FPrevRevision = '') 
         then Result := Result + ' was removed'
  else if (FRevision <> '') and (FPrevRevision = '')
         then Result := Result + ' is new; current revision is ' + FRevision
  else if (FRevision <> '') and (FPrevRevision <> '')
         then Result := Result + ' has changed from ' + FPrevRevision + ' to ' + FRevision;
end;

{ TCvsPassTask }

// used in both, MsWindows and Linux
procedure TCvsPassTask.ChangeCvsPassInHome;
var
  bHomeDir: string;
begin
  if JclSysInfo.GetEnvironmentVar('HOME', bHomeDir, True) then
    WritePasswordTo(PathAddSeparator(bHomeDir) + '.cvspass')
  else
    Log(vlErrors, 'Cannot determine $HOME directory');
end;

{$IFDEF MSWINDOWS}
procedure TCvsPassTask.ChangeCvsPassInRegistry;
begin
  if RegKeyExists(HKEY_CURRENT_USER, 'Software\Cvsnt\cvspass') then 
  begin
    RegWriteString(HKEY_CURRENT_USER,
                   'Software\Cvsnt\cvspass',
                   FCvsRoot,
                   ScrambleCvsPassword(fPassword));
    Log(vlVerbose, 'Password for repository '
                   + FCvsRoot
                   + ' stored to registry key HKEY_CURRENT_USER/Software/Cvsnt/cvspass');
  end 
  else 
  begin
    Log(vlWarnings, 'Could not find registry key HKEY_CURRENT_USER/Software/Cvsnt/cvspass. Trying $HOME');
    ChangeCvsPassInhome;
  end;
end;
{$ENDIF}

procedure TCvsPassTask.Execute;
begin
  // no call to inherited, because of this task does not call cvs executable

  // if CVSNT is used, default password file is not regular file, but passwords
  // are stored in registry key HKEY_CURRENT_USER/Software/Cvsnt/cvspass
  // in format:  KeyName = repository; KeyValue = scrambled password

  // in linux is used ~/.cvspass
  {$IFDEF LINUX}
  ChangeCvsPassInHome;
  {$ELSE}
  ChangeCvsPassInRegistry;
  {$ENDIF}
end;

procedure TCvsPassTask.Init;
begin
  inherited;
  RequireAttribute('cvsroot');
  RequireAttribute('password|emptypassword');
  if GetAttribute('emptypassword') <> '' then 
  begin
    if FEmptyPassword then FPassword := ''; 
  end;
end;

function TCvsPassTask.ScrambleCvsPassword(const APassword: string): string;
var
  i: integer;
begin
  Result := 'A';
  for i := 1 to Length(APassword) do
  begin
    Result := Result + Chr(PSW_SHIFTS[Ord(APassword[i])]);
  end;
end;

procedure TCvsPassTask.WritePasswordTo(AFileName: string);
var
  bSL     : TStringList;
  bExists : boolean;
  bFound  : boolean;
  i       : integer;
begin
  bExists := False;
  if FileExists(AFileName) then
  begin
    bExists := True;
    if FileIsReadOnly(AFileName) then
    begin
      Log(vlErrors, 'Cannot write to ' + AFileName);
      exit;
    end;
  end;
  bSL := TStringList.Create;
  try
    if bExists then bSL.LoadFromFile(AFileName);
    bFound := False;
    for i := 0 to bSL.Count - 1 do
    begin
      if Copy(bSL[i], 1, Length(FCvsRoot)) = FCvsRoot then
      begin
        bSL[i] := FCvsRoot + ' ' + ScrambleCvsPassword(FPassword);
        bFound := True;
        break;
      end;
    end;
    if not bFound then bSL.Add(FCvsRoot + ' ' + ScrambleCvsPassword(FPassword));
    bSL.SaveToFile(AFileName);
  finally
    bSL.Free;
  end;
end;

{ TCvsChangeLogUserElement }

procedure TCvsChangeLogUserElement.Init;
begin
  inherited;
  RequireAttribute('userid');
  RequireAttribute('displayname');
end;

class function TCvsChangeLogUserElement.TagName: string;
begin
  Result := 'user';
end;

{ TCvsChangeLogTask }

function TCvsChangeLogTask.BuildArgumentsCommand: string;
begin
  Log(vlVerbose, 'command=log');
  ArgumentList.Add(AddOption('log'));
end;

function TCvsChangeLogTask.BuildArgumentsSpecific: string;
var
  s: string;
begin
  if FDaysInPast <> '' then
  begin
    DateTimeToString(FStart, 'yyyy-mm-dd', Now - StrToInt(FDaysInPast));
    Log(vlVerbose, 'daysinpast (' + FDaysInPast + ') converted to ' + FStart);
  end;
  if FStart <> '' then
  begin
    DateTimeToString(s, 'yyyy-mm-dd', ParseCVSDate(FStart));
    s := '>=' + s;
    ArgumentList.Add(AddOption('-d', s, True));
    Log(vlVerbose, 'date' + s);
  end;
  if FDir = '' then FDir := FBasedir;
  inherited BuildArgumentsSpecific;
end;

constructor TCvsChangeLogTask.Create(AOwner: TScriptElement);
begin
  FDateFormat := 'yyyy-mm-dd';
  FTimeFormat := 'hh:mm';
  inherited Create(aOwner);
  FUserList := TList.Create;
end;

function TCvsChangeLogTask.CreateUser: TCvsChangeLogUserElement;
begin
  Result := TCvsChangeLogUserElement.Create(self);
  FUserList.Add(Result);
end;

function TCvsChangeLogTask.CreateUser(AUserID,
  ADisplayName: string): TCvsChangeLogUserElement;
begin
  Result := TCvsChangeLogUserElement.Create(self);
  Result.userid := AUserID;
  Result.displayname := ADisplayName;
  FUserList.Add(Result);
end;

destructor TCvsChangeLogTask.Destroy;
begin
  FUserList.Free;
  inherited;
end;

procedure TCvsChangeLogTask.Execute;
var
  i         : integer;
  j         : integer;
  bSL       : TStringList;
  bOldDir   : TPath;
  bEntry    : TCvsEntry;
  bEntries  : THashedStringList;
begin
  bOldDir := CurrentDir;
  if FDir <> '' then
  begin
    ChangeDir(FDir, True);
    Log(vlDebug, 'directory changed to ' + FDir);
  end;
  output := FileGetTempName('cvs');
  inherited;
  ChangeDir(bOldDir);
  Log(vlDebug, 'directory changed back to ' + bOldDir);

  // append to user list from file
  if FUsersFile <> '' then
  begin
    if FileExists(FUsersFile) then
    begin
      bSL := TStringList.Create;
      try
        bSL.LoadFromFile(FUsersFile);
        for i := 0 to bSL.Count - 1 do
        begin
          if bSL.Values[bSL.Names[i]] <> '' then
          begin
            CreateUser(bSL.Names[i], bSL.Values[bSL.Names[i]]);
          end;
        end;
      finally
        bSL.Free;
      end;
    end
    else
      Log(vlWarnings, 'Userfile ' + fUsersFile + ' does not exists');
  end;
  bEntries := TCvsChangeLogParser.Parse(output);
  DeleteFile(output);

  // filter start/end dates and replace username
  for i := bEntries.Count - 1 downto 0 do
  begin
    bEntry := TCvsEntry(bEntries.Objects[i]);
    if FStart <> '' then
    begin
      if bEntry.FDate < ParseCVSDate(FStart) then
      begin
        bEntries.Delete(i);
        continue;
      end;
    end;
    if FEnd <> '' then
    begin
      if bEntry.FDate > ParseCVSDate(FEnd) then
      begin
        bEntries.Delete(i);
        continue;
      end;
    end;
    for j := 0 to fUserList.Count - 1 do
    begin
      if TCvsChangeLogUserElement(FUserList[j]).userid = bEntry.FAuthor then
      begin
        bEntry.FAuthor := TCvsChangeLogUserElement(fUserList[j]).displayname;
        break;
      end;
    end;
  end;
  TCvsChangeLogParser.OutputEntriesToXML(FDestFile, bEntries, FDateFormat, FTimeFormat);
end;

procedure TCvsChangeLogTask.Init;
begin
  inherited;
  RequireAttribute('destfile');
end;

{ TRCSFile }

constructor TRCSFile.Create(AName, ARevision: string);
begin
  FFile         := AName;
  FRevision     := ARevision;
  FPrevRevision := '';
end;

constructor TRCSFile.Create(aName, aRevision, aPrevRevision: string);
begin
  FFile         := AName;
  FRevision     := ARevision;
  FPrevRevision := '';
  if ARevision <> APrevRevision then FPrevRevision := APrevRevision;
end;

{ TCvsEntry }

procedure TCvsEntry.AddFile(AFile, ARevision, APreviousRevision: string);
begin
  FFiles.Add(TRCSFile.Create(AFile, ARevision, APreviousRevision));
end;

procedure TCvsEntry.AddFile(AFile, ARevision: string);
begin
  FFiles.Add(TRCSFile.Create(AFile, ARevision));
end;

constructor TCvsEntry.Create(ADate: TDateTime; AAuthor, AComment: string);
begin
  FDate    := ADate;
  FAuthor  := AAuthor;
  FComment := AComment;
  FFiles   := TObjectList.Create;
end;

destructor TCvsEntry.Destroy;
begin
  FFiles.Free;
  inherited;
end;

function TCvsEntry.OutAsXML(ADateFormat, ATimeFormat: string): string;
var
  i       : integer;
  s       : string;
  bOutput : string;
  bRF     : TRCSFile;

  function AddLine(AText: string): string;
  begin
    bOutput := bOutput + AText + #13#10;
  end;
begin
  bOutput := '';
  AddLine(#9'<entry>');
  DateTimeToString(s, ADateFormat, FDate);
  AddLine(#9#9'<date>' + s + '</date>');
  DateTimeToString(s, ATimeFormat, FDate);
  AddLine(#9#9'<time>' + s + '</time>');
  AddLine(#9#9'<author><![CDATA[' + FAuthor + ']]></author>');
  for i := 0 to FFiles.Count - 1 do
  begin
    bRF := TRCSFile(FFiles[i]);
    AddLine(#9#9'<file>');
    AddLine(#9#9#9'<name>' + bRF.FileName + '</name>');
    AddLine(#9#9#9'<revision>' + bRF.Revision + '</revision>');
    if bRF.PrevRevision <> '' then
    begin
      AddLine(#9#9#9'<prevrevision>' + bRF.PrevRevision + '</prevrevision>');
    end;
    AddLine(#9#9'</file>');
  end;
  AddLine(#9#9'<msg><![CDATA[' + FComment + ']]></msg>');
  AddLine(#9'</entry>');
  Result := bOutput;
end;

{ TCvsChangeLogParser }

constructor TCvsChangeLogParser.Create;
begin
  FStatus  := GET_FILE;
  FEntries := THashedStringList.Create;
end;

destructor TCvsChangeLogParser.Destroy;
begin
  FEntries.Free;
  inherited;
end;

class procedure TCvsChangeLogParser.OutputEntriesToXML(AOutputFile: string;
  AEntries: THashedStringList; ADateFormat, ATimeformat: string);
var
  i   : integer;
  bFS : TFileStream;

  procedure StreamWriteString(const AString: string);
  var
    s: string;
  begin
    s := AnsiToUtf8(AString);
    bFS.WriteBuffer(s[1], Length(s));
  end;
begin
  bFS := TFileStream.Create(AOutputFile, fmCreate);
  try
    StreamWriteString('<?xml version="1.0" encoding="UTF-8"?>'#13#10);
    StreamWriteString('<changelog>'#13#10);
    for i := 0 to AEntries.Count - 1 do
    begin
      StreamWriteString(TCvsEntry(AEntries.Objects[i]).OutAsXML(ADateFormat, ATimeFormat));
    end;
    StreamWriteString('</changelog>'#13#10);
  finally
    bFS.Free;
  end;
end;

class function TCvsChangeLogParser.Parse(AInputFile: string): THashedStringList;
begin
  with TCvsChangeLogParser.Create do
  begin
    ProcessInputFile(AInputfile);
    Result := FEntries;
  end;
end;

procedure TCvsChangeLogParser.ProcessComment(ALine: string);
var
  bLineSeparator : string;
  bEnd           : integer;
begin
  {$IFDEF LINUX}
  bLineSeparator := #$0A;
  {$ELSE}
  bLineSeparator := #$0D#$0A;
  {$ENDIF}
  if Pos('======', ALine) = 1 then
  begin
    //We have ended changelog for that particular file
    //so we can save it
    bEnd := Length(FComment) - Length(bLineSeparator);
    fComment := Copy(FComment, 1, bEnd);
    SaveEntry;
    FStatus := GET_FILE;
  end
  else if Pos('----------------------------', ALine) = 1 then
  begin
    bEnd     := Length(FComment) - Length(bLineSeparator);
    FComment := Copy(FComment, 1, bEnd);
    FStatus  := GET_PREVIOUS_REV;
  end 
  else if Pos('branches:', ALine) = 1 then
  begin
    // "branches" was not in original Ant implementation
    // ignore "branches" line; continue in Comment parsing
  end
  else
  begin
    FComment := FComment + ALine + bLineSeparator;
  end;
end;

procedure TCvsChangeLogParser.ProcessDate(ALine: string);
var
  bLineData: string;
begin
  if Pos('date:', ALine) = 1 then
  begin
    FDate     := Copy(ALine, 7, 19);
    bLineData := Copy(ALine, Pos(';', ALine) + 1, Length(ALine));
    FAuthor   := Copy(bLineData, 11, Pos(';', bLineData) - 11);
    FStatus   := GET_COMMENT;
    //Reset comment to empty here as we can accumulate multiple lines
    //in the processComment method
    FComment := '';
  end;
end;

procedure TCvsChangeLogParser.ProcessFile(ALine: string);
begin
  if Pos('Working file:', ALine) = 1 then
  begin
    FFile   := Copy(ALine, 15, Length(ALine));
    FStatus := GET_REVISION;
  end;
end;

procedure TCvsChangeLogParser.ProcessGetPreviousRevision(ALine: string);
begin
  if Pos('revision', ALine) = 0 then
  begin
    raise Exception.Create('Unexpected line from CVS: ' + ALine);
  end;
  FPreviousRevision := Copy(ALine, 10, Length(ALine));
  SaveEntry;
  FRevision := FPreviousRevision;
  FStatus   := GET_DATE;
end;

procedure TCvsChangeLogParser.ProcessInputFile(AFile: string);
var
  i   : integer;
  bSL : TStringList;
begin
  bSL := TStringList.Create;
  try
    bSL.LoadFromFile(AFile);
    for i := 0 to bSL.Count - 1 do
    begin
      case FStatus of
        GET_FILE:
          begin
            // make sure attributes are reset when
            // working on a 'new' file.
            Reset;
            ProcessFile(bSL[i]);
          end;
        GET_REVISION: 
          begin
            ProcessRevision(bSL[i]);
          end;
        GET_DATE:
          begin
            ProcessDate(bSL[i]);
          end;
        GET_COMMENT:
          begin
            ProcessComment(bSL[i]);
          end;
        GET_PREVIOUS_REV:
          begin
            ProcessGetPreviousRevision(bSL[i]);
          end;
      end;
    end;
  finally
    bSL.Free;
  end;
end;

procedure TCvsChangeLogParser.ProcessRevision(aLine: string);
begin
  if Pos('revision', ALine) = 1 then
  begin
    FRevision := Copy(ALine, 10, Length(ALine));
    FStatus   := GET_DATE;
  end
  else if Pos('======', ALine) = 1 then
  begin
    //There was no revisions in this changelog
    //entry so lets move into next file
    FStatus := GET_FILE;
  end;
end;

procedure TCvsChangeLogParser.Reset;
begin
  FFile             := '';
  FDate             := '';
  FAuthor           := '';
  FComment          := '';
  FRevision         := '';
  FPreviousRevision := '';
end;

procedure TCvsChangeLogParser.SaveEntry;
var
  i         : integer;
  bEntryKey : string;
  bEntry    : TCvsEntry;
begin
  bEntryKey := FDate + FAuthor + FComment;
  i := FEntries.IndexOf(bEntryKey);
  if i = -1 then
  begin
    bEntry := TCvsEntry.Create(ParseCVSDate(FDate), FAuthor, FComment);
    FEntries.AddObject(bEntryKey, bEntry);
  end
  else
  begin
    bEntry := TCVSEntry(FEntries.Objects[i]);
  end;
  bEntry.AddFile(FFile, FRevision, FPreviousRevision);
end;

{ TCvsMostRecentTag }

function TCvsMostRecentTag.BuildArgumentsCommand: string;
begin
  Log(vlVerbose, 'command=log');
  ArgumentList.Add(AddOption('log'));
end;

function TCvsMostRecentTag.BuildArgumentsSpecific: string;
begin
  ArgumentList.Add(AddOption('-h')); // headers only
  ArgumentList.Add(AddOption(FModuleName));
end;

procedure TCvsMostRecentTag.Execute;
var
  i   : integer;
  BSL : TStringList;
begin
  FMostRecentTag := '';
  output := FileGetTempName('cvs');
  inherited;
  bSL := TStringList.Create;
  try
    bSL.LoadFromFile(output);
    i := bSL.IndexOf('symbolic names:');
    if i <> -1 then
    begin
      if bSL[i+1][1] = #9 then
      begin
        FMostRecentTag := Trim(Copy(bSL[i+1], 1, Pos(':', bSL[i+1]) - 1));
      end;
    end;
  finally
    bSL.Free;
    DeleteFile(output);
  end;
end;

initialization
  RegisterTasks([ TCvsTask,
                  TCvsTagDiffTask,
                  TCvsPassTask,
                  TCvsChangeLogTask ]);
  RegisterElement(TCvsChangeLogTask, TCvsChangeLogUserElement);
end.
