view release on metacpan or  search on metacpan

t/test_bugs_3_22.t  view on Meta::CPAN

  is( scalar(  @siblings), 0, "following_elts on last sibling");

  
  is(  XML::Twig->nparse( "<doc/>")->root->del_id->sprint, "<doc/>", "del_id on elt with no atts");

  # next_elt with deep tree (
  my $t= XML::Twig->nparse( q{
  <doc n="12">
    <elt n="0"/>
    <elt1 n="10">
      <selt n="4">
        <sselt1 n="1"><ssselt n="0"/></sselt1>
        <sselt2 n="1"><ssselt n="0"/></sselt2>
      </selt>
      <selt1 n="4">
        <sselt3 n="1"><ssselt n="0"/></sselt3>
        <sselt4 n="1"><ssselt n="0"/></sselt4>
      </selt1>
    </elt1>
  </doc>
  });

  foreach my $e ($t->root->descendants_or_self)
    { is( scalar( $e->_descendants), $e->att( 'n'), "_descendant " . $e->tag . "\n");
      is( scalar( $e->_descendants( 1)), $e->att( 'n') + 1, "_descendant(1) " . $e->tag . "\n");
    }
}
  
{ 
  my $exp= '/foo/1^%';
  eval { XML::Twig->nparse( "<doc/>")->get_xpath( $exp); };
  matches( $@, "^error in xpath expression", "xpath with valid expression then stuff left");
}

{ 
  my $t = XML::Twig->nparse( "<doc/>");
  my $root = $t->root;
  my $elt  =XML::Twig::Elt->new( 'foo');
  foreach my $pos ( qw( before after))
    { eval {  $elt->paste( $pos => $root); }; 
      matches( $@, "^cannot paste $pos root", "paste $pos root");
      eval " \$elt->paste_$pos( \$root)";
      matches( $@, "^cannot paste $pos root", "paste $pos root");
    }
}

{ is( XML::Twig->nparse( comments => "process", pi => "process", "<doc><!-- c --><?t data?><?t?></doc>")->_dump,
     "document\n|-doc\n| |-COMMENT: '<!-- c -->'\n| |-PI:      't' - 'data'\n| |-PI:      't' - ''\n",
     "_dump PI/comment"
    );
}

{ is(  XML::Twig->nparse( '<doc/>')->root->get_xpath( '.', 0)->gi, 'doc', 'get_xpath: .'); }

{ my $t= XML::Twig->nparse( '<doc><![CDATA[foo]]></doc>');
  $t->first_elt( '#CDATA')->set_text( 'bar');
  is( $t->sprint, '<doc><![CDATA[bar]]></doc>', " set_text on CDATA");
  $t->root->set_text( 'bar');
  is( $t->sprint, '<doc>bar</doc>', " set_text on elt containing CDATA");
  $t= XML::Twig->nparse( '<doc><![CDATA[foo]]></doc>');
  $t->first_elt( '#CDATA')->set_text( 'bar', force_pcdata => 1);
  is( $t->sprint, '<doc>bar</doc>', " set_text on CDATA with force_pcdata");}

  # print/flush entity
  # SAX export entity

{ my $enc= "a_non_existent_encoding_bwaaahhh";
  eval { XML::Twig->iconv_convert( $enc); };
  matches( $@, "^(Unsupported|Text::Iconv not available|Can't locate)", "unsupported encoding");
}

{ # test comments handlers
  my $doc= qq{<doc><!-- comment --><elt/></doc>};
  is( XML::Twig->nparse( twig_handlers => { '#COMMENT' => sub { return uc( $_[1]); } }, $doc)->sprint,
      qq{<doc><!-- COMMENT --><elt/></doc>},
      "comment handler"
    );
  is( XML::Twig->nparse( twig_handlers => { '#COMMENT' => sub { return uc( $_[1]); } }, keep_encoding => 1, $doc)->sprint,
      qq{<doc><!-- COMMENT --><elt/></doc>},
      "comment handler (with keep_encoding)"
    );
  is( XML::Twig->nparse( twig_handlers => { '#COMMENT' => sub { return; } }, keep_encoding => 0, $doc)->sprint,
      qq{<doc><elt/></doc>},
      "comment handler returning undef comment"
    );
  is( XML::Twig->nparse( twig_handlers => { '#COMMENT' => sub { return ''; } }, keep_encoding => 1, $doc)->sprint,
      qq{<doc><elt/></doc>},
      "comment handler  returning empty comment (with keep_encoding)"
    );
  is( XML::Twig->nparse( comments => 'process', twig_handlers => { '#COMMENT' => sub { $_->set_comment( uc( $_->comment)); } }, 
                         keep_encoding => 0, $doc)->sprint,
      qq{<doc><!-- COMMENT --><elt/></doc>},
      "comment handler, process mode"
    );
  is( XML::Twig->nparse( comments => 'process', twig_handlers => { '#COMMENT' => sub { $_->set_comment( uc( $_->comment)); } }, 
                         keep_encoding => 1, $doc)->sprint, 
      qq{<doc><!-- COMMENT --><elt/></doc>},
      "comment handler (with keep_encoding), process mode"
    );
  is( XML::Twig->nparse( comments => 'process', twig_handlers => { elt => sub { $_->cut; } }, keep_encoding => 0, $doc)->sprint,
      qq{<doc><!-- comment --></doc>},
      "comment handler deletes comment, process mode"
    );
  is( XML::Twig->nparse( comments => 'process', twig_handlers => { '#COMMENT' => sub { $_->cut; } }, keep_encoding => 0, $doc)->sprint,
      qq{<doc><elt/></doc>},
      "comment handler deletes comment, process mode"
    );
  is( XML::Twig->nparse( comments => 'process', twig_handlers => { '#COMMENT' => sub { $_->set_comment( ''); } }, keep_encoding => 1, $doc)->sprint,
      qq{<doc><!----><elt/></doc>},
      "comment handler returning empty comment (with keep_encoding), process mode"
    );
}

{ # check pi element handler in keep_encoding mode
  is( XML::Twig->nparse( pi => 'process', twig_handlers => { '?t' => sub { $_->set_data( uc( $_->data)); } }, '<doc><?t data?></doc>')->sprint,
       '<doc><?t DATA?></doc>', 'pi element handler');
  is( XML::Twig->nparse( pi => 'process', keep_encoding => 1,twig_handlers => { '?t' => sub { $_->set_data( uc( $_->data)); } }, 
                         '<doc><?t data?></doc>')->sprint,
       '<doc><?t DATA?></doc>', 'pi element handler in keep_encoding mode');
}

{ # test changes on comments before the root element