# do attribute matching
        foreach my $kid (@kids) {
            my $value = $get_attr_value->($kid, $pat->{attr});
            push(@results, $kid)
              if ($op eq 'eq' and $value eq $pat->{value}) or 
                 ($op eq '='  and $value == $pat->{value}) or 
                 ($op eq '!=' and $value != $pat->{value}) or 
                 ($op eq '>'  and $value >  $pat->{value}) or 
                 ($op eq '<'  and $value <  $pat->{value}) or 
                 ($op eq '>=' and $value >= $pat->{value}) or 
                 ($op eq '<=' and $value <= $pat->{value});                 
        }
        }
        else {
            my $attr = $pat->{attr};
            push(@results, $get_attr_value->($self, $attr))
            if grep { $_ eq $attr } $get_attr_names->($self);
        }
    } elsif (defined $pat->{child}) {
        croak("Can't process child pattern without name")
        unless defined $pat->{name};
        # default op is 'eq' for string matching
        my $op = $pat->{op} || 'eq';
        # do attribute matching
        foreach my $kid (@kids) {
            foreach ( 
                $pat->{child} eq "." ? $kid
                : grep {$get_name->($_) eq $pat->{child}} $get_children->($kid)
            ) {
                my $value;
                foreach_node { 
                    my $txt = $get_content->($_);
                    $value .= $txt if defined $txt;
                } $_, $get_children;
                next unless defined $value;
                push(@results, $kid)
                  if ($op eq 'eq' and $value eq $pat->{value}) or 
                     ($op eq '='  and $value == $pat->{value}) or 
                     ($op eq '!=' and $value != $pat->{value}) or 
                     ($op eq '>'  and $value >  $pat->{value}) or 
                     ($op eq '<'  and $value <  $pat->{value}) or 
                     ($op eq '>=' and $value >= $pat->{value}) or 
                     ($op eq '<=' and $value <= $pat->{value});
            }
        }
    } else {
        push @results, @kids;
    }

    # all done?
    return @results unless @patterns;

    # apply remaining patterns on matching kids
    return map { $pkg->_do_match($_, $args, @patterns) } @results;
}


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

    my $parent = $get_parent->($self);
    return '/' unless defined $parent; # root's xpath is /
    
    # get order within same-named nodes in the parent
    my $name = $get_name->($self);
    my $count = 0;
    for my $kid ($get_children->($parent)) {
        last if $kid == $self;
        $count++ if $get_name->($kid) eq $name;
    }

    # construct xpath using parent's xpath and our name and count
    return $pkg->xpath($parent, $args) . 
      ($get_parent->($parent) ? '/' : '') .
        $name . '[' . $count . ']';
}


# does a depth first traversal in a stack
sub foreach_node (&@) {
    my ($code, $node, $get_children) = @_;
    my @stack = ($node);
    while (@stack) {
        local $_ = shift(@stack);
        $code->();
        push(@stack, $get_children->($_));
    }
}

1;
__END__

=head1 NAME

Class::XPath - adds xpath matching to object trees

=head1 SYNOPSIS