unit strparser;
{$mode objfpc}{$H+}

{ 
The almight stringparsing tool kit, these functions are greatly perl inspired. I'm creating and
duplicating various perl functions as far as regex and things go. My goal is to create a good and useful string manipulation unit for FPC, while trying to mimic perl as closely as I can manage. Why perl? I use perl as my primary lang of choice for 99% of my work. Also they are the ones I use most. I hope this code is useful to others. You may notice, that some function are closely related. I liscence it under the r-t-f-m.com liscence.

My terms are simple.

1. This unit maybe freely used in open source or apps you do not intend to sell.
2. You may sell apps using this unit, buy only with my written permission.
3. You may modify and redistribute this unit and its source under these same terms.

Thats it other than the discliamer.

This unit is provided "AS IS" in hopes it will be useful. There is NO WARRANTY what so ever, expressed or implied. If you do one of the following including but not limited to,download,edit and use this unit. YOU TAKE SOLE REPONSIBILITY FOR WHATEVER HAPPENS AS A RESULT OF SUCH ACTION. You cannot hold me responsible.

Questions,suggestions or comments e-mail me at iso196@yahoo.com.

Author: Paul Malcher
Date of Inital 1.0 Release: 9/27/03 of 1.0
Current Version: 1.9

History
1.0 - 9/27/03 sparser,ssparser,strstrip
1.1 - 9/29/03 added strsub, doubled parser array type length
1.2 - 9/29/03 added match function
1.3 - 10/15/03 added aclear function
1.4 - 01/11/04 added adump procedure
1.5 - 02/13/04 changes for FPC 1.9.2 dynamic arrays made,edited sparser and ssparser
1.6 - 02/14/04 almost a complete redo of sparser and ssparser,thanks to oliebol on irc.freenode.net #fpc,one of the fpc developers
1.7 - 02/24/04 added strRightOf,strLeftOf,strReverse they were donate by Jestin Larson
1.8 - 03/23/04 added a compiler directive to unit
1.9 - 08/04/05 corrected comments and OOPification 

} 

interface

uses Classes;

TYPE
parser = array of string;

TYPE
strpar=class(TComponent)
    
Private
    Function sparser(data:string;delimiter:string):parser; {if delimiter is more than 1 char use this}
    Function ssparser(data:string;delimiter:string):parser;{if delimiter is one char or space use this}
    
Public
Function parse(data:string;delimiter:string):parser; {One stop interface to sparser and ssparser, this will call the right one automatically}
Function strstrip(data:string;delimiter:string):string;{this will stripp a certain char or chars from a string}
Function strsub(data:string;olds:string;news:string):string; {this will take a string and replace one sub string with another}
Function match(data:string;contains:string):integer; {this will scan to see if a string contains a requested pattern}
Function aclear(data:parser;len:integer):parser; { clears array }
Function strRightOf (inStr : string; rightInt : integer) : string; { returns all chars
to the right of requested position }
Function strLeftOf (inStr : string; leftInt : integer) : string; { same as above only
to the left }
Function strReverse (rstr : string) : string; { reverse a given string }
Procedure adump(data:parser); { Debug uses }
      
end;

implementation

Function strpar.sparser(data:string;delimiter:string):parser;{if delimiter is one char or space use this}
var
info:string;
del:integer;
st:parser;
start:integer;
tmp:integer;
slen: integer;

begin
info := data;
del := Length(delimiter);
slen := Length(info);
tmp:=1;
repeat
  start := pos(delimiter,info);
  Setlength(st,tmp);
  if start<>0 THen
   begin
    st[tmp-1]:=Copy(Info,1,start-1);
    Delete(info,1,start);
   end
 else
   begin
    st[tmp-1]:=info;
   end;
 inc(tmp);
 until start=0;
 sparser:=st;
end;

Function strpar.ssparser(data:string;delimiter:string):parser;{if delimiter is more than 1 char use this}
var
info:string;
del:integer;
st:parser;
start:integer;
stop:integer;
tmp:integer;
slen: integer;

begin
info := data;
del := Length(delimiter);
slen := Length(info);
tmp:=1;
stop  := del-1;
repeat
  start := pos(delimiter,info);
  Setlength(st,tmp);
  if start<>0 THen
   begin
    st[tmp-1]:=Copy(Info,1,start-1);
    Delete(info,1,start);
    Delete(info,1,stop);
   end
 else
   begin
    st[tmp-1]:=info;
   end;
 inc(tmp);
 until start=0;
 ssparser:=st;
end;

Function strpar.strstrip(data:string;delimiter:string):string;
var
info:string;
del:string;
slen: integer;
dlen:integer;
counter:integer;
start:integer;
stop:integer;

begin
info := data;
del := delimiter;
slen := Length(info);
dlen := Length(del);
for counter := 1 to slen do
begin
start := pos(delimiter,info);
if start = 0 then
break;
Delete (info,start,dlen);
end;
strstrip := info;
end;

Function strpar.strsub(data:string;olds:string;news:string):string;
var
info:string;
find:string;
rep:string;
olen:integer;
slen:integer;
counter:integer;
start:integer;

begin
info := data;
find := olds;
rep := news;
olen := Length(find);
slen := Length(info);
for counter := 1 to slen do
begin
start := pos(find,info);
if start = 0 then
break;
Insert (rep,info,pos(find,info));
start := pos(find,info);
Delete (info,start,olen);
end;
strsub := info;
end;

Function strpar.match(data:string;contains:string):integer;
var
info:string;
find:string;
ret:integer;
begin
info := data;
find := contains;
ret := pos(find,info);
if ret > 0 then
begin
ret := 1;
match := ret;
end;
match := ret;
end;

Function strpar.aclear(data:parser;len:integer):parser;
var
info:parser;
lenn:integer;
I:integer;
begin
info := data;
lenn := len;
For I := 1 to lenn do
info[I] := '';
aclear := info;
end;

Procedure strpar.adump(data:parser);
var
info:parser;
count:integer;
slen:integer;
begin
info := data;
slen := Length(info);
For count := 1 to slen do
begin
if info[count] = '' then 
break;
writeln(info[count]);
end;
end;

// Begin donated functions

Function strpar.strReverse (rstr : string) : string;

var
 newstr : string;
 pos    : integer;

begin
 newstr := '';
 for pos := 1 to Length(rstr) do
 begin
  newstr := rstr[pos] + newstr;
 end;
 strReverse := newstr;
end;

Function strpar.strLeftOf (inStr : string; leftInt : integer) : string;

var
 output : string;
 strLen : integer;
 strPos : integer;
 errchk  : integer;

begin
 errchk := 0;
 strLen := length(inStr);
 if strLen <= 1 then
 begin
  output := 'ERROR 100 - STRING NOT FOUND';
  errchk := 1;
 end;
 if leftInt <= 0 then
 begin
  output := 'ERROR 101 - INT NOT FOUND';
  errchk := 1;
 end;
 if leftInt > strLen then
 begin
  output := 'ERROR 102 - STRING OVERFLOW';
  errchk := 1;
 end;
 if errchk = 0 then
 begin
  output := '';
  for strPos := 1 to leftInt do
  begin
   output := output + inStr[strPos];
  end;
 end;
 strLeftOf := output;
end;

Function strpar.strRightOf (inStr : string; rightInt : integer) : string;

var
 output  : string;
 strLen  : integer;
 strPos  : integer;
 strLeft : integer;
 errchk  : integer;

begin
 errchk := 0;
 strLen := length(inStr);
 if strLen <= 1 then
 begin
  output := 'ERROR 100 - STRING NOT FOUND';
  errchk := 1;
 end;
 if rightInt <= 0 then
 begin
  output := 'ERROR 101 - INT NOT FOUND';
  errchk := 1;
 end;
 if rightInt > strLen then
 begin
  output := 'ERROR 102 - STRING OVERFLOW';
  errchk := 1;
 end;
 if errchk = 0 then
 begin
  output := '';
  strLeft := strLen - rightInt;
  for strPos := (strLeft+1) to strLen do
  begin
   output := output + inStr[strPos];
  end;
 end;
 strRightOf := output;
end;

//End Donated Functions

// 1.9 additions

Function strpar.parse(data:string;delimiter:string):parser;
var
dlen:integer;
ret :parser;
begin
// Simply checks the delimiter length and launches the right sub to handle it
dlen := length(delimiter);
if dlen > 1 then
ret := sparser(data,delimiter)
else
ret := ssparser(data,delimiter);
parse := ret;
end;

end.
{
some crap that I kept here as comment for a reason I can't remeber
begin
write('Enter text:');
readln(data);
writeln('');
write('Delimiter:');
readln(delimiter);
writeln('');
writeln('Function called');
ret := sparser(data,delimiter);
writeln(ret[3]);
end.

Function vash(key:string;value:string;hhash:phash):phash;
var
k,v:string;
ret:phash;
count:integer;
thash:phash;
begin
k := key;
v := value;
thash := hhash;
repeat
if thash[1,1] = '' then
begin
thash[1,1] := k;
thash[1,2] := v;
end;
until count = 20;
end;

}

end.