path: root/tools.pas

unit tools;

{$mode objfpc}{$H+}

interface

uses
  classes, sysUtils, process, mystringlistunit, regExpr, lowlevelunit;

type
  tAktualitaet = (aNichtVorhanden,aVeraltet,aAktuell,aWirdErneuert);
  tRegexTyp = (rtKein,rtFpc,rtShell);
  tMyStringListBArray = array[boolean] of tMyStringList;
  tSummenDatei = record
    name:   string;
    inhalt: tMyStringListBArray;
  end;
  tDateiMitDatum = class
  private
    _name:    ansiString;
  public
    aktuell: tAktualitaet;
    property name: ansiString
      read _name;
    constructor create(nam: ansiString; ak: tAktualitaet);
  end;
  tDateienMitDaten = class(tFPList)
  private
    sortiert:    tLongintArray;
    istSortiert: boolean;
    procedure sortiereNachNamen; inline;
    procedure quickSort(li,re,ungeradheit: longint);
    function rItem(idx: longint): tDateiMitDatum; inline;
    procedure wItem(idx: longint; neu: tDateiMitDatum); inline;
    function rSItem(idx: longint): tDateiMitDatum; inline;
    procedure pruefeSortierung;
  public
    property items[idx: longint]: tDateiMitDatum
      read rItem
      write wItem; default;
    property sItems[idx: longint]: tDateiMitDatum
      read rSItem;
    constructor create;
    destructor destroy; override;
    procedure mrProper;
    function add(neu: tDateiMitDatum): longint;
    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;
    function findeIndex(name: string): longint; inline;
    procedure matchAll(regEx: string; out indizes: tLongintArray; istRegex: boolean);
    procedure delete(idx: longint);
  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;
function vergleicheNamenVonDateienMitDaten(item1,item2: pointer): integer;

// Routinen für sha512-Prüfsummen

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

implementation

uses
  math;

// tDateiMitDatum **************************************************************

constructor tDateiMitDatum.create(nam: ansiString; ak: tAktualitaet);
begin
  inherited create;
  _name:=nam;
  aktuell:=ak;
end;

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

constructor tDateienMitDaten.create;
begin
  inherited create;
  setLength(sortiert,0);
  istSortiert:=true;
end;

destructor tDateienMitDaten.destroy;
begin
  setLength(sortiert,0);
  inherited destroy;
end;

procedure tDateienMitDaten.sortiereNachNamen;
var
  i: longint;
begin
  if istSortiert then
    exit;
  setLength(sortiert,count);
  for i:=0 to length(sortiert)-1 do
    sortiert[i]:=i;
  quickSort(0,count-1,0);
  istSortiert:=true;
end;

procedure tDateienMitDaten.quickSort(li,re,ungeradheit: longint);
var
  pivot:   string;
  l,r,tmp: longint;
begin
  if li>=re then
    exit;
  r:=0;
  for l:=li+1 to re do
    if items[sortiert[l]].name<>items[sortiert[li]].name then begin
      r:=1;
      break;
    end;
  if r=0 then  // nur gleiche Namen
    exit;
  pivot:=items[sortiert[(li+re) div 2]].name;
  l:=li;
  r:=re;
  while l<=r do begin
    while (l<length(sortiert)) and (vergleicheStrings(items[sortiert[l]].name,pivot)<ungeradheit) do
      inc(l);
    while (r>=0) and (vergleicheStrings(items[sortiert[r]].name,pivot)>ungeradheit-1) do
      dec(r);
    if l<r then begin
      tmp:=sortiert[l];
      sortiert[l]:=sortiert[r];
      sortiert[r]:=tmp;
      inc(l);
      dec(r);
    end;
  end;
  assert(l=r+1,'Fehler in Quicksort: '+intToStr(l)+'<>'+intToStr(r)+'+1!');
  quickSort(li,r,1-ungeradheit);
  quickSort(l,re,1-ungeradheit);
end;

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

procedure tDateienMitDaten.wItem(idx: longint; neu: tDateiMitDatum);
begin
  assert(neu.name<>'','wItem: Dateiname darf nicht leer sein!');
  put(idx,neu);
  istSortiert:=false;
end;

function tDateienMitDaten.rSItem(idx: longint): tDateiMitDatum; inline;
begin
  sortiereNachNamen;
  result:=items[sortiert[idx]];
end;

procedure tDateienMitDaten.pruefeSortierung;
var
  i: longint;
begin
  sortiereNachNamen;
  assert(count=length(sortiert),'tDateienMitDaten.pruefeSortierung: length(sortiert) <> count!');
  for i:=1 to count-1 do
    assert(vergleicheStrings(sItems[i-1].name,sItems[i].name)<0,'tDateienMitDaten.pruefeSortierung: '''+sItems[i-1].name+'''>='''+sItems[i].name+'''!');
end;

procedure tDateienMitDaten.mrProper;
var
  i: longint;
begin
  for i:=0 to count-1 do
    items[i].free;
  clear;
  setLength(sortiert,0);
  istSortiert:=true;
end;

function tDateienMitDaten.add(neu: tDateiMitDatum): longint;
begin
  assert(neu.name<>'','add: Dateiname darf nicht leer sein!');
  result:=inherited add(neu);
  istSortiert:=false;
end;

function tDateienMitDaten.gleicheNamenWie(dmd: tDateienMitDaten): boolean;
var
  i: longint;
begin
  result:=count=dmd.count;
  if not result then
    exit;
  result:=false;
  for i:=0 to count-1 do
    if sItems[i].name <> dmd.sItems[i].name then
      exit;
  result:=true;
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;
begin
  j:=0;
  for i:=0 to dmd.count-1 do begin
    while (j<length(sortiert)) and (vergleicheStrings(dmd.sItems[i].name,sItems[j].name)<0) do
      inc(j);
    if (j<length(sortiert)) and (vergleicheStrings(dmd.sItems[i].name,sItems[j].name)=0) then
      continue;
    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
  i:=findeIndex(name);
  if (i>=0) and (i<count) and (sItems[i].name = name) then begin
    result:=sItems[i];
    istNeu:=false;
    exit;
  end;
  add(tDateiMitDatum.create(name,wirdAktualitaet));
  istNeu:=true;
  result:=tDateiMitDatum(last);
end;

function tDateienMitDaten.findeIndex(name: string): longint;
var
  li,re,i: longint;
begin
  sortiereNachNamen;
  li:=0;
  re:=count-1;
  while li<=re do begin
    i:=(li+re) div 2;
    case vergleicheStrings(sItems[i].name,name) of
      -1: li:=i+1;
      1: re:=i-1;
      0: begin
        li:=i;
        re:=i;
        break;
      end;
    end{of case};
  end;
  if li=re then begin
    assert(sItems[li].name=name,'Fehler in Bisektion: '''+sItems[li].name+'''<>'''+name+'''!');
    result:=li;
    exit;
  end;
  assert(li=re+1,'Fehler in Bisektion: '+intToStr(li)+'<>'+intToStr(re)+'+1!');
  result:=li;
end;

procedure tDateienMitDaten.matchAll(regEx: string; out indizes: tLongintArray; istRegex: boolean);
var
  re: tRegExpr;
  i:  longint;
begin
  setLength(indizes,0);
  if istRegex then begin
    re:=tRegExpr.create;
    re.expression:=regEx;
    for i:=0 to count-1 do
      if re.exec(items[i].name) then begin
        setLength(indizes,length(indizes)+1);
        indizes[length(indizes)-1]:=i;
      end;
  end
  else begin
    i:=findeIndex(regEx);
    if (i>=0) and (i<count) and (sItems[i].name=regEx) then begin
      setLength(indizes,1);
      indizes[0]:=longint(sortiert[i]);
    end;
  end;
end;

procedure tDateienMitDaten.delete(idx: longint);
begin
  inherited delete(idx);
  istSortiert:=false;
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
      if not fileExists(dateien[i]) then
        continue;
      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;

function vergleicheNamenVonDateienMitDaten(item1,item2: pointer): integer;
begin
  result:=vergleicheStrings(tDateiMitDatum(item1).name,tDateiMitDatum(item2).name);
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;
  dummy: array of byte;
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:='parallel';
  p.parameters.add('--pipepart');
  p.parameters.add('sha512sum');
  p.parameters.add('-c');
  p.parameters.add('::::');
  p.parameters.add(sumNam);
  p.options:=p.options + [poUsePipes];
  p.execute;
  rb:=0;
  s:='';
  setLength(dummy,1024);
  fillchar(dummy[0],length(dummy),0);
  while p.running do begin
    while p.stderr.numBytesAvailable>0 do
      p.stderr.read(dummy[0],min(length(dummy),p.stderr.numBytesAvailable));
    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.