package Class::XPath;

use 5.006;
use strict;
use warnings;

our $VERSION = '1.4';
use Carp qw(croak);
use constant DEBUG => 0;

# regex fragment for names in XPath expressions
our $NAME = qr/[\w:]+/;

# declare prototypes
sub foreach_node (&@);

# handle request to build methods from 'use Class::XPath'.
sub import {
    my $pkg = shift;
    return unless @_;
    my $target = (caller())[0];
    # hand off to add_methods
    $pkg->add_methods(@_, target => $target, from_import => 1);
}

{
    # setup lists of required params
    my %required = map { ($_,1) } 
      qw(get_name get_parent get_children 
         get_attr_names get_attr_value get_content
         get_root call_match call_xpath);
    
# add the xpath and match methods to 
sub add_methods {
    my $pkg  = shift;
    my %args = (call_match => 'match',
                call_xpath => 'xpath',
                @_);
    my $from_import = delete $args{from_import};
    my $target      = delete $args{target};
    croak("Missing 'target' parameter to ${pkg}->add_methods()")
      unless defined $target;

    # check args
    local $_;
    for (keys %args) {
        croak("Unrecognized parameter '$_' " . 
              ($from_import ? " on 'use $pkg' line. " :
                              "passed to ${pkg}->add_methods()"))
          unless $required{$_};
    }
    for (keys %required) {
        croak("Missing required parameter '$_' " . 
              ($from_import ? " on 'use $pkg' line. " :
                              "in call to ${pkg}->add_methods()"))
          unless exists $args{$_};
    }

    # translate get_* method names to sub-refs
    for (grep { /^get_/ } keys %args) {
        next if ref $args{$_} and ref $args{$_} eq 'CODE';
        $args{$_} = eval "sub { shift->$args{$_}(\@_) };";
        croak("Unable to compile sub for '$_' : $@") if $@;
    }

    # install code into requested names to call real match/xpath with
    # supplied %args
    {
        no strict 'refs';
        *{"${target}::$args{call_match}"} = 
          sub { $pkg->match($_[0], \%args, $_[1]) };
        *{"${target}::$args{call_xpath}"} = 
          sub { $pkg->xpath($_[0], \%args) }
    }
}}

sub match {
    my ($pkg, $self, $args, $xpath) = @_;
    my ($get_root, $get_parent, $get_children, $get_name) = 
      @{$args}{qw(get_root get_parent get_children get_name)};

    croak("Bad call to $args->{call_match}: missing xpath argument.")
      unless defined $xpath;
    
    print STDERR "match('$xpath') called.\n" if DEBUG;

    # / is the root.  This should probably work as part of the
    # algorithm, but it doesn't.
    return $get_root->($self) if $xpath eq '/';
        
    # . is self.  This should also work as part of the algorithm,
    # but it doesn't.
    return $self if $xpath eq '.';

    # break up an incoming xpath into a set of @patterns to match
    # against a list of @target elements
    my (@patterns, @targets);    
        
    # target aquisition
    if ($xpath =~ m!^//(.*)$!) {