Soliciting feedback on new high-level pull based tree parser

#!/usr/bin/env perl

#you'll need XML::LibXML with reader support and XML::CompactTree::XS

use strict;
use warnings;
use Data::Dumper;

binmode(STDOUT, ':utf8');

my $puller = XML::CompactTree::Puller->new(string => get_xml());

$puller->config('/mediawiki' => 'element');
$puller->config('/mediawiki/siteinfo' => 'subtree');
$puller->config('/mediawiki/page' => 'subtree');

my $version = $puller->next;
my $siteinfo = $puller->next;

print "Dump version: ", $version->attributes->{version}, "\n";
print "Site name: ", $siteinfo->get_element('/siteinfo/sitename')->text, "\n";
print "Content of dump file:\n\n";

while(defined(my $t = $puller->next)) {
	my ($title, $text);
	
	$title = $t->get_element('/page/title')->text;
	$text = $t->get_element('/page/revision/text')->text;
	
	$text =~ s/(.*)/\t$1/g;
	
	print "Title: $title\n";
	print "Article:\n";
	print $text;
	print "\n\n";
		
}

sub get_xml {
	my @xml;
	
	die "could not open $0: $!" unless open(IN, $0);
	
	while(<IN>) {
		last if m/^__END__/;
	}
	
	while(<IN>) {
		push(@xml, $_);
	}
	
	die "could not close $0: $!" unless close(IN);
	
	return join('', @xml);
}

#which is best?
#package XML::TreePuller;
#package XML::LibXML::Reader::TreePuller;
package XML::CompactTree::Puller;
#package XML::Branches;

use strict;
use warnings;
use Data::Dumper;

use XML::LibXML::Reader;
use XML::CompactTree::XS;

sub new {
	my ($class, @args) = @_;
	my $self = {};
	my $reader;
	
	bless($self, $class);
	
	$reader = $self->{reader} = XML::LibXML::Reader->new(@args);
	$self->{elements} = [];
	$self->{config} = {};
	$self->{finished} = 0;
	
	die "could not construct libxml reader" unless defined $reader;
		
	die "libxml read error" unless $reader->read == 1;
	
	return $self;
	
}

sub config {
	my ($self, $path, $todo) = @_;
	
	$self->{config}->{$path} = $todo;
}

sub next {
	my ($self) = @_;
	my $reader = $self->{reader};
	my $elements = $self->{elements};
	my $config = $self->{config};
	
	return undef if $self->{finished};
	
	while(1) {
		my $type = $reader->nodeType;
		
		if ($type == XML_READER_TYPE_ELEMENT) {
			push(@$elements, $reader->name);
			my $is_empty = $reader->isEmptyElement;
			my $path = '/' . join('/', @$elements);
			my $todo = $config->{$path};
			my $did_something = 0;
			my $ret;
				
			if (defined($todo)) {	
				if ($todo eq 'subtree') {
					$ret = $self->do_subtree;
				} elsif ($todo eq 'element') {
					$ret = $self->read_element;
				} elsif (ref($todo) eq 'CODE') {
					$ret = $self->do_code($todo);
				} else {
					die "unexpected todo type";
				}
				
				$did_something = 1;
			}
			
			if ($is_empty) {
				pop(@$elements);
			}
			
			if ($did_something) {
				return $ret;
			}
		} elsif ($type == XML_READER_TYPE_END_ELEMENT) {
			pop(@$elements);
		}
		
		my $ret = $reader->read;
		
		if ($ret == 0) {
			$self->{finished} = 1;
			return undef;
		}
		
		die "libxml read error" if $ret == -1;
		die "expected 1" unless $ret == 1;
		
	}
	
}

sub do_code {
	my ($self, $ref) = @_;
	
	return &$ref($self->read_element);
}

sub do_subtree {
	my ($self) = @_;
	my $reader = $self->{reader};
	my $elements = $self->{elements};
	
	my $tree = Element->new(read_tree($reader));
	
	#CompactTree leaves us in an unknown spot after it's done
	#slurping up data - get ourselves back into sync with
	#the position of the reader
	my $depth = $reader->depth;
	splice(@$elements, $depth);
	
	if (! defined($tree)) {
		$self->{finished} = 1;
		return undef;
	}
	
	return $tree;
}

sub read_element {
	my ($self) = @_;
	my $reader = $self->{reader};
	my $new;
	my %attr;
	
	$new->[0] = 1;
	$new->[1] = $reader->name;
	$new->[2] = 0;
		
	if ($reader->hasAttributes && $reader->moveToFirstAttribute == 1) {
		do {
			my $name = $reader->name;
			my $val = $reader->value;
			
			$attr{$name} = $val;
		} while($reader->moveToNextAttribute == 1);
	}

	$new->[3] = \%attr;
	$new->[4] = undef;
	
	return Element->new($new);
}

sub read_tree {
	my ($r) = @_;
	
	return XML::CompactTree::XS::readSubtreeToPerl($r, 0);
}

package Element;

use strict;
use warnings;
use Carp qw(croak);

use XML::LibXML::Reader;

use Data::Dumper;

sub new {
	my ($class, $tree) = @_;
	
	if ($tree->[0] != XML_READER_TYPE_ELEMENT) {
		croak("must specify an element node");
	}
	
	bless($tree, $class);
	
	return $tree;
}

sub get_element {
	my ($tree, $path) = @_;
	my @path = split('/', $path);
	my $p = [ $tree ];
	my $target = pop(@path);	
	my $found;
	
	#remove empty data caused by leading /
	shift(@path);

	foreach (@path) {
		$found = 0;
	
		for(my $i = 0; $i < scalar(@$p); $i++) {
			my $one = $p->[$i];
			
			if ($one->[0] != XML_READER_TYPE_ELEMENT) {
				next;
			} elsif ($one->[1] eq $_) {
				$p = $one->[4];
				$found = 1;
				last;
			}		
		}
		
		return undef unless $found;
	}

	for(my $i = 0; $i < scalar(@$p); $i++) {
		next unless $p->[$i]->[0] == XML_READER_TYPE_ELEMENT;
		
		if ($p->[$i]->[1] eq $target) {
			return Element->new($p->[$i]);
		}
	}	
	
	return undef;
}

sub name {
	my ($tree) = @_;
	
	return $tree->[1];
}

sub child_nodes {
	my ($tree) = @_;
	
	return $tree->[4];
}

sub text {
	my ($p) = @_;
	my @text;
	
	$p = $p->child_nodes;
	
	return undef unless defined $p;

	for(my $i = 0; $i < scalar(@$p); $i++) {
		if ($p->[$i]->[0] == XML_READER_TYPE_TEXT || $p->[$i]->[0] == XML_READER_TYPE_CDATA) {
			push(@text, $p->[$i]->[1]);
		}
	}	
	
	return join('', @text);
}

sub attributes {
	my ($tree) = @_;
	my $attr = $tree->[3];
	
	return {} unless defined $attr;
	return $attr;
}

__END__

<mediawiki xmlns="http://www.mediawiki.org/xml/export-0.3/" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="http://www.mediawiki.org/xml/export-0.3/ http://www.mediawiki.org/xml/export-0.3.xsd" version="0.3" xml:lang="simple">
<siteinfo>
  <sitename>Sitename Test Value</sitename>
  <base>Base Test Value</base>
  <generator>Generator Test Value</generator>
  <case>Case Test Value</case>
  <namespaces>
    <namespace key="-2">Media</namespace>
    <namespace key="-1">Special</namespace>
    <namespace key="0" />
    <namespace key="1">Talk</namespace>
    <namespace key="2">User</namespace>
    <namespace key="3">User talk</namespace>
    <namespace key="4">Wikipedia</namespace>
    <namespace key="5">Wikipedia talk</namespace>
    <namespace key="6">Image</namespace>
    <namespace key="7">Image talk</namespace>
    <namespace key="8">MediaWiki</namespace>
    <namespace key="9">MediaWiki talk</namespace>
    <namespace key="10">Template</namespace>
    <namespace key="11">Template talk</namespace>
    <namespace key="12">Help</namespace>
    <namespace key="13">Help talk</namespace>
    <namespace key="14">Category</namespace>
    <namespace key="15">Category talk</namespace>
  </namespaces>
</siteinfo>
<page>
  <title>Talk:Title Test Value</title>
  <id>1</id>
    <revision>
      <id>47084</id>
      <timestamp>2005-07-09T18:41:10Z</timestamp>
      <contributor><username>Username Test Value</username><id>1292</id></contributor>
      <minor/>
      <comment>Comment Test Value</comment>
      <text xml:space="preserve">Text Test Value
</text>
    </revision>
</page>

<page>
  <title>Title Test Value #2</title>
  <id>2</id>
    <revision>
      <id>47085</id>
      <timestamp>2005-07-09T18:41:10Z</timestamp>
      <contributor><username>Username Test Value 2</username><id>1292</id></contributor>
      <minor/>
      <comment>Comment Test Value</comment>
      <text xml:space="preserve">#redirect : [[fooooo]]
</text>
    </revision>
</page>

<page>
  <title>Title Test Value #3</title>
  <id>3</id>
    <revision>
      <id>47086</id>
      <timestamp>2005-07-09T18:41:10Z</timestamp>
      <contributor><username>Username Test Value</username><id>1292</id></contributor>
      <minor/>
      <comment>Comment Test Value</comment>
      <text xml:space="preserve">#redirect [[fooooo]]
</text>
    </revision>
</page>

<page>
  <title>NotANameSpace:Bar</title>
  <id>4</id>
    <revision>
      <id>47088</id>
      <timestamp>2005-07-09T18:41:10Z</timestamp>
      <contributor><username>Username Test Value</username><id>1292</id></contributor>
      <minor/>
      <comment>Comment Test Value</comment>
      <text xml:space="preserve">
        test for bug #36255 -
	Parse::MediaWikiDump::page::namespace may return a string 
	which is not really a namespace
      </text>
    </revision>
</page>

</mediawiki>