File Coverage

blib/lib/Tree/DAG_Node/XPath.pm

Criterion	Covered	Total	%
statement	84	88	95.4
branch			n/a
condition	4	5	80.0
subroutine	38	42	90.4
pod	12	12	100.0
total	138	147	93.8

package Tree::DAG_Node::XPath;

require 5.006;
use strict;
use warnings;


use vars qw(@ISA $VERSION);
$VERSION="0.11";

use base 'Tree::DAG_Node';
use Tree::XPathEngine;

sub _init {
    my($self, $options) = @_[0,1];
    $self->SUPER::_init($options);

    $self->_init_xpath_engine($options);
  }

  sub _init_xpath_engine {
    my($self, $options) = @_;
    # copy options, so the delete doesn't modify the original options
    my %options= %$options;
    my %xpath_engine_options;
    my @xpath_engine_options= qw{xpath_name_re};
    foreach my $option_name ( @xpath_engine_options)
      { $xpath_engine_options{$option_name}= $options{$option_name};
        delete $options{$option_name};
      }
    $xpath_engine_options{xpath_name_re}= $options->{xpath_name_re};
    $self->{_xpath_engine} = Tree::XPathEngine->new( %xpath_engine_options);
  }

sub _xpath_engine
  { return shift()->{_xpath_engine}; }

# these are straight from Tree::XPathEngine::Node
sub find {
    my $node = shift;
    my ($path) = @_;
    my $xp = $node->root->_xpath_engine;
    return $xp->find($path, $node);
}



sub findvalue {
    my $node = shift;
    my ($path) = @_;
    my $xp = $node->root->_xpath_engine;
    return $xp->findvalue($path, $node);
}

sub findnodes {
    my $node = shift;
    my ($path) = @_;
    my $xp = $node->root->_xpath_engine;
    return $xp->findnodes($path, $node);
}

sub matches {
    my $node = shift;
    my ($path, $context) = @_;
    $context ||= $node;
    my $xp = $node->root->_xpath_engine;
    return $xp->matches($node, $path, $context);
}

# Tree::XPathEngine method   aliased to   Tree::DAG_Node method
*xpath_get_name                 =         *Tree::DAG_Node::name;
*xpath_get_next_sibling         =         *Tree::DAG_Node::right_sister;
*xpath_get_previous_sibling     =         *Tree::DAG_Node::left_sister;

sub xpath_get_root_node
  { my $node= shift;
    # The parent of root is a Tree::DAG_Node::XPath::Root
    # that helps getting the tree to mimic a DOM tree
    return $node->root->xpath_get_parent_node; # I like this one!
  }

sub xpath_get_parent_node
  { my $node= shift;
    return $node->mother || bless { root => $node }, 'Tree::DAG_Node::XPath::Root';
  }


sub xpath_get_child_nodes { my @daughters= shift()->daughters; return @daughters; }
sub xpath_is_document_node  { return 0; }
sub xpath_is_element_node   { return 1; }
sub xpath_is_attribute_node { return 0; }
#sub getValue      { return '' };

sub xpath_get_attributes
  { my $elt= shift;
    my $atts= $elt->attributes;
    my $rank=-1;
    my @atts= map { bless( { name => $_, value => $atts->{$_}, elt => $elt, rank => $rank -- },
                           'Tree::DAG_Node::XPath::Attribute')
                  }
                   sort keys %$atts;
    return @atts;
  }



sub xpath_cmp { $_[0]->address cmp $_[1]->address }


1;

# class for the fake root for a tree
package Tree::DAG_Node::XPath::Root;


sub xpath_get_child_nodes   { my @daughters= ( $_[0]->{root}); return @daughters; }
sub address           { return -1; } # the root is before all other nodes
sub xpath_get_attributes    { return (); }
sub xpath_is_document_node  { return 1   }
sub xpath_is_element_node   { return 0   }
sub xpath_is_attribute_node { return 0   }
sub xpath_get_parent_node   { return;    }
sub xpath_get_root_node     { return $_[0] }
sub xpath_get_name          { return;    }
sub xpath_get_next_sibling  { return;    }
sub xpath_get_previous_sibling { return; }


1;

package Tree::DAG_Node::XPath::Attribute;
use Tree::XPathEngine::Number;

# not used, instead xpath_get_attributes in Tree::DAG_Node::XPath directly returns an
# object blessed in this class
#sub new
#  { my( $class, $elt, $att)= @_;
#    return bless { name => $att, value => $elt->att( $att), elt => $elt }, $class;
#  }

sub xpath_get_value         { return $_[0]->{value}; }
sub xpath_get_name          { return $_[0]->{name} ; }
sub xpath_string_value      { return $_[0]->{value}; }
sub xpath_to_number         { return Tree::XPathEngine::Number->new( $_[0]->{value}); }
sub xpath_is_document_node  { 0 }
sub xpath_is_element_node   { 0 }
sub xpath_is_attribute_node { 1 }
sub to_string         { return qq{$_[0]->{name}="$_[0]->{value}"}; }
sub address
  { my $att= shift;
    my $elt= $att->{elt};
    return $elt->address . ':' . $att->{rank};
  }

sub xpath_cmp { $_[0]->address cmp $_[1]->address }

1;



__END__