File Coverage

blib/lib/XML/TreePuller.pm

Criterion	Covered	Total	%
statement	13	15	86.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	18	20	90.0

package XML::TreePuller;

our $VERSION = '0.1.3_01';

use strict;
use warnings;
use Data::Dumper;
use Carp qw(croak carp);

use XML::LibXML::Reader;

use XML::TreePuller::Element;
use XML::TreePuller::Constants;
use XML::CompactTree;

our $NO_XS;

BEGIN {

	if ($ENV{XML_TREEPULLER_NO_XS}) {
		$NO_XS = $ENV{XML_TREEPULLER_NO_XS};
	}

	if (! $NO_XS && ! defined(eval { require XML::CompactTree::XS; })) {
		$NO_XS = 1;
	}

}

sub new {
	my ($class, @args) = @_;
	my $self = {};
	my $reader;

	bless($self, $class);

	$self->{elements} = [];
	$self->{config} = {};
	$self->{finished} = 0;

	$Carp::CarpLevel++;
	$reader = $self->{reader} = XML::LibXML::Reader->new(@args);
	$Carp::CarpLevel--;

	#arg how do you get error messages out of libxml reader?
	croak("could not construct libxml reader") unless defined $reader;

	return $self;
}

sub parse {
	my ($class, @args) = @_;

	return $class->new(@args)->next;
}

sub iterate_at {
	my ($self, $path, $todo) = @_;

	croak("must specify match and instruction") unless defined $path && defined $todo;

	$self->{config}->{$path} = $todo;

	return undef;
}

sub config {
	#turn this warning on later
	#carp "config() is depreciated, use iterate_at() instead";

	return iterate_at(@_);
}

sub next {
	my ($self) = @_;
	my $reader = $self->{reader};
	my $elements = $self->{elements};
	my $config = $self->{config};
	my $ret;

	return () if $self->{finished};

	if ($reader->nodeType != XML_READER_TYPE_ELEMENT) {
		if (! $self->_find_next_element) {
			#no more elements available in the document
			return ();
		}
	}

	#the reader came in already sitting on an element so we have to
	#iterate at the end of the loop
	do {
		my $path;
		my $todo;
		my $ret;

		if(! $self->_sync) {
			#ran out of data in the document
			return ();
		}

		push(@$elements, $reader->name);

		$path = '/' . join('/', @$elements);

		#handle the default case where no config is specified
		if (scalar(keys(%$config)) == 0) {
			$self->{finished} = 1;

			if (wantarray()) {
				return($path, $self->_read_subtree);
			}

			return $self->_read_subtree;
		}

		#if this is converted over a dispatch hash then
		#the keys in the hash can be used to validate items
		#as they are passed to next() and allow this
		#method to scale to more instructions
		if (defined($todo = $config->{$path})) {
			if ($todo eq 'short') {
				$ret = $self->_read_element;
			} elsif ($todo eq 'subtree') {
				$ret = $self->_read_subtree;
			} else {
				die "invalid todo specified: $todo";
			}

			if (wantarray()) {
				return($path, $ret);
			}

			return $ret;
		}

	} while ($self->_find_next_element);

	return ();
}

sub reader {
	return $_[0]->{reader};
}

#private methods

#get the reader to a point where it is in sync with
#our internal element list
sub _sync {
	my ($self) = @_;
	my $reader = $self->{reader};
	my $depth = $self->{reader}->depth;
	my $elements = $self->{elements};

	#if we are at a higher level than we have
	#tracked to we need to get back to the same
	#depth as our element list to properly process
	#data again
	while(scalar(@$elements) < $reader->depth) {
		my $ret = $reader->nextElement;

		if ($ret == -1) {
			die "libxml read error";
		} elsif ($ret == 0) {
			$self->{finished} = 1;
			return 0;
		}
	}

	#handle the case where the reader is at a lower
	#depth than we have tracked to
	splice(@$elements, $reader->depth);

	return 1;
}


sub _find_next_element {
	my ($self) = @_;
	my $reader = $self->{reader};
	my $ret;

	if (! ($ret = $reader->nextElement)) {
		$self->{finished} = 1;

		return 0;
	} elsif ($ret == -1) {
		die "libxml read error";
	}

	return 1;
}

sub _read_subtree {
	my ($self) = @_;
	my $reader = $self->{reader};
	my $elements = $self->{elements};

	my $tree = XML::TreePuller::Element->new(_read_tree($reader));

	if (! defined($tree)) {
		$self->{finished} = 1;
		return undef;
	}

	return $tree;
}

sub _read_element {
	my ($self) = @_;
	my $reader = $self->{reader};
	my $is_empty = $reader->isEmptyElement;
	my $new;
	my %attr;
	my $node_type;
	my $ret;

	$new->[XML_TREEPULLER_ELEMENT_TYPE] = 1;
	$new->[XML_TREEPULLER_ELEMENT_NAME] = $reader->name;
	$new->[XML_TREEPULLER_ELEMENT_NAMESPACE] = 0;
	$new->[XML_TREEPULLER_ELEMENT_ATTRIBUTES] = \%attr;
	$new->[XML_TREEPULLER_ELEMENT_CHILDREN] = [];


	if ($reader->hasAttributes && $reader->moveToFirstAttribute == 1) {
		do {
			my $name = $reader->name;
			my $val = $reader->value;

			$attr{$name} = $val;
		} while($reader->moveToNextAttribute == 1);
	}


	$ret = $reader->read;

	if ($ret == -1) {
		die "libxml read error";
	} elsif ($ret == 0) {
		return undef;
	}

	if ($is_empty) {
		return XML::TreePuller::Element->new($new);
	}

	$node_type = $reader->nodeType;

	while($node_type != XML_READER_TYPE_ELEMENT && $node_type != XML_READER_TYPE_END_ELEMENT) {
		$node_type = $reader->nodeType;

		if ($node_type == XML_READER_TYPE_TEXT || $node_type == XML_READER_TYPE_CDATA) {
			push(@{$new->[XML_TREEPULLER_ELEMENT_CHILDREN]}, [ $node_type, $reader->value ]);
		}

		$ret = $reader->read;

		if ($ret == -1) {
			die "libxml read error";
		} elsif ($ret == 0) {
			return undef;
		}

		$node_type = $reader->nodeType;

	}

	return XML::TreePuller::Element->new($new);
}

sub _read_tree {
	my ($r) = @_;

	if ($NO_XS) {
		return XML::CompactTree::readSubtreeToPerl($r, 0);
	}

	return XML::CompactTree::XS::readSubtreeToPerl($r, 0);
}

1;

__END__