#!/usr/bin/perl use strict; use warnings FATAL => qw(all); use Data::Dumper; use Test::More qw(no_plan); use FindBin; use lib "$FindBin::Bin/.."; #======================================== # require_ok('YATT::LRXML::Node'); require_ok('YATT::LRXML::Parser'); my $base = YATT::LRXML::Parser->new; #======================================== # { my %nsdict; my $i = 0; foreach my $type (qw( text comment decl_comment pi entity root element attribute )) { my $tree; ok(ref($tree = YATT::LRXML::Node->new($type, undef, $type)) , "$type create tree"); is $tree->node_type, $i, "$type keeps same enum order"; is $tree->node_type_name, $type, "$type has same type_name"; is $tree->node_body, $type, "$type get_body"; } continue { $i++; } } #======================================== import YATT::LRXML::Node; is(stringify_node($base->create_node(comment => perl => ' foobar')) , q(), 'stringify_node(perl) comment'); is(stringify_node($base->create_node(text => undef, 'foobar')) , q(foobar), 'stringify_node(perl) text'); is(stringify_node($base->create_node(pi => perl => ' foobar')) , q(), 'stringify_node(perl) pi'); is(stringify_node($base->create_node(entity => perl => ':foobar')) , q(&perl:foobar;), 'stringify_node(perl) entity'); is(stringify_node($base->create_node(element => , ['perl', 'foo'] , $base->create_node(text => undef, 'ba') , 'r')) , q(bar), q(bar)); # element でない attribute は, node_name に # (intern しない) 生の文字列を入れる。 # empty element は [element => 1] で create する。 is(stringify_node($base->create_node(element => , ['perl', 'foo'] , $base->create_node([attribute => 2] , bar => 'baz') , 'b' , $base->create_node(text => undef, 'ar') , $base->create_node([element => 1] , ['perl', 'hoe']))) , q(bar) , q(bar)); is(stringify_node($base->create_node(element => , ['perl', 'foo'] , $base->create_node([attribute => 1] , bar => 'baz') , 'b' , $base->create_node(text => undef, 'ar') , $base->create_node([element => 1] , ['perl', 'hoe']))) , q(bar) , q(bar)); #======================================== # my $att; $att = $base->create_node([attribute => 0], 'foo' => 'bar'); is node_name($att), 'foo', "attribute name"; is node_body($att), 'bar', "attribute name"; is node_flag($att), 0, "attribute quote flag"; #XXX: ok($att->get_quote_char eq "", "attribute quote char"); is stringify_node($att), q(foo=bar), q(foo=bar); is stringify_node($base->create_node([attribute => 1] , 'foo' => 'bar')) , q(foo='bar'), q(foo='bar'); is stringify_node($base->create_node([attribute => 2] , 'foo' => 'bar')) , q(foo="bar"), q(foo="bar"); is stringify_node($base->create_node([attribute => undef] , 'checked')) , q(checked), q(checked); is(stringify_node(($att = $base->create_node ([attribute => $base->quoted_by_element] , ['perl', 'foo'] => 'bar', 'baz'))) , q(<:perl:foo>barbaz), q(<:perl:foo>barbaz)); is_deeply [node_children($att)], [qw(bar baz)], 'list attribute->children'; #======================================== # my @elem = $base->create_attlist (' ', 'href', '=', undef, 'foo', undef, ' ', 'name', '=', 'bar', undef, undef, ' ', 'id', '=', undef, undef, 'baz'); print "elem: ", Dumper(@elem), "\n" if $ENV{VERBOSE}; is scalar(@elem), 3, 'parse_match compose all atts'; my $i = 0; is stringify_node($elem[$i++]), q(href="foo"), q(href="foo"); is stringify_node($elem[$i++]), q(name='bar'), q(name='bar'); is stringify_node($elem[$i++]), q(id=baz), q(id=baz); #======================================== sub dumper { require Data::Dumper; Data::Dumper->new(\@_)->Terse(1)->Indent(0)->Dump; } { #XXX: Do test. require_ok('YATT::LRXML::NodeCursor'); my $cursor = new YATT::LRXML::NodeCursor ($base->create_node([element => 0] , ['yatt', 'foo'] , $base->create_node([attribute => 2] , bar => 'baz') , 'b' , $base->create_node(text => undef, 'ar') , $base->create_node([element => 0] , ['perl', 'hoe']))); $cursor = $cursor->open; while ($cursor && $cursor->readable) { print dumper($cursor->node_type_name, scalar $cursor->path_list , $cursor->node_body), "\n"; if ($cursor->can_open) { print "down: ", map {defined $_ ? $_ : "(undef)"} $cursor->node_type_name, '.', $cursor->node_name,"\n"; $cursor = $cursor->open; } else { print "leaf: (", $cursor->read, ")\n"; } if (!$cursor->readable && $cursor->can_close) { print "up: \n"; $cursor = $cursor->close; } } }