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

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

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// This unit is for work with environment variables in Windows or Unix style. //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20230502 - Created by A.K.                                                 //
// 20230523 - OriginalEnvironmentList                                         //
////////////////////////////////////////////////////////////////////////////////

unit _crw_environ; //  Unit for work with Environment Variables.

{$I _crw_sysdef}

{$IFDEF FPC}{$mode Delphi}{$ENDIF}{$H+}

interface

uses
 _crw_sharemem, // NB: THIS UNIT MUST BE FIRST !!!
 {$IFDEF UNIX} cthreads, dl, {$ENDIF}
 {$IFDEF WINDOWS} windows, {$ENDIF}
 sysutils, classes, math,
 _crw_alloc;

// Environment variables (top level).
///////////////////////////////////////////////////////
function GetEnv(Name:String):String;                 // Get environment variable
function SetEnv(Name,Value:String):Boolean;          // Set environment variable
function ExpEnv(Expr:String; Mode:Integer=0):String; // Expand as %VAR% or $VAR
function EnvironmentVariableList:TStringList;        // List of all (NAME=VALUE)
function OriginalEnvironmentList:TStringList;        // Startup (original) env.

const                  // Expand modes for ExpEnv
 emExpandLikeWinC = 1; // Windows Classic  - %Variable%
 emExpandLikeWinE = 2; // Windows Expanded - !Variable!
 emExpandLikeUnix = 4; // Unix classic     - $Variable
 emExpandLikeBash = 8; // Bash style       - ${Variable}

const // Default value of ExpEnv Mode (when passed Mode=0)
 emExpandDefaults : Integer = emExpandLikeWinC + emExpandLikeWinE
                            + emExpandLikeUnix + emExpandLikeBash;

const // Temp.Buffer Size for GetEnv
 TempEnvBuffSize : Integer = 1024*64;

const // Max.number of iterations for ExpEnv substitutions
 MaxExpEnvIterations : Integer = 10;

// Get/Set environment variables (low level).
function GetEnvironmentVariable(Name:String):String;
function SetEnvironmentVariable(Name,Value:String):Boolean;

// Get all environment variable strings (low level).
// On Linux: return initial environment (passed by parent).
// On Windows: return actual environment (with user changes).
// Use Get/SetEnv+EnvironmentVariableList for actual environ on all systems.
function SysGetEnvironmentList(List:TStrings; NamesOnly:Boolean=false):LongInt;
function SysGetEnvironmentText(NamesOnly:Boolean=false):String;

// Expand environment variables from Expression.
// Supports Unix-like $Name (for example, $HOME\Demo).
// Supports Unix-like ${Name} (for example, ${HOME}\Demo).
// Supports Windows-like !Name! (for example, !ProgramFiles!\Demo).
// Supports Windows-like %Name% (for example, %ProgramFiles%\Demo).
// Note: arguments (%0,%1..%9 or $0,$1..$9) is NOT suported, it's not real environment variables.
function ExpandEnvironmentVariables(const Expression:String; Mode:Integer=0):String;

// Uses to set PChar arguments from String.
function PCharArg(const S:String):PChar; {$IFDEF FPC}inline;{$ENDIF}
function PWideCharArg(const S:WideString):PWideChar; {$IFDEF FPC}inline;{$ENDIF}

// Just for testing purposes.
function TestExpandEnvironmentVariables:String;

implementation

function SysGetEnvironmentList(List:TStrings; NamesOnly:Boolean=false):LongInt;
var s:LongString; i,p,count:LongInt;
begin
 Result:=0;
 if Assigned(List) then
 try
  count:=GetEnvironmentVariableCount;
  if (count>0) then
  for i:=1 to count do begin
   s:=GetEnvironmentString(i);
   if NamesOnly then begin
    p:=pos('=',s);
    if (p>0) then s:=Copy(s,1,p-1);
   end;
   List.Add(s);
  end;
  Result:=count;
 except
  on E:Exception do BugReport(E,nil,'SysGetEnvironmentList')
 end;
end;

function SysGetEnvironmentText(NamesOnly:Boolean=false):String;
var List:TStringList;
begin
 Result:='';
 try
  List:=TStringList.Create;
  try
   if (SysGetEnvironmentList(List,NamesOnly)>0)
   then Result:=List.Text;
  finally
   Kill(List);
  end;
 except
  on E:Exception do BugReport(E,nil,'SysGetEnvironmentText')
 end;
end;

var TheEnvList:TStringList=nil;

procedure TheEnvListInit;
var i:Integer;
begin
 SysGetEnvironmentList(TheEnvList);
 for i:=TheEnvList.Count-1 downto 0 do begin
  if (Pos('=',TheEnvList.Strings[i])<=1)
  then TheEnvList.Delete(i);
 end;
end;

function EnvironmentVariableList:TStringList;
begin
 if (TheEnvList=nil) then begin
  TheEnvList:=TStringList.Create;
  TheEnvListInit;
 end;
 Result:=TheEnvList;
end;

var OriEnvList:TStringList=nil;

procedure OriEnvListInit;
var i:Integer;
begin
 SysGetEnvironmentList(OriEnvList);
 for i:=OriEnvList.Count-1 downto 0 do begin
  if (Pos('=',OriEnvList.Strings[i])<=1)
  then OriEnvList.Delete(i);
 end;
end;

function OriginalEnvironmentList:TStringList;
begin
 if (OriEnvList=nil) then begin
  OriEnvList:=TStringList.Create;
  OriEnvListInit;
 end;
 Result:=OriEnvList;
end;

function GetEnv(Name:String):String;
begin
 Result:=GetEnvironmentVariable(Name);
end;

function SetEnv(Name,Value:String):Boolean;
begin
 Result:=false; if (Name='') then Exit;
 Result:=SetEnvironmentVariable(Name,Value);
 if Result then EnvironmentVariableList.Values[Name]:=Value;
end;

function ExpEnv(Expr:String; Mode:Integer=0):String;
begin
 if (Mode=0) then Mode:=emExpandDefaults;
 Result:=ExpandEnvironmentVariables(Expr,Mode);
end;

function PCharArg(const S:String):PChar; {$IFDEF FPC}inline;{$ENDIF}
begin
  if (S='') then Result:=nil else Result:=PChar(S);
end;

function PWideCharArg(const S:WideString):PWideChar; {$IFDEF FPC}inline;{$ENDIF}
begin
  if (S='') then Result:=nil else Result:=PWideChar(S);
end;

{$IFDEF WINDOWS}
function GetEnvironmentVariable(Name:String):String;
begin
  Result:='';
  if (Name='') then Exit;
  SetLength(Result,Max(1024,TempEnvBuffSize));
  SetLength(Result,Windows.GetEnvironmentVariable(PChar(Name),PChar(Result),Length(Result)));
end;
function SetEnvironmentVariable(Name,Value:String):Boolean;
begin
 Result:=Windows.SetEnvironmentVariable(PCharArg(Name),PCharArg(Value));
end;
{$ELSE}
function c_getenv(__name:Pchar):Pchar;cdecl;external 'c' name 'getenv';
function c_putenv(__string:Pchar):longint;cdecl;external 'c' name 'putenv';
function c_setenv(__name:Pchar; __value:Pchar; __replace:longint):longint;cdecl;external 'c' name 'setenv';
function c_unsetenv(__name:Pchar):longint;cdecl;external 'c' name 'unsetenv';
function GetEnvironmentVariable(Name:String):String;
begin
 if (Name='') then Result:='' else Result:=c_getenv(PCharArg(Name));
end;
function SetEnvironmentVariable(Name,Value:String):Boolean;
begin
 Result:=false;
 if (Name='') then Exit;
 if (Value='') then begin Result:=(c_unsetenv(PCharArg(Name))<>-1); Exit; end;
 Result:=(c_setenv(PCharArg(Name),PCharArg(Value),1)<>-1);
end;
{$ENDIF}

// Internal utility routines
////////////////////////////
procedure BookMark(i:Integer; var iStart,Count:Integer); {$IFDEF FPC}inline;{$ENDIF}
begin
 iStart:=i; Count:=0;
end;

procedure Accumulate(iStart:Integer; var Count:Integer); {$IFDEF FPC}inline;{$ENDIF}
begin
 if (iStart>0) then inc(Count);
end;

function TrySubstitution(var S:String; var iStart,Count:Integer; LeftOff,RightOff:Integer):Boolean;
var sName,sValue:String;
begin
 Result:=false;
 if (iStart>0) then begin
  if (Count>0) then begin
   sName:=Copy(S,iStart+LeftOff,Count);
   sValue:=GetEnvironmentVariable(sName);
   if (sValue='') then Exit; // Environment variable is not defined, skip it.
   S:=Copy(S,1,iStart-1)+sValue+Copy(S,iStart+Count+LeftOff+RightOff,MaxInt);
   Result:=true;
  end;
  BookMark(0,iStart,Count);
 end;
end;

// Environment substitution in Windows Cmd Classic style.
// Replace %Name% expression to GetEnv(Name), return true if one found.
// Do not replace anything if environment variable Name is not defined.
function ExpandLikeWinC(var S:String; Mode:Integer):Boolean;
var i,iStart,Count:Integer;
begin
 Result:=false;
 if ((Mode and emExpandLikeWinC)=0) then Exit;
 iStart:=0; Count:=0;
 for i:=1 to Length(S) do
 case S[i] of
  '%':  if (iStart=0) then BookMark(i,iStart,Count) else
        if TrySubstitution(S,iStart,Count,1,1) then begin Result:=true; Exit; end;
  else  Accumulate(iStart,Count);
 end;
end;

// Environment substitution in Windows Cmd Expanded style.
// Replace !Name! expression to GetEnv(Name), return true if one found.
// Do not replace anything if environment variable Name is not defined.
function ExpandLikeWinE(var S:String; Mode:Integer):Boolean;
var i,iStart,Count:Integer;
begin
 Result:=false;
 if ((Mode and emExpandLikeWinE)=0) then Exit;
 iStart:=0; Count:=0;
 for i:=1 to Length(S) do
 case S[i] of
  '!': if (iStart=0) then BookMark(i,iStart,Count) else
       if TrySubstitution(S,iStart,Count,1,1) then begin Result:=true; Exit; end;
  else Accumulate(iStart,Count);
 end;
end;

// Environment substitution in Unix Shell style.
// Replace $Name expression to GetEnv(Name), return true if one found.
// Do not replace anything if environment variable Name is not defined.
function ExpandLikeUnix(var S:String; Mode:Integer):Boolean;
var i,iStart,Count:Integer;
begin
 Result:=false;
 if ((Mode and emExpandLikeUnix)=0) then Exit;
 iStart:=0; Count:=0;
 for i:=1 to Length(S) do
 case S[i] of
  '$':  if (iStart=0) then BookMark(i,iStart,Count);
  'A'..'Z',
  'a'..'z',
  '0'..'9',
  '_': Accumulate(iStart,Count);
  else if TrySubstitution(S,iStart,Count,1,0) then begin Result:=true; Exit; end;
 end;
 if TrySubstitution(S,iStart,Count,1,0) then begin Result:=true; Exit; end;
end;

// Environment substitution in Unix Bash style.
// Replace ${Name} expression to GetEnv(Name), return true if one found.
// Do not replace anything if environment variable Name is not defined.
function ExpandLikeBash(var S:String; Mode:Integer):Boolean;
var i,iStart,Count:Integer;
begin
 Result:=false;
 if ((Mode and emExpandLikeBash)=0) then Exit;
 iStart:=0; Count:=0;
 for i:=1 to Length(S) do
 case S[i] of
  '$': if (iStart=0) then BookMark(i,iStart,Count);
  '{': if (iStart>0) then if (i<>iStart+1) then BookMark(0,iStart,Count);
  '}': if TrySubstitution(S,iStart,Count,2,1) then begin Result:=true; Exit; end;
  else Accumulate(iStart,Count);
 end;
end;

function ExpandEnvironmentVariables(const Expression:String; Mode:Integer=0):String;
var i,MaxIterations:Integer;
begin
 Result:=Expression; if (Result='') then Exit; if (Mode=0) then Exit;
 try
  if (Mode=0) then Mode:=emExpandDefaults;
  MaxIterations:=Max(0,MaxExpEnvIterations);
  i:=0; while (ExpandLikeWinE(Result,Mode) or ExpandLikeWinC(Result,Mode)) and (i<MaxIterations) do inc(i);
  i:=0; while (ExpandLikeBash(Result,Mode) or ExpandLikeUnix(Result,Mode)) and (i<MaxIterations) do inc(i);
 except
  on E:Exception do BugReport(E,nil,'ExpandEnvironmentVariables');
 end;
end;

function TestExpandEnvironmentVariables:String;
begin
 Result:='Test ExpandEnvironmentVariables:'+EOL
        +ExpEnv('$HOME')+EOL
        +ExpEnv('%HOME%')+EOL
        +ExpEnv('!HOME!')+EOL
        +ExpEnv('${HOME}')+EOL
        +ExpEnv('$HOME\Demo')+EOL
        +ExpEnv('!HOME!\Demo')+EOL
        +ExpEnv('%HOME%\Demo')+EOL
        +ExpEnv('${HOME}\Demo')+EOL
        +ExpEnv('$UserProfile')+EOL
        +ExpEnv('!UserProfile!')+EOL
        +ExpEnv('%UserProfile%')+EOL
        +ExpEnv('${UserProfile}')+EOL
        +ExpEnv('$UserProfile\Demo')+EOL
        +ExpEnv('!UserProfile!\Demo')+EOL
        +ExpEnv('%UserProfile%\Demo')+EOL
        +ExpEnv('${UserProfile}\Demo')+EOL;
end;

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

procedure Init_crw_environ;
begin
 EnvironmentVariableList;
 OriginalEnvironmentList;
end;

procedure Free_crw_environ;
begin
 FreeAndNil(TheEnvList);
 FreeAndNil(OriEnvList);
end;

initialization

 Init_crw_environ;

finalization

 Free_crw_environ;

end.

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

