File Coverage

blib/lib/Data/ZPath.pm

Criterion	Covered	Total	%
statement	66	66	100.0
branch	10	12	83.3
condition	4	6	66.6
subroutine	17	17	100.0
pod	6	6	100.0
total	103	107	96.2

use strict;
use warnings;

package Data::ZPath;

use Carp          qw(croak);

use Data::ZPath::_Ctx;
use Data::ZPath::_Lexer;
use Data::ZPath::Node;
use Data::ZPath::NodeList;
use Data::ZPath::_Parser;
use Data::ZPath::_ScalarProxy;
use Data::ZPath::_Evaluate;

our $DEBUG = 0;

our $VERSION = '0.001000';

our @CARP_NOT = qw(
	Data::ZPath::_Ctx
	Data::ZPath::_Lexer
	Data::ZPath::Node
	Data::ZPath::NodeList
	Data::ZPath::_Parser
	Data::ZPath::_ScalarProxy
	Data::ZPath::_Evaluate
);

for my $pkg ( @CARP_NOT ) {
	no strict 'refs';
	*{"${pkg}::CARP_NOT"} = \@CARP_NOT;
}

our $Epsilon      = 1e-08;
our $UseBigInt    = !!1;
our $XmlIgnoreWS  = !!1;

sub new {
	my ( $class, $expr ) = @_;
	croak "Missing expression" unless defined $expr;

	my $self = bless {
		expr_src => $expr,
		terms    => Data::ZPath::_Parser::_parse_top_level_terms($expr),
	}, $class;

	return $self;
}

sub evaluate {
	my ( $self, $root, %opts ) = @_;
	my $wantarray = wantarray;

	my $ctx = Data::ZPath::_Ctx->new($root);
	my @out;

	for my $term (@{$self->{terms}}) {
		push @out, Data::ZPath::_Evaluate::_eval_expr($term, $ctx);
		last if ( $opts{first} and @out );
	}

	return Data::ZPath::NodeList->_new_or_list(@out);
}

sub all {
	my ( $self, $root ) = @_;
	map $_->value, $self->evaluate( $root )->all;
}

sub first {
	my ( $self, $root ) = @_;
	my $found = $self->evaluate($root, first => 1)->first
		or return undef;
	return $found->value;
}

sub last {
	my ( $self, $root ) = @_;
	my $found = $self->evaluate($root)->last
		or return undef;
	return $found->value;
}

sub each {
	my ( $self, $root, $cb ) = @_;
	croak "each() requires a coderef" unless ref($cb) eq 'CODE';

	my $ctx = Data::ZPath::_Ctx->new($root);
	for my $term (@{$self->{terms}}) {
		my @res = Data::ZPath::_Evaluate::_eval_expr($term, $ctx);

		for my $node (@res) {
			my $slot = $node->slot;
			croak "each() can only mutate Perl map/list scalars (not XML)" unless $slot && ref($slot) eq 'CODE';

			tie my $proxy, 'Data::ZPath::_ScalarProxy', $slot;
			$cb->() for $proxy;
		}
	}

	return;
}

1;

__END__