(YA) Perl XML-like parser

Speedy XML-like parser (not 100% compliant). It takes a funky approach and matches against substrs instead of gathering in the match, this made it over 20x faster in my test case.

This is going into a module that needs to be very light weight, which more or less precludes dependencies. XML::Parser::Lite isn't available by itself, and it along with XML::SAX::PurePerl have pretty hefty interfaces.

Fixed issues

<foo/>

<foo bar="1" baz="=" quux="don't"/>

<foo><bar/>quux</foo>

Last Modified: Sat May 11 04:15:44 UTC 2002

UPDATE: Please see XML::RSSLite for further updates.

=pod

=head1 SYNOPSIS

parse(\%parsedTree, \$parseThis, 'topTag', $comments);

=head1 DESCRIPTION

=over

=item parsedTree - required

reference to hash to store the parsed document within

=item parseThis  - required

reference to scalar containg the document to parse

=item topTag     - optional

tag to consider the root node, leaving this undefined is not recommend
+ed.

=item comments   - optional

=over

=item false will remove contents from

=item true will not remove comments

=item array reference is true, comments are stored here

=back

=back

=head1 CAVEATS

Not a conforming parser, it does not handle the following

=over

=item <foo bar=">">

=item <foo><bar> <bar></bar> <bar></bar> </bar></foo>

=item <![CDATA[ ]]>

=item PI

=back

It's non-validating, without a DTD the following cannot be addressed

=over

=item entities

=item namespace

=back

=cut

sub parseXML{
  my($hash, $xml, $tag, $comments) = @_;
  my($begin, $end, @comments);
  local $_;

  #Kill comments
  while( ($begin =  index(${$xml}, '<!--')) > -1 &&
    ${$xml} =~ m%<!--.*?--(>)%sg ){
    my $str = substr(${$xml}, $begin, pos(${$xml})-$begin, '');
    
    #Save them if requested
    do{ unshift @comments, [$begin, substr($str, 4, length($str)-7)] }
      if $comments;
  }


  #Find topTag and set pos to start matching from there
  ${$xml} =~ /<$tag(?:>|\s)/g;
  ($begin, $end) = (0, pos(${$xml})||0);

  #Match either <foo></foo> or <bar />, optional attributes, stash tag
+ name
  while( ${$xml} =~ m%<([^\s>]+)(?:\s+[^>]*?)?(?:/|>.*?</\1)>%sg ){   
+  

    #Save the tag name, we'll need it
    $tag = $1 || $2;

    #Save the new beginning and end
    ($begin, $end) = ($end, pos(${$xml}));

    #Get the bit we just matched.
    my $str = substr(${$xml}, $begin, $end-$begin);
    
    #Extract the actual attributes and contents of the tag
#   $str =~ m%<$tag\s*([^>]*?)?>(.*?)</$tag>%s ||
    $str =~ s%^.*?<$tag\s*([^>]*?)?>(.*?)</$tag>%<$tag>$2</$tag>%s ||
      $str =~ m%<$tag\s*([^>]*?)?\s*/>%;
    my($attr, $content) = ($1, $2);

    #Did we get attributes? clean them up and chuck them in a hash.
    if( $attr ){
      ($_, $attr) = ($attr, {});
      $attr->{$1} = $3 while m/([^\s=]+)\s*=\s*(['"])(.*?)\2/g;
    }

    #Recurse if contents has more tags, replace contents with referenc
+e we get
    if( $content && index($content, '<') > -1 ){
      parseXML($content={}, \$str, $tag, 0);
      #Was there any data in the contents? We should extract that...
#      if( $str =~ />[^><\s]+</ || $str =~ />(?:[^><\s]+\s+)+</ ){
      if( $str =~ />[^><]+</ ){
    #The odd RE above \S+\s+ shortcircuits unnecessary entry

    my $length = length($str);
    my $taglen = length($tag)+2;
    $str= substr($str, $taglen, $length-1-2*$taglen);

    #Clean whitespace between tags
    #$str =~ s%(?<=>)?\s*(?=<)%%g; #XXX ~same speed, wacko warning
    #$str =~ s%(>?)\s*<%$1<%g;

#    $str =~ s%<$_\s*(?:[^>]*?)?(?:/|>.*?</$_)>%%sg for keys %{$conten
+t};
    my $qr = qr{@{[join('|', keys %{$content})]}};
    $str =~ s%<($qr)\s*(?:[^>]*?)?(?:/|>.*?</\1)>%%sg;

    $content->{'<>'} = $str;#XXX if $str;
      }
    }

    my($inhash);
    if( ref($content) ){
      #We have attributes? Then we should save them.
      $inhash = $attr || {};

      #Contents too? Save them as well.
      if( $content ){
    for( keys %{$content} ){
      $inhash->{$_} = exists($inhash->{$_})   ?
        (ref($inhash->{$_})  eq 'ARRAY'       ?
         [@{$inhash->{$_}}, $content->{$_}]   :
         [  $inhash->{$_},  $content->{$_}] ) : $content->{$_};
    }
    
      }
    }
    else{
      #Otherwise save our content
      $inhash = $content;
    }
    
    $hash->{$tag} = exists($hash->{$tag}) ?
      (ref($hash->{$tag})  eq 'ARRAY'     ?
    [@{$hash->{$tag}}, $inhash]       :
    [  $hash->{$tag},  $inhash]  )    : $inhash;
  }

  if( $comments ){
    #Restore comments if requested
    substr(${$xml}, $_->[0], 0, '<!--'.$_->[1].'-->') for @comments;

    #Expose comments if requested
    do{ push(@$comments, $_->[1]) for @comments } if ref($comments) eq
+ 'ARRAY';
  }
}
[download]

Comment on (YA) Perl XML-like parser Select or Download Code

Replies are listed 'Best First'.
Re: (YA) Perl XML parser by mirod (Canon) on May 07, 2002 at 05:33 UTC
The title of your post should be YA piece of code that parses a limited and undefined subset of XML. XML parsers can be validating (against a DTD) or not (they just test well-formedness), see the XML spec. But a non-validating parser still must cover the whole spec. Nothing is optional in the XML spec. To claim to be an XML parser your code must be able to deal with entities, CDATA sections, comments, PI's... A couple more cases that your code does not handle: `<doc att="toto>"/>`: yes > is legal in a tag, if it is in an attribute value, `<doc><section><section></section></section></doc>`: nested tags are perfectly legal and widely used, so you can't use a regexp like `<tag>.*?</tag>` like you do to match an entire element. You should really study XML::SAX::PurePerl for a real XML parser in pure Perl (XML::SOAP::Lite does not parse all of XML, just the subset used by SOAP). Once again: writing something that parses the specific XML data you have to deal with at the moment is usually quite easy, but writing a real XML parser is _HARD_. You can of course use this parser for your data, but try to remember that it does not parse all of XML, and do not complain if one day it breaks on perfectly valid XML. And please do not post the code and above all do not pretend it is an XML parser. You are doing a disservice both to other monks and to you. OK, I think I am done. I will now take off my XML ayatollah hat and resume my normal activities ;--)	[reply] [d/l] [select]
Re: Re: (YA) Perl XML parser by belg4mit (Prior) on May 07, 2002 at 06:50 UTC
Did you run the code? Did you read the comments? It handles nested tags, you mean a tag nested within itself, they are parsed but a level is lost. PI won't be supported. I shall endeavor to handle > in the attributes and CDATA. I did not see XML::SAX::PurePerl in my search earlier, oh well. The XML spec is far from the easiest thing to read. I appreciate the insight, and am filling in most of the gaps but this is going to be like perl52perl6, 100%, 80% of the time. It wasn't even the original intent. It started as just an RSS parser but seemed to handle generic XML and so It thought I'd share it. Other things to keep in mind are; I did in fact say it was lax, this is snippets not craft. `-- perl -pew "s/\b;([mnst])/'$1/g"`	[reply]
Re: Re: Re: (YA) Perl XML parser by mirod (Canon) on May 07, 2002 at 09:28 UTC
If I spent time debugging all the pseudo-xml parsers I come accross I would not have much time left for real work. That said you are right, your thing handles nested tags just fine. It does not handle mixed content though. The problem is not which specific feature your code does or does not handle, it is that you have no idea what portion of the XML spec it covers. As you said the XML spec is complex and hard to read. It includes a grammar though, and that's how you should tackle writing a parser: extract the grammar (Ways to Rome will give you 11 ways to do this) and work from there. Do not pretend that code that parses "stuff with pointy brackets" is an XML parser. There have been numerous discussions about this on this forum (parse the "Other Users XML Ticker" with index and substr being a recent one, On XML parsing giving you a bunch of features that make parsing difficult). It boils down to "do what you want at home, but please don't spread improper code". Now if you had worked on XML::RSS to get it to work with XML::SAX::PurePerl, now you would have written something useful for you (minimal dependance for an RSS parser) and for the rest of the World.	[reply]
(ar0n) Re: (YA) Perl XML parser by ar0n (Priest) on May 07, 2002 at 03:52 UTC
Speedy (lax?) little generic XML parser. It takes a funky approach and matches against substrs instead of gathering in the match, this made it over 20x faster in my test case. You can pick your own root node in the document as well.. There are no generic XML parsers. Just as a document either is XML or it isn't; something either parses XML, or it doesn't. Your so-called 'XML parser' doesn't. There are no compromises. `<?xml version="1.0" encoding="UTF-8" ?> <?xml-stylesheet type="text/css" href="style.css"?> <one> <two foo="bar "" baz:quux='4'> <three:toto wawa=''/> </two> <![CDATA[ 1 && 2 && 3 Foo Bar <Baz></Foo><Bar /><Foo> ]> <!-- one two three --> </one>` [download] PS. And yes, I was the one who downvoted your node.	[reply] [d/l]
Re: (ar0n) Re: (YA) Perl XML parser by belg4mit (Prior) on May 07, 2002 at 03:53 UTC
There are lax XML parsers, they're called non-validating. It is supposed to handle `<foo />` (as the comments indicate), but I negelected to test that yet, and have posted prematurely. I am working on it now, thank you. UPDATE: This now works, it was meant to, but that's what I get for not testing all cases... As for generic I meant as opposed to podmaster's XML ticker parsers which also user substr but in a format dependent manner. `-- perl -pew "s/\b;([mnst])/'$1/g"`	[reply] [d/l]


There's more than one way to do things
	PerlMonks