program Pas2jsReleaseCreator; {$mode objfpc}{$H+} uses {$IFDEF UNIX} cthreads, {$ENDIF} Classes, SysUtils, Types, CustApp, IniFiles, process, FindWriteln, PRCUtils; const DefaultCfgFilename = 'pas2jsrelease.ini'; type TGetDefaultEvent = function(): string of object; { TPas2jsReleaseCreator } TPas2jsReleaseCreator = class(TCustomApplication) protected procedure DoLog(EventType: TEventType; const Msg: String); override; procedure DoRun; override; procedure Err(const Msg: string); public BuildDir: string; BuildDir_Sources: string; BuildDir_Bin: string; CfgFilename: string; FPCReleaseFilename: string; // released compiler binary FPCDevelFilename: string; // development compiler binary FPC2Filename: string; // optional second compiler for a second libpas2js FPC2TargetCPU: string; FPC2TargetOS: string; Ini: TIniFile; GitFilename: string; // 'git' binary MakeFilename: string; // 'make' binary ZipFilename: string; // 'zip' binary Pas2jsVersion: string; Simulate: boolean; SourceDir: string; // cloned git release FPCSrcDir: string; Verbosity: integer; constructor Create(TheOwner: TComponent); override; destructor Destroy; override; procedure WriteHelp; virtual; procedure ReadPas2jsVersion; procedure CheckForgottenWriteln; procedure ParseFPCTargetOption(const LongOpt: string; out TargetCPU, TargetOS: string); procedure CleanSources; procedure CreateBuildSourceDir(const TargetOS, TargetCPU: string); procedure BuildTools(const TargetOS, TargetCPU: string); procedure CopySourceFolders; procedure CopyRTLjs; procedure CreatePas2jsCfg; procedure CreateZip; procedure RunTool(WorkDir, Exe: string; const ProcParams: TStringDynArray); overload; procedure RunTool(WorkDir, Exe: string; ProcParams: TStringList); overload; procedure ForceDir(Dir, DirTitle: string); function Quote(const s: string): string; function GetDefaultCfgFilename: string; function GetDefaultBuildDir: string; function GetDefaultTool(const Filename: string; Expanded: boolean): string; function GetDefaultGit: string; function GetDefaultMake: string; function GetDefaultZip: string; function GetOption_String(ShortOption: char; const LongOption: string): string; function GetOption_Directory(ShortOption: char; const LongOption: string; const GetDefaultFunc: TGetDefaultEvent): string; function GetOption_Executable(ShortOption: char; const LongOption: string; const GetDefaultFunc: TGetDefaultEvent): string; procedure CheckExecutable(const Filename, ParamName: string); end; { TPas2jsReleaseCreator } procedure TPas2jsReleaseCreator.DoLog(EventType: TEventType; const Msg: String); begin case EventType of etInfo: write('Info: '); etWarning: write('Warning: '); etError: write('Error: '); etDebug: write('Debug: '); else write('Custom: '); end; writeln(Msg); end; procedure TPas2jsReleaseCreator.DoRun; var ErrorMsg: String; TargetOS, TargetCPU: String; begin // quick check parameters ErrorMsg:=CheckOptions('hb:c:s:l:qvx', ['help', 'config:', 'builddir:', 'sourcedir:', 'quiet', 'verbose', 'execute', 'fpcrelease:', 'fpcdevel:', 'fpcdir:', 'fpc2:', 'fpc2target:', 'git:', 'make:', 'zip:']); if ErrorMsg<>'' then Err(ErrorMsg); // parse basic parameters if HasOption('h', 'help') then begin WriteHelp; Terminate; Exit; end; Simulate:=true; if HasOption('q','quiet') then dec(Verbosity); if HasOption('v','verbose') then inc(Verbosity); // read config file if HasOption('c','config') then begin CfgFilename:=ExpandFileName(GetOptionValue('c','config')); if not FileExists(CfgFilename) then Err('Config file not found: "'+CfgFilename+'"'); end else begin CfgFilename:=GetDefaultCfgFilename; end; if FileExists(CfgFilename) then begin if Verbosity>=0 then Log(etInfo,'Reading config file "'+CfgFilename+'" ...'); Ini:=TIniFile.Create(CfgFilename); end; BuildDir:=GetOption_Directory('b','builddir',@GetDefaultBuildDir); SourceDir:=GetOption_Directory('s','sourcedir',nil); if SourceDir='' then Err('missing source directory'); FPCSrcDir:=GetOption_Directory(' ','fpcdir',nil); FPCReleaseFilename:=GetOption_Executable(' ','fpcrelease',nil); FPCDevelFilename:=GetOption_Executable(' ','fpcdevel',nil); FPC2Filename:=GetOption_Executable(' ','fpc2',nil); ParseFPCTargetOption('fpc2target',FPC2TargetCPU,FPC2TargetOS); GitFilename:=GetOption_Executable(' ','git',@GetDefaultGit); MakeFilename:=GetOption_Executable(' ','make',@GetDefaultMake); ZipFilename:=GetOption_Executable(' ','zip',@GetDefaultZip); if FPCSrcDir='' then begin FPCSrcDir:=GetEnvironmentVariable('FPCDIR'); if FPCSrcDir<>'' then FPCSrcDir:=AppendPathDelim(ExpandFileName(FPCSrcDir)); end; if FPCSrcDir='' then FPCSrcDir:=SourceDir+'compiler'+PathDelim; // write options if Verbosity>=0 then begin Log(etInfo,'SourceDir: "'+SourceDir+'"'); Log(etInfo,'BuildDir: "'+BuildDir+'"'); Log(etInfo,'FPCDir: "'+FPCSrcDir+'"'); Log(etInfo,'FPCRelease: "'+FPCReleaseFilename+'"'); Log(etInfo,'FPCDevel: "'+FPCDevelFilename+'"'); Log(etInfo,'FPC2: "'+FPC2Filename+'"'); Log(etInfo,'FPC2Target: "'+FPC2TargetCPU+'-'+FPC2TargetOS+'"'); Log(etInfo,'git: "'+GitFilename+'"'); Log(etInfo,'make: "'+MakeFilename+'"'); Log(etInfo,'zip: "'+ZipFilename+'"'); end; if HasOption('x','execute') then Simulate:=false else Log(etInfo,'Simulating...'); // preflight checks if not DirectoryExists(BuildDir) then Err('BuildDir missing: "'+BuildDir+'"'); if not DirectoryExists(SourceDir) then Err('SourceDir missing: "'+SourceDir+'"'); if not DirectoryExists(FPCSrcDir) then Err('FPCDir missing: "'+FPCSrcDir+'"'); CheckExecutable(FPCReleaseFilename,'fpcrelease'); CheckExecutable(FPCDevelFilename,'fpcdevel'); if FPC2Filename<>'' then CheckExecutable(FPC2Filename,'fpc2'); CheckExecutable(GitFilename,'git'); CheckExecutable(MakeFilename,'make'); CheckExecutable(ZipFilename,'zip'); ReadPas2jsVersion; CheckForgottenWriteln; // build CleanSources; TargetOS:=GetCompiledTargetOS; TargetCPU:=GetCompiledTargetCPU; CreateBuildSourceDir(TargetOS,TargetCPU); BuildTools(TargetOS,TargetCPU); CopySourceFolders; CopyRTLjs; CreatePas2jsCfg; CreateZip; // stop program loop Terminate; end; procedure TPas2jsReleaseCreator.Err(const Msg: string); begin Log(etError,Msg); Halt(1); end; constructor TPas2jsReleaseCreator.Create(TheOwner: TComponent); begin inherited Create(TheOwner); StopOnException:=True; end; destructor TPas2jsReleaseCreator.Destroy; begin FreeAndNil(Ini); inherited Destroy; end; procedure TPas2jsReleaseCreator.WriteHelp; begin writeln('Usage: ', ExeName, ' -h'); writeln; writeln('-h, --help: Write this help and exit'); writeln; writeln('Required parameters:'); writeln('-s , --sourcedir=: git directory of the pas2js release'); writeln('--fpcdir=: Path of fpc devel sources.'); writeln(' Used for compiling pas2js and libpas2js.'); writeln('--fpcrelease=: Path of released version fpc executable.'); writeln(' Used for compiling pas2js and libpas2js.'); writeln('--fpcdevel=: Path of development version fpc executable.'); writeln(' Used for compiling the other tools.'); writeln('--fpc2=: Path of a secondary fpc for building a second libpas2js.'); writeln('--fpc2target=-: Target CPU and OS for fpc2.'); writeln('-x, --execute: Do not simulate, execute the commands'); writeln; writeln('Optional parameters:'); writeln('-q, --quiet: Less verbose'); writeln('-v, --verbose: More verbose'); writeln('-c , --config=: Path of ini file with a Main section.'); writeln(' Default: '+GetDefaultCfgFilename); writeln('-b , --builddir=: Output directory where to build the zip.'); writeln(' Default: '+GetDefaultBuildDir); writeln('--git=: Path of gnu make executable.'); writeln(' Default: '+GetDefaultGit); writeln('--make=: Path of gnu make executable.'); writeln(' Default: '+GetDefaultMake); writeln('--zip=: Path of zip executable.'); writeln(' Default: '+GetDefaultZip); writeln; end; procedure TPas2jsReleaseCreator.ReadPas2jsVersion; function CheckPascalConstInt(const Line, Identifier: string; var aValue: integer): boolean; var s: String; p, StartP: SizeInt; begin Result:=false; s:=' '+Identifier+' = '; if not SameText(LeftStr(Line,length(s)),s) then exit; p:=length(s)+1; StartP:=p; aValue:=0; while (p<=length(Line)) and (Line[p] in ['0'..'9']) do begin aValue:=aValue*10+ord(Line[p])-ord('0'); inc(p); end; Result:=p>StartP; end; function CheckJSConstInt(const Line, Identifier: string; var aValue: integer): boolean; var s: String; p, StartP: SizeInt; begin Result:=false; s:=' '+Identifier+': '; if LeftStr(Line,length(s))<>s then exit; p:=length(s)+1; StartP:=p; aValue:=0; while (p<=length(Line)) and (Line[p] in ['0'..'9']) do begin aValue:=aValue*10+ord(Line[p])-ord('0'); inc(p); end; Result:=p>StartP; end; type TVersionPart = (vMajor,vMinor,vRelease); const PartNames: array[TVersionPart] of string = ('VersionMajor','VersionMinor','VersionRelease'); var Filename, Line: String; sl: TStringList; i, JSVersion: Integer; Parts: array[TVersionPart] of integer; PartFound: array[TVersionPart] of boolean; p: TVersionPart; begin sl:=TStringList.Create; try // read pas2js version number from Pascal sources Filename:=FPCSrcDir+SetDirSeparators('packages/pastojs/src/pas2jscompiler.pp'); if Verbosity>0 then Log(etInfo,'Reading version from "'+Filename+'" ...'); if not FileExists(Filename) then Err('Missing source file: "'+Filename+'"'); sl.LoadFromFile(Filename); // parse source and find all three version constants for p in TVersionPart do begin Parts[p]:=-1; PartFound[p]:=false; end; for i:=0 to sl.Count-1 do begin Line:=sl[i]; for p in TVersionPart do if not PartFound[p] then PartFound[p]:=CheckPascalConstInt(Line,PartNames[p],Parts[p]); if PartFound[High(TVersionPart)] then begin // last constant found if Verbosity>0 then Log(etInfo,'Found const '+PartNames[High(TVersionPart)]+' = '+IntToStr(Parts[High(TVersionPart)])); break; end; end; for p in TVersionPart do if not PartFound[p] then Err('Missing '+PartNames[p]+' in "'+Filename+'"'); // one constant missing Pas2jsVersion:=IntToStr(Parts[vMajor])+'.'+IntToStr(Parts[vMinor])+'.'+IntToStr(Parts[vRelease]); if Verbosity>=0 then Log(etInfo,'Pas2js version is '+Pas2jsVersion); // read version number from rtl.js Filename:=FPCSrcDir+SetDirSeparators('utils/pas2js/dist/rtl.js'); if Verbosity>0 then Log(etInfo,'Reading version from "'+Filename+'" ...'); if not FileExists(Filename) then Err('Missing source file: "'+Filename+'"'); sl.LoadFromFile(Filename); JSVersion:=-1; for i:=0 to sl.Count-1 do begin Line:=sl[i]; if CheckJSConstInt(Line,'version',JSVersion) then break; end; if JSVersion<0 then Err('Missing version in "'+Filename+'"'); i:=(Parts[vMajor]*100+Parts[vMinor])*100+Parts[vRelease]; if i<>JSVersion then Err('Expected version '+IntToStr(i)+', but found '+IntToStr(JSVersion)+' in "'+Filename+'"'); finally sl.Free; end; end; procedure TPas2jsReleaseCreator.CheckForgottenWriteln; procedure Check(const SrcDir: string); begin if not DirectoryExists(SrcDir) then Err('Missing dource directory: "'+SrcDir+'"'); if Verbosity>=0 then Log(etInfo,'Checking for forgotten writeln: '+SrcDir+' ...'); FindWritelnInDirectory(SrcDir,false,@DoLog); end; begin Check(FPCSrcDir+'packages'+PathDelim+'fcl-js'+PathDelim+'src'); Check(FPCSrcDir+'packages'+PathDelim+'fcl-json'+PathDelim+'src'); Check(FPCSrcDir+'packages'+PathDelim+'fcl-passrc'+PathDelim+'src'); Check(FPCSrcDir+'packages'+PathDelim+'pastojs'+PathDelim+'src'); Check(FPCSrcDir+'utils'+PathDelim+'pas2js'); end; procedure TPas2jsReleaseCreator.ParseFPCTargetOption(const LongOpt: string; out TargetCPU, TargetOS: string); var Opt: String; p: SizeInt; begin TargetOS:=''; TargetCPU:=''; Opt:=lowercase(GetOption_String(' ',LongOpt)); if Opt='' then exit; p:=Pos('-',Opt); if p<1 then Err('Expected TargetCPU-TargetOS, but found "--'+LongOpt+'='+Opt+'"'); TargetCPU:=LeftStr(Opt,p-1); TargetOS:=copy(Opt,p+1,length(Opt)); end; procedure TPas2jsReleaseCreator.CleanSources; procedure Clean(Dir: string); var Info: TRawByteSearchRec; Ext, Filename: String; begin Dir:=AppendPathDelim(Dir); if FindFirst(Dir+AllFilesMask,faAnyFile,Info)=0 then begin repeat if (Info.Name='') or (Info.Name='.') or (Info.Name='..') then continue; if (Info.Attr and faDirectory)>0 then begin Clean(Dir+Info.Name); end else begin Ext:=lowercase(ExtractFileExt(Info.Name)); case Ext of '.ppu','.o','.rsj','.lib','.dylib': begin Filename:=Dir+Info.Name; if Simulate then begin if Verbosity>0 then Log(etInfo,'Simulate Deleting "'+Filename+'"'); end else begin if DeleteFile(Filename) then begin if Verbosity>0 then Log(etInfo,'Deleted "'+Filename+'"'); end else begin Err('Unable to delete "'+Filename+'"'); end; end; end; end; end; until FindNext(Info)<>0; FindClose(Info); end; end; begin // make clean RunTool(SourceDir,MakeFilename,['clean']); // delete files Clean(SourceDir+'packages'); Clean(SourceDir+'demo'); Clean(SourceDir+'tools'); end; procedure TPas2jsReleaseCreator.CreateBuildSourceDir(const TargetOS, TargetCPU: string); begin BuildDir_Sources:=BuildDir+'pas2js-'+TargetOS+'-'+TargetCPU+'-'+Pas2jsVersion; if DirectoryExists(BuildDir_Sources) then begin if Simulate then begin if Verbosity>=0 then Log(etInfo,'Simulate: Deleting directory "'+BuildDir_Sources+'"'); end else begin if Verbosity>=0 then Log(etInfo,'Deleting directory "'+BuildDir_Sources+'"'); if not DeleteDirectory(BuildDir_Sources,false) then Err('Unable to delete directory "'+BuildDir_Sources+'"'); end; end; if Simulate then begin Log(etInfo,'Simulate: Creating directory "'+BuildDir_Sources+'"') end else begin if not ForceDirectory(BuildDir_Sources) then Err('Unable to create directory "'+BuildDir_Sources+'"'); Log(etInfo,'Created directory "'+BuildDir_Sources+'"') end; BuildDir_Sources+=PathDelim; BuildDir_Bin:=BuildDir_Sources+'bin'; if not ForceDirectory(BuildDir_Bin) then Err('Unable to create directory "'+BuildDir_Bin+'"'); BuildDir_Bin+=PathDelim; end; procedure TPas2jsReleaseCreator.BuildTools(const TargetOS, TargetCPU: string); var WorkDir, PkgSrcDir, UnitOutDir, CurBinDir: String; SharedParams, TheParams: TStringList; begin SharedParams:=TStringList.Create; TheParams:=TStringList.Create; try WorkDir:=FPCSrcDir+'utils'+PathDelim+'pas2js'; PkgSrcDir:=FPCSrcDir+'packages'+PathDelim; SharedParams.Add('-Fu'+PkgSrcDir+'fcl-js'+PathDelim+'src'); SharedParams.Add('-Fu'+PkgSrcDir+'fcl-json'+PathDelim+'src'); SharedParams.Add('-Fu'+PkgSrcDir+'fcl-passrc'+PathDelim+'src'); SharedParams.Add('-Fu'+PkgSrcDir+'pastojs'+PathDelim+'src'); SharedParams.Add('-Fu'+PkgSrcDir+'fcl-web'+PathDelim+'src'+PathDelim+'base'); SharedParams.Add('-B'); SharedParams.Add('-MObjFPC'); SharedParams.Add('-O1'); SharedParams.Add('-Schi'); SharedParams.Add('-vew'); SharedParams.Add('-XX'); SharedParams.Add('-Xs'); UnitOutDir:=SourceDir+'units'+PathDelim+TargetCPU+'-'+TargetOS; ForceDir(UnitOutDir,'unit output'); SharedParams.Add('-FU'+UnitOutDir); // compile pas2js exe using release fpc TheParams.Assign(SharedParams); TheParams.Add('-o'+BuildDir_Bin+'pas2js'+GetExeExt); TheParams.Add('pas2js.pp'); RunTool(WorkDir,FPCReleaseFilename,TheParams); // compile libpas2js using release fpc TheParams.Assign(SharedParams); if SameText(TargetOS,'linux') then TheParams.Add('-fPIC'); TheParams.Add('-o'+BuildDir_Bin+'libpas2js'+GetLibExt(TargetOS)); TheParams.Add('pas2jslib.pp'); RunTool(WorkDir,FPCReleaseFilename,TheParams); if FPC2Filename<>'' then begin // compile second libpas2js CurBinDir:=BuildDir_Bin+FPC2TargetCPU+'-'+FPC2TargetOS+PathDelim; ForceDir(CurBinDir,'sub folder for second libpas2js'); TheParams.Assign(SharedParams); if SameText(FPC2TargetOS,'linux') then TheParams.Add('-fPIC'); TheParams.Add('-o'+CurBinDir+'libpas2js'+GetLibExt(TargetOS)); TheParams.Add('-P'+FPC2TargetCPU); TheParams.Add('-T'+FPC2TargetOS); TheParams.Add('pas2jslib.pp'); RunTool(WorkDir,FPC2Filename,TheParams); end; // compile compileserver using devel fpc TheParams.Assign(SharedParams); TheParams.Add('-o'+BuildDir_Bin+'compileserver'+GetExeExt); TheParams.Add('compileserver.pp'); RunTool(WorkDir,FPCDevelFilename,TheParams); // compile webidl2pas using devel fpc TheParams.Assign(SharedParams); TheParams.Add('-o'+BuildDir_Bin+'webidl2pas'+GetExeExt); TheParams.Add('webidl2pas.pp'); RunTool(WorkDir,FPCDevelFilename,TheParams); // compile makestub using devel fpc TheParams.Assign(SharedParams); TheParams.Add('-o'+BuildDir_Bin+'makestub'+GetExeExt); TheParams.Add('makestub.pp'); RunTool(WorkDir,FPCDevelFilename,TheParams); finally TheParams.Free; SharedParams.Free; end; end; procedure TPas2jsReleaseCreator.CopySourceFolders; procedure CopyFolder(const Dir: string); var SrcDir, DestDir: String; begin SrcDir:=SourceDir+Dir; DestDir:=BuildDir_Sources+Dir; if not DirectoryExists(SrcDir) then Err('Unable to copy missing source folder "'+SrcDir+'"'); // git restore SrcDir RunTool(SourceDir,GitFilename,['restore',SrcDir]); // copy if Simulate then begin Log(etInfo,'Simulate: Copying folder "'+SrcDir+'" -> "'+DestDir+'"'); end else begin Log(etInfo,'Copying folder "'+SrcDir+'" -> "'+DestDir+'"'); CopyDirTree(SrcDir,DestDir,[cffCreateDestDirectory,cffPreserveTime,cffExceptionOnError]); end; end; var Info: TRawByteSearchRec; begin CopyFolder('demo'); CopyFolder('packages'); // copy all tools except releasecreator if not Simulate then begin if not CreateDir(BuildDir_Sources+'tools') then Err('Unable to create directory: '+BuildDir_Sources+'tools'); end; if FindFirst(SourceDir+'tools'+PathDelim+AllFilesMask,faAnyFile,Info)=0 then begin repeat if (Info.Name='') or (Info.Name='.') or (Info.Name='..') then continue; if (Info.Name='releasecreator') then continue; if (Info.Attr and faDirectory)>0 then begin CopyFolder('tools'+PathDelim+Info.Name); end until FindNext(Info)<>0; FindClose(Info); end; end; procedure TPas2jsReleaseCreator.CopyRTLjs; var SrcFilename, DestFilename: String; begin SrcFilename:=FPCSrcDir+SetDirSeparators('utils/pas2js/dist/rtl.js'); DestFilename:=BuildDir_Sources+SetDirSeparators('packages/rtl/src/rtl.js'); if Simulate then begin Log(etInfo,'Simulate: Copying "'+SrcFilename+'" -> "'+DestFilename+'"'); end else begin Log(etInfo,'Copying "'+SrcFilename+'" -> "'+DestFilename+'"'); CopyFile(SrcFilename,DestFilename,[cffOverwriteFile,cffPreserveTime,cffExceptionOnError]); end; end; procedure TPas2jsReleaseCreator.CreatePas2jsCfg; var Dir, SrcFilename, ExeFilename, Pas2jsCfgFilename: String; NeedBuild: Boolean; begin // build createconfig Dir:=SourceDir+SetDirSeparators('tools/createconfig/'); SrcFilename:=Dir+'createconfig.pp'; ExeFilename:=Dir+'createconfig'+GetExeExt; if not FileExists(SrcFilename) then Err('File not found: "'+SrcFilename+'"'); NeedBuild:=true; if not FileExists(ExeFilename) then log(etInfo,'Missing tool createconfig, building ...') else if FileAge(SrcFilename)>FileAge(ExeFilename) then log(etInfo,'createconfig.pp changed, building ...') else NeedBuild:=false; if NeedBuild then begin RunTool(Dir,FPCReleaseFilename,['-O1','Schi','-vew','-XX','-Xs','createconfig.pp']); end; // run createconfig Pas2jsCfgFilename:=BuildDir_Bin+'pas2js.cfg'; if Simulate then begin Log(etInfo,'Simulate: run createconfig to create "'+Pas2jsCfgFilename+'"'); end else begin RunTool(Dir,ExeFilename,[Pas2jsCfgFilename,'..']); end; end; procedure TPas2jsReleaseCreator.CreateZip; var Dir, Filename, s: String; begin if not DirectoryExists(BuildDir_Sources) then Err('TPas2jsReleaseCreator.CreateZip: Empty BuildDir_Sources'); Dir:=ExtractFilename(ChompPathDelim(BuildDir_Sources)); Filename:=BuildDir+Dir+'.zip'; if FileExists(Filename) and not Simulate then if not DeleteFile(Filename) then Err('Unable to delete "'+Filename+'"'); RunTool(BuildDir,ZipFilename,['-r',Filename,Dir]); s:=IntToStr(FileSize(Filename)); if Simulate then Log(etInfo,'Simulate: Created '+Filename+' Size='+s) else Log(etInfo,'Created '+Filename+' Size='+s); end; procedure TPas2jsReleaseCreator.RunTool(WorkDir, Exe: string; const ProcParams: TStringDynArray); var sl: TStringList; i: Integer; begin sl:=TStringList.Create; try for i:=0 to length(ProcParams)-1 do sl.Add(ProcParams[i]); RunTool(WorkDir,Exe,sl); finally sl.Free; end; end; procedure TPas2jsReleaseCreator.RunTool(WorkDir, Exe: string; ProcParams: TStringList); var TheProcess: TProcess; i, OutLen, LineStart: Integer; OutputLine, buf, CmdLine: String; begin WorkDir:=ChompPathDelim(WorkDir); if not FileIsExecutable(Exe) then Err('Not an executable: '+Exe); if DirectoryExists(Exe) then Err('Not an executable: '+Exe); if (not Simulate) and (not DirectoryExists(WorkDir)) then Err('Workdir missing: '+WorkDir); TheProcess:=TProcess.Create(nil); try TheProcess.Executable := Exe; TheProcess.Parameters := ProcParams; TheProcess.Options := [poUsePipes, poStdErrToOutput]; TheProcess.ShowWindow := swoHide; TheProcess.CurrentDirectory := WorkDir; CmdLine:=Quote(Exe); for i:=0 to ProcParams.Count-1 do CmdLine+=' '+Quote(ProcParams[i]); if Simulate then begin Log(etInfo,'Simulate: Running: WorkDir="'+WorkDir+'" Cmd: '+CmdLine); exit; end; Log(etInfo,'Running: WorkDir="'+WorkDir+'" Cmd: '+CmdLine); TheProcess.Execute; OutputLine:=''; SetLength(buf{%H-},4096); repeat if (TheProcess.Output<>nil) then begin OutLen:=TheProcess.Output.Read(Buf[1],length(Buf)); end else OutLen:=0; LineStart:=1; i:=1; while i<=OutLen do begin if Buf[i] in [#10,#13] then begin OutputLine:=OutputLine+copy(Buf,LineStart,i-LineStart); writeln(OutputLine); OutputLine:=''; if (iBuf[i+1]) then inc(i); LineStart:=i+1; end; inc(i); end; OutputLine:=OutputLine+copy(Buf,LineStart,OutLen-LineStart+1); until OutLen=0; if OutputLine<>'' then writeln(OutputLine); TheProcess.WaitOnExit; if TheProcess.ExitStatus<>0 then Err('ExitStatus: '+IntToStr(TheProcess.ExitStatus)); if TheProcess.ExitCode<>0 then Err('ExitCode: '+IntToStr(TheProcess.ExitCode)); finally TheProcess.Free; end; end; procedure TPas2jsReleaseCreator.ForceDir(Dir, DirTitle: string); begin Dir:=ChompPathDelim(Dir); if DirectoryExists(Dir) then exit; if Simulate then exit; if ForceDirectories(Dir) then exit; Err('Unable to create '+DirTitle+' directory "'+Dir+'"'); end; function TPas2jsReleaseCreator.Quote(const s: string): string; begin Result:=s; if Pos(' ',Result)<1 then exit; Result:=QuotedStr(s); end; function TPas2jsReleaseCreator.GetDefaultCfgFilename: string; begin Result:=ExpandFileName(DefaultCfgFilename); end; function TPas2jsReleaseCreator.GetDefaultBuildDir: string; begin Result:=AppendPathDelim(ExpandFileName(GetTempDir(false))); end; function TPas2jsReleaseCreator.GetDefaultTool(const Filename: string; Expanded: boolean): string; begin Result:=Filename; if Expanded then begin if FilenameIsAbsolute(Result) then exit; if ExtractFilePath(Result)<>'' then exit; Result:=FindDefaultExecutablePath(Result); if Result='' then Result:=Filename; end; end; function TPas2jsReleaseCreator.GetDefaultGit: string; begin Result:=GetDefaultTool('git'+GetExeExt,true); end; function TPas2jsReleaseCreator.GetDefaultMake: string; begin Result:=GetDefaultTool('make'+GetExeExt,true); end; function TPas2jsReleaseCreator.GetDefaultZip: string; begin Result:=GetDefaultTool('zip'+GetExeExt,true); end; function TPas2jsReleaseCreator.GetOption_String(ShortOption: char; const LongOption: string): string; begin if ShortOption<=' ' then begin if HasOption(LongOption) then begin Result:=GetOptionValue(LongOption); exit; end; end else begin if HasOption(ShortOption,LongOption) then begin Result:=GetOptionValue(ShortOption,LongOption); exit; end; end; if Ini<>nil then begin Result:=Ini.ReadString('Main',LongOption,''); exit; end; Result:=''; end; function TPas2jsReleaseCreator.GetOption_Directory(ShortOption: char; const LongOption: string; const GetDefaultFunc: TGetDefaultEvent): string; begin Result:=GetOption_String(ShortOption,LongOption); if (Result='') and Assigned(GetDefaultFunc) then Result:=GetDefaultFunc(); if Result<>'' then Result:=AppendPathDelim(ExpandFileName(Result)); end; function TPas2jsReleaseCreator.GetOption_Executable(ShortOption: char; const LongOption: string; const GetDefaultFunc: TGetDefaultEvent): string; begin if ShortOption<=' ' then Result:=GetOption_String(ShortOption,LongOption) else Result:=GetOption_String(ShortOption,LongOption); if (Result='') and Assigned(GetDefaultFunc) then Result:=GetDefaultFunc(); if Result='' then exit; if FilenameIsAbsolute(Result) then exit; if ExtractFilePath(Result)<>'' then Result:=ExpandFileName(Result) else if Result<>'' then Result:=FindDefaultExecutablePath(Result); end; procedure TPas2jsReleaseCreator.CheckExecutable(const Filename, ParamName: string); begin if Filename='' then Err('Missing parameter '+ParamName); if not FileExists(Filename) then Err('File '+ParamName+' not found: "'+Filename+'"'); if not FileIsExecutable(Filename) then Err('File '+ParamName+' not executable: "'+Filename+'"'); end; var Application: TPas2jsReleaseCreator; begin Application:=TPas2jsReleaseCreator.Create(nil); Application.Title:='Pas2js Release Creator'; Application.Run; Application.Free; end.