view release on metacpan or  search on metacpan

t/test5.t  view on Meta::CPAN

  { print "ok 11\n"; } else { print "not ok 11\n"; warn "$path instead of $exp_path\n"; }

$path=  $elt3->path;
$exp_path=  '/doc/elt1/elt2';
if( $path eq $exp_path)
  { print "ok 12\n"; } else { print "not ok 12\n"; warn "$path instead of $exp_path\n"; }

$path=  $root->path;
$exp_path=  '/doc';
if( $path eq $exp_path)
  { print "ok 13\n"; } else { print "not ok 13\n"; warn "$path instead of $exp_path\n"; }

my $id1=''; my $exp_id1= 'p2_1';
my $id2=''; my $exp_id2= 'p2_3p2_4';
my $id3=''; my $exp_id3= 'p2_2p2_7';
my $id4=''; my $exp_id4= 'p2_5p2_6';
my $path_error='';
my $t2= new XML::Twig( TwigHandlers => 
                         { '/doc/p1/p2' => sub { $id1.= $_[1]->id; return; },
                           '/doc/p2'    => sub { $id2.= $_[1]->id; return; },
                           'p3/p2'      => sub { $id3.= $_[1]->id; return; },
                           'p2'         => sub { $id4.= $_[1]->id; return; },
   _all_  => sub { my( $t, $elt)= @_;
                   my $gi= $elt->gi;
                   my $tpath= $t->path( $gi); my $epath= $elt->path;
                   unless( $tpath eq $epath)
                     { $path_error.= " $tpath <> $epath\n"; }
                 }  
                         }
                     );
$t2->parse( $doc);
if( $id1 eq $exp_id1) 
  { print "ok 14\n"; } else { print "not ok 14\n"; warn "$id1 instead of $exp_id1\n"; }
if( $id2 eq $exp_id2) 
  { print "ok 15\n"; } else { print "not ok 15\n"; warn "$id2 instead of $exp_id2\n"; }
if( $id3 eq $exp_id3) 
  { print "ok 16\n"; } else { print "not ok 16\n"; warn "$id3 instead of $exp_id3\n"; } 
if( $id4 eq $exp_id4) 
  { print "ok 17\n"; } else { print "not ok 17\n"; warn "$id4 instead of $exp_id4\n"; } 
unless( $path_error)
  { print "ok 18\n"; } else { print "not ok 18\n"; warn "$path_error\n"; } 

$id1=''; $exp_id1= 'p2_1';
my $t3= new XML::Twig( TwigRoots => { '/doc/p1/p2' => sub { $id1.= $_[1]->id; } } );
$t3->parse( $doc);
if( $id1 eq $exp_id1) 
  { print "ok 19\n"; } else { print "not ok 19\n"; warn "$id1 instead of $exp_id1\n"; }

$id2=''; $exp_id2= 'p2_3p2_4';
$t3= new XML::Twig( TwigRoots => { '/doc/p2'    => sub { $id2.= $_[1]->id;} } );
$t3->parse( $doc);
if( $id2 eq $exp_id2) 
  { print "ok 20\n"; } else { print "not ok 20\n"; warn "$id2 instead of $exp_id2\n"; }

$id3=''; $exp_id3= 'p2_2p2_7';
$t3= new XML::Twig( TwigRoots => { 'p3/p2'    => sub { $id3.= $_[1]->id;} } );
$t3->parse( $doc);
if( $id3 eq $exp_id3) 
  { print "ok 21\n"; } else { print "not ok 21\n"; warn "$id3 instead of $exp_id3\n"; }

# test what happens to 0 in pcdata/cdata
my $pcdata= '<test><text>0</text></test>';
my $cdata= '<test><text><![CDATA[0]]></text></test>';
my $t4= new XML::Twig;

$t4->parse( $pcdata);
if( my $res= $t4->sprint eq $pcdata) { print "ok 22\n"; } 
else { print "not ok 22\n"; warn "sprint returns $res instead of $pcdata\n"; }

$t4->parse( $pcdata);
if( my $res= $t4->root->text eq '0') { print "ok 23\n"; } 
else { print "not ok 23\n"; warn "sprint returns $res instead of '0'\n"; }

$t4->parse( $cdata);
if( my $res= $t4->sprint eq $cdata) { print "ok 24\n"; } 
else { print "not ok 23\n"; warn "sprint returns $res instead of $cdata\n"; }

$t4->parse( $cdata);
if( my $res= $t4->root->text eq '0') { print "ok 25\n"; } 
else { print "not ok 25\n"; warn "sprint returns $res instead of '0'\n"; }

my $test_inherit=
'<doc att1="doc1" att2="doc2" att3="doc3"><elt att1="elt1" att_null="0">
  <subelt att1="subelt1" att2="subelt2"></subelt>
</elt></doc>';

my $t5= new XML::Twig;
$t5->parse( $test_inherit);
my $subelt= $t5->root->first_child->first_child;

if( my $att= $subelt->att( 'att1') eq "subelt1") { print "ok 26\n"; }
else { print "not ok 26\n"; warn "sprint returns $att instead of 'subelt1'\n"; }

if( my $att= $subelt->inherit_att( 'att1') eq "subelt1") { print "ok 27\n"; }
else { print "not ok 27\n"; warn "sprint returns $att instead of 'subelt1'\n"; }

if( my $att= $subelt->inherit_att( 'att1', 'elt') eq "elt1") { print "ok 28\n"; }
else { print "not ok 28 sprint returns $att instead of 'elt1'\n"; }

if( my $att= $subelt->inherit_att( 'att1', 'elt', 'doc') eq "elt1") { print "ok 29\n"; }
else { print "not ok 29\n"; warn "sprint returns $att instead of 'elt1'\n"; }

if( my $att= $subelt->inherit_att( 'att1', "doc") eq "doc1") { print "ok 30\n"; }
else { print "not ok 30\n"; warn "sprint returns $att instead of 'doc1'\n"; }

if( my $att= $subelt->inherit_att( 'att3') eq "doc3") { print "ok 31\n"; }
else { print "not ok 31\n"; warn "sprint returns $att instead of 'doc3'\n"; }

if( my $att= $subelt->inherit_att( 'att3') eq "doc3") { print "ok 32\n"; }
else { print "not ok 32\n"; warn "sprint returns $att instead of 'doc3'\n"; }

if( my $att= $subelt->inherit_att( 'att_null') == 0) { print "ok 33\n"; }
else { print "not ok 33\n"; warn "sprint returns $att instead of '0'\n"; }

# test attribute paths
my $test_att_path=
'<doc>
  <elt id="elt1" att="val1">
    <subelt id="subelt1" att="val1"/>
    <subelt id="subelt2" att="val1"/>
    <subelt id="subelt3" att="val2"/>
  </elt>
  <elt id="elt2" att="val1">
    <subelt id="subelt4" att="val1"/>
    <subelt id="subelt5" att="val1"/>
    <subelt id="subelt6" att="val2"/>
  </elt>
 </doc>';

my $res1='';
my $t6= new XML::Twig
          ( TwigHandlers =>    #'' (or VIM messes up colors)
            { 'elt[@id="elt1"]' => sub { $res1.= $_[1]->id} } 
          );
$t6->parse( $test_att_path);

if( $res1 eq 'elt1') { print "ok 34\n"; }
else { print "not ok 34\n"; warn "returns $res1 instead of elt1\n"; }