path: root/mystringlistunit.pas

unit mystringlistunit;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, RegExpr, Process, Math, lowlevelunit, protokollunit;

type
  tMyStringlist = class;

  tInputThread = class (tThread)
    fertig: boolean;
    inhalt: tMyStringList;
    proc:   tProcess;
    constructor create(p: tProcess; sl: tMyStringList);
    destructor destroy; override;
    procedure execute; override;
  end;

  tMyStringlist = class (tStringlist)
  private
    line:  longint;
    prot:  tProtokollant;
  public
    constructor create; overload;
    constructor create(protokollant: tProtokollant); 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;
  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

implementation

// tInputThread ****************************************************************

constructor tInputThread.create(p: tProcess; sl: tMyStringList);
begin
 inherited create(true);
 fertig:=false;
 inhalt:=sl;
 proc:=p;
 suspended:=false;
end;

destructor tInputThread.destroy;
begin
 inhalt:=nil;
 proc:=nil;
 inherited destroy;
end;

procedure tInputThread.execute;
var
  wb,cwb: longint;
begin
 wb:=0;
 while wb<length(inhalt.text) do begin
   cwb:=proc.input.write(inhalt.text[wb+1],length(inhalt.text)-wb);
   if cwb=0 then
     sleep(1)
   else
     wb:=wb+cwb;
 end;
 proc.CloseInput;
 fertig:=true;
end;

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

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

constructor tMyStringlist.create(protokollant: tProtokollant);
begin
 inherited create;
 prot:=tProtokollant.create(protokollant,'tMyStringlist');
 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;
 writeln(inttostr(count)+' Zeilen eingelesen');
end;

procedure tMyStringlist.loadFromGz(const s: ansiString);
var p:     tProcess;
    buf:   ansiString;
    rb,br: longint;
begin
 p:=tProcess.create(nil);
 p.executable:='/usr/bin/zcat';
 p.parameters.add(s);
 p.options:=p.options + [poUsePipes];
 setlength(buf,0);
 br:=0;
 p.execute;
 while p.running do begin
   rb:=p.output.numBytesAvailable;
   if rb>0 then begin
     if length(buf)<br+rb then
       setlength(buf,br+rb+1048576);
     rb:=p.output.read(buf[br+1],rb);
     br:=br+rb;
   end
   else sleep(1);
 end;
 setlength(buf,br);
 rb:=p.output.numBytesAvailable;
 while rb>0 do begin
   setlength(buf,br+rb);
   rb:=p.output.read(buf[br+1],rb);
   br:=br+rb;
   rb:=p.output.numBytesAvailable;
 end;
 text:=buf;
 setlength(buf,0);
 p.free;
 for rb:=0 to count-1 do
   self[rb]:=trim(self[rb]);
 line:=0;
 writeln(inttostr(count)+' Zeilen eingelesen');
end;

procedure tMyStringlist.saveToGz(const s: ansiString);
var
  p:     tProcess;
  buf:   array of byte;
  f:     file;
  rb:    longint;
  it:    tInputThread;
const
  outBufLen = 1024*1024;
begin
 p:=tProcess.create(nil);
 p.executable:='/usr/bin/gzip';
 p.parameters.add('--best');
 p.parameters.add('-c');
 p.options:=p.options + [poUsePipes];
 p.execute;
 setlength(buf,outBufLen);
 fillchar(buf[0],length(buf)*sizeof(buf[0]),$0);
 it:=tInputThread.create(p,self);
 assignfile(f,s);
 rewrite(f,1);
 while p.running or (not it.fertig) or (p.output.numBytesAvailable>0) do begin
   rb:=min(length(buf),p.output.numBytesAvailable);
   if rb>0 then begin
     rb:=p.output.read(buf[0],rb);
     blockwrite(f,buf[0],rb);
   end
   else
     sleep(1); // nix zu Schreiben, nix zu Lesen, also warten wir
 end;
 it.free;
 closefile(f);
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:  boolean;
const binops: array[0..8] of string =
  ('<=','>=','<>','≤','≥','=','≠','<','>');
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;

  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;

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

      SchleifenInhalt:=tMyStringlist.create; // 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);

      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;

  i:=0;
  while i<count do begin   // Bedingungen auswerten
    s:=self[i];
    if startetMit('?',s) then begin
      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);
            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;

  i:=0;
  while i<count do begin  // nochmals Übersprünge überspringen und alles nach 'Dateiende' ignorieren
    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;

  result:=true;
end;

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

end.