The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl 
#$Id: /tree-xpathengine/trunk/t/01_basic.t 21 2006-02-13T10:47:57.335542Z mrodrigu  $

use strict;
use warnings;

use Test::More qw( no_plan);
use Tree::XPathEngine;

BEGIN { push @INC, './t'; }

my $tree = init_tree();
my $xp   = Tree::XPathEngine->new;

{
my @root_nodes= $xp->findnodes( '/root', $tree);
is( join( ':', map { $_->value } @root_nodes), 'root_value', q{findnodes( '/root', $tree)});
}
{
my @kid_nodes= $xp->findnodes( '/root/kid0', $tree);
is( scalar @kid_nodes, 2, q{findnodes( '/root/kid0', $tree)});
}
{
my $kid_nodes= $xp->findvalue( '/root/kid0', $tree);
is( $kid_nodes, 'vkid2vkid4', q{findvalue( '/root/kid0', $tree)});
}
{
is( $xp->findvalue( '//*[@att2="vv"]', $tree), 'gvkid1gvkid2gvkid3gvkid4gvkid5', 
    q{findvalue( '//*[@att2="vv"]', $tree)}
  );
is( $xp->findvalue( '//*[@att2]', $tree), 'gvkid1gkid2 1gvkid2gkid2 2gvkid3gkid2 3gvkid4gkid2 4gvkid5gkid2 5', 
    q{findvalue( '//*[@att2]', $tree)}
  );
}

{
is( $xp->findvalue( '//kid1/@att1[.="v1"]', $tree), 'v1', "return attribute values (1)");
is( $xp->findvalue( '//@att1[.="v1"]', $tree), 'v1'x2, "return attribute values (2)");
is( $xp->findvalue( '//@att2[.="vx"]', $tree), 'vx'x5, "return attribute values (5)");

is( $xp->findvalue( '//kid1/@att1[.=~m/v1/]', $tree), 'v1', "regxp match, return attribute values (1)");
is( $xp->findvalue( '//@att1[.=~m/v1/]', $tree), 'v1'x2, "regxp match, return attribute values (2)");
is( $xp->findvalue( '//@att2[.=~/vx/]', $tree), 'vx'x5, "regxp match, return attribute values (5)");
}

{ my $elt= ($xp->findnodes( '/root/kid1[1]/gkid2', $tree))[0];
  ok( $xp->matches( $elt, '/root/kid1/gkid2', $tree), 'matches (true)');
  ok( !$xp->matches( $elt, '/root/kid0/gkid2', $tree), 'matches (false)');
}

{ my @empty= $xp->findnodes( '0', $tree);
  is( scalar( @empty), 0, 'findnodes, empty return in list context');
}

{ is( $xp->findnodes_as_string( '/root/kid1[1]/gkid2', $tree), '[gkid2 {att2="vx"} gkid2 1]' , 'findnode_as_string (nodeset result)');
  is( $xp->findnodes_as_string( '"foo"', $tree), 'foo' , 'findnode_as_string (literal result)');
  is( $xp->findnodes_as_string( '1', $tree), 1 , 'findnode_as_string (number result)');
}
{ is( $xp->findvalue( '/root/kid1[1]/gkid2', $tree), 'gkid2 1' , 'findvalue (nodeset result)');
  is( $xp->findvalue( '"foo"', $tree), 'foo' , 'findvalue (literal result)');
  is( $xp->findvalue( '1', $tree), 1 , 'findvalue (number result)');
  is( $xp->findvalue( '//nothing', $tree), '' , 'findvalue (number result)');
}

{ is( $xp->exists( '/root/kid1[1]/gkid2', $tree), 1, 'exists (true)');
  is( $xp->exists( '/nothing/kid1[1]/gkid2', $tree), 0, 'exists (false)');
}

{ $xp->set_var( var => "gkid2 1");
  is( $xp->get_var( 'var'), 'gkid2 1', 'get_var');
  is( $xp->findvalue( '//gkid2[string()="gkid2 1"]', $tree), 'gkid2 1', "string()");
  #is( $xp->findvalue( '//gkid2[string()=$var]', $tree), 'gkid2 1', "string()"); # TODO
}

{ # to test _get_context_size
  is( $xp->findvalue( '//kid0[last()]/gkid2', $tree), 'gkid2 4', "string()");
  # to test _get_context_pos
  is( $xp->findvalue( '//kid0[position()=2]/gkid2', $tree), 'gkid2 4', "string()");
}


sub init_tree
  {  my $tree  = tree->new( 'att', name => 'tree', value => 'tree');
    my $root  = tree->new( 'att', name => 'root', value => 'root_value', att1 => 'v1');
    $root->add_as_last_child_of( $tree);

    foreach (1..5)
      { my $kid= tree->new( 'att', name => 'kid' . $_ % 2, value => "vkid$_", att1 => "v$_");
        $kid->add_as_last_child_of( $root);
        my $gkid1= tree->new( 'att', name => 'gkid' . $_ % 2, value => "gvkid$_", att2 => "vv");
        $gkid1->add_as_last_child_of( $kid);
        my $gkid2= tree->new( 'att', name => 'gkid2', value => "gkid2 $_", att2 => "vx");
        $gkid2->add_as_last_child_of( $kid);
      }

    $tree->set_pos;
    #tree->dump_all;

    return $tree;
  }


package tree;
use base 'minitree';

sub xpath_get_name             { return shift->name;  }
sub xpath_string_value         { return shift->value; }
sub xpath_get_root_node        { return shift->root;                }
sub xpath_get_parent_node      { return shift->parent;              }
sub xpath_get_child_nodes      { return shift->children; }
sub xpath_get_next_sibling     { return shift->next_sibling;        }
sub xpath_get_previous_sibling { return shift->previous_sibling;    }
sub xpath_is_element_node      { return 1;                          }
sub xpath_get_attributes       { return @{shift->attributes}; }
sub to_string            
  { my $node= shift; 
    my $name= $node->name;
    my $value= $node->value;
    my $atts= join( ' ', map { $_->to_string } $_->xpath_get_attributes);
    return "[$name {$atts} $value]";
  }

sub xpath_cmp { my( $a, $b)= @_; return $a->pos <=> $b->pos; }

1;

package att;
use base 'attribute';

sub xpath_get_name          { return shift->name;                }
sub to_string         { my $att= shift; return sprintf( '%s="%s"', $att->name, $att->value) ; }
sub xpath_string_value      { return shift->value;               }
sub xpath_get_root_node     { return shift->parent->root;        }
sub xpath_get_parent_node   { return shift->parent;              }
sub xpath_is_attribute_node { return 1;                          }
sub xpath_get_child_nodes   { return; }

sub xpath_cmp { my( $a, $b)= @_; return $a->pos <=> $b->pos; }

1;