BrookFreepascal/.github/workflows/make.pas

program Make;
{$mode objfpc}{$H+}

uses
  Classes,
  SysUtils,
  StrUtils,
  FileUtil,
  Zipper,
  fphttpclient,
  RegExpr,
  openssl,
  opensslsockets,
  Process;

const
  Target: string = 'demos';
  Dependencies: array of string = ('Rhl', 'XMailer', 'dOPF', 'Brookframework', 'Synapse40.1');

type
  TLog = (audit, info, error);
  Output = record
    Code: boolean;
    Output: ansistring;
  end;


  procedure OutLog(Knd: TLog; 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: Output;
  begin
    if FileExists('.gitmodules') then
      if RunCommand('git', ['submodule', 'update', '--init', '--recursive',
        '--force', '--remote'], Result.Output) then
        OutLog(info, Result.Output);
  end;

  function AddPackage(Path: string): Output;
  begin
    with TRegExpr.Create do
    begin
      Expression :=
        {$IFDEF MSWINDOWS}
          '(cocoa|x11|_template)'
        {$ELSE}
          '(cocoa|gdi|_template)'
        {$ENDIF}
      ;
      if not Exec(Path) and RunCommand('lazbuild', ['--add-package-link', Path],
        Result.Output) then
        OutLog(audit, 'added ' + Path);
      Free;
    end;
  end;

  function BuildProject(Path: string): Output;
  var
    Line: string;
  begin
    OutLog(audit, 'build from ' + Path);
    try
      Result.Code := RunCommand('lazbuild', ['--build-all', '--recursive',
        '--no-write-project', Path], Result.Output);
      if Result.Code then
        for Line in SplitString(Result.Output, LineEnding) do
        begin
          if ContainsStr(Line, 'Linking') then
          begin
            Result.Output := SplitString(Line, ' ')[2];
            OutLog(info, ' to ' + Result.Output);
            break;
          end;
        end
      else
      begin
        ExitCode += 1;
        for Line in SplitString(Result.Output, LineEnding) do
          with TRegExpr.Create do
          begin
            Expression := '(Fatal|Error):';
            if Exec(Line) then
              OutLog(error, #10 + Line);
            Free;
          end;
      end;
    except
      on E: Exception do
        OutLog(error, E.ClassName + #13#10 + E.Message);
    end;
  end;

  function RunTest(Path: string): Output;
  var
    Temp: string;
  begin
    Result := BuildProject(Path);
    Temp:= Result.Output;
    if Result.Code then
        try
          if not RunCommand(Temp, ['--all', '--format=plain', '--progress'], Result.Output) then
          begin
            ExitCode += 1;
            OutLog(error, Result.Output);
          end;
        except
          on E: Exception do
            OutLog(error, E.ClassName + #13#10 + E.Message);
        end;
  end;

  function InstallOPM(Each: string): string;
  var
    OutFile, Uri: string;
    Zip: TStream;
  begin
    Result :=
      {$IFDEF MSWINDOWS}
      GetEnvironmentVariable('APPDATA') + '\.lazarus\onlinepackagemanager\packages\'
      {$ELSE}
      GetEnvironmentVariable('HOME') + '/.lazarus/onlinepackagemanager/packages/'
      {$ENDIF}
      + Each;
    OutFile := GetTempFileName;
    Uri := 'https://packages.lazarus-ide.org/' + Each + '.zip';
    if not DirectoryExists(Result) then
    begin
      Zip := TFileStream.Create(OutFile, fmCreate or fmOpenWrite);
      with TFPHttpClient.Create(nil) do
      begin
        try
          AddHeader('User-Agent', 'Mozilla/5.0 (compatible; fpweb)');
          AllowRedirect := True;
          Get(Uri, Zip);
          OutLog(audit, 'Download from ' + Uri + ' to ' + OutFile);
        finally
          Free;
        end;
      end;
      Zip.Free;
      CreateDir(Result);
      with TUnZipper.Create do
      begin
        try
          FileName := OutFile;
          OutputPath := Result;
          Examine;
          UnZipAllFiles;
          OutLog(audit, 'Unzip from ' + OutFile + ' to ' + Result);
        finally
          Free;
        end;
      end;
      DeleteFile(OutFile);
    end;
  end;

  procedure BuildAll;
  var
    Each, Item: string;
    List: TStringList;
  begin
    CheckModules;
    InitSSLInterface;
    for Item in Dependencies do
    begin
      List := FindAllFiles(InstallOPM(Item), '*.lpk', True);
      try
        for Each in List do
          AddPackage(Each);
      finally
        List.Free;
      end;
    end;
    List := FindAllFiles(GetCurrentDir, '*.lpk', True);
    try
      for Each in List do
        AddPackage(Each);
    finally
      List.Free;
    end;
    List := FindAllFiles(Target, '*.lpi', True);
    try
      for Each in List do
        if ContainsStr(ReadFileToString(ReplaceStr(Each, '.lpi', '.lpr')),
          'consoletestrunner') then
          RunTest(Each)
        else
          BuildProject(Each);
    finally
      List.Free;
    end;
    if ExitCode <> 0 then
      OutLog(error, #10 + 'Errors: ' + IntToStr(ExitCode))
    else
      OutLog(info, #10 + 'Errors: ' + IntToStr(ExitCode));
  end;

begin
  BuildAll;
end.