////////////////////////////////////////////////////////////////////////////////
// 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 is for work with environment variables in Windows or Unix style. //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20230502 - Created by A.K.                                                 //
// 20230523 - OriginalEnvironmentList                                         //
// 20241128 - Substitute Bash style call $() and ``                           //
////////////////////////////////////////////////////////////////////////////////

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

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

interface

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

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

const                    // Expand modes for ExpEnv
 emExpandLikeWinC = $01; // Windows Classic  - %Variable%
 emExpandLikeWinE = $02; // Windows Expanded - !Variable!
 emExpandLikeUnix = $04; // Unix classic     - $Variable
 emExpandLikeBash = $08; // Bash style       - ${Variable}
 emExpandBashCall = $10; // Bash call        - $(Command)
 emExpandBackTick = $20; // Bash call        - `Command`

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

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:LongString):LongString;
function SetEnvironmentVariable(Name,Value:LongString):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:TSafeStringList; NamesOnly:Boolean=false):LongInt;
function SysGetEnvironmentText(NamesOnly:Boolean=false):LongString;

// Expand environment variables from Expression.
// Supports Unix-like $Name (for example, $HOME\Demo).
// Supports Unix-like ${Name} (for example, ${HOME}\Demo).
// Supports Unix-like `Command` (for example, $(pwd)).
// Supports Unix-like $(Command) (for example, $(pwd)).
// 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:LongString; Mode:Integer=0):LongString;

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

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

implementation

type
 TEnvSubstitutor=function(Name:LongString):LongString;

function SysGetEnvironmentList(List:TSafeStringList; 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):LongString;
var List:TSafeStringList;
begin
 Result:='';
 try
  List:=TSafeStringList.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:TSafeStringList=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:TSafeStringList;
begin
 if (TheEnvList=nil) then begin
  TheEnvList:=TSafeStringList.Create;
  TheEnvListInit;
 end;
 Result:=TheEnvList;
end;

var OriEnvList:TSafeStringList=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:TSafeStringList;
begin
 if (OriEnvList=nil) then begin
  OriEnvList:=TSafeStringList.Create;
  OriEnvListInit;
 end;
 Result:=OriEnvList;
end;

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

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

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

function PCharArg(const S:LongString):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:LongString):LongString;
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:LongString):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:LongString):LongString;
begin
 if (Name='') then Result:='' else Result:=c_getenv(PCharArg(Name));
end;
function SetEnvironmentVariable(Name,Value:LongString):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:LongString; var iStart,Count:Integer; LeftOff,RightOff:Integer; Substitutor:TEnvSubstitutor=nil):Boolean;
var sName,sValue:LongString;
begin
 Result:=false;
 if (iStart>0) then begin
  if (Count>0) then begin
   sName:=Copy(S,iStart+LeftOff,Count);
   if Assigned(Substitutor)
   then sValue:=Substitutor(sName)
   else sValue:=GetEnvironmentVariable(sName);
   if not Assigned(Substitutor) then // For environment variables only
   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:LongString; 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 iStart:=0;
  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:LongString; 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 iStart:=0;
  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:LongString; 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 else iStart:=0;
 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:LongString; 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 iStart:=0;
  else Accumulate(iStart,Count);
 end;
end;

function RunOut(Cmd:LongString):LongString;
var outstr:LongString;
begin
 Result:=''; outstr:='';
 if RunCommand(cmd,outstr)
 then Result:=TrimRightSet(outstr,[#13,#10]);
end;

// Environment substitution in Bash call style.
// Replace $(Name) expression to RunCommand out, return true if succeded.
function ExpandBashCall(var S:LongString; Mode:Integer):Boolean;
var i,iStart,Count:Integer;
begin
 Result:=false;
 if ((Mode and emExpandBashCall)=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,RunOut) then begin Result:=true; Exit; end else iStart:=0;
  else Accumulate(iStart,Count);
 end;
end;

// Environment substitution in Bash call with backticks style.
// Replace `Command` expression to RunCommand output, return true if succeded.
function ExpandBackTick(var S:LongString; Mode:Integer):Boolean;
var i,iStart,Count:Integer;
begin
 Result:=false;
 if ((Mode and emExpandBackTick)=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,RunOut) then begin Result:=true; Exit; end else iStart:=0;
  else Accumulate(iStart,Count);
 end;
end;


function ExpandEnvironmentVariables(const Expression:LongString; Mode:Integer=0):LongString;
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);
  i:=0; while (ExpandBashCall(Result,Mode) or ExpandBackTick(Result,Mode)) and (i<MaxIterations) do inc(i);
 except
  on E:Exception do BugReport(E,nil,'ExpandEnvironmentVariables');
 end;
end;

function TestExpandEnvironmentVariables:LongString;
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
//////////////

