123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875 |
- 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 <filename>, --sourcedir=<filename>: git directory of the pas2js release');
- writeln('--fpcdir=<filename>: Path of fpc devel sources.');
- writeln(' Used for compiling pas2js and libpas2js.');
- writeln('--fpcrelease=<filename>: Path of released version fpc executable.');
- writeln(' Used for compiling pas2js and libpas2js.');
- writeln('--fpcdevel=<filename>: Path of development version fpc executable.');
- writeln(' Used for compiling the other tools.');
- writeln('--fpc2=<filename>: Path of a secondary fpc for building a second libpas2js.');
- writeln('--fpc2target=<targetcpu>-<targetos>: 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 <filename>, --config=<filename>: Path of ini file with a Main section.');
- writeln(' Default: '+GetDefaultCfgFilename);
- writeln('-b <filename>, --builddir=<filename>: Output directory where to build the zip.');
- writeln(' Default: '+GetDefaultBuildDir);
- writeln('--git=<filename>: Path of gnu make executable.');
- writeln(' Default: '+GetDefaultGit);
- writeln('--make=<filename>: Path of gnu make executable.');
- writeln(' Default: '+GetDefaultMake);
- writeln('--zip=<filename>: 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('-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 (i<OutLen) and (Buf[i+1] in [#10,#13]) and (Buf[i]<>Buf[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.
|