view release on metacpan or  search on metacpan

t/test_need_io_scalar.t  view on Meta::CPAN

{ 
  my %ents= ( foo => '"toto"', pile => 'SYSTEM "file.bar" NDATA bar');
  my %ent_text = hash_ent_text( %ents);
  my $ent_text = string_ent_text( %ents); 

  my $doc= "<!DOCTYPE doc [$ent_text]><doc/>";

  my $t= XML::Twig->new->parse( $doc);
  is( normalize_xml( $t->entity_list->text), $ent_text, 'entity_list'); 
  my @entities= $t->entity_list->list;
  is( scalar @entities, scalar keys %ents, 'entity_list'); 

      foreach my $ent (@entities)
        { my $out='';
          my $fh= IO::String->new( \$out);
          my $stdout= select $fh;
          $ent->print;
          close $fh;
          select $stdout;
          is( normalize_xml( $out), $ent_text{$ent->name}, "print $ent->{name}"); 
        }
      my $out='';
      my $fh= IO::String->new( \$out);
      my $stdout= select $fh;
      $t->entity_list->print;
      close $fh;
      select $stdout;
      is( normalize_xml( $out), $ent_text, 'print entity_list'); 

}

{ my( $out1, $out2, $out3);
  my $fh1= IO::String->new( \$out1);
  my $fh2= IO::String->new( \$out2);
  my $fh3= IO::String->new( \$out3);

  my $stdout= select $fh3; 
  my $t= XML::Twig->new( twig_handlers => { e => sub { $_->print( $fh2); 
                                                       print $fh1 "X"; 
                                                       $_[0]->finish_print( $fh1);
                                                     },
                                          },
                       )
                  ->parse( '<doc>text<e>e <p>text</p></e>more text <p>foo</p></doc>');
  print 'should be in $out3';
  select $stdout;
  is( $out1, 'Xmore text <p>foo</p></doc>', 'finish_print'); 
  is( $out2, '<e>e <p>text</p></e>', 'print to fh'); 
  is( $out3, 'should be in $out3', 'restoring initial fh'); 

}


{ my $doc= '<doc><![CDATA[toto]]>tata<!-- comment -->t<?pi data?> more</doc>';
  my $out;
  my $fh= IO::String->new( \$out);
  my $t= XML::Twig->new( comments => 'process', pi => 'process')->parse( $doc);
  $t->flush( $fh);
  is( $out, $doc, 'flush with cdata');
}

{ my $out=''; 

  my $fh= IO::String->new( \$out);
  my $doc='<doc><elt>text</elt><elt1/><elt2/><elt3>text</elt3></doc>';
  my $t= XML::Twig->new( twig_roots=> { elt2 => 1 },
                          start_tag_handlers => { elt  => sub { print $fh '<e1/>'; } },  
                          end_tag_handlers   => { elt3 => sub { print $fh '<e2/>'; } },  
                          twig_print_outside_roots => $fh,
                          keep_encoding => 1
                        )
                   ->parse( $doc);
  is( $out, '<doc><e1/><elt>text</elt><elt1/><elt3>text<e2/></elt3></doc>', 
            'twig_print_outside_roots, start/end_tag_handlers, keep_encoding');
  close $fh;
  $out='';
  $fh= IO::String->new( \$out);
  $t= XML::Twig->new( twig_roots=> { elt2 => 1 },
                      start_tag_handlers => { elt  => sub { print $fh '<e1/>'; } },  
                      end_tag_handlers   => { elt3 => sub { print $fh '<e2/>'; } },  
                      twig_print_outside_roots => $fh,
                    )
               ->parse( $doc);
  is( $out, '<doc><e1/><elt>text</elt><elt1/><elt3>text<e2/></elt3></doc>', 
         'twig_print_outside_roots and start_tag_handlers');
}

{ my $t= XML::Twig->new->parse( '<doc/>');
  eval( '$t->set_output_encoding( "ISO-8859-1");');
  if( $@) 
    { skip( 1 => "your system does not seem to support conversions to ISO-8859-1: $@\n"); }
  else
    { is( $t->sprint, qq{<?xml version="1.0" encoding="ISO-8859-1"?><doc/>}, 
          'creating an output encoding'
        );
    }
}

{ my $out=''; 
  my $fh= IO::String->new( \$out);
  select $fh;
  my $doc='<?xml version="1.0"?><!DOCTYPE doc [ <!ELEMENT doc (#PCDATA)> <!ENTITY foo "bar">]><doc/>';
  my( $expected)= $doc=~ m{(<!DOCTYPE.*?\]>)};
  XML::Twig->new->parse( $doc)->dtd_print;
  select STDOUT;
  is_like( $out, $expected, "dtd_print to STDOUT");
}

{ my $out=''; 
  my $fh= IO::String->new( \$out);
  select $fh;
  my $doc='<doc><elt1/><elt2/></doc>';
  XML::Twig->new( twig_handlers => { elt1 => sub { $_[0]->finish_print; } })->parse( $doc);
  select STDOUT;
  is( $out, '<elt2/></doc>', "finish_print to STDOUT");
}

{ my $out=''; 
  my $fh= IO::String->new( \$out);