mixster

program SRLUpdater;

function GetRemoteSRLVersion(tryagain: Boolean): string;
var
  pageSauce: string;
begin
  pageSauce := ps_GetPage('http://vila.villavu.com/cgi-bin/gitweb/gitweb.cgi?p=srl-opendev.git;a=commit');
  Result := Between('<tr><td>commit</td><td class="sha1">', '</td></tr>', pageSauce);
  if (Result = '') or (pageSauce = '') then
  begin
    if (tryagain) then
    begin
      Writeln('Error retrieving remote SRL version. Trying again');
      Result := GetRemoteSRLVersion(False);
    end
    else
    begin
      Writeln('Error retrieving the remote SRL version. Not trying again');
    end;
  end;
end;

function IsSRLDownloaded(out uptodate: Boolean): Boolean;
var
  remoteVersion, localVersion: string;
begin
  Result := SettingsIsKey('SRLVersion');

  if (Result) then
  begin
    remoteVersion := GetRemoteSRLVersion(True);
    if (remoteVersion = '') then
    begin
      Writeln('Unable to get remote version - assuming SRL include is up to date');
      uptodate := True;
    end
    else
    begin
      localVersion := SettingsGetKeyValue('SRLVersion');
      uptodate := localVersion = remoteVersion;

      if (uptodate) then
        Writeln('The local SRL include is up-to-date!')
      else
        Writeln('The local SRL include is not up-to-date');
    end;
  end
  else
  begin
    uptodate := False;
    Writeln('There currently is no local version of the SRL includes!');
  end;
end;

type
  TFile = record
    path, filename: string;
  end;

  TSVNFile = record
    local, remote: TFile;
  end;

  TMatch = record
    start, finish: string;
  end;

  TFilter = record
    exp, dir, fil: string;
    local, remote: TMatch;
  end;

  TSVN = record
    name: string;
    skip: TStringArray;
    baseloc: TSVNFile;
    files: array of TSVNFile;
    filter: TFilter;
    rev: TMatch;
    col: Boolean;
  end;

function Explode(str, del: string): TStringArray;
var
  i, l, dL: Integer;
begin
  i := 0;
  l := -1;
  SetLength(Result, 0);
  if (str = '') then
    Exit;
  dL := Length(del) - 1;
  repeat
    Inc(l);
    SetLength(Result, l + 1);
    i := Pos(del, str);
    if i <= 0 then
      Break;
    Result[l] := Copy(str, 1, i - 1);
    Delete(str, 1, i + dL);
  until false
  Result[l] := Copy(str, 1, Length(str));
end;

function ReturnPage(svn: TSVN; dir: TSVNFile; tryagain: Boolean): string;
var
  url: string;
begin
  url := svn.baseloc.remote.path + dir.remote.path;

  Result := GetPage(url);

  if (Result = '') then
  begin
    if (tryagain) then
    begin
      Writeln('Downloading url "' + url + '" failed - trying again');
      Result := ReturnPage(svn, dir, False);
    end
    else
    begin
      Writeln('Downloading url "' + url + '" failed - not trying again');
    end;
  end;
end;

procedure RawCollectSVN(var svn: TSVN; cur_dir: TSVNFile);
var
  input, tmpLoc, tmpRem: string;
  split: TStringArray;
  h, i: Integer;
  new_dir: TSVNFile;
  sk: Boolean;
begin
  input := ReturnPage(svn, cur_dir, True);
  split := Explode(input, svn.filter.exp);

  for i := 0 to High(split) do
  begin
    for h := 0 to High(svn.skip) do
    begin
      sk := Pos(svn.skip[h], split[i]) > 0;
      if sk then
        Break;
    end;

    if sk then
      Continue;

    tmpLoc := Between(svn.filter.local.start, svn.filter.local.finish, split[i]);
    tmpRem := Between(svn.filter.remote.start, svn.filter.remote.finish, split[i]);

    if (tmpLoc = '') or (tmpRem = '') then
      Continue;

    if Pos(svn.filter.dir, split[i]) > 0 then // Handle directory
    begin
      new_dir.local.path := cur_dir.local.path + tmpLoc;
      new_dir.local.path := new_dir.local.path + '/'

      new_dir.remote.path := cur_dir.remote.path + tmpRem;
      Writeln('Discovered directory "' + cur_dir.local.path + tmpLoc + '"');

      if not DirectoryExists(svn.baseloc.local.path + new_dir.local.path) then
        if not CreateDirectory(svn.baseloc.local.path + new_dir.local.path) then
          Writeln(format('Could not create the folder: %s',[svn.baseloc.local.path + new_dir.local.path]));

      RawCollectSVN(svn, new_dir);
    end
    else if Pos(svn.filter.fil, split[i]) > 0 then // Handle file
    begin;
      h := Length(svn.files);
      SetLength(svn.files, h + 1);

      svn.files[h].local.path := cur_dir.local.path;
      svn.files[h].local.filename := tmpLoc;
      svn.files[h].remote.path := cur_dir.remote.path;
      svn.files[h].remote.filename := tmpRem;
    end;
  end;
end;

procedure CollectSVN(var svn: TSVN);
var
  start: TSVNFile;
  t: Integer;
begin
  Writeln('Now starting to collect "' + svn.name + '"');
  t := GetSystemTime;
  RawCollectSVN(svn, start);
  svn.col := True;
  t := GetSystemTime - t;
  Writeln('Finished collecting "' + svn.name + '" in ' + IntToStr(t) + ' ms');
  Writeln('A total of ' + IntToStr(Length(svn.files)) + ' files were collected');
end;

procedure DownloadSVN(svn: TSVN);
var
  i, f, l, t: Integer;
  s, remoteVersion: string;
  opt: TReplaceFlags;
begin
  Writeln('Now starting to download "' + svn.name + '"');
  Writeln('');

  opt := [rfReplaceAll];

  t := GetSystemTime;
  l := Length(svn.files);
  for i := 0 to l - 1 do
    try
      s := svn.baseloc.local.path + svn.files[i].local.path + svn.files[i].local.filename;

      f := RewriteFile(s, False);
      if (f = -1) then
      begin
        Writeln('Error writing ''' + s + '''' + ' (' + IntToStr(i) + ' of ' + IntToStr(l - 1) + ')');
        Continue;
      end
      else
        Writeln(s + ' (' + IntToStr(i) + ' of ' + IntToStr(l - 1) + ')');

      WriteFileString(f, GetPage(svn.baseloc.remote.path + svn.files[i].remote.path + svn.files[i].remote.filename));
      CloseFile(f);
    except
      Writeln('Failed to download file.');
    end;
  t := GetSystemTime - t;
  Writeln('Finished downloading "' + svn.name + '" in ' + IntToStr(t) + ' ms');

  remoteVersion := GetRemoteSRLVersion(True);
  if (remoteVersion = '') then
  begin
    Writeln('Appears to have successfully updated SRL, but unable to update the settings with the new version');
    Writeln('This will most likely mean you will be told your SRL include is outdated, even if it is not');
    Writeln('Please bear with us and either ignore it until you know SRL has been updated or update again :)');
  end
  else
  begin
    SettingsGetSetDefaultKeyValue('SRLVersion', remoteVersion);
  end;
end;

function ReturnSRLSVN: TSVN;
var
  opt: TReplaceFlags;
begin
  Result.name := 'SRL';
  Result.baseloc.remote.path := 'http://www.villavu.com/repositories/srl-opendev/';
  opt := [rfReplaceAll];
  Result.baseloc.local.path := Replace(IncludePath + 'SRL/', '\', '/', opt);

  if not DirectoryExists(Result.baseloc.local.path) then
    CreateDirectory(Result.baseloc.local.path);

  Result.filter.exp := '<';
  Result.filter.dir := 'dir';
  Result.filter.fil := 'file';

  Result.filter.local.start := 'name="';
  Result.filter.local.finish := '"';

  Result.filter.remote.start := 'href="';
  Result.filter.remote.finish := '"';

  Result.rev.start := 'rev="';
  Result.rev.finish := '"';
  Result.skip := [];
end;

procedure MovePlugins(svn: TSVN; dest: string);
var
  i, f: Integer;
  s: string;
  o: Boolean;
begin
  for i := 0 to High(svn.files) do
    if {$IFDEF LINUX} (Pos('.so', svn.files[i].local.filename) > 0)
       {$ELSE} (Pos('.dll', svn.files[i].local.filename) > 0) {$ENDIF} then
      try
        Writeln('Found plugin "' + svn.files[i].local.filename);
        if (Pos('Simba', svn.files[i].local.path) <= 0) then
        begin
          Writeln('Not a Simba plugin - ignoring');
          Continue;
        end;
        o := False;
        f := OpenFile(svn.baseloc.local.path + svn.files[i].local.path + svn.files[i].local.filename, False);
        if (f = -1) then
        begin
          Writeln('Error opening file ''' + svn.baseloc.local.path + svn.files[i].local.path + svn.files[i].local.filename + '''');
          Continue;
        end;
        ReadFileString(f, s, FileSize(f));
        CloseFile(f);
        o := True;
        f := RewriteFile(dest + svn.files[i].local.filename, False);
        if (f = -1) then
        begin
          Writeln('Error opening file ''' + dest + svn.files[i].local.filename + '''');
          Continue;
        end;
        WriteFileString(f, s);
        CloseFile(f);
      except
        Writeln('Failed to save plugin.');
        if o then
          Writeln('Problem involved rewriting the file at target folder')
        else
          Writeln('Problem involved opening the sauce file to read');
      end;
end;

var
  MainMenuItem, MenuCheck, MenuUpdate, MenuMove : TMenuItem;
  started: Boolean;

procedure CheckSRLVersions;
var
  tmp: Boolean;
begin
  IsSRLDownloaded(tmp);
end;

procedure UpdateSRL;
var
  svn: TSVN;
begin
  svn := ReturnSRLSVN;
  CollectSVN(svn);
  DownloadSVN(svn);
end;

procedure OnSRLUpdaterClick(Sender: TObject);
var
  svn: TSVN;
begin
  Writeln('Click!');
  if (Sender = MenuCheck) then
  begin
    CheckSRLVersions;
    Writeln('We checked and you''re fine, or maybe not!');
  end
  else if (Sender = MenuUpdate) then
  begin
    UpdateSRL;
    Writeln('Updated you - looks good, or does it?');
  end
  else if (Sender = MenuMove) then
  begin
    svn := ReturnSRLSVN;
    CollectSVN(svn);
    MovePlugins(svn, PluginPath);
  end;
end;

procedure Init;
begin;
  MainMenuItem := TMenuItem.Create(Simba_MainMenu);
  MainMenuItem.Caption := 'SRL';
  Simba_MainMenu.Items.Add(MainMenuItem);

  MenuCheck := TMenuItem.Create(MainMenuItem);
  MenuCheck.Caption := 'Check for new SRL';
  MenuCheck.OnClick := @OnSRLUpdaterClick;
  MainMenuItem.Add(MenuCheck);

  MenuUpdate := TMenuItem.Create(MainMenuItem);
  MenuUpdate.Caption := 'Update SRL';
  MenuUpdate.OnClick := @OnSRLUpdaterClick;
  MainMenuItem.Add(MenuUpdate);

  MenuMove := TMenuItem.Create(MainMenuItem);
  MenuMove.Caption := 'Move SRL plugins';
  MenuMove.OnClick := @OnSRLUpdaterClick;
  MainMenuItem.Add(MenuMove);

  started := True;
end;

procedure Free;
begin
  if (started) then
  begin
    MenuCheck.Free;
    MenuUpdate.Free;
    MainMenuItem.Free;
  end;
end;

procedure Attach;
var
  tmp: Boolean;
begin
  MainMenuItem.Visible := True;
  IsSRLDownloaded(tmp);
end;

Procedure Detach;
begin
  Writeln('Fine, look after your own includes. See if we care!');
  MainMenuItem.Visible := False;
end;

function GetName : string;
begin;
  result := 'SRL Updater';
end;

function GetVersion : string;
begin;
  result := '1.0';
end;


begin
end.