unit mystringlistunit; {$mode objfpc}{$H+} interface uses Classes, SysUtils, RegExpr, Process, 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; 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 implementation uses Math, lowlevelunit, systemunit; // 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 wb0 then begin if length(buf)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; if assigned(prot) then prot.schreibe(inttostr(count)+' Zeilen eingelesen') else gibAus(inttostr(count)+' Zeilen eingelesen',1); end; procedure tMyStringlist.saveToGz(const s: ansiString); var p: tProcess; buf: array of byte; f: file; rb: longint; it: tInputThread; datNam: string; const outBufLen = 1024*1024; begin if fileexists(s) then datNam:=mkTemp(s+'.XXXXXX') else datNam:=s; p:=tProcess.create(nil); p.executable:='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,datNam); 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; p.free; it.free; closefile(f); if s<>datNam then begin deleteFile(s); rename(f,s); end; 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=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'$') then exit; SchleifenInhalt:=tMyStringlist.create(nil,''); // Schleifenkörper merken Ebene:=0; while (i0) 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 i0 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)': 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; end.