view release on metacpan or  search on metacpan

t/test_3_40.t  view on Meta::CPAN

  matches( $@, "you seem to have used the parse method on a filename", 'parse on a file name');
}

{ my $got;
  XML::Twig->parse( twig_handlers => { 'e[@a]' => sub { $got .= $_->id; } }, '<d><e a="a" id="i1"/><e id="i2"/><e a="0" id="i3"/></d>');
  is( $got, 'i1i3', 'bare attribute in handler condition');
}

if( $] > 5.008)
{ my $doc= q{<!DOCTYPE doc [ <!ELEMENT doc (#PCDATA)><!ENTITY ext SYSTEM "not_there.txt">]><doc>&ext;</doc>};
  ok( XML::Twig->parse( expand_external_ents => -1, $doc), 'failsafe expand_external_ents');
}
else
{ skip( 1, 'not tested under perl < 5.8'); }
  
{ my $t=XML::Twig->parse( q{<doc><e><e1>e11</e1><e2>e21</e2></e><e><e1>e12</e1></e></doc>});
  is( join( ':',  $t->findvalues( [$t->root->children], "./e1")), 'e11:e12', 'findvalues on array');
}

{ my $t=XML::Twig->parse( "<doc/>"); 
  $t->set_encoding( "UTF-8");
  is( $t->sprint, qq{<?xml version="1.0" encoding="UTF-8"?>\n<doc/>}, 'set_encoding without XML declaration');
}

{ my $t=XML::Twig->parse( "<doc/>"); 
  $t->set_standalone( 1);
  is( $t->sprint, qq{<?xml version="1.0" standalone="yes"?>\n<doc/>}, 'set_standalone (yes) without XML declaration');
}

{ my $t=XML::Twig->parse( "<doc/>"); 
  $t->set_standalone( 0);
  is( $t->sprint, qq{<?xml version="1.0" standalone="no"?>\n<doc/>}, 'set_standalone (no) without XML declaration');
}

{ my $t=XML::Twig->parse( "<doc/>"); 
  nok( $t->xml_version, 'xml_version with no XML declaration');
  $t->set_xml_version( 1.1);
  is( $t->sprint, qq{<?xml version="1.1"?>\n<doc/>}, 'set_xml_version without XML declaration');
  is( $t->xml_version, 1.1, 'xml_version after being set');
}

{ my $t= XML::Twig->new;
  is( $t->_dump, "document\n", '_dump on an empty twig');
}

{ my $t=XML::Twig->parse( pretty_print => 'none', '<doc><f a="a">foo</f><f a="b">bar</f></doc>');
  $t->root->field_to_att( 'f[@a="b"]', 'g');
  is( $t->sprint, '<doc g="bar"><f a="a">foo</f></doc>', 'field_to_att on non-simple condition');
  $t->root->att_to_field( g => 'gg');
  is( $t->sprint, '<doc><gg>bar</gg><f a="a">foo</f></doc>', 'att_to_field with att != field');
}

{ my $t=XML::Twig->parse( '<root/>');
  $t->root->wrap_in( 'nroot');
  is( $t->sprint, '<nroot><root/></nroot>', 'wrapping the root');
}

{
my $t=XML::Twig->new;
XML::Twig::_set_weakrefs(0);
my $doc='<doc>\n  <e att="a">text</e><e>text <![CDATA[cdata text]]> more text <e>foo</e>\n more</e></doc>';
$t->parse( $doc);

$doc=~ s{\n  }{}; # just the first one
is( $t->sprint, $doc, 'parse with no weakrefs');

$t->root->insert_new_elt( first_child => x => 'text');
$doc=~ s{<doc>}{<doc><x>text</x>};
is( $t->sprint, $doc, 'insert first child with no weakrefs');

$t->root->insert_new_elt( last_child => x => 'text');
$doc=~ s{</doc>}{<x>text</x></doc>};
is( $t->sprint, $doc, 'insert last child with no weakrefs');

$t->root->wrap_in( 'dd');
$doc=~ s{<doc>}{<dd><doc>}; $doc=~s{</doc>}{</doc></dd>};
is( $t->sprint, $doc, 'wrap with no weakrefs');

$t->root->unwrap;
$doc=~s{</?dd>}{}g;
is( $t->sprint, $doc, 'unwrap with no weakrefs');

my $new_e= XML::Twig::Elt->new( ee => { c => 1 }, 'ee text');
$new_e->replace( $t->root->first_child( 'e'));
$doc=~ s{<e.*?</e>}{<ee c="1">ee text</ee>};
is( $t->sprint, $doc, 'replace with no weakrefs');

XML::Twig::_set_weakrefs(1);

}

{ 
my $t= XML::Twig->new( no_expand => 1);
XML::Twig::_set_weakrefs(0);
my $doc='<!DOCTYPE d [<!ENTITY foo SYSTEM "foo.xml"><!ENTITY bar SYSTEM "bar.xml">]><d a="foo"> bar &bar; bar<e/><f>&bar;</f><f>&foo; <e/>&bar; bar &foo;</f><e/>&bar; na &foo;<e/></d>';
$t->parse( $doc);
(my $got= $t->sprint)=~ s{\n}{}g;
is( $got, $doc, 'external entities without weakrefs');

XML::Twig::_set_weakrefs(1);
}

{ 
  XML::Twig::_set_weakrefs(0);
  { my $t= XML::Twig->new; undef $t; } 
  ok( 1, "DESTROY doesn't crash when weakrefs is off");
  XML::Twig::_set_weakrefs(1);
}

{ my $doc= '<d><e a="a" get1="1" id="e1">foo</e><e a="b" id="e2"><e1 id="e11"/>bar</e><e a="b" id="e3"><e2 id="e21"/>bar</e></d>';
  my( $got1, $got2);
  XML::Twig->new( twig_handlers => { e1 => sub { $_->parent->set_att( get1 => 1); },
                                     e2 => sub { $_->parent->set_att( '#get2' => 1); },
                                     '[@get1]'  => sub { $got1 .= 'a' . $_->id; },
                                     '[@#get2]' => sub { $got2 .= 'a' . $_->id; },
                                     'e[@get1]'  => sub { $got1 .= 'b' . $_->id; },
                                     'e[@#get2]' => sub { $got2 .= 'b' . $_->id; },
                                   },
                )
            ->parse( $doc);
  is( $got1, 'be1ae1', 'handler on bare attribute');