path: root/mystringlistunit.pas

unit mystringlistunit;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, RegExpr, Process, protokollunit;

type
  tMyStringlist = class (tStringlist)
  private
    line:  longint;
    prot:  tProtokollant;
  public
    constructor create; overload;
    constructor create(protokollant: tProtokollant; name: string); overload;
    procedure loadFromFile(const s: ansiString); override;
    procedure loadFromGz(const s: ansiString);
    procedure saveToGz(const s: ansiString);
    function readln(out s: string): boolean;
    procedure grep(expr: string);
    function eof: boolean;
    procedure rewind;
    function stillNeed(bez: string): boolean;
    function unfoldMacros: boolean;
    procedure subst(regex,ersatz: string);
    procedure dump(pro: tProtokollant; prefix: string);
  end;

procedure _del(var s: string; p,c: longint); inline;  // identisch zu delete(s,p,c) -- lediglich um delete innerhalb von tMyStringlist verfügbar zu haben
procedure _mov(const source;var dest;count:SizeInt);

implementation

uses Math, lowlevelunit, systemunit, fileUnit;

// tMyStringlist ***************************************************************

constructor tMyStringlist.create;
begin
 create(nil,'');
end;

constructor tMyStringlist.create(protokollant: tProtokollant; name: string);
begin
 inherited create;
 if assigned(protokollant) then
   prot:=tProtokollant.create(protokollant,name)
 else
   prot:=nil;
 line:=0;
end;

procedure tMyStringlist.loadFromFile(const s: ansiString);
var i: longint;
begin
 inherited loadFromFile(s);
 for i:=0 to count-1 do
   self[i]:=trim(self[i]);
 line:=0;
 if assigned(prot) then
   prot.schreibe(inttostr(count)+' Zeilen eingelesen')
 else
   gibAus(inttostr(count)+' Zeilen eingelesen',1);
end;

procedure tMyStringlist.loadFromGz(const s: ansiString);
var
  len: longint;
  pt:  pointer;
  buf: ansistring;
begin
 fileunit.loadFromGz(s,pt,len);
 setlength(buf,len);
 _mov(pt^,buf[1],len);
 text:=buf;
 setlength(buf,0);
 for len:=0 to count-1 do
   self[len]:=trim(self[len]);
 line:=0;
 if assigned(prot) then
   prot.schreibe(inttostr(count)+' Zeilen eingelesen')
 else
   gibAus(inttostr(count)+' Zeilen eingelesen',1);
end;

procedure tMyStringlist.saveToGz(const s: ansiString);
begin
 fileunit.saveToGz(s,@(text[1]),length(text));
end;

function tMyStringlist.readln(out s: string): boolean;
begin
 result:=not eof;
 if not result then begin
   s:='';
   exit;
 end;
 s:=self[line];
 inc(line);
end;

procedure tMyStringlist.grep(expr: string);
var
  re: tRegExpr;
  i:  longint;
begin
  re:=tRegExpr.create;
  re.Expression:=expr;
  for i:=count-1 downto 0 do
    if not re.Exec(self[i]) then
      delete(i);
  re.free;
end;

function tMyStringlist.eof: boolean;
begin
 result:=line>=count;
end;

procedure tMyStringlist.rewind;
begin
 line:=0;
end;

function tMyStringlist.stillNeed(bez: string): boolean;
var i:   longint;
    s,t: string;
begin
  result:=false;
  for i:=max(0,line-1) to count-1 do begin
    s:=' '+self[i]+' ';
    while pos(bez,s)>0 do begin
      t:=copy(s,1,pos(bez,s)+length(bez));
      _del(s,1,pos(bez,s)+length(bez)-1);
      _del(t,1,length(t)-length(bez)-2);
      if (t[1] in [' ',#9,':','[']) and (t[length(t)] in [' ',#9,':',']']) and (copy(t,2,length(bez))=bez) then begin
        result:=true;
        exit;
      end;
    end;
  end;
end;

function tMyStringlist.unfoldMacros: boolean;
var i,j,k,l,Ebene:                longint;
    s,t,u,v:                      string;
    SchleifenInhalt:              tMyStringlist;
    istWahr,gefunden,wasGefunden: boolean;
const binops: array[0..12] of string =
  ('<=','>=','<>','≤','≥','=','≠','<','>','in','∈','notIn','∉');
begin
  result:=false;

  i:=0;
  while i<count do begin  // Kommentare löschen
    s:=self[i];
    s:=erstesArgument(s,'#');
    if length(s)=0 then begin
      delete(i);
      continue;
    end;
    self[i]:=s;
    inc(i);
  end;

  repeat
    wasGefunden:=false;

    i:=0;
    while i<count do begin  // Übersprünge überspringen, alles nach 'Dateiende' löschen
      s:=self[i];
      if startetMit('!überspringe:',s) then begin
        for j:=0 to strtoint(s) do
          delete(i);
        continue;
      end;

      if s='Dateiende' then begin
        inc(i);
        while i<count do
          delete(i);
        continue;
      end;
      inc(i);
    end;
    if wasGefunden then continue;

    i:=count-1;
    while i>=0 do begin   // Substitutionen auswerten
      s:=self[i];
      if startetMit('!setze',s) then begin
        wasGefunden:=true;
        t:=erstesArgument(s,':');
        if pos('$',t)<>1 then begin
          prot.schreibe('ungültiger Variablenname '''+t+''' für Ersetzung!',true);
          exit;
        end;
        delete(i);
        for j:=i to count-1 do begin
          u:=self[j];
          k:=length(u);
          while (pos(t,u)>0) and (k>0) do begin       // ... nach Ersetzung ...
            u:=copy(u,1,pos(t,u)-1)+s+copy(u,pos(t,u)+length(t),length(u));
            dec(k);
          end;
          self[j]:=u;
        end;
      end
      else
        dec(i);
    end;
    if wasGefunden then continue;

    for i:=0 to count-1 do begin   // Shellvariablen auswerten
      s:=shellSubst(self[i]);
      if s<>self[i] then begin
        wasGefunden:=true;
        self[i]:=s;
      end;
    end;

    i:=0;
    while i<count do begin  // Schleifen ausrollen
      s:=self[i];
      if startetMit('!Schleife:',s) then begin
        wasGefunden:=true;
        l:=i;
        delete(i);
        t:=erstesArgument(s,':');
        if (length(t)=0) or (t[1]<>'$') then exit;

        SchleifenInhalt:=tMyStringlist.create(nil,''); // Schleifenkörper merken
        Ebene:=0;
        while (i<Count) and ((Ebene<>0) or (self[i]<>'!Schleifenende')) do begin
          SchleifenInhalt.Add(self[i]);
          if self[i]='!Schleifenende' then dec(Ebene);
          if pos('!Schleife:',self[i])=1 then inc(Ebene);
          delete(i);
        end;
        delete(i);

        u:=s;
        s:='';
        while length(u)>0 do begin
          v:=erstesArgument(u);
          if pos('..',v)<>0 then v:=intervallAusrollen(v);
          s:=s+' '+v;
        end;
        s:=trim(s);

        while length(s)>0 do begin  // Schleifenzähler laufen lassen
          u:=erstesArgument(s);
          for j:=0 to SchleifenInhalt.Count-1 do begin  // Schleifenkörper ...
            v:=SchleifenInhalt[j];
            k:=length(v);
            while (pos(t,v)>0) and (k>0) do begin       // ... nach Ersetzung ...
              v:=copy(v,1,pos(t,v)-1)+u+copy(v,pos(t,v)+length(t),length(v));
              dec(k);
            end;
            insert(i,v);                                // ... kopieren
            inc(i);
          end;
        end;

        SchleifenInhalt.free;
        i:=l;
        continue;
      end;
      self[i]:=s;
      inc(i);
    end;
    if wasGefunden then continue;

    i:=0;
    while i<count do begin   // Bedingungen auswerten
      s:=self[i];
      if startetMit('?',s) then begin
        wasGefunden:=true;
        t:=erstesArgument(s,':');
        gefunden:=false;
        for j:=0 to length(binops)-1 do
          if pos(binops[j],t)>0 then begin
            gefunden:=true;
            u:=trim(copy(t,1,pos(binops[j],t)-1));
            _del(t,1,pos(binops[j],t)+length(binops[j])-1);
            t:=trim(t);
            case binops[j] of
              '≤','<=': istWahr:=strtofloat(u)<=strtofloat(t);
              '≥','>=': istWahr:=strtofloat(u)>=strtofloat(t);
              '=':
                try
                  istWahr:=strtofloat(u)=strtofloat(t);
                except
                  istWahr:=u=t;
                end;
              '≠','<>':
                try
                  istWahr:=strtofloat(u)<>strtofloat(t);
                except
                  istWahr:=u<>t;
                end;
              '<': istWahr:=strtofloat(u)<strtofloat(t);
              '>': istWahr:=strtofloat(u)>strtofloat(t);
              'in','∈': begin
                istWahr:=false;
                t:=t+' ';
                while (t<>'') and not istWahr do
                  istWahr:=erstesArgument(t)=u;
              end;
              'notIn','∉': begin
                istWahr:=true;
                t:=t+' ';
                while (t<>'') and istWahr do
                  istWahr:=erstesArgument(t)<>u;
              end;
              else begin
                if assigned(prot) then prot.schreibe('Operator '''+binops[j]+''' ist nicht implementiert!',true)
                else gibAus('Operator '''+binops[j]+''' ist nicht implementiert!',3);
                exit;
              end;
            end{of case};
            if not istWahr then
              delete(i);
            break;
          end;
        if not gefunden then begin
          if assigned(prot) then prot.schreibe('Ich kann keinen gültigen Operator in Bedingung '''+t+''' finden!',true)
          else gibAus('Ich kann keinen gültigen Operator in Bedingung '''+t+''' finden!',3);
          exit;
        end;
        if not istWahr then
          continue;
        self[i]:=s;
      end;
      inc(i);
    end;

  until not wasGefunden;

  result:=true;
end;

procedure tMyStringlist.subst(regex,ersatz: string);
var
  i,cnt: longint;
  re:    tRegExpr;
begin
  re:=tRegExpr.create;
  re.expression:='^(.*)('+regex+')(.*)$';
  cnt:=3;
  for i:=1 to length(regex) do
    if (regex[i]='(') and
       ((i=1) or (regex[i-1]<>'\')) then
      inc(cnt);
  for i:=0 to count-1 do begin
    re.exec(self[i]);
    self[i]:=re.substitute('$1'+ersatz+'$'+inttostr(cnt));
  end;
  re.free;
end;

procedure tMyStringlist.dump(pro: tProtokollant; prefix: string);
var
  i: longint;
begin
  for i:=0 to count-1 do
    pro.schreibe(prefix+self[i]);
end;

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

procedure _del(var s: string; p,c: longint);
begin
 delete(s,p,c);
end;

procedure _mov(const source;var dest;count:SizeInt);
begin
 move(source,dest,count);
end;

end.