XML-TreePP-0.39/ 0000755 0001751 0001751 00000000000 11222330343 012441 5 ustar u-suke u-suke XML-TreePP-0.39/t/ 0000755 0001751 0001751 00000000000 11222330343 012704 5 ustar u-suke u-suke XML-TreePP-0.39/t/31_tie_ixhash.t 0000755 0001751 0001751 00000005726 10652552410 015545 0 ustar u-suke u-suke # ----------------------------------------------------------------
use strict;
use Test::More;
# ----------------------------------------------------------------
SKIP: {
local $@;
eval { require Tie::IxHash; } unless defined $Tie::IxHash::VERSION;
if ( ! defined $Tie::IxHash::VERSION ) {
plan skip_all => 'Tie::IxHash is not loaded.';
}
plan tests => 19;
use_ok('XML::TreePP');
&test_parse();
&test_write();
&test_parse_with_attr();
&test_write_with_attr();
}
# ----------------------------------------------------------------
sub test_parse {
my $xml = <<"EOT";
1
2
3
4
5
6
7
8
9
EOT
my $tpp = XML::TreePP->new();
$tpp->set( use_ixhash => 1 );
my $tree = $tpp->parse( $xml );
my $prev;
foreach my $key ( keys %{$tree->{root}} ) {
my $val = $tree->{root}->{$key};
is( $prev+1, $val, "<$key>$val$key>" ) if $prev;
$prev = $val;
}
}
# ----------------------------------------------------------------
sub test_write {
my $root = {};
tie( %$root, 'Tie::IxHash' );
$root->{one} = 1;
$root->{two} = 2;
$root->{three} = 3;
$root->{four} = 4;
$root->{five} = 5;
$root->{six} = 6;
$root->{seven} = 7;
$root->{eight} = 8;
$root->{nine} = 9;
my $tree = {
root => $root
};
my $tpp = XML::TreePP->new();
$tpp->set( use_ixhash => 1 );
my $xml = $tpp->write( $tree );
like( $xml, qr{1.*2.*3.*4.*5.*6.*7.*8.*9}s, "1-2-3-4-5-6-7-8-9" );
}
# ----------------------------------------------------------------
sub test_parse_with_attr {
my $xml = <<"EOT";
6
7
8
9
EOT
my $tpp = XML::TreePP->new();
$tpp->set( use_ixhash => 1 );
my $tree = $tpp->parse( $xml );
my $prev;
foreach my $key ( keys %{$tree->{root}} ) {
my $val = $tree->{root}->{$key};
my $view = ( $key =~ /^-/ ) ? "$key=" : "<$key>";
is( $prev+1, $val, $view.$val ) if $prev;
$prev = $val;
}
}
# ----------------------------------------------------------------
sub test_write_with_attr {
my $root = {};
tie( %$root, 'Tie::IxHash' );
$root->{one} = 1;
$root->{two} = 2;
$root->{-three} = 3;
$root->{-four} = 4;
$root->{-five} = 5;
$root->{-six} = 6;
$root->{-seven} = 7;
$root->{eight} = 8;
$root->{nine} = 9;
my $tree = {
root => $root
};
my $tpp = XML::TreePP->new();
$tpp->set( use_ixhash => 1 );
my $xml = $tpp->write( $tree );
like( $xml, qr{3.*4.*5.*6.*7.*1.*2.*8.*9}s, "3-4-5-6-7-1-2-8-9" );
}
# ----------------------------------------------------------------
;1;
# ----------------------------------------------------------------
XML-TreePP-0.39/t/16_encoding_ko.t 0000755 0001751 0001751 00000002164 10432046334 015672 0 ustar u-suke u-suke # ----------------------------------------------------------------
use strict;
use Test::More tests => 5;
# ----------------------------------------------------------------
my $FILES = [qw(
t/example/hello-ko-euc.xml
t/example/hello-ko-utf8.xml
)];
# ----------------------------------------------------------------
SKIP: {
skip( "Perl $]", 5 ) if ( $] < 5.008 );
use_ok('XML::TreePP');
&test_main();
}
# ----------------------------------------------------------------
sub test_main {
my $tpp = XML::TreePP->new();
my $prev;
foreach my $file ( @$FILES ) {
my $tree = $tpp->parsefile( $file );
if ( defined $prev ) {
is( $tree->{root}->{text}, $prev, $file );
} else {
like( $tree->{root}->{text}, qr/\S\!/, $file );
$prev = $tree->{root}->{text};
}
my $xml = $tpp->write( $tree );
like( $xml, qr/^\s*<\?xml[^<>]+encoding="UTF-8"/is, "write encoding" );
}
}
# ----------------------------------------------------------------
;1;
# ----------------------------------------------------------------
XML-TreePP-0.39/t/42_cdata_comment.t 0000755 0001751 0001751 00000004745 10676265315 016233 0 ustar u-suke u-suke # ----------------------------------------------------------------
use strict;
use Test::More tests => 129;
BEGIN { use_ok('XML::TreePP') };
# ----------------------------------------------------------------
{
my $test = {
'' => 'AAA',
'AAACCC' => 'AAABBBCCC',
'BBB' => 'AAABBBCCC',
'AAACCCEEE' => 'AAABBBCCCDDDEEE',
'' => '',
'AAACCC' => 'AAACCC',
'BBB' => 'BBB',
'AAACCCEEE' => 'AAACCCEEE',
'BBB' => 'BBBCCC',
'BBB' => 'AAABBB',
'BBBDDD' => 'BBBCCCDDD',
'BBBDDD' => 'AAABBBDDDEEE',
']]>' => '',
'' => '',
']]>' => '',
']]>' => '',
};
&cdata_cdsect( $test );
&cdata_cdsect( $test, { cdata_scalar_ref=>1 } );
}
# ----------------------------------------------------------------
sub cdata_cdsect {
my $list = shift;
my $opt = shift;
my $tpp = XML::TreePP->new( %$opt );
foreach my $src ( keys %$list ) {
my $val = $list->{$src};
my $tree = $tpp->parse( $src );
ok( exists $tree->{xml}, 'exists' );
my $cdata = $tree->{xml};
$cdata = $$cdata if ( ref $cdata eq 'SCALAR' );
ok( ! ref $cdata, 'invalid ref' );
is( $cdata, $val, $val );
my $xml = $tpp->write( $tree );
my $again = $tpp->parse( $xml );
my $cdat2 = $again->{xml};
$cdat2 = $$cdat2 if ( ref $cdat2 eq 'SCALAR' );
is( $cdat2, $cdata, 'round trip' );
}
}
# ----------------------------------------------------------------
;1;
# ----------------------------------------------------------------
XML-TreePP-0.39/t/02_write.t 0000755 0001751 0001751 00000002306 10467562467 014560 0 ustar u-suke u-suke # ----------------------------------------------------------------
use strict;
use Test::More tests => 6;
BEGIN { use_ok('XML::TreePP') };
# ----------------------------------------------------------------
my $tpp = XML::TreePP->new();
my $tree = { rss => { channel => { item => [ {
title => "The Perl Directory",
link => "http://www.perl.org/",
}, {
title => "The Comprehensive Perl Archive Network",
link => "http://cpan.perl.org/",
} ] } } };
my $xml = $tpp->write( $tree );
like( $xml, qr{^<\?xml version="1.0" encoding="UTF-8"}, "xmldecl" );
like( $xml, qr{.*}s, "rss" );
my $back = $tpp->parse( $xml );
is_deeply( $tree, $back, "write and parse" );
# 2006/08/13 added
$tpp->set( xml_decl => '' );
my $nodecl = $tpp->write( $back );
unlike( $nodecl, qr{^<\?xml}, "xml_decl is null" );
my $decl = '';
$tpp->set( xml_decl => $decl );
my $setdecl = $tpp->write( $back );
like( $setdecl, qr{^\Q$decl\E}, "xml_decl is set" );
# ----------------------------------------------------------------
;1;
# ----------------------------------------------------------------
XML-TreePP-0.39/t/32_base_class.t 0000755 0001751 0001751 00000004130 10655660723 015516 0 ustar u-suke u-suke # ----------------------------------------------------------------
use strict;
use Test::More;
# ----------------------------------------------------------------
{
plan tests => 14;
use_ok('XML::TreePP');
&test_base_class( force_array => [qw( six )], base_class => 'Element' );
}
# ----------------------------------------------------------------
sub test_base_class {
my $tpp = XML::TreePP->new(@_);
my $xml = <<"EOT";
1
2
4
5
5
7
8
9
EOT
my $tree = $tpp->parse( $xml );
is( ref $tree, 'Element', '/root' );
is( ref $tree->{root}, 'Element::root', '/root' );
is( ref $tree->{root}->{two}, 'Element::root::two', '/root/two' );
is( ref $tree->{root}->{three}, 'Element::root::three', '/root/three' );
is( ref $tree->{root}->{three}->{five}, 'Element::root::three::five', '/root/three/five' );
is( ref $tree->{root}->{six}, 'ARRAY', '/root/six (ARRAY)' );
is( ref $tree->{root}->{six}->[0], 'Element::root::six', '/root/six' );
is( ref $tree->{root}->{six}->[0]->{seven}, 'Element::root::six::seven', '/root/six/seven' );
is( ref $tree->{root}->{eight}, 'ARRAY', '/root/eight (ARRAY)' );
is( ref $tree->{root}->{eight}->[1], 'Element::root::eight', '/root/eight' );
# 2007/08/07 added
is( ref $tree->{root}->{foo}, 'Element::root::foo', '/root/foo' );
is( ref $tree->{root}->{foo}->{bar}, 'ARRAY', '/root/foo/bar (ARRAY)' );
is( ref $tree->{root}->{foo}->{bar}->[0], 'Element::root::foo::bar', '/root/foo/bar' );
}
# ----------------------------------------------------------------
;1;
# ----------------------------------------------------------------
XML-TreePP-0.39/t/49_invalid_encoding.t 0000755 0001751 0001751 00000003144 11152511332 016707 0 ustar u-suke u-suke # ----------------------------------------------------------------
use strict;
use Test::More;
# ----------------------------------------------------------------
{
local $@;
eval { require 5.008001; };
plan skip_all => 'Perl 5.8.1 is required.' if $@;
}
# ----------------------------------------------------------------
my $ENC = 'UNKNOWN_ENCODING';
# ----------------------------------------------------------------
{
plan tests => 4;
use_ok('XML::TreePP');
&test1();
&test2();
&test3();
}
# ----------------------------------------------------------------
sub test1 {
my $xml = <<"EOT";
value
EOT
my $tpp = XML::TreePP->new();
local $@;
eval {
my $tree = $tpp->parse( $xml );
};
like( $@, qr#^Unknown encoding#, 'parse: '.$@ );
}
# ----------------------------------------------------------------
sub test2 {
my $tree = { root => { elem => 'value' }};
my $tpp = XML::TreePP->new();
local $@;
eval {
my $xml = $tpp->write( $tree, $ENC );
};
like( $@, qr#^Unknown encoding#, 'write: '.$@ );
}
# ----------------------------------------------------------------
sub test3 {
my $tree = { root => { elem => 'value' }};
my $tpp = XML::TreePP->new( output_encoding => $ENC );
local $@;
eval {
my $xml = $tpp->write( $tree );
};
like( $@, qr#^Unknown encoding#, 'output_encoding: '.$@ );
}
# ----------------------------------------------------------------
;1;
# ----------------------------------------------------------------
XML-TreePP-0.39/t/24_ignore_error.t 0000755 0001751 0001751 00000001452 10467627612 016121 0 ustar u-suke u-suke use strict;
use Test::More tests => 7;
BEGIN { use_ok('XML::TreePP') };
&no_carp( \&invalid_tag, qr{Invalid tag sequence}i );
&no_carp( \&no_such_file, qr{file-not-found}i );
&no_carp( \&invalid_tree, qr{Invalid tree}i );
sub no_carp {
my $sub = shift;
my $err = shift;
local $@;
&$sub( ignore_error => 1 );
ok( ! $@, 'ignore error' );
eval {
&$sub();
};
like( $@, $err, 'raise error' );
}
sub invalid_tag {
my $tpp = XML::TreePP->new( @_ );
my $xml = '';
return $tpp->parse( $xml );
}
sub no_such_file {
my $tpp = XML::TreePP->new( @_ );
return $tpp->parsefile( 'file-not-found-'.$$ );
}
sub invalid_tree {
my $tpp = XML::TreePP->new( @_ );
return $tpp->write( undef );
}
;1;
XML-TreePP-0.39/t/27_http-lite-force.t 0000755 0001751 0001751 00000004113 10655240317 016423 0 ustar u-suke u-suke # ----------------------------------------------------------------
use strict;
use Test::More;
# ----------------------------------------------------------------
SKIP: {
local $@;
eval { require HTTP::Lite; } unless defined $HTTP::Lite::VERSION;
if ( ! defined $HTTP::Lite::VERSION ) {
plan skip_all => 'HTTP::Lite is not loaded.';
}
eval { require LWP::UserAgent; } unless defined $LWP::UserAgent::VERSION;
if ( ! defined $LWP::UserAgent::VERSION ) {
# ok
}
if ( ! defined $ENV{MORE_TESTS} ) {
plan skip_all => 'define $MORE_TESTS to test this.';
}
plan tests => 14;
use_ok('XML::TreePP');
my $name = 'HTTP::Lite';
my $url = "http://www.kawa.net/works/perl/treepp/example/envxml.cgi";
my $query = time();
{
my $tpp = XML::TreePP->new();
my $http = HTTP::Lite->new();
ok( ref $http, 'HTTP::Lite->new()' );
$tpp->set( http_lite => $http );
$tpp->set( user_agent => '' );
&test_http_req( $tpp, $name, POST => $url, $query ); # use HTTP::Lite
}
{
my $tpp = XML::TreePP->new();
my $http = HTTP::Lite->new();
ok( ref $http, 'HTTP::Lite->new()' );
$tpp->set( http_lite => $http );
$tpp->set( user_agent => '' );
my $ret = &test_http_req( $tpp, $name, GET => "$url?$query" );
is( $ret, $query, "QUERY_STRING: $query" );
}
}
# ----------------------------------------------------------------
sub test_http_req {
my $tpp = shift;
my $name = shift;
my( $tree, $xml, $code ) = $tpp->parsehttp( @_ );
ok( ref $tree, "parsehttp: $_[1]" );
my $decl = ( $xml =~ /(<\?xml[^>]+>)/ )[0];
like( $xml, qr/(<\?xml[^>]+>)/, "XML Decl: $decl" );
is( $code, 200, "HTTP Status: $code" );
my $agent = $tree->{env}->{HTTP_USER_AGENT};
ok( $agent, "User-Agent: $agent" );
like( $agent, qr/\Q$name\E/, "Match: $name" );
$tree->{env}->{QUERY_STRING};
}
# ----------------------------------------------------------------
;1;
# ----------------------------------------------------------------
XML-TreePP-0.39/t/43_encoding_quote.t 0000755 0001751 0001751 00000002470 10715550725 016426 0 ustar u-suke u-suke # ----------------------------------------------------------------
use strict;
use Test::More tests => 5;
# ----------------------------------------------------------------
SKIP: {
skip( "Perl $]", 5 ) if ( $] < 5.008 );
use_ok('XML::TreePP');
use_ok('Encode');
&test_main();
}
# ----------------------------------------------------------------
sub test_main {
my $tpp = XML::TreePP->new();
my $xml1 = "FOO";
my $tree1 = $tpp->parse( $xml1 );
is( $tree1->{root}, 'FOO', 'windows-1250' );
# 0xxxxxxx (00-7f)
# 110xxxxx 10xxxxxx (c0-df)(80-bf)
# 1110xxxx 10xxxxxx 10xxxxxx (e0-ef)(80-bf)(80-bf)
my $soa = "\xEA\x92\xB1"; # is a valid Shift_JIS string
my $xml3 = "$soa";
my $tree3 = $tpp->parse( $xml3 );
Encode::from_to( $soa, 'Shift_JIS', 'utf8' );
is( $tree3->{root}, $soa, 'Shift_JIS' );
my $xml2 = "BAR";
local $@;
eval { $tpp->parse( $xml2 ); };
like( $@, qr/INVALID_ENCODING/, 'INVALID_ENCODING' );
}
# ----------------------------------------------------------------
;1;
# ----------------------------------------------------------------
XML-TreePP-0.39/t/37_undef.t 0000755 0001751 0001751 00000002277 10661673143 014534 0 ustar u-suke u-suke # ----------------------------------------------------------------
use strict;
use Test::More;
# ----------------------------------------------------------------
{
plan tests => 6;
use_ok('XML::TreePP');
&test_undef( first_out => [qw( attr hash list empty undef -one -two three four )] );
}
# ----------------------------------------------------------------
sub test_undef {
my $tpp = XML::TreePP->new(@_);
my $empty = '';
my $undef = undef;
my $tree = {
root => {
attr => { -one=>'', -two=>undef },
hash => { three => '', four => undef },
list => [ '', undef ],
empty => \$empty,
undef => \$undef,
}
};
my $xml = $tpp->write( $tree );
like( $xml, qr{\s*\s*