You've already forked lazarus-ccr
cmdlinecfg: the initial files commit
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2802 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
skalogryz
282
components/cmdlinecfg/trunk/cmdlinecfgutils.pas
Normal file
282
components/cmdlinecfg/trunk/cmdlinecfgutils.pas
Normal file
@ -0,0 +1,282 @@
|
||||
unit cmdlinecfgutils;
|
||||
|
||||
interface
|
||||
|
||||
{$mode delphi}
|
||||
|
||||
uses
|
||||
SysUtils, Classes, cmdlinecfg, process;
|
||||
|
||||
function CmdLineCfgCombine(const ancestor, child: TCmdLineCfg; DoDeleteDashTypes: Boolean = true): Boolean;
|
||||
procedure CmdLineCfgRemoveUnused(cfg: TCmdLineCfg);
|
||||
function CmdLineCfgDetect(listofcfg: TList {of TCmdLineCfg}; const Dir, FullPathExec: string): TCmdLineCfg;
|
||||
|
||||
function ReadOutput(const Dir, ExecCommand: String): string;
|
||||
|
||||
// make the Value to be comand-line friendly, by handling CommandLineINvalidChars
|
||||
// quotes would be added, if white-space characters are found
|
||||
// todo: command lines replacement, should be system specific!
|
||||
function CmdLineNormalizeParam(const Value: String): String;
|
||||
|
||||
// parses a command line into a list of arguments
|
||||
// to be compatbile with RTL: ParamStr, ParamCount
|
||||
procedure CmdLineParse(const cmdline: string; arguments : TStrings);
|
||||
function CmdLineToExecutable(const cmdline: String; var Executable: string; Args: TStrings): Boolean;
|
||||
|
||||
procedure CmdLineAllocMultiValues(opt: TCmdLineCfgOption; const SrcValue: string; Delim: Char; dst: TList);
|
||||
|
||||
implementation
|
||||
|
||||
function OverrideIfEmpty(const existingValue, ReplacingValue: string): string;
|
||||
begin
|
||||
if existingValue='' then Result:=ReplacingValue else Result:=existingValue;
|
||||
end;
|
||||
|
||||
function CmdLineCfgOptionCopy(const opt: TCmdLineCfgOption): TCmdLineCfgOption;
|
||||
var
|
||||
i : Integer;
|
||||
begin
|
||||
Result:=TCmdLineCfgOption.Create;
|
||||
Result.Section:=opt.Section;
|
||||
Result.SubSection:=opt.SubSection;
|
||||
Result.Name:=opt.Name;
|
||||
Result.OptType:=opt.OptType;
|
||||
Result.Key:=opt.Key;
|
||||
Result.Display:=opt.Display;
|
||||
Result.Condition:=opt.Condition;
|
||||
Result.ValCount:=opt.ValCount;
|
||||
SetLength(Result.Values, Result.ValCount);
|
||||
for i:=0 to Result.ValCount-1 do begin
|
||||
Result.Values[i].Condition:=opt.Values[i].Condition;
|
||||
Result.Values[i].DisplayName:=opt.Values[i].DisplayName;
|
||||
Result.Values[i].CmdLineValue:=opt.Values[i].DisplayName;
|
||||
end;
|
||||
end;
|
||||
|
||||
function SortByName(p1,p2: Pointer): Integer;
|
||||
var
|
||||
o1, o2: TCmdLineCfgOption;
|
||||
begin
|
||||
o1:=TCmdLineCfgOption(p1);
|
||||
o2:=TCmdLineCfgOption(p2);
|
||||
Result:=CompareStr(o1.Name, o2.Name);
|
||||
end;
|
||||
|
||||
function CmdLineCfgCombine(const ancestor, child: TCmdLineCfg; DoDeleteDashTypes: Boolean = true): Boolean;
|
||||
var
|
||||
i, j : integer;
|
||||
l1,l2 : TList;
|
||||
opt : TCmdLineCfgOption;
|
||||
begin
|
||||
Result:=Assigned(ancestor) and Assigned(child)
|
||||
and (ancestor.Version=child.FromVersion) and (ancestor.Executable=child.Executable);
|
||||
if not Result then Exit;
|
||||
// executable
|
||||
// version
|
||||
// testValue
|
||||
// fromVersion are not inheritable
|
||||
child.TestKey:=OverrideIfEmpty(child.TestKey, ancestor.TestKey);
|
||||
ancestor.Options.Sort(@SortByName);
|
||||
child.Options.Sort(@SortByName);
|
||||
i:=0;
|
||||
j:=0;
|
||||
for i:=0 to ancestor.Options.Count-1 do begin
|
||||
opt:=TCmdLineCfgOption(ancestor.Options[i]);
|
||||
while (j<child.Options.Count) and (CompareStr(opt.Name, TCmdLineCfgOption(child.Options[j]).Name)>0) do
|
||||
inc(j);
|
||||
if (j<child.Options.Count) and (CompareStr(opt.Name, TCmdLineCfgOption(child.Options[j]).Name)<0) then begin
|
||||
child.Options.Add ( CmdLineCfgOptionCopy (opt));
|
||||
end;
|
||||
end;
|
||||
if DoDeleteDashTypes then CmdLineCfgRemoveUnused(child);
|
||||
end;
|
||||
|
||||
procedure CmdLineCfgRemoveUnused(cfg: TCmdLineCfg);
|
||||
var
|
||||
i : Integer;
|
||||
begin
|
||||
for i:=0 to cfg.Options.Count-1 do
|
||||
if TCmdLineCfgOption(cfg.Options[i]).OptType='-' then begin
|
||||
TCmdLineCfgOption(cfg.Options[i]).Free;
|
||||
cfg.Options[i]:=nil;
|
||||
end;
|
||||
cfg.Options.Pack;
|
||||
end;
|
||||
|
||||
function ReadOutput(const Dir, ExecCommand: String): string;
|
||||
var
|
||||
p: TProcess;
|
||||
m: TMemoryStream;
|
||||
BytesRead : Integer;
|
||||
n: INteger;
|
||||
exe : string;
|
||||
const
|
||||
READ_BYTES = 1024;
|
||||
begin
|
||||
Result:='';
|
||||
BytesRead:=0;
|
||||
m:=TMemoryStream.Create;
|
||||
p:=TProcess.Create(nil);
|
||||
try
|
||||
exe:='';
|
||||
if not CmdLineToExecutable(ExecCommand, exe, p.Parameters) then Exit;
|
||||
p.Executable:=exe;
|
||||
p.CurrentDirectory:=Dir;
|
||||
p.Options:=[poUsePipes, poStdErrToOutput];
|
||||
p.Execute;
|
||||
while P.Running do begin
|
||||
if P.Output.NumBytesAvailable>0 then begin
|
||||
if M.Size-M.Position<READ_BYTES then begin
|
||||
M.SetSize(BytesRead + READ_BYTES);
|
||||
end;
|
||||
n := P.Output.Read((M.Memory + BytesRead)^, READ_BYTES);
|
||||
if n > 0 then Inc(BytesRead, n) else Sleep(1);
|
||||
end;
|
||||
end;
|
||||
repeat
|
||||
M.SetSize(BytesRead + READ_BYTES);
|
||||
n := P.Output.Read((M.Memory + BytesRead)^, READ_BYTES);
|
||||
if n > 0 then Inc(BytesRead, n);
|
||||
until n <= 0;
|
||||
if BytesRead > 0 then M.SetSize(BytesRead);
|
||||
M.Position:=0;
|
||||
SetLength(Result, M.Size);
|
||||
if length(Result)>0 then
|
||||
M.Read(Result[1], M.Size);
|
||||
finally
|
||||
p.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function SortByTestKey(c1, c2: TCmdLineCfg {these are actually Pointers in here!}): Integer;
|
||||
begin
|
||||
Result:=CompareStr(c1.TestKey, c2.TestKey);
|
||||
end;
|
||||
|
||||
function CmdLineCfgDetect(listofcfg: TList {of TCmdLineCfg}; const Dir, FullPathExec: string): TCmdLineCfg;
|
||||
var
|
||||
i : integer;
|
||||
cfg : TCmdLineCfg;
|
||||
tk : String;
|
||||
tv : String;
|
||||
search : TList;
|
||||
begin
|
||||
Result:=nil;
|
||||
search:=TList.Create;
|
||||
try
|
||||
tk:='';
|
||||
search.Assign(listofcfg);
|
||||
search.Sort(@SortByTestKey);
|
||||
for i:=0 to listofcfg.Count-1 do begin
|
||||
cfg := TCmdLineCfg(listofcfg[i]);
|
||||
if cfg.TestKey<>tk then begin
|
||||
tk:=cfg.TestKey;
|
||||
tv:=trim(ReadOutput(dir, FullPathExec+' '+tk));
|
||||
end;
|
||||
if cfg.TestValue=tv then begin
|
||||
Result:=cfg;
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
search.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function CmdLineNormalizeParam(const Value: String): String;
|
||||
var
|
||||
i : Integer;
|
||||
const
|
||||
CommandLineInvalidChars : set of Char = ['/','\',':','"','''','?','<','>',' '];
|
||||
begin
|
||||
for i:=0 to length(Value) do
|
||||
if Value[i] in CommandLineInvalidChars then begin
|
||||
//todo!
|
||||
Result:='"'+Result+'"';
|
||||
Exit;
|
||||
end;
|
||||
Result:=Value;
|
||||
end;
|
||||
|
||||
|
||||
function CmdLineToExecutable(const cmdline: String; var Executable: string;
|
||||
Args: TStrings): Boolean;
|
||||
var
|
||||
a : TStringList;
|
||||
begin
|
||||
a:=TStringList.Create;
|
||||
try
|
||||
CmdLineParse(cmdline, a);
|
||||
Result:=a.Count>0;
|
||||
if Result then begin
|
||||
Executable:=a[0];
|
||||
a.Delete(0);
|
||||
Args.Assign(a);
|
||||
end;
|
||||
finally
|
||||
a.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure CmdLineParse(const cmdline: string; arguments : TStrings);
|
||||
var
|
||||
i : integer;
|
||||
j : integer;
|
||||
isprm : Boolean;
|
||||
p : string;
|
||||
const
|
||||
WhiteSpace : set of char = [#32,#9,#8,#13,#10];
|
||||
QuoteChar = '"'; // yeah! be academic!
|
||||
begin
|
||||
if not Assigned(arguments) then eXit;
|
||||
j:=1;
|
||||
i:=1;
|
||||
isprm:=false;
|
||||
p:='';
|
||||
while i<=length(cmdline) do begin
|
||||
if not (cmdline[i] in WhiteSpace) then begin
|
||||
if not isprm then j:=i;
|
||||
if cmdline[i]=QuoteChar then begin
|
||||
p:=p+Copy(cmdline, j, i-j);
|
||||
inc(i);
|
||||
j:=i;
|
||||
while (i<=length(cmdline)) and (cmdline[i]<>'"') do
|
||||
inc(i);
|
||||
p:=p+Copy(cmdline, j, i-j);
|
||||
j:=i+1;
|
||||
end;
|
||||
isprm:=true;
|
||||
end else if isprm then begin
|
||||
arguments.Add(p+Copy(cmdline, j, i-j));
|
||||
isprm:=false;
|
||||
p:='';
|
||||
end;
|
||||
inc(i);
|
||||
end;
|
||||
if isprm then arguments.Add(p+Copy(cmdline, j, i-j));
|
||||
end;
|
||||
|
||||
procedure CmdLineAllocMultiValues(opt: TCmdLineCfgOption; const SrcValue: string; Delim: Char; dst: TList);
|
||||
var
|
||||
i, j : Integer;
|
||||
vl : TCmdLineOptionValue;
|
||||
v : string;
|
||||
begin
|
||||
if not Assigned(opt) or not Assigned(dst) or (SrcValue='') then Exit;
|
||||
i:=1; j:=1;
|
||||
while i<=length(SrcValue) do begin
|
||||
if SrcValue[i]=Delim then begin
|
||||
v:=Trim(Copy(SrcValue, j, i-j));
|
||||
j:=i+1;
|
||||
if v<>'' then dst.Add( TCmdLineOptionValue.Create(opt, v));
|
||||
end;
|
||||
inc(i);
|
||||
end;
|
||||
if j<i then begin
|
||||
v:=Trim(Copy(SrcValue, j, i-j));
|
||||
j:=i+1;
|
||||
if v<>'' then dst.Add( TCmdLineOptionValue.Create(opt, v));
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user