path: root/tools.pas

unit tools;

{$mode objfpc}{$H+}

interface

uses
  classes, sysUtils, process, mystringlistunit, regExpr;

type
  tAktualitaet = (aNichtVorhanden,aVeraltet,aAktuell,aWirdErneuert);
  tRegexTyp = (rtKein,rtFpc,rtShell);
  tMyStringListBArray = array[boolean] of tMyStringList;
  tSummenDatei = record
    name:   string;
    inhalt: tMyStringListBArray;
  end;
  tDateiMitDatum = class
    name:    ansiString;
    aktuell: tAktualitaet;
  end;
  tDateienMitDaten = class(tFPList)
    function rItem(idx: longint): tDateiMitDatum; inline;
    procedure wItem(idx: longint; neu: tDateiMitDatum); inline;
  public
    property items[idx: longint]: tDateiMitDatum
      read rItem
      write wItem; default;
    procedure mrProper;
    function add(neu: tDateiMitDatum): longint;
    function last: tDateiMitDatum;
    function gleicheNamenWie(dmd: tDateienMitDaten): boolean;
    function toString: string; override;
    procedure append(dmd: tDateienMitDaten);
    function toMyStringList: tMyStringList;
    function finde(name: string; wirdAktualitaet: tAktualitaet = aNichtVorhanden): tDateiMitDatum; overload; inline;
    function finde(name: string; out istNeu: boolean; wirdAktualitaet: tAktualitaet = aNichtVorhanden): tDateiMitDatum; overload; inline;
  end;

function min(a1,a2: tAktualitaet): tAktualitaet; inline; overload;
function max(a1,a2: tAktualitaet): tAktualitaet; inline; overload;
function anzCs(c: char; s: string): longint;
function notQuotedPos(was,worin: string): longint;
function unEscapedPos(was,worin: string): longint;
procedure testeObBefehlLokal(bef, ordner: string; dateiListe: tMyStringList; lokTest: tRegExpr);
function extrahiereAlleDateien(woraus: string; dateiListe: tMyStringList): tMyStringList;
function unescape(s: string): string;
function escape(s,toe,es: string): string;
function escapeStringToRegex(s: string; typ: tRegexTyp; extras: string = ''): string; inline;
procedure ersetzeAlleVorkommen(var worin: string; was,wodurch: string);
function unterVerzeichnisRegex(dateien: array of const): string;

// Routinen für sha512-Prüfsummen

function testeSummen(sumNam: string): tMyStringListBArray;
function dateienMitGueltigerSumme(sumNam: string): tMyStringList;

implementation

uses
  lowlevelunit;

// tDateienMitDaten ************************************************************

function tDateienMitDaten.rItem(idx: longint): tDateiMitDatum;
begin
  result:=tDateiMitDatum(get(idx));
end;

procedure tDateienMitDaten.wItem(idx: longint; neu: tDateiMitDatum);
begin
  put(idx,neu);
end;

procedure tDateienMitDaten.mrProper;
var
  i: longint;
begin
  for i:=0 to count-1 do
    items[i].free;
  clear;
end;

function tDateienMitDaten.add(neu: tDateiMitDatum): longint;
begin
  result:=inherited add(neu);
end;

function tDateienMitDaten.last: tDateiMitDatum;
begin
  result:=tDateiMitDatum(inherited last);
end;

function tDateienMitDaten.gleicheNamenWie(dmd: tDateienMitDaten): boolean;
var
  i,j: longint;
begin
  result:=count=dmd.count;
  if not result then
    exit;
  for i:=0 to count-1 do begin
    result:=false;
    for j:=0 to dmd.count-1 do
      result:=result or (items[i].name = dmd[j].name);
    if not result then exit;
  end;
end;

function tDateienMitDaten.toString: string;
var
  i: longint;
begin
  result:='';
  for i:=0 to count-1 do
    result:=result+''''+items[i].name+''''#10;
end;

procedure tDateienMitDaten.append(dmd: tDateienMitDaten);
var
  i,j:   longint;
  found: boolean;
begin
  for i:=0 to dmd.count-1 do begin
    found:=false;
    for j:=0 to count-1 do
      found:=found or (items[j].name = dmd[i].name);
    if not found then
      add(dmd[i]);
  end;
end;

function tDateienMitDaten.toMyStringList: tMyStringList;
var
  i: longint;
begin
  result:=tMyStringList.create;
  for i:=0 to count-1 do
    result.add(items[i].name);
end;

function tDateienMitDaten.finde(name: string; wirdAktualitaet: tAktualitaet = aNichtVorhanden): tDateiMitDatum;
var
  dummy: boolean;
begin
  result:=finde(name,dummy,wirdAktualitaet);
end;

function tDateienMitDaten.finde(name: string; out istNeu: boolean; wirdAktualitaet: tAktualitaet = aNichtVorhanden): tDateiMitDatum;
var
  i: longint;
begin
  istNeu:=false;
  for i:=0 to count-1 do
    if items[i].name=name then begin
      result:=items[i];
      exit;
    end;
  add(tDateiMitDatum.create);
  istNeu:=true;
  result:=last;
  last.name:=name;
  last.aktuell:=wirdAktualitaet;
end;

// allgemeine Funktionen *******************************************************

function min(a1,a2: tAktualitaet): tAktualitaet;
begin
  if a1<a2 then
    result:=a1
  else
    result:=a2;
end;

function max(a1,a2: tAktualitaet): tAktualitaet;
begin
  if a1>a2 then
    result:=a1
  else
    result:=a2;
end;

function anzCs(c: char; s: string): longint;
var
  i: longint;
begin
  result:=0;
  for i:=1 to length(s) do
    if s[i]=c then
      inc(result);
end;

function notQuotedPos(was,worin: string): longint;
begin
  result:=0;
  repeat
    if pos(was,copy(worin,result+1,length(worin)-result))=0 then begin
      result:=0;
      exit;
    end;
    result:=result+pos(was,copy(worin,result+1,length(worin)-result));
    if not odd(anzCs('"',copy(worin,1,result-1))) then
      exit;
  until false;
end;

function unEscapedPos(was,worin: string): longint;
var
  ebene: longint;
begin
  result:=0;
  ebene:=0;
  while pos(was,copy(worin,result+1,length(worin)))>0 do begin
    repeat
      result:=result+1;
      case worin[result] of
        '{': inc(ebene);
        '}': dec(ebene);
      end;
    until (result>=length(worin)) or ((copy(worin,result,length(was))=was) and (ebene=0));
    if
      ((result=1) or ((worin[result-1]<>'\') and (worin[result-1]<>was))) and
      ((result=length(worin)) or (worin[result+1]<>was)) and
      (copy(worin,result,length(was))=was) then exit;
  end;
  result:=0;
end;

procedure testeObBefehlLokal(bef, ordner: string; dateiListe: tMyStringList; lokTest: tRegExpr);
var
  exe,args,regex,oBef,s:  string;
  dateien,sl,relZeil,env: tMyStringList;
  i,matchNum:             longint;
  re:                     tRegExpr;
begin
  bef:=trim(bef);
  while notQuotedPos(';',bef)>0 do begin
    testeObBefehlLokal(trim(leftStr(bef,notQuotedPos(';',bef)-1)),ordner,dateiListe,lokTest);
    delete(bef,1,notQuotedPos(';',bef));
    bef:=trim(bef);
  end;
  while notQuotedPos('&&',bef)>0 do begin
    testeObBefehlLokal(trim(leftStr(bef,notQuotedPos('&&',bef)-1)),ordner,dateiListe,lokTest);
    delete(bef,1,notQuotedPos('&&',bef)+1);
    bef:=trim(bef);
  end;
  oBef:=bef;

  env:=tMyStringList.create;
  args:='';
  repeat
    exe:=leftStr(bef,notQuotedPos(' ',bef)-1);
    delete(bef,1,length(exe));
    if exe='cat' then begin
      args:=args+' '+trim(leftStr(bef,notQuotedPos('|',bef)-1));
      delete(bef,1,notQuotedPos('|',bef));
    end;
    if notQuotedPos('=',exe)<>0 then begin
      env.add(exe);
      args:=args+' '+trim(copy(exe,notQuotedPos('=',exe)+1,length(exe)));
    end;
    bef:=trim(bef);
  until (notQuotedPos('=',exe)=0) and (exe<>'do') and (exe<>'cat');

  delete(args,1,1);
  exe:=extractfilename(exe);

  if exe='gnuplot' then begin
    //  set output "~/Dokumente/Erich_Masterarbeit/Bilder/gnuplot/Energiescan.tex"
    regex:='^ *set +output +';
    re:=tRegExpr.create;
    re.expression:='"([^"]*/[^"]*)"';
    matchNum:=1;
  end
  else if exe='epost' then begin
    // Datei:
    regex:='^ *(Datei|Legende):';
    re:=tRegExpr.create;
    re.expression:='[^ :]*/[^ ]*';
    matchNum:=0;
  end
  else if exe='math' then begin
    // das wird vmtl. schwer zu überprüfen, außer man nimmt Muster,
    // die generisch auf Pfade passen, aber dann erwischt man auch den Input mit ...
    regex:='^([^"]*"[^"]*")*[^"]*"([^"]*/)+[^"]*"';
    re:=tRegExpr.create;
    re.expression:='"([^"]*/[^"]*)"';
    matchNum:=1;
  end
  else if (exe='cd') then begin
    if not lokTest.exec(bef) then begin
      gibAus('Befehl '''+oBef+''' hat Lokalitätstest nicht bestanden! ('+lokTest.expression+')',3);
      fehler('Lokalitätstest nicht bestanden!');
    end;
    exit;
  end
  // folgende Executables sind unkritisch, da der Name des Outputs i.d.R. direkt
  // vom Namen des Inputs abhängt bzw. per Kommandozeilenparameter übergeben
  // wird (und nicht in einer Datei steht):
  else if (exe='convert') or
    (exe='epstopdf') or
    (exe='latexmk') or
    (exe='mpost') or
    (exe='pdflatex') or
    (exe='sha512sum') or
    (exe='sed') then begin
    env.free;
    exit;
  end
  else begin
    regex:='';
    re:=tRegExpr.create;
    re.expression:='\S+';
    matchNum:=0;
  end;

  dateien:=extrahiereAlleDateien(args+' '+bef,dateiListe);
  if dateien.count = 0 then
    gibAus('Warnung: Hier ist ein Befehl ohne offensichtliche Input-Dateien! ('''+oBef+''')!',3);

  relZeil:=tMyStringList.create;
  if regex='' then begin
    // dateien sind bereits die zu betrachtenden Dateien
    for i:=0 to dateien.count-1 do begin
      if re.exec(dateien[i]) then
        relZeil.add(dateien[i]);
    end;
  end
  else begin
    sl:=tMyStringList.create;
    for i:=0 to dateien.count-1 do begin
      sl.loadFromFile(dateien[i]);
      sl.shellSubst(env);
      if exe='epost' then begin
        sl.grep(regex+'|^[!?]');
        sl.unfoldMacros;
      end;
      sl.grep(regex);
      relZeil.addStrings(sl);
    end;
    sl.free;
  end;
  dateien.free;

  for i:=0 to relZeil.count-1 do begin
    if not re.exec(relZeil[i]) then begin
      gibAus('Warnung: Hier ist eine Zeile in der Optionsdatei, die keine passende Inputdatei benennt, es aber sollte! ('''+relZeil[i]+''')!',3);
      continue;
    end;
    repeat
      s:=trim(re.match[matchNum]);
      if (leftStr(s,1)='"') and (rightStr(s,1)='"') then begin
        delete(s,1,1);
        delete(s,length(s),1);
      end;
      if not lokTest.exec(s) then begin
        gibAus(''''+relZeil[i]+''' in Befehl '''+oBef+''' hat Lokalitätstest nicht bestanden! ('+lokTest.expression+')',3);
        fehler('Lokalitätstest nicht bestanden!');
      end;
    until not re.execNext;
  end;
  re.free;
  relZeil.free;
end;

function extrahiereAlleDateien(woraus: string; dateiListe: tMyStringList): tMyStringList;
var
  s: string;
begin
  result:=tMyStringList.create;
  woraus:=woraus+' ';
  while notQuotedPos(' ',woraus)>0 do begin
    s:=leftStr(woraus,notQuotedPos(' ',woraus));
    delete(woraus,1,length(s));
    s:=trim(s);
    if fileexists(s) or dateiListe.hatZeile(s,false) then
      result.add(s);
  end;
end;

function unescape(s: string): string;
begin
  result:=s;
  while pos('\,',result)>0 do
    delete(result,pos('\,',result),1);
end;

function escape(s,toe,es: string): string;
var
  i,j: longint;
  b:   boolean;
begin
  result:='';
  for i:=1 to length(s) do begin
    b:=false;
    for j:=1 to length(toe) do
      b:=b or (toe[j]=s[i]);
    if b then result:=result+es;
    result:=result+s[i];
  end;
end;

function escapeStringToRegex(s: string; typ: tRegexTyp; extras: string = ''): string;
begin
  case typ of
    rtKein:
      result:=s;
    rtFpc:
      result:=escape(s,'\.[+^$'+extras,'\');
    rtShell:
      result:=escape(s,'\.[^$'+extras,'\');
  end{of case};
end;

procedure ersetzeAlleVorkommen(var worin: string; was,wodurch: string);
begin
  while pos(was,worin)>0 do begin
    worin:=
      leftStr(worin,pos(was,worin)-1) +
      wodurch +
      rightStr(worin,length(worin)-pos(was,worin)-length(was)+1);
  end;
end;

function unterVerzeichnisRegex(dateien: array of const): string;
var
  i,j:      longint;
  dats:     tStringList;
  s:        string;
  rekursiv: boolean;
begin
  result:='';
  dats:=tStringList.create;
  for i:=0 to length(dateien)-1 do
    case dateien[i].vType of
      vtChar:
        dats.add(dateien[i].vChar);
      vtWideChar:
        dats.add(string(dateien[i].vWideChar));
      vtString:
        dats.add(string(dateien[i].vString));
      vtPChar:
        dats.add(dateien[i].vPChar);
      vtPWideChar:
        dats.add(dateien[i].vPWideChar);
      vtAnsiString:
        dats.add(string(dateien[i].vAnsiString));
      vtWideString:
        dats.add(string(dateien[i].vWideString));
      vtObject:
        if dateien[i].vObject is tStringList then begin
          for j:=0 to (dateien[i].vObject as tStringList).count-1 do
            dats.add((dateien[i].vObject as tStringList)[j]);
        end
        else
          fehler('unterVerzeichnisRegex Argument Nummer '+intToStr(i)+' ist ein Klasse, aber keine StringList!');
      else
        fehler('unterVerzeichnisRegex Argument Nummer '+intToStr(i)+' ist kein String!');
    end{of case};

  for i:=0 to dats.count-1 do begin
    s:=dats[i];
    rekursiv:=leftStr(s,1)='1';
    delete(s,1,1);
    if rekursiv then begin
      s:=extractFilePath(s);
      while rightStr(s,1)='/' do
        delete(s,length(s),1);
    end;
    s:=escapeStringToRegex(s,rtFpc); // "*" soll nicht escaped werden, müsste bei rtFpc aber eigentlich escaped werden!
    s:=escape(s,'*','[^/]');
    if leftStr(s,1)='/' then // absoluter Pfad
      s:='^'+s;
    result:=result+'|'+s;
    if rekursiv then
      result:=result+'(/|$)'
    else
      result:=result+'$';
  end;
  delete(result,1,1);
end;

// Routinen für sha512-Prüfsummen

var
  summenVorrat: array of tSummenDatei;

function testeSummen(sumNam: string): tMyStringListBArray;
var
  p:    tProcess;
  rb,i: longint;
  s:    string;
  erg:  tStringList;
  gut:  boolean;
const leseHappen=65536;
begin
  for i:=0 to length(summenVorrat)-1 do
    if summenVorrat[i].name=sumNam then begin
      for gut:=false to true do begin
        result[gut]:=tMyStringList.create;
        result[gut].text:=summenVorrat[i].inhalt[gut].text;
      end;
      exit;
    end;

  p:=tProcess.create(nil);
  p.executable:='sha512sum';
  p.parameters.add('-c');
  p.parameters.add(sumNam);
  p.options:=p.options + [poUsePipes];
  p.execute;
  rb:=0;
  s:='';
  while p.running do begin
    if p.output.numBytesAvailable=0 then sleep(10)
    else begin
      setLength(s,rb+leseHappen);
      rb:=rb+p.output.read(s[rb+1],leseHappen);
    end;
  end;
  if p.output.numBytesAvailable>0 then begin
    setLength(s,rb+leseHappen);
    rb:=rb+p.output.read(s[rb+1],leseHappen);
  end;
  p.free;
  setLength(s,rb);
  erg:=tStringList.create;
  erg.text:=s;
  s:='';
  for gut:=false to true do begin
    result[gut]:=tMyStringList.create;
    rb:=0;
    for i:=0 to erg.count-1 do
      if not gut xor (rightStr(erg[i],4)=': OK') then begin
        s:=leftStr(erg[i],pos(':',erg[i])-1);
        if leftStr(s,1)<>'/' then
          s:=extractFilePath(sumNam)+s;
        result[gut].add(s);
        inc(rb);
      end;
  end;
  erg.free;

  setLength(summenVorrat,length(summenVorrat)+1);
  with summenVorrat[length(summenVorrat)-1] do begin
    name:=sumNam;
    for gut:=false to true do begin
      inhalt[gut]:=tMyStringList.create;
      inhalt[gut].text:=result[gut].text;
    end;
  end;
end;

function dateienMitGueltigerSumme(sumNam: string): tMyStringList;
var
  sums: tMyStringListBArray;
begin
  sums:=testeSummen(sumNam);
  result:=sums[true];
  sums[false].free;
end;

var
  i: longint;

initialization
  setLength(summenVorrat,0);

finalization
  for i:=0 to length(summenVorrat)-1 do
    with summenVorrat[i] do begin
      name:='';
      inhalt[false].free;
      inhalt[true].free;
    end;
  setLength(summenVorrat,0);
end.