unit Konfig;
{$I defines.inc}
interface
uses Vaznik;
const
cmDekodujSoubor = 1;
cmZahladStopy   = 2;

type

PKFpolozka = ^KFPolozka;
KFPolozka = object
   z:pstring;
   c:pstring;
   k:pstring;
   i:byte;
   end;

const
KFG_OK       = 0;
KFG_NOTFOUND = 1;

type
PKonfig = ^TKonfig;
TKonfig = object
     cfg:PVaznik; {na nem polozky typu PKFpolozka}
     error_code:byte;
     ignore:boolean;
     ukazatel:integer;
     orig:string;
     Constructor Init;
     Destructor Done;
     Function Zapis(s:string):boolean;virtual;
     Procedure DefinujPolozku(z,c,k:string);virtual;
     Procedure PovolNovySoubor(b:boolean);
     Procedure NactiKonfiguraci(s:string);virtual;
     Function NactiPolozku(polozka,default:string):string;virtual;
     Function NactiMultiPolozku(polozka,default,oddelovac:string):string;
     {Nacte zretezene polozky. Priklad v tele metody}
     Function Je_v_komentari(s:string):PUzel;virtual;
     Function Vrat_ID_polozky(z:string):PUzel;
     Procedure Zmen_obsah_polozky(z,c:string);
     Function Chyba(s:string;b:byte):byte;virtual;
     Procedure Dekoduj(x:byte);virtual;
     Procedure Zakoduj;virtual;
     end;


Procedure Prirad_konfiguracni_Soubory(_hlavni,_zalozni:PKonfig);


implementation
var hlavni,zalozni:PKonfig;

Function NaPstring(s:string):pointer;
var p:pointer;
    l:longint;
begin
l:=Length(s)+1;
GetMem(p,l);
Move(s,p^,l);
NaPstring:=p;
end;

Function ZrusPstring(p:pstring):pointer;
var l:longint;
begin
if p<>nil then
   begin
   l:=Length(p^)+1;
   FreeMem(p,l);
   end;
ZrusPstring:=nil;
end;

Procedure ZlikvidujZaznam(var p:pointer);
var v:PKFpolozka;
begin
v:=p;
ZrusPString(v^.z);
ZrusPString(v^.c);
ZrusPString(v^.k);
Dispose(v);
end;


Function Convert_down(s:string):string;
var t:string;
    a:byte;
begin
t:='';
for a:=1 to Length(s) do
    if s[a] in ['A'..'Z'] then t:=t+char(byte(s[a])+32) else t:=t+s[a];
Convert_down:=t;
end;


Function XMezer(b:byte):string;
var a:byte;
    t:string;
begin
t:='';
for a:=1 to b do t:=t+' ';
XMezer:=t;
end;


Function MyStr(i:longint):string;
var s:string;
begin
Str(i,s);
MyStr:=s;
end;


Function SkipAllSpaces(s:string):string;
var b:byte;
    t:string;
begin
t:='';
for b:=1 to Length(s) do
    if not (s[b] in [#32,#9]) then t:=t+s[b];
SkipAllSpaces:=t;
end;


Function SkipBegSpaces(s:string):string;
var a:byte;
begin
for a:=1 to Length(s) do
    if not (s[a] in [#32,#9]) then Exit(Copy(s,a,length(s)));
SkipBegSpaces:='';
end;


Function SkipEndSpaces(s:string):string;
var a:byte;
begin
for a:=Length(s) downto 1 do
    if not (s[a] in [#32,#9]) then Exit(Copy(s,1,a));
SkipEndSpaces:='';
end;



Constructor TKonfig.Init;
var a:byte;
begin
ignore:=false;
cfg:=NovyVaznik;
end;

Destructor TKonfig.Done;
var a:byte;
begin
Vaznik_Done_All(cfg,@ZlikvidujZaznam);
end;

Procedure TKonfig.DefinujPolozku(z,c,k:string);
var a:byte;
    v:PKFpolozka;
begin
a:=1;
New(v);
v^.z:=Napstring(z);
v^.c:=Napstring(c);
v^.k:=Napstring(k);
cfg^.InitNext(v);
end;


Function TKonfig.Vrat_ID_polozky(z:string):PUzel;
var a:byte;
    v:PKFpolozka;
begin
a:=1;
z:=Convert_Down(z);
cfg^.Reset;
while not cfg^.konec do
   begin
   v:=cfg^.Nacti;
   if v^.z<> nil then
      if v^.z^=z then Exit(cfg^.nacteny);
   end;
Vrat_ID_polozky:=nil;
end;


Procedure TKonfig.Zmen_obsah_polozky(z,c:string);
var p:PUzel;
    v:PKFpolozka;
begin
p:=Vrat_ID_polozky(z);
if p<>nil then
   begin
   v:=p^.vazba;
   ZrusPString(v^.c);
   v^.c:=NaPstring(c);
   end;
end;


Function TKonfig.Zapis(s:string):boolean;
var f:text;
    v:PKFpolozka;
    t:string;
    j:byte;
begin
Assign(f,s);
Rewrite(f);

cfg^.Reset;
while not cfg^.konec do
   begin
   v:=cfg^.nacti;
   if v^.z=nil then t:=v^.k^
      else begin
      t:=v^.z^+' = ';
      if v^.c<>nil then t:=t+v^.c^;
      j:=Length(t);
      if v^.k<>nil then
         if j>v^.i then t:=t+' '+v^.k^ else t:=t+Xmezer(v^.i-j-1)+v^.k^;
      end;
   writeln(f,t);
   end;
Close(f);
Zapis:=true;
end;

Procedure TKonfig.PovolNovySoubor(b:boolean);
begin
ignore:=b;
end;

Procedure TKonfig.Dekoduj(x:byte);
begin
end;

Procedure TKonfig.Zakoduj;
begin
end;

Function NajdiVyznamnyStrednik(t:string):longint;
var a:longint;
    c:char;
    v_tagu:boolean;
begin
v_tagu:=false;
for a:=1 to Length(t) do
    begin
    c:=t[a];
    if (c=';') and (v_tagu=false) then Exit(a);
    if c='>' then v_tagu:=false;
    if c='<' then v_tagu:=not v_tagu;
    end;
NajdiVyznamnyStrednik:=0;
end;

Procedure Tkonfig.NactiKonfiguraci(s:string);
var f:text;
    t,u:string;
    a,b:longint;
    v:PKFpolozka;
begin
orig:=s;
Dekoduj(cmDekodujSoubor);
Assign(f,orig);
Reset(f);
if IOresult<>0 then Exit;   {neexistujici soubor?}
a:=0;
while not Eof(f) do
   begin
   readln(f,t);
   New(v);
   cfg^.InitNext(v);
   a:=Pos('=',t);
   b:=NajdiVyznamnyStrednik(t);
   v^.i:=b;
   if (a=0) or ((a>b) and (b>0))then  {v teto radce je pouze komentar}
      begin
      v^.z:=nil;
      v^.c:=nil;
      v^.k:=NaPstring(t);
      end                  {v teto radce je prirazena promenna}
      else begin
      v^.z:=NaPstring(SkipAllSpaces(Copy(t,1,a-1))); { to pred rovnasem }
      if b=0 then
         begin
         u:=SkipBegSpaces(Copy(t,a+1,255));
         if u=''
            then v^.c:=nil                {vyraz konci rovnasem a nic za nim}
            else v^.c:=NaPstring(u);      {to za rovnasem}
         v^.k:=nil;                                            {bez komentare}
         end else
         begin
         {to za rovnasem}
         u:=SkipEndSpaces(SkipBegSpaces(Copy(t,a+1,b-(a+1))));
         if u=''
            then begin v^.c:=nil;end      {vyraz konci rovnasem a nic za nim}
            else v^.c:=NaPstring(u);      {to za rovnasem}
         v^.k:=NaPstring(Copy(t,b,255));                       {komentar}
         end;
      end;
   end;
Close(f);
Dekoduj(cmZahladStopy);
end;


Function TKonfig.NactiPolozku(polozka,default:string):string;
var v:PKFpolozka;
    cp:string;
begin
error_code:=kfg_ok;
cp:=Convert_down(polozka);
cfg^.Reset;
while not cfg^.konec do
   begin
   v:=cfg^.nacti;
   if (v^.z<>nil) and (cp=Convert_Down(v^.z^)) then
      if v^.c=nil then Exit('') else Exit(v^.c^);
   end;

error_code:=kfg_notfound;
if default<>'' then
   NactiPolozku:=default else
   begin
     Chyba('Chyba v konfiguracnim souboru !'+#13#10+
           'Nenalezena promenna [ '+polozka+' ]',0);
   end;
end;


Function PorovnaniMultiPolozek(s,pol:string):boolean;
var a:byte;
begin
if s=pol then Exit(true);
for a:=0 to 9 do if s+Mystr(a)=pol then Exit(true);
PorovnaniMultiPolozek:=false;
end;


Function TKonfig.NactiMultiPolozku(polozka,default,oddelovac:string):string;
{Priklad:
 s:=NactiMultiPolozku('Info','?',',')

Nacte do S vsechny polozky z Info, Info0, Info1, Info2, Info3 az Info9
Jednotlive podretezce oddeli oddelovacem ","}
var v:PKFpolozka;
    cp,n,i:string;
begin
error_code:=kfg_ok;
cp:=Convert_down(polozka);
i:='';
cfg^.reset;
while not cfg^.konec do
   begin
   v:=cfg^.nacti;
   if (v^.z<>nil) then
      begin
      n:=Convert_Down(v^.z^);
      if PorovnaniMultiPolozek(cp,n) then
         if v^.c<>nil then i:=i+oddelovac+v^.c^;
      end;
   end;

if i='' then
   begin
   error_code:=kfg_notfound;
   if default<>'' then
      NactiMultiPolozku:=default else
         begin
         Chyba('Chyba v konfiguracnim souboru !'+#13#10+
               'Nenalezena promenna [ '+polozka+' ]',0);
         end;
   end
   else begin
   Delete(i,1,Length(oddelovac));
   NactiMultiPolozku:=i;
   end;
end;

Function TKonfig.Je_v_komentari(s:string):PUzel;
var v:PKFpolozka;
    i:string;
begin
s:=Convert_down(s);
cfg^.Reset;
while not cfg^.konec do
   begin
   v:=cfg^.nacti;
   i:='';
   if v^.z<>nil then i:=i+v^.z^;
   if v^.c<>nil then i:=i+v^.c^;
   if v^.k<>nil then i:=i+v^.k^;
   if s=Copy(Convert_down(i),1,Length(s)) then Exit(cfg^.nacteny);
   end;
Je_v_komentari:=nil;
end;


Function TKonfig.Chyba(s:string;b:byte):byte;
begin
asm mov ax,3;int 10h;end;
writeln(s);
Halt(b);
end;


Procedure Prirad_konfiguracni_Soubory(_hlavni,_zalozni:PKonfig);
begin
hlavni:=_hlavni;
zalozni:=_zalozni;
end;




begin
hlavni:=nil;
zalozni:=nil;
end.
