#!/usr/bin/perl -w use strict; use Carp; use File::Spec; use lib File::Spec->catdir(File::Spec->curdir,"t"); use tools; use XML::Twig; my $DEBUG=0; print "1..44\n"; { # test tag regexp handler my @res; my $doc=q{<doc><foo_f1/><foo_f2/><foo_f1/><foo_f3/><afoo_f1/><FOO_f4/></doc>}; my $handlers= { qr/^foo_/ => sub { push @res, $_->tag; }, foo_f2 => sub { push @res, uc $_->tag; 0 }, }; my $expected= 'foo_f1:FOO_F2:foo_f1:foo_f3'; XML::Twig->new( twig_handlers => $handlers)->parse( $doc); my $res= join( ':', @res); is( $res, $expected, "tag regexp handlers"); } { # test tag regexp handler with i modifier my @res; my $doc=q{<doc><foo_f1/><foo_f2/><foo_f1/><foo_f3/><afoo_f1/><FOO_f4/></doc>}; my $handlers= { qr/^foo_/i => sub { push @res, $_->tag; }, foo_f2 => sub { push @res, uc $_->tag; 0 }, }; my $expected= 'foo_f1:FOO_F2:foo_f1:foo_f3:FOO_f4'; XML::Twig->new( twig_handlers => $handlers)->parse( $doc); my $res= join( ':', @res); is( $res, $expected, "tag regexp handlers"); } { # test tag regexp handler with all modifier my @res; my $doc=q{<doc><foo_f1/><foo_f2/><foo_f1/><foo_f3/><afoo_f1/><FOO_f4/></doc>}; my $handlers= { qr/^foo_/xism => sub { push @res, $_->tag; }, foo_f2 => sub { push @res, uc $_->tag; 0 }, }; my $expected= 'foo_f1:FOO_F2:foo_f1:foo_f3:FOO_f4'; XML::Twig->new( twig_handlers => $handlers)->parse( $doc); my $res= join( ':', @res); is( $res, $expected, "tag regexp handlers"); } { # testing last_descendant my $t= XML::Twig->new->parse( '<doc id="doc"> <e3 id="e3">t_e_3</e3> <e4 id="e4" /> <e id="e1">t_e_1</e> <e id="e2">t_e_2<n id="n1">t_n</n></e> </doc> ' ); my %exp2id= ( '' => 't_n', 'n' => 'n1', '#ELT' => 'n1', 'e' => 'e2', 'e[@id="e1"]' => 'e1', 'e2' => undef, ); foreach my $exp (sort keys %exp2id) { my $expected= $exp2id{$exp}; is( result( $t->last_elt( $exp)), $expected, "last_elt( $exp)"); is( result( $t->root->last_descendant( $exp)), $expected, "last_descendant( $exp)"); } # some more tests to check that we stay in te subtree and that we get the last descendant if it is itself is( result( $t->last_elt( 'e3')), 'e3', 'last_elt( e3)'); is( result( $t->root->last_descendant( 'e3')), 'e3', 'last_descendant( e3)'); is( result( $t->root->first_child( 'e3')->last_descendant( 'e3')), 'e3', 'last_descendant( e3) (on e3)'); is( result( $t->root->first_child( 'e3')->last_descendant()), 't_e_3', 'last_descendant() (on e3)'); is_undef( $t->root->last_child->last_descendant( 'e3'), 'last_descendant (no result)'); is( result( $t->root->first_child( 'e4')->last_descendant( 'e4')), 'e4', 'last_descendant( e4) (on e4)'); is( result( $t->root->first_child( 'e4')->last_descendant( )), 'e4', 'last_descendant( ) (on e4)'); sub result { my( $elt)= @_; return undef unless $elt; return $elt->id || $elt->text; } } {# testing trim my $expected; while( <DATA>) { chomp; next unless( m{\S}); if( s{^#}{}) { $expected= $_; } is( XML::Twig->new->parse( $_)->trim->root->sprint, $expected, "trimming '$_'"); } } { # testing children_trimmed_text my $t = XML::Twig->new; $t->parse("<o><e> hell </e><i> foo </i><e> o, \n world</e></o>"); is( join( ':', $t->root->children_trimmed_text("e")), "hell:o, world" , "children_trimmed_text (list context)"); my $scalar= $t->root->children_trimmed_text("e"); is( $scalar, "hello, world" , "children_trimmed_text (scalar context)"); is( join( ':', $t->root->children_text("e")), " hell : o, \n world" , "children_text (list context)"); $scalar= $t->root->children_text("e"); is( $scalar, " hell o, \n world" , "children_text (scalar context)"); } __DATA__ #<doc>text1 text2</doc> <doc> text1 text2</doc> <doc> text1 text2</doc> <doc>text1 text2 </doc> <doc>text1 text2 </doc> <doc>text1 text2 </doc> <doc>text1 text2</doc> <doc> text1 text2 </doc> <doc> text1 text2 </doc> #<doc>text1 <e>text2</e> text3</doc> <doc>text1 <e>text2</e> text3 </doc> #<doc>text1 <e> text2 </e> text3</doc> <doc>text1 <e> text2 </e> text3 </doc> #<doc><![CDATA[text1 text2]]></doc> <doc> <![CDATA[text1 text2]]> </doc> <doc><![CDATA[ text1 text2 ]]></doc> #<doc>text <b> hah! </b> yep</doc> <doc> text <b> hah! </b> yep</doc>