Pas2jsReleaseCreator.lpr 27 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875
  1. program Pas2jsReleaseCreator;
  2. {$mode objfpc}{$H+}
  3. uses
  4. {$IFDEF UNIX}
  5. cthreads,
  6. {$ENDIF}
  7. Classes, SysUtils, Types, CustApp, IniFiles, process,
  8. FindWriteln, PRCUtils;
  9. const
  10. DefaultCfgFilename = 'pas2jsrelease.ini';
  11. type
  12. TGetDefaultEvent = function(): string of object;
  13. { TPas2jsReleaseCreator }
  14. TPas2jsReleaseCreator = class(TCustomApplication)
  15. protected
  16. procedure DoLog(EventType: TEventType; const Msg: String); override;
  17. procedure DoRun; override;
  18. procedure Err(const Msg: string);
  19. public
  20. BuildDir: string;
  21. BuildDir_Sources: string;
  22. BuildDir_Bin: string;
  23. CfgFilename: string;
  24. FPCReleaseFilename: string; // released compiler binary
  25. FPCDevelFilename: string; // development compiler binary
  26. FPC2Filename: string; // optional second compiler for a second libpas2js
  27. FPC2TargetCPU: string;
  28. FPC2TargetOS: string;
  29. Ini: TIniFile;
  30. GitFilename: string; // 'git' binary
  31. MakeFilename: string; // 'make' binary
  32. ZipFilename: string; // 'zip' binary
  33. Pas2jsVersion: string;
  34. Simulate: boolean;
  35. SourceDir: string; // cloned git release
  36. FPCSrcDir: string;
  37. Verbosity: integer;
  38. constructor Create(TheOwner: TComponent); override;
  39. destructor Destroy; override;
  40. procedure WriteHelp; virtual;
  41. procedure ReadPas2jsVersion;
  42. procedure CheckForgottenWriteln;
  43. procedure ParseFPCTargetOption(const LongOpt: string; out TargetCPU, TargetOS: string);
  44. procedure CleanSources;
  45. procedure CreateBuildSourceDir(const TargetOS, TargetCPU: string);
  46. procedure BuildTools(const TargetOS, TargetCPU: string);
  47. procedure CopySourceFolders;
  48. procedure CopyRTLjs;
  49. procedure CreatePas2jsCfg;
  50. procedure CreateZip;
  51. procedure RunTool(WorkDir, Exe: string; const ProcParams: TStringDynArray); overload;
  52. procedure RunTool(WorkDir, Exe: string; ProcParams: TStringList); overload;
  53. procedure ForceDir(Dir, DirTitle: string);
  54. function Quote(const s: string): string;
  55. function GetDefaultCfgFilename: string;
  56. function GetDefaultBuildDir: string;
  57. function GetDefaultTool(const Filename: string; Expanded: boolean): string;
  58. function GetDefaultGit: string;
  59. function GetDefaultMake: string;
  60. function GetDefaultZip: string;
  61. function GetOption_String(ShortOption: char; const LongOption: string): string;
  62. function GetOption_Directory(ShortOption: char; const LongOption: string; const GetDefaultFunc: TGetDefaultEvent): string;
  63. function GetOption_Executable(ShortOption: char; const LongOption: string; const GetDefaultFunc: TGetDefaultEvent): string;
  64. procedure CheckExecutable(const Filename, ParamName: string);
  65. end;
  66. { TPas2jsReleaseCreator }
  67. procedure TPas2jsReleaseCreator.DoLog(EventType: TEventType; const Msg: String);
  68. begin
  69. case EventType of
  70. etInfo: write('Info: ');
  71. etWarning: write('Warning: ');
  72. etError: write('Error: ');
  73. etDebug: write('Debug: ');
  74. else
  75. write('Custom: ');
  76. end;
  77. writeln(Msg);
  78. end;
  79. procedure TPas2jsReleaseCreator.DoRun;
  80. var
  81. ErrorMsg: String;
  82. TargetOS, TargetCPU: String;
  83. begin
  84. // quick check parameters
  85. ErrorMsg:=CheckOptions('hb:c:s:l:qvx', ['help', 'config:',
  86. 'builddir:', 'sourcedir:', 'quiet', 'verbose', 'execute',
  87. 'fpcrelease:', 'fpcdevel:', 'fpcdir:', 'fpc2:', 'fpc2target:',
  88. 'git:', 'make:', 'zip:']);
  89. if ErrorMsg<>'' then
  90. Err(ErrorMsg);
  91. // parse basic parameters
  92. if HasOption('h', 'help') then begin
  93. WriteHelp;
  94. Terminate;
  95. Exit;
  96. end;
  97. Simulate:=true;
  98. if HasOption('q','quiet') then
  99. dec(Verbosity);
  100. if HasOption('v','verbose') then
  101. inc(Verbosity);
  102. // read config file
  103. if HasOption('c','config') then begin
  104. CfgFilename:=ExpandFileName(GetOptionValue('c','config'));
  105. if not FileExists(CfgFilename) then
  106. Err('Config file not found: "'+CfgFilename+'"');
  107. end else begin
  108. CfgFilename:=GetDefaultCfgFilename;
  109. end;
  110. if FileExists(CfgFilename) then begin
  111. if Verbosity>=0 then
  112. Log(etInfo,'Reading config file "'+CfgFilename+'" ...');
  113. Ini:=TIniFile.Create(CfgFilename);
  114. end;
  115. BuildDir:=GetOption_Directory('b','builddir',@GetDefaultBuildDir);
  116. SourceDir:=GetOption_Directory('s','sourcedir',nil);
  117. if SourceDir='' then
  118. Err('missing source directory');
  119. FPCSrcDir:=GetOption_Directory(' ','fpcdir',nil);
  120. FPCReleaseFilename:=GetOption_Executable(' ','fpcrelease',nil);
  121. FPCDevelFilename:=GetOption_Executable(' ','fpcdevel',nil);
  122. FPC2Filename:=GetOption_Executable(' ','fpc2',nil);
  123. ParseFPCTargetOption('fpc2target',FPC2TargetCPU,FPC2TargetOS);
  124. GitFilename:=GetOption_Executable(' ','git',@GetDefaultGit);
  125. MakeFilename:=GetOption_Executable(' ','make',@GetDefaultMake);
  126. ZipFilename:=GetOption_Executable(' ','zip',@GetDefaultZip);
  127. if FPCSrcDir='' then begin
  128. FPCSrcDir:=GetEnvironmentVariable('FPCDIR');
  129. if FPCSrcDir<>'' then
  130. FPCSrcDir:=AppendPathDelim(ExpandFileName(FPCSrcDir));
  131. end;
  132. if FPCSrcDir='' then
  133. FPCSrcDir:=SourceDir+'compiler'+PathDelim;
  134. // write options
  135. if Verbosity>=0 then begin
  136. Log(etInfo,'SourceDir: "'+SourceDir+'"');
  137. Log(etInfo,'BuildDir: "'+BuildDir+'"');
  138. Log(etInfo,'FPCDir: "'+FPCSrcDir+'"');
  139. Log(etInfo,'FPCRelease: "'+FPCReleaseFilename+'"');
  140. Log(etInfo,'FPCDevel: "'+FPCDevelFilename+'"');
  141. Log(etInfo,'FPC2: "'+FPC2Filename+'"');
  142. Log(etInfo,'FPC2Target: "'+FPC2TargetCPU+'-'+FPC2TargetOS+'"');
  143. Log(etInfo,'git: "'+GitFilename+'"');
  144. Log(etInfo,'make: "'+MakeFilename+'"');
  145. Log(etInfo,'zip: "'+ZipFilename+'"');
  146. end;
  147. if HasOption('x','execute') then
  148. Simulate:=false
  149. else
  150. Log(etInfo,'Simulating...');
  151. // preflight checks
  152. if not DirectoryExists(BuildDir) then
  153. Err('BuildDir missing: "'+BuildDir+'"');
  154. if not DirectoryExists(SourceDir) then
  155. Err('SourceDir missing: "'+SourceDir+'"');
  156. if not DirectoryExists(FPCSrcDir) then
  157. Err('FPCDir missing: "'+FPCSrcDir+'"');
  158. CheckExecutable(FPCReleaseFilename,'fpcrelease');
  159. CheckExecutable(FPCDevelFilename,'fpcdevel');
  160. if FPC2Filename<>'' then
  161. CheckExecutable(FPC2Filename,'fpc2');
  162. CheckExecutable(GitFilename,'git');
  163. CheckExecutable(MakeFilename,'make');
  164. CheckExecutable(ZipFilename,'zip');
  165. ReadPas2jsVersion;
  166. CheckForgottenWriteln;
  167. // build
  168. CleanSources;
  169. TargetOS:=GetCompiledTargetOS;
  170. TargetCPU:=GetCompiledTargetCPU;
  171. CreateBuildSourceDir(TargetOS,TargetCPU);
  172. BuildTools(TargetOS,TargetCPU);
  173. CopySourceFolders;
  174. CopyRTLjs;
  175. CreatePas2jsCfg;
  176. CreateZip;
  177. // stop program loop
  178. Terminate;
  179. end;
  180. procedure TPas2jsReleaseCreator.Err(const Msg: string);
  181. begin
  182. Log(etError,Msg);
  183. Halt(1);
  184. end;
  185. constructor TPas2jsReleaseCreator.Create(TheOwner: TComponent);
  186. begin
  187. inherited Create(TheOwner);
  188. StopOnException:=True;
  189. end;
  190. destructor TPas2jsReleaseCreator.Destroy;
  191. begin
  192. FreeAndNil(Ini);
  193. inherited Destroy;
  194. end;
  195. procedure TPas2jsReleaseCreator.WriteHelp;
  196. begin
  197. writeln('Usage: ', ExeName, ' -h');
  198. writeln;
  199. writeln('-h, --help: Write this help and exit');
  200. writeln;
  201. writeln('Required parameters:');
  202. writeln('-s <filename>, --sourcedir=<filename>: git directory of the pas2js release');
  203. writeln('--fpcdir=<filename>: Path of fpc devel sources.');
  204. writeln(' Used for compiling pas2js and libpas2js.');
  205. writeln('--fpcrelease=<filename>: Path of released version fpc executable.');
  206. writeln(' Used for compiling pas2js and libpas2js.');
  207. writeln('--fpcdevel=<filename>: Path of development version fpc executable.');
  208. writeln(' Used for compiling the other tools.');
  209. writeln('--fpc2=<filename>: Path of a secondary fpc for building a second libpas2js.');
  210. writeln('--fpc2target=<targetcpu>-<targetos>: Target CPU and OS for fpc2.');
  211. writeln('-x, --execute: Do not simulate, execute the commands');
  212. writeln;
  213. writeln('Optional parameters:');
  214. writeln('-q, --quiet: Less verbose');
  215. writeln('-v, --verbose: More verbose');
  216. writeln('-c <filename>, --config=<filename>: Path of ini file with a Main section.');
  217. writeln(' Default: '+GetDefaultCfgFilename);
  218. writeln('-b <filename>, --builddir=<filename>: Output directory where to build the zip.');
  219. writeln(' Default: '+GetDefaultBuildDir);
  220. writeln('--git=<filename>: Path of gnu make executable.');
  221. writeln(' Default: '+GetDefaultGit);
  222. writeln('--make=<filename>: Path of gnu make executable.');
  223. writeln(' Default: '+GetDefaultMake);
  224. writeln('--zip=<filename>: Path of zip executable.');
  225. writeln(' Default: '+GetDefaultZip);
  226. writeln;
  227. end;
  228. procedure TPas2jsReleaseCreator.ReadPas2jsVersion;
  229. function CheckPascalConstInt(const Line, Identifier: string; var aValue: integer): boolean;
  230. var
  231. s: String;
  232. p, StartP: SizeInt;
  233. begin
  234. Result:=false;
  235. s:=' '+Identifier+' = ';
  236. if not SameText(LeftStr(Line,length(s)),s) then exit;
  237. p:=length(s)+1;
  238. StartP:=p;
  239. aValue:=0;
  240. while (p<=length(Line)) and (Line[p] in ['0'..'9']) do begin
  241. aValue:=aValue*10+ord(Line[p])-ord('0');
  242. inc(p);
  243. end;
  244. Result:=p>StartP;
  245. end;
  246. function CheckJSConstInt(const Line, Identifier: string; var aValue: integer): boolean;
  247. var
  248. s: String;
  249. p, StartP: SizeInt;
  250. begin
  251. Result:=false;
  252. s:=' '+Identifier+': ';
  253. if LeftStr(Line,length(s))<>s then exit;
  254. p:=length(s)+1;
  255. StartP:=p;
  256. aValue:=0;
  257. while (p<=length(Line)) and (Line[p] in ['0'..'9']) do begin
  258. aValue:=aValue*10+ord(Line[p])-ord('0');
  259. inc(p);
  260. end;
  261. Result:=p>StartP;
  262. end;
  263. type
  264. TVersionPart = (vMajor,vMinor,vRelease);
  265. const
  266. PartNames: array[TVersionPart] of string = ('VersionMajor','VersionMinor','VersionRelease');
  267. var
  268. Filename, Line: String;
  269. sl: TStringList;
  270. i, JSVersion: Integer;
  271. Parts: array[TVersionPart] of integer;
  272. PartFound: array[TVersionPart] of boolean;
  273. p: TVersionPart;
  274. begin
  275. sl:=TStringList.Create;
  276. try
  277. // read pas2js version number from Pascal sources
  278. Filename:=FPCSrcDir+SetDirSeparators('packages/pastojs/src/pas2jscompiler.pp');
  279. if Verbosity>0 then
  280. Log(etInfo,'Reading version from "'+Filename+'" ...');
  281. if not FileExists(Filename) then
  282. Err('Missing source file: "'+Filename+'"');
  283. sl.LoadFromFile(Filename);
  284. // parse source and find all three version constants
  285. for p in TVersionPart do begin
  286. Parts[p]:=-1;
  287. PartFound[p]:=false;
  288. end;
  289. for i:=0 to sl.Count-1 do begin
  290. Line:=sl[i];
  291. for p in TVersionPart do
  292. if not PartFound[p] then
  293. PartFound[p]:=CheckPascalConstInt(Line,PartNames[p],Parts[p]);
  294. if PartFound[High(TVersionPart)] then begin
  295. // last constant found
  296. if Verbosity>0 then
  297. Log(etInfo,'Found const '+PartNames[High(TVersionPart)]+' = '+IntToStr(Parts[High(TVersionPart)]));
  298. break;
  299. end;
  300. end;
  301. for p in TVersionPart do
  302. if not PartFound[p] then
  303. Err('Missing '+PartNames[p]+' in "'+Filename+'"'); // one constant missing
  304. Pas2jsVersion:=IntToStr(Parts[vMajor])+'.'+IntToStr(Parts[vMinor])+'.'+IntToStr(Parts[vRelease]);
  305. if Verbosity>=0 then
  306. Log(etInfo,'Pas2js version is '+Pas2jsVersion);
  307. // read version number from rtl.js
  308. Filename:=FPCSrcDir+SetDirSeparators('utils/pas2js/dist/rtl.js');
  309. if Verbosity>0 then
  310. Log(etInfo,'Reading version from "'+Filename+'" ...');
  311. if not FileExists(Filename) then
  312. Err('Missing source file: "'+Filename+'"');
  313. sl.LoadFromFile(Filename);
  314. JSVersion:=-1;
  315. for i:=0 to sl.Count-1 do begin
  316. Line:=sl[i];
  317. if CheckJSConstInt(Line,'version',JSVersion) then break;
  318. end;
  319. if JSVersion<0 then
  320. Err('Missing version in "'+Filename+'"');
  321. i:=(Parts[vMajor]*100+Parts[vMinor])*100+Parts[vRelease];
  322. if i<>JSVersion then
  323. Err('Expected version '+IntToStr(i)+', but found '+IntToStr(JSVersion)+' in "'+Filename+'"');
  324. finally
  325. sl.Free;
  326. end;
  327. end;
  328. procedure TPas2jsReleaseCreator.CheckForgottenWriteln;
  329. procedure Check(const SrcDir: string);
  330. begin
  331. if not DirectoryExists(SrcDir) then
  332. Err('Missing dource directory: "'+SrcDir+'"');
  333. if Verbosity>=0 then
  334. Log(etInfo,'Checking for forgotten writeln: '+SrcDir+' ...');
  335. FindWritelnInDirectory(SrcDir,false,@DoLog);
  336. end;
  337. begin
  338. Check(FPCSrcDir+'packages'+PathDelim+'fcl-js'+PathDelim+'src');
  339. Check(FPCSrcDir+'packages'+PathDelim+'fcl-json'+PathDelim+'src');
  340. Check(FPCSrcDir+'packages'+PathDelim+'fcl-passrc'+PathDelim+'src');
  341. Check(FPCSrcDir+'packages'+PathDelim+'pastojs'+PathDelim+'src');
  342. Check(FPCSrcDir+'utils'+PathDelim+'pas2js');
  343. end;
  344. procedure TPas2jsReleaseCreator.ParseFPCTargetOption(const LongOpt: string; out
  345. TargetCPU, TargetOS: string);
  346. var
  347. Opt: String;
  348. p: SizeInt;
  349. begin
  350. TargetOS:='';
  351. TargetCPU:='';
  352. Opt:=lowercase(GetOption_String(' ',LongOpt));
  353. if Opt='' then exit;
  354. p:=Pos('-',Opt);
  355. if p<1 then
  356. Err('Expected TargetCPU-TargetOS, but found "--'+LongOpt+'='+Opt+'"');
  357. TargetCPU:=LeftStr(Opt,p-1);
  358. TargetOS:=copy(Opt,p+1,length(Opt));
  359. end;
  360. procedure TPas2jsReleaseCreator.CleanSources;
  361. procedure Clean(Dir: string);
  362. var
  363. Info: TRawByteSearchRec;
  364. Ext, Filename: String;
  365. begin
  366. Dir:=AppendPathDelim(Dir);
  367. if FindFirst(Dir+AllFilesMask,faAnyFile,Info)=0 then begin
  368. repeat
  369. if (Info.Name='') or (Info.Name='.') or (Info.Name='..') then continue;
  370. if (Info.Attr and faDirectory)>0 then begin
  371. Clean(Dir+Info.Name);
  372. end
  373. else begin
  374. Ext:=lowercase(ExtractFileExt(Info.Name));
  375. case Ext of
  376. '.ppu','.o','.rsj','.lib','.dylib':
  377. begin
  378. Filename:=Dir+Info.Name;
  379. if Simulate then begin
  380. if Verbosity>0 then
  381. Log(etInfo,'Simulate Deleting "'+Filename+'"');
  382. end
  383. else begin
  384. if DeleteFile(Filename) then begin
  385. if Verbosity>0 then
  386. Log(etInfo,'Deleted "'+Filename+'"');
  387. end else begin
  388. Err('Unable to delete "'+Filename+'"');
  389. end;
  390. end;
  391. end;
  392. end;
  393. end;
  394. until FindNext(Info)<>0;
  395. FindClose(Info);
  396. end;
  397. end;
  398. begin
  399. // make clean
  400. RunTool(SourceDir,MakeFilename,['clean']);
  401. // delete files
  402. Clean(SourceDir+'packages');
  403. Clean(SourceDir+'demo');
  404. Clean(SourceDir+'tools');
  405. end;
  406. procedure TPas2jsReleaseCreator.CreateBuildSourceDir(const TargetOS,
  407. TargetCPU: string);
  408. begin
  409. BuildDir_Sources:=BuildDir+'pas2js-'+TargetOS+'-'+TargetCPU+'-'+Pas2jsVersion;
  410. if DirectoryExists(BuildDir_Sources) then begin
  411. if Simulate then begin
  412. if Verbosity>=0 then
  413. Log(etInfo,'Simulate: Deleting directory "'+BuildDir_Sources+'"');
  414. end else begin
  415. if Verbosity>=0 then
  416. Log(etInfo,'Deleting directory "'+BuildDir_Sources+'"');
  417. if not DeleteDirectory(BuildDir_Sources,false) then
  418. Err('Unable to delete directory "'+BuildDir_Sources+'"');
  419. end;
  420. end;
  421. if Simulate then begin
  422. Log(etInfo,'Simulate: Creating directory "'+BuildDir_Sources+'"')
  423. end else begin
  424. if not ForceDirectory(BuildDir_Sources) then
  425. Err('Unable to create directory "'+BuildDir_Sources+'"');
  426. Log(etInfo,'Created directory "'+BuildDir_Sources+'"')
  427. end;
  428. BuildDir_Sources+=PathDelim;
  429. BuildDir_Bin:=BuildDir_Sources+'bin';
  430. if not ForceDirectory(BuildDir_Bin) then
  431. Err('Unable to create directory "'+BuildDir_Bin+'"');
  432. BuildDir_Bin+=PathDelim;
  433. end;
  434. procedure TPas2jsReleaseCreator.BuildTools(const TargetOS, TargetCPU: string);
  435. var
  436. WorkDir, PkgSrcDir, UnitOutDir, CurBinDir: String;
  437. SharedParams, TheParams: TStringList;
  438. begin
  439. SharedParams:=TStringList.Create;
  440. TheParams:=TStringList.Create;
  441. try
  442. WorkDir:=FPCSrcDir+'utils'+PathDelim+'pas2js';
  443. PkgSrcDir:=FPCSrcDir+'packages'+PathDelim;
  444. SharedParams.Add('-Fu'+PkgSrcDir+'fcl-js'+PathDelim+'src');
  445. SharedParams.Add('-Fu'+PkgSrcDir+'fcl-json'+PathDelim+'src');
  446. SharedParams.Add('-Fu'+PkgSrcDir+'fcl-passrc'+PathDelim+'src');
  447. SharedParams.Add('-Fu'+PkgSrcDir+'pastojs'+PathDelim+'src');
  448. SharedParams.Add('-B');
  449. SharedParams.Add('-MObjFPC');
  450. SharedParams.Add('-O1');
  451. SharedParams.Add('-Schi');
  452. SharedParams.Add('-vew');
  453. SharedParams.Add('-XX');
  454. SharedParams.Add('-Xs');
  455. UnitOutDir:=SourceDir+'units'+PathDelim+TargetCPU+'-'+TargetOS;
  456. ForceDir(UnitOutDir,'unit output');
  457. SharedParams.Add('-FU'+UnitOutDir);
  458. // compile pas2js exe using release fpc
  459. TheParams.Assign(SharedParams);
  460. TheParams.Add('-o'+BuildDir_Bin+'pas2js'+GetExeExt);
  461. TheParams.Add('pas2js.pp');
  462. RunTool(WorkDir,FPCReleaseFilename,TheParams);
  463. // compile libpas2js using release fpc
  464. TheParams.Assign(SharedParams);
  465. if SameText(TargetOS,'linux') then
  466. TheParams.Add('-fPIC');
  467. TheParams.Add('-o'+BuildDir_Bin+'libpas2js'+GetLibExt(TargetOS));
  468. TheParams.Add('pas2jslib.pp');
  469. RunTool(WorkDir,FPCReleaseFilename,TheParams);
  470. if FPC2Filename<>'' then begin
  471. // compile second libpas2js
  472. CurBinDir:=BuildDir_Bin+FPC2TargetCPU+'-'+FPC2TargetOS+PathDelim;
  473. ForceDir(CurBinDir,'sub folder for second libpas2js');
  474. TheParams.Assign(SharedParams);
  475. if SameText(FPC2TargetOS,'linux') then
  476. TheParams.Add('-fPIC');
  477. TheParams.Add('-o'+CurBinDir+'libpas2js'+GetLibExt(TargetOS));
  478. TheParams.Add('-P'+FPC2TargetCPU);
  479. TheParams.Add('-T'+FPC2TargetOS);
  480. TheParams.Add('pas2jslib.pp');
  481. RunTool(WorkDir,FPC2Filename,TheParams);
  482. end;
  483. // compile compileserver using devel fpc
  484. TheParams.Assign(SharedParams);
  485. TheParams.Add('-o'+BuildDir_Bin+'compileserver'+GetExeExt);
  486. TheParams.Add('compileserver.pp');
  487. RunTool(WorkDir,FPCDevelFilename,TheParams);
  488. // compile webidl2pas using devel fpc
  489. TheParams.Assign(SharedParams);
  490. TheParams.Add('-o'+BuildDir_Bin+'webidl2pas'+GetExeExt);
  491. TheParams.Add('webidl2pas.pp');
  492. RunTool(WorkDir,FPCDevelFilename,TheParams);
  493. // compile makestub using devel fpc
  494. TheParams.Assign(SharedParams);
  495. TheParams.Add('-o'+BuildDir_Bin+'makestub'+GetExeExt);
  496. TheParams.Add('makestub.pp');
  497. RunTool(WorkDir,FPCDevelFilename,TheParams);
  498. finally
  499. TheParams.Free;
  500. SharedParams.Free;
  501. end;
  502. end;
  503. procedure TPas2jsReleaseCreator.CopySourceFolders;
  504. procedure CopyFolder(const Dir: string);
  505. var
  506. SrcDir, DestDir: String;
  507. begin
  508. SrcDir:=SourceDir+Dir;
  509. DestDir:=BuildDir_Sources+Dir;
  510. if not DirectoryExists(SrcDir) then
  511. Err('Unable to copy missing source folder "'+SrcDir+'"');
  512. // git restore SrcDir
  513. RunTool(SourceDir,GitFilename,['restore',SrcDir]);
  514. // copy
  515. if Simulate then begin
  516. Log(etInfo,'Simulate: Copying folder "'+SrcDir+'" -> "'+DestDir+'"');
  517. end else begin
  518. Log(etInfo,'Copying folder "'+SrcDir+'" -> "'+DestDir+'"');
  519. CopyDirTree(SrcDir,DestDir,[cffCreateDestDirectory,cffPreserveTime,cffExceptionOnError]);
  520. end;
  521. end;
  522. var
  523. Info: TRawByteSearchRec;
  524. begin
  525. CopyFolder('demo');
  526. CopyFolder('packages');
  527. // copy all tools except releasecreator
  528. if not Simulate then begin
  529. if not CreateDir(BuildDir_Sources+'tools') then
  530. Err('Unable to create directory: '+BuildDir_Sources+'tools');
  531. end;
  532. if FindFirst(SourceDir+'tools'+PathDelim+AllFilesMask,faAnyFile,Info)=0 then begin
  533. repeat
  534. if (Info.Name='') or (Info.Name='.') or (Info.Name='..') then continue;
  535. if (Info.Name='releasecreator') then continue;
  536. if (Info.Attr and faDirectory)>0 then begin
  537. CopyFolder('tools'+PathDelim+Info.Name);
  538. end
  539. until FindNext(Info)<>0;
  540. FindClose(Info);
  541. end;
  542. end;
  543. procedure TPas2jsReleaseCreator.CopyRTLjs;
  544. var
  545. SrcFilename, DestFilename: String;
  546. begin
  547. SrcFilename:=FPCSrcDir+SetDirSeparators('utils/pas2js/dist/rtl.js');
  548. DestFilename:=BuildDir_Sources+SetDirSeparators('packages/rtl/src/rtl.js');
  549. if Simulate then begin
  550. Log(etInfo,'Simulate: Copying "'+SrcFilename+'" -> "'+DestFilename+'"');
  551. end else begin
  552. Log(etInfo,'Copying "'+SrcFilename+'" -> "'+DestFilename+'"');
  553. CopyFile(SrcFilename,DestFilename,[cffOverwriteFile,cffPreserveTime,cffExceptionOnError]);
  554. end;
  555. end;
  556. procedure TPas2jsReleaseCreator.CreatePas2jsCfg;
  557. var
  558. Dir, SrcFilename, ExeFilename, Pas2jsCfgFilename: String;
  559. NeedBuild: Boolean;
  560. begin
  561. // build createconfig
  562. Dir:=SourceDir+SetDirSeparators('tools/createconfig/');
  563. SrcFilename:=Dir+'createconfig.pp';
  564. ExeFilename:=Dir+'createconfig'+GetExeExt;
  565. if not FileExists(SrcFilename) then
  566. Err('File not found: "'+SrcFilename+'"');
  567. NeedBuild:=true;
  568. if not FileExists(ExeFilename) then
  569. log(etInfo,'Missing tool createconfig, building ...')
  570. else if FileAge(SrcFilename)>FileAge(ExeFilename) then
  571. log(etInfo,'createconfig.pp changed, building ...')
  572. else
  573. NeedBuild:=false;
  574. if NeedBuild then begin
  575. RunTool(Dir,FPCReleaseFilename,['-O1','Schi','-vew','-XX','-Xs','createconfig.pp']);
  576. end;
  577. // run createconfig
  578. Pas2jsCfgFilename:=BuildDir_Bin+'pas2js.cfg';
  579. if Simulate then begin
  580. Log(etInfo,'Simulate: run createconfig to create "'+Pas2jsCfgFilename+'"');
  581. end else begin
  582. RunTool(Dir,ExeFilename,[Pas2jsCfgFilename,'..']);
  583. end;
  584. end;
  585. procedure TPas2jsReleaseCreator.CreateZip;
  586. var
  587. Dir, Filename, s: String;
  588. begin
  589. if not DirectoryExists(BuildDir_Sources) then
  590. Err('TPas2jsReleaseCreator.CreateZip: Empty BuildDir_Sources');
  591. Dir:=ExtractFilename(ChompPathDelim(BuildDir_Sources));
  592. Filename:=BuildDir+Dir+'.zip';
  593. if FileExists(Filename) and not Simulate then
  594. if not DeleteFile(Filename) then
  595. Err('Unable to delete "'+Filename+'"');
  596. RunTool(BuildDir,ZipFilename,['-r',Filename,Dir]);
  597. s:=IntToStr(FileSize(Filename));
  598. if Simulate then
  599. Log(etInfo,'Simulate: Created '+Filename+' Size='+s)
  600. else
  601. Log(etInfo,'Created '+Filename+' Size='+s);
  602. end;
  603. procedure TPas2jsReleaseCreator.RunTool(WorkDir, Exe: string;
  604. const ProcParams: TStringDynArray);
  605. var
  606. sl: TStringList;
  607. i: Integer;
  608. begin
  609. sl:=TStringList.Create;
  610. try
  611. for i:=0 to length(ProcParams)-1 do
  612. sl.Add(ProcParams[i]);
  613. RunTool(WorkDir,Exe,sl);
  614. finally
  615. sl.Free;
  616. end;
  617. end;
  618. procedure TPas2jsReleaseCreator.RunTool(WorkDir, Exe: string;
  619. ProcParams: TStringList);
  620. var
  621. TheProcess: TProcess;
  622. i, OutLen, LineStart: Integer;
  623. OutputLine, buf, CmdLine: String;
  624. begin
  625. WorkDir:=ChompPathDelim(WorkDir);
  626. if not FileIsExecutable(Exe) then
  627. Err('Not an executable: '+Exe);
  628. if DirectoryExists(Exe) then
  629. Err('Not an executable: '+Exe);
  630. if (not Simulate) and (not DirectoryExists(WorkDir)) then
  631. Err('Workdir missing: '+WorkDir);
  632. TheProcess:=TProcess.Create(nil);
  633. try
  634. TheProcess.Executable := Exe;
  635. TheProcess.Parameters := ProcParams;
  636. TheProcess.Options := [poUsePipes, poStdErrToOutput];
  637. TheProcess.ShowWindow := swoHide;
  638. TheProcess.CurrentDirectory := WorkDir;
  639. CmdLine:=Quote(Exe);
  640. for i:=0 to ProcParams.Count-1 do
  641. CmdLine+=' '+Quote(ProcParams[i]);
  642. if Simulate then begin
  643. Log(etInfo,'Simulate: Running: WorkDir="'+WorkDir+'" Cmd: '+CmdLine);
  644. exit;
  645. end;
  646. Log(etInfo,'Running: WorkDir="'+WorkDir+'" Cmd: '+CmdLine);
  647. TheProcess.Execute;
  648. OutputLine:='';
  649. SetLength(buf{%H-},4096);
  650. repeat
  651. if (TheProcess.Output<>nil) then begin
  652. OutLen:=TheProcess.Output.Read(Buf[1],length(Buf));
  653. end else
  654. OutLen:=0;
  655. LineStart:=1;
  656. i:=1;
  657. while i<=OutLen do begin
  658. if Buf[i] in [#10,#13] then begin
  659. OutputLine:=OutputLine+copy(Buf,LineStart,i-LineStart);
  660. writeln(OutputLine);
  661. OutputLine:='';
  662. if (i<OutLen) and (Buf[i+1] in [#10,#13]) and (Buf[i]<>Buf[i+1]) then
  663. inc(i);
  664. LineStart:=i+1;
  665. end;
  666. inc(i);
  667. end;
  668. OutputLine:=OutputLine+copy(Buf,LineStart,OutLen-LineStart+1);
  669. until OutLen=0;
  670. if OutputLine<>'' then
  671. writeln(OutputLine);
  672. TheProcess.WaitOnExit;
  673. if TheProcess.ExitStatus<>0 then
  674. Err('ExitStatus: '+IntToStr(TheProcess.ExitStatus));
  675. if TheProcess.ExitCode<>0 then
  676. Err('ExitCode: '+IntToStr(TheProcess.ExitCode));
  677. finally
  678. TheProcess.Free;
  679. end;
  680. end;
  681. procedure TPas2jsReleaseCreator.ForceDir(Dir, DirTitle: string);
  682. begin
  683. Dir:=ChompPathDelim(Dir);
  684. if DirectoryExists(Dir) then exit;
  685. if Simulate then exit;
  686. if ForceDirectories(Dir) then exit;
  687. Err('Unable to create '+DirTitle+' directory "'+Dir+'"');
  688. end;
  689. function TPas2jsReleaseCreator.Quote(const s: string): string;
  690. begin
  691. Result:=s;
  692. if Pos(' ',Result)<1 then exit;
  693. Result:=QuotedStr(s);
  694. end;
  695. function TPas2jsReleaseCreator.GetDefaultCfgFilename: string;
  696. begin
  697. Result:=ExpandFileName(DefaultCfgFilename);
  698. end;
  699. function TPas2jsReleaseCreator.GetDefaultBuildDir: string;
  700. begin
  701. Result:=AppendPathDelim(ExpandFileName(GetTempDir(false)));
  702. end;
  703. function TPas2jsReleaseCreator.GetDefaultTool(const Filename: string;
  704. Expanded: boolean): string;
  705. begin
  706. Result:=Filename;
  707. if Expanded then begin
  708. if FilenameIsAbsolute(Result) then exit;
  709. if ExtractFilePath(Result)<>'' then exit;
  710. Result:=FindDefaultExecutablePath(Result);
  711. if Result='' then
  712. Result:=Filename;
  713. end;
  714. end;
  715. function TPas2jsReleaseCreator.GetDefaultGit: string;
  716. begin
  717. Result:=GetDefaultTool('git'+GetExeExt,true);
  718. end;
  719. function TPas2jsReleaseCreator.GetDefaultMake: string;
  720. begin
  721. Result:=GetDefaultTool('make'+GetExeExt,true);
  722. end;
  723. function TPas2jsReleaseCreator.GetDefaultZip: string;
  724. begin
  725. Result:=GetDefaultTool('zip'+GetExeExt,true);
  726. end;
  727. function TPas2jsReleaseCreator.GetOption_String(ShortOption: char;
  728. const LongOption: string): string;
  729. begin
  730. if ShortOption<=' ' then begin
  731. if HasOption(LongOption) then begin
  732. Result:=GetOptionValue(LongOption);
  733. exit;
  734. end;
  735. end else begin
  736. if HasOption(ShortOption,LongOption) then begin
  737. Result:=GetOptionValue(ShortOption,LongOption);
  738. exit;
  739. end;
  740. end;
  741. if Ini<>nil then begin
  742. Result:=Ini.ReadString('Main',LongOption,'');
  743. exit;
  744. end;
  745. Result:='';
  746. end;
  747. function TPas2jsReleaseCreator.GetOption_Directory(ShortOption: char;
  748. const LongOption: string; const GetDefaultFunc: TGetDefaultEvent): string;
  749. begin
  750. Result:=GetOption_String(ShortOption,LongOption);
  751. if (Result='') and Assigned(GetDefaultFunc) then
  752. Result:=GetDefaultFunc();
  753. if Result<>'' then
  754. Result:=AppendPathDelim(ExpandFileName(Result));
  755. end;
  756. function TPas2jsReleaseCreator.GetOption_Executable(ShortOption: char;
  757. const LongOption: string; const GetDefaultFunc: TGetDefaultEvent): string;
  758. begin
  759. if ShortOption<=' ' then
  760. Result:=GetOption_String(ShortOption,LongOption)
  761. else
  762. Result:=GetOption_String(ShortOption,LongOption);
  763. if (Result='') and Assigned(GetDefaultFunc) then
  764. Result:=GetDefaultFunc();
  765. if Result='' then exit;
  766. if FilenameIsAbsolute(Result) then exit;
  767. if ExtractFilePath(Result)<>'' then
  768. Result:=ExpandFileName(Result)
  769. else if Result<>'' then
  770. Result:=FindDefaultExecutablePath(Result);
  771. end;
  772. procedure TPas2jsReleaseCreator.CheckExecutable(const Filename, ParamName: string);
  773. begin
  774. if Filename='' then
  775. Err('Missing parameter '+ParamName);
  776. if not FileExists(Filename) then
  777. Err('File '+ParamName+' not found: "'+Filename+'"');
  778. if not FileIsExecutable(Filename) then
  779. Err('File '+ParamName+' not executable: "'+Filename+'"');
  780. end;
  781. var
  782. Application: TPas2jsReleaseCreator;
  783. begin
  784. Application:=TPas2jsReleaseCreator.Create(nil);
  785. Application.Title:='Pas2js Release Creator';
  786. Application.Run;
  787. Application.Free;
  788. end.