|
|
@@ -0,0 +1,183 @@
|
|
|
+program Make;
|
|
|
+{$mode objfpc}{$H+}
|
|
|
+
|
|
|
+uses
|
|
|
+ Classes,
|
|
|
+ SysUtils,
|
|
|
+ StrUtils,
|
|
|
+ FileUtil,
|
|
|
+ Zipper,
|
|
|
+ fphttpclient,
|
|
|
+ RegExpr,
|
|
|
+ openssl,
|
|
|
+ opensslsockets,
|
|
|
+ Process;
|
|
|
+
|
|
|
+const
|
|
|
+ Target: string = 'QRCodeGenLib.Demo';
|
|
|
+ Dependencies: array of string = ();
|
|
|
+
|
|
|
+type
|
|
|
+ TLog = (audit, info, error);
|
|
|
+
|
|
|
+ Output = record
|
|
|
+ Success: boolean;
|
|
|
+ Output: string;
|
|
|
+ end;
|
|
|
+
|
|
|
+ procedure OutLog(const Knd: TLog; const Msg: string);
|
|
|
+ begin
|
|
|
+ case Knd of
|
|
|
+ error: Writeln(stderr, #27'[31m', Msg, #27'[0m');
|
|
|
+ info: Writeln(stderr, #27'[32m', Msg, #27'[0m');
|
|
|
+ audit: Writeln(stderr, #27'[33m', Msg, #27'[0m');
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+
|
|
|
+ function CheckModules: string;
|
|
|
+ begin
|
|
|
+ if FileExists('.gitmodules') then
|
|
|
+ if RunCommand('git', ['submodule', 'update', '--init', '--recursive',
|
|
|
+ '--force', '--remote'], Result) then
|
|
|
+ OutLog(info, Result)
|
|
|
+ else
|
|
|
+ OutLog(error, Result);
|
|
|
+ end;
|
|
|
+
|
|
|
+ function AddPackage(const Path: string): string;
|
|
|
+ begin
|
|
|
+ if RunCommand('lazbuild', ['--add-package-link', Path], Result) then
|
|
|
+ OutLog(audit, 'Add package:'#9 + Path);
|
|
|
+ end;
|
|
|
+
|
|
|
+ function SelectString(const Input, Reg: string): string;
|
|
|
+ var
|
|
|
+ Line: string;
|
|
|
+ begin
|
|
|
+ Result := ' ';
|
|
|
+ for Line in Input.Split(LineEnding) do
|
|
|
+ with TRegExpr.Create do
|
|
|
+ begin
|
|
|
+ Expression := Reg;
|
|
|
+ if Exec(Line) then
|
|
|
+ Result += Line + LineEnding;
|
|
|
+ Free;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+
|
|
|
+ function RunTest(const Path: String): string;
|
|
|
+ begin
|
|
|
+ OutLog(audit, #9'run:'#9 + Path);
|
|
|
+ if RunCommand(Path, ['--all', '--format=plain'], Result) then
|
|
|
+ OutLog(info, #9'success!')
|
|
|
+ else
|
|
|
+ ExitCode += 1;
|
|
|
+ OutLog(audit, Result);
|
|
|
+ end;
|
|
|
+
|
|
|
+ function BuildProject(const Path: string): Output;
|
|
|
+ begin
|
|
|
+ OutLog(audit, 'Build from:'#9 + Path);
|
|
|
+ Result.Success := RunCommand('lazbuild',
|
|
|
+ ['--build-all', '--recursive', '--no-write-project', Path], Result.Output);
|
|
|
+ Result.Output := SelectString(Result.Output, '(Fatal:|Error:|Linking)');
|
|
|
+ if Result.Success then
|
|
|
+ begin
|
|
|
+ Result.Output := Result.Output.Split(' ')[3].Replace(LineEnding, '');
|
|
|
+ OutLog(info, #9'to:'#9 + Result.Output);
|
|
|
+ if ContainsStr(ReadFileToString(Path.Replace('.lpi', '.lpr')), 'consoletestrunner') then
|
|
|
+ RunTest(Result.Output.Replace(#10, ''));
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ ExitCode += 1;
|
|
|
+ OutLog(error, Result.Output);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+
|
|
|
+ function DownloadFile(const Uri: string): string;
|
|
|
+ var
|
|
|
+ OutFile: TStream;
|
|
|
+ begin
|
|
|
+ InitSSLInterface;
|
|
|
+ Result := GetTempFileName;
|
|
|
+ OutFile := TFileStream.Create(Result, fmCreate or fmOpenWrite);
|
|
|
+ with TFPHttpClient.Create(nil) do
|
|
|
+ begin
|
|
|
+ try
|
|
|
+ AddHeader('User-Agent', 'Mozilla/5.0 (compatible; fpweb)');
|
|
|
+ AllowRedirect := True;
|
|
|
+ Get(Uri, OutFile);
|
|
|
+ OutLog(audit, 'Download from ' + Uri + ' to ' + Result);
|
|
|
+ finally
|
|
|
+ Free;
|
|
|
+ OutFile.Free;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+
|
|
|
+ procedure UnZip(const ZipFile, ZipPath: string);
|
|
|
+ begin
|
|
|
+ with TUnZipper.Create do
|
|
|
+ begin
|
|
|
+ try
|
|
|
+ FileName := ZipFile;
|
|
|
+ OutputPath := ZipPath;
|
|
|
+ Examine;
|
|
|
+ UnZipAllFiles;
|
|
|
+ OutLog(audit, 'Unzip from'#9 + ZipFile + #9'to'#9 + ZipPath);
|
|
|
+ DeleteFile(ZipFile);
|
|
|
+ finally
|
|
|
+ Free;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+
|
|
|
+ function InstallOPM(const Path: string): string;
|
|
|
+ begin
|
|
|
+ Result :=
|
|
|
+ {$IFDEF MSWINDOWS}
|
|
|
+ GetEnvironmentVariable('APPDATA') + '\.lazarus\onlinepackagemanager\packages\'
|
|
|
+ {$ELSE}
|
|
|
+ GetEnvironmentVariable('HOME') + '/.lazarus/onlinepackagemanager/packages/'
|
|
|
+ {$ENDIF}
|
|
|
+ + Path;
|
|
|
+ if not DirectoryExists(Result) then
|
|
|
+ begin
|
|
|
+ CreateDir(Result);
|
|
|
+ UnZip(DownloadFile('https://packages.lazarus-ide.org/' + Path + '.zip'), Result);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+
|
|
|
+ function BuildAll: string;
|
|
|
+ var
|
|
|
+ List: TStringList;
|
|
|
+ begin
|
|
|
+ CheckModules;
|
|
|
+ List := FindAllFiles(GetCurrentDir, '*.lpk', True);
|
|
|
+ try
|
|
|
+ for Result in Dependencies do
|
|
|
+ List.AddStrings(FindAllFiles(InstallOPM(Result), '*.lpk', True));
|
|
|
+ for Result in List do
|
|
|
+ AddPackage(Result);
|
|
|
+ List := FindAllFiles(Target, '*.lpi', True);
|
|
|
+ for Result in List do
|
|
|
+ BuildProject(Result);
|
|
|
+ finally
|
|
|
+ List.Free;
|
|
|
+ end;
|
|
|
+ case ExitCode of
|
|
|
+ 0: OutLog(info, 'Errors:'#9 + IntToStr(ExitCode));
|
|
|
+ else
|
|
|
+ OutLog(error, 'Errors:'#9 + IntToStr(ExitCode));
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+
|
|
|
+begin
|
|
|
+ try
|
|
|
+ BuildAll
|
|
|
+ except
|
|
|
+ on E: Exception do
|
|
|
+ Writeln(E.ClassName, #9, E.Message);
|
|
|
+ end;
|
|
|
+end.
|