unit protokollunit;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils;

type
  tProtokolldatei = record
    datei:       textfile;
    einrueckung: longint;
  end;

  { tProtokollant }

  tProtokollant = class(TObject)
  private
    sDat:   ^tProtokolldatei;
    bes:    string;
    kinder: array of tProtokollant;
    elter:  tProtokollant;
  public
    constructor create(dateiname: string); overload;
    constructor create(elter_: tProtokollant; besitzer: string); overload;
    destructor destroy; override;
    procedure destroyall;
    procedure schreibe(s: string);
    procedure schreibe(s: string; tee: boolean);
    procedure spuelen;
  end;


implementation

{ tProtokollant }

constructor tProtokollant.create(dateiname: string);
begin
  inherited create;
  getmem(sDat,sizeof(tProtokolldatei));
  sDat^.einrueckung:=10;
  assignfile(sDat^.datei,dateiname);
  rewrite(sDat^.datei);
  bes:='';
  setlength(kinder,0);
  elter:=nil;
end;

constructor tProtokollant.create(elter_: tProtokollant; besitzer: string);
begin
  inherited create;
  sDat:=elter_.sDat;
  setlength(elter_.kinder,length(elter_.kinder)+1);
  elter_.kinder[length(elter_.kinder)-1]:=self;
  elter:=elter_;
  setlength(kinder,0);
  bes:=elter.bes+'.'+besitzer;
  if pos('.',bes)=1 then delete(bes,1,1);
  if length(bes)+4 > sDat^.einrueckung then
    sDat^.einrueckung:=length(bes)+4;
end;

destructor tProtokollant.destroy;
var
  i: longint;
begin
  while length(kinder)>0 do
    kinder[length(kinder)-1].free;
  if assigned(elter) then begin
    flush(sDat^.datei);
    i:=0;
    while (i<length(elter.kinder)) and (elter.kinder[i]<>self) do
      inc(i);
    if i>=length(elter.kinder) then
      schreibe('destroy fehlgeschlagen, ich kann mich nicht sehen.');
    inc(i);
    while i<length(elter.kinder) do begin
      elter.kinder[i-1]:=elter.kinder[i];
      inc(i);
    end;
    setlength(elter.kinder,length(elter.kinder)-1);
  end
  else begin
    closefile(sDat^.datei);
    freemem(sDat,sizeof(tProtokolldatei));
  end;
  inherited destroy;
end;

procedure tProtokollant.destroyall;
begin
  if Assigned(elter) then elter.destroyall
  else destroy;
end;

procedure tProtokollant.schreibe(s: string);
begin
  schreibe(s,false);
end;

procedure tProtokollant.schreibe(s: string; tee: boolean);
var
  i: longint;
begin
  for i:=length(bes)+1 to sDat^.einrueckung do
    s:=' '+s;
  writeln(sDat^.datei,bes+s);
  if tee then
    writeln(bes+s);
end;

procedure tProtokollant.spuelen;
begin
  flush(sDat^.datei);
end;

end.