#!/bin/perl -w use strict; use File::Spec; use lib File::Spec->catdir(File::Spec->curdir,"t"); use tools; $|=1; use XML::Twig; my $TMAX=19; # do not forget to update! print "1..$TMAX\n"; my $s='
Title <b>bold</b>

para1

para2

Title

para2

para3

'; my @toc; my $t= new XML::Twig( TwigHandlers => { title => sub { push @toc, $_[1]->text; } }); $t->parse( $s); my $toc= join ':', @toc; stest( $toc, "Title bold:Title", "text method"); undef @toc; $t= new XML::Twig( TwigHandlers => { title => sub { push @toc, $_[1]->sprint( 1); } }); $t->parse( $s); $toc= join ':', @toc; stest( $toc, "Title bold:Title", "sprint method"); undef @toc; $t= new XML::Twig( TwigHandlers => { title => sub { push @toc, $_[1]->sprint( 1); $_[0]->purge; } }); $t->parse( $s); $toc= join ':', @toc; stest( $toc, "Title bold:Title", "sprint method with purge"); my $purged_doc= $t->sprint; stest( $purged_doc, '

para2

para3

', "sprint purged doc"); $t= new XML::Twig( TwigRoots => { title => 1}); $t->parse( $s); my $doc= $t->sprint; stest( $doc, 'Title <b>bold</b>Title', "using title as TwigRoots"); $t= new XML::Twig( TwigHandlers => { doc => sub { $_[1]->set_att( mod => "yes"); } }, TwigRoots => { title => 1}); $t->parse( $s); $doc= $t->sprint; stest( $doc, 'Title <b>bold</b>Title', "using title as TwigRoots (with doc handler)"); $s='
t1 <b>b1</b>

para1

ts1 <b>b2</b> para1

para2

t2

para3

para4
ts2

para6

para7

'; $t= new XML::Twig( TwigHandlers => { doc => sub { $_[1]->set_att( mod => "yes"); } }, TwigRoots => { title => 1}); $t->parse( $s); $doc= $t->sprint; stest( $doc, 't1 <b>b1</b>ts1 <b>b2</b>t2ts2', "using title as TwigRoots (with doc handler)"); $t= new XML::Twig( TwigHandlers => { doc => sub { $_[1]->set_att( mod => "yes"); } }, TwigRoots => { title => 1, p2 => 1}); $t->parse( $s); $doc= $t->sprint; stest( $doc, 't1 <b>b1</b>ts1 <b>b2</b>para1t2para4ts2', "using title, p2 as TwigRoots (with doc handler)"); $s="string with ' here"; $t= new XML::Twig(); $t->parse( $s); $doc= $t->sprint; stest( $doc, "string with ' here", "apos without KeepEncoding"); $t= new XML::Twig( KeepEncoding => 1); $t->parse( $s); $doc= $t->sprint; stest( $doc, "string with ' here", "apos WITH KeepEncoding"); $s="string with " here"; $t= new XML::Twig(); $t->parse( $s); $doc= $t->sprint; stest( $doc, "string with \" here", "quote without KeepEncoding"); $t= new XML::Twig( KeepEncoding => 1); $t->parse( $s); $doc= $t->sprint; stest( $doc, 'string with " here', "quote WITH KeepEncoding"); $s="string with & here"; $t= new XML::Twig(); $t->parse( $s); $doc= $t->sprint; stest( $doc, $s, "& in text"); $s='string'; $t= new XML::Twig(); $t->parse( $s); $doc= $t->sprint; stest( $doc, $s, "& in attribute"); $s="string with < here"; $t= new XML::Twig(); $t->parse( $s); $doc= $t->sprint; stest( $doc, $s, "< in text"); $s='string'; $t= new XML::Twig(); $t->parse( $s); $doc= $t->sprint; stest( $doc, $s, "< in attribute"); $s="string with " here"; $t= new XML::Twig(); $t->parse( $s); $doc= $t->sprint; stest( $doc, 'string with " here', "" in text"); $s='string'; $t= new XML::Twig(); $t->parse( $s); $doc= $t->sprint; stest( $doc, $s, "" in attribute"); #$s='string'; #$t= new XML::Twig(); #$t->parse( $s); #$doc= $t->sprint; #stest( $doc, $s, "‚ in attribute"); #$s="string with ‰ here"; #$t= new XML::Twig(); #$t->parse( $s); #$doc= $t->sprint; #stest( $doc, "string with ‚ here", "eacute without KeepEncoding"); #$t= new XML::Twig( KeepEncoding => 1); #$t->parse( $s); #$doc= $t->sprint; #stest( $doc, 'string with ‰ here', "eacute WITH KeepEncoding"); #$s='string with ‚ here'; #$t= new XML::Twig(); #$t->parse( $s); #$doc= $t->sprint; #stest( $doc, "string with ‚ here", "‚ without KeepEncoding"); #$t= new XML::Twig( KeepEncoding => 1); #$t->parse( $s); #$doc= $t->sprint; #stest( $doc, 'string with ‚ here', "‚ WITH KeepEncoding"); #$s='text'; #$t= new XML::Twig(); #$t->parse( $s); #$doc= $t->sprint; #stest( $doc, $s, "PI"); my ($a, $ba, $rba); $t= XML::Twig->new( twig_handlers => { a => sub { $a++; 1; }, 'b/a' => sub { $ba++; 1;}, '/b/a' => sub { $rba++; 1;}, }, ); $t->parse( ''); my $calls= ($a || '_') . ($ba || '_') . ($rba || '_'); if( $calls eq '111') { print "ok 19\n"; } else { print "not ok 19\n"; warn "\n$calls instead of 111\n"; } exit 0;