XML-TreePP-0.43/ 000755 000765 000024 00000000000 12432275633 013620 5 ustar 00u-suke staff 000000 000000 XML-TreePP-0.43/Changes 000755 000765 000024 00000017122 12432275567 015127 0 ustar 00u-suke staff 000000 000000 # XML::TreePP Changes
2014/11/17 (0.43)
* Sync OpenBSD patches from their Ports tree. thanks to kucharskim
https://github.com/kawanet/XML-TreePP/pull/3
* README.md added
2013/11/07 (0.42)
* add empty_element_tag_end option. thanks to Songmu
https://github.com/kawanet/XML-TreePP/pull/2
* ensure unicode transmitted proprely. thanks to xenoterracide
https://github.com/kawanet/XML-TreePP/pull/1
* it requires LWP 5.811 or later to use add_content_utf8 method in HTTP::Message
* source repository is now on github
https://github.com/kawanet/XML-TreePP
2010/10/31 (0.41)
* require_xml_decl option added. thanks to nicomen
https://rt.cpan.org/Ticket/Display.html?id=42441
* empty element when #text node is undef
http://www.kawa.net/works/perl/treepp/treepp.html#com-2009-07-23T16:38:09Z
2009/11/21 (0.40)
* pod typo fix: (thanks to jkutej)
http://annocpan.org/~KAWASAKI/XML-TreePP-0.39/lib/XML/TreePP.pm#note_2382
2009/06/30 (0.39)
* parsehttp now uses decoded_content method under LWP 5.802.
This allows compressed content by Content-Encoding: gzip, etc.
(thanks to cormanaz and ikegami)
http://perlmonks.org/?node_id=774537
http://rt.cpan.org/Public/Bug/Display.html?id=47336
2009/03/01 (0.38)
* dies by "Invalid tree" when write() is called without a hash argument.
* warns by "Unsupported reference type" when write() is called with
a tree which contains unsupported references, ex. BLOBREF.
It avoids "Not a HASH reference" and "Can't use string as a HASH ref."
* dies by "Unknown encoding" when unknown encoding is used.
* No new features are added at this version except for the messages above.
2009/01/17 (0.37)
* new option: xml_deref dereferences the numeric character references,
like ë, 漢 etc.
Now UTF-8 flag is correctly treated. (thanks to haarg)
http://rt.cpan.org/Public/Bug/Display.html?id=42347
* without xml_deref option, the numeric character references between
U+0080 and U+00FF are not dereferenced any more.
the numeric character references up to U+007F and the predefined
character entity references are still dereferenced per default.
* supports Perl 5.8.4 which includes Encode 1.99_01. (thanks to SAPER)
http://rt.cpan.org/Public/Bug/Display.html?id=41986
2008/10/26 (0.36)
* supports spaces around the "=" sign in attribute (thanks to John)
ex.
http://tech.groups.yahoo.com/group/xml-treepp/message/27
* Perl 5.10.0 has a memory leak problem on qr//
(thanks to Marcin Guzowski)
http://rt.perl.org/rt3/Public/Bug/Display.html?id=59516
* Makefile.PL now calls Jcode and HTTP::Lite when needed
2008/01/05 (0.33)
* Subversion on Google Code
http://xml-treepp.googlecode.com/svn/trunk/XML-TreePP/
* supports UTF-8 with BOM when parsing XML
http://www.kawa.net/works/perl/feedpp/feedpp.html#com-2008-01-03T15:02:56Z
2007/11/11 (0.32)
* supports invalid xml decl quoted with single quote (thanks to xatrix)
ex.
http://rt.cpan.org/Public/Bug/Display.html?id=30187
2007/09/22 (0.31)
* "]]>" in CDATA must be separated into "]]>"
http://www.w3.org/TR/REC-xml/#sec-cdata-sect
* utf8_flag option requires Perl 5.8.1
* avoid "Wide character in print at" in writefile()
2007/08/27 (0.29)
* 34_utf8_flag.t skips all tests on Perl 5.8.0
utf8::is_utf8() wasn't there in 5.8.0.
http://www.nntp.perl.org/group/perl.perl5.changes/2003/08/msg8628.html
* 34_utf8_flag.t passes all tests on Perl 5.8.1-2
http://rt.perl.org/rt3/Public/Bug/Display.html?id=24846
* avoid "Use of uninitialized value in substitution" in xml_escape
2007/08/13 (0.27)
* bug fix: autoload Encode.pm on particular environment, $] == 5.008
http://www.nntp.perl.org/group/perl.cpan.testers/2007/08/msg557739.html
http://www.nntp.perl.org/group/perl.cpan.testers/2007/08/msg557741.html
* pod revised. OPTIONS FOR PARSING/WRITING sections are separated.
2007/08/07 (0.26)
* new option: force_array => '*' means every elements (thanks to Niek)
* new option: force_hash => [], and also '*' means every elements
* new option: elem_class => 'class'
* new tests: t/35_force_hash.t t/36_elem_class.t
2007/07/28 (0.22)
* new option: ident => 2 (thanks to Aaron)
* new option: utf8_flag => 1
* new option: base_class => 'class'
* new tests: t/32_base_class.t t/33_indent.t t/34_utf8_flag.t
* LICENSE field added in META.yml
2007/07/25 (0.21)
* bug fix: use_ixhash missing order on elements with attribute(s)
2007/07/22 (0.20)
* new option: http_lite => HTTP::Lite->new()
* new option: lwp_useragent => LWP::UserAgent->new() (thanks to NEELY)
http://rt.cpan.org/Ticket/Display.html?id=28167
* new option: use_ixhash => 1 (thanks to RENEEB)
http://rt.cpan.org/Ticket/Display.html?id=23522
* first_out and last_out options keep its order (thanks to BASHI and sajohn52)
http://tech.groups.yahoo.com/group/xml-treepp/message/13
* new tests: 27_http-lite-force.t 28_http-lwp-force.t
29_http-lwp-withcache.t 30_first_out.t 31_tie_ixhash.t
2006/11/03 (0.19)
* new option: text_node_key (thanks to Niek)
* attr_prefix now supports zero-length prefix.
2006/08/13 (0.18)
* parsehttp()'s 4th argument: an HTTP request header as a hash ref.
* new option: ignore_error (thanks to Riyousha)
* new option: xml_decl (thanks to Stephen and Jon)
* new tests: 20_http-lite-cached.t 21_http-lwp-cached.t
22_http-lite-headers.t 23_http-lwp-headers.t 24_ignore_error.t
2006/05/25 (0.17)
* bug fix: multiple CDATA or text nodes in a element (thanks to junichi)
* new test: 19_multi_text.t
2006/05/21 (0.16)
* bug fix: character references support (since 0.14)
* Encode::FB_XMLCREF support (again)
* new test: 18_escape_amp.t
2006/05/15 (0.14)
* new encodings: eucJP-win and eucJP-ms (for Perl 5.005/5.6.1)
* new entity references: '
* character references supported: & &
* spaces in text node are not deleted on parse() method.
* returns are not added in text node on write() method.
* HTTP tests are skipped per default: 09_http-lite.t 10_http-lwp.t
* new tests: 00_pod.t 13_encoding_en.t 14_encoding_zh.t
15_encoding_ja.t 16_encoding_ko.t 17_output_encoding.t
2006/04/30 (0.10)
* attr_prefix parameter added to emulate E4X, ECMAScript for XML.
* user_agent parameter and its default value added.
* source code passed perltidy. (thanks to Nadim)
2006/04/08 (0.08)
* set() and get() method added.
* cdata_scalar_ref option added. CDATASection's round trip supported.
* some error checkes added. (thanks to Nadim)
2006/03/09 (0.07)
* Correct POD about parsehttp() method
2006/03/02 (0.06)
* parsehttp() method now supports the HTTP::Lite pure Perl module as well.
* Bug fix: xml_escape() call in hash_to_xml() method. (thanks to suVene)
2006/02/26 (0.04)
* Correct POD about force_array option of new() method.
* parsehttp() method returns a hash tree and xml source on array context.
2006/02/22 (0.03)
* Changes
2006/02/21 (0.02)
* Change encoding from ISO-8859-1 to UTF-8 is natively supported.
* t/force_array.t t/parse.t t/parsefile.t t/parsehttp.t t/write.t
t/index.rdf t/family.xml
* Test scripts added.
2006/02/20 (0.01)
* first release.
# http://www.kawa.net/works/perl/treepp/treepp-e.html (English)
# http://www.kawa.net/works/perl/treepp/treepp.html#changes (Japanese)
XML-TreePP-0.43/example/ 000755 000765 000024 00000000000 12432275633 015253 5 ustar 00u-suke staff 000000 000000 XML-TreePP-0.43/lib/ 000755 000765 000024 00000000000 12432275633 014366 5 ustar 00u-suke staff 000000 000000 XML-TreePP-0.43/make-dist.sh 000755 000765 000024 00000002721 12432275304 016032 0 ustar 00u-suke staff 000000 000000 #!/bin/sh
die () {
echo "$*" >&2
exit 1
}
doit () {
echo "\$ $*" >&2
$* || die "[ERROR:$?]"
}
rdf=t/example/index.rdf
doit wget -O $rdf~ http://www.kawa.net/rss/index-e.rdf
diff $rdf $rdf~ > /dev/null || doit /bin/mv -f $rdf~ $rdf
/bin/rm -f $rdf~
[ -f Makefile ] && doit make clean
[ -f META.yml ] || doit touch META.yml
egrep -v '^(lib/.*\.pm|t/.*\.t)$' MANIFEST > MANIFEST~
ls Makefile.PL README Changes MANIFEST META.yml COPYING >> MANIFEST~ 2> /dev/null
find lib -type f -name '*.pm' >> MANIFEST~
ls t/*.t >> MANIFEST~
LC_ALL=C sort MANIFEST~ | uniq > MANIFEST~~
/bin/mv -f MANIFEST~~ MANIFEST~
diff MANIFEST MANIFEST~ > /dev/null || doit /bin/mv -f MANIFEST~ MANIFEST
/bin/rm -f MANIFEST~
doit perl Makefile.PL
doit make metafile
newmeta=`ls -t */META.yml | head -1`
diff META.yml $newmeta > /dev/null || doit /bin/cp -f $newmeta META.yml
doit make disttest
name=`grep '^name:' META.yml | sed 's#^.*: *##; s#-#/#g;'`
main=`grep "$name.pm$" < MANIFEST | head -1`
[ "$main" == "" ] && die "main module is not found in MANIFEST"
doit pod2text $main > README~
diff README README~ > /dev/null || doit /bin/mv -f README~ README
/bin/rm -f README~
doit pod2markdown $main > README.md~
diff README.md README.md~ > /dev/null || doit /bin/mv -f README.md~ README.md
/bin/rm -f README.md~
doit make dist
[ -d blib ] && doit /bin/rm -fr blib
[ -f pm_to_blib ] && doit /bin/rm -f pm_to_blib
[ -f Makefile.old ] && doit /bin/rm -f Makefile.old
ls -lt *.tar.gz | head -1
XML-TreePP-0.43/Makefile.PL 000755 000765 000024 00000001655 12236703553 015603 0 ustar 00u-suke staff 000000 000000 use ExtUtils::MakeMaker;
my $opt = {
NAME => 'XML::TreePP',
VERSION_FROM => 'lib/XML/TreePP.pm',
PREREQ_PM => {
'Test::More' => '0',
# 'LWP::UserAgent' => '0',
# 'HTTP::Lite' => '0',
# 'Jcode' => '0', # on Perl 5.005/5.6.x
},
ABSTRACT => 'Pure Perl implementation for parsing/writing XML documents',
AUTHOR => 'kawanet',
};
my $mm = $ExtUtils::MakeMaker::VERSION;
$mm =~ s/[^\d\.]+//g;
$opt->{LICENSE} = 'perl' if ( $mm >= 6.3001 );
my $PERL581 = 1 if ( $] >= 5.008001 );
$opt->{PREREQ_PM}->{Jcode} = '0' unless $PERL581;
eval { require 'LWP/UserAgent.pm'; };
# LWP.pm 5.811 is required for HTTP::Message add_content_utf8 method
$opt->{PREREQ_PM}->{'LWP'} = '5.811' if $LWP::UserAgent::VERSION;
$opt->{PREREQ_PM}->{'HTTP::Lite'} = '0' unless $LWP::UserAgent::VERSION;
WriteMakefile( %$opt );
XML-TreePP-0.43/MANIFEST 000644 000765 000024 00000003253 12432275633 014754 0 ustar 00u-suke staff 000000 000000 Changes
MANIFEST
META.yml
Makefile.PL
README
README.md
example/envxml.cgi
lib/XML/TreePP.pm
make-dist.sh
t/00_pod.t
t/01_parse.t
t/02_write.t
t/03_parsefile.t
t/04_escape.t
t/05_empty.t
t/06_cdata.t
t/07_attr_prefix.t
t/08_force_array.t
t/09_http-lite.t
t/10_http-lwp.t
t/11_escape_cdata.t
t/12_escape_charref.t
t/13_encoding_en.t
t/14_encoding_zh.t
t/15_encoding_ja.t
t/16_encoding_ko.t
t/17_output_encoding.t
t/18_escape_amp.t
t/19_multi_text.t
t/20_http-lite-cached.t
t/21_http-lwp-cached.t
t/22_http-lite-headers.t
t/23_http-lwp-headers.t
t/24_ignore_error.t
t/25_text_node_key.t
t/26_attr_prefix_null.t
t/27_http-lite-force.t
t/28_http-lwp-force.t
t/29_http-lwp-withcache.t
t/30_first_out.t
t/31_tie_ixhash.t
t/32_base_class.t
t/33_indent.t
t/34_utf8_flag.t
t/35_force_hash.t
t/36_elem_class.t
t/37_undef.t
t/38_cdata_cdsect.t
t/39_writefile.t
t/40_writefile_jcode.t
t/41_writefile_encode.t
t/42_cdata_comment.t
t/43_encoding_quote.t
t/44_utf8_bom.t
t/45_attr_space.t
t/46_xml_deref.t
t/47_xml_deref_utf8.t
t/48_blobref.t
t/49_invalid_encoding.t
t/50_invalid_tree.t
t/51_RT_42441.t
t/52_require_xml_decl.t
t/53_empty_text_node.t
t/54_empty_element_tag_end.t
t/example/hello-en-latin1.xml
t/example/hello-en-nodecl-bom.xml
t/example/hello-en-nodecl.xml
t/example/hello-en-noenc-bom.xml
t/example/hello-en-noenc.xml
t/example/hello-en-utf8-bom.xml
t/example/hello-en-utf8.xml
t/example/hello-ja-euc.xml
t/example/hello-ja-sjis.xml
t/example/hello-ja-utf8.xml
t/example/hello-ko-euc.xml
t/example/hello-ko-utf8.xml
t/example/hello-zh-big5.xml
t/example/hello-zh-gb2312.xml
t/example/hello-zh-utf8.xml
t/example/index.rdf
META.json Module JSON meta-data (added by MakeMaker)
XML-TreePP-0.43/META.json 000644 000765 000024 00000001616 12432275633 015245 0 ustar 00u-suke staff 000000 000000 {
"abstract" : "Pure Perl implementation for parsing/writing XML documents",
"author" : [
"kawanet"
],
"dynamic_config" : 1,
"generated_by" : "ExtUtils::MakeMaker version 6.6302, CPAN::Meta::Converter version 2.120921",
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : "2"
},
"name" : "XML-TreePP",
"no_index" : {
"directory" : [
"t",
"inc"
]
},
"prereqs" : {
"build" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"runtime" : {
"requires" : {
"LWP" : "5.811",
"Test::More" : "0"
}
}
},
"release_status" : "stable",
"version" : "0.43"
}
XML-TreePP-0.43/META.yml 000644 000765 000024 00000000770 12432275633 015075 0 ustar 00u-suke staff 000000 000000 ---
abstract: 'Pure Perl implementation for parsing/writing XML documents'
author:
- kawanet
build_requires:
ExtUtils::MakeMaker: 0
configure_requires:
ExtUtils::MakeMaker: 0
dynamic_config: 1
generated_by: 'ExtUtils::MakeMaker version 6.6302, CPAN::Meta::Converter version 2.120921'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
name: XML-TreePP
no_index:
directory:
- t
- inc
requires:
LWP: 5.811
Test::More: 0
version: 0.43
XML-TreePP-0.43/README 000644 000765 000024 00000031325 12432274756 014511 0 ustar 00u-suke staff 000000 000000 NAME
XML::TreePP -- Pure Perl implementation for parsing/writing XML
documents
SYNOPSIS
parse an XML document from file into hash tree:
use XML::TreePP;
my $tpp = XML::TreePP->new();
my $tree = $tpp->parsefile( "index.rdf" );
print "Title: ", $tree->{"rdf:RDF"}->{item}->[0]->{title}, "\n";
print "URL: ", $tree->{"rdf:RDF"}->{item}->[0]->{link}, "\n";
write an XML document as string from hash tree:
use 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 );
print $xml;
get a remote XML document by HTTP-GET and parse it into hash tree:
use XML::TreePP;
my $tpp = XML::TreePP->new();
my $tree = $tpp->parsehttp( GET => "http://use.perl.org/index.rss" );
print "Title: ", $tree->{"rdf:RDF"}->{channel}->{title}, "\n";
print "URL: ", $tree->{"rdf:RDF"}->{channel}->{link}, "\n";
get a remote XML document by HTTP-POST and parse it into hash tree:
use XML::TreePP;
my $tpp = XML::TreePP->new( force_array => [qw( item )] );
my $cgiurl = "http://search.hatena.ne.jp/keyword";
my $keyword = "ajax";
my $cgiquery = "mode=rss2&word=".$keyword;
my $tree = $tpp->parsehttp( POST => $cgiurl, $cgiquery );
print "Link: ", $tree->{rss}->{channel}->{item}->[0]->{link}, "\n";
print "Desc: ", $tree->{rss}->{channel}->{item}->[0]->{description}, "\n";
DESCRIPTION
XML::TreePP module parses an XML document and expands it for a hash
tree. This generates an XML document from a hash tree as the opposite
way around. This is a pure Perl implementation and requires no modules
depended. This can also fetch and parse an XML document from remote web
server like the XMLHttpRequest object does at JavaScript language.
EXAMPLES
Parse XML file
Sample XML document:
Yasuhisa
Chizuko
Shiori
Yusuke
Kairi
Sample program to read a xml file and dump it:
use XML::TreePP;
use Data::Dumper;
my $tpp = XML::TreePP->new();
my $tree = $tpp->parsefile( "family.xml" );
my $text = Dumper( $tree );
print $text;
Result dumped:
$VAR1 = {
'family' => {
'-name' => 'Kawasaki',
'father' => 'Yasuhisa',
'mother' => 'Chizuko',
'children' => {
'girl' => 'Shiori'
'boy' => [
'Yusuke',
'Kairi'
],
}
}
};
Details:
print $tree->{family}->{father}; # the father's given name.
The prefix '-' is added on every attribute's name.
print $tree->{family}->{"-name"}; # the family name of the family
The array is used because the family has two boys.
print $tree->{family}->{children}->{boy}->[1]; # The second boy's name
print $tree->{family}->{children}->{girl}; # The girl's name
Text node and attributes:
If a element has both of a text node and attributes or both of a text
node and other child nodes, value of a text node is moved to "#text"
like child nodes.
use XML::TreePP;
use Data::Dumper;
my $tpp = XML::TreePP->new();
my $source = 'Kawasaki Yusuke';
my $tree = $tpp->parse( $source );
my $text = Dumper( $tree );
print $text;
The result dumped is following:
$VAR1 = {
'span' => {
'-class' => 'author',
'#text' => 'Kawasaki Yusuke'
}
};
The special node name of "#text" is used because this elements has
attribute(s) in addition to the text node. See also "text_node_key"
option.
METHODS
new
This constructor method returns a new XML::TreePP object with %options.
$tpp = XML::TreePP->new( %options );
set
This method sets a option value for "option_name". If $option_value is
not defined, its option is deleted.
$tpp->set( option_name => $option_value );
See OPTIONS section below for details.
get
This method returns a current option value for "option_name".
$tpp->get( 'option_name' );
parse
This method reads an XML document by string and returns a hash tree
converted. The first argument is a scalar or a reference to a scalar.
$tree = $tpp->parse( $source );
parsefile
This method reads an XML document by file and returns a hash tree
converted. The first argument is a filename.
$tree = $tpp->parsefile( $file );
parsehttp
This method receives an XML document from a remote server via HTTP and
returns a hash tree converted.
$tree = $tpp->parsehttp( $method, $url, $body, $head );
$method is a method of HTTP connection: GET/POST/PUT/DELETE $url is an
URI of an XML file. $body is a request body when you use POST method.
$head is a request headers as a hash ref. LWP::UserAgent module or
HTTP::Lite module is required to fetch a file.
( $tree, $xml, $code ) = $tpp->parsehttp( $method, $url, $body, $head );
In array context, This method returns also raw XML document received and
HTTP response's status code.
write
This method parses a hash tree and returns an XML document as a string.
$source = $tpp->write( $tree, $encode );
$tree is a reference to a hash tree.
writefile
This method parses a hash tree and writes an XML document into a file.
$tpp->writefile( $file, $tree, $encode );
$file is a filename to create. $tree is a reference to a hash tree.
OPTIONS FOR PARSING XML
This module accepts option parameters following:
force_array
This option allows you to specify a list of element names which should
always be forced into an array representation.
$tpp->set( force_array => [ 'rdf:li', 'item', '-xmlns' ] );
The default value is null, it means that context of the elements will
determine to make array or to keep it scalar or hash. Note that the
special wildcard name '*' means all elements.
force_hash
This option allows you to specify a list of element names which should
always be forced into an hash representation.
$tpp->set( force_hash => [ 'item', 'image' ] );
The default value is null, it means that context of the elements will
determine to make hash or to keep it scalar as a text node. See also
"text_node_key" option below. Note that the special wildcard name '*'
means all elements.
cdata_scalar_ref
This option allows you to convert a cdata section into a reference for
scalar on parsing an XML document.
$tpp->set( cdata_scalar_ref => 1 );
The default value is false, it means that each cdata section is
converted into a scalar.
user_agent
This option allows you to specify a HTTP_USER_AGENT string which is used
by parsehttp() method.
$tpp->set( user_agent => 'Mozilla/4.0 (compatible; ...)' );
The default string is 'XML-TreePP/#.##', where '#.##' is substituted
with the version number of this library.
http_lite
This option forces pasrsehttp() method to use a HTTP::Lite instance.
my $http = HTTP::Lite->new();
$tpp->set( http_lite => $http );
lwp_useragent
This option forces parsehttp() method to use a LWP::UserAgent instance.
my $ua = LWP::UserAgent->new();
$ua->timeout( 60 );
$ua->env_proxy;
$tpp->set( lwp_useragent => $ua );
You may use this with LWP::UserAgent::WithCache.
base_class
This blesses class name for each element's hashref. Each class is named
straight as a child class of it parent class.
$tpp->set( base_class => 'MyElement' );
my $xml = 'text';
my $tree = $tpp->parse( $xml );
print ref $tree->{root}->{parent}->{child}, "\n";
A hash for element above is blessed to
"MyElement::root::parent::child" class. You may use this with
Class::Accessor.
elem_class
This blesses class name for each element's hashref. Each class is named
horizontally under the direct child of "MyElement".
$tpp->set( base_class => 'MyElement' );
my $xml = 'text';
my $tree = $tpp->parse( $xml );
print ref $tree->{root}->{parent}->{child}, "\n";
A hash for element above is blessed to "MyElement::child" class.
xml_deref
This option dereferences the numeric character references, like ë,
漢, etc., in an XML document when this value is true.
$tpp->set( xml_deref => 1 );
Note that, for security reasons and your convenient, this module
dereferences the predefined character entity references, &, <,
>, ' and ", and the numeric character references up to
U+007F without xml_deref per default.
require_xml_decl
This option requires XML declaration at the top of XML document to
parse.
$tpp->set( require_xml_decl => 1 );
This will die when declration not found.
OPTIONS FOR WRITING XML
first_out
This option allows you to specify a list of element/attribute names
which should always appears at first on output XML document.
$tpp->set( first_out => [ 'link', 'title', '-type' ] );
The default value is null, it means alphabetical order is used.
last_out
This option allows you to specify a list of element/attribute names
which should always appears at last on output XML document.
$tpp->set( last_out => [ 'items', 'item', 'entry' ] );
indent
This makes the output more human readable by indenting appropriately.
$tpp->set( indent => 2 );
This doesn't strictly follow the XML specification but does looks nice.
xml_decl
This module inserts an XML declaration on top of the XML document
generated per default. This option forces to change it to another or
just remove it.
$tpp->set( xml_decl => '' );
output_encoding
This option allows you to specify a encoding of the XML document
generated by write/writefile methods.
$tpp->set( output_encoding => 'UTF-8' );
On Perl 5.8.0 and later, you can select it from every encodings
supported by Encode.pm. On Perl 5.6.x and before with Jcode.pm, you can
use "Shift_JIS", "EUC-JP", "ISO-2022-JP" and "UTF-8". The default value
is "UTF-8" which is recommended encoding.
empty_element_tag_end
$tpp->set( empty_element_tag_end => '>' );
Set characters which close empty tag. The default value is ' />'.
OPTIONS FOR BOTH
utf8_flag
This makes utf8 flag on for every element's value parsed and makes it on
for the XML document generated as well.
$tpp->set( utf8_flag => 1 );
Perl 5.8.1 or later is required to use this.
attr_prefix
This option allows you to specify a prefix character(s) which is
inserted before each attribute names.
$tpp->set( attr_prefix => '@' );
The default character is '-'. Or set '@' to access attribute values like
E4X, ECMAScript for XML. Zero-length prefix '' is available as well, it
means no prefix is added.
text_node_key
This option allows you to specify a hash key for text nodes.
$tpp->set( text_node_key => '#text' );
The default key is "#text".
ignore_error
This module calls Carp::croak function on an error per default. This
option makes all errors ignored and just returns.
$tpp->set( ignore_error => 1 );
use_ixhash
This option keeps the order for each element appeared in XML.
Tie::IxHash module is required.
$tpp->set( use_ixhash => 1 );
This makes parsing performance slow. (about 100% slower than default)
AUTHOR
Yusuke Kawasaki, http://www.kawa.net/
REPOSITORY
https://github.com/kawanet/XML-TreePP
COPYRIGHT
The following copyright notice applies to all the files provided in this
distribution, including binary files, unless explicitly noted otherwise.
Copyright 2006-2010 Yusuke Kawasaki
LICENSE
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
XML-TreePP-0.43/README.md 000644 000765 000024 00000030410 12432275317 015074 0 ustar 00u-suke staff 000000 000000 # NAME
XML::TreePP -- Pure Perl implementation for parsing/writing XML documents
# SYNOPSIS
parse an XML document from file into hash tree:
use XML::TreePP;
my $tpp = XML::TreePP->new();
my $tree = $tpp->parsefile( "index.rdf" );
print "Title: ", $tree->{"rdf:RDF"}->{item}->[0]->{title}, "\n";
print "URL: ", $tree->{"rdf:RDF"}->{item}->[0]->{link}, "\n";
write an XML document as string from hash tree:
use 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 );
print $xml;
get a remote XML document by HTTP-GET and parse it into hash tree:
use XML::TreePP;
my $tpp = XML::TreePP->new();
my $tree = $tpp->parsehttp( GET => "http://use.perl.org/index.rss" );
print "Title: ", $tree->{"rdf:RDF"}->{channel}->{title}, "\n";
print "URL: ", $tree->{"rdf:RDF"}->{channel}->{link}, "\n";
get a remote XML document by HTTP-POST and parse it into hash tree:
use XML::TreePP;
my $tpp = XML::TreePP->new( force_array => [qw( item )] );
my $cgiurl = "http://search.hatena.ne.jp/keyword";
my $keyword = "ajax";
my $cgiquery = "mode=rss2&word=".$keyword;
my $tree = $tpp->parsehttp( POST => $cgiurl, $cgiquery );
print "Link: ", $tree->{rss}->{channel}->{item}->[0]->{link}, "\n";
print "Desc: ", $tree->{rss}->{channel}->{item}->[0]->{description}, "\n";
# DESCRIPTION
XML::TreePP module parses an XML document and expands it for a hash tree.
This generates an XML document from a hash tree as the opposite way around.
This is a pure Perl implementation and requires no modules depended.
This can also fetch and parse an XML document from remote web server
like the XMLHttpRequest object does at JavaScript language.
# EXAMPLES
## Parse XML file
Sample XML document:
Yasuhisa
Chizuko
Shiori
Yusuke
Kairi
Sample program to read a xml file and dump it:
use XML::TreePP;
use Data::Dumper;
my $tpp = XML::TreePP->new();
my $tree = $tpp->parsefile( "family.xml" );
my $text = Dumper( $tree );
print $text;
Result dumped:
$VAR1 = {
'family' => {
'-name' => 'Kawasaki',
'father' => 'Yasuhisa',
'mother' => 'Chizuko',
'children' => {
'girl' => 'Shiori'
'boy' => [
'Yusuke',
'Kairi'
],
}
}
};
Details:
print $tree->{family}->{father}; # the father's given name.
The prefix '-' is added on every attribute's name.
print $tree->{family}->{"-name"}; # the family name of the family
The array is used because the family has two boys.
print $tree->{family}->{children}->{boy}->[1]; # The second boy's name
print $tree->{family}->{children}->{girl}; # The girl's name
## Text node and attributes:
If a element has both of a text node and attributes
or both of a text node and other child nodes,
value of a text node is moved to `#text` like child nodes.
use XML::TreePP;
use Data::Dumper;
my $tpp = XML::TreePP->new();
my $source = 'Kawasaki Yusuke';
my $tree = $tpp->parse( $source );
my $text = Dumper( $tree );
print $text;
The result dumped is following:
$VAR1 = {
'span' => {
'-class' => 'author',
'#text' => 'Kawasaki Yusuke'
}
};
The special node name of `#text` is used because this elements
has attribute(s) in addition to the text node.
See also ["text\_node\_key"](#text_node_key) option.
# METHODS
## new
This constructor method returns a new XML::TreePP object with `%options`.
$tpp = XML::TreePP->new( %options );
## set
This method sets a option value for `option_name`.
If `$option_value` is not defined, its option is deleted.
$tpp->set( option_name => $option_value );
See OPTIONS section below for details.
## get
This method returns a current option value for `option_name`.
$tpp->get( 'option_name' );
## parse
This method reads an XML document by string and returns a hash tree converted.
The first argument is a scalar or a reference to a scalar.
$tree = $tpp->parse( $source );
## parsefile
This method reads an XML document by file and returns a hash tree converted.
The first argument is a filename.
$tree = $tpp->parsefile( $file );
## parsehttp
This method receives an XML document from a remote server via HTTP and
returns a hash tree converted.
$tree = $tpp->parsehttp( $method, $url, $body, $head );
`$method` is a method of HTTP connection: GET/POST/PUT/DELETE
`$url` is an URI of an XML file.
`$body` is a request body when you use POST method.
`$head` is a request headers as a hash ref.
[LWP::UserAgent](https://metacpan.org/pod/LWP::UserAgent) module or [HTTP::Lite](https://metacpan.org/pod/HTTP::Lite) module is required to fetch a file.
( $tree, $xml, $code ) = $tpp->parsehttp( $method, $url, $body, $head );
In array context, This method returns also raw XML document received
and HTTP response's status code.
## write
This method parses a hash tree and returns an XML document as a string.
$source = $tpp->write( $tree, $encode );
`$tree` is a reference to a hash tree.
## writefile
This method parses a hash tree and writes an XML document into a file.
$tpp->writefile( $file, $tree, $encode );
`$file` is a filename to create.
`$tree` is a reference to a hash tree.
# OPTIONS FOR PARSING XML
This module accepts option parameters following:
## force\_array
This option allows you to specify a list of element names which
should always be forced into an array representation.
$tpp->set( force_array => [ 'rdf:li', 'item', '-xmlns' ] );
The default value is null, it means that context of the elements
will determine to make array or to keep it scalar or hash.
Note that the special wildcard name `'*'` means all elements.
## force\_hash
This option allows you to specify a list of element names which
should always be forced into an hash representation.
$tpp->set( force_hash => [ 'item', 'image' ] );
The default value is null, it means that context of the elements
will determine to make hash or to keep it scalar as a text node.
See also ["text\_node\_key"](#text_node_key) option below.
Note that the special wildcard name `'*'` means all elements.
## cdata\_scalar\_ref
This option allows you to convert a cdata section into a reference
for scalar on parsing an XML document.
$tpp->set( cdata_scalar_ref => 1 );
The default value is false, it means that each cdata section is converted into a scalar.
## user\_agent
This option allows you to specify a HTTP\_USER\_AGENT string which
is used by parsehttp() method.
$tpp->set( user_agent => 'Mozilla/4.0 (compatible; ...)' );
The default string is `'XML-TreePP/#.##'`, where `'#.##'` is
substituted with the version number of this library.
## http\_lite
This option forces pasrsehttp() method to use a [HTTP::Lite](https://metacpan.org/pod/HTTP::Lite) instance.
my $http = HTTP::Lite->new();
$tpp->set( http_lite => $http );
## lwp\_useragent
This option forces parsehttp() method to use a [LWP::UserAgent](https://metacpan.org/pod/LWP::UserAgent) instance.
my $ua = LWP::UserAgent->new();
$ua->timeout( 60 );
$ua->env_proxy;
$tpp->set( lwp_useragent => $ua );
You may use this with [LWP::UserAgent::WithCache](https://metacpan.org/pod/LWP::UserAgent::WithCache).
## base\_class
This blesses class name for each element's hashref.
Each class is named straight as a child class of it parent class.
$tpp->set( base_class => 'MyElement' );
my $xml = 'text';
my $tree = $tpp->parse( $xml );
print ref $tree->{root}->{parent}->{child}, "\n";
A hash for element above is blessed to `MyElement::root::parent::child`
class. You may use this with [Class::Accessor](https://metacpan.org/pod/Class::Accessor).
## elem\_class
This blesses class name for each element's hashref.
Each class is named horizontally under the direct child of `MyElement`.
$tpp->set( base_class => 'MyElement' );
my $xml = 'text';
my $tree = $tpp->parse( $xml );
print ref $tree->{root}->{parent}->{child}, "\n";
A hash for element above is blessed to `MyElement::child` class.
## xml\_deref
This option dereferences the numeric character references, like ë,
漢, etc., in an XML document when this value is true.
$tpp->set( xml_deref => 1 );
Note that, for security reasons and your convenient,
this module dereferences the predefined character entity references,
&, <, >, ' and ", and the numeric character
references up to U+007F without xml\_deref per default.
## require\_xml\_decl
This option requires XML declaration at the top of XML document to parse.
$tpp->set( require_xml_decl => 1 );
This will die when declration not found.
# OPTIONS FOR WRITING XML
## first\_out
This option allows you to specify a list of element/attribute
names which should always appears at first on output XML document.
$tpp->set( first_out => [ 'link', 'title', '-type' ] );
The default value is null, it means alphabetical order is used.
## last\_out
This option allows you to specify a list of element/attribute
names which should always appears at last on output XML document.
$tpp->set( last_out => [ 'items', 'item', 'entry' ] );
## indent
This makes the output more human readable by indenting appropriately.
$tpp->set( indent => 2 );
This doesn't strictly follow the XML specification but does looks nice.
## xml\_decl
This module inserts an XML declaration on top of the XML document generated
per default. This option forces to change it to another or just remove it.
$tpp->set( xml_decl => '' );
## output\_encoding
This option allows you to specify a encoding of the XML document generated
by write/writefile methods.
$tpp->set( output_encoding => 'UTF-8' );
On Perl 5.8.0 and later, you can select it from every
encodings supported by Encode.pm. On Perl 5.6.x and before with
Jcode.pm, you can use `Shift_JIS`, `EUC-JP`, `ISO-2022-JP` and
`UTF-8`. The default value is `UTF-8` which is recommended encoding.
## empty\_element\_tag\_end
$tpp->set( empty_element_tag_end => '>' );
Set characters which close empty tag. The default value is ' />'.
# OPTIONS FOR BOTH
## utf8\_flag
This makes utf8 flag on for every element's value parsed
and makes it on for the XML document generated as well.
$tpp->set( utf8_flag => 1 );
Perl 5.8.1 or later is required to use this.
## attr\_prefix
This option allows you to specify a prefix character(s) which
is inserted before each attribute names.
$tpp->set( attr_prefix => '@' );
The default character is `'-'`.
Or set `'@'` to access attribute values like E4X, ECMAScript for XML.
Zero-length prefix `''` is available as well, it means no prefix is added.
## text\_node\_key
This option allows you to specify a hash key for text nodes.
$tpp->set( text_node_key => '#text' );
The default key is `#text`.
## ignore\_error
This module calls Carp::croak function on an error per default.
This option makes all errors ignored and just returns.
$tpp->set( ignore_error => 1 );
## use\_ixhash
This option keeps the order for each element appeared in XML.
[Tie::IxHash](https://metacpan.org/pod/Tie::IxHash) module is required.
$tpp->set( use_ixhash => 1 );
This makes parsing performance slow.
(about 100% slower than default)
# AUTHOR
Yusuke Kawasaki, http://www.kawa.net/
# REPOSITORY
https://github.com/kawanet/XML-TreePP
# COPYRIGHT
The following copyright notice applies to all the files provided in
this distribution, including binary files, unless explicitly noted
otherwise.
Copyright 2006-2010 Yusuke Kawasaki
# LICENSE
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
XML-TreePP-0.43/t/ 000755 000765 000024 00000000000 12432275633 014063 5 ustar 00u-suke staff 000000 000000 XML-TreePP-0.43/t/00_pod.t 000755 000765 000024 00000000315 12236676324 015337 0 ustar 00u-suke staff 000000 000000 use strict;
use Test::More;
my $FILES = [qw(
lib/XML/TreePP.pm
)];
local $@;
eval "use Test::Pod 1.00";
plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
all_pod_files_ok( @$FILES );
;1;
XML-TreePP-0.43/t/01_parse.t 000755 000765 000024 00000001405 12236676324 015671 0 ustar 00u-suke staff 000000 000000 # ----------------------------------------------------------------
use strict;
use Test::More tests => 4;
BEGIN { use_ok('XML::TreePP') };
# ----------------------------------------------------------------
my $tpp = XML::TreePP->new();
my $source = 'BBB';
my $tree = $tpp->parse( $source );
is( $tree->{root}->{"#text"}, "BBB", "text node" );
is( $tree->{root}->{"-attr"}, "AAA", "attributes" );
my $back = $tpp->write( $tree );
my $test = $source;
$back =~ s/\s+//sg;
$back =~ s/<\?.*?\?>//s;
$test =~ s/\s+//sg;
is( $back, $test, "parse and write" );
# ----------------------------------------------------------------
;1;
# ----------------------------------------------------------------
XML-TreePP-0.43/t/02_write.t 000755 000765 000024 00000002306 12236676324 015713 0 ustar 00u-suke staff 000000 000000 # ----------------------------------------------------------------
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.43/t/03_parsefile.t 000755 000765 000024 00000001250 12236676324 016531 0 ustar 00u-suke staff 000000 000000 # ----------------------------------------------------------------
use strict;
use Test::More tests => 3;
BEGIN { use_ok('XML::TreePP') };
# ----------------------------------------------------------------
my $tpp = XML::TreePP->new();
my $tree = $tpp->parsefile( 't/example/index.rdf' );
my $title = $tree->{'rdf:RDF'}->{channel}->{title};
like( $title, qr{ kawa.net }ix, '' );
my $about = $tree->{'rdf:RDF'}->{channel}->{'-rdf:about'};
like( $about, qr{ ^http:// }x, '' );
# ----------------------------------------------------------------
;1;
# ----------------------------------------------------------------
XML-TreePP-0.43/t/04_escape.t 000755 000765 000024 00000003533 12236676324 016026 0 ustar 00u-suke staff 000000 000000 # ----------------------------------------------------------------
use strict;
use Test::More tests => 9;
BEGIN { use_ok('XML::TreePP') };
# ----------------------------------------------------------------
my $tpp = XML::TreePP->new();
my $source = '<>&"'><BBB';
my $tree = $tpp->parse( $source );
is( $tree->{root}->{text}, '<>&"\'><', "parse text node" );
is( $tree->{root}->{cdata}, '<>&"'><', "parse cdata node" );
is( $tree->{root}->{attr}->{'-key'}, '<>&"\'><', "parse attribute" );
$tree->{root}->{text_add} = '<>&"'><';
my $cdata_raw = $tree->{root}->{cdata};
$tree->{root}->{cdata_ref} = \$cdata_raw;
my $back = $tpp->write( $tree );
my $text = ( $back =~ m#(.*)# )[0];
is( $text, '<>&"'><', "write text node" );
my $cdata = ( $back =~ m#(.*)# )[0];
is( $cdata, '<>&"'&gt;&lt;', "write cdata node (as text node)" );
my $attr = ( $back =~ m## )[0];
is( $attr, '<>&"'><', "write attribute" );
my $tadd = ( $back =~ m#(.*)# )[0];
is( $tadd, '<>&"'&gt;&lt;', "write new var" );
my $cref = ( $back =~ m#(.*)# )[0];
is( $cref, '', "write cdata node (as cdata)" );
# ----------------------------------------------------------------
;1;
# ----------------------------------------------------------------
XML-TreePP-0.43/t/05_empty.t 000755 000765 000024 00000002706 12236676324 015726 0 ustar 00u-suke staff 000000 000000 # ----------------------------------------------------------------
use strict;
use Test::More tests => 13;
BEGIN { use_ok('XML::TreePP') };
# ----------------------------------------------------------------
my $tpp = XML::TreePP->new( force_array => [qw( one two three )] );
my $source = ' ';
my $tree = $tpp->parse( $source );
ok( exists $tree->{root}->{e1}, "empty element" );
ok( ref $tree->{root}->{e2}, "empty element with attribute" );
ok( exists $tree->{root}->{e3}, "no child nodes" );
ok( ref $tree->{root}->{e4}, "attribute" );
ok( exists $tree->{root}->{e5}, "white space" );
my $xml = $tpp->write( $tree );
my $round = $tpp->parse( $xml );
ok( exists $round->{root}->{e1}, "round trip: empty element" );
ok( ref $round->{root}->{e2}, "round trip: empty element with attribute" );
ok( exists $round->{root}->{e3}, "round trip: no child nodes" );
ok( ref $round->{root}->{e4}, "round trip: attribute" );
ok( exists $round->{root}->{e5}, "round trip: white space" );
is( $tree->{root}->{e2}->{"-foo"}, $round->{root}->{e2}->{"-foo"}, "round trip: attribute 1" );
is( $tree->{root}->{e4}->{"-foo"}, $round->{root}->{e4}->{"-foo"}, "round trip: attribute 2" );
# ----------------------------------------------------------------
;1;
# ----------------------------------------------------------------
XML-TreePP-0.43/t/06_cdata.t 000755 000765 000024 00000004531 12236676324 015643 0 ustar 00u-suke staff 000000 000000 # ----------------------------------------------------------------
use strict;
use Test::More tests => 13;
BEGIN { use_ok('XML::TreePP') };
# ----------------------------------------------------------------
{
my $cdatal = '
bar';
my $cdatar = ']]>';
my $tpp = XML::TreePP->new();
my $xml1 = join( "", $cdatal, $test, $cdatar );
$tpp->set( cdata_scalar_ref => 1 );
my $tree1 = $tpp->parse( $xml1 );
my $cdata1 = $tree1->{cdata};
ok( ref $cdata1, "cdata as reference" );
is( $$cdata1, $test, "cdata escaping" );
my $xml2 = $tpp->write( $tree1 );
ok( $xml2 =~ /\Q$cdatal$test$cdatar\E/, "round trip: source" );
$tpp->set( cdata_scalar_ref => undef );
my $tree2 = $tpp->parse( $xml2 );
my $cdata2 = $tree2->{cdata};
ok( ! ref $cdata2, "round trip: cdata as scalar" );
is( $cdata2, $test, "round trip: text node escaping" );
$tree2->{cdata} = \$cdata2;
my $xml3 = $tpp->write( $tree2 );
ok( $xml2 =~ /\Q$cdatal$test$cdatar\E/, "round trip: again" );
}
# ----------------------------------------------------------------
{
my $root1 = '';
my $root2 = '';
my $cdatal = '
bar';
my $cdatar = ']]>';
my $root3 = '';
my $tpp = XML::TreePP->new();
my $xml1 = join( '', $root1, $root2, $cdatal, $test, $cdatar, $root3 );
$tpp->set( cdata_scalar_ref => 1 );
my $tree1 = $tpp->parse( $xml1 );
my $cdata1 = $tree1->{cdata}{'#text'};
ok( ref $cdata1, 'cdata as reference B' );
is( $$cdata1, $test, 'cdata escaping B' );
my $xml2 = $tpp->write( $tree1 );
ok( $xml2 =~ /\Q$cdatal$test$cdatar\E/, 'round trip: source B' );
$tpp->set( cdata_scalar_ref => undef );
my $tree2 = $tpp->parse( $xml2 );
my $cdata2 = $tree2->{cdata}{'#text'};
ok( ! ref $cdata2, 'round trip: cdata as scalar B' );
is( $cdata2, $test, 'round trip: text node escaping B' );
$tree2->{cdata} = \$cdata2;
my $xml3 = $tpp->write( $tree2 );
ok( $xml2 =~ /\Q$cdatal$test$cdatar\E/, 'round trip: again B' );
}
# ----------------------------------------------------------------
;1;
# ----------------------------------------------------------------
XML-TreePP-0.43/t/07_attr_prefix.t 000755 000765 000024 00000002370 12236676324 017116 0 ustar 00u-suke staff 000000 000000 # ----------------------------------------------------------------
use strict;
use Test::More tests => 15;
BEGIN { use_ok('XML::TreePP') };
# ----------------------------------------------------------------
my $source = '';
my $tpp = XML::TreePP->new();
my $tree1 = $tpp->parse( $source );
is( $tree1->{root}->{foo}->{'-bar'}, 'hoge', "parse: default" );
my $test = $source;
$test =~ s/\s+//sg;
foreach my $prefix ( '-', '@', '__', '?}{][)(', '$*@^%+&', '0' ) {
my $vprefix = defined $prefix ? ( length($prefix) ? $prefix : '""' ) : 'undef';
$tpp->set( attr_prefix => $prefix );
my $tree = $tpp->parse( $source );
is( $tree->{root}->{foo}->{$prefix.'bar'}, 'hoge', "parse: $vprefix" );
my $back = $tpp->write( $tree );
$back =~ s/\s+//sg;
$back =~ s/<\?.*?\?>//s;
is( $test, $back, "write: $vprefix" );
}
$tpp->set( "attr_prefix" ); # remove attr_prefix
my $tree2 = $tpp->parse( $source );
is( $tree2->{root}->{foo}->{'-bar'}, 'hoge', "parse: default (again)" );
# ----------------------------------------------------------------
;1;
# ----------------------------------------------------------------
XML-TreePP-0.43/t/08_force_array.t 000755 000765 000024 00000005735 12236676324 017074 0 ustar 00u-suke staff 000000 000000 # ----------------------------------------------------------------
use strict;
use Test::More tests => 25;
BEGIN { use_ok('XML::TreePP') };
# ----------------------------------------------------------------
{
my $tpp = XML::TreePP->new( force_array => [qw( one two three )] );
my $source = <<"EOT";
AAA
CCC
DDDEEE
EOT
my $tree = $tpp->parse( $source );
ok( ! ref $tree->{root}->{zero}, "A: normal node" );
ok( ref $tree->{root}->{one} , "A: one force_array node" );
ok( ref $tree->{root}->{two} , "A: two child nodes" );
ok( ref $tree->{root}->{three} , "A: three empty nodes" );
is( scalar( @{$tree->{root}->{one}} ), 1, "A: one force_array node" );
is( scalar( @{$tree->{root}->{two}} ), 2, "A: two child nodes" );
is( scalar( @{$tree->{root}->{three}} ), 3, "A: three empty nodes" );
is( scalar( grep {$_} @{$tree->{root}->{one}} ), 1, "A: one force_array node" );
is( scalar( grep {$_} @{$tree->{root}->{two}} ), 2, "A: two child nodes" );
is( scalar( grep {$_} @{$tree->{root}->{three}} ), 0, "A: three empty nodes" );
}
# ----------------------------------------------------------------
{
my $tpp = XML::TreePP->new( force_array => [qw( one two three )] );
my $source = <<"EOT";
EOT
my $tree = $tpp->parse( $source );
is( scalar( @{$tree->{root}->{one}} ), 1, "B: one force_array node" );
is( scalar( @{$tree->{root}->{two}} ), 2, "B: two child nodes" );
is( scalar( @{$tree->{root}->{three}} ), 3, "B: three empty nodes" );
is( scalar( grep {ref $_} @{$tree->{root}->{one}} ), 1, "B: one force_array node" );
is( scalar( grep {ref $_} @{$tree->{root}->{two}} ), 2, "B: two child nodes" );
is( scalar( grep {ref $_} @{$tree->{root}->{three}} ), 3, "B: three empty nodes" );
}
# ----------------------------------------------------------------
{
my $tpp = XML::TreePP->new( force_array => '*' );
my $source = <<"EOT";
1
3
EOT
my $tree = $tpp->parse( $source );
is( ref $tree->{root}, 'ARRAY', 'C: root ARRAY' );
is( ref $tree->{root}->[0], 'HASH', 'C: root HASH' );
is( ref $tree->{root}->[0]->{one}, 'ARRAY', 'C: one ARRAY' );
is( $tree->{root}->[0]->{one}->[0], '1', 'C: one text' );
is( ref $tree->{root}->[0]->{two}, 'ARRAY', 'C: two ARRAY' );
is( ref $tree->{root}->[0]->{two}->[0], 'HASH', 'C: two HASH' );
is( ref $tree->{root}->[0]->{two}->[0]->{three}, 'ARRAY', 'C: three ARRAY' );
is( $tree->{root}->[0]->{two}->[0]->{three}->[0], '3', 'C: three text' );
}
# ----------------------------------------------------------------
;1;
# ----------------------------------------------------------------
XML-TreePP-0.43/t/09_http-lite.t 000755 000765 000024 00000003161 12432272674 016500 0 ustar 00u-suke staff 000000 000000 # ----------------------------------------------------------------
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.';
}
if ( ! defined $ENV{MORE_TESTS} ) {
plan skip_all => 'define $MORE_TESTS to test HTTP::Lite.';
}
plan tests => 5;
use_ok('XML::TreePP');
&parsehttp_get();
&parsehttp_post();
}
# ----------------------------------------------------------------
sub parsehttp_get {
my $tpp = XML::TreePP->new();
my $name = ( $0 =~ m#([^/:\\]+)$# )[0];
$tpp->set( user_agent => "$name " );
my $url = "http://rss.slashdot.org/Slashdot/slashdot";
my $tree = $tpp->parsehttp( GET => $url );
ok( ref $tree, $url );
like( $tree->{"rss"}->{channel}->{link}, qr{^http://}, "$url link" );
}
# ----------------------------------------------------------------
sub parsehttp_post {
my $tpp = XML::TreePP->new( force_array => [qw( item )] );
my $name = ( $0 =~ m#([^/:\\]+)$# )[0];
$tpp->set( user_agent => "$name " );
my $url = "http://search.hatena.ne.jp/keyword";
my $query = "ajax";
my $body = "mode=rss2&word=".$query;
my $tree = $tpp->parsehttp( POST => $url, $body );
ok( ref $tree, $url );
like( $tree->{rss}->{channel}->{item}->[0]->{link}, qr{^http://}, "$url link" );
}
# ----------------------------------------------------------------
;1;
# ----------------------------------------------------------------
XML-TreePP-0.43/t/10_http-lwp.t 000755 000765 000024 00000003206 12432272674 016335 0 ustar 00u-suke staff 000000 000000 # ----------------------------------------------------------------
use strict;
use Test::More;
# ----------------------------------------------------------------
SKIP: {
local $@;
eval { require LWP::UserAgent; } unless defined $LWP::UserAgent::VERSION;
if ( ! defined $LWP::UserAgent::VERSION ) {
plan skip_all => 'LWP::UserAgent is not loaded.';
}
if ( ! defined $ENV{MORE_TESTS} ) {
plan skip_all => 'define $MORE_TESTS to test LWP::UserAgent.';
}
plan tests => 5;
use_ok('XML::TreePP');
&parsehttp_get();
&parsehttp_post();
}
# ----------------------------------------------------------------
sub parsehttp_get {
my $tpp = XML::TreePP->new();
my $name = ( $0 =~ m#([^/:\\]+)$# )[0];
$tpp->set( user_agent => "$name " );
my $url = "http://rss.slashdot.org/Slashdot/slashdot";
my $tree = $tpp->parsehttp( GET => $url );
ok( ref $tree, $url );
like( $tree->{"rss"}->{channel}->{link}, qr{^http://}, "$url link" );
}
# ----------------------------------------------------------------
sub parsehttp_post {
my $tpp = XML::TreePP->new( force_array => [qw( item )] );
my $name = ( $0 =~ m#([^/:\\]+)$# )[0];
$tpp->set( user_agent => "$name " );
my $url = "http://search.hatena.ne.jp/keyword";
my $query = "ajax";
my $body = "mode=rss2&word=".$query;
my $tree = $tpp->parsehttp( POST => $url, $body );
ok( ref $tree, $url );
like( $tree->{rss}->{channel}->{item}->[0]->{link}, qr{^http://}, "$url link" );
}
# ----------------------------------------------------------------
;1;
# ----------------------------------------------------------------
XML-TreePP-0.43/t/11_escape_cdata.t 000755 000765 000024 00000002245 12236676324 017157 0 ustar 00u-suke staff 000000 000000 # ----------------------------------------------------------------
use strict;
use Test::More tests => 7;
BEGIN { use_ok('XML::TreePP') };
# ----------------------------------------------------------------
my $tpp = XML::TreePP->new();
$tpp->set( cdata_scalar_ref => 1 );
my $source = '<>&><BBB';
my $tree = $tpp->parse( $source );
is( $tree->{root}->{text}, '<>&><', "parse text node" );
my $cdata = $tree->{root}->{cdata};
is( $$cdata, '<>&><', "parse cdata node" );
is( $tree->{root}->{attr}->{'-key'}, '<>&><', "parse attribute" );
my $back = $tpp->write( $tree );
like( $back, qr{ \s* <>&>< \s* }sx, "write text node" );
like( $back, qr{ }sx, "write cdata node (as cdata)" );
like( $back, qr{