path: root/tools.pas

unit tools;

{$mode objfpc}{$H+}

interface

uses
  classes, sysUtils, process, mystringlistunit, regExpr;

type
  tAktualitaet = (aNichtVorhanden,aVeraltet,aAktuell,aWirdErneuert);
  tStringlistBArray = array[boolean] of tStringlist;
  tSummenDatei = record
    name:   string;
    inhalt: tStringlistBArray;
  end;
  tDateiMitDatum = class
    name:    ansiString;
    aktuell: tAktualitaet;
  end;
  tDateienMitDaten = array of tDateiMitDatum;

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; lokTest: tRegExpr);
function extrahiereAlleDateien(woraus: string): tMyStringList;
function unescape(s: string): string;
function escape(s,toe: string; ec: char): string;
function bashMatch(was,worauf: string): boolean;
function gleicheDateinamen(dl1,dl2: tDateienMitDaten): boolean;

// Routinen für sha512-Prüfsummen

function testeSummen(sumNam: string): tStringlistBArray;
function dateienMitGueltigerSumme(sumNam: string): tStringList;

implementation

uses
  lowlevelunit;

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; lokTest: tRegExpr);
var
  exe,args,regex,oBef,s: string;
  dateien,sl,relZeil:    tMyStringlist;
  i,j:                   longint;
  re:                    tRegExpr;
begin
  oBef:=bef;

  while notQuotedPos(';',bef)>0 do begin
    testeObBefehlLokal(trim(leftStr(bef,notQuotedPos(';',bef)-1)),ordner,lokTest);
    delete(bef,1,notQuotedPos(';',bef));
    bef:=trim(bef);
  end;

  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;
    bef:=trim(bef);
  until (notQuotedPos('=',bef)=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:='"[^"]*/[^"]*"';
  end
  else if exe='epost' then begin
    // Datei:
    regex:='^ *(Datei|Legende): *';
    re:=tRegExpr.create;
    re.expression:='[^ :]*/[^ ]*';
  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:='"[^"]*/[^"]*"';
  end
  else exit;

  // 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):
  //
  // 'convert'
  // 'epstopdf'
  // 'latexmk'
  // 'mpost'
  // 'pdflatex'

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

  sl:=tMyStringlist.create;
  relZeil:=tMyStringlist.create;
  for i:=0 to dateien.count-1 do begin
    sl.loadFromFile(dateien[i]);
    sl.grep(regex);
    relZeil.addStrings(sl);
  end;
  sl.free;
  dateien.free;

  for i:=0 to relZeil.count-1 do begin
    re.inputString:=relZeil[i];
    if re.subExprMatchCount=0 then
      gibAus('Warnung: Hier ist eine Zeile in der optionsdatei, die keine passende Inputdatei benennt, es aber sollte! ('''+relZeil[i]+''')!',3);
    for j:=0 to re.subExprMatchCount-1 do begin
      s:=trim(re.match[j]);
      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
        fehler(''''+relZeil[i]+''' in Befehl '''+oBef+''' hat Lokalitätstest nicht bestanden! ('+lokTest.expression+')');
    end;
  end;
  re.free;
  relZeil.free;
end;

function extrahiereAlleDateien(woraus: string): 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) 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: string; ec: char): 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+ec;
    result:=result+s[i];
  end;
end;

function bashMatch(was,worauf: string): boolean;
var
  re: tRegExpr;
begin
  if pos('*',was)=0 then begin
    result:=was=worauf;
    exit;
  end;
  re:=tRegExpr.create;
  re.expression:='^'+escape(escape(was,'.|()^$','\'),'*','.')+'$';
  result:=re.exec(worauf);
  re.free;
end;

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

// Routinen für sha512-Prüfsummen

var
  summenvorrat: array of tSummenDatei;

function testeSummen(sumNam: string): tStringlistBArray;
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]:=tStringlist.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]:=tStringlist.create;
    rb:=0;
    for i:=0 to erg.count-1 do
      if not gut xor (rightStr(erg[i],4)=': OK') then begin
        result[gut].add(leftStr(erg[i],pos(':',erg[i])-1));
        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]:=tStringlist.create;
      inhalt[gut].text:=result[gut].text;
    end;
  end;
end;

function dateienMitGueltigerSumme(sumNam: string): tStringList;
var
  sums: tStringlistBArray;
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.