[lazarus] First Pass at the light xml parser

[Cliff Baeseman]

Here is the parser unit and a simple test app and a xml file. In order to use
it you create a decendant class of TXMLParser and override the event
trigger virtual methods. There is a TTestParser defined in the unit that
shows how to implement the parser. I still need to do a little code
purtification on it before committing.

This allows you to create a class like TLazarusConfig = class(TXMLParser) and
implement a simple state machine that loads the config interface with data for
reading by the application. 

xtest.pp is the app
xparser is the parser
test.xml is a example config file

Cliff

unit xparser;
{$mode objfpc}

interface
uses
 Classes,Sysutils;

type
 TXMLElement = class(TObject)
  public
   StartTag: boolean;
   EndTag: boolean;
   VersionTag: boolean;
   DataTag: boolean;
   Data: string;
  end;

 TXMLParser = class(TObject)
 protected
   procedure LoadStream(xmlstream: TStream);
   procedure OnStartTag(sData:string);virtual;
   procedure OnEndTag(eData:string);virtual;
   procedure OnData(dData:string);virtual;
   procedure Run;

 private
   FStream: TStream;
   FList: TList;
   FBuffer: string;
   procedure SplitStream;
   procedure LoadElement(vdata:string);
   procedure LoadDataElement;
   procedure DumpBuffer;
   procedure AppendBuffer(vdata:char);
   function IsData:boolean;
   function StripStartTagData(sdata:string):string;
   function StripEndTagData(sdata:string):string;
   procedure FireEvents;
 end;
 TTestParser = class(TXMLParser)
  public
   procedure Parse;
   procedure SetData(xdata: TStream);
   procedure OnStartTag(sData:string);override;
   procedure OnEndTag(eData:string);override;
   procedure OnData(dData:string);override;
  end;

implementation

{ TXMLParser }


{------------------------------------------------------------------------------}
{*************************WARNING**********************************************}
{ Change Back to trim after RTL is fixed                                       }
{------------------------------------------------------------------------------}
function StringTrim(const S: string): string;
var Ofs, Len: integer;
begin
  len := Length(S);
  while (Len>0) and (S[Len] = ' ') or (S[Len] = #10) or (S[Len] = #13) do
   dec(Len);
  Ofs := 1;
  while (Ofs<=Len) and (S[Ofs] = ' ') or (S[Ofs] = #10) or (S[Len] = #13) do
   Inc(Ofs);
  result := Copy(S, Ofs, 1 + Len - Ofs);
end ;


{------------------------------------------------------------------------------}
{ Start Class Decendant Virtual Event Triggers                                       }
{------------------------------------------------------------------------------}
procedure TXMLParser.OnStartTag(sData:string);
begin
end;

procedure TXMLParser.OnEndTag(eData:string);
begin
end;

procedure TXMLParser.OnData(dData:string);
begin
end;
{------------------------------------------------------------------------------}
{ End Class Decendant Virtual Event Triggers                                       }
{------------------------------------------------------------------------------}


{------------------------------------------------------------------------------}
{ Fire virtual functions in decendant parser class, based on data in stack     }
{------------------------------------------------------------------------------}
procedure TXMLParser.FireEvents;
var
lIndex: integer;
vElement: TXMLElement;
begin
  for lIndex := 0 to FList.Count -1 do
    begin
       vElement := TXMLElement(FList[lIndex]);
       if vElement.StartTag then
         OnStartTag(vElement.Data);
       if vElement.EndTag then
         OnEndTag(vElement.Data);
       if vElement.DataTag then
         OnData(vElement.Data);
     end;
end;

{------------------------------------------------------------------------------}
{ Strip off start tag markers                                                  }
{------------------------------------------------------------------------------}
function TXMLParser.StripStartTagData(sdata:string):string;
begin
 result := Copy(StringTrim(sdata),2,length(StringTrim(sdata)) - 2);
end;

{------------------------------------------------------------------------------}
{ Strip off end tag markers                                                    }
{------------------------------------------------------------------------------}
function TXMLParser.StripEndTagData(sdata:string):string;
begin
  result := Copy(StringTrim(sdata),3,length(StringTrim(sdata)) -3);
end;

{------------------------------------------------------------------------------}
{ Appends data to the buffer                                                   }
{------------------------------------------------------------------------------}
procedure TXMLParser.AppendBuffer(vdata: char);
begin
   FBuffer := FBuffer + vdata;
end;

{------------------------------------------------------------------------------}
{ Loads a data element to the parsed stack                                     }
{------------------------------------------------------------------------------}
procedure TXMLParser.LoadElement(vdata: string);
var
velement:TXMLElement;

begin

  {version junk throw it away}
  if Pos('?>',vdata) > 0 then
    exit;

  if IsData then
    begin
      LoadDataElement;
      exit;
    end;

  if Pos('</',vdata) > 0 then
    begin
      velement := TXMLElement.Create;
      velement.EndTag := true;
      velement.Data := StripEndTagData(vdata);
      FList.Add(velement);
      exit;
    end;

  if Pos('<',vdata) > 0 then
    begin
      velement := TXMLElement.Create;
      velement.StartTag := true;
      velement.Data := StripStartTagData(vdata);
      FList.Add(velement);
      exit;
    end;

end;

{------------------------------------------------------------------------------}
{ Dumps the contents of the data buffer                                        }
{------------------------------------------------------------------------------}
procedure TXMLParser.DumpBuffer;
begin
    LoadElement(FBuffer);
    FBuffer := '';
end;

{------------------------------------------------------------------------------}
{ Sets the internal private stream                                             }
{------------------------------------------------------------------------------}
procedure TXMLParser.LoadStream(xmlstream: TStream);
begin
 FStream := xmlstream;
end;

{------------------------------------------------------------------------------}
{ Runs the parser                                                              }
{ The run  method loads a element stack containing the data and just does a    }
{  loop on it firing data the virtual event methods                            }
{------------------------------------------------------------------------------}
procedure TXMLParser.Run;
begin
  if not assigned(FList) then
    FList := TList.Create;

  SplitStream;
  FireEvents;
end;

{------------------------------------------------------------------------------}
{ Splits the stream into tag chunks                                            }
{------------------------------------------------------------------------------}
procedure TXMLParser.SplitStream;
var
count: integer;
vchar: char;
begin
  for count := 0 to FStream.Size -1 do
    begin
       FStream.Read(vchar,1);
       if (vchar = '>') then
         begin
           AppendBuffer(vchar);
           DumpBuffer;
         end
       else
         AppendBuffer(vchar);
    end;
end;

{------------------------------------------------------------------------------}
{ Tests a tag set to determine if it contains data                             }
{------------------------------------------------------------------------------}
function TXMLParser.IsData: boolean;
var
vBuffer: string;
begin
 vBuffer := StringTrim(FBuffer);
 if Pos('<',vBuffer) > 2 then
   begin
    result := true;
   end
 else
   result := false;
end;

{------------------------------------------------------------------------------}
{ Strips a data element                                                   }
{------------------------------------------------------------------------------}
procedure TXMLParser.LoadDataElement;
var
ldata: string;
rdata: string;
epos: integer;
lElement: TXMLElement;

begin

   { At this point we are going to have data
   on the left side of the tagged line we need
   to strip it into a data and tag element and
   add it to the element list }
   epos := Pos('<',FBuffer);
   ldata := Copy(FBuffer,0,epos-1);
   rdata := Copy(FBuffer,epos,length(FBuffer));
   { load left data element }
   lElement := TXMLElement.Create;
   lElement.DataTag := true;
   lElement.Data := ldata;
   FList.Add(lElement);
   { load close tag element }
   lElement := TXMLElement.Create;
   lElement.EndTag := true;
   lElement.Data := StripEndTagData(rdata);
   FList.Add(lElement);
end;
{******************* inherited test parser **************}
 procedure TTestParser.Parse;
 begin
  self.Run;
 end;

 procedure TTestParser.SetData(xdata: TStream);
 begin
   self.LoadStream(xdata);
 end;

 procedure TTestParser.OnStartTag(sData:string);
 begin
  writeln('start tag = ' + sData);
 end;

 procedure TTestParser.OnEndTag(eData:string);
 begin
  writeln('end tag =' + eData);
 end;

 procedure TTestParser.OnData(dData:string);
 begin
  if trim(dData) > '' then
    writeln('data =' + dData);
 end;
end.

program xtest;

{$mode objfpc}

uses classes, xparser;

var
parser: TTestParser;
FData: TStream;

begin
parser := TTestParser.Create;
FData := TFileStream.Create('test.xml',fmOpenRead);
parser.SetData(FData);
parser.Parse;
FData.Free;
end.


<?xml version="1.0"?>
  <idesettings>
    <toolbar>
       <height>100</height>
       <width>400</width>
       <left>10</left>
       <top>10</top>
    </toolbar>
    <toolstrings>
      <language>
        <english>
          <caption>Lazarus</caption>
        </english>
        <german>
          <caption>Whatever in German</caption>
        </german>
      </language>
    </toolstrings>
  </idesettings>