{$mode objfpc} {$h+} unit pkgglobals; interface uses SysUtils, Classes; Const {$ifdef unix} ExeExt = ''; AllFiles='*'; {$else unix} ExeExt = '.exe'; AllFiles='*.*'; {$endif unix} Type TVerbosity = (vError,vWarning,vInfo,vCommands,vDebug); TVerbosities = Set of TVerbosity; EPackagerError = class(Exception); // Logging Function StringToVerbosity (S : String) : TVerbosity; Function VerbosityToString (V : TVerbosity): String; Procedure Log(Level: TVerbosity;Msg : String); Procedure Log(Level: TVerbosity;Fmt : String; const Args : array of const); Procedure Error(Msg : String); Procedure Error(Fmt : String; const Args : array of const); // Utils function maybequoted(const s:string):string; Function FixPath(const S : String) : string; Procedure DeleteDir(const ADir:string); Procedure SearchFiles(SL:TStringList;const APattern:string); Function GetCompilerInfo(const ACompiler,AOptions:string):string; var Verbosity : TVerbosities; Implementation uses typinfo, process, contnrs, uriparser, pkgmessages; function StringToVerbosity(S: String): TVerbosity; Var I : integer; begin I:=GetEnumValue(TypeInfo(TVerbosity),'v'+S); If (I<>-1) then Result:=TVerbosity(I) else Raise EPackagerError.CreateFmt(SErrInvalidVerbosity,[S]); end; Function VerbosityToString (V : TVerbosity): String; begin Result:=GetEnumName(TypeInfo(TVerbosity),Integer(V)); Delete(Result,1,1);// Delete 'v' end; procedure Log(Level:TVerbosity;Msg: String); var Prefix : string; begin if not(Level in Verbosity) then exit; Prefix:=''; if Level=vWarning then Prefix:=SWarning; Writeln(stdErr,Prefix,Msg); end; Procedure Log(Level:TVerbosity; Fmt:String; const Args:array of const); begin Log(Level,Format(Fmt,Args)); end; procedure Error(Msg: String); begin Raise EPackagerError.Create(Msg); end; procedure Error(Fmt: String; const Args: array of const); begin Raise EPackagerError.CreateFmt(Fmt,Args); end; function maybequoted(const s:string):string; const {$IFDEF MSWINDOWS} FORBIDDEN_CHARS = ['!', '@', '#', '$', '%', '^', '&', '*', '(', ')', '{', '}', '''', '`', '~']; {$ELSE} FORBIDDEN_CHARS = ['!', '@', '#', '$', '%', '^', '&', '*', '(', ')', '{', '}', '''', ':', '\', '`', '~']; {$ENDIF} var s1 : string; i : integer; quoted : boolean; begin quoted:=false; s1:='"'; for i:=1 to length(s) do begin case s[i] of '"' : begin quoted:=true; s1:=s1+'\"'; end; ' ', #128..#255 : begin quoted:=true; s1:=s1+s[i]; end; else begin if s[i] in FORBIDDEN_CHARS then quoted:=True; s1:=s1+s[i]; end; end; end; if quoted then maybequoted:=s1+'"' else maybequoted:=s; end; Function FixPath(const S : String) : string; begin If (S<>'') then Result:=IncludeTrailingPathDelimiter(S) else Result:=''; end; Procedure DeleteDir(const ADir:string); var Info : TSearchRec; begin if FindFirst(ADir+PathDelim+AllFiles,faAnyFile, Info)=0 then try repeat if (Info.Attr and faDirectory)=faDirectory then begin if (Info.Name<>'.') and (Info.Name<>'..') then DeleteDir(ADir+PathDelim+Info.Name) end else DeleteFile(ADir+PathDelim+Info.Name); until FindNext(Info)<>0; finally FindClose(Info); end; end; Procedure SearchFiles(SL:TStringList;const APattern:string); var Info : TSearchRec; ADir : string; begin ADir:=ExtractFilePath(APattern); if FindFirst(APattern,faAnyFile, Info)=0 then try repeat if (Info.Attr and faDirectory)=faDirectory then begin if (Info.Name<>'.') and (Info.Name<>'..') then SearchFiles(SL,ADir+Info.Name+PathDelim+ExtractFileName(APattern)) end; SL.Add(ADir+Info.Name); until FindNext(Info)<>0; finally FindClose(Info); end; end; Function GetCompilerInfo(const ACompiler,AOptions:string):string; Const BUFSIZE=1024; Var S : TProcess; Buf : Array[0..BUFSIZE-1] of char; Count : longint; begin S:=TProcess.Create(Nil); S.Commandline:=ACOmpiler+' '+AOptions; S.Options:=[poUsePipes,poNoConsole]; S.execute; Count:=s.output.read(buf,BufSize); SetLength(Result,Count); Move(Buf,Result[1],Count); S.Free; end; end.