////////////////////////////////////////////////////////////////////////////////
// Copyright (c) 2001-2026 Alexey Kuryakin daqgroup@mail.ru under MIT license //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// This file is part of the CRW-DAQ project by DaqGroup - component CRWLIB.   //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// This unit containts Command Line arguments parser.                         //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20201123 - Created by A.K.                                                 //
// 20230501 - Modified for FPC (A.K.)                                         //
////////////////////////////////////////////////////////////////////////////////

unit _crw_cmdargs; // Command line arguments parser.

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

{$WARN 5023 off : Unit "$1" not used in $2}

interface

uses
 //////////////////////////////////////////////////////
 {$I _crw_uses_first.inc} // NB: MUST BE FIRST USES !!!
 //////////////////////////////////////////////////////
 sysutils, classes, strutils,
 _crw_alloc;

////////////////////////////////////////////////////////////////////////////////
// CmdArgs is command arguments parser.
// Usage is like:
//  CmdArgs.Count           = total argument count = ParamCount+1
//  CmdArgs.Strings[0]      = executable file name as ParamStr(0)
//  CmdArgs.Strings[i]      = command line argiment with number i
//  CmdArgs.IsOption(S)     = true if S looks like option, i.e. as -opt or /opt
//  CmdArgs.ListOptVal      = Get/set list of options which (must) have a values
//                            List is semicolon separated, like '-dns;-obj;-set'
//                            Value (val) of option (opt) must be set as one of:
//                            1) as -opt=val or 2) as -opt val    In second case
//                            the val exclude from list of positional parameters
//                      Note: 1) CmdArgs.ListOptVal:=''; - uses to reset (clear)
//                               the list of options values.
//                            2) CmdArgs.ListOptVal:=XXX;  - uses to add options
//                               from XXX (with checking duplicates and format).
//                               So the CmdArgs.ListOptVal works as accumulator.
//  CmdArgs.NeedOptVal(Opt) = true if Opt is in ListOptVal and has no equal sign
//                            use it to check if option Opt need to have a value
//  CmdArgs.NumOptions      = number of arguments which is looks like an options
//  CmdArgs.HasOption(Opt)  = true if command line has option with name = Opt
//  CmdArgs.HasOption(n)    = true if command line has option with number = n
//  CmdArgs.GetOption(n)    = return command line option with given number = n
//  CmdArgs.GetOptionValue(Opt) = get option value; Opt must be in ListOptVal
//  CmdArgs.NumParams       = number of parameters, exclude options+their values
//  CmdArgs.HasParam(n)     = true if command line has parameter with number = n
//  CmdArgs.GetParam(n)     = return positional parameter number n, skip options
// Notes:
//  1) Options looks like -opt (or /opt in Windows) is allowed
//  2) Options may have values 1) as -opt val or 2) as -opt=val
//  3) Options which need values must be included in ListOptVal
//  4) Params is any arguments which is not looks like options
//  5) Order of Params is important, it's positional arguments
//  6) Order of Options don't matter (-a -b are same as -b -a)
//  7) Special option -- uses to terminate options; after that
//     any argument interprets as param even if started with -
//  8) Option names is not case sensitive, so -x equals to -X
// Examples:
//  CmdArgs.ListOptVal:='--test;--demo'; // Options need values
//  for i:=0 to CmdArgs.Count-1 do ShowMessage(CmdArgs.Strings[i]);
//  if CmdArgs.HasOption('--test') then
//  ShowMessage('--test has value '+CmdArgs.GetOptionValue('--test'));
//  if CmdArgs.HasOption('--demo') then
//  ShowMessage('--demo has value '+CmdArgs.GetOptionValue('--demo'));
//  This code will recognize for example:
//   test.exe --demo Demo1 --test=Test1 Param1 Param2
//   test.exe --demo=Demo2 Param1 --test Test2 Param2
//  See also ReportCmdArgs.
////////////////////////////////////////////////////////////////////////////////

type
 TCmdArgs = class(TStringList)
 private
  FExeFilePath : LongString;
  FExeFileName : LongString;
  FExeBaseName : LongString;
  FExeFileDir  : LongString;
  FExeFileExt  : LongString;
  FStartupDir  : LongString;
  FListOptVal  : LongString;
  FListOptPat  : LongString;
  FListOpt     : TStringList;
  FListPar     : TStringList;
 protected
  procedure   Update;
  procedure   Parser;
  procedure   SetListOptVal(const aList:LongString);
  function    GetPattern(const S:LongString):LongString;
  function    HasEqualsSign(const S:LongString):Boolean;
 public
  constructor Create;
  destructor  Destroy; override;
  procedure   AfterConstruction; override;
  procedure   BeforeDestruction; override;
 public
  property    ExeFilePath : LongString read FExeFilePath;      // Executable file path as dir\base.ext
  property    ExeFileName : LongString read FExeFileName;      // Executable file base.ext
  property    ExeBaseName : LongString read FExeBaseName;      // Executable file basename
  property    ExeFileDir  : LongString read FExeFileDir;       // Executable file dir
  property    ExeFileExt  : LongString read FExeFileExt;       // Executable file ext
  property    StartupDir :  LongString read FStartupDir;       // Directory of start
 public
  function    IsOption(const S:LongString):Boolean;            // String S looks like Option (-opt,/opt) ?
  function    ExtractName(const S:LongString):LongString;      // Extract Name  from expression Name=Value
  function    ExtractValue(const S:LongString):LongString;     // Extract Value from expression Name=Value
 public
  property    ListOptVal  : LongString read FListOptVal        // List (semicolon separated) of Options
                                       write SetListOptVal;    // which need a value as '-dns;-obj;-set'
  function    NeedOptVal(const Opt:LongString):Boolean;        // Option need a value (is in ListOptVal)?
 public
  function    NumOptions:Integer;                              // Number of options (started with -)
  function    GetOption(n:Integer):LongString;                 // Get name of option with number n
  function    HasOption(n:Integer):Boolean; overload;          // Check option number n exists
  function    HasOption(const Opt:LongString):Boolean; overload;          // Check option name Opt exists
  function    GetOptionValue(n:Integer):LongString; overload;             // Get option value by index
  function    GetOptionValue(const Opt:LongString):LongString; overload;  // -Opt=Value or -Opt Value
  function    HasOptionValue(n:Integer):Boolean; overload;                // Check option number n has a value
  function    HasOptionValue(const Opt:LongString):Boolean; overload;     // Check option name Opt has a value
 public
  function    NumParams:Integer;                               // Number of parameters (not options)
  function    HasParam(n:Integer):Boolean;                     // Check positional parameter, skip options
  function    GetParam(n:Integer):LongString;                  // Get positional parameter, skip options
 end;

function CmdArgs:TCmdArgs;          // The only one command line parser

function ReportCmdArgs:LongString;  // Return a text of CmdArgs report

implementation

var TheCmdArgs:TCmdArgs=nil;

function CmdArgs:TCmdArgs;
begin
 if (TheCmdArgs=nil) then TheCmdArgs:=TCmdArgs.Create;
 Result:=TheCmdArgs;
end;

constructor TCmdArgs.Create;
begin
 inherited Create;
 FListOpt:=TStringList.Create;
 FListPar:=TStringList.Create;
 Delimiter:=' ';
 QuoteChar:='"';
 Update;
end;

destructor TCmdArgs.Destroy;
begin
 Clear;
 FListOpt.Clear;
 FListPar.Clear;
 FExeFilePath:='';
 FExeFileName:='';
 FExeBaseName:='';
 FExeFileDir:='';
 FExeFileExt:='';
 FStartupDir:='';
 FListOptVal:='';
 FListOptPat:='';
 FListOpt.Free;
 FListPar.Free;
 inherited Destroy;
end;

procedure TCmdArgs.AfterConstruction;
begin
 inherited AfterConstruction;
 if (TheCmdArgs=nil) then TheCmdArgs:=Self;
end;

procedure TCmdArgs.BeforeDestruction;
begin
 if (TheCmdArgs=Self) then TheCmdArgs:=nil;
 inherited BeforeDestruction;
end;

procedure TCmdArgs.Update;
var i:Integer;
begin
 try
  FListOpt.Clear;
  FListPar.Clear;
  if (Count=0) then begin
   for i:=0 to ParamCount do Add(ParamStr(i));
   FExeFilePath:=ExpandFileName(ParamStr(0));
   FExeFileName:=ExtractFileName(ExeFilePath);
   FExeBaseName:=ChangeFileExt(ExeFileName,'');
   FExeFileDir:=ExtractFileDir(ExeFilePath);
   FExeFileExt:=ExtractFileExt(ExeFilePath);
   FStartupDir:=GetCurrentDir;
  end;
  Parser;
 except
  on E: Exception do BugReport(E,Self,'Update');
 end;
end;

procedure TCmdArgs.Parser;
var i:Integer; arg,opt,val,par:LongString; optflag,optval:Boolean;
begin
 try
  if (Count>1) then begin
   i:=1; optflag:=true;
   while (i<Count) do begin
    arg:=Strings[i];
    if optflag and (arg='--') then optflag:=false else
    if optflag and IsOption(arg) then begin
     optval:=NeedOptVal(arg);
     if optval then inc(i);
     opt:=ExtractName(arg);
     val:=ExtractValue(arg);
     if optval then begin
      if (i<Count) // option as -opt value in ListOptVal
      then FListOpt.Add(Format('%s=%s',[opt,Strings[i]]))
      else FListOpt.Add(opt); // incomplete tail -opt
     end else begin
      // option as -opt or -opt=value
      if HasEqualsSign(arg) and NeedOptVal(opt)
      then FListOpt.Add(Format('%s=%s',[opt,val]))
      else FListOpt.Add(opt);
     end;
    end else begin
     par:=arg;
     FListPar.Add(par);
    end;
    inc(i);
   end;
  end;
 except
  on E: Exception do BugReport(E,Self,'Parser');
 end;
end;

procedure TCmdArgs.SetListOptVal(const aList:LongString);
var i,n:Integer; opt,val,pat:LongString;
const OptDelims=[';',',',' '];
begin
 val:=FListOptVal;
 pat:=FListOptPat;
 n:=WordCount(aList,OptDelims);
 if (n=0) then FListOptVal:='';
 for i:=1 to n do begin
  opt:=ExtractWord(i,aList,OptDelims);
  if not IsOption(opt) then Continue;
  if (Pos(GetPattern(opt),FListOptPat)>0) then Continue;
  if (FListOptVal<>'') then FListOptVal:=FListOptVal+';';
  FListOptVal:=FListOptVal+Trim(opt);
  FListOptPat:=GetPattern(FListOptVal);
 end;
 FListOptPat:=GetPattern(FListOptVal);
 if (val<>FListOptVal) or (pat<>FListOptPat)
 then Update;
end;

function TCmdArgs.GetPattern(const S:LongString):LongString;
begin
 if (S='') then Result:=S else Result:=';'+LowerCase(Trim(S))+';';
end;

function TCmdArgs.HasEqualsSign(const S:LongString):Boolean;
begin
 Result:=(Pos('=',S)>0);
end;

function TCmdArgs.IsOption(const S:LongString):Boolean;
begin
 Result:=false;
 if (S='') then Exit;
 if (S[1]='-') then Result:=true else
 if (S[1]='/') then Result:=IsWindows;
end;

function TCmdArgs.ExtractName(const S:LongString):LongString;
var i:Integer;
begin
 Result:=S;
 i:=Pos('=',S);
 if (i=0) then Exit;
 Result:=Copy(S,1,i-1);
end;

function TCmdArgs.ExtractValue(const S:LongString):LongString;
var i:Integer;
begin
 Result:='';
 i:=Pos('=',S);
 if (i=0) then Exit;
 Result:=Copy(S,i+1,Length(S)-i);
end;

function TCmdArgs.NeedOptVal(const Opt:LongString):Boolean;
begin
 Result:=false;
 if (ListOptVal='') then Exit;
 if not IsOption(Opt) then Exit;
 if HasEqualsSign(Opt) then Exit;
 if (Pos(GetPattern(Opt),FListOptPat)=0) then Exit;
 Result:=true;
end;

function TCmdArgs.NumOptions:Integer;
begin
 Result:=FListOpt.Count;
end;

function TCmdArgs.GetOption(n:Integer):LongString;
begin
 Result:='';
 if (n>=1) and (n<=FListOpt.Count)
 then Result:=ExtractName(FListOpt.Strings[n-1]);
end;

function TCmdArgs.HasOption(n:Integer):Boolean;
begin
 Result:=(n>=1) and (n<=FListOpt.Count);
end;

function TCmdArgs.HasOption(const Opt:LongString):Boolean;
begin
 Result:=false;
 if (Opt='') then Exit;
 if not IsOption(Opt) then Exit;
 if (FListOpt.IndexOf(Opt)<0) and (FListOpt.IndexOfName(Opt)<0) then Exit;
 Result:=true;
end;

function TCmdArgs.GetOptionValue(n:Integer):LongString;
begin
 Result:='';
 if (n>=1) and (n<=FListOpt.Count)
 then Result:=ExtractValue(FListOpt.Strings[n-1]);
end;

function TCmdArgs.GetOptionValue(const Opt:LongString):LongString;
var i:Integer;
begin
 Result:='';
 if (Opt='') then Exit;
 if not IsOption(Opt) then Exit;
 i:=FListOpt.IndexOfName(Opt);
 if (i>=0) then Result:=ExtractValue(FListOpt.Strings[i]);
end;

function TCmdArgs.HasOptionValue(n:Integer):Boolean;
begin
 Result:=false;
 if (n>=1) and (n<=FListOpt.Count)
 then Result:=HasEqualsSign(FListOpt.Strings[n-1]);
end;

function TCmdArgs.HasOptionValue(const Opt:LongString):Boolean;
var i:Integer;
begin
 Result:=false;
 if (Opt='') then Exit;
 if not IsOption(Opt) then Exit;
 i:=FListOpt.IndexOfName(Opt);
 if (i>=0) then Result:=HasEqualsSign(FListOpt.Strings[i]);
end;

function TCmdArgs.NumParams:Integer;
begin
 Result:=FListPar.Count;
end;

function TCmdArgs.GetParam(n:Integer):LongString;
begin
 Result:='';
 if (n>=1) and (n<=FListPar.Count)
 then Result:=FListPar.Strings[n-1]; 
end;

function TCmdArgs.HasParam(n:Integer):Boolean;
begin
 Result:=(n>=1) and (n<=FListPar.Count);
end;

function ReportCmdArgs:LongString;
var i:Integer; List:TStringList; Line,Opt:LongString;
 procedure Add(const s:LongString); begin List.Add(s); end;
begin
 Result:='';
 try
  List:=TStringList.Create;
  try
   Add('Report of CmdArgs:');
   Add(Format('ExeFilePath = %s',[CmdArgs.ExeFilePath]));
   Add(Format('ExeFileName = %s',[CmdArgs.ExeFileName]));
   Add(Format('ExeFileBase = %s',[CmdArgs.ExeBaseName]));
   Add(Format('ExeFileDir  = %s',[CmdArgs.ExeFileDir]));
   Add(Format('ExeFileExt  = %s',[CmdArgs.ExeFileExt]));
   Add(Format('StartupDir  = %s',[CmdArgs.StartupDir]));
   Add(Format('ArgC        = %d',[CmdArgs.Count]));
   for i:=0 to CmdArgs.Count-1 do begin
    Add(Format('Argv[%d]   = %s',[i,CmdArgs[i]]));
   end;
   Add(Format('ParamCount  = %d',[CmdArgs.Count-1]));
   Add(Format('NumOptions  = %d',[CmdArgs.NumOptions]));
   Add(Format('NumParams   = %d',[CmdArgs.NumParams]));
   for i:=1 to CmdArgs.NumOptions do
   if CmdArgs.HasOption(i) then begin
    Opt:=CmdArgs.GetOption(i);
    Line:=Format('Options[%d] = %s',[i,Opt]);
    if CmdArgs.HasOptionValue(Opt) then Line:=Line+Format(' %s',[CmdArgs.GetOptionValue(Opt)]);
    Add(Line);
   end;
   for i:=1 to CmdArgs.NumParams do
   if CmdArgs.HasParam(i) then begin
    Add(Format('Params[%d] = %s',[i,CmdArgs.GetParam(i)]));
   end;
   Result:=List.Text;
  finally
   List.Free;
  end;
 except
  on E: Exception do BugReport(E,nil,'ReportCmdArgs');
 end;
end;

///////////////////////////////////////
// Unit initialization and finalization
///////////////////////////////////////

procedure Init_crw_cmdargs;
begin
 CmdArgs;
end;

procedure Free_crw_cmdargs;
begin
 FreeAndNil(TheCmdArgs);
end;

initialization

 Init_crw_cmdargs;

finalization

 Free_crw_cmdargs;

end.

//////////////
// END OF FILE
//////////////

