path: root/dateibeziehungen.pas

unit dateiBeziehungen;

{$mode objfpc}{$H+}

interface

uses
  classes, sysUtils, tools, regExpr;

type
  tAbhArt = (aaFinal,aaPrimaer,aaIgnore);
  tZeilenTyp = (ztSuche,ztZiel,ztQuelle,ztBefehl);

  tAbhaengigkeit = class;
  tAbhaengigkeiten = array of tAbhaengigkeit;
  tAbhaengigkeit = class(tObject)
    abhArt:     tAbhArt;
    quellenRE:  tRegExpr;
    zieleFkt,
    befehle:    tStringlist;
    quellen,
    ziele:      tDateienMitDaten;
    erben:      tAbhaengigkeiten;
    prioritaet: integer;
    constructor create; overload;
    constructor create(original: tAbhaengigkeit); overload;
    destructor destroy; override;
  end;

function quellersetzung(var worin: string; quelle, inputfile: string): boolean;
procedure sammleDateien(wo: string; rekursiv: boolean; ignoriere: array of tRegExpr; var dats: tDateienMitDaten);
function liesMakeFile(datNam: string; out abh: tAbhaengigkeiten; out dats: tDateienMitDaten): boolean;

implementation

uses
  lowlevelunit, mystringlistunit;

// tAbhaengigkeit **************************************************************

constructor tAbhaengigkeit.create;
begin
  inherited create;
  quellenRE:=tRegExpr.create;
  quellenRE.expression:='';
  zieleFkt:=tStringlist.create;
  setlength(quellen,0);
  setlength(ziele,0);
  befehle:=tStringlist.create;
  setlength(erben,0);
  abhArt:=aaIgnore;
  prioritaet:=42;
end;

constructor tAbhaengigkeit.create(original: tAbhaengigkeit);
var
  i: integer;
begin
  inherited create;
  quellenRE:=tRegExpr.create;
  quellenRE.expression:=original.quellenRE.expression;
  zieleFkt:=tStringlist.create;
  zieleFkt.text:=original.zieleFkt.text;
  setlength(quellen,length(original.quellen));
  for i:=0 to length(original.quellen)-1 do
    quellen[i]:=original.quellen[i];
  setlength(ziele,length(original.ziele));
  for i:=0 to length(original.ziele)-1 do
    ziele[i]:=original.ziele[i];
  befehle:=tStringlist.create;
  befehle.text:=original.befehle.text;
  setlength(erben,length(original.erben));
  for i:=0 to length(original.erben)-1 do
    erben[i]:=original.erben[i];
  prioritaet:=original.prioritaet;
  abhArt:=original.abhArt;
end;

destructor tAbhaengigkeit.destroy;
begin
  quellenRE.free;
  setLength(quellen,0);
  setLength(ziele,0);
  zieleFkt.free;
  befehle.free;
  setlength(erben,0);
  inherited destroy;
end;

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

function quellersetzung(var worin: string; quelle, inputfile: string): boolean;
var
  s,anfang,mitte: string;
  i,li,re:        integer;
begin
  result:=true;
  if quelle<>'' then begin
    while pos('%in',worin)>0 do
      worin:=copy(worin,1,pos('%in',worin)-1)+quelle+copy(worin,pos('%in',worin)+3,length(worin));
    s:=extractfilename(quelle);
    while pos('%ifile',worin)>0 do
      worin:=copy(worin,1,pos('%ifile',worin)-1)+s+copy(worin,pos('%ifile',worin)+6,length(worin));
    if pos('.',s)>0 then begin
      while s[length(s)]<>'.' do delete(s,length(s),1);
      delete(s,length(s),1);
    end;
    while pos('%basename',worin)>0 do
      worin:=copy(worin,1,pos('%basename',worin)-1)+s+copy(worin,pos('%basename',worin)+9,length(worin));
    while pos('%dirname(',worin)>0 do begin
      anfang:=erstesArgument(worin,'%dirname(');
      mitte:=erstesArgument(worin,')');
      s:=extractfilepath(quelle);
      if rightStr(s,1)='/' then
        delete(s,length(s),1);
      i:=anzCs('/',s)+1;
      li:=strtoint(erstesArgument(mitte,','));
      if li<0 then li:=li+i;
      if mitte='' then
        re:=0
      else
        re:=strtoint(mitte);
      if re<=0 then re:=re+i;
      while li>0 do begin
        dec(li);
        dec(re);
        erstesArgument(s,'/');
      end;
      mitte:='';
      while re>0 do begin
        dec(re);
        mitte:=mitte+'/'+erstesArgument(s,'/');
      end;
      delete(mitte,1,1);
      worin:=anfang+mitte+worin;
    end;
    s:=extractfilepath(quelle);
    if rightStr(s,1)='/' then
      delete(s,length(s),1);
    while pos('%dirname',worin)>0 do
      worin:=copy(worin,1,pos('%dirname',worin)-1)+s+copy(worin,pos('%dirname',worin)+8,length(worin));
  end;
  s:=extractfilepath(inputfile);
  if rightStr(s,1)='/' then
    delete(s,length(s),1);
  while pos('%DIRNAME',worin)>0 do
    worin:=copy(worin,1,pos('%DIRNAME',worin)-1)+s+copy(worin,pos('%DIRNAME',worin)+8,length(worin));
  while pos('%num''',worin)>0 do begin
    anfang:=erstesArgument(worin,'%num''');
    mitte:=erstesArgument(worin,'''');
    for i:=length(mitte) downto 1 do
      if mitte[i] in ['0'..'9'] then
        break
      else
        delete(mitte,i,1);
    for i:=length(mitte) downto 1 do
      if not (mitte[i] in ['0'..'9']) then begin
        delete(mitte,1,i);
        break;
      end;
    worin:=anfang+mitte+worin;
  end;
  if quelle<>'' then begin
    result:=false;
    while pos('%nurmit''',worin)>0 do begin
      anfang:=erstesArgument(worin,'%nurmit''');
      mitte:=erstesArgument(worin,'''');
      if pos(mitte,quelle)=0 then
        exit;
      worin:=anfang+worin;
    end;
    while pos('%nurohne''',worin)>0 do begin
      anfang:=erstesArgument(worin,'%nurohne''');
      mitte:=erstesArgument(worin,'''');
      if pos(mitte,quelle)>0 then
        exit;
      worin:=anfang+worin;
    end;
    result:=true;
  end;
end;

procedure sammleDateien(wo: string; rekursiv: boolean; ignoriere: array of tRegExpr; var dats: tDateienMitDaten);
var
  sr:        tSearchRec;
  err,i:     integer;
  weglassen: boolean;
begin
  err:=FindFirst(wo,fareadOnly or faHidden or faSysFile or (byte(rekursiv)*faDirectory),sr);
  while err=0 do begin
    weglassen:=false;
    for i:=0 to length(ignoriere)-1 do
      weglassen:=weglassen or ignoriere[i].exec(extractfilepath(wo)+sr.name);
    if not weglassen then begin
      if sr.attr and faDirectory <> 0 then begin
        if rekursiv and
           (sr.name<>'.') and
           (sr.name<>'..') then
             sammleDateien(extractfilepath(wo)+sr.name+'/'+extractfilename(wo),rekursiv,ignoriere,dats);
      end
      else begin
        setlength(dats,length(dats)+1);
        dats[length(dats)-1]:=tDateiMitDatum.create;
        dats[length(dats)-1].name:=extractfilepath(wo)+sr.name;
        dats[length(dats)-1].aktuell:=aVeraltet;
      end;
    end;
    err:=FindNext(sr);
  end;
  findClose(sr);
end;

function liesMakeFile(datNam: string; out abh: tAbhaengigkeiten; out dats: tDateienMitDaten): boolean;
var
  f:             tMyStringList;
  s:             string;
  na:            tAbhaengigkeit;
  ignoriere:     array of tRegExpr;
  rek:           boolean;
  num,posi:      longint;
  wasWar,wasIst: tZeilenTyp;

procedure aufraeumen;
var
  ii: longint;
begin
  f.free;
  na.free;
  for ii:=0 to length(ignoriere)-1 do
    ignoriere[ii].free;
  setlength(ignoriere,0);
end;

begin
  result:=false;

  na:=tAbhaengigkeit.create;
  na.prioritaet:=0;
  na.abhArt:=aaPrimaer;
  setlength(dats,0);
  setlength(abh,0);
  setlength(ignoriere,0);
  num:=0;
  wasWar:=ztSuche;
  f:=tMyStringList.create;
  f.loadFromFile(datNam);
  f.add('%%DATEIENDE%%');
  if not f.unfoldMacros then begin
    f.free;
    exit;
  end;
  s:='';
  while f.readln(s) do begin
    if rightStr(s,1)=';' then      // ein Befehl(steil)
      wasIst:=ztBefehl
    else if rightStr(s,1)=':' then // ein Ziel
      wasIst:=ztZiel
    else if wasWar=ztZiel then     // eine Quelle
      wasIst:=ztQuelle
    else                           // eine zu überwachende Datei
      wasIst:=ztSuche;

    if wasIst in [ztZiel,ztBefehl] then
      delete(s,length(s),1);

    if (wasWar=ztBefehl) and (wasIst<>ztBefehl) then begin
      setlength(abh,length(abh)+1);
      abh[length(abh)-1]:=na;
      inc(num);
      na:=tAbhaengigkeit.create;
      na.prioritaet:=num;
      na.abhArt:=aaPrimaer;
    end;

    if s='%%DATEIENDE%%' then break;

    case wasIst of
      ztSuche: begin
        if not quellersetzung(s,'',datNam) then begin
          writeln('Fehler: Quellersetzung in '''+s+''' fehlgeschlagen!');
          aufraeumen;
          exit;
        end;
        if pos('!',s)=1 then begin
          delete(s,1,1);
          s:=trim(s);
          setlength(ignoriere,length(ignoriere)+1);
          ignoriere[length(ignoriere)-1]:=tRegExpr.create;
          ignoriere[length(ignoriere)-1].expression:=s;
        end
        else begin
          rek:=startetMit('-r',s);
          while s<>'' do
            sammleDateien(erstesArgument(s),rek,ignoriere,dats);
        end;
      end;
      ztBefehl: begin
        while unescapedpos(';',s)>0 do begin
          posi:=unescapedpos(';',s);
          s:=trim(leftStr(s,posi-1))+' && '+trim(rightStr(s,length(s)-posi));
        end;
        while pos(';;',s)>0 do
          delete(s,pos(';;',s),1);
        na.befehle.add(s);
      end;
      ztZiel:
        while s<>'' do
          na.zieleFkt.add(erstesArgument(s));
      ztQuelle: begin
        if not quellersetzung(s,'',datNam) then begin
          writeln('Fehler: Quellersetzung in '''+s+''' fehlgeschlagen!');
          aufraeumen;
          exit;
        end;
        na.quellenRE.expression:=s;
      end;
    end{of case};
    wasWar:=wasIst;
  end;

  if s<>'%%DATEIENDE%%' then
    writeln('Interner Fehler! Die letzte Regel wird vsl. nicht beachtet!');

  aufraeumen;
  result:=true;
end;

end.