make.pas 4.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185
  1. program Make;
  2. {$mode objfpc}{$H+}
  3. uses
  4. Classes,
  5. SysUtils,
  6. StrUtils,
  7. FileUtil,
  8. Zipper,
  9. fphttpclient,
  10. RegExpr,
  11. openssl,
  12. opensslsockets,
  13. Process;
  14. const
  15. Target: string = '.';
  16. Dependencies: array of string = ();
  17. type
  18. TLog = (audit, info, error);
  19. Output = record
  20. Success: boolean;
  21. Output: string;
  22. end;
  23. procedure OutLog(const Knd: TLog; const Msg: string);
  24. begin
  25. case Knd of
  26. error: Writeln(stderr, #27'[31m', Msg, #27'[0m');
  27. info: Writeln(stderr, #27'[32m', Msg, #27'[0m');
  28. audit: Writeln(stderr, #27'[33m', Msg, #27'[0m');
  29. end;
  30. end;
  31. function CheckModules: string;
  32. begin
  33. if FileExists('.gitmodules') then
  34. if RunCommand('git', ['submodule', 'update', '--init', '--recursive',
  35. '--force', '--remote'], Result) then
  36. OutLog(info, Result)
  37. else
  38. OutLog(error, Result);
  39. end;
  40. function AddPackage(const Path: string): string;
  41. begin
  42. if RunCommand('lazbuild', ['--add-package-link', Path], Result) then
  43. OutLog(audit, 'Add package:'#9 + Path);
  44. end;
  45. function SelectString(const Input, Reg: string): string;
  46. var
  47. Line: string;
  48. begin
  49. Result := ' ';
  50. for Line in Input.Split(LineEnding) do
  51. with TRegExpr.Create do
  52. begin
  53. Expression := Reg;
  54. if Exec(Line) then
  55. Result += Line + LineEnding;
  56. Free;
  57. end;
  58. end;
  59. function RunTest(const Path: String): string;
  60. begin
  61. OutLog(audit, #9'run:'#9 + Path);
  62. if RunCommand(Path, ['--all', '--format=plain'], Result) then
  63. OutLog(info, #9'success!')
  64. else
  65. begin
  66. ExitCode += 1;
  67. OutLog(error, Result);
  68. end;
  69. end;
  70. function BuildProject(const Path: string): Output;
  71. begin
  72. OutLog(audit, 'Build from:'#9 + Path);
  73. Result.Success := RunCommand('lazbuild',
  74. ['--build-all', '--recursive', '--no-write-project', Path], Result.Output);
  75. Result.Output := SelectString(Result.Output, '(Fatal:|Error:|Linking)');
  76. if Result.Success then
  77. begin
  78. Result.Output := Result.Output.Split(' ')[3].Replace(LineEnding, '');
  79. OutLog(info, #9'to:'#9 + Result.Output);
  80. if ContainsStr(ReadFileToString(Path.Replace('.lpi', '.lpr')), 'consoletestrunner') then
  81. RunTest(Result.Output.Replace(#10, ''));
  82. end
  83. else
  84. begin
  85. ExitCode += 1;
  86. OutLog(error, Result.Output);
  87. end;
  88. end;
  89. function DownloadFile(const Uri: string): string;
  90. var
  91. OutFile: TStream;
  92. begin
  93. InitSSLInterface;
  94. Result := GetTempFileName;
  95. OutFile := TFileStream.Create(Result, fmCreate or fmOpenWrite);
  96. with TFPHttpClient.Create(nil) do
  97. begin
  98. try
  99. AddHeader('User-Agent', 'Mozilla/5.0 (compatible; fpweb)');
  100. AllowRedirect := True;
  101. Get(Uri, OutFile);
  102. OutLog(audit, 'Download from ' + Uri + ' to ' + Result);
  103. finally
  104. Free;
  105. OutFile.Free;
  106. end;
  107. end;
  108. end;
  109. procedure UnZip(const ZipFile, ZipPath: string);
  110. begin
  111. with TUnZipper.Create do
  112. begin
  113. try
  114. FileName := ZipFile;
  115. OutputPath := ZipPath;
  116. Examine;
  117. UnZipAllFiles;
  118. OutLog(audit, 'Unzip from'#9 + ZipFile + #9'to'#9 + ZipPath);
  119. DeleteFile(ZipFile);
  120. finally
  121. Free;
  122. end;
  123. end;
  124. end;
  125. function InstallOPM(const Path: string): string;
  126. begin
  127. Result :=
  128. {$IFDEF MSWINDOWS}
  129. GetEnvironmentVariable('APPDATA') + '\.lazarus\onlinepackagemanager\packages\'
  130. {$ELSE}
  131. GetEnvironmentVariable('HOME') + '/.lazarus/onlinepackagemanager/packages/'
  132. {$ENDIF}
  133. + Path;
  134. if not DirectoryExists(Result) then
  135. begin
  136. CreateDir(Result);
  137. UnZip(DownloadFile('https://packages.lazarus-ide.org/' + Path + '.zip'), Result);
  138. end;
  139. end;
  140. function BuildAll: string;
  141. var
  142. List: TStringList;
  143. begin
  144. CheckModules;
  145. List := FindAllFiles(GetCurrentDir, '*.lpk', True);
  146. try
  147. for Result in Dependencies do
  148. List.AddStrings(FindAllFiles(InstallOPM(Result), '*.lpk', True));
  149. for Result in List do
  150. AddPackage(Result);
  151. List := FindAllFiles(Target, '*.lpi', True);
  152. for Result in List do
  153. BuildProject(Result);
  154. finally
  155. List.Free;
  156. end;
  157. case ExitCode of
  158. 0: OutLog(info, 'Errors:'#9 + IntToStr(ExitCode));
  159. else
  160. OutLog(error, 'Errors:'#9 + IntToStr(ExitCode));
  161. end;
  162. end;
  163. begin
  164. try
  165. BuildAll
  166. except
  167. on E: Exception do
  168. Writeln(E.ClassName, #9, E.Message);
  169. end;
  170. end.