XML-TreePP-0.43/000755 000765 000024 00000000000 12432275633 013620 5ustar00u-sukestaff000000 000000 XML-TreePP-0.43/Changes000755 000765 000024 00000017122 12432275567 015127 0ustar00u-sukestaff000000 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 5ustar00u-sukestaff000000 000000 XML-TreePP-0.43/lib/000755 000765 000024 00000000000 12432275633 014366 5ustar00u-sukestaff000000 000000 XML-TreePP-0.43/make-dist.sh000755 000765 000024 00000002721 12432275304 016032 0ustar00u-sukestaff000000 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.PL000755 000765 000024 00000001655 12236703553 015603 0ustar00u-sukestaff000000 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/MANIFEST000644 000765 000024 00000003253 12432275633 014754 0ustar00u-sukestaff000000 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.json000644 000765 000024 00000001616 12432275633 015245 0ustar00u-sukestaff000000 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.yml000644 000765 000024 00000000770 12432275633 015075 0ustar00u-sukestaff000000 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/README000644 000765 000024 00000031325 12432274756 014511 0ustar00u-sukestaff000000 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.md000644 000765 000024 00000030410 12432275317 015074 0ustar00u-sukestaff000000 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 5ustar00u-sukestaff000000 000000 XML-TreePP-0.43/t/00_pod.t000755 000765 000024 00000000315 12236676324 015337 0ustar00u-sukestaff000000 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.t000755 000765 000024 00000001405 12236676324 015671 0ustar00u-sukestaff000000 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.t000755 000765 000024 00000002306 12236676324 015713 0ustar00u-sukestaff000000 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.t000755 000765 000024 00000001250 12236676324 016531 0ustar00u-sukestaff000000 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, '<channel rdf:about="">' ); # ---------------------------------------------------------------- ;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 = '<root><text><>&"'&gt;&lt;</text><cdata><![CDATA[<>&"'&gt;&lt;]]></cdata><attr key="<>&"'&gt;&lt;">BBB</attr></root>'; my $tree = $tpp->parse( $source ); is( $tree->{root}->{text}, '<>&"\'><', "parse text node" ); is( $tree->{root}->{cdata}, '<>&"'&gt;&lt;', "parse cdata node" ); is( $tree->{root}->{attr}->{'-key'}, '<>&"\'><', "parse attribute" ); $tree->{root}->{text_add} = '<>&"'&gt;&lt;'; my $cdata_raw = $tree->{root}->{cdata}; $tree->{root}->{cdata_ref} = \$cdata_raw; my $back = $tpp->write( $tree ); my $text = ( $back =~ m#<text>(.*)</text># )[0]; is( $text, '<>&"'&gt;&lt;', "write text node" ); my $cdata = ( $back =~ m#<cdata>(.*)</cdata># )[0]; is( $cdata, '&lt;&gt;&amp;&quot;&apos;&amp;gt;&amp;lt;', "write cdata node (as text node)" ); my $attr = ( $back =~ m#<attr\s+key="(.*?)"\s*># )[0]; is( $attr, '<>&"'&gt;&lt;', "write attribute" ); my $tadd = ( $back =~ m#<text_add>(.*)</text_add># )[0]; is( $tadd, '&lt;&gt;&amp;&quot;&apos;&amp;gt;&amp;lt;', "write new var" ); my $cref = ( $back =~ m#<cdata_ref>(.*)</cdata_ref># )[0]; is( $cref, '<![CDATA[<>&"'&gt;&lt;]]>', "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 = '<root> <e1/> <e2 foo="bar"/> <e3></e3> <e4 foo="bar"></e4> <e5> </e5> </root>'; 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 = '<cdata><![CDATA['; my $test = 'bar &lt; <&> &gt; <span><br/></span> bar'; my $cdatar = ']]></cdata>'; 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 = '<cdata attr="foo">'; my $root2 = '<bar/>'; my $cdatal = '<![CDATA['; my $test = 'bar &lt; <&> &gt; <span><br/></span> bar'; my $cdatar = ']]>'; my $root3 = '</cdata>'; 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 = '<root><foo bar="hoge" /></root>'; 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"; <root> <zero>AAA</zero> <one>CCC</one> <two>DDD</two><two>EEE</two> <three/><three/><three/> </root> 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"; <root> <one aaa="1"></one> <two bbb="2"></two><two ccc=""></two> <three ddd="4"/><three eee="5"/><three fff="6"></three> </root> 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"; <root> <one>1</one> <two><three>3</three></two> </root> 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 = '<root><text><>&><</text><cdata><![CDATA[<>&><]]></cdata><attr key="<>&><">BBB</attr></root>'; 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{ <text>\s* <>&>< \s*</text> }sx, "write text node" ); like( $back, qr{ <cdata><!\[CDATA\[<>&><\]\]></cdata> }sx, "write cdata node (as cdata)" ); like( $back, qr{ <attr\s+key="<>&><" }sx, "write attribute" ); # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������XML-TreePP-0.43/t/12_escape_charref.t���������������������������������������������������������������000755 �000765 �000024 �00000007217 12236676324 017522� 0����������������������������������������������������������������������������������������������������ustar�00u-suke��������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������# ---------------------------------------------------------------- use strict; use Test::More tests => 23; BEGIN { use_ok('XML::TreePP') }; # ---------------------------------------------------------------- my $tpp = XML::TreePP->new(); my $source = '<root> <t1_zero>��</t1_zero> <t2_ctrl></t2_ctrl> <t3_tab_esc>[ ]</t3_tab_esc> <t3_tab_raw>'."[\x09\x09]".'</t3_tab_raw> <t4_lf_esc>[ ]</t4_lf_esc> <t4_lf_raw>'."[\x0A\x0A]".'</t4_lf_raw> <t5_cr_esc>[ ]</t5_cr_esc> <t5_cr_raw>'."[\x0D\x0D]".'</t5_cr_raw> <t6_space> </t6_space> <t7_ascii>!!</t7_ascii> <t8_latin>€ÿ€ÿ</t8_latin> <t9_kanji>漢漢</t9_kanji> </root>'; # ---------------------------------------------------------------- my $tree = $tpp->parse( $source ); # control chars are escaped/unescaped. is( $tree->{root}->{t1_zero}, "\x00\x00", "parse: t1_zero" ); is( $tree->{root}->{t2_ctrl}, "\x01\x1F\x01\x1F", "parse: t2_ctrl" ); # TAB,CR,LF are not unescaped but escaped. is( $tree->{root}->{t3_tab_esc}, "[\x09\x09]", "parse: t3_tab_esc" ); is( $tree->{root}->{t3_tab_raw}, "[\x09\x09]", "parse: t3_tab_raw" ); is( $tree->{root}->{t4_lf_esc}, "[\x0A\x0A]", "parse: t4_lf_esc" ); is( $tree->{root}->{t4_lf_raw}, "[\x0A\x0A]", "parse: t4_lf_raw" ); is( $tree->{root}->{t5_cr_esc}, "[\x0D\x0D]", "parse: t5_cr_esc" ); is( $tree->{root}->{t5_cr_raw}, "[\x0D\x0D]", "parse: t5_cr_raw" ); # ascii/latin chars are escaped/unescaped. is( $tree->{root}->{t6_space}, "\x20\x20", "parse: t6_space" ); is( $tree->{root}->{t7_ascii}, "\x21\x7F\x21\x7F", "parse: t7_ascii" ); # XML::TreePP 0.37 ignores between U+0080 and U+00FF without xml_deref # my $u80 = "\xC2\x80"; # is UTF-8 of "\x80" # my $uFF = "\xC3\xBF"; # is UTF-8 of "\xFF" # is( $tree->{root}->{t8_latin}, "$u80$uFF$u80$uFF", "parse: t8_latin" ); # CJK > 0xFF are not escaped/unescaped. is( $tree->{root}->{t9_kanji}, "漢漢", "parse: t9_kanji" ); # ---------------------------------------------------------------- my $back = $tpp->write( $tree ); # control chars are escaped/unescaped. like( $back, qr/ <t1_zero> �� < /x, "write: t1_zero" ); like( $back, qr/ <t2_ctrl>  < /x, "write: t2_ctrl" ); # TAB,CR,LF are not unescaped but escaped. like( $back, qr/ <t3_tab_esc> \[\x09\x09\] < /x, "write: t3_tab_esc" ); like( $back, qr/ <t3_tab_raw> \[\x09\x09\] < /x, "write: t3_tab_raw" ); like( $back, qr/ <t4_lf_esc> \[\x0A\x0A\] < /x, "write: t4_lf_esc" ); like( $back, qr/ <t4_lf_raw> \[\x0A\x0A\] < /x, "write: t4_lf_raw" ); like( $back, qr/ <t5_cr_esc> \[\x0D\x0D\] < /x, "write: t5_cr_esc" ); like( $back, qr/ <t5_cr_raw> \[\x0D\x0D\] < /x, "write: t5_cr_raw" ); # ascii/latin chars are escaped/unescaped. like( $back, qr/ <t6_space> \x20\x20 < /x, "write: t6_space" ); like( $back, qr/ <t7_ascii> !! < /x, "write: t7_ascii" ); # XML::TreePP 0.37 ignores between U+0080 and U+00FF without xml_deref # like( $back, qr/ <t8_latin> $u80$uFF$u80$uFF < /x, "write: t8_latin" ); # CJK > 0xFF are not escaped/unescaped. like( $back, qr/ <t9_kanji> 漢漢 < /x, "write: t9_kanji" ); # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������XML-TreePP-0.43/t/13_encoding_en.t������������������������������������������������������������������000755 �000765 �000024 �00000002362 12236676324 017035� 0����������������������������������������������������������������������������������������������������ustar�00u-suke��������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������# ---------------------------------------------------------------- use strict; use Test::More tests => 15; BEGIN { use_ok('XML::TreePP') }; # ---------------------------------------------------------------- my $FILES = [qw( t/example/hello-en-utf8.xml t/example/hello-en-nodecl.xml t/example/hello-en-noenc.xml t/example/hello-en-latin1.xml t/example/hello-en-utf8-bom.xml t/example/hello-en-nodecl-bom.xml t/example/hello-en-noenc-bom.xml )]; &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, "same ".$file ); } else { like( $tree->{root}->{text}, qr/^Hello, World\!\s\S{4}/, "first ".$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.43/t/14_encoding_zh.t������������������������������������������������������������������000755 �000765 �000024 �00000002233 12236676324 017052� 0����������������������������������������������������������������������������������������������������ustar�00u-suke��������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������# ---------------------------------------------------------------- use strict; use Test::More tests => 7; # ---------------------------------------------------------------- my $FILES = [qw( t/example/hello-zh-utf8.xml t/example/hello-zh-big5.xml t/example/hello-zh-gb2312.xml )]; # ---------------------------------------------------------------- SKIP: { skip( "Perl $]", 7 ) 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.43/t/15_encoding_ja.t������������������������������������������������������������������000755 �000765 �000024 �00000002461 12236676324 017027� 0����������������������������������������������������������������������������������������������������ustar�00u-suke��������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������# ---------------------------------------------------------------- use strict; use Test::More tests => 7; # ---------------------------------------------------------------- my $FILES = [qw( t/example/hello-ja-utf8.xml t/example/hello-ja-sjis.xml t/example/hello-ja-euc.xml )]; # ---------------------------------------------------------------- SKIP: { if ( $] < 5.008 ) { eval { require Jcode; } unless defined $Jcode::VERSION; if ( ! defined $Jcode::VERSION ) { skip( "Jcode.pm is not loaded.", 7 ); } } 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.43/t/16_encoding_ko.t������������������������������������������������������������������000755 �000765 �000024 �00000002164 12236676324 017047� 0����������������������������������������������������������������������������������������������������ustar�00u-suke��������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������# ---------------------------------------------------------------- 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.43/t/17_output_encoding.t��������������������������������������������������������������000755 �000765 �000024 �00000004700 12236676324 017775� 0����������������������������������������������������������������������������������������������������ustar�00u-suke��������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������# ---------------------------------------------------------------- use strict; use Test::More tests => 43; BEGIN { use_ok('XML::TreePP') }; # ---------------------------------------------------------------- my $DIVISION_SIGN = { 'Shift_JIS' => "\x81\x80", 'EUC-JP' => "\xA1\xE0", 'GB2312' => "\xA1\xC2", 'EUC-KR' => "\xA1\xC0", 'BIG5' => "\xA1\xD2", 'UTF-8' => "\xC3\xB7", 'Latin-1' => "\xF7", }; my $PLUSMINUS_SIGN = { 'Shift_JIS' => "\x81\x7D", 'EUC-JP' => "\xA1\xDE", 'GB2312' => "\xA1\xC0", 'EUC-KR' => "\xA1\xBE", 'BIG5' => "\xA1\xD3", 'UTF-8' => "\xC2\xB1", 'Latin-1' => "\xB1", }; # ---------------------------------------------------------------- SKIP: { &test_main('UTF-8'); if ( $] < 5.008 ) { eval { require Jcode; } unless defined $Jcode::VERSION; if ( ! defined $Jcode::VERSION ) { skip( "Jcode.pm is not loaded.", 36 ); } } &test_main('Shift_JIS'); &test_main('EUC-JP'); skip( "Perl $]", 24 ) if ( $] < 5.008 ); &test_main('Latin-1'); &test_main('EUC-KR'); &test_main('GB2312'); &test_main('BIG5'); } # ---------------------------------------------------------------- sub test_main { my $code = shift; my $tpp = XML::TreePP->new(); my $tree = { root => { division => $DIVISION_SIGN->{'UTF-8'}, plusminus => $PLUSMINUS_SIGN->{'UTF-8'}, }, }; my $xml1 = $tpp->write( $tree, $code ); $tpp->set( output_encoding => $code ); my $xml2 = $tpp->write( $tree ); like( $xml1, qr/^\s*<\?xml[^<>]+encoding="\Q$code\E"/is, "encoding $code 1" ); like( $xml2, qr/^\s*<\?xml[^<>]+encoding="\Q$code\E"/is, "encoding $code 2" ); my $div1 = ( $xml1 =~ m/<division>([^<>]+)</ )[0]; my $div2 = ( $xml2 =~ m/<division>([^<>]+)</ )[0]; is( $div1, $DIVISION_SIGN->{$code}, "division $code 1" ); is( $div2, $DIVISION_SIGN->{$code}, "division $code 2" ); my $plm1 = ( $xml1 =~ m/<plusminus>([^<>]+)</ )[0]; my $plm2 = ( $xml2 =~ m/<plusminus>([^<>]+)</ )[0]; is( $plm1, $PLUSMINUS_SIGN->{$code}, "plusminus $code 1" ); is( $plm2, $PLUSMINUS_SIGN->{$code}, "plusminus $code 2" ); } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- ����������������������������������������������������������������XML-TreePP-0.43/t/18_escape_amp.t�������������������������������������������������������������������000755 �000765 �000024 �00000003502 12236676324 016664� 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 $space0 = ' '; my $space1 = ' '; my $entref0 = '&quot;&apos;&lt;&gt;&amp;'; my $entref1 = '"'<>&'; my $charref0 = "\x21\x22"; my $charref1 = '!"'; my $invalid0 = '&#32&#x20&#foo;&#ZZ&#&32;&x20;&bar'; my $invalid1 = ' &#foo;&#ZZ&#&32;&x20;&bar'; my $tree = { root => { space => $space1, entref => $entref1, charref => $charref1, invalid => $invalid1, }, }; my $write = $tpp->write( $tree ); my $space2 = ( $write =~ m#<space>(.*)</space># )[0]; # through is( $space2, $space1, 'write space' ); my $entref2 = ( $write =~ m#<entref>(.*)</entref># )[0]; # escaped is( $entref2, $entref0, 'write entref' ); my $charref2 = ( $write =~ m#<charref>(.*)</charref># )[0]; # through is( $charref2, $charref1, 'write charref' ); my $invalid2 = ( $write =~ m#<invalid>(.*)</invalid># )[0]; # escaped is( $invalid2, $invalid0, 'write invalid' ); my $parse = $tpp->parse( $write ); is( $parse->{root}->{space}, $space0, 'write space' ); # unescaped is( $parse->{root}->{entref}, $entref1, 'write entref' ); # unescaped is( $parse->{root}->{charref}, $charref0, 'write charref' ); # unescaped is( $parse->{root}->{invalid}, $invalid1, 'write invalid' ); # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������XML-TreePP-0.43/t/19_multi_text.t�������������������������������������������������������������������000755 �000765 �000024 �00000007453 12236676324 016777� 0����������������������������������������������������������������������������������������������������ustar�00u-suke��������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������# ---------------------------------------------------------------- use strict; use Test::More tests => 41; BEGIN { use_ok('XML::TreePP') }; # ---------------------------------------------------------------- my $xml1 = '<root><text>aaa<child attr="bar"/>bbb</text></root>'; my $xml2 = '<root><text attr="foo">ccc<child attr="bar"/>ddd</text></root>'; my $xml3 = '<root><text><![CDATA[eee]]><child attr="bar"/><![CDATA[fff]]></text></root>'; my $xml4 = '<root><text attr="foo"><![CDATA[ggg]]><child attr="bar"/><![CDATA[hhh]]></text></root>'; my $xml5 = '<root><text><![CDATA[iii]]>jjj<![CDATA[kkk]]></text></root>'; my $xml6 = '<root><text>lll<![CDATA[mmm]]>nnn</text></root>'; my $tpp = XML::TreePP->new(); foreach my $cdata ( 1, 0 ) { $tpp->set( cdata_scalar_ref => $cdata ); $tpp->set( multi_text_nodes => 0 ); my $tree1 = $tpp->parse( $xml1 ); my $tree2 = $tpp->parse( $xml2 ); my $tree3 = $tpp->parse( $xml3 ); my $tree4 = $tpp->parse( $xml4 ); my $tree5 = $tpp->parse( $xml5 ); my $tree6 = $tpp->parse( $xml6 ); ok( ! ref $tree1->{root}{text}{'#text'}, '1 parse' ); ok( ! ref $tree2->{root}{text}{'#text'}, '2 parse' ); if ( $cdata ) { is( ref $tree3->{root}{text}{'#text'}, 'SCALAR', '3 parse cdata' ); is( ref $tree4->{root}{text}{'#text'}, 'SCALAR', '4 parse cdata' ); is( ref $tree5->{root}{text}, 'SCALAR', '5 parse cdata' ); is( ref $tree6->{root}{text}, 'SCALAR', '6 parse cdata' ); } else { ok( ! ref $tree3->{root}{text}{'#text'}, '3 parse' ); ok( ! ref $tree4->{root}{text}{'#text'}, '4 parse' ); ok( ! ref $tree5->{root}{text}, '5 parse' ); ok( ! ref $tree6->{root}{text}, '6 parse' ); } is( $tree1->{root}{text}{'#text'}, 'aaabbb', '1 aaa-bbb' ); is( $tree2->{root}{text}{'#text'}, 'cccddd', '2 ccc-ddd' ); if ( $cdata ) { is( ref $tree3->{root}{text}{'#text'}, 'SCALAR', '3 eee-fff ref' ); is( ref $tree4->{root}{text}{'#text'}, 'SCALAR', '4 ggg-hhh ref' ); is( ref $tree5->{root}{text}, 'SCALAR', '5 iii-jjj-kkk ref' ); is( ref $tree6->{root}{text}, 'SCALAR', '6 lll-mmm-nnn ref' ); is( ${$tree3->{root}{text}{'#text'}}, 'eeefff', '3 eee-fff cdata' ); is( ${$tree4->{root}{text}{'#text'}}, 'ggghhh', '4 ggg-hhh cdata' ); is( ${$tree5->{root}{text}}, 'iiijjjkkk', '5 iii-jjj-kkk cdata' ); is( ${$tree6->{root}{text}}, 'lllmmmnnn', '6 lll-mmm-nnn cdata' ); } else { is( $tree3->{root}{text}{'#text'}, 'eeefff', '3 eee-fff' ); is( $tree4->{root}{text}{'#text'}, 'ggghhh', '4 ggg-hhh' ); is( $tree5->{root}{text}, 'iiijjjkkk', '5 iii-jjj-kkk' ); is( $tree6->{root}{text}, 'lllmmmnnn', '6 lll-mmm-nnn' ); } my $write1 = $tpp->write( $tree1 ); my $write2 = $tpp->write( $tree2 ); my $write3 = $tpp->write( $tree3 ); my $write4 = $tpp->write( $tree4 ); my $write5 = $tpp->write( $tree5 ); my $write6 = $tpp->write( $tree6 ); like( $write1, qr/>aaabbb</s, '1 back' ); like( $write2, qr/>cccddd</s, '2 back' ); if ( $cdata ) { like( $write3, qr/<!\[CDATA\[eeefff\]\]>/s, '3 write cdata' ); like( $write4, qr/<!\[CDATA\[ggghhh\]\]>/s, '4 write cdata' ); like( $write5, qr/<!\[CDATA\[iiijjjkkk\]\]>/s, '5 write cdata' ); like( $write6, qr/<!\[CDATA\[lllmmmnnn\]\]>/s, '6 write cdata' ); } else { like( $write3, qr/>eeefff</s, '3 write' ); like( $write4, qr/>ggghhh</s, '4 write' ); like( $write5, qr/>iiijjjkkk</s, '5 write' ); like( $write6, qr/>lllmmmnnn</s, '6 write' ); } } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������XML-TreePP-0.43/t/20_http-lite-cached.t�������������������������������������������������������������000755 �000765 �000024 �00000002604 12236676324 017701� 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 this.'; } plan tests => 7; use_ok('XML::TreePP'); my $tpp = XML::TreePP->new(); my $name = ( $0 =~ m#([^/:\\]+)$# )[0]; $tpp->set( user_agent => "$name " ); &test_http_post( $tpp, $name ); # use HTTP::Lite eval { require LWP::UserAgent; }; &test_http_post( $tpp, $name ); # use HTTP::Lite again not LWP::UserAgent } # ---------------------------------------------------------------- sub test_http_post { my $tpp = shift; my $name = shift; my $url = "http://www.kawa.net/works/perl/treepp/example/envxml.cgi"; my( $tree, $xml ) = $tpp->parsehttp( POST => $url, '' ); ok( ref $tree, $url ); my $agent = $tree->{env}->{HTTP_USER_AGENT}; unlike( $agent, qr/libwww-perl/, $agent ); like( $agent, qr/^\Q$name\E/, "User-Agent has '$name'" ); } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- ����������������������������������������������������������������������������������������������������������������������������XML-TreePP-0.43/t/21_http-lwp-cached.t��������������������������������������������������������������000755 �000765 �000024 �00000002624 12236676324 017551� 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 this.'; } plan tests => 7; use_ok('XML::TreePP'); my $tpp = XML::TreePP->new(); my $name = ( $0 =~ m#([^/:\\]+)$# )[0]; $tpp->set( user_agent => "$name " ); &test_http_post( $tpp, $name ); # use LWP::UserAgent eval { require HTTP::Lite; }; &test_http_post( $tpp, $name ); # use LWP::UserAgent again not HTTP::Lite } # ---------------------------------------------------------------- sub test_http_post { my $tpp = shift; my $name = shift; my $url = "http://www.kawa.net/works/perl/treepp/example/envxml.cgi"; my( $tree, $xml ) = $tpp->parsehttp( POST => $url, '' ); ok( ref $tree, $url ); my $agent = $tree->{env}->{HTTP_USER_AGENT}; like( $agent, qr/libwww-perl/, "$agent" ); like( $agent, qr/^\Q$name\E/, "User-Agent has '$name'" ); } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- ������������������������������������������������������������������������������������������������������������XML-TreePP-0.43/t/22_http-lite-headers.t������������������������������������������������������������000755 �000765 �000024 �00000003237 12236676324 020112� 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 this.'; } plan tests => 6; use_ok('XML::TreePP'); my $tpp = XML::TreePP->new(); my $name = ( $0 =~ m#([^/:\\]+)$# )[0]; $tpp->set( user_agent => "$name " ); my $url = "http://www.kawa.net/works/perl/treepp/example/envxml.cgi"; my $tree1 = $tpp->parsehttp( POST => $url, '' ); ok( ref $tree1, "POST 1 $url" ); is( $tree1->{env}->{CONTENT_TYPE}, 'application/x-www-form-urlencoded', 'Content-Type (1) default' ); my $body = 'Hello, World!'; my $head2 = { Hoge => 'Pomu' }; my $tree2 = $tpp->parsehttp( POST => $url, $body, $head2 ); ok( ref $tree2, "POST 2" ); is( $tree2->{env}->{CONTENT_TYPE}, 'application/x-www-form-urlencoded', 'Content-Type (2) default' ); is( $tree2->{env}->{HTTP_HOGE}, 'Pomu', "Original Header" ); # HTTP::Lite ignores Content-Type header. # my $head3 = { # 'Content-Type' => 'text/plain', # }; # my $tree3 = $tpp->parsehttp( POST => $url, $body, $head3 ); # ok( ref $tree3, "POST 3" ); # is( $tree3->{env}->{CONTENT_TYPE}, 'text/plain', 'Content-Type (3) change' ); } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������XML-TreePP-0.43/t/23_http-lwp-headers.t�������������������������������������������������������������000755 �000765 �000024 �00000003204 12236676324 017752� 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 this.'; } plan tests => 8; use_ok('XML::TreePP'); my $tpp = XML::TreePP->new(); my $name = ( $0 =~ m#([^/:\\]+)$# )[0]; $tpp->set( user_agent => "$name " ); my $url = "http://www.kawa.net/works/perl/treepp/example/envxml.cgi"; my $tree1 = $tpp->parsehttp( POST => $url, '' ); ok( ref $tree1, "POST 1 $url" ); is( $tree1->{env}->{CONTENT_TYPE}, 'application/x-www-form-urlencoded', 'Content-Type (1) default' ); my $body = 'Hello, World!'; my $head2 = { Hoge => 'Pomu', }; my $tree2 = $tpp->parsehttp( POST => $url, $body, $head2 ); ok( ref $tree2, "POST 2" ); is( $tree2->{env}->{CONTENT_TYPE}, 'application/x-www-form-urlencoded', 'Content-Type (2) default' ); is( $tree2->{env}->{HTTP_HOGE}, 'Pomu', "Original Header" ); my $head3 = { 'Content-Type' => 'text/plain', }; my $tree3 = $tpp->parsehttp( POST => $url, $body, $head3 ); ok( ref $tree3, "POST 3" ); is( $tree3->{env}->{CONTENT_TYPE}, 'text/plain', 'Content-Type (3) change' ); } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������XML-TreePP-0.43/t/24_ignore_error.t�����������������������������������������������������������������000755 �000765 �000024 �00000001452 12236676324 017262� 0����������������������������������������������������������������������������������������������������ustar�00u-suke��������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������ 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 = '<root><not_closed></invalid></root>'; 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.43/t/25_text_node_key.t����������������������������������������������������������������000755 �000765 �000024 �00000002261 12236676324 017427� 0����������������������������������������������������������������������������������������������������ustar�00u-suke��������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������# 25_text_noe_key.t use strict; use Test::More tests => 13; BEGIN { use_ok('XML::TreePP') }; my $tpp = XML::TreePP->new(); $tpp->set( cdata_scalar_ref => 1 ); my $hello = 'Hello, World!'; my $tnode_keys = [ '#text', '_content', '0' ]; foreach my $tkey ( @$tnode_keys ) { my $rand = int(rand() * 9000 + 1000); my $text = "$hello $rand $tkey"; my $tree = { root => { text => { -attr => $text, $tkey => $text, }, cdata => { -attr => $text, $tkey => \$text, }, } }; $tpp->set( text_node_key => $tkey ); my $write = $tpp->write( $tree ); # print STDERR $write; my $back = $tpp->parse( $write ); is( $back->{root}->{text}->{-attr}, $text, "attribute1 for $tkey" ); is( $back->{root}->{text}->{$tkey}, $text, "text node for $tkey" ); is( $back->{root}->{cdata}->{-attr}, $text, "attribute2 for $tkey" ); my $ref = $back->{root}->{cdata}->{$tkey}; is( $$ref, $text, "cdata node for $tkey (content)" ) if ref $ref; is( $text, 'SCALAR(0x...)', "cdata node for $tkey (ref)" ) unless ref $ref; } 1; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������XML-TreePP-0.43/t/26_attr_prefix_null.t�������������������������������������������������������������000755 �000765 �000024 �00000001626 12236676324 020154� 0����������������������������������������������������������������������������������������������������ustar�00u-suke��������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������# 26_attr_prefix_null.t.t use strict; use Test::More tests => 6; BEGIN { use_ok('XML::TreePP') }; my $tpp = XML::TreePP->new(); $tpp->set( attr_prefix => '' ); my $source = '<root><foo bar="hoge"/></root>'; my $expect = '<root><foo><bar>hoge</bar></foo></root>'; my $parse1 = $tpp->parse( $source ); is( $parse1->{root}->{foo}->{bar}, 'hoge', 'parse 1' ); my $write1 = $tpp->write( $parse1 ); $write1 =~ s/\s+//sg; $write1 =~ s/<\?.*?\?>//s; is( $write1, $expect, 'write 1' ); my $tree1 = { root => { foo => { '@attr' => 'atmark', '-attr' => 'minus', 'attr' => 'null', }, }, }; my $write2 = $tpp->write( $tree1 ); my $parse2 = $tpp->parse( $write2 ); is( $parse2->{root}->{foo}->{'@attr'}, 'atmark', 'write 2' ); is( $parse2->{root}->{foo}->{'-attr'}, 'minus', 'write 3' ); is( $parse2->{root}->{foo}->{'attr'}, 'null', 'write 4' ); 1; ����������������������������������������������������������������������������������������������������������XML-TreePP-0.43/t/27_http-lite-force.t��������������������������������������������������������������000755 �000765 �000024 �00000004113 12236676324 017574� 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.'; } 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.43/t/28_http-lwp-force.t���������������������������������������������������������������000755 �000765 �000024 �00000005056 12236676324 017451� 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 ) { # ok } 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 this.'; } plan tests => 26; use_ok('XML::TreePP'); my $name = ( $0 =~ m#([^/:\\]+)$# )[0]; my $url = "http://www.kawa.net/works/perl/treepp/example/envxml.cgi"; my $query = time(); { my $tpp = XML::TreePP->new(); my $http = LWP::UserAgent->new(); ok( ref $http, 'LWP::UserAgent->new()' ); $tpp->set( lwp_useragent => $http ); &test_http_req( $tpp, 'libwww-perl', POST => $url, $query ); } { my $tpp = XML::TreePP->new(); my $http = LWP::UserAgent->new(); ok( ref $http, 'LWP::UserAgent->new()' ); $tpp->set( lwp_useragent => $http ); $http->agent( "$name " ); &test_http_req( $tpp, $name, POST => $url, $query ); } { my $tpp = XML::TreePP->new(); my $http = LWP::UserAgent->new(); ok( ref $http, 'LWP::UserAgent->new()' ); $tpp->set( user_agent => "$name " ); &test_http_req( $tpp, $name, POST => $url, $query ); } { my $tpp = XML::TreePP->new(); my $http = LWP::UserAgent->new(); ok( ref $http, 'LWP::UserAgent->new()' ); $tpp->set( user_agent => "$name " ); 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.43/t/29_http-lwp-withcache.t�����������������������������������������������������������000755 �000765 �000024 �00000003000 12236676324 020276� 0����������������������������������������������������������������������������������������������������ustar�00u-suke��������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������# ---------------------------------------------------------------- use strict; use Test::More; # ---------------------------------------------------------------- SKIP: { local $@; eval { require LWP::UserAgent::WithCache; } unless defined $LWP::UserAgent::WithCache::VERSION; if ( ! defined $LWP::UserAgent::WithCache::VERSION ) { plan skip_all => 'LWP::UserAgent::WithCache is not loaded.'; } if ( ! defined $ENV{MORE_TESTS} ) { plan skip_all => 'define $MORE_TESTS to test this.'; } plan tests => 6; use_ok('XML::TreePP'); my $http = LWP::UserAgent::WithCache->new(); ok( ref $http, 'LWP::UserAgent::WithCache' ); my $name = ( $0 =~ m#([^/:\\]+)$# )[0]; $http->agent( "$name " ); my $tpp = XML::TreePP->new(); $tpp->set( lwp_useragent => $http ); &test_http_post( $tpp, $name ); # use LWP::UserAgent::WithCache } # ---------------------------------------------------------------- sub test_http_post { my $tpp = shift; my $name = shift; my $url = "http://www.kawa.net/works/perl/treepp/example/envxml.cgi"; my( $tree, $xml ) = $tpp->parsehttp( POST => $url, '' ); ok( ref $tree, $url ); my $agent = $tree->{env}->{HTTP_USER_AGENT}; ok( $agent, "User-Agent: $agent" ); like( $agent, qr/libwww-perl/, "Test: libwww-perl" ); like( $agent, qr/\Q$name\E/, "Test: $name" ); } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- XML-TreePP-0.43/t/30_first_out.t��������������������������������������������������������������������000755 �000765 �000024 �00000002420 12236676324 016575� 0����������������������������������������������������������������������������������������������������ustar�00u-suke��������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������# ---------------------------------------------------------------- use strict; use Test::More tests => 3; BEGIN { use_ok('XML::TreePP') }; # ---------------------------------------------------------------- { my $tree = { root => { one => 1, two => 2, three => 3, four => 4, five => 5, six => 6, seven => 7, eight => 8, nine => 9, }, }; { my $tpp = XML::TreePP->new(); $tpp->set( first_out => [qw( one two three )] ); $tpp->set( last_out => [qw( seven eight nine )] ); my $xml = $tpp->write( $tree ); like( $xml, qr{<one>.*<two>.*<three>.*<five>.*<seven>.*<eight>.*<nine>}s, "1-2-3-*-5-*-7-8-9" ); } { my $tpp = XML::TreePP->new(); $tpp->set( first_out => [qw( seven eight nine )] ); $tpp->set( last_out => [qw( one two three )] ); my $xml = $tpp->write( $tree ); like( $xml, qr{<seven>.*<eight>.*<nine>.*<five>.*<one>.*<two>.*<three>}s, "7-8-9-*-5-*-1-2-3" ); } } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������XML-TreePP-0.43/t/31_tie_ixhash.t�������������������������������������������������������������������000755 �000765 �000024 �00000005726 12236676324 016721� 0����������������������������������������������������������������������������������������������������ustar�00u-suke��������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������# ---------------------------------------------------------------- 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"; <root> <one>1</one> <two>2</two> <three>3</three> <four>4</four> <five>5</five> <six>6</six> <seven>7</seven> <eight>8</eight> <nine>9</nine> </root> 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"; <root one="1" two="2" three="3" four="4" five="5"> <six>6</six> <seven>7</seven> <eight>8</eight> <nine>9</nine> </root> 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.43/t/32_base_class.t�������������������������������������������������������������������000755 �000765 �000024 �00000004130 12236676324 016660� 0����������������������������������������������������������������������������������������������������ustar�00u-suke��������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������# ---------------------------------------------------------------- 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"; <root> <one>1</one> <two attr="-2">2</two> <three> <four>4</four> <five> 5 <empty/> 5 </five> </three> <six><seven attr="-7">7</seven></six> <eight>8</eight> <eight><nine>9</nine></eight> <foo> <bar hoge="1"/> <bar pomu="2"/> </foo> </root> 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.43/t/33_indent.t�����������������������������������������������������������������������000755 �000765 �000024 �00000006242 12236676324 016051� 0����������������������������������������������������������������������������������������������������ustar�00u-suke��������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������# ---------------------------------------------------------------- use strict; use Test::More; # ---------------------------------------------------------------- { plan tests => 73; use_ok('XML::TreePP'); &test_indent( undef ); &test_indent( 1 ); &test_indent( 4 ); } # ---------------------------------------------------------------- sub test_indent { my $indent = shift; my $order = [qw( one two three four five six seven eight nine )]; my $tpp = XML::TreePP->new( first_out => $order, indent => $indent ); my $nine = '9'; my $tree = { root => { one => '1', two => { '#text' => '2', three => undef, }, four => [{ five => '5', six => { '#text' => '6', }, }, { seven => { '#text' => '7', -eight => '8', }, }], nine => \$nine, }, }; my $xml = $tpp->write( $tree ); my $space = $indent ? '\040' x $indent : ''; $indent ||= 0; like( $xml, qr{ <one>1</one> }x, "[$indent] text node" ); like( $xml, qr{ <two><three }x, "[$indent] child node" ); like( $xml, qr{ />2</two> }x, "[$indent] text node after empty node" ); like( $xml, qr{ <six>6</six> }x, "[$indent] explicit text node" ); like( $xml, qr{ >7</seven> }x, "[$indent] text node after attribute" ); like( $xml, qr{ <nine><!\[CDATA\[9\]\]></nine> }x, "[$indent] cdata node" ); like( $xml, qr{ ^<root> }mx, "[$indent] no-indent root" ); like( $xml, qr{ ^$space<one> }mx, "[$indent] indent one" ); like( $xml, qr{ ^$space<two> }mx, "[$indent] indent two" ); like( $xml, qr{ ^$space<four> }mx, "[$indent] indent four" ); like( $xml, qr{ ^$space</four> }mx, "[$indent] indent four end" ); like( $xml, qr{ ^$space$space<five> }mx, "[$indent] indent five" ); like( $xml, qr{ ^$space$space<six> }mx, "[$indent] indent six" ); like( $xml, qr{ ^$space$space<seven }mx, "[$indent] indent seven" ); like( $xml, qr{ ^$space<nine> }mx, "[$indent] indent nine" ); like( $xml, qr{ ^</root> }mx, "[$indent] no-indent root end" ); like( $xml, qr{ <root>\n }x, "[$indent] line root" ); like( $xml, qr{ </one>\n }x, "[$indent] line one" ); like( $xml, qr{ </two>\n }x, "[$indent] line two" ); like( $xml, qr{ </five>\n }x, "[$indent] line five" ); like( $xml, qr{ </six>\n }x, "[$indent] line six" ); like( $xml, qr{ </four>\n }x, "[$indent] line four" ); like( $xml, qr{ </nine>\n }x, "[$indent] line nine" ); like( $xml, qr{ </root>\n }x, "[$indent] line root" ); } # ---------------------------------------------------------------- =example <root> <one>1</one> <two><three />2</two> <four> <five>5</five> <six>6</six> </four> <four> <seven eight="8">7</seven> </four> <nine><![CDATA[9]]></nine> </root> =cut # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������XML-TreePP-0.43/t/34_utf8_flag.t��������������������������������������������������������������������000755 �000765 �000024 �00000012713 12236676324 016450� 0����������������������������������������������������������������������������������������������������ustar�00u-suke��������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������# ---------------------------------------------------------------- # this test script is written in utf8 but does not "use utf8" for 5.005-compatibility # ---------------------------------------------------------------- use strict; use Test::More; # ---------------------------------------------------------------- { local $@; eval { require 5.008001; }; plan skip_all => 'Perl 5.8.1 is required.' if $@; } # ---------------------------------------------------------------- { plan tests => 66; use_ok('XML::TreePP'); &test_utf8(); } # ---------------------------------------------------------------- sub test_utf8 { my $octxml = <<"EOT"; <root> <one>一</one> <two>二2</two> <three>三3参</three> <four>四4Ⅳⅳ</four> <five>5</five> <six>±6÷6</six> </root> EOT my $strxml = $octxml; utf8::decode( $strxml ); my $strtpp = XML::TreePP->new( utf8_flag => 1 ); my $octtpp = XML::TreePP->new(); ok( ! utf8::is_utf8($octxml), '[source] XML: octets' ); ok( utf8::is_utf8($strxml), '[source] XML: string' ); my $treeA = $strtpp->parse( $octxml ); my $treeB = $strtpp->parse( $strxml ); my $treeC = $octtpp->parse( $octxml ); my $treeD = $octtpp->parse( $strxml ); ok( ! utf8::is_utf8($octxml), "[source] XML: octets (no damaged)" ); ok( utf8::is_utf8($strxml), "[source] XML: string (no damaged)" ); &check_string( 'A', $treeA ); &check_string( 'B', $treeB ); &check_octest( 'C', $treeC ); &check_string( 'D', $treeD ); &check_same( 'A-B', $treeA, $treeB ); &check_same( 'B-D', $treeB, $treeB ); &check_diff( 'A-C', $treeA, $treeC ); foreach my $hash ( $treeA, $treeB, $treeD ) { my $root = $hash->{root}; foreach my $key ( sort keys %$root ) { ok( utf8::is_utf8($root->{$key}), 'XML: string '.$key ); } } foreach my $hash ( $treeC ) { my $root = $hash->{root}; foreach my $key ( sort keys %$root ) { ok( ! utf8::is_utf8($root->{$key}), 'XML: octets '.$key ); } } my $xmlH = $octtpp->write( $treeC ); my $xmlE = $strtpp->write( $treeA ); my $xmlF = $strtpp->write( $treeB ); my $xmlG = $octtpp->write( $treeD ); ok( utf8::is_utf8($xmlE), '[E] XML: string' ); ok( utf8::is_utf8($xmlF), '[F] XML: string' ); ok( utf8::is_utf8($xmlG), '[G] XML: string' ); ok( ! utf8::is_utf8($xmlH), '[H] XML: octets' ); } # ---------------------------------------------------------------- sub check_string { my $name = shift; my $tree = shift; my $oct1 = '一'; my $oct2 = "二2"; my $str2 = $oct2; utf8::decode( $str2 ); my $four = $tree->{root}->{four}; ok( utf8::is_utf8($four), "[$name] 4: string" ); my $five = $tree->{root}->{five}; ok( utf8::is_utf8($five), "[$name] 5: string" ); my $six = $tree->{root}->{six}; ok( utf8::is_utf8($six), "[$name] 6: string" ); my $one = "".$tree->{root}->{one}; isnt( $one, $oct1, "[$name] 1: string != octets" ); utf8::encode( $one ); is( $one, $oct1, "[$name] 2: octets == octets" ); my $two = "".$tree->{root}->{two}; isnt( $two, $oct2, "[$name] 3: string != octets" ); is( $two, $str2, "[$name] 4: string == string" ); } # ---------------------------------------------------------------- sub check_octest { my $name = shift; my $tree = shift; my $oct1 = '一'; my $oct2 = "二2"; my $str2 = $oct2; utf8::decode( $str2 ); my $four = $tree->{root}->{four}; ok( ! utf8::is_utf8($four), "[$name] 4: octets" ); my $five = $tree->{root}->{five}; ok( ! utf8::is_utf8($five), "[$name] 5: octets" ); my $six = $tree->{root}->{six}; ok( ! utf8::is_utf8($six), "[$name] 6: octets" ); my $one = $tree->{root}->{one}; is( $one, $oct1, "[$name] 1: octets == octets" ); my $two = "".$tree->{root}->{two}; isnt( $two, $str2, "[$name] 2: octets != string" ); utf8::decode( $two ); is( $two, $str2, "[$name] 2: string == string" ); } # ---------------------------------------------------------------- sub check_same { my $name = shift; my $tree1 = shift; my $tree2 = shift; my $three1 = $tree1->{root}->{three}; my $three2 = $tree2->{root}->{three}; is( $three1, $three2, "[$name] 4: same" ); # octets' latin-1 and string's latin-1 are equal # my $five1 = $tree1->{root}->{five}; # my $five2 = $tree2->{root}->{five}; # is( $five1, $five2, "[$name] 5: same" ); my $six1 = $tree1->{root}->{six}; my $six2 = $tree2->{root}->{six}; is( $six1, $six2, "[$name] 6: same" ); } # ---------------------------------------------------------------- sub check_diff { my $name = shift; my $tree1 = shift; my $tree2 = shift; my $three1 = $tree1->{root}->{three}; my $three2 = $tree2->{root}->{three}; isnt( $three1, $three2, "[$name] 4: diff" ); # octets' latin-1 and string's latin-1 are equal # my $five1 = $tree1->{root}->{five}; # my $five2 = $tree2->{root}->{five}; # isnt( $five1, $five2, "[$name] 5: diff" ); my $six1 = $tree1->{root}->{six}; my $six2 = $tree2->{root}->{six}; isnt( $six1, $six2, "[$name] 6: diff" ); } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- �����������������������������������������������������XML-TreePP-0.43/t/35_force_hash.t�������������������������������������������������������������������000755 �000765 �000024 �00000004464 12236676324 016677� 0����������������������������������������������������������������������������������������������������ustar�00u-suke��������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������# ---------------------------------------------------------------- use strict; use Test::More tests => 23; BEGIN { use_ok('XML::TreePP') }; # ---------------------------------------------------------------- my $source = <<"EOT"; <root> <zero>ZZZ</zero> <one>AAA</one> <two>BBB</two><two attr="CCC"></two> <three attr="DDD">EEE</three><three></three><three/> </root> EOT # ---------------------------------------------------------------- { my $tpp = XML::TreePP->new( force_hash => [qw( one two three )] ); my $tree = $tpp->parse( $source ); ok( ! ref $tree->{root}->{zero}, "A: zero" ); ok( ref $tree->{root}->{one}, "A: one" ); ok( ref $tree->{root}->{two}->[0], "A: two with text node" ); ok( ref $tree->{root}->{two}->[1], "A: two with attribute" ); ok( ref $tree->{root}->{three}->[0], "A: three with both text node and attribute" ); ok( ref $tree->{root}->{three}->[1], "A: three empty node 1" ); ok( ref $tree->{root}->{three}->[2], "A: three empty node 2" ); is( $tree->{root}->{zero}, 'ZZZ', "A: ZZZ" ); is( $tree->{root}->{one}->{'#text'}, 'AAA', "A: AAA" ); is( $tree->{root}->{two}->[0]->{'#text'}, 'BBB', "A: BBB" ); is( $tree->{root}->{three}->[0]->{'#text'}, 'EEE', "A: EEE" ); } # ---------------------------------------------------------------- { my $tpp = XML::TreePP->new( force_hash => '*' ); my $tree = $tpp->parse( $source ); ok( ref $tree->{root}->{zero}, "B: zero" ); ok( ref $tree->{root}->{one}, "B: one" ); ok( ref $tree->{root}->{two}->[0], "B: two with text node" ); ok( ref $tree->{root}->{two}->[1], "B: two with attribute" ); ok( ref $tree->{root}->{three}->[0], "B: three with both text node and attribute" ); ok( ref $tree->{root}->{three}->[1], "B: three empty node 1" ); ok( ref $tree->{root}->{three}->[2], "B: three empty node 2" ); is( $tree->{root}->{zero}->{'#text'}, 'ZZZ', "B: ZZZ" ); is( $tree->{root}->{one}->{'#text'}, 'AAA', "B: AAA" ); is( $tree->{root}->{two}->[0]->{'#text'}, 'BBB', "B: BBB" ); is( $tree->{root}->{three}->[0]->{'#text'}, 'EEE', "B: EEE" ); } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������XML-TreePP-0.43/t/36_elem_class.t�������������������������������������������������������������������000755 �000765 �000024 �00000003776 12236676324 016713� 0����������������������������������������������������������������������������������������������������ustar�00u-suke��������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������# ---------------------------------------------------------------- use strict; use Test::More; # ---------------------------------------------------------------- { plan tests => 14; use_ok('XML::TreePP'); &test_elem_class( force_array => [qw( six )], elem_class => 'Element' ); } # ---------------------------------------------------------------- sub test_elem_class { my $tpp = XML::TreePP->new(@_); my $xml = <<"EOT"; <root> <one>1</one> <two attr="-2">2</two> <three> <four>4</four> <five> 5 <empty/> 5 </five> </three> <six><seven attr="-7">7</seven></six> <eight>8</eight> <eight><nine>9</nine></eight> <foo> <bar hoge="1"/> <bar pomu="2"/> </foo> </root> EOT my $tree = $tpp->parse( $xml ); is( ref $tree, 'Element', '/root' ); is( ref $tree->{root}, 'Element::root', '/root' ); is( ref $tree->{root}->{two}, 'Element::two', '/root/two' ); is( ref $tree->{root}->{three}, 'Element::three', '/root/three' ); is( ref $tree->{root}->{three}->{five}, 'Element::five', '/root/three/five' ); is( ref $tree->{root}->{six}, 'ARRAY', '/root/six (ARRAY)' ); is( ref $tree->{root}->{six}->[0], 'Element::six', '/root/six' ); is( ref $tree->{root}->{six}->[0]->{seven}, 'Element::seven', '/root/six/seven' ); is( ref $tree->{root}->{eight}, 'ARRAY', '/root/eight (ARRAY)' ); is( ref $tree->{root}->{eight}->[1], 'Element::eight', '/root/eight' ); # 2007/08/07 added is( ref $tree->{root}->{foo}, 'Element::foo', '/root/foo' ); is( ref $tree->{root}->{foo}->{bar}, 'ARRAY', '/root/foo/bar (ARRAY)' ); is( ref $tree->{root}->{foo}->{bar}->[0], 'Element::bar', '/root/foo/bar' ); } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- ��XML-TreePP-0.43/t/37_undef.t������������������������������������������������������������������������000755 �000765 �000024 �00000002277 12236676324 015701� 0����������������������������������������������������������������������������������������������������ustar�00u-suke��������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������# ---------------------------------------------------------------- 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{<attr one="" two=""}, 'attr one two' ); like( $xml, qr{ <hash>\s*<three }xs, 'hash three' ); like( $xml, qr{ </three>\s*<four }xs, 'hash four' ); like( $xml, qr{ <empty><!\[CDATA\[ }xs, 'empty cdata' ); like( $xml, qr{ <undef><!\[CDATA\[ }xs, 'undef cdata' ); } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������XML-TreePP-0.43/t/38_cdata_cdsect.t�����������������������������������������������������������������000755 �000765 �000024 �00000005035 12236676324 017175� 0����������������������������������������������������������������������������������������������������ustar�00u-suke��������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������# ---------------------------------------------------------------- use strict; use Test::More tests => 161; BEGIN { use_ok('XML::TreePP') }; # ---------------------------------------------------------------- { my $test = { '<cdata><![CDATA[]]></cdata>' => '', '<cdata><![CDATA[]]]></cdata>' => ']', '<cdata><![CDATA[>]]></cdata>' => '>', '<cdata><![CDATA[]]]]></cdata>' => ']]', '<cdata><![CDATA[]]]><![CDATA[]]]></cdata>' => ']]', '<cdata><![CDATA[]>]]></cdata>' => ']>', '<cdata><![CDATA[]]]><![CDATA[>]]></cdata>' => ']>', '<cdata>]<![CDATA[]]]>></cdata>' => ']]>', '<cdata>]<![CDATA[]>]]></cdata>' => ']]>', '<cdata><![CDATA[]]]]>></cdata>' => ']]>', '<cdata><![CDATA[]]]]><![CDATA[>]]></cdata>' => ']]>', '<cdata><![CDATA[]]]><![CDATA[]>]]></cdata>' => ']]>', '<cdata>]<![CDATA[]]]><![CDATA[>]]></cdata>' => ']]>', '<cdata><![CDATA[]]]><![CDATA[]]]>></cdata>' => ']]>', '<cdata><![CDATA[]]]>]<![CDATA[>]]></cdata>' => ']]>', '<cdata><![CDATA[]]]><![CDATA[]]]><![CDATA[>]]></cdata>' => ']]>', '<cdata><![CDATA[]]]><![CDATA[]>]]]]><![CDATA[>]]></cdata>' => ']]>]]>', '<cdata><![CDATA[]]]><![CDATA[]>]]]><![CDATA[]>]]></cdata>' => ']]>]]>', '<cdata><![CDATA[]]]><![CDATA[]>]]><![CDATA[]]]]><![CDATA[>]]></cdata>' => ']]>]]>', '<cdata><![CDATA[]]]]><![CDATA[>]]><![CDATA[]]]><![CDATA[]>]]></cdata>' => ']]>]]>', }; &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->{cdata}, 'exists' ); my $cdata = $tree->{cdata}; $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->{cdata}; $cdat2 = $$cdat2 if ( ref $cdat2 eq 'SCALAR' ); is( $cdat2, $cdata, 'round trip' ); } } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������XML-TreePP-0.43/t/39_writefile.t��������������������������������������������������������������������000755 �000765 �000024 �00000002715 12236676324 016571� 0����������������������������������������������������������������������������������������������������ustar�00u-suke��������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������# ---------------------------------------------------------------- use strict; use Test::More; # ---------------------------------------------------------------- { local $@; eval { require File::Temp; }; plan skip_all => 'File::Temp is not loaded.' if $@; my $writable = &test_filetemp(); plan skip_all => 'temp file is not writable.' unless $writable; plan tests => 7; use_ok('XML::TreePP'); &test_writefile(); } # ---------------------------------------------------------------- sub test_writefile { my $file = File::Temp->new->filename; ok( $file, "file:".$file ); my $foo = 'Hello'; my $bar = 'World!'; my $tree = { root => { foo => $foo, bar => $bar }}; my $tpp = XML::TreePP->new(); $tpp->writefile( $file, $tree ); ok( (-s $file), 'writefile' ); my $check = $tpp->parsefile( $file ); ok( ref $check, 'parsefile' ); ok( ref $check->{root}, 'parsefile' ); is( $check->{root}{foo}, $foo, 'foo' ); is( $check->{root}{bar}, $bar, 'bar' ); unlink( $file ); } # ---------------------------------------------------------------- sub test_filetemp { my $file = File::Temp->new->filename or return; open( TEMP, "> $file" ) or return; print TEMP "EOT\n"; close( TEMP ); my $size = ( -s $file ); unlink( $file ); $size; } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- ���������������������������������������������������XML-TreePP-0.43/t/40_writefile_jcode.t��������������������������������������������������������������000755 �000765 �000024 �00000004564 12236676324 017731� 0����������������������������������������������������������������������������������������������������ustar�00u-suke��������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������# ---------------------------------------------------------------- use strict; use Test::More; # ---------------------------------------------------------------- { local $@; eval { require Jcode; }; plan skip_all => 'Jcode is not loaded.' if $@; eval { require File::Temp; }; plan skip_all => 'File::Temp is not loaded.' if $@; my $writable = &test_filetemp(); plan skip_all => 'temp file is not writable.' unless $writable; plan tests => 31; use_ok('XML::TreePP'); &test_writefile( 'UTF-8', 'utf8' ); &test_writefile( 'Shift_JIS', 'sjis' ); &test_writefile( 'EUC-JP', 'euc' ); } # ---------------------------------------------------------------- sub test_writefile { my $encode = shift; my $jcode = shift; ok( $encode, 'encode:'.$encode ); my $file = File::Temp->new->filename; ok( $file, "file:".$file ); my $foo_utf8 = 'こんにちは世界'; # UTF-8 my $bar_utf8 = '8÷4=2±0'; # UTF-8 my $foo_test = $foo_utf8; my $bar_test = $bar_utf8; Jcode::convert( \$foo_test, $jcode, 'utf8' ); Jcode::convert( \$bar_test, $jcode, 'utf8' ); ok( length($foo_test), 'foo length' ); ok( length($bar_test), 'bar length' ); my $tpp = XML::TreePP->new(); my $tree = { root => { foo => $foo_utf8, bar => $bar_utf8 }}; $tpp->writefile( $file, $tree, $encode ); ok( (-s $file), 'writefile' ); my $out = &read_file( $file ); like( $out, qr/\Q$foo_test\E/, 'foo raw' ); like( $out, qr/\Q$bar_test\E/, 'bar raw' ); my $check = $tpp->parsefile( $file ); ok( ref $check, 'parsefile' ); is( $check->{root}{foo}, $foo_utf8, 'foo tree' ); is( $check->{root}{bar}, $bar_utf8, 'bar tree' ); unlink( $file ); } # ---------------------------------------------------------------- sub test_filetemp { my $file = File::Temp->new->filename or return; open( TEMP, "> $file" ) or return; print TEMP "EOT\n"; close( TEMP ); my $size = ( -s $file ); unlink( $file ); $size; } # ---------------------------------------------------------------- sub read_file { my $file = shift or return; open( TEMP, $file ) or return; local $/ = undef; my $body = <TEMP>; close( TEMP ); $body; } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- ��������������������������������������������������������������������������������������������������������������������������������������������XML-TreePP-0.43/t/41_writefile_encode.t�������������������������������������������������������������000755 �000765 �000024 �00000005120 12236676324 020070� 0����������������������������������������������������������������������������������������������������ustar�00u-suke��������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������# ---------------------------------------------------------------- use strict; use Test::More; # ---------------------------------------------------------------- { local $@; eval { require 5.008001; }; plan skip_all => 'Perl 5.8.1 is required.' if $@; eval { require Encode; }; plan skip_all => 'Encode is not loaded.' if $@; eval { require File::Temp; }; plan skip_all => 'File::Temp is not loaded.' if $@; my $writable = &test_filetemp(); plan skip_all => 'temp file is not writable.' unless $writable; plan tests => 19; use_ok('XML::TreePP'); &test_writefile(); &test_writefile( utf8_flag => 1 ); } # ---------------------------------------------------------------- sub test_writefile { my $opt = { @_ }; my $file = File::Temp->new->filename; ok( $file, "file:".$file ); my $foo = 'Ελληνικά/Español/Français'; # UTF-8 my $bar = 'Русский/Türkçe/日本語'; # UTF-8 my $tree = { root => { foo => $foo, bar => $bar }}; my $tpp = XML::TreePP->new( %$opt ); $tpp->writefile( $file, $tree ); ok( (-s $file), 'writefile' ); my $out = &read_file( $file ); like( $out, qr/\Q$foo\E/, 'foo raw' ); like( $out, qr/\Q$bar\E/, 'bar raw' ); my $check = $tpp->parsefile( $file ); ok( ref $check, 'parsefile' ); if ( $opt->{utf8_flag} ) { ok( utf8::is_utf8($check->{root}{foo}), 'foo string' ); ok( utf8::is_utf8($check->{root}{bar}), 'bar string' ); utf8::decode( $foo ); utf8::decode( $bar ); is( $check->{root}{foo}, $foo, 'foo tree string' ); is( $check->{root}{bar}, $bar, 'bar tree string' ); } else { ok( ! utf8::is_utf8($check->{root}{foo}), 'foo octets' ); ok( ! utf8::is_utf8($check->{root}{bar}), 'bar octets' ); is( $check->{root}{foo}, $foo, 'foo tree octets' ); is( $check->{root}{bar}, $bar, 'bar tree octets' ); } unlink( $file ); } # ---------------------------------------------------------------- sub test_filetemp { my $file = File::Temp->new->filename or return; open( TEMP, "> $file" ) or return; print TEMP "EOT\n"; close( TEMP ); my $size = ( -s $file ); unlink( $file ); $size; } # ---------------------------------------------------------------- sub read_file { my $file = shift or return; open( TEMP, $file ) or return; local $/ = undef; my $body = <TEMP>; close( TEMP ); $body; } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������XML-TreePP-0.43/t/42_cdata_comment.t����������������������������������������������������������������000755 �000765 �000024 �00000005115 12236676324 017364� 0����������������������������������������������������������������������������������������������������ustar�00u-suke��������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������# ---------------------------------------------------------------- use strict; use Test::More tests => 129; BEGIN { use_ok('XML::TreePP') }; # ---------------------------------------------------------------- { my $test = { '<xml><![CDATA[AAA]]></xml>' => 'AAA', '<xml>AAA<![CDATA[BBB]]>CCC</xml>' => 'AAABBBCCC', '<xml><![CDATA[AAA]]>BBB<![CDATA[CCC]]></xml>' => 'AAABBBCCC', '<xml>AAA<![CDATA[BBB]]>CCC<![CDATA[DDD]]>EEE</xml>' => 'AAABBBCCCDDDEEE', '<xml><!-- AAA --></xml>' => '', '<xml>AAA<!-- BBB -->CCC</xml>' => 'AAACCC', '<xml><!-- AAA -->BBB<!-- CCC --></xml>' => 'BBB', '<xml>AAA<!-- BBB -->CCC<!-- DDD -->EEE</xml>' => 'AAACCCEEE', '<xml><!-- AAA -->BBB<![CDATA[CCC]]></xml>' => 'BBBCCC', '<xml><![CDATA[AAA]]>BBB<!-- CCC --></xml>' => 'AAABBB', '<xml><!-- AAA -->BBB<![CDATA[CCC]]>DDD<!-- EEE --></xml>' => 'BBBCCCDDD', '<xml><![CDATA[AAA]]>BBB<!-- CCC -->DDD<![CDATA[EEE]]></xml>' => 'AAABBBDDDEEE', '<xml><![CDATA[<!-- AAA -->]]></xml>' => '<!-- AAA -->', '<xml><!-- <![CDATA[AAA]]> --></xml>' => '', '<xml><![CDATA[<!-- AAA -->]]><!-- <![CDATA[BBB]]> --></xml>' => '<!-- AAA -->', '<xml><!-- <![CDATA[AAA]]> --><![CDATA[<!-- BBB -->]]></xml>' => '<!-- BBB -->', }; &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 ); my $memo = exists $opt->{cdata_scalar_ref} ? 'cdata_scalar_ref ' : 'default '; foreach my $src ( keys %$list ) { my $val = $list->{$src}; my $tree = $tpp->parse( $src ); ok( exists $tree->{xml}, $memo.'exists' ); my $cdata = $tree->{xml}; $cdata = $$cdata if ( ref $cdata eq 'SCALAR' ); ok( ! ref $cdata, $memo.'invalid ref' ); is( $cdata, $val, $memo.$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, $memo.'round trip' ); } } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������XML-TreePP-0.43/t/43_encoding_quote.t���������������������������������������������������������������000755 �000765 �000024 �00000002470 12236676324 017573� 0����������������������������������������������������������������������������������������������������ustar�00u-suke��������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������# ---------------------------------------------------------------- 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 = "<?xml version='1.0' encoding='windows-1250'?><root>FOO</root>"; 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 = "<?xml version='1.0' encoding='Shift_JIS'?><root>$soa</root>"; my $tree3 = $tpp->parse( $xml3 ); Encode::from_to( $soa, 'Shift_JIS', 'utf8' ); is( $tree3->{root}, $soa, 'Shift_JIS' ); my $xml2 = "<?xml version='1.0' encoding='INVALID_ENCODING'?><root>BAR</root>"; local $@; eval { $tpp->parse( $xml2 ); }; like( $@, qr/INVALID_ENCODING/, 'INVALID_ENCODING' ); } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������XML-TreePP-0.43/t/44_utf8_bom.t���������������������������������������������������������������������000644 �000765 �000024 �00000003202 12236676324 016303� 0����������������������������������������������������������������������������������������������������ustar�00u-suke��������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������# ---------------------------------------------------------------- # this test script is written in utf8 but does not "use utf8" for 5.005-compatibility # ---------------------------------------------------------------- use strict; use Test::More; # ---------------------------------------------------------------- { local $@; eval { require 5.008001; }; plan skip_all => 'Perl 5.8.1 is required.' if $@; } # ---------------------------------------------------------------- my $FILES = [qw( t/example/hello-en-utf8.xml t/example/hello-en-nodecl.xml t/example/hello-en-noenc.xml t/example/hello-en-utf8-bom.xml t/example/hello-en-nodecl-bom.xml t/example/hello-en-noenc-bom.xml )]; # ---------------------------------------------------------------- { plan tests => 13; use_ok('XML::TreePP'); &test_main(); } # ---------------------------------------------------------------- sub test_main { my $octets = 'Hello, World! §±×÷'; my $string = $octets; require utf8; utf8::decode( $string ); my $tpp1 = XML::TreePP->new( utf8_flag => 0 ); my $tpp2 = XML::TreePP->new( utf8_flag => 1 ); foreach my $file ( @$FILES ) { my $tree1 = $tpp1->parsefile( $file ); is( $tree1->{root}->{text}, $octets, $file." without utf8_flag" ); my $tree2 = $tpp2->parsefile( $file ); is( $tree2->{root}->{text}, $string, $file." with utf8_flag" ); } } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������XML-TreePP-0.43/t/45_attr_space.t�������������������������������������������������������������������000755 �000765 �000024 �00000003344 12236676324 016720� 0����������������������������������������������������������������������������������������������������ustar�00u-suke��������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������# ---------------------------------------------------------------- use strict; use Test::More tests => 49; BEGIN { use_ok('XML::TreePP') }; # ---------------------------------------------------------------- my $tpp = XML::TreePP->new(); my $list = [ '<root aaa="AAA" bbb ="BBB" zzz ccc= "CCC" ddd = "DDD" >XXX</root>', "<root aaa='AAA' bbb ='BBB' zzz ccc= 'CCC' ddd = 'DDD' >XXX</root>", '<root aaa="AAA" bbb ="BBB" zzz ccc= "CCC" ddd = "DDD">XXX</root>', "<root aaa='AAA' bbb ='BBB' zzz ccc= 'CCC' ddd = 'DDD'>XXX</root>", '<root aaa="AAA" bbb ="BBB" zzz ccc= "CCC" ddd = "DDD" ></root>', "<root aaa='AAA' bbb ='BBB' zzz ccc= 'CCC' ddd = 'DDD' ></root>", '<root aaa="AAA" bbb ="BBB" zzz ccc= "CCC" ddd = "DDD"></root>', "<root aaa='AAA' bbb ='BBB' zzz ccc= 'CCC' ddd = 'DDD'></root>", '<root aaa="AAA" bbb ="BBB" zzz ccc= "CCC" ddd = "DDD" />', "<root aaa='AAA' bbb ='BBB' zzz ccc= 'CCC' ddd = 'DDD' />", '<root aaa="AAA" bbb ="BBB" zzz ccc= "CCC" ddd = "DDD"/>', "<root aaa='AAA' bbb ='BBB' zzz ccc= 'CCC' ddd = 'DDD'/>", ]; foreach my $source ( @$list ) { my $tree = $tpp->parse( $source ); my $sep = ( $source =~ /(['"])/ )[0]; is( $tree->{root}->{"-aaa"}, "AAA", "key=".$sep."val".$sep." (no space)" ); is( $tree->{root}->{"-bbb"}, "BBB", "key =".$sep."val".$sep." (left space)" ); is( $tree->{root}->{"-ccc"}, "CCC", "key= ".$sep."val".$sep." (right space)" ); is( $tree->{root}->{"-ddd"}, "DDD", "key = ".$sep."val".$sep." (both space)" ); } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������XML-TreePP-0.43/t/46_xml_deref.t��������������������������������������������������������������������000755 �000765 �000024 �00000007103 12236676324 016536� 0����������������������������������������������������������������������������������������������������ustar�00u-suke��������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������# ---------------------------------------------------------------- # this test script is written in utf8 but does not "use utf8" for 5.005-compatibility # ---------------------------------------------------------------- use strict; use Test::More; # ---------------------------------------------------------------- { plan tests => 33; use_ok('XML::TreePP'); &test_main(); } # ---------------------------------------------------------------- sub test_main { my $src = {}; $src->{Plain} = <<"EOT"; <root> <a>AA</a> <z>zz</z> <c>©©</c> <e>ëë</e> <n>んん</n> <k>漢漢</k> </root> EOT $src->{XMLref} = <<"EOT"; <root> <a>AA</a> <z>zz</z> <c>©©</c> <e>ëë</e> <n>んん</n> <k>漢漢</k> </root> EOT $src->{Mixed} = <<"EOT"; <root> <a>AA</a> <z>zz</z> <c>©©</c> <e>ëë</e> <n>んん</n> <k>漢漢</k> </root> EOT foreach my $key ( keys %$src ) { phase2( "$key octets", $src->{$key} ); } } # ---------------------------------------------------------------- sub phase2 { my $subject = shift; my $srcxml = shift; my $srcref = ( $srcxml =~ /&#\w+;/ ); foreach my $xml_deref ( 0, 1 ) { my $subj3 = $subject .( $xml_deref ? ' xml_deref' : '' ); my $opt = { xml_deref => $xml_deref, }; my $tpp = XML::TreePP->new( %$opt ); my $tree = $tpp->parse( $srcxml ); if ( $xml_deref ) { check_octets( $subj3, $tree ); } else { if ( $srcref ) { check_has_ref( $subj3, $tree ); } else { check_no_ref( $subj3, $tree ); } } } } # ---------------------------------------------------------------- sub check_has_ref { my $subject = shift; my $tree = shift; my $root = $tree->{root}; my $HAS_REF = qr/&#\w+;/; # \x00-\x7F is always dereferenced. # like( $root->{a}, $HAS_REF, "$subject has_ref: a" ); # like( $root->{z}, $HAS_REF, "$subject has_ref: z" ); like( $root->{c}, $HAS_REF, "$subject has_ref: c" ); like( $root->{e}, $HAS_REF, "$subject has_ref: e" ); like( $root->{n}, $HAS_REF, "$subject has_ref: n" ); like( $root->{k}, $HAS_REF, "$subject has_ref: k" ); } # ---------------------------------------------------------------- sub check_no_ref { my $subject = shift; my $tree = shift; my $root = $tree->{root}; my $HAS_REF = qr/&#\w+;/; unlike( $root->{a}, $HAS_REF, "$subject no_ref: a" ); unlike( $root->{z}, $HAS_REF, "$subject no_ref: z" ); unlike( $root->{c}, $HAS_REF, "$subject no_ref: c" ); unlike( $root->{e}, $HAS_REF, "$subject no_ref: e" ); unlike( $root->{n}, $HAS_REF, "$subject no_ref: n" ); unlike( $root->{k}, $HAS_REF, "$subject no_ref: k" ); } # ---------------------------------------------------------------- sub check_octets { my $subject = shift; my $tree = shift; my $root = $tree->{root}; is( $root->{a}, 'AA', "$subject ok: a" ); is( $root->{z}, 'zz', "$subject ok: z" ); is( $root->{c}, '©©', "$subject ok: c" ); is( $root->{e}, 'ëë', "$subject ok: e" ); is( $root->{n}, 'んん', "$subject ok: n" ); is( $root->{k}, '漢漢', "$subject ok: k" ); } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������XML-TreePP-0.43/t/47_xml_deref_utf8.t���������������������������������������������������������������000755 �000765 �000024 �00000013232 12236676324 017505� 0����������������������������������������������������������������������������������������������������ustar�00u-suke��������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������# ---------------------------------------------------------------- # this test script is written in utf8 but does not "use utf8" for 5.005-compatibility # ---------------------------------------------------------------- use strict; use Test::More; # ---------------------------------------------------------------- { local $@; eval { require 5.008001; }; plan skip_all => 'Perl 5.8.1 is required.' if $@; } # ---------------------------------------------------------------- { plan tests => 155; use_ok('XML::TreePP'); &test_main(); } # ---------------------------------------------------------------- sub test_main { my $src = {}; $src->{Plain} = <<"EOT"; <root> <a>AA</a> <z>zz</z> <c>©©</c> <e>ëë</e> <n>んん</n> <k>漢漢</k> </root> EOT $src->{XMLref} = <<"EOT"; <root> <a>AA</a> <z>zz</z> <c>©©</c> <e>ëë</e> <n>んん</n> <k>漢漢</k> </root> EOT $src->{Mixed} = <<"EOT"; <root> <a>AA</a> <z>zz</z> <c>©©</c> <e>ëë</e> <n>んん</n> <k>漢漢</k> </root> EOT foreach my $key ( keys %$src ) { phase2( "$key octets", $src->{$key} ); my $copy = $src->{$key}; utf8::decode( $copy ); next unless utf8::is_utf8($copy); phase2( "$key string", $copy ); } } # ---------------------------------------------------------------- sub phase2 { my $subject = shift; my $srcxml = shift; my $srcutf8 = utf8::is_utf8($srcxml); my $srcref = ( $srcxml =~ /&#\w+;/ ); foreach my $utf8_flag ( 0, 1 ) { my $subj2 = $subject .( $utf8_flag ? ' utf8_flag' : '' ); foreach my $xml_deref ( 0, 1 ) { my $subj3 = $subj2 .( $xml_deref ? ' xml_deref' : '' ); my $opt = { utf8_flag => $utf8_flag, xml_deref => $xml_deref, }; my $tpp = XML::TreePP->new( %$opt ); my $tree = $tpp->parse( $srcxml ); if ( $xml_deref ) { if ( $srcutf8 || $utf8_flag ) { check_string( $subj3, $tree ); } else { check_octets( $subj3, $tree ); } } else { if ( $srcref ) { check_has_ref( $subj3, $tree ); } else { check_no_ref( $subj3, $tree ); } } } } } # ---------------------------------------------------------------- sub check_has_ref { my $subject = shift; my $tree = shift; my $root = $tree->{root}; my $HAS_REF = qr/&#\w+;/; # \x00-\x7F is always dereferenced. # like( $root->{a}, $HAS_REF, "[$subject] has_ref: a" ); # like( $root->{z}, $HAS_REF, "[$subject] has_ref: z" ); like( $root->{c}, $HAS_REF, "[$subject] has_ref: c" ); like( $root->{e}, $HAS_REF, "[$subject] has_ref: e" ); like( $root->{n}, $HAS_REF, "[$subject] has_ref: n" ); like( $root->{k}, $HAS_REF, "[$subject] has_ref: k" ); } # ---------------------------------------------------------------- sub check_no_ref { my $subject = shift; my $tree = shift; my $root = $tree->{root}; my $HAS_REF = qr/&#\w+;/; unlike( $root->{a}, $HAS_REF, "[$subject] no_ref: a" ); unlike( $root->{z}, $HAS_REF, "[$subject] no_ref: z" ); unlike( $root->{c}, $HAS_REF, "[$subject] no_ref: c" ); unlike( $root->{e}, $HAS_REF, "[$subject] no_ref: e" ); unlike( $root->{n}, $HAS_REF, "[$subject] no_ref: n" ); unlike( $root->{k}, $HAS_REF, "[$subject] no_ref: k" ); } # ---------------------------------------------------------------- sub check_string { my $subject = shift; my $tree = shift; my $root = $tree->{root}; # \x00-\x7F never have utf8 flag # ok( utf8::is_utf8($root->{a}), "[$subject] is_utf8: a" ); # ok( utf8::is_utf8($root->{z}), "[$subject] is_utf8: z" ); ok( utf8::is_utf8($root->{c}), "[$subject] is_utf8: c" ); ok( utf8::is_utf8($root->{e}), "[$subject] is_utf8: e" ); ok( utf8::is_utf8($root->{n}), "[$subject] is_utf8: n" ); ok( utf8::is_utf8($root->{k}), "[$subject] is_utf8: k" ); is( $root->{a}, chr(0x0041) x 2, "[$subject] ok: a" ); is( $root->{z}, chr(0x007A) x 2, "[$subject] ok: z" ); is( $root->{c}, chr(0x00A9) x 2, "[$subject] ok: c" ); is( $root->{e}, chr(0x00EB) x 2, "[$subject] ok: e" ); is( $root->{n}, chr(0x3093) x 2, "[$subject] ok: n" ); is( $root->{k}, chr(0x6F22) x 2, "[$subject] ok: k" ); } # ---------------------------------------------------------------- sub check_octets { my $subject = shift; my $tree = shift; my $root = $tree->{root}; ok( ! utf8::is_utf8($root->{a}), "[$subject] is_octets: a" ); ok( ! utf8::is_utf8($root->{z}), "[$subject] is_octets: z" ); ok( ! utf8::is_utf8($root->{c}), "[$subject] is_octets: c" ); ok( ! utf8::is_utf8($root->{e}), "[$subject] is_octets: e" ); ok( ! utf8::is_utf8($root->{n}), "[$subject] is_octets: n" ); ok( ! utf8::is_utf8($root->{k}), "[$subject] is_octets: k" ); is( $root->{a}, 'AA', "[$subject] ok: a" ); is( $root->{z}, 'zz', "[$subject] ok: z" ); is( $root->{c}, '©©', "[$subject] ok: c" ); is( $root->{e}, 'ëë', "[$subject] ok: e" ); is( $root->{n}, 'んん', "[$subject] ok: n" ); is( $root->{k}, '漢漢', "[$subject] ok: k" ); } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������XML-TreePP-0.43/t/48_blobref.t����������������������������������������������������������������������000755 �000765 �000024 �00000003572 12236676324 016214� 0����������������������������������������������������������������������������������������������������ustar�00u-suke��������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������# ---------------------------------------------------------------- use strict; use Test::More tests => 8; BEGIN { use_ok('XML::TreePP') }; ## ---------------------------------------------------------------- { my $scalar = 'value'; my $obj = MyObject->new( elem => 'value' ); my $tree1 = { hashref => { elem => 'value' } }; my $tree2 = { arrayref => { elem => [ 'first', 'last' ] }}; my $tree3 = { scalarref => \$scalar }; my $tree4 = { coderef => sub {} }; my $tree5 = { object => $obj }; my $tree6 = { blob => *STDIN }; my $tree7 = { blobref => \*STDIN }; my $tpp = XML::TreePP->new(); local $SIG{__WARN__} = sub {}; # ignore warn messages my $xml1 = $tpp->write( $tree1 ); like( $xml1, qr#<elem>value</elem>#, 'no1: HASHREF - child node' ); my $xml2 = $tpp->write( $tree2 ); like( $xml2, qr#<elem>first</elem>\s*<elem>last</elem>#s, 'no2: ARRAYREF - multiple nodes' ); my $xml3 = $tpp->write( $tree3 ); my $exp3 = '<scalarref><![CDATA[value]]></scalarref>'; like( $xml3, qr#\Q$exp3\E#, 'no3: SCALARREF - cdata node' ); my $xml4 = $tpp->write( $tree4 ); like( $xml4, qr#xml#, 'no4: CODEREF - undefined behavior rather than die' ); my $xml5 = $tpp->write( $tree5 ); like( $xml5, qr#<elem>value</elem>#, 'no5: OBJECT - as a normal child node' ); my $xml6 = $tpp->write( $tree6 ); like( $xml6, qr#xml#, 'no6: BLOB - undefined behavior rather than die' ); my $xml7 = $tpp->write( $tree7 ); like( $xml7, qr#xml#, 'no7: BLOBREF - undefined behavior rather than die' ); } # ---------------------------------------------------------------- package MyObject; sub new { my $class = shift; my $hash = { @_ }; bless $hash, $class; } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- ��������������������������������������������������������������������������������������������������������������������������������������XML-TreePP-0.43/t/49_invalid_encoding.t�������������������������������������������������������������000755 �000765 �000024 �00000003144 12236676324 020071� 0����������������������������������������������������������������������������������������������������ustar�00u-suke��������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������# ---------------------------------------------------------------- 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"; <?xml version="1.0" encoding="$ENC"?> <root> <elem>value</elem> </root> 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.43/t/50_invalid_tree.t�����������������������������������������������������������������000755 �000765 �000024 �00000002024 12236676324 017226� 0����������������������������������������������������������������������������������������������������ustar�00u-suke��������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������# ---------------------------------------------------------------- use strict; use Test::More tests => 5; BEGIN { use_ok('XML::TreePP') }; # ---------------------------------------------------------------- { my $tpp = XML::TreePP->new(); my $scalar = 'string'; { local $@; eval { my $xml = $tpp->write( undef ); }; like( $@, qr#^Invalid tree#, 'undef: '.$@ ); } { local $@; eval { my $xml = $tpp->write( [] ); }; like( $@, qr#^Invalid tree#, 'arrayref: '.$@ ); } { local $@; eval { my $xml = $tpp->write( $scalar ); }; like( $@, qr#^Invalid tree#, 'scalar: '.$@ ); } { local $@; eval { my $xml = $tpp->write( \$scalar ); }; like( $@, qr#^Invalid tree#, 'scalarref: '.$@ ); } } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������XML-TreePP-0.43/t/51_RT_42441.t���������������������������������������������������������������������000644 �000765 �000024 �00000257606 12236676324 015664� 0����������������������������������������������������������������������������������������������������ustar�00u-suke��������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������# ---------------------------------------------------------------- use strict; use Test::More tests => 5; BEGIN { use_ok('XML::TreePP') }; # ---------------------------------------------------------------- my $tpp = XML::TreePP->new(require_xml_decl=>1); my $source = join('', <DATA>); ok ($source, 'loaded inline content to be parsed'); # diag ('Loaded ' . length($source) . ' bytes'); # The following should not segfault my $tree; eval { $tree = $tpp->parse($source); }; like( $@, qr/XML declaration not found/, 'parsing random html should not segfault' ); is( $tree, undef, 'parsing random html returns undefined values'); ok( 1, 'https://rt.cpan.org/Ticket/Display.html?id=42441' ); # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- __DATA__ <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en"> <head> <link rel="Shortcut Icon" href="/tam.ico"> <meta http-equiv="Content-Type" content="text/html; charset=utf-8" /> <meta name="description" content="The Texas A&M Official Athletic Site, partner of CSTV Networks, Inc. The most comprehensive coverage of Texas A&M Athletics on the web." /> <link href="http://grfx.cstv.com/schools/tam/library/css/tam-08-display.css" rel="stylesheet" type="text/css" /> <script type="text/javascript" src="http://grfx.cstv.com/schools/tam/library/scripts/tam-08-tabs.js"></script> <script type="text/javascript" src="http://grfx.cstv.com/scripts/common.js"></script> <script type="text/javascript" src="http://grfx.cstv.com/scripts/oas-omni-controls.js"></script> <title>Texas A&M Official Athletic Site

Football, 2/17/2009

Four Aggies Set to Participate at NFL Combine

Four Aggies will work out for NFL coaches and front office personnel at this week's NFL Combine in Indianapolis. Justin Brantly, Michael Bennett, Mike Goodson and Stephen McGee have been invited by the league to...

Football, 2/11/2009

AGGIE FOOTBALL TEAM ATTENDS DISTINGUISHED LECTURE SERIES

The Texas A&M football team attended the University Distinguished Lecture Series on Tuesday, Feb. 10 at 7:30 p.m. in the Anneberg Presidential Conference Center on the Texas A&M campus.

Football, 2/4/2009

Aggies Ink 28 on National Signing Day

Aggie head football coach Mike Sherman announced the signing of 28 student-athletes to national letters of intent in a press conference Wednesday on the Texas A&M campus.

Football, 2/11/2009

Funeral Arrangements Set for Former A&M Great

McLean was a record-setting receiver for the Aggies from 1962-63 and 1965. Forty-three seasons after his final game in the maroon and white, McLean still holds the school standard for receiving yards in a single game.
cookie

01/27/2009

Aggies set to compete in the Texas vs. The Nation All-Star Football Game

Texas A&M will be well represented at the third annual Texas vs. The Nation All-Star Football Game held at the Sun Bowl in El Paso, Texas, this Saturday, Jan. 31

02/03/2009

Signing Day to have Live Interviews

Watch and listen to live Signing Day interviews with the Texas A&M Football Coaches beginning Wednesday morning at 10am beginning with Tight End & Special Teams Coordinator Kirk Doll and ending with Head Coach Mike Sherman's Press Conference beginning at 1pm. Full footballl, soccer and track and field signing day coverage with player bios and photos is available at http://signingday.aggieathletics.com

01/12/2009

McGee Wins FCA/Bobby Bowden Athlete of the Year Award

The Fellowship of Christian Athletes selected Stephen McGee as the recipient of the 2008 FCA Bobby Bowden Athlete of the Year. McGee received the sixth annual award from Coach Bowden on Wednesday in Nashville.

01/09/2009

McGee Preps for Combine

Texas A&M's Stephen McGee visited with the media on Friday on the Texas A&M campus as he continues workouts and preparations for the 2009 NFL Combine

12/22/2008

McGee Named Finalist for Bobby Bowden Award

Texas A&M quarterback Stephen McGee has been selected as one of three finalists for the Bobby Bowden Award the Fellowship of Christian Athletes announced Monday.

12/17/2008

Five Aggies Named to Phil Steele's All-Freshman Team

Five members of the Texas A&M football team have been named to Phil Steele's All-Freshman team, the magazine's website announced Wednesday.

There are no upcoming events.
XML-TreePP-0.43/t/52_require_xml_decl.t000755 000765 000024 00000002600 12236676324 020106 0ustar00u-sukestaff000000 000000 # ---------------------------------------------------------------- use strict; use Test::More; # ---------------------------------------------------------------- my $xml1 = <<"EOT"; value EOT my $xml2 = <<"EOT"; value EOT # ---------------------------------------------------------------- { plan tests => 5; use_ok('XML::TreePP'); my $tpp1 = XML::TreePP->new(); my $tpp2 = XML::TreePP->new( require_xml_decl => 1 ); my $res; my $die; ($res, $die) = &test($tpp1, $xml1); is($res->{root}->{elem}, 'value', 'no decl and default'); ($res, $die) = &test($tpp1, $xml2); is($res->{root}->{elem}, 'value', 'has decl and default'); ($res, $die) = &test($tpp2, $xml1); like($die, qr/^XML DECLARATION NOT FOUND/i, 'require_xml_decl works'); ($res, $die) = &test($tpp2, $xml2); is($res->{root}->{elem}, 'value', 'has decl and require_xml_decl'); } # ---------------------------------------------------------------- sub test { my $tpp = shift; my $xml = shift; my $exp = shift; local $@; my $tree; eval { $tree = $tpp->parse($xml); }; return ($tree, $@); } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- XML-TreePP-0.43/t/53_empty_text_node.t000755 000765 000024 00000001421 12236676324 017773 0ustar00u-sukestaff000000 000000 # ---------------------------------------------------------------- use strict; use Test::More; # ---------------------------------------------------------------- my $tree1 = {root=>{-attr=>'val', "#text"=>""}}; my $tree2 = {root=>{-attr=>'val', "#text"=>undef}}; # ---------------------------------------------------------------- { plan tests => 3; use_ok('XML::TreePP'); my $tpp = XML::TreePP->new(); my $xml; $xml = $tpp->write($tree1); like($xml, qr:]*>:, "text node with zero length string"); $xml = $tpp->write($tree2); like($xml, qr:]*/>:, "text node of undef"); } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- XML-TreePP-0.43/t/54_empty_element_tag_end.t000644 000765 000024 00000001062 12236700411 021074 0ustar00u-sukestaff000000 000000 # ---------------------------------------------------------------- use strict; use Test::More tests => 2; BEGIN { use_ok('XML::TreePP') }; # ---------------------------------------------------------------- my $source = ''; my $tpp = XML::TreePP->new(empty_element_tag_end => '>'); my $tree1 = $tpp->parse( $source ); like $tpp->write($tree1), qr!!; # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- XML-TreePP-0.43/t/example/000755 000765 000024 00000000000 12432275633 015516 5ustar00u-sukestaff000000 000000 XML-TreePP-0.43/t/example/hello-en-latin1.xml000755 000765 000024 00000000157 12236676324 021143 0ustar00u-sukestaff000000 000000 Hello, World! XML-TreePP-0.43/t/example/hello-en-nodecl-bom.xml000644 000765 000024 00000000110 12236676324 021754 0ustar00u-sukestaff000000 000000  Hello, World! §±×÷ XML-TreePP-0.43/t/example/hello-en-nodecl.xml000755 000765 000024 00000000105 12236676324 021210 0ustar00u-sukestaff000000 000000 Hello, World! §±×÷ XML-TreePP-0.43/t/example/hello-en-noenc-bom.xml000644 000765 000024 00000000140 12236676324 021615 0ustar00u-sukestaff000000 000000  Hello, World! §±×÷ XML-TreePP-0.43/t/example/hello-en-noenc.xml000755 000765 000024 00000000135 12236676324 021051 0ustar00u-sukestaff000000 000000 Hello, World! §±×÷ XML-TreePP-0.43/t/example/hello-en-utf8-bom.xml000644 000765 000024 00000000161 12236676324 021404 0ustar00u-sukestaff000000 000000  Hello, World! §±×÷ XML-TreePP-0.43/t/example/hello-en-utf8.xml000755 000765 000024 00000000156 12236676324 020640 0ustar00u-sukestaff000000 000000 Hello, World! §±×÷ XML-TreePP-0.43/t/example/hello-ja-euc.xml000755 000765 000024 00000000135 12236676324 020513 0ustar00u-sukestaff000000 000000 ˤ! XML-TreePP-0.43/t/example/hello-ja-sjis.xml000755 000765 000024 00000000144 12236676324 020707 0ustar00u-sukestaff000000 000000 ɂ! XML-TreePP-0.43/t/example/hello-ja-utf8.xml000755 000765 000024 00000000145 12236676324 020626 0ustar00u-sukestaff000000 000000 こんにちは! XML-TreePP-0.43/t/example/hello-ko-euc.xml000755 000765 000024 00000000141 12236676324 020527 0ustar00u-sukestaff000000 000000 ȳϼ! XML-TreePP-0.43/t/example/hello-ko-utf8.xml000755 000765 000024 00000000145 12236676324 020645 0ustar00u-sukestaff000000 000000 안녕하세요! XML-TreePP-0.43/t/example/hello-zh-big5.xml000755 000765 000024 00000000131 12236676324 020610 0ustar00u-sukestaff000000 000000 An! XML-TreePP-0.43/t/example/hello-zh-gb2312.xml000755 000765 000024 00000000133 12236676324 020664 0ustar00u-sukestaff000000 000000 ! XML-TreePP-0.43/t/example/hello-zh-utf8.xml000755 000765 000024 00000000134 12236676324 020653 0ustar00u-sukestaff000000 000000 你好! XML-TreePP-0.43/t/example/index.rdf000644 000765 000024 00000456111 12236702326 017326 0ustar00u-sukestaff000000 000000 Kawa.net xp - ajax/JavaScript/Perl/CGI by Yusuke Kawasaki http://www.kawa.net/xp/index-e.html 2013-05-23T12:05:00+09:00 en Copyright 1995-2010 Yusuke Kawasaki. All rights reserved. Yusuke Kawasaki 25 1 80 http://www.kawa.net/xp/images/xp-title-128x32.gif Kawa.net xp - ajax/JavaScript/Perl/CGI by Yusuke Kawasaki http://www.kawa.net/xp/index-e.html [Perl] HTML::TagParser - Yet another HTML tag parser by pure Perl implementation http://www.kawa.net/works/perl/html/tagparser-e.html 2012-05-05T23:21:00+09:00 Perl HTML::TagParser is a pure Perl implementaion for parsing HTML files. This module provides some methods like DOM. This module is not strict about XHTML format because many of HTML pages are not strict. You know, many pages use <br> elemtents instead of <br/> and have <p> elements which are not closed. Apple.com has "_2x.jpg" high resolutionary images for the new iPad http://kawanet.blogspot.com/2012/03/applecom-has-2xjpg-high-resolutionary.html Yusuke Kawasaki 2012-03-18T09:32:09.855-07:00 <div dir="ltr" style="text-align: left;" trbidi="on">The new iPad's&nbsp;<i>resolutionary&nbsp;</i>Retina display&nbsp;looks cool, but, on the other hand, it terrifies designers in the Web industry. &nbsp;The new iPad is the first HiDPI device which works well for browsing PC websites.&nbsp;All images on the Web must be republished to enhance its experience on the new iPad and other upcoming HiDPI devices.<br /><br />Apple's website itself is also ongoing to support&nbsp;HiDPI displays. Many image files on the website have a couple resolutions of normal one and doubled one which has "<span class="Apple-style-span" style="font-family: 'Courier New', Courier, monospace;">_2x</span>"&nbsp;suffix.&nbsp;Here is a sample:<br /><br /><div class="separator" style="clear: both; text-align: center;"><a href="http://4.bp.blogspot.com/-0CYMq7WXM0E/T2XtyTJpbFI/AAAAAAAAEI4/3G3276FLaqs/s1600/ipad_hero-compare.jpg" target="_blank"><img border="0" src="http://4.bp.blogspot.com/-0CYMq7WXM0E/T2XtyTJpbFI/AAAAAAAAEI4/3G3276FLaqs/s500/ipad_hero-compare.jpg" width="500" /></a></div><br />Traditional resolution version: 1454 x 605 pixel<br /><a href="http://images.apple.com/home/images/ipad_hero.jpg"><span class="Apple-style-span" style="font-family: 'Courier New', Courier, monospace;">http://images.apple.com/home/images/ipad_hero.jpg</span></a><br /><br />High resolution&nbsp;version: &nbsp;2908 x 1210 pixel (doubled!)<br /><a href="http://images.apple.com/home/images/ipad_hero_2x.jpg"><span class="Apple-style-span" style="font-family: 'Courier New', Courier, monospace;">http://images.apple.com/home/images/ipad_hero_<b>2x</b>.jpg</span></a><br /><div><br /></div><div style="margin-bottom: 0px; margin-left: 0px; margin-right: 0px; margin-top: 0px;"></div><div>Some images on the website still not have "<span class="Apple-style-span" style="font-family: 'Courier New', Courier, monospace;">_2x</span>" version at this time, however.&nbsp;Any image files which has&nbsp;"<span class="Apple-style-span" style="font-family: 'Courier New', Courier, monospace;">_2x</span>" version&nbsp;are automatically and&nbsp;progressively&nbsp;replaced by&nbsp;<a href="http://images.apple.com/v/ipad/a/scripts/image_replacer.js">image_replacer.js</a>&nbsp;according to the current display resolution setting.&nbsp;</div><div><br /></div><div><b><span class="Apple-style-span" style="font-family: Verdana, sans-serif;">TRY IT NOW ON YOUR MAC</span></b></div><br />You could try the future with HiDPI on your current Mac by enabling it with&nbsp;<span class="Apple-style-span" style="font-family: 'Courier New', Courier, monospace;">Quartz Debug.app</span> shipped with <a href="https://developer.apple.com/downloads/index.action">Graphics Tools for Xcode</a>. Apple.com website would show "<span class="Apple-style-span" style="font-family: 'Courier New', Courier, monospace;">_2x</span>" images when HiDPI is&nbsp;enabled on your Mac.<br /><br /><div><div class="separator" style="clear: both; text-align: center;"><a href="http://4.bp.blogspot.com/-hMwB1FtAwoo/T2Xz25dZMLI/AAAAAAAAEJE/-fHjFN1Ls8o/s1600/hidpi.png" imageanchor="1" style="border: 0; margin-left: 1em; margin-right: 1em;"><img border="0" src="http://4.bp.blogspot.com/-hMwB1FtAwoo/T2Xz25dZMLI/AAAAAAAAEJE/-fHjFN1Ls8o/s500/hidpi.png" style="border-bottom-width: 0px; border-color: initial; border-left-width: 0px; border-right-width: 0px; border-style: initial; border-top-width: 0px; box-shadow: none;" width="500" /></a></div><b><span class="Apple-style-span" style="font-family: Verdana, sans-serif;">AUTO DETECTION</span></b><br /><br />Check&nbsp;<span class="Apple-style-span" style="font-family: 'Courier New', Courier, monospace;"><a href="javascript:alert('window.devicePixelRatio%20=%20'+window.devicePixelRatio);">window.devicePixelRatio</a></span> property to detect current display resolution by JavaScript.<br /><br /></div></div> Chinese Alphabet - Romanization of Chinese characters (Pinyin) http://www.kawa.net/works/ajax/romanize/chinese-e.html 2012-03-05T14:12:00+09:00 Pinyin is a romanization system (phonemic notation) of Chinese characters. Enter some Chinese phrases and push the button below. Both of Simplified Chinese (GB2312) and Traditional Chinese (BIG5) are allowed. Korean Alphabet - Romanization of Korean characters (Hangul) http://www.kawa.net/works/ajax/romanize/hangul-e.html 2012-03-05T14:12:00+09:00 Hangul is phonemic characters used in Korea. Enter some Korean phrases and push the button below. Asian Alphabets - Lingua::*::Romanize::* - Online Demo http://www.kawa.net/works/perl/romanize/roman-demo-e.html 2012-03-05T06:08:00+09:00 This page is online-demo of Lingua::*::Romanize::* modules for Perl. Enter some CJK phrases and push the button below. Chinese, Japanese and Korean characters are available. This is not a translation system but to get phonemic notation by roman letters. Moving to the Bay Area http://kawanet.blogspot.com/2012/01/moving-to-bay-area.html Yusuke Kawasaki 2012-01-14T15:51:14.133-08:00 <div dir="ltr" style="text-align: left;" trbidi="on">Hello 2012,<br /><br />For these 5 years, I have been working at the <a href="http://mtl.recruit.co.jp/about/index-en.html"><b>Media Technology Labs</b></a>&nbsp;(MTL) which is a R&amp;D department of <a href="http://www.recruit.jp/corporate/english/"><b>Recruit Co., Ltd.</b></a>, one of the most largest information media publishing companies in Japan. The company is spreading its&nbsp;business&nbsp;field to the global market. At January of 2012, I'll soon fly to the Bay Area&nbsp;of the center of universe&nbsp;to launch our new R&amp;D branch focusing&nbsp;the cutting-edge technologies of the&nbsp;Internet.<br /><br /><div class="separator" style="clear: both; text-align: center;"><a href="http://1.bp.blogspot.com/-T8v5ggJg4bI/TxIHgnMgy4I/AAAAAAAADDc/M2lRciWwuQs/s1600/2012.jpeg" imageanchor="1" style="clear: left; float: left; margin-bottom: 1em; margin-right: 1em;"><img border="0" src="http://1.bp.blogspot.com/-T8v5ggJg4bI/TxIHgnMgy4I/AAAAAAAADDc/M2lRciWwuQs/s500/2012.jpeg" width="500" /></a></div><br /></div> "Wisdom of Earthquakes" Released at TechCrunch Disrupt Hackathon SF 2011 http://kawanet.blogspot.com/2011/09/wisdom-of-earthquakes-released-at.html Yusuke Kawasaki 2011-09-12T11:34:41.251-07:00 <div dir="ltr" style="text-align: left;" trbidi="on">I'm attending the <a href="http://disrupt.techcrunch.com/SF2011/">TechCrunch Disrupt SF 2011</a> held in San Francisco. Prior to the conference, I've hacked here at the huge hackathon filled with more than 700 hackers. It's a really exciting experience. I started hacking the "Wisdom of Earthquakes" web application and released it at the hackathon. <br /><br /><div align="center"><a href="http://www.flickr.com/photos/u-suke/6134568134/" target="_blank" title="TechCrunch Hackathon SF 2011 #tcdisrupt | Flickr - Photo Sharing!"><img alt="photo" border="0" src="http://farm7.static.flickr.com/6158/6134568134_986f3a1339.jpg" width="500" /></a></div><br />The hackathon started at Saturday noon and ended at the Sunday noon. Each team of hackers must finish their hack in 24 hours. <br /><br /><div align="center"><a href="http://www.flickr.com/photos/u-suke/6137354378/" target="_blank" title="TechCrunch Disrupt Hackathon SF 2011 #tcdisrupt | Flickr - Photo Sharing!"><img alt="photo" border="0" src="http://farm7.static.flickr.com/6177/6137354378_37eaeb7d31.jpg" width="500" /></a></div><br />I've also posted articles <a href="http://mtl.recruit.co.jp/blog/2011/09/tcdisrupt-hackathon.html">about the event</a> and <a href="http://kawa.at.webry.info/201109/article_2.html">food for hackers</a> on my Japanese blogs in detail. TechCrunch's official report is <a href="http://techcrunch.com/2011/09/11/and-the-2011-techcrunch-disrupt-sf-hackathon-winners-are/">here</a>.<br /><span class="Apple-style-span" style="font-size: 19px; font-weight: bold;"><br /></span><br /><span class="Apple-style-span" style="font-size: 19px; font-weight: bold;">Wisdom of Earthquakes</span><br /><h3> <span class="Apple-style-span" style="font-size: small; font-weight: normal;">After the lunch, the time has came for me to give a talk about my hack on the stage.</span></h3><div align="center"><a href="http://www.flickr.com/photos/u-suke/6138006657/" target="_blank" title="&quot;Wisdom of Earthquakes&quot; #tcdisrupt #hack4jp | Flickr - Photo Sharing!"><img alt="photo" border="0" src="http://farm7.static.flickr.com/6163/6138006657_20a3194485.jpg" width="500" /></a></div><br />I've hacked <a href="http://code.google.com/p/memorial-calendars/wiki/tcdisrupt">"Wisdom of Earthquakes"</a> which is a web application with a calendar and a map to tell the wisdom we can learn from earthquakes.<br /><br />This calendar shows 500+ memorial days of earthquakes hit in the history of the globe. The oldest one listed is the <a href="http://en.wikipedia.org/wiki/62_Pompeii_earthquake">62 Pompeii earthquake</a> in Italy. We could see almost every day on the calendar has had one or more earthquakes. The wisdom helps us do something to survive at the next coming disaster. <br /><br /><div align="center"><a href="http://memorial-calendars.googlecode.com/svn/trunk/pre2/index.html"><img border="0" src="http://4.bp.blogspot.com/-7zuRXsnTSho/Tm5IVbnq6pI/AAAAAAAAA7U/auSVvqqEZww/s500/wisdom.png" width="500" /></a></div><br />The app is shipped as an open source at:<br /><a href="http://code.google.com/p/memorial-calendars/wiki/tcdisrupt">http://code.google.com/p/memorial-calendars/wiki/tcdisrupt</a></div> [Perl] XML::FeedPP - Parse/write/merge/edit RSS/RDF/Atom syndication feeds http://www.kawa.net/works/perl/feedpp/feedpp-e.html 2011-05-08T22:07:00+09:00 Perl XML::FeedPP is an all-purpose syndication utility that parses and publishes RSS 2.0, RSS 1.0 (RDF), Atom 0.3 and 1.0 feeds. It allows you to add new content, merge feeds, and convert among various formats. It is a pure Perl implementation and does not require any other module except for XML::TreePP. Released version: XML-FeedPP-0.43.tar.gz TARGZ CPAN Subversion repository: http://xml-treepp.googlecode.com/svn/trunk/XML-FeedPP/ SVN Documents: README README Changes Changes iPad 2 JavaScript Benchmark Results 37% Faster Than iPad 1 http://kawanet.blogspot.com/2011/04/ipad-2-javascript-benchmark-results-37.html Yusuke Kawasaki 2011-04-06T06:49:26.173-07:00 iOS iPad javascript Safari <a href="http://www.webkit.org/perf/sunspider/sunspider.html">SunSpider JavaScript Benchmark</a> marks 37% faster score on iPad 2 / iOS 4.3.1 / Mobile Safari 5.0 compared to iPad 1st gen.<br /><br /><a href="http://4.bp.blogspot.com/-LF_qhcrB3rw/TZxql3wugLI/AAAAAAAAA3o/IVeCLmA7GNA/s1600/ios-bench.png" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" src="http://4.bp.blogspot.com/-LF_qhcrB3rw/TZxql3wugLI/AAAAAAAAA3o/IVeCLmA7GNA/s1600/ios-bench.png" width="477" /></a><br /><br />Also note that iPad 1 could get significant peformance improvement by updating iOS from 4.2.1 to 4.3.1. This means Mobile Safari 5.0's "Nitro" Engine enabled on&nbsp;iOS 4.3&nbsp;runs JavaScript quite fast.<br /><br />Benchmark results captured are below:<br /><br />iPad 2 - 4.3.1 and 4.3<br /><a href="https://picasaweb.google.com/www.kawa.net/Captures#5592447924009209490" style="margin-left: 1em;" target="_blank" title="SunSpider 0.9.1 / Total 2043.3ms / iPad 2 / iOS 4.3.1 / Moile Safari 5.0.2"><img border="0" height="256" src="https://lh6.googleusercontent.com/_gkSXygtOqmM/TZxdwb9wjpI/AAAAAAAANvg/4zzuww0RGBs/s512/IMG_20110406213431.jpg" width="192" /></a> <a href="https://picasaweb.google.com/www.kawa.net/Captures#5592433634865154786" style="margin-left: 1em;" target="_blank" title="SunSpider 0.9.1 / Total 2043.8ms / iPad 2 / iOS 4.3 / Moile Safari 5.0.2"><img border="0" height="256" src="https://lh4.googleusercontent.com/_gkSXygtOqmM/TZxQwswViuI/AAAAAAAANtw/6qE7CdlhzwA/s512/IMG_20110406203902.jpg" width="192" /></a><br /><br />iPad 1 - 4.3.1 and 4.2.1<br /><a href="https://picasaweb.google.com/www.kawa.net/Captures#5592442243541056962" style="margin-left: 1em;" target="_blank" title="SunSpider 0.9.1 / Total 3276.0ms / iPad 1 / iOS 4.3.1 / Moile Safari 5.0.2"><img border="0" height="256" src="https://lh3.googleusercontent.com/_gkSXygtOqmM/TZxYlyknPcI/AAAAAAAANuk/3dhPxOqTLYE/s512/IMG_20110406211130.jpg" width="192" /></a> <a href="https://picasaweb.google.com/www.kawa.net/Captures#5592434751802296722" style="margin-left: 1em;" target="_blank" title="SunSpider 0.9.1 / Total 8041.9ms / iPad 1 / iOS 4.2.1 / Moile Safari 5.0.2"><img border="0" height="256" src="https://lh4.googleusercontent.com/_gkSXygtOqmM/TZxRxtq5yZI/AAAAAAAANuI/_dLOcuyO3d4/s512/IMG_20110406204736.jpg" width="192" /></a><br /><br />PS.<br />My Mac results 344ms on Chrome and 360ms on Safari.<br />iPads are still nothing compared to Mac. :-&lt;<br /><br />* <a href="http://mtl.recruit.co.jp/blog/2011/04/ipad_2_javascript37safari_nitr.html">Japanese version of this post is here</a>. KDrawSprite: Get GPU power without cacheAsBitmapMatrix on AIR for iOS http://kawanet.blogspot.com/2011/02/kdrawsprite-get-gpu-power-without.html Yusuke Kawasaki 2011-02-14T06:22:51.063-08:00 actionscript AIR iOS iPad iPhone KDrawSprite is an ActionScript library for mobile AIR applications using Packager for iPhone, AIR for iOS and AIR for Android to get more power of GPU. My iPhone app <a href="http://click.linksynergy.com/fs-bin/stat?id=p2dVV*6ZlI0&amp;offerid=94348&amp;type=3&amp;subid=0&amp;tmpid=2192&amp;RD_PARM1=http://itunes.apple.com/jp/app/korean-alphabet/id355690031%253Fmt=8%2526uo=6%2526partnerId=30">Korean Alphabet 1.2.2</a> is using this to get more than 30 fps on older devices, ex. iPod Touch 1st gen. A4 chip powered latest devices, such as iPad and iPhone 4, will performs 100 fps over with KDrawSprite.<br /><br />Source on github:<br /><a href="https://github.com/kawanet/as3kawalib/raw/master/src/net/kawa/display/KDrawSprite.as">https://github.com/kawanet/as3kawalib/raw/master/src/net/kawa/display/KDrawSprite.as</a><br />Document:<br /><a href="http://www.kawa.net/works/as/as3kawalib/docs/net/kawa/display/KDrawSprite.html">http://www.kawa.net/works/as/as3kawalib/docs/net/kawa/display/KDrawSprite.html</a><br /><br /><div class="separator" style="clear: both; text-align: center;"><img border="0" src="http://1.bp.blogspot.com/--Bzdu32y9-0/TVk5IdLtyrI/AAAAAAAAA2Q/QPLKk8rlNMI/s320/adobe-air.jpeg" /></div><br />KDrawSprite draws your vector image onto a bitmap image. You don't need to manipulate cacheAsBitmapMatrix and cacheAsBitmap properties. These are powerful, however, sometimes make our app crashed erratically. You need take more care for iPad which has larger screen but has less memory.<br /><br /><h3>How To Use This</h3>Simply call KDrawSprite.getSprite() instead of setting cacheAsBitmapMatrix and cacheAsBitmap properties.<br /><blockquote style="padding: 8px; border: 1px solid green; color: black; font-family: monospace; line-height: 1.3em;">var sprite:Sprite = new Sprite();<br />sprite.graphics.beginFill(0x336699);<br />sprite.graphics.drawCircle(50, 50, 50);<br /><br /><span style="color: blue;">// sprite.cacheAsBitmapMatrix = new Matrix(); // BEFORE<br />// sprite.cacheAsBitmap = true;</span><br /><br /><span style="color: red;">sprite = KDrawSprite.getSprite(sprite);&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; // AFTER</span><br /><br />addChild(sprite);<br />sprite.x = 100;<br />sprite.y = 100;<br />sprite.scaleX = 0.5;<br />sprite.height = 50;<br />sprite.rotation = 1;</blockquote>Bitmap operations such as moving, scaling and rotation will be GPU enabled.<br />KDrawSprite will also free memory of image rendered when it comes out of the Stage.<br /><br />You need call getSprite() or draw() method whenever you make changes on the vector source image. This also means any other needless re-rendering will not be invoked. Learn more on <a href="http://www.kawa.net/works/as/as3kawalib/docs/net/kawa/display/KDrawSprite.html">document</a>.<br /><br /><h3>Super Sampling Anti-Aliasing (2x SSAA)</h3>KDrawSprite supports 2x SSAA, super sampling anti-aliasing, in addition to NoAA per default.<br /><br /><h3>Note</h3>To get better performance and rendering quality, you <b>MUST</b> set stage.quality as StageQuality.LOW. Also use 2x SSAA when needed.<br /><blockquote style="padding: 8px; border: 1px solid green; color: black; font-family: monospace; line-height: 1.3em;">stage.quality = StageQuality.LOW; // must</blockquote><br />* <a href="http://kawa.at.webry.info/201102/article_3.html">Japanese version of this post is here</a>. YAPC::Asia Tokyo 2010 - Japan's Perl Week http://kawanet.blogspot.com/2010/11/yapcasia-tokyo-2010-japans-perl-week.html Yusuke Kawasaki 2010-10-31T09:19:30.704-07:00 perl yapcasia yapcasia2010 Autumn is the best season for Perl hackers to come to Japan as we have the YAPC::Asia in Tokyo. This year, at September 15-16, I attended the great conference held at the&nbsp;Tokyo Institute of Technology Univ.<br /><br /><div class="separator" style="clear: both; text-align: center;"><a href="http://www.flickr.com/photos/u-suke/5085375676/in/set-72157625105552309/" style="margin-left: 1em; margin-right: 1em;" target="_blank" title="YAPC::Asia 2010 Tokyo Auditorium | Flickr - Photo Sharing!"><img alt="photo" border="0" height="300" src="http://farm5.static.flickr.com/4089/5085375676_1f01b99593_z.jpg" width="400" /></a></div><br /><h3><span style="background-color: blue;">&nbsp;</span>&nbsp;Thursday, September 14 - Pre-Conference Meetup&nbsp;</h3><br />One day before the conference, we had the <a href="http://atnd.org/events/8375">PerlCasual#4</a>&nbsp;developer meetup event organized by <a href="http://twitter.com/yusukebe">@yusukebe</a>. The event was born as the antithesis of Shibuya.pm's technical talk events which were filled by too deep talks, such like x86, XS, binary etc., by&nbsp;super-guru hackers. Casual developers need another place.<br /><br />At the event, I gave at a&nbsp;lightening&nbsp;talk&nbsp;<a href="http://www.kawa.net/text/yapcasia/2010/perlcasual.html">"Reporting OSDC.TW - Shibuya.pm in Taipei."</a>&nbsp;This April, we went the <a href="http://kawanet.blogspot.com/2010/04/shibuya-perl-mongers-comes-into-taipei.html">OSDC.TW 2010</a> conference in Taiwan. Shibuya.pm people, including me, gave talks there.<br /><br /><div class="separator" style="clear: both; text-align: center;"><a href="http://www.kawa.net/text/yapcasia/2010/perlcasual.html" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" height="300" src="http://1.bp.blogspot.com/_cgZUdkW7lzE/TM19q3NI-9I/AAAAAAAAA0Q/Vl3lBvGcm3Y/s400/yapcasia-2010-pre.jpeg" width="400" /></a></div><br />The first half of my talk reports the event and the reason we went there.<br />And the second is about my 3D JavaScript talks.<br />Try <a href="http://www.kawa.net/text/yapcasia/2010/perlcasual.html">my slide here</a> and push <span class="Apple-style-span" style="font-family: 'Courier New', Courier, monospace;">[3]</span> key on your keyboard to view slides in 3D mode.<br /><br /><div style="text-align: center;"><a href="http://www.flickr.com/photos/u-suke/5085367216/in/set-72157625105552309/" style="margin-right: 10px;" target="_blank" title="Strange Alien(変な外人)@obra | Flickr - Photo Sharing!"><img alt="photo" border="0" height="320" src="http://farm5.static.flickr.com/4111/5085367216_85ea347c65.jpg" width="240" /></a><a href="http://www.flickr.com/photos/u-suke/5084778691/in/set-72157625105552309/" target="_blank" title="Acme::Acotie - 名前空間クラッシャー | Flickr - Photo Sharing!"><img alt="photo" border="0" height="320" src="http://farm5.static.flickr.com/4109/5084778691_974587232d.jpg" width="240" /></a></div><br />Photo (left):&nbsp;<a href="http://twitter.com/obra">@obra</a>'s T-shirt shows he is a "Strange Alien."<br /><div style="margin-bottom: 0px; margin-left: 0px; margin-right: 0px; margin-top: 0px;">(right): the&nbsp;<a href="http://www.donzoko.net/gakuya/#Acmencyclopedia2010">Acmencyclopedia 2010</a>&nbsp;at&nbsp;the after-party of day #0.<br /><br /></div><h3><span style="background-color: blue;">&nbsp;</span>&nbsp;Friday, September 15 -&nbsp;Conference Day #1</h3><br />At the first day of the&nbsp;conference, I and my colleague&nbsp;<a href="http://twitter.com/#!/iandeth">@iandeth</a>&nbsp;gave a talk.&nbsp;His slides are&nbsp;<a href="http://mtl.recruit.co.jp/blog/2010/10/yapc_asia_2010_plackvm.html">here</a>.&nbsp;My part is about the <a href="http://mashupaward.jp/">Mashup Awards 6 (MA6)</a>, Japan's largest web application development contest.&nbsp;My slides are&nbsp;<a href="http://mtl.recruit.co.jp/blog/2010/10/yapcasia_2010_ma6_api.html">here</a>.<br /><br /><div class="separator" style="clear: both; text-align: center;"><a href="http://www.flickr.com/photos/u-suke/5085374874/in/set-72157625105552309/" style="margin-left: 1em; margin-right: 1em;" target="_blank" title="Centenial Hall 3F | Flickr - Photo Sharing!"><img alt="photo" border="0" height="300" src="http://farm5.static.flickr.com/4153/5085374874_56f4af7c6b_z.jpg" width="400" /></a></div><br />The&nbsp;day #1's&nbsp;after-party was the official party held in the venue.<br />@clkao's T-shirt shows "Taiwanese." It's easy for us to see his nationality.<br /><br /><div class="separator" style="clear: both; text-align: center;"><a href="http://www.flickr.com/photos/u-suke/5085375974/in/set-72157625105552309/" style="margin-right: 10px;" target="_blank" title="@tsuyoshikawa the PHP Hacker from GREE | Flickr - Photo Sharing!"><img alt="photo" border="0" height="320" src="http://farm5.static.flickr.com/4089/5085375974_5eea1f5c94_z.jpg" width="240" /></a><a href="http://www.flickr.com/photos/u-suke/5085375824/in/set-72157625105552309/" target="_blank" title="@clkao - 台湾人 Taiwanese | Flickr - Photo Sharing!"><img alt="photo" border="0" height="320" src="http://farm5.static.flickr.com/4126/5085375824_d759c32da9_z.jpg" width="240" /></a></div><br />My ex-colleague&nbsp;<a href="http://twitter.com/tsuyoshikawa">@tsuyoshikawa</a>&nbsp;is a Ruby guy but now working at a large PHP company. The company ordered him to give a talk at the Perl conference. It seems he is drunken from the stresses. :)<br /><br /><h3><span style="background-color: blue;">&nbsp;</span>&nbsp;Saturday, September 16 -&nbsp;Conference Day #2</h3><br />Day #2 was Saturday and sunny. Some speakers went down to a BoF looked like a picnic to have a beer under the sun.<br /><br /><div class="separator" style="clear: both; text-align: center;"><a href="http://www.flickr.com/photos/u-suke/5085868710/in/set-72157625105552309/" style="margin-left: 1em; margin-right: 1em; text-align: center;" target="_blank" title="東工大の芝生で昼間からビールを飲んでるお兄さん達 | Flickr - Photo Sharing!"><img alt="photo" border="0" height="300" src="http://farm5.static.flickr.com/4144/5085868710_dcde1016f0_z.jpg" width="400" /></a></div><br />On the other hand, as the closing keynote,&nbsp;<a href="http://twitter.com/miyagawa">@miyagawa</a>&nbsp;gave us the great talk filled with many of suggestions and encouragements for developers. The talk was this year's best talk in my opinion.<br /><br /><div style="text-align: center;"><a href="http://www.flickr.com/photos/u-suke/5086220215/in/set-72157625105552309/" target="_blank" title="@miyagawa - Secret of success | Flickr - Photo Sharing!"><img alt="photo" border="0" height="300" src="http://farm5.static.flickr.com/4133/5086220215_c863b4da66_z.jpg" width="400" /></a></div><br />He showed us the "Secret of success" that he found during his work for Plack and his other projects.<br /><blockquote style="background: black; color: white; font-family: Trebuchet MS; margin-left: 40px; padding: 20px; width: 380px;"><b>Secret of success</b><br /><br />* Good artists borrow, Great artists steal<br />* Better late than too early<br />* JFDI (Just f* do it)<br />* STFUAWSC (Shut the f* up and write some code)<br />* TIMTOWTDI (There is more than one way to do it.) <br />&nbsp;&nbsp;BSCINABTE (But sometimes consistency is not a bad thing either)<br />* KISS (Keep it simple, stupid)<br />* glue language<br />* Naming</blockquote><br />Thank you so much, the YAPC organizers and volunteers.<br /><br /><span class="Apple-style-span" style="font-size: 19px; font-weight: bold;"><span style="background-color: blue;">&nbsp;</span></span><span class="Apple-style-span" style="font-size: 19px; font-weight: bold;">&nbsp;</span><span class="Apple-style-span" style="font-size: 19px; font-weight: bold;">Sunday, September 17 -&nbsp;</span><span class="Apple-style-span" style="font-size: 19px; font-weight: bold;">Hackathon</span><br /><br />Sunday,&nbsp;we had the post-conference-hackathon at <a href="http://twitter.com/hidek">@hidek</a>'s.<br /><br /><div style="text-align: center;"><a href="http://www.flickr.com/photos/u-suke/5088536531/in/set-72157625105552309/" style="margin-right: 10px;" target="_blank" title="Hackathon at @hidek's | Flickr - Photo Sharing!"><img alt="photo" border="0" height="148" src="http://farm5.static.flickr.com/4084/5088536531_c6653518eb.jpg" width="200" /></a><a href="http://www.flickr.com/photos/u-suke/5088536725/in/set-72157625105552309/" target="_blank" title="Hackathon at @hidek's | Flickr - Photo Sharing!"><img alt="photo" border="0" height="149" src="http://farm5.static.flickr.com/4124/5088536725_dea076aa43.jpg" width="200" /></a><br /><br /><a href="http://www.flickr.com/photos/u-suke/5089135834/in/set-72157625105552309/" style="margin-right: 10px;" target="_blank" title="Hackathon at @hidek's | Flickr - Photo Sharing!"><img alt="photo" border="0" height="149" src="http://farm5.static.flickr.com/4133/5089135834_61c47d1b6d.jpg" width="200" /></a><a href="http://www.flickr.com/photos/u-suke/5089136020/in/set-72157625105552309/" target="_blank" title="Footprints of Perl Hackers | Flickr - Photo Sharing!"><img alt="photo" border="0" height="149" src="http://farm5.static.flickr.com/4145/5089136020_e12a955943.jpg" width="200" /></a></div><br /><div style="margin-bottom: 0px; margin-left: 0px; margin-right: 0px; margin-top: 0px;">After the hackathon, we went to a <a href="http://en.wikipedia.org/wiki/Chankonabe">Chankonabe</a> restaurant near @hidek's as the 4th after-patry. We had too many after-parties this week with a lot of fun!<br /><br /><br /><div style="margin-bottom: 0px; margin-left: 0px; margin-right: 0px; margin-top: 0px;"><span class="Apple-style-span" style="font-size: 19px; font-weight: bold;"><span style="background-color: blue;">&nbsp;</span></span><span class="Apple-style-span" style="font-size: 19px; font-weight: bold;">&nbsp;Related Posts</span></div><ul><li><a href="http://www.slideshare.net/kawa0117/corporate-perl-in-recruit-opensocial-and-emoji-yapcasia-2009-tokyo">Corporate Perl in Recruit, OpenSocial and Emoji‎ - YAPC::Asia 2009 Tokyo</a>&nbsp;2009</li><li><a href="http://kawanet.blogspot.com/2007/04/yapcasia-2007-tokyo-party-hackathon.html">YAPC::Asia 2007 Tokyo + Party + Hackathon</a>&nbsp;2008</li><li><a href="http://kawanet.blogspot.com/2008/05/yapcasia-2008-tokyo-dom-manipulation-by.html">YAPC::Asia 2008 Tokyo - DOM manipulation by Wiimote/Gainer over HTTP</a>&nbsp;2007</li><li><a href="http://kawa.at.webry.info/200603/article_11.html">[YAPC] YAPC::Asia 2006 has just begun!</a>&nbsp;2006 (ja)</li></ul></div> [Perl] XML::TreePP - A pure Perl implementation for parsing/writing xml file http://www.kawa.net/works/perl/treepp/treepp-e.html 2010-10-31T20:15:00+09:00 Perl XML::TreePP module parses XML file and expand it for a hash tree. And also this generates XML file from a hash tree. This module is a pure Perl implementation. You can also fetch an XML file from remote web server like an XMLHttpRequest object in JavaScript language. I think that XML::TreePP is enough fast and easy to use! Released version: XML-TreePP-0.41.tar.gz TARGZ CPAN Subversion repository: http://xml-treepp.googlecode.com/svn/trunk/XML-TreePP/ SVN Documents: README README Changes Changes Encode::JP::Emoji 0.60 Supports Unicode 6.0 Emoji! http://kawanet.blogspot.com/2010/10/encodejpemoji-060-supports-unicode-60.html Yusuke Kawasaki 2010-10-24T05:50:55.641-07:00 emoji perl unicode <div class="separator" style="clear: both; text-align: left;">October 11,&nbsp;Unicode Consortium&nbsp;<a href="http://www.unicode.org/press/pr-6.0.html">released</a> Unicode Version 6.0 including Emoji code points and <a href="http://unicode.org/Public/UNIDATA/EmojiSources.txt">the mapping table</a>. Then, today, I've just shipped <a href="http://search.cpan.org/~kawasaki/Encode-JP-Emoji-0.60/lib/Encode/JP/Emoji.pm">Encode::JP::Emoji version 0.60</a>&nbsp;which supports encoding&nbsp;conversion&nbsp;for variant emojis between Unicode 6.0 and Japanese mobile phone carriers as a fast pure Perl module.</div><blockquote style="font-family: monospace;"><span class="Apple-style-span" style="color: #296d3b; font-size: small; line-height: 15px;">use Encode;<br style="line-height: 16px; margin-bottom: 0px; margin-left: 0px; margin-right: 0px; margin-top: 0px;" />use Encode::JP::Emoji;<br style="line-height: 16px; margin-bottom: 0px; margin-left: 0px; margin-right: 0px; margin-top: 0px;" /><br style="line-height: 16px; margin-bottom: 0px; margin-left: 0px; margin-right: 0px; margin-top: 0px;" />my $sun = "\xF8\x9F";<br style="line-height: 16px; margin-bottom: 0px; margin-left: 0px; margin-right: 0px; margin-top: 0px;" />Encode::from_to($sun, 'x-sjis-e4u-docomo', 'x-utf8-e4u-unicode');<br /># U+2600<br style="line-height: 16px; margin-bottom: 0px; margin-left: 0px; margin-right: 0px; margin-top: 0px;" /><br style="line-height: 16px; margin-bottom: 0px; margin-left: 0px; margin-right: 0px; margin-top: 0px;" />my $watch = encode_utf8 "\x{231A}";<br style="line-height: 16px; margin-bottom: 0px; margin-left: 0px; margin-right: 0px; margin-top: 0px;" />Encode::from_to($watch, 'x-utf8-e4u-unicode', 'x-utf8-e4u-kddiapp');<br /># U+E57A</span></blockquote><div class="separator" style="clear: both; text-align: left;">The code above means:</div><div class="separator" style="clear: both; text-align: left;">$sun: from DoCoMo's F8F9 (Shift_JIS) to Unicode 6.0's U+2600.</div><div class="separator" style="clear: both; text-align: left;">$watch: from Unicode 6.0's U+231A to KDDI's U+E57A (UTF-8).&nbsp;</div><div class="separator" style="clear: both; text-align: left;"><br /></div><h3>Encode::JP::Emoji's Encodings</h3><div class="separator" style="clear: both; text-align: left;"><br /></div><div class="separator" style="clear: both; text-align: left;">Encode::JP::Emoji modules provides numbers of encodings.</div><div class="separator" style="clear: both; text-align: left;">Check the figures below to see which encoding to fit for your use.&nbsp;</div><div class="separator" style="clear: both; text-align: left;"><br /></div><div class="separator" style="clear: both; text-align: left;"></div><div style="margin-bottom: 0px; margin-left: 0px; margin-right: 0px; margin-top: 0px;">Group #1 uses each carrier's&nbsp;private code points as Perl's internal string which has UTF-8 flag on.</div><br /><div class="separator" style="clear: both; text-align: center;"><a href="http://3.bp.blogspot.com/_cgZUdkW7lzE/TMQl_iuL1mI/AAAAAAAAAz0/lbmNBpjADNI/s1600/emoji-group1-b.png" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" height="240" src="http://3.bp.blogspot.com/_cgZUdkW7lzE/TMQl_iuL1mI/AAAAAAAAAz0/lbmNBpjADNI/s400/emoji-group1-b.png" width="400" /></a></div><br />Group #2 uses Googles's private code points internaly. This means Google's encoding could be the interchange encoding for others.<br /><br /><div class="separator" style="clear: both; text-align: center;"><a href="http://3.bp.blogspot.com/_cgZUdkW7lzE/TMQmAUjSlZI/AAAAAAAAAz4/7b4mUn9W14s/s1600/emoji-group2-b.png" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" height="240" src="http://3.bp.blogspot.com/_cgZUdkW7lzE/TMQmAUjSlZI/AAAAAAAAAz4/7b4mUn9W14s/s400/emoji-group2-b.png" width="400" /></a></div><br />Group #3 also uses Google's internal.<br />See Unicode 6.0's emojis are supported here.<br /><br /><div class="separator" style="clear: both; text-align: center;"><a href="http://4.bp.blogspot.com/_cgZUdkW7lzE/TMQmBCKR6rI/AAAAAAAAAz8/JVPXoKqpKMo/s1600/emoji-group34-b.png" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" height="240" src="http://4.bp.blogspot.com/_cgZUdkW7lzE/TMQmBCKR6rI/AAAAAAAAAz8/JVPXoKqpKMo/s400/emoji-group34-b.png" width="400" /></a></div><br />Tha last group #4 rejects any emojis above.<br />Use this group with <a href="http://search.cpan.org/dist/Encode-JP-Emoji/lib/Encode/JP/Emoji/FB_EMOJI_TEXT.pm">FB_EMOJI_TEXT</a> fallback function.<br /><br />For more detail, see <a href="http://search.cpan.org/dist/Encode-JP-Emoji/lib/Encode/JP/Emoji.pm">POD documents</a> on CPAN.<br /><br /><i>* <a href="http://kawa.at.webry.info/201010/article_2.html">Original post of this is posted in Japanese</a>.</i> RT Bookmarklet for Unofficial Retweet Format "RT @kawanet:" of #Twitter. http://kawanet.blogspot.com/2010/08/rt-bookmarklet-for-unofficial-retweet.html Yusuke Kawasaki 2010-10-08T19:47:19.298-07:00 bookmarklet twitter I love writing bookmarklets these days. :)<br /><br />The RT bookmarklet helps you to post a retweet by unofficial style like "RT @kawanet: ..."<br /><br />[ <a href="javascript:(function(){if (location.hostname=='twitter.com') {var t=$('textarea#status, textarea.twitter-anywhere-tweet-box-editor');var n=$('.screen-name:first, .tweet-user-block-screen-name:first, .tweet-screen-name:first').text();var b=$('.entry-content:first, .tweet-text:first').text();n=n.replace(/^@/,'');var r='RT @'+n+': '+b;if (t.length) {t.val(r);} else {location.href='http://twitter.com/home?status='+encodeURIComponent(r);}} else {location.href='http://twitter.com/';}})()">RT</a> ]<br /><br />Use the RT bookmarklet on tweet status (detail) page like below:<br /><a href="http://twitter.com/kawanet/status/20487928914"><img alt="" border="0" id="BLOGGER_PHOTO_ID_5502360085788174514" src="http://4.bp.blogspot.com/_cgZUdkW7lzE/TFxPWGOxKLI/AAAAAAAAAvY/RNgLP27GQes/s400/twitter-sample-4.png" style="cursor: hand; cursor: pointer; display: block; height: 275px; margin: 0px auto 10px; text-align: center; width: 400px;" /></a><br />The tweet content will be quoted in a new tweet:<br /><a href="http://twitter.com/"><img alt="" border="0" id="BLOGGER_PHOTO_ID_5502360088617114610" src="http://3.bp.blogspot.com/_cgZUdkW7lzE/TFxPWQxPW_I/AAAAAAAAAvg/gQqM7zmD6Wk/s400/twitter-sample-6.png" style="cursor: hand; cursor: pointer; display: block; height: 99px; margin: 0px auto 10px; text-align: center; width: 400px;" /></a><br /><h3>BONUS</h3>This also runs at any other domain of twitter.com as a shortcut for <a href="http://twitter.com/">http://twitter.com/</a> top.<br /><br /><h3>UPDATES</h3>2010.10.09 <a href="http://twitter.com/#!/search/%23NewTwitter">#NewTwitter interface</a> supported.<br /><br /><i>* Original post of this is <a href="http://kawa.at.webry.info/201008/article_3.html">written in Japanese</a>.</i> img2html - bookmarklet for blog posting with flickr, picasa, etc. http://kawanet.blogspot.com/2010/09/img2html-bookmarklet-for-blog-posting.html Yusuke Kawasaki 2010-09-26T05:41:35.558-07:00 bookmarklet flickr picasa The <tt>img2html</tt> bookmarklet below helps you to get a html source code with a <tt><img></tt>&nbsp;element which refers photo sharing service, ex. Yahoo's Flickr, Google's Picasa Web Album, etc.<br /><br /><a href="javascript:(function(){var x=240;var y=80;var c=window.img2html_history;if(!c){c={};window.img2html_history=c;}var a=document.getElementsByTagName('img');var p=0;var g;for(var i=0; i<a.length; i++){var tg = a[i];if(!tg.src)continue;if(c[tg.src])continue;var tp = tg.width * tg.height;if(p >= tp)continue;p = tp;g = tg;}var b=document.body;var w=b.style;var o=window.img2html_last;if(o&&!g){w.marginTop='0';window.img2html_history={};}if(o&&o.parentNode){o.parentNode.removeChild(o);}if (!g) return;c[g.src]=true;var l=location.href.replace(/"/g,'&quot;').replace(/#$/,'');var n=document.title.replace(/&/g,'&amp;').replace(/</g,'&lt;').replace(/>/g,'&gt;').replace(/"/g,'&quot;');var z='';if(g.alt){z=g.alt.replace(/&/g,'&amp;').replace(/</g,'&lt;').replace(/>/g,'&gt;').replace(/"/g,'&quot;');z='alt="'+z+'" ';}var h='<a href="'+l+'" target="_blank" title="'+n+'"><img src="'+g.src+'" width="'+g.width+'" height="'+g.height+'" border="0" '+z+'/></a>';var d=document.createElement('div');var u=d.style;u.padding='4px 120px 2px 4px';u.background='#FFFF99';u.margin='-'+(y+1)+'px 0 0 0';u.height=(y-6)+'px';u.position='relative';u.borderBottom='1px solid black';var m=document.createElement('img');m.src=g.src;var v=m.style;v.position='absolute';v.top='0';v.right='0';v.float='right';v.padding='0';v.margin='0';v.background='#FFFFFF';v.borderLeft='1px solid black';m.alt=g.alt;m.title=document.title;var t=document.createElement('textarea');t.value=h;var s=t.style;s.background='#FFFF99';s.border='0';s.wordBreak='break-all';s.fontSize='18px';s.lineHeight='18px';s.width='100%';s.padding='0';s.margin='0';s.overflow='hidden';s.fontFamily='monospace';s.height=(y-6)+'px';d.appendChild(m);d.appendChild(t);b.insertBefore(d,b.firstChild);w.marginTop=(y+1)+'px';if(m.height<y&&m.width<x){v.height=m.height+'px';}else{v.height=y+'px';if(m.clientWidth>x){v.width=x+'px';v.height='';}}var q=Math.floor((y-m.clientHeight)/2);var f=y-m.clientHeight-q;var r=Math.floor((y-m.clientWidth)/2);if(r<0)r=0;v.padding=q+'px '+r+'px '+f+'px '+r+'px';u.paddingRight=Math.floor(m.clientWidth+4)+'px';window.scrollTo(0,0);t.select();t.focus();window.img2html_last=d;})()" style="font-size: 120%; font-weight: bold; margin-left: 40px;">img2html</a><br /><br />You can also try just to click the link above for testing on the site.<br />It generates HTML source code like below:<br /><blockquote style="font-family: monospace; padding: 8px; border: 1px solid gray;">&lt;a href="Page URL" target="_blank" title="Page Title"&gt;&lt;img src="Image URL" width="Image Width" height="Image Height" border="0" alt="Image ALT" /&gt;&lt;/a&gt;</blockquote>The largest image on page is picked up by the bookmarklet.<br />This works on flickr.<br /><br /><a href="http://www.flickr.com/photos/u-suke/5024851856/" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" src="http://3.bp.blogspot.com/_cgZUdkW7lzE/TJ85qOV6KRI/AAAAAAAAAys/buveE0vK_Bs/s1600/cap-flickr.jpg" /></a><br /><br />Also works on Picasa Web Album and any other websites.<br /><br /><a href="http://picasaweb.google.com/www.kawa.net/MashupAwards5Ceremony23#5409776742109241234" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" src="http://3.bp.blogspot.com/_cgZUdkW7lzE/TJ85pocFWQI/AAAAAAAAAyo/NlS8RHwqHRU/s1600/cap-picasa.jpg" /></a><br /><br /><h3>Related Posts</h3><ul><li><a href="http://kawa.at.webry.info/201009/article_7.html">Original post of this</a> written in Japanese</li><li><a href="http://kawanet.blogspot.com/2010/05/fr-bookmarklet-to-get-link-to-flickr.html">fr - a bookmarklet to get a link to flickr</a> (older version)</li></ul> fr - a bookmarklet to get a link to flickr http://kawanet.blogspot.com/2010/05/fr-bookmarklet-to-get-link-to-flickr.html Yusuke Kawasaki 2010-09-26T05:40:16.514-07:00 The fr is a bookmarklet to help you to post your image on flickr to your blog. Tested on IE8, Firefox, Safari and Chrome.<br /><br />[<a href="javascript:(function(){var u=location.href;var z=window.Y?Y.D.getElementsByClassName('photoImgDiv')[0]:document.getElementById('photo');var g=z.getElementsByTagName('img')[0];if(!g)return;var n=document.getElementsByTagName('h1')[0].innerHTML.replace(/"/g,'&quot;');var h='<a href="'+u+'"><img src="'+g.src+'" title="'+n+'" width="'+g.width+'" height="'+g.height+'" border="0"/></a>';var t=document.createElement('TEXTAREA');var s=t.style;s.background='#FFFF99';s.border='1px solid gray';s.wordBreak='break-all';s.marginTop='1em';s.width='100%';s.height='4em';s.fontSize='18px';t.value=h;var b=document.getElementById(window.Y?'Main':'main');if(!b)b=document.body;var f=b.firstChild.tagName;if(f&&f.toUpperCase()=='TEXTAREA')b.removeChild(b.firstChild);b.insertBefore(t,b.firstChild);t.select();t.focus();})();" title="fr">fr</a>]<br /><br />Drag the link [fr] above onto your browser's bookmark toolbar, etc.<br /><br />Access a flickr photo detail page, then click the bookmarklet. This shows an HTML source code which contains the image and links to the flickr page like below:<br /><br /><a href="http://www.flickr.com/photos/u-suke/4550191832/"><img style="display:block; margin:0px auto 10px; text-align:center;cursor:pointer; cursor:hand;width: 400px; height: 120px;" src="http://3.bp.blogspot.com/_cgZUdkW7lzE/S-BHxI48yDI/AAAAAAAAAt4/CW8Cm68VFUE/s400/flickr-bookmark-400.png" border="0" alt=""id="BLOGGER_PHOTO_ID_5467448857153292338" /></a><br /><br /><span style="font-weight:bold;">(07/22/2010 updated)</span><br />Flickr's new interface supported.<br /><br /><span style="font-weight:bold;">(09/26/2010 updated)</span><br /><a href="http://kawanet.blogspot.com/2010/09/img2html-bookmarklet-for-blog-posting.html">New version released</a> which supports Picasa and any other photo sharing service.<br /><br />*<i><a href="http://kawa.at.webry.info/201005/article_4.html">Original post written in Japanese</a>.</i> Cantonese Alphabet - iPhone app for traveling in Hong Kong http://kawanet.blogspot.com/2010/09/cantonese-alphabet-iphone-app-for.html Yusuke Kawasaki 2010-09-23T23:50:27.235-07:00 iPhone <a href="http://click.linksynergy.com/fs-bin/stat?id=p2dVV*6ZlI0&amp;offerid=94348&amp;type=3&amp;subid=0&amp;tmpid=2192&amp;RD_PARM1=http%253A//itunes.apple.com/app/id363512177%253Fmt%253D8%2526uo%253D4%2526partnerId%253D30" imageanchor="1" style="float: right; margin: 0 0 1em 1em;"><img border="0" src="http://2.bp.blogspot.com/_cgZUdkW7lzE/TJxIOGQhyEI/AAAAAAAAAyY/V_AATgQShgk/s1600/hongkong-logo-72.png" style="cursor: move;" /></a>The <a href="http://click.linksynergy.com/fs-bin/stat?id=p2dVV*6ZlI0&amp;offerid=94348&amp;type=3&amp;subid=0&amp;tmpid=2192&amp;RD_PARM1=http%253A//itunes.apple.com/app/id363512177%253Fmt%253D8%2526uo%253D4%2526partnerId%253D30">Canotonese Alphabet</a> mobile application is now available on iTunes App Store. This helps you to read <a href="http://en.wikipedia.org/wiki/Cantonese">Cantonese</a>, spoken in Southern China including Hong Kong. It's just US$1.99. <a href="http://click.linksynergy.com/fs-bin/stat?id=p2dVV*6ZlI0&amp;offerid=94348&amp;type=3&amp;subid=0&amp;tmpid=2192&amp;RD_PARM1=http%253A//itunes.apple.com/app/id363512177%253Fmt%253D8%2526uo%253D4%2526partnerId%253D30">But this now!</a><br /><br /><div class="separator" style="clear: both; text-align: center;"><a href="http://3.bp.blogspot.com/_cgZUdkW7lzE/TJxDITY7CyI/AAAAAAAAAyA/OV8XH0MxLes/s1600/iphone-hongkong-caaufaan.jpg" imageanchor="1"><img border="0" height="400" src="http://3.bp.blogspot.com/_cgZUdkW7lzE/TJxDITY7CyI/AAAAAAAAAyA/OV8XH0MxLes/s400/iphone-hongkong-caaufaan.jpg" width="207" /></a><a href="http://1.bp.blogspot.com/_cgZUdkW7lzE/TJxDJFsOYNI/AAAAAAAAAyE/Qj6DKx0o8rA/s1600/iphone-hongkong-neihou.jpg" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" height="400" src="http://1.bp.blogspot.com/_cgZUdkW7lzE/TJxDJFsOYNI/AAAAAAAAAyE/Qj6DKx0o8rA/s400/iphone-hongkong-neihou.jpg" width="207" /></a></div><br />To enter Cantonese phrases, use iOS's built-in Traditional Chinese hand-writing keyboard. The app also have online translation feature. This means you can translate English to Cantonese to read them in Cantonese.<br /><br /><h3>The Last Piece</h3><br />This was the latest member of the series of my Asian Alphabet applications.<br /><br /><div class="separator" style="clear: both; text-align: center;"><a href="http://2.bp.blogspot.com/_cgZUdkW7lzE/TJxDh7Yu9lI/AAAAAAAAAyU/LMCi5BjQ-yM/s1600/korean-logo-v3-57.png" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" src="http://2.bp.blogspot.com/_cgZUdkW7lzE/TJxDh7Yu9lI/AAAAAAAAAyU/LMCi5BjQ-yM/s1600/korean-logo-v3-57.png" style="cursor: move;" /></a><a href="http://4.bp.blogspot.com/_cgZUdkW7lzE/TJxDXUTgPwI/AAAAAAAAAyI/3kXrFOgnqcA/s1600/beijing-logo-57.png" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" src="http://4.bp.blogspot.com/_cgZUdkW7lzE/TJxDXUTgPwI/AAAAAAAAAyI/3kXrFOgnqcA/s1600/beijing-logo-57.png" /></a><a href="http://1.bp.blogspot.com/_cgZUdkW7lzE/TJxDan5DedI/AAAAAAAAAyM/JqtX5NCEQxY/s1600/taipei-logo-57.png" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" src="http://1.bp.blogspot.com/_cgZUdkW7lzE/TJxDan5DedI/AAAAAAAAAyM/JqtX5NCEQxY/s1600/taipei-logo-57.png" /></a><a href="http://4.bp.blogspot.com/_cgZUdkW7lzE/TJxDdruwbVI/AAAAAAAAAyQ/nG_svreBy_Q/s1600/tokyo-icon-57.png" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" src="http://4.bp.blogspot.com/_cgZUdkW7lzE/TJxDdruwbVI/AAAAAAAAAyQ/nG_svreBy_Q/s1600/tokyo-icon-57.png" /></a><a href="http://1.bp.blogspot.com/_cgZUdkW7lzE/TJxC7N6l4dI/AAAAAAAAAx8/jjZwJvGYsyE/s1600/canton-logo-57.png" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" src="http://1.bp.blogspot.com/_cgZUdkW7lzE/TJxC7N6l4dI/AAAAAAAAAx8/jjZwJvGYsyE/s1600/canton-logo-57.png" style="cursor: move;" /></a></div><br />Complete all five apps for Korean (Hangul), Chinese (Simplified and Traditional), Japanese and Cantonese!<br /><br /><h3>Related Posts</h3><ul><li><a href="http://kawanet.blogspot.com/2010/09/cantonese-alphabet-iphone-app-for.html">Cantonese Alphabet - iPhone app for traveling in Hong Kong</a> 2010.09.24</li><li><a href="http://kawanet.blogspot.com/2010/09/japanese-alphabet-iphone-app-for-kanji.html">Japanese Alphabet - iPhone App for Kanji and Kana</a>&nbsp;2010.09.24</li><li><a href="http://kawanet.blogspot.com/2010/02/simplified-and-traditional-chinese.html">Simplified and Traditional Chinese Alphabet iPhone Application Shipped!</a>&nbsp;2010.02.27</li><li><a href="http://kawanet.blogspot.com/2010/02/korean-alphabet-iphone-app-built-by.html">The Korean Alphabet, iPhone app built by Flash</a>&nbsp;2010.02.17</li></ul> The Korean Alphabet, iPhone app built by Flash http://kawanet.blogspot.com/2010/02/korean-alphabet-iphone-app-built-by.html Yusuke Kawasaki 2010-09-23T23:49:35.170-07:00 I've shipped <a href="http://kuru2.st/llp/iphone/korean.html">the Korean Alphabet</a> which is a paid iPhone application to study Hangul. It's now <a href="http://click.linksynergy.com/fs-bin/stat?id=p2dVV*6ZlI0&offerid=94348&type=3&subid=0&tmpid=2192&RD_PARM1=http://itunes.apple.com/us/app/korean-alphabet/id355690031%253Fmt=8%2526uo=6%2526partnerId=30" target="itunes_store">available on the iTunes Store</a>. This was build by ActionScript with the Packagers for iPhone® under Adobe's Flash CS5 pre-release beta program. <br /><br /><script type="text/javascript" charset="UTF-8" src="http://cmizer.com/javascripts/version02/swfobject.js"></script><script type="text/javascript" charset="UTF-8" src="http://cmizer.com/javascripts/version02/cmizer_1_0_1.js"></script><div id="cmizer-movie-88535" style="margin-bottom:3px;width:420px;height:390px;"><a href="http://www.adobe.com/shockwave/download/index.cgi?Lang=Japanese&P1_Prod_Version=ShockwaveFlash"><img alt="Get Adobe Flash Player" src="http://cmizer.com/images/version02/160x41_Get_Flash_Player.jpg" style="border:0" /></a></div><script type="text/javascript">var cm_option = new Object();cm_option["auto_play"]="false";cm_option["repeat_play"]=(location.href.charAt(location.href.length-1)=='/')?"false":"true";cm_option["mute"]="false";cm_option["volume"]="50";cm_option["jump_action"]="nomal";SetPlayer("cmizer.com/swfs/cmizer_player.swf",420,390,"cmizer.com/cm/movie/s/ck/42/q4epy.xml","88535", cm_option);</script><br />This app represents Hangul with the Roman (Latin) alphabet to help you to read (say) Korean phrases. Enjoy this when you're traveling in Korea, studying Korean, watching Korean TV dramas, etc.<br /><br /><center><a href="http://click.linksynergy.com/fs-bin/stat?id=p2dVV*6ZlI0&offerid=94348&type=3&subid=0&tmpid=2192&RD_PARM1=http://itunes.apple.com/us/app/korean-alphabet/id355690031%253Fmt=8%2526uo=6%2526partnerId=30"><img src="http://4.bp.blogspot.com/_cgZUdkW7lzE/S3rfIlitQuI/AAAAAAAAAqg/njAuryrLBag/s400/iphone-annyeong.png" border="0" alt=""id="BLOGGER_PHOTO_ID_5438904838612927202" /><img src="http://2.bp.blogspot.com/_cgZUdkW7lzE/S3rfiC_BiFI/AAAAAAAAAqo/7pi2ESxxeO4/s400/iphone-seoul.png" border="0" alt=""id="BLOGGER_PHOTO_ID_5438905276013054034" /></a></center><br /><center><a href="http://click.linksynergy.com/fs-bin/stat?id=p2dVV*6ZlI0&offerid=94348&type=3&subid=0&tmpid=2192&RD_PARM1=http://itunes.apple.com/us/app/korean-alphabet/id355690031%253Fmt=8%2526uo=6%2526partnerId=30" target="itunes_store"><img height="39" width="111" alt="Korean Alphabet" src="http://kuru2.st/iphone/korean/img/marketing_badge.png" /></a></center><br />Hangul is the native phonemic character of Korean language. The system is also called as Korean romanization or latinization. In 2006, I've also released <a href="http://www.kawa.net/works/ajax/romanize/hangul-e.html">the web service version of this</a> for PC web browsers. Note that I'm a native of Japanese language however.<br /><br /><br /><h3>Related Posts</h3><ul><li><a href="http://kawanet.blogspot.com/2010/09/cantonese-alphabet-iphone-app-for.html">Cantonese Alphabet - iPhone app for traveling in Hong Kong</a> 2010.09.24</li><li><a href="http://kawanet.blogspot.com/2010/09/japanese-alphabet-iphone-app-for-kanji.html">Japanese Alphabet - iPhone App for Kanji and Kana</a>&nbsp;2010.09.24</li><li><a href="http://kawanet.blogspot.com/2010/02/simplified-and-traditional-chinese.html">Simplified and Traditional Chinese Alphabet iPhone Application Shipped!</a>&nbsp;2010.02.27</li><li><a href="http://kawanet.blogspot.com/2010/02/korean-alphabet-iphone-app-built-by.html">The Korean Alphabet, iPhone app built by Flash</a>&nbsp;2010.02.17</li></ul> Simplified and Traditional Chinese Alphabet iPhone Application Shipped! http://kawanet.blogspot.com/2010/02/simplified-and-traditional-chinese.html Yusuke Kawasaki 2010-09-23T23:49:18.683-07:00 I'm happy to announce to releasing a couple of the Chinese Alphabet iPhone application. These are Chinese version of the <a href="http://kawanet.blogspot.com/2010/02/korean-alphabet-iphone-app-built-by.html">Korean Alphabet</a> I've released last week.<br /><br /><span style="font-weight:bold;"><a href="http://kuru2.st/llp/iphone/s-chinese.html">Simplified Chinese Alphabet</a></span><br /><br />This tells how to read/pronounce Chinese characters used in the mainland China. You could read Chinese characters by Latin (Roman) alphabet notated.<br /><br /><a href="http://kuru2.st/llp/iphone/s-chinese.html"><img style="margin-right: 1px; width: 208px; height: 400px;" src="http://3.bp.blogspot.com/_cgZUdkW7lzE/S4ktvmIZqpI/AAAAAAAAAq4/v3R9iPBCgaQ/s400/iphone-beijing-nihao.png" border="0" id="BLOGGER_PHOTO_ID_5442931920366840466" /><img style="width: 208px; height: 400px;" src="http://4.bp.blogspot.com/_cgZUdkW7lzE/S4ktwaYH7RI/AAAAAAAAArA/gmPkdGPW95M/s400/iphone-beijing-xialong.png" border="0" id="BLOGGER_PHOTO_ID_5442931934391430418" /></a><br /><br /><span style="font-weight:bold;"><a href="http://kuru2.st/llp/iphone/t-chinese.html">Traditional Chinese Alphabet</a></span><br /><br />This is the traditional, complex and old-styled, Chinese characters version which are used in Taiwan and Hong Kong.<br /><br /><a href="http://kuru2.st/llp/iphone/t-chinese.html"><img style="margin-right: 1px;width: 208px; height: 400px;" src="http://1.bp.blogspot.com/_cgZUdkW7lzE/S4ktykYLxmI/AAAAAAAAArI/AdnKs1__wfU/s400/iphone-taipei-nihao.png" border="0" id="BLOGGER_PHOTO_ID_5442931971435775586" /><img style="width: 208px; height: 400px;" src="http://2.bp.blogspot.com/_cgZUdkW7lzE/S4ktzc_NT9I/AAAAAAAAArQ/qP3kbape-rY/s400/iphone-taipei-xiaolong.png" border="0" id="BLOGGER_PHOTO_ID_5442931986631839698" /></a><br /><br />Once I've got a taxi at Beijing, the driver could not understand the Great Wall I said. I hope the app would help such scenes.<br /><br /><br /><h3>Related Posts</h3><ul><li><a href="http://kawanet.blogspot.com/2010/09/cantonese-alphabet-iphone-app-for.html">Cantonese Alphabet - iPhone app for traveling in Hong Kong</a> 2010.09.24</li><li><a href="http://kawanet.blogspot.com/2010/09/japanese-alphabet-iphone-app-for-kanji.html">Japanese Alphabet - iPhone App for Kanji and Kana</a>&nbsp;2010.09.24</li><li><a href="http://kawanet.blogspot.com/2010/02/simplified-and-traditional-chinese.html">Simplified and Traditional Chinese Alphabet iPhone Application Shipped!</a>&nbsp;2010.02.27</li><li><a href="http://kawanet.blogspot.com/2010/02/korean-alphabet-iphone-app-built-by.html">The Korean Alphabet, iPhone app built by Flash</a>&nbsp;2010.02.17</li></ul> Japanese Alphabet - iPhone App for Kanji and Kana http://kawanet.blogspot.com/2010/09/japanese-alphabet-iphone-app-for-kanji.html Yusuke Kawasaki 2010-09-23T23:48:37.294-07:00 iPhone <div class="separator" style="clear: both; float: right; margin: 0 0 1em 1em;"><a href="http://click.linksynergy.com/fs-bin/stat?id=p2dVV*6ZlI0&amp;offerid=94348&amp;type=3&amp;subid=0&amp;tmpid=2192&amp;RD_PARM1=http%253A//itunes.apple.com/app/id363521978" imageanchor="1"><img border="0" src="http://2.bp.blogspot.com/_cgZUdkW7lzE/TJw8-SpuxqI/AAAAAAAAAx4/lkC-8QU5nCs/s1600/tokyo-icon-72.png" /></a></div>The <a href="http://click.linksynergy.com/fs-bin/stat?id=p2dVV*6ZlI0&amp;offerid=94348&amp;type=3&amp;subid=0&amp;tmpid=2192&amp;RD_PARM1=http%253A//itunes.apple.com/app/id363521978">Japanese Alphabet</a> mobile application for iPhone / iPod Touch is now on sale at App Store. This helps you to read Japanese phrases when you come to Japan, study Japanese, order something at Japanese restaurants, etc. It's just USD $1.99. <a href="http://click.linksynergy.com/fs-bin/stat?id=p2dVV*6ZlI0&amp;offerid=94348&amp;type=3&amp;subid=0&amp;tmpid=2192&amp;RD_PARM1=http%253A//itunes.apple.com/app/id363521978">Buy this now</a>!<br /><br /><div class="separator" style="clear: both; text-align: center;"><a href="http://click.linksynergy.com/fs-bin/stat?id=p2dVV*6ZlI0&amp;offerid=94348&amp;type=3&amp;subid=0&amp;tmpid=2192&amp;RD_PARM1=http%253A//itunes.apple.com/app/id363521978" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" height="400" src="http://4.bp.blogspot.com/_cgZUdkW7lzE/TJw8sTdeaNI/AAAAAAAAAxk/fwNGE43I6KE/s400/iphone-tokyo-hello.jpg" width="207" /></a><a href="http://click.linksynergy.com/fs-bin/stat?id=p2dVV*6ZlI0&amp;offerid=94348&amp;type=3&amp;subid=0&amp;tmpid=2192&amp;RD_PARM1=http%253A//itunes.apple.com/app/id363521978" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" height="400" src="http://3.bp.blogspot.com/_cgZUdkW7lzE/TJw8tkdm-gI/AAAAAAAAAxo/kmkNKBYMHKU/s400/iphone-tokyo-tokyo.jpg" width="207" /></a></div><br />This allows you to enter Japanese in serveral ways. First, <a href="http://en.wikipedia.org/wiki/Hiragana">Hiaragana</a> software keyboard. Originally iOS doesn't have the feature but the app has.<br /><br /><div class="separator" style="clear: both; text-align: center;"><a href="http://click.linksynergy.com/fs-bin/stat?id=p2dVV*6ZlI0&amp;offerid=94348&amp;type=3&amp;subid=0&amp;tmpid=2192&amp;RD_PARM1=http%253A//itunes.apple.com/app/id363521978" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" src="http://2.bp.blogspot.com/_cgZUdkW7lzE/TJw8zQcm6AI/AAAAAAAAAxw/fFqnxcBPSMo/s1600/ja-kana1.png" /></a></div><br />Second, <a href="http://en.wikipedia.org/wiki/Katakana">Katakana</a> software keyboard. Again, you can easily select a Kana character you want to enter by clicking it from the list.<br /><br /><div class="separator" style="clear: both; text-align: center;"><a href="http://click.linksynergy.com/fs-bin/stat?id=p2dVV*6ZlI0&amp;offerid=94348&amp;type=3&amp;subid=0&amp;tmpid=2192&amp;RD_PARM1=http%253A//itunes.apple.com/app/id363521978" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" src="http://4.bp.blogspot.com/_cgZUdkW7lzE/TJw8z9yhkrI/AAAAAAAAAx0/ZnA-PZX-cX0/s1600/ja-kana3.png" /></a></div><br />You can also use iOS's built-in Traditional Chinese character hand-writing keyboard. Note that most of Kanjis used in Japan are same to Kanjis used in Taiwan. Differences are&nbsp;intelligently&nbsp;corrected by the app.<br /><br /><div class="separator" style="clear: both; text-align: center;"><a href="http://click.linksynergy.com/fs-bin/stat?id=p2dVV*6ZlI0&amp;offerid=94348&amp;type=3&amp;subid=0&amp;tmpid=2192&amp;RD_PARM1=http%253A//itunes.apple.com/app/id363521978" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" src="http://3.bp.blogspot.com/_cgZUdkW7lzE/TJw8y4ch_ZI/AAAAAAAAAxs/vNIerqYcfgQ/s1600/ja-keyboard-hand.png" /></a></div><br />At last, you can call Google Translate from the app. Entering English phrases, you will get Japanese phrases translated and see how to read them.<br /><br /><h3>Related Posts</h3><ul><li><a href="http://kawanet.blogspot.com/2010/09/cantonese-alphabet-iphone-app-for.html">Cantonese Alphabet - iPhone app for traveling in Hong Kong</a> 2010.09.24</li><li><a href="http://kawanet.blogspot.com/2010/09/japanese-alphabet-iphone-app-for-kanji.html">Japanese Alphabet - iPhone App for Kanji and Kana</a>&nbsp;2010.09.24</li><li><a href="http://kawanet.blogspot.com/2010/02/simplified-and-traditional-chinese.html">Simplified and Traditional Chinese Alphabet iPhone Application Shipped!</a>&nbsp;2010.02.27</li><li><a href="http://kawanet.blogspot.com/2010/02/korean-alphabet-iphone-app-built-by.html">The Korean Alphabet, iPhone app built by Flash</a>&nbsp;2010.02.17</li></ul> Yapcasia-en Group Opened! CFP Until August 31! #yapcasia http://kawanet.blogspot.com/2010/08/yapcasia-en-group-opened-cfp-until.html Yusuke Kawasaki 2010-08-31T18:47:51.742-07:00 perl yapc yapcasia I've opened the <b><a href="http://groups.google.com/group/yapcasia-en">yapcasia-en group</a></b> which is a mailing list for YAPC::Asia's speakers, guests and all YAPC lovers. Feel free to join the group when you have an interest in the largest Perl conference on the globe!<br /><br /><a href="http://yapcasia.org/2010/"><img style="display:block; margin:0px auto 10px; text-align:center;cursor:pointer; cursor:hand;width: 400px; height: 300px;" src="http://2.bp.blogspot.com/_cgZUdkW7lzE/THgQsvQN_fI/AAAAAAAAAw0/M4VKWnRY8cE/s400/yapcasia.png" border="0" alt=""id="BLOGGER_PHOTO_ID_5510172504872582642" /></a><br /><h3>About YAPC::Asia Tokyo 2010</h3>Dates: October 15-16, 2010<br />Venue: Tokyo Institute Of Technology, Oo-okayama, Tokyo, Japan<br />Map: <a href="http://maps.google.com/?cid=974026751406604607">http://maps.google.com/?cid=974026751406604607</a><br />Twitter: <a href="http://twitter.com/yapcasia">http://twitter.com/yapcasia</a><br />Website: <a href="http://yapcasia.org/2010/">http://yapcasia.org/2010/</a><br /><br />Note that Call For Paper is open until the next Tuesday, August 31. Go to <a href="http://bit.ly/bwd9SX">the form</a> to submit your proposal.<br /><br /><h3>Related Posts</h3>* <a href="http://kawanet.blogspot.com/2010/05/meet-again-at-yapcasia-2010-tokyo-in.html">Meet again at YAPC::Asia 2010 Tokyo in October</a><br />* <a href="http://www.slideshare.net/kawa0117/corporate-perl-in-recruit-opensocial-and-emoji-yapcasia-2009-tokyo">Corporate Perl in Recruit, OpenSocial and Emoji‎ - YAPC::Asia 2009 Tokyo</a><br />* <a href="http://mtl.recruit.co.jp/blog/2009/08/yapceurope_2009_3.html">YAPC::Europe 2009 Reports</a> (ja)<br />* <a href="http://mtl.recruit.co.jp/blog/2008/08/yapceurope_2008_3.html">YAPC::Europe 2008 Summary</a> (ja)<br />* <a href="http://kawanet.blogspot.com/2008/06/yapcna-2008-in-chicago.html">YAPC::NA 2008 in Chicago</a><br />* <a href="http://kawanet.blogspot.com/2008/05/yapcasia-2008-tokyo-dom-manipulation-by.html">YAPC::Asia 2008 Tokyo - DOM manipulation by Wiimote/Gainer over HTTP</a><br />* <a href="http://kawanet.blogspot.com/2007/04/yapcasia-2007-tokyo-party-hackathon.html">YAPC::Asia 2007 Tokyo + Party + Hackathon</a><br />* <a href="http://kawa.at.webry.info/200603/article_13.html">[YAPC] YAPC::Asia 2006 Sessions</a> (ja)<br /><br /><h3>@yapcasia's Official Tweet</h3><!-- http://twitter.com/yapcasia/status/22291267293 --> <style type='text/css'>.bbpBox22291267293 {background:url(http://s.twimg.com/a/1281738360/images/themes/theme1/bg.png) #9ae4e8;padding:20px;} p.bbpTweet{background:#fff;padding:10px 12px 10px 12px;margin:0;min-height:48px;color:#000;font-size:18px !important;line-height:22px;-moz-border-radius:5px;-webkit-border-radius:5px} p.bbpTweet span.metadata{display:block;width:100%;clear:both;margin-top:8px;padding-top:12px;height:40px;border-top:1px solid #fff;border-top:1px solid #e6e6e6} p.bbpTweet span.metadata span.author{line-height:19px} p.bbpTweet span.metadata span.author img{float:left;margin:0 7px 0 0px;width:38px;height:38px} p.bbpTweet a:hover{text-decoration:underline}p.bbpTweet span.timestamp{font-size:12px;display:block}</style> <div class='bbpBox22291267293'><p class='bbpTweet'>For the visitors from abroad @<a class="tweet-url username" href="http://twitter.com/kawanet" rel="nofollow">kawanet</a> has kindly taken to organize a mailing list <a href="http://bit.ly/cnEqFf" rel="nofollow">http://bit.ly/cnEqFf</a> <a href="http://twitter.com/search?q=%23yapc" title="#yapc" class="tweet-url hashtag" rel="nofollow">#yapc</a> <a href="http://twitter.com/search?q=%23yapcasia" title="#yapcasia" class="tweet-url hashtag" rel="nofollow">#yapcasia</a><span class='timestamp'><a title='Fri Aug 27 19:12:31 +0000 2010' href='http://twitter.com/yapcasia/status/22291267293'>less than a minute ago</a> via <a href="http://www.echofon.com/" rel="nofollow">Echofon</a></span><span class='metadata'><span class='author'><a href='http://twitter.com/yapcasia'><img src='http://a0.twimg.com/profile_images/51949044/yapc2008_normal.jpg' /></a><strong><a href='http://twitter.com/yapcasia'>yapcasia</a></strong><br/>yapcasia</span></span></p></div> <!-- end of tweet --> Memorial Service for Google Wave at Google's Tokyo Office http://kawanet.blogspot.com/2010/08/memorial-service-for-google-wave-at.html Yusuke Kawasaki 2010-08-23T20:39:36.221-07:00 google googlewave Tokyo, Japan - Japanese developers have held the <a href="http://atnd.org/events/6995">memorial service for Google Wave</a> somberly at Google's Tokyo office. Grieving attendees held <a href="http://dmail.ntt-east.co.jp/p/a02_0140.do?cd=5381">a condolence telegram</a> and the deceased's deadee.<br /><br /><a href="http://www.flickr.com/photos/u-suke/4915480450/"><img src="http://farm5.static.flickr.com/4093/4915480450_7401dd47d0_z.jpg" title="Grieving Attendees of Google Wave Memorial Service in Tokyo" width="400" height="300" border="0"/></a><br /><br />Google Japan respectfully provided their new <a href="http://maps.google.com/?cid=14754714318877864787">Roppongi office</a> as a venue for the memorial service and made an arrangement to style the wallpapers in monotone.<br /><br /><a href="http://www.flickr.com/photos/u-suke/4915480696/"><img src="http://farm5.static.flickr.com/4122/4915480696_f481258291_z.jpg" title="Google Japan styles their wallpaper coloring for the memorial service." width="400" height="300" border="0"/></a><br /><br />The chief mourner, <a href="http://twitter.com/technohippy">Yasushi Ando (@technohippy)</a>, pensively signed his new <a href="http://amzn.to/9vdQRm">Google Wave introductory book</a> which is just published this week.<br /><br /><a href="http://amzn.to/9vdQRm"><img style="float:right; margin:0 0 10px 10px;cursor:pointer; cursor:hand;width: 150px; height: 150px;" src="http://3.bp.blogspot.com/_cgZUdkW7lzE/THDtMh8u1eI/AAAAAAAAAv0/UoQioIspW2A/s320/google-wave-top.jpg" border="0" alt=""id="BLOGGER_PHOTO_ID_5508163143801427426" /></a><a href="http://www.flickr.com/photos/u-suke/4912819704/"><img src="http://farm5.static.flickr.com/4136/4912819704_6f976ec3fe_z.jpg" title="@technohippy signing his Google Wave book" width="240" height="320" border="0"/></a><br /><br />A Googler behaved just positively in her video message which filled our eyes with waves of tears.<br /><br /><a href="http://www.flickr.com/photos/u-suke/4914843043/"><img src="http://farm5.static.flickr.com/4123/4914843043_35c30bd716_z.jpg" title="@pamelafox giving us a video message" width="400" height="300" border="0"/></a><br /><br />Sorry, but too many jokes covered around whole of the memorial service, in fact! :)<br /><br />We all attendees enjoyed the convivial event with beers, wines and laughs.<br /><br /><a href="http://www.flickr.com/photos/u-suke/4915447814/"><img src="http://farm5.static.flickr.com/4115/4915447814_11c5bb74af_z.jpg" title="@technohippy, @MaripoGoda and @tmatsuo san miss #googlewave" width="400" height="300" border="0"/></a><br /><br />The three types of Wave T-shirts above are now rarely acquirable though.<br /><br /><a href="http://www.flickr.com/photos/u-suke/4915447894/"><img src="http://farm5.static.flickr.com/4139/4915447894_df0621145a_z.jpg" title="Google Wave Memorial Service in Tokyo" width="400" height="300" border="0"/></a><br /><br />Thank you, Google Wave, we will never forget you on the cloud.<br /><br />What is the coming next service listed on <a href="http://www.wordstream.com/articles/google-failures-google-flops">Google Graveyard</a>?<br /><br /><i>* <a href="http://kawa.at.webry.info/201008/article_6.html">Japanese version of this post is here</a></i> Shibuya.js won the prize at LT championship, LLTiger http://kawanet.blogspot.com/2010/08/shibuyajs-won-prize-at-lt-championship.html Yusuke Kawasaki 2010-08-22T07:36:20.465-07:00 #lltiger javascript shibuyajs July 31st, the <a href="http://www.jus.or.jp/">Japan UNIX Society</a> hosted the <a href="http://ll.jus.or.jp/2010/">LL Tiger</a> conference as a series of their annual Lightweight Language developer events. Eight teams competed at the <a href="http://ll.jus.or.jp/2010/program/lt">lightening talks tournament championship</a> held in the conference. Our team of Shibuya.js, Tokyo-based JavaScript developers group, did it to win the first prize at the hard knockout competition!<br /><br /><h3>Preliminary Round</h3>Just a day before the championship, we Shibuya.js members had an tech meetup event titled <a href="http://atnd.org/events/6730">Shibuya.js beyond HTML5</a> as the preliminary round to pick up the presenters. <br /><br /><a href="http://www.flickr.com/photos/takesako/4844204334/in/set-72157624491917827/"><img src="http://farm5.static.flickr.com/4110/4844204334_f0396c665c.jpg" title="P1030341.JPG" width="400" height="300" border="0"/></a><br />(photo by @takesako)<br /><br />At the pre-round, three speakers, @gyuque, @yukoba and me was selected. <br /><br /><h2>The First Round - @gyuque</h2>On the following day, our presenter for the first round was <a href="http://twitter.com/gyuque">@gyuque</a>. He gave a talk about a <a href="http://en.wikipedia.org/wiki/Softmodem">software modem</a> implemented by JavaScript. His <a href="http://www.slideshare.net/gyuque/ll-tiger-2010-lt-1">JavaScript FSK modulator</a> generates sound waves for data payloads. Then it plays generated <tt>.wav</tt> data encoded in base64 via <tt>data:</tt> scheme through HTML5's <tt>&lt;audio&gt;</tt> element.<br /><br /><a href="http://www.slideshare.net/gyuque/ll-tiger-2010-lt-1"><img style="width: 400px; height: 308px;" src="http://1.bp.blogspot.com/_cgZUdkW7lzE/THEuQduY8lI/AAAAAAAAAv8/22Yff9d5640/s400/gyuque-lltiger-p10.jpg" border="0" id="BLOGGER_PHOTO_ID_5508234679642813010" /></a><br /><br />See also <a href="http://www.slideshare.net/gyuque/ll-tiger-2010-lt-1">@gyuque's slides</a> on Slideshare.<br /><br /><h2>The Second Round - @kawanet</h2>At the semi-final match, I <a href="http://twitter.com/kawanet">@kawanet</a> gave a talk about <a href="http://www.kawa.net/text/shibuyajs/lltiger/lltiger.html">3D JavaScript</a>. The talk was enhanced since I gave the former talk at <a href="http://kawanet.blogspot.com/2010/04/css3-powered-3d-presentation-osdctw.html">OSDC.TW 2010</a> in Taipei.<br /><br /><a href="http://4.bp.blogspot.com/_cgZUdkW7lzE/THEuQjTK6SI/AAAAAAAAAwE/d9kcOtc0Sug/s1600/3d-javascript-title.jpg"><img style="width: 400px; height: 300px;" src="http://4.bp.blogspot.com/_cgZUdkW7lzE/THEuQjTK6SI/AAAAAAAAAwE/d9kcOtc0Sug/s400/3d-javascript-title.jpg" border="0" id="BLOGGER_PHOTO_ID_5508234681139259682" /></a><br /><br />See also <a href="http://www.kawa.net/text/shibuyajs/lltiger/lltiger.html">my slides</a>.<br /><tt>*</tt> Right cursor or mouse click - Proceed to the next<br /><tt>*</tt> Left cursor - Back to the previous<br /><tt>*</tt> 0 key - Return to the first slide<br /><tt>*</tt> 3 key - Toggle 3D mode and 2D mode<br /><tt>*</tt> Use red-blue glasses to see anaglyph 3D.<br /><br />At the intermission after the first round, we decided to add an additional demo for the second round. Our JavaScript guru @gyuque wrote the <a href="http://gyu.que.jp/jscloth/glass/">real-time 3D demo</a> below within just 30 minutes.<br /><br /><a href="http://gyu.que.jp/jscloth/glass/"><img style="width: 400px; height: 300px;" src="http://4.bp.blogspot.com/_cgZUdkW7lzE/THEuQyORDZI/AAAAAAAAAwM/dUY2h7qBUz0/s400/3d-wireframe.gif" border="0" id="BLOGGER_PHOTO_ID_5508234685145222546" /></a><br /><br /><h3>The Final Round - @yukoba vs. @takesako</h3>At the final, our last speaker <a href="http://twitter.com/yukoba">@yukoba</a> fighted against <a href="http://twitter.com/takesako">@takesako</a> from the <a href="http://ll.jus.or.jp/2010/slide/06-LT-Tiger/Project-D/">Project-D Team</a>. He is a tough rival as he is also a member of our Shibuya.js group. This means the last match is blue-on-blue.<br /><br />Takesako gave a talk about <a href="http://utf-8.jp/public/sas/">an 8086 assembler</a> implemented by JavaScript. The assembler is not normal but generates bytes covered with many ASCII arts of smileys like <tt>[^_^]</tt>.<br /><br /><a href="http://utf-8.jp/public/sas/"><img style="width: 400px; height: 323px;" src="http://2.bp.blogspot.com/_cgZUdkW7lzE/THEuRcS56lI/AAAAAAAAAwc/0PDBxFCj2_M/s400/takesako-aa86.gif" border="0" id="BLOGGER_PHOTO_ID_5508234696438966866" /></a><br /><br />At Yukoba's turn, he gave a talk about <a href="http://www.ustream.tv/recorded/8606236">a JVM including MIDP</a> implemented by JavaScript. He compiles <tt>.class</tt> binary files of Java to <tt>.js</tt> source code files of JavaScript. The compiled code runs on his JS-based JVM which works on HTML5 web browsers including Google Chrome and WebKit. It means mobile phone applications for <a href="http://en.wikipedia.org/wiki/MIDP">MIDP</a> devices would run on iPhone and Android phones without any codes changed. I'm sure that his system has incredible potential for mobile game market.<br /><br /><a href="http://www.ustream.tv/recorded/8606236"><img style="width: 400px; height: 300px;" src="http://2.bp.blogspot.com/_cgZUdkW7lzE/THEuRCh2rrI/AAAAAAAAAwU/whUQqYQT3b4/s400/yukoba-iphone.jpg" border="0" id="BLOGGER_PHOTO_ID_5508234689522347698" /></a><br /><br />See also <a herf="http://ll.jus.or.jp/2010/slide/06-LT-Tiger/Project-D/">@takesako's slides</a> and <a href="http://www.ustream.tv/recorded/8606236">@yukoba's video</a> from 07:40 on Ustream.<br /><br /><h3>I won an iPad!</h3>Our team Shibuya.js won the championship at last. As the bonus prize, I got an iPad. Thanks!<br /><br /><a href="http://www.flickr.com/photos/u-suke/4861858070/"><img src="http://farm5.static.flickr.com/4101/4861858070_c3faaf3755.jpg" title="won the iPad!" width="400" height="266" border="0"/></a><br /><br />Invitations for other tournaments are welcomed. ; )<br /><br /><h3>Related Posts</h3><a href="http://kawanet.blogspot.com/2009/03/2nd-jui-conference-in-adobe-max-japan.html">The 2nd JUI Conference in Adobe MAX Japan 2009</a> - Feb 2009<br /><a href="http://kawanet.blogspot.com/2008/06/jui-2008-tokyo-was-over.html">The JUI 2008 Tokyo was over</a> - Jun 2008<br /><a href="http://kawanet.blogspot.com/2007/11/event-john-resig-and-future-of.html">John Resig and The Future of JavaScript</a> - Oct 2007<br /><a href="http://kawanet.blogspot.com/2007/09/event-shuccho-shibuyajs-24-in-mozilla.html">"Shuccho Shibuya.JS 24" in Mozilla 24</a> - Sep 2007<br /><br />About Shibuya.js, see also <a href="http://ejohn.org/blog/ecmascript-4-speaking-tour/">John Resig's post</a>.<br /><br />* <i><a href="http://kawa.at.webry.info/201008/article_1.html">Original post written in Japanese is here</a></i> #Flickr is still a-bombing on Organizr. (Workaround patch added!) http://kawanet.blogspot.com/2010/08/flickr-is-still-bombing-on-organizr.html Yusuke Kawasaki 2010-08-07T23:58:49.010-07:00 flickr I'm sorry but this post is not in a political campaign. I just want to tell that, today, I feel really sad with the great photo sharing service of <a href="http://www.flickr.com/">flickr</a>.<br /><br />I'm an individual flickr lover and have an Pro account of it. You can also find <a href="http://kawanet.blogspot.com/2010/05/fr-bookmarklet-to-get-link-to-flickr.html">my bookmarklet</a> for flickr.<br /><br />Two weeks ago, I've posted <a href="http://www.flickr.com/groups/flickrideas/discuss/72157600299198503/#comment72157624555651768">a comment</a> on the Flickr Ideas discussion group. The thread titled <a href="http://www.flickr.com/groups/flickrideas/discuss/72157600299198503/">"Drop a A-bomb on flickr!?!"</a> has existed since 2007.<br /><br />In the <a href="http://www.flickr.com/photos/organize/">Flickr Organizr</a>, at removing operations of photos, it shows <a href="http://l.yimg.com/g/images/nuke.gif">a bombing animation</a> as below:<center><a href="http://l.yimg.com/g/images/nuke.gif" target="_blank"><img onClick="this.src='http://l.yimg.com/g/images/nuke.gif'; return false;" src="http://1.bp.blogspot.com/_cgZUdkW7lzE/TFwvOi_cl5I/AAAAAAAAAuo/9WzszDw8i-8/s1600/nuke.jpg" width="300" height="300" border="0" /></a></center><br />I feel uncomfortable whenever I see it. It just evokes the days in Hiroshima and Nagasaki. I thought, however, it would be an imagining thing as I am a Japanese.<br /><br />Last month, I found I was not wrong. The bomb was not just a conventional bomb but was designed as an atomic bomb. The animation GIF file has name of <tt><a href="http://l.yimg.com/g/images/nuke.gif">nuke.gif</a></tt>. This unacceptable discovery makes me posting the comment.<br /><br />Two weeks have passed. Today, August 6, is the 65th anniversary of the bombing on Hiroshima. Flickr is still a-bombing on Organizr. I never do the operation of removing photos on Organizr in order not to see the nuke.<br /><br />I won't think the bombing is a part of spirits of Yahoo.<br /><br /><div style="border-bottom: 1px solid gray;">&nbsp;</div>See also:<br /><a href="http://www.nytimes.com/2010/08/07/world/asia/07japan.html">U.S. Envoy Attends Hiroshima Event</a> - New York Times<br /><a href="http://en.wikipedia.org/wiki/Atomic_bombings_of_Hiroshima_and_Nagasaki">Atomic bombings of Hiroshima and Nagasaki</a> - Wikipedia<br />I don't know U.S. schools teach the terrible horror side of the a-bomb underneath the mushroom-shaped cloud.<br /><br />Note that <a href="http://www.reuters.com/finance/stocks/overview?symbol=4689.T">Yahoo Japan Corporation</a> does NOT provide the flickr service here in Japan market.<br /><br /><a name="organizrpatch"></a><div style="border-bottom: 1px solid gray;">&nbsp;</div><span style="font-weight:bold;">(Updated / August 8)</span><br />I wrote a bookmarklet to patch the Flickr's Organizr.<br /><br />When a photo is removed from batch area, the patched Organizr will just fade it out instead of showing the unwelcome a-bomb animation of <a href="http://l.yimg.com/g/images/nuke.gif">nuke.gif</a>.<br /><br />[<a href="javascript:reorder_drag.prototype.frame_explode=function(){ var e=this.getDragEl(); var a=new YAHOO.util.Anim(e,{opacity:{from:1,to:0}},0.5,YAHOO.util.Easing.easeOut); a.animate();var f=function(){ e.style.opacity=''; e.style.display='none';};reorder_drag.explode_tim=setTimeout(f,1800);}">Organizr Patch</a>]<br /><br />Save above link (bookmarklet) to your bookmark toolbar. And click it just once after you open the <a href="http://www.flickr.com/photos/organize/">Organizr</a>.<br /><br />The source code is below.<br /><blockquote style="font-family: monospace; background: #f0f0f0;">reorder_drag.prototype.frame_explode=function(){<br />&nbsp; var e=this.getDragEl();<br />&nbsp; var a=new YAHOO.util.Anim(e,{opacity:{from:1,to:0}},0.5,YAHOO.util.Easing.easeOut);<br />&nbsp; a.animate();<br />&nbsp; var f=function(){<br />&nbsp;&nbsp; e.style.opacity='';<br />&nbsp;&nbsp; e.style.display='none';<br />&nbsp; };<br />&nbsp; reorder_drag.explode_tim=setTimeout(f,1800);<br />}</blockquote><br /><a href="http://developer.yahoo.com/yui/">YUI library</a> helps this. Yahoo rocks. :) Bookmarklet Viewer Bookmarklet for #iPhone and #iPad http://kawanet.blogspot.com/2010/08/bookmarklet-viewer-bookmarklet-for.html Yusuke Kawasaki 2010-08-06T10:47:19.651-07:00 bookmarklet iPad iPhone The bookmarklet helps you get JavaScript source code of bookmarklets on your iPhone and iPad. Mobile Safari for iPhone/iPad cannot save bookmarklets which have a link to javascript: scheme. Don't give up. Use the bookmarklet below.<br /> <br /><a href="javascript:(function(){var a=document.getElementsByTagName('a');var f;for(var i=0; i<a.length; i++) {var b=a[i];if (! b.href.match(/^javascript:/)) continue;if (b.href.match(/^javascript:void/)) continue;var t=document.createElement('textarea');t.innerHTML=b.href.replace(/&/g,'&amp;').replace(/</g,'&lt;').replace(/>/g,'&gt;').replace(/%2520/g,' ');var s=t.style;s.display='block';s.width='100%';s.height='2em';s.color='#006600';s.background='#EEFFEE';s.border='2px solid #66CC66';s.padding='2px';s.lineHeight='1em';s.wordBreak='break-all';s.fontFamily='monospace';s.fontSize='16px';b.parentNode.replaceChild(t,b);var h=Math.floor(t.scrollHeight+2);s.height=(h>160)?'10em':h+'px';if (f) continue;f=t;t.select();t.focus();}})();">Bookmarklet Viewer</a> Bookmarklet<br /><br /><h3>How to save the Bookmarklet Viewer itself</h3>1. Click above to get the source of Bookmarklet Viewer<br /><br />2. Long-press on the textarea and push [Select All] button<center><img src="http://3.bp.blogspot.com/_cgZUdkW7lzE/TFxIHOWIm1I/AAAAAAAAAvI/rcGC4tnzHvo/s400/iphone-select-all.png" width="320" height="200" /></center> <br />3. Push [Copy] button to copy the source<center><img src="http://1.bp.blogspot.com/_cgZUdkW7lzE/TFxIG_5XFzI/AAAAAAAAAvA/BTB98gKIYs4/s400/iphone-copy.png" width="320" height="200" /></center> <br />4. Push Safari's [+] button then [Add Bookmark] button<br /><br />5. Enter the name of the bookmarklet<br /><br />6. URL cannot be modified at the first time<br /><br />7. Push [Save] button to save the bookmark<br /><br />8. Push Safari's book button then [Edit] button<br /><br />9. Open the bookmark saved, long-press on Address area then push [Paste] button<center><img src="http://1.bp.blogspot.com/_cgZUdkW7lzE/TFxIGmLcmDI/AAAAAAAAAu4/kS6vKky9bvg/s400/iphone-paste.png" width="320" height="244" /></center> <br />10. Close the bookmark<br /><br /><h3>Save other bookmarklets using the Bookmarklet Viewer</h3>Now you're ready to get the bookmarklet with the Bookmarklet Viewer bookmarklet :)<br /> <br />delicious (Extra bookmarklets is recommended)<br /><a href="http://delicious.com/help/bookmarklets">http://delicious.com/help/bookmarklets</a> <br /> <br />bit.ly <br /><a href="http://bit.ly/pages/tools">http://bit.ly/pages/tools</a> <br /> <br />fr - a bookmarklet to get a link to flickr<br /><a href="http://kawanet.blogspot.com/2010/05/fr-bookmarklet-to-get-link-to-flickr.html">http://kawanet.blogspot.com/2010/05/fr-bookmarklet-to-get-link-to-flickr.html</a> <br /> <br />3D Bookmarklet (why don't you use the Web in 3D?)<br /><a href="http://svn.coderepos.org/share/lang/javascript/3D/3d-bookmarklet.html">http://svn.coderepos.org/share/lang/javascript/3D/3d-bookmarklet.html</a> <br /> <br /><i>* Japanese version of this post is <a href="http://kawa.at.webry.info/201008/article_2.html">here</a>.</i> [ajax] JKL.ParseXML - XML Parsing Library for JavaScript http://www.kawa.net/works/js/jkl/parsexml-e.html 2010-05-29T22:57:00+09:00 ajax JKL.ParseXML is a JavaScript library that let you convert an XML into a JavaScript object (JSON). DOM manipulation is not needed any more for you to write Ajax powered dynamic web applications. The first version of this was shipped at May 18th, 2005. For the several years, this has been used on many websites in Japan and other countries in the World. See also SoftXML's nice article about JavaScript libraries including the JKL.ParseXML, thanks. This is free under the BSD license. HTML5 GeoLocation API + Maps Demo http://www.kawa.net/works/geo/html5geomap-e.html 2010-05-09T13:09:00+09:00 Source code: html5geoform.js JavaScript Meet again at YAPC::Asia 2010 Tokyo in October http://kawanet.blogspot.com/2010/05/meet-again-at-yapcasia-2010-tokyo-in.html Yusuke Kawasaki 2010-05-03T00:48:55.441-07:00 I was back to Japan from Taiwan. It's my third time to attend the OSDC.TW. I must say thank you for the Taiwanese hackers to warmly welcome us, <a href="http://kawanet.blogspot.com/2010/04/shibuya-perl-mongers-comes-into-taipei.html">Shibuya.pm</a>, to have our first tech talk session abroad. More than a few of us, including me, must attend the OSDC.TW again next year.<br /><br />By the way, some people there asked me when the YAPC::Asia Tokyo would be held. It's not officially announced in English.<br /><br /><a href="http://www.flickr.com/photos/u-suke/3911913810/"><img style="display:block; margin:0px auto 10px; text-align:center;cursor:pointer; cursor:hand;width: 400px; height: 266px;" src="http://3.bp.blogspot.com/_cgZUdkW7lzE/S959SaiVvzI/AAAAAAAAAtQ/DiGg95EL3Zw/s400/yapc-asia-2009.jpg" border="0" alt=""id="BLOGGER_PHOTO_ID_5466944752988831538" /></a><br /><a href="http://twitter.com/941">@941</a>-san who is the events organizing lead in the JPA, Japan Perl Association, <a href="http://blog.perlassociation.org/2010/04/yapcasia-tokyo-2010.html">has announced</a> the brief schedule for the YAPC::Asia 2010 Tokyo as following:<br /><br /><ul><li>May - the first splash website opened</li><li>July - CFP started</li><li>August - registration started</li><li>October - curtain-up!</li></ul><br />Details about the venue and exact date don't seem fixed yet. They are planning to hold it at somewhere in/near Tokyo at October 14th-16th as their current plan noted only in Japanese. After fixed by the JPA, the details would be announced also in English as in the past years.<br /><br />I hope you all friends could meet here again at Japan's beautiful season of Autumn. 3D Bookmarklet - Enjoy 3D world on the Web by CSS3 http://kawanet.blogspot.com/2010/05/3d-bookmarklet-enjoy-3d-world-on-web-by.html Yusuke Kawasaki 2010-05-02T23:42:54.678-07:00 The <a href="http://svn.coderepos.org/share/lang/javascript/3D/3d-bookmarklet.html">3D Bookmarklet</a> is a bookmarklet which allows you to dive into the 3D-world on the Web. CSS3 capable browser is needed. Firefox 3.5 and Chrome 5 is tested.<br /><br /><a href="hhttp://svn.coderepos.org/share/lang/javascript/3D/3d-bookmarklet.html"><img style="display:block; margin:0px auto 10px; text-align:center;cursor:pointer; cursor:hand;width: 400px; height: 300px;" src="http://2.bp.blogspot.com/_cgZUdkW7lzE/S95o8PNx6ZI/AAAAAAAAAsw/pBS4C1dXnZE/s400/nytimes-3d-400.jpg" border="0" id="BLOGGER_PHOTO_ID_5466922381760129426" /></a><br />* <a href="http://svn.coderepos.org/share/lang/javascript/3D/3d-bookmarklet.html">Get the 3D bookmarklet</a><br /><br />Drag the link <strong>[3D]</strong> onto your browser's bookmark toolbar, etc.<br /><br />* <a href="javascript:(function(){ var webkit=/webkit/i.test(navigator.userAgent); var imp=webkit?' !important':''; var l=document.getElementsByTagName('*'); var m={a:1.3,em:1.3,strong:1.3}; for(var i=0; i != l.length; i++){ var e=l[i]; var t=e.tagName.toLowerCase(); if(e.text=='')continue; if(t=='select')continue; var s=parseInt(getComputedStyle(e,'').fontSize); var d=s/4; if (d&lt;10) d=10; d *= m[t] || 1; e.style.color='rgba(255,0,0,0.5)'+imp; e.style.textShadow=d+'px 0 0 rgba(0,255,191,0.5)'+imp; };})();">Try now on this page</a><br /><br />Every 2D websites will come into 3D with this. You need to have a red/blue (anaglyph) 3D glasses by yourself. The CSS3 standard allows iPhone and <a href="http://www.flickr.com/photos/u-suke/4554223887/">iPad to run this</a>. Enjoy 3D everywhere!<br /><br /><a href="http://svn.coderepos.org/share/lang/javascript/3D/3d-bookmarklet.html"><img style="display:block; margin:0px auto 10px; text-align:center;cursor:pointer; cursor:hand;width: 400px; height: 266px;" src="http://4.bp.blogspot.com/_cgZUdkW7lzE/S95o8Q_K8DI/AAAAAAAAAs4/WQ_NP73SgAA/s400/3d-glass.jpg" border="0" id="BLOGGER_PHOTO_ID_5466922382235725874" /></a><br />Gugod and I have corroborated to the code snippet as a result from the <a href="http://mtl.recruit.co.jp/blog/2010/04/osdctw_2010.html">OSDC.TW Hackathon</a>.<br /><br /><h3>How this works</h3>This sets all text's CSS <tt>color</tt> property to red, and also sets <tt>text-shadow</tt> property to blue on right. Gugod gave me an idea to hack to draw with alpha channel using <tt>rgba()</tt>. Each 3D layer, depth, is depend on sort of its element and font size. Firefox seems not to allow <strong>!important</strong> within element's <tt>style</tt> attribute. Chrome however does. Only texts are made into 3D. Images are not yet at this version.<br /><br />* <i><a href="kawa.at.webry.info/201004/article_5.html">See also the original post in Japanese. (日本語)</a></i><br /><br /><h3>PS.</h3>Hualien is a city located at East Coast of Taiwan. You may know everybody in town there wears 3D glasses to enjoy 3D world. :)<br /><a href="http://www.flickr.com/photos/u-suke/4565018187/"><img style="display:block; margin:0px auto 10px; text-align:center;cursor:pointer; cursor:hand;width: 400px; height: 267px;" src="http://2.bp.blogspot.com/_cgZUdkW7lzE/S95tYmwXNeI/AAAAAAAAAtA/zX8O1OhpXdI/s400/3d-hualien.jpg" border="0" id="BLOGGER_PHOTO_ID_5466927267162043874" /></a> CSS3 Powered 3D Presentation - OSDC.TW 2010 http://kawanet.blogspot.com/2010/04/css3-powered-3d-presentation-osdctw.html Yusuke Kawasaki 2010-04-28T02:39:49.731-07:00 You're still running the classical 2D-era presentation tools, e.g. PowerPoint or Keynote? The 3D-era has just come since <a href="http://kawanet.blogspot.com/2010/04/shibuya-perl-mongers-comes-into-taipei.html">OSDC.TW 2010</a>.<br />&nbsp;<br />I gave <a href="http://www.kawa.net/text/osdc.tw/2010/osdctw2010.html?3d">Something Xiaolongbao</a> talk at the most major open source developers conference in Taiwan.<br /><br /><a href="http://www.kawa.net/text/osdc.tw/2010/osdctw2010.html?3d"><img style="display:block; margin:0px auto 10px; text-align:center;cursor:pointer; cursor:hand;width: 400px; height: 300px;" src="http://2.bp.blogspot.com/_cgZUdkW7lzE/S9f_M5gNE4I/AAAAAAAAAsg/Ml0oNlRQfVg/s400/ss-01.jpg" border="0" alt=""id="BLOGGER_PHOTO_ID_5465117269896795010" /></a><br />This year's main theme in my talk is the 3D presentation using CSS3 techs. I wrote an HTML5/JavaScript-based presentation tool for the talk.<br /><br /><a href="http://www.kawa.net/text/osdc.tw/2010/osdctw2010.html?3d"><img style="display:block; margin:0px auto 10px; text-align:center;cursor:pointer; cursor:hand;width: 400px; height: 300px;" src="http://3.bp.blogspot.com/_cgZUdkW7lzE/S9f_NWYoKnI/AAAAAAAAAso/2kGX0O-MX4U/s400/ss-02.jpg" border="0" alt=""id="BLOGGER_PHOTO_ID_5465117277649644146" /></a><br />Usage:<br />Next Slide - Mouse Click, Space Key or Right Arrow Key<br />Prev Slide - Left Arrow key<br />First Slide - [0] Key<br />3D Mode Toggle - [3] Key<br /><br />For 3D newbie, try [3] key to turn off 3D and <a href="http://www.kawa.net/text/osdc.tw/2010/osdctw2010.html">fall back to 2D</a>. :)<br /><br />The slides are based on HTML5 / JavaScript / CSS3 and the cutting-edge 3D tech of "<a href="http://en.wikipedia.org/wiki/Anaglyph_image">anaglyph</a>." I've brought some red-blue 3D glasses for the conference from Japan.<br /><br />At the OSDC.TW day 1 early morning, I wrote <strong>pptx2html53d.pl</strong>, a Perl script to convert from PowerPoint .pptx file to 3D HTML5 .html. I'll make it open later. Basically .pptx file is a ZIP file. It's pretty easy to parse .pptx using Archive::Zip and XML::TreePP Perl modules. <strong>pptx2html53d.pl</strong> generates a HTML5 source code.<br /><br />At first, I also used SVG's <tt>feColorMatrix</tt> feature for 3D. It's however cancelled at this moment as not working well. And also Chrome 5 for Mac seems it could not run <a href="http://www.yomotsu.net/wp/wp-content/uploads/2009/090510_demo/demo3.xhtml">SVG's <tt>filter</tt> element</a>. The slides above are updated as Gugod gave me nice advices around CSS3 usage of <tt>text-shadow</tt>.<br /><br />Buy 3D glasses in town and enjoy 3D presentation now.<br /><br />* <i><a href="http://kawa.at.webry.info/201004/article_4.html">Original post written in Japanese(日本語はコチラ)</a></i> Shibuya Perl Mongers comes into Taipei! - OSDC.TW 2010 http://kawanet.blogspot.com/2010/04/shibuya-perl-mongers-comes-into-taipei.html Yusuke Kawasaki 2010-04-22T09:44:13.223-07:00 The Shibuya.pm comes in Taipei!<br /><a href="http://shibuya.pm.org/">The Shibuya Perl Mongers</a> is a community of Perl hackers based in Tokyo. The super hackers give technical talks away in the special sub-conference of the <a href="http://osdc.tw/2010/">OSDC.TW 2010</a>. You'll see the highest level in techniques and the lowest level in depth of Perl with us.<br />Don't miss this and enjoy.<a onblur="try {parent.deselectBloggerImageGracefully();} catch(e) {}" href="http://osdc.tw/2010/"><img style="display:block; margin:0px auto 10px; text-align:center;cursor:pointer; cursor:hand;width: 200px; height: 200px;" src="http://1.bp.blogspot.com/_cgZUdkW7lzE/S9Bv0FkCO5I/AAAAAAAAAsY/Ok_WAwkxIlI/s400/osdc_logo-2010.png" border="0" alt=""id="BLOGGER_PHOTO_ID_5462989288637610898" /></a><h3>Speakers</h3><ul><li>竹迫 良範 (Yoshinori Takesako) <a href="http://twitter.com/takesako">@takesako</a> - Polyglot Programming<br /><li>石垣 憲一 (Kenichi Ishigaki) <a href="http://twitter.com/charsbar">@charsbar</a> - Perl for a translator<br /><li>藤 吾郎 (Goro Fuji) <a href="http://twitter.com/__gfx__">@__gfx__</a> - Xslate - A high performance template engine<br /><li>川崎 有亮 (Yusuke Kawasaki) <a href="http://twitter.com/kawanet">@kawanet</a> - Something Xiaolongbao<br /><li>檀上 伸郎 (Nobuo Danjou) <a href="http://twitter.com/lopnor">@lopnor</a> - Net::Google::Spreadsheet<br /><li>宮川 達彦 (Tatsuhiko Miyagawa) <a href="http://twitter.com/miyagawa">@miyagawa</a> - cpanminus<br /><li>松野 徳大 (Tokuhiro Matsuno) <a href="http://twitter.com/tokuhirom">@tokuhirom</a> - Perl5.12's new feature - PL_keyword_plugin *hack*<br /><li>大沢 和宏 (Kazuhiro Osawa) <a href="http://twitter.com/yappo">@yappo</a> - Ajax application testing</ul><br />This is <a href="http://shibuya.pm.org/blosxom/techtalks/201004.html">the 13th tech talk conference</a> by Shibuya.pm and the first time abroad.<br />At the day of the hackathon soon after the last <a href="http://conferences.yapcasia.org/ya2009/">YAPC::Asia 2009 conference</a> was over, we had a lot to talk about foreign conferences to attend. I'm really happy that it's come true.<br /><br /><h3>What's Shibuya</h3><br /><a href="http://en.wikipedia.org/wiki/Shibuya,_Tokyo">Shibuya</a> is a culture heart district of Tokyo. The word Shibuya (渋谷) literally means "Bitter Valley." Like Silicon Valley, many Web/IT companies have started up from Shibuya.<br /><br />That is, Shibuya is just a symbol for us. There is a fact that we've never had a tech talk conference in Shibuya district though.<br /><br /><h3 name="rubyconf">RubyConf Taiwan 2010</h3><br />The next day of Shibuya.pm in Taipei, three Ruby hackers from Japan will also give talks in the same venue. <a href="http://rubyconf.tw/2010/">RubyConf Taiwan 2010</a> is the first regional Ruby Conference in Taiwan. Arai-san, <a href="http://twitter.com/kakutani">Kakutani-san</a> and <a href="http://twitter.com/takahashim">Takahashi-san</a> will come to speak there.<br /><br />At the Spring, eight Perl guys and three Ruby guys, from Japan, will attend the conferences in Taiwan. I'm sure that we could boost the stream of the kind of international exchanges between East Asian developer communities.<br /><br /><h3 name="omake">Last year</h3><br />This is my third time to attend the OSDC.TW.<br /><br />- <a href="http://kawanet.blogspot.com/2009/04/jsar-javascript-argumented-reality-at.html">JSAR (JavaScript Augmented Reality) at OSDC.TW 2009 Taipei</a><br />- <a href="http://kawanet.blogspot.com/2008/05/osdctw-2008-dom-manipulation-by.html">OSDC.TW 2008 - DOM manipulation by Wiimote/Gainer over HTTP</a><br /><br />I've given talks about JavaScript and Flash in addition to Perl.<br />For this year, I had a plan of a new topic, however, it's forced to be canceled due to a sudden change of a SDK license agreement this month. orz.<br />I need to write new slides until the time of my slot at Saturday.<br /><br /><hr>* <i><a href="http://kawa.at.webry.info/201004/article_3.html">See also Japanese version of this post</a></i> KTween 1.0.1 Released - Simple & Fast Tween Engine for AS3 http://kawanet.blogspot.com/2010/04/ktween-101-released-more-faster-tween.html Yusuke Kawasaki 2010-04-13T18:16:19.523-07:00 KTween is now as fast as the cool tween engine of the Eaze Tween. The Eaze has jQuery-like method chain interface. Philippe Elsass has pointed that <a href="http://twitpic.com/13f7b9">his Eaze Tween is faster</a> than KTween, soon after <a href="http://kawanet.blogspot.com/2010/02/ktween-worlds-fastest-simple-tween.html">my last post</a>.<br />Now, here comes KTween's turn:<br /><br /><a href="http://code.google.com/p/kawanet/"><img style="display:block; margin:0px auto 10px; text-align:center;cursor:pointer; cursor:hand; width: 400px; height: 240px;" src="http://1.bp.blogspot.com/_cgZUdkW7lzE/S8SVEj5oQuI/AAAAAAAAArY/r8LBcRnEZIQ/s400/ktween-bench-0413-graph.png" border="0" /></a><br />Running on my MacBook Pro, Mac OS X 10.6.3, Core 2 Duo 2.26GHz, <a href="http://labs.adobe.com/downloads/flashplayer10.html">Flash Player 10.1 Release Candidate</a>, Firefox plug-in, the bench shows the KTween is a teeny bit faster than the Eaze. However, I could say it's still in the range of error.<br /><br /><a href="http://kawanet.googlecode.com/svn/lang/as3/KTween/trunk/site/benchmark.html"><img style="display:block; margin:0px auto 10px; text-align:center;cursor:pointer; cursor:hand; width: 267px; height: 400px;" src="http://3.bp.blogspot.com/_cgZUdkW7lzE/S8SVFE0UkHI/AAAAAAAAArg/fxM2IdpWTF0/s400/ktween-bench-0413-result.png" border="0" /></a><br /><a href="http://kawanet.googlecode.com/svn/lang/as3/KTween/trunk/tests/Benchmark.as">The bench</a> runs with the engines below:<br /><a href="http://kawanet.googlecode.com/svn/lang/as3/KTween/trunk/src/">KTween</a> - Version 1.0.1 Revision 79<br /><a href="http://www.libspark.org/svn/as3/BetweenAS3/trunk/">BetweenAS3</a> - Revision 3765.<br /><a href="http://www.gskinner.com/libraries/gtween/">GTween</a> - Version 2.01 (2009/12/11)<br /><a href="http://tweener.googlecode.com/svn/trunk/as3/">tweener</a> - Revision 424<br /><a href="http://www.greensock.com/tweennano/">TweenNano</a> – Version 1.03 (2010/04/03)<br /><a href="http://eaze-tween.googlecode.com/svn/trunk/as3/src/">eaze-tween</a> - Revision 74<br /><br />I guess it'd be rare that a case tweens 4,000 particles though. :-)<br />KTween is an open source distributed under the MIT license.<br /><br />Try KTween.<br /><br />Download: <a href="http://code.google.com/p/kawanet/">KTween 1.0.1</a> (20100413)<br /><br />* <i>The original post written in Japanese is <a href="http://kawa.at.webry.info/201004/article_1.html">here</a></i><br /><br /><span style="font-size: 80%;">* Note that the benchmark result is depend on machine, OS, flash player version and revision etc. The BetweenAS3 becomes the fastest engine in the six above in a case for instance.</span> Japanese Alphabet - Romanization of Japanese characters (Kanji/Kana) http://www.kawa.net/works/ajax/romanize/japanese-e.html 2010-03-01T00:33:00+09:00 Japanese language is written with a mix of Kanji and Kana characters. Most of Kanji characters used in Japan were imported from China. Two types of Kana characters, called Katakana and Hiragana, were created in Japan. Kana characters are general terms for the syllabic Japanese scripts. Enter some Japanese phrases and push the button below. iSWF - iPhone Appearance Simulator for Flash http://kawanet.blogspot.com/2010/02/iswf-iphone-appearance-simulator-for.html Yusuke Kawasaki 2010-02-27T06:21:33.649-08:00 The iSWF is an appearance simulator for iPhone applications developed by Flash. This helps you to develop iPhone app and take its screen capture on your Mac.<br /><br />Get iSWF from Google Code:<br /><a href="http://code.google.com/p/kawanet/downloads/detail?name=iSWF-20100227.zip">http://code.google.com/p/kawanet/downloads/detail?name=iSWF-20100227.zip</a><br /><br /><a onblur="try {parent.deselectBloggerImageGracefully();} catch(e) {}" href="http://click.linksynergy.com/fs-bin/stat?id=p2dVV*6ZlI0&offerid=94348&type=3&subid=0&tmpid=2192&RD_PARM1=http://itunes.apple.com/us/app/id358471897%253Fmt%253D8%2526uo%253D6%2526partnerId%253D30"><img style="display:block; margin:0px auto 10px; text-align:center;cursor:pointer; cursor:hand;width: 300px; height: 400px;" src="http://1.bp.blogspot.com/_cgZUdkW7lzE/S4kib5kSoHI/AAAAAAAAAqw/c0shGAbpOo4/s400/iSWF-sample.jpg" border="0" alt=""id="BLOGGER_PHOTO_ID_5442919487358804082" /></a><br /><br /><span style="font-weight:bold;">1. Install iPhone SDK</span><br /><br />At first, get and install the iPhone SDK from Apple:<br /><a href="http://developer.apple.com/iphone/">http://developer.apple.com/iphone/</a><br /><br />"iPhone SDK 3.1.3 with Xcode 3.1.4" for 10.5 (Leopard) users,<br />"iPhone SDK 3.1.3 with Xcode 3.2.1" for 10.6 (Snow Leopard) users.<br /><br />After installing it, try to run iPhone Simulator located at:<br />/Developer/Platforms/iPhoneSimulator.platform/Developer/Applications<br /><br />Important note, as you know, iPhone's Safari could not run Flash.<br /><br /><span style="font-weight:bold;">2. Install AIR 2.0 Beta SDK</span><br /><br />Install AIR 2.0 Beta SDK as the next.<br />Note skip this step when you're already using CS5.<br /><br /><a href="http://labs.adobe.com/downloads/air2.html">http://labs.adobe.com/downloads/air2.html</a><br />Click "Download for Macintosh (TBZ2, 17.9 MB)".<br /><br />Unzip air2_b2_sdk_mac_020210.tbz2 and change the folder name as "AIK2.0" and move the folder to "/Applications/Adobe Flash CS4" . Check black "adl" icon at<br />/Applications/Adobe Flash CS4/AIK2.0/bin<br /><br /><span style="font-weight:bold;">3. Publish .swf </span><br /><br />Publish your MyApp.swf using your CS4.<br />Flash Player 10, 320px width, 480px height and any frame rate.<br /><br /><span style="font-weight:bold;">4. Get iSWF package</span><br /><br />Get the iSWF package from Google Code:<br /><a href="http://code.google.com/p/kawanet/downloads/detail?name=iSWF-20100227.zip">http://code.google.com/p/kawanet/downloads/detail?name=iSWF-20100227.zip</a><br /><br />Unzip the archive and move its contents to the folder of MyApp.swf. Then double click iSWF.command to run MyApp.swf. You would see the appearance simulator running as the first picture of the post.<br /><br />Copy each three files of iSWF to any other your .swf project.<br /><br /><span style="font-weight:bold;">5. How it works?</span><br /><br />The iSWF runs the most recent changed .swf file in the same folder. It's quite simple. See the iSWF.html. The iSWF uses the same appearance of Apple's iPhone Simulator. This means iSWF could not run on Windows which Apple doesn't care for.<br /><br /><span style="font-weight:bold;">6. ActionScript for iPhone</span><br /><br />Flash application for iPhone is based on AIR technology. The iSWF, however, runs the app in the localTrusted sandbox. And also multi-touch, GPS, File class and iPhone's native keyboard are not avaible with iSWF. Wait CS5 released for you to start such developments.<br /><br />(<a href="http://kawa.at.webry.info/201002/article_7.html">※日本語版の解説はコチラを参照ください</a>)<br /><br />AIR 2.0 Document:<br /><a href="http://help.adobe.com/en_US/FlashPlatform/beta/reference/actionscript/3/">http://help.adobe.com/en_US/FlashPlatform/beta/reference/actionscript/3/</a><br /><br />Flash Player 10.1 ActionScript 3.0 Document:<br /><a href="http://help.adobe.com/en_US/air/reference/html/">http://help.adobe.com/en_US/air/reference/html/</a> [Perl] Lingua::*::Romanize::* - Romanization of CJK characters http://www.kawa.net/works/perl/romanize/romanize-e.html 2008-01-20T19:30:00+09:00 Perl Lingua::*::Romanize::* modules generate roman letteres from CJK characters. Lingua::ZH::Romanize::Pinyin module parses Chinese characters, both of Mandarin and Cantonese. Lingua::JA::Romanize::Japanese module parses Japanese characters, both of Kanji and Kana. Lingua::KO::Romanize::Hangul module parses Korean characters, Hangul. [Perl] XML::OverHTTP - A base class for XML over HTTP-styled web service interface http://www.kawa.net/works/perl/overhttp/overhttp-e.html 2007-08-12T22:15:00+09:00 Perl XML::OverHTTP is a base class for XML over HTTP-styled web service interface. This is not used directly from end-users. As a child class of this, module authors can easily write own interface module for XML over HTTP-styled web service. Current version: XML-OverHTTP-0.07.tar.gz TARGZ CPAN [JavaScript] Animation.Cube - Rotating Cube Animation Effect http://www.kawa.net/works/js/animation/cube-e.html 2007-01-08T17:19:00+09:00 JavaScript Animation.Cube class is a JavaScript library for a rotating cube animation effect. This effect needs CPU speed faster than Animation.Raster class. Ruby on Chinese Pinyin http://www.kawa.net/works/cantonese/canton.html 2006-11-10T10:33:00+09:00 Ajax-ized web service version of this is also available. Try it! NEW Type (or copy&paste) some chinese characters and push the button. [ajax] AjaxTB - a pluggable trackback feature in static HTML page http://www.kawa.net/works/ajax/ajaxtb/ajaxtb-e.html 2006-09-19T00:38:00+09:00 ajax AjaxTB provides your static pages with trackback feature. AjaxTB' CGI part works to receive a trackback which is sent by visiters. AjaxTB' JavaScript part works to display trackbacks received. CMS is not needed. PHP is not required. AjaxTB is really pluggable and easy to use. Indexed RSS and JSON files are also generated when a trackback is posted. [ajax] AjaxCom - one line comment box in static HTML page http://www.kawa.net/works/ajax/ajaxcom/ajaxcom-e.html 2006-09-19T00:34:00+09:00 ajax AjaxCom provides your pages with one line comment box. You and your visiters can write comments in your static page! You know, ajax is used here. CMS is not required. PHP is not required. Ajaxcom is pluggable and easy to use. Perl/CGI works only when comments are entered. A plain text file is loaded when comments are displayed. [JavaScript] XML.ObjTree - XML source code from/to JavaScript object like E4X http://www.kawa.net/works/js/xml/objtree-e.html 2006-08-18T03:14:00+09:00 JavaScript XML.ObjTree class is a parser/generater for XML source code and JavaScript object. This is a JavaScript version of XML::TreePP for Perl. This also works as a wrapper for XMLHTTPRequest and successor to JKL.ParseXML class when using with prototype.js or JSAN's HTTP.Request class. Attributes' prefix '@' like E4X (ECMAScript for XML) is also available. Safari for Intel Mac is supported. XML.ObjTree Group is now opened on Yahoo! Groups. [YUI] Link tooltip with website's thumbnail screenshot http://www.kawa.net/works/js/tips/yui-tooltips-e.html 2006-06-27T00:06:00+09:00 YUI This is a mash-up demonstration using Yahoo! UI Library's YAHOO.widget.Tooltip object with Simple API's thumbnail generating service. Try to move your mouse cursor onto the links below: [Mac] One click to crash Safari for Intel Mac http://www.kawa.net/works/ajax/tips/crash-safari/intelmac-e.html 2006-05-14T00:40:00+09:00 Mac Do you know any differences between Safari for Intel Mac and for PowerPC? Just two lines of JavaScript code below crashes Safari for Intel Mac. But Safari for PowerPC and other browsers are never crased. JSAN Search - JavaScript Libraries Database http://www.kawa.net/service/jsan/search/index.html 2006-05-03T20:53:00+09:00 A yet another search engine for JavaScript libraries registered on JSAN. [JavaScript] Animation.Raster - Virtual Raster Scrolling Effect http://www.kawa.net/works/js/animation/raster-e.html 2006-04-30T08:25:00+09:00 JavaScript This library provides a virtual raster scrolling's effect for images and block elements. Tested on Internet Explorer 7.0, Firefox 1.5, Opera 8.5, Safari 2.0.3 and OmniWeb 5.1.3. [Sudoku] Quick Sudoku Solving by JavaScript http://www.kawa.net/works/js/game/ncross-e.html 2006-04-18T21:54:00+09:00 Sudoku I think the most important thing of Sudoku is not getting its answer but is solving it. However, ... [JSAN] Date.W3CDTF - JavaScript Date object's W3CDTF extension http://www.kawa.net/works/js/date/w3cdtf-e.html 2006-04-05T22:49:00+09:00 JSAN Date.W3CDTF class understands the W3CDTF date/time format, an ISO 8601 profile, defined by W3C. This date/time format is the native date format of RSS 1.0. It can be used to parse these formats in order to create the appropriate objects. This is my first library to be contributed to JSAN. Date.W3CDTF class supports two types of formats below: 2005-04-23T17:20:00+09:00 (with timezone) 2005-04-23T17:20:00Z (without timezone) [ajax] Expanding DOM tree (cross browser DOM inspector) http://www.kawa.net/works/ajax/tips/dump/dom-tree.html 2006-03-21T02:41:00+09:00 ajax XML URL: [ajax] XML parser bug on iCab and OmniWeb http://www.kawa.net/works/ajax/tips/dump/icab-omniweb-bug.html 2006-03-21T02:40:00+09:00 ajax Source XML file: Flickr's RSS 2.0 file (as example) Demonstration: Expanding DOM tree (cross browser DOM inspector) CCDICT - Chinese Dictionary Search http://www.kawa.net/works/cantonese/ccdict.html 2006-03-08T16:20:00+09:00 Enter (or copy&paste) some chinese characters and push the button. [JavaScript] data: scheme URI generator / base64-encoded image file http://www.kawa.net/works/js/data-scheme/base64-e.html 2006-03-05T08:56:00+09:00 JavaScript The data: scheme can contain binary data such as image. Firefox and Opera supports the data: scheme, but IE doesn't yet. [Greasemonkey] User Scripts by kawa.net http://www.kawa.net/works/greasemonkey/myscripts-e.html 2006-02-13T21:14:00+09:00 Greasemonkey Here are my User Scripts for Greasemonkey. [ajax] Content-Type: availablity on XMLHttpRequest http://www.kawa.net/works/ajax/tips/mimetype/content-type-e.html 2006-02-09T01:05:00+09:00 ajax Some of content-types are only available on many browsers' XMLHttpRequest. [ajax] RSS BOX in your website http://www.kawa.net/works/ajax/rss/rss-box-e.html 2006-02-09T01:04:00+09:00 ajax How to put a RSS BOX in your website. JavaScript: Generating Random Passwords http://www.kawa.net/works/js/passwd/gen-passwds-e.html 2005-10-27T01:10:00+09:00 KCatch.pm - Catch warn and die to avoid "Internal Server Error" http://www.kawa.net/works/perl/catch/KCatch.pm.html 2004-11-24T00:47:00+09:00 NAME XML-TreePP-0.43/lib/XML/000755 000765 000024 00000000000 12432275633 015026 5ustar00u-sukestaff000000 000000 XML-TreePP-0.43/lib/XML/TreePP.pm000755 000765 000024 00000116515 12432274707 016540 0ustar00u-sukestaff000000 000000 =head1 NAME XML::TreePP -- Pure Perl implementation for parsing/writing XML documents =head1 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"; =head1 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. =head1 EXAMPLES =head2 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 =head2 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 C<#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 C<#text> is used because this elements has attribute(s) in addition to the text node. See also L option. =head1 METHODS =head2 new This constructor method returns a new XML::TreePP object with C<%options>. $tpp = XML::TreePP->new( %options ); =head2 set This method sets a option value for C. If C<$option_value> is not defined, its option is deleted. $tpp->set( option_name => $option_value ); See OPTIONS section below for details. =head2 get This method returns a current option value for C. $tpp->get( 'option_name' ); =head2 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 ); =head2 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 ); =head2 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 ); C<$method> is a method of HTTP connection: GET/POST/PUT/DELETE C<$url> is an URI of an XML file. C<$body> is a request body when you use POST method. C<$head> is a request headers as a hash ref. L module or L 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. =head2 write This method parses a hash tree and returns an XML document as a string. $source = $tpp->write( $tree, $encode ); C<$tree> is a reference to a hash tree. =head2 writefile This method parses a hash tree and writes an XML document into a file. $tpp->writefile( $file, $tree, $encode ); C<$file> is a filename to create. C<$tree> is a reference to a hash tree. =head1 OPTIONS FOR PARSING XML This module accepts option parameters following: =head2 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 C<'*'> means all elements. =head2 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 L option below. Note that the special wildcard name C<'*'> means all elements. =head2 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. =head2 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 C<'XML-TreePP/#.##'>, where C<'#.##'> is substituted with the version number of this library. =head2 http_lite This option forces pasrsehttp() method to use a L instance. my $http = HTTP::Lite->new(); $tpp->set( http_lite => $http ); =head2 lwp_useragent This option forces parsehttp() method to use a L instance. my $ua = LWP::UserAgent->new(); $ua->timeout( 60 ); $ua->env_proxy; $tpp->set( lwp_useragent => $ua ); You may use this with L. =head2 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 C class. You may use this with L. =head2 elem_class This blesses class name for each element's hashref. Each class is named horizontally under the direct child of C. $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 C class. =head2 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. =head2 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. =head1 OPTIONS FOR WRITING XML =head2 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. =head2 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' ] ); =head2 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. =head2 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 => '' ); =head2 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 C, C, C and C. The default value is C which is recommended encoding. =head2 empty_element_tag_end $tpp->set( empty_element_tag_end => '>' ); Set characters which close empty tag. The default value is ' />'. =head1 OPTIONS FOR BOTH =head2 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. =head2 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 C<'-'>. Or set C<'@'> to access attribute values like E4X, ECMAScript for XML. Zero-length prefix C<''> is available as well, it means no prefix is added. =head2 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 C<#text>. =head2 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 ); =head2 use_ixhash This option keeps the order for each element appeared in XML. L module is required. $tpp->set( use_ixhash => 1 ); This makes parsing performance slow. (about 100% slower than default) =head1 AUTHOR Yusuke Kawasaki, http://www.kawa.net/ =head1 REPOSITORY https://github.com/kawanet/XML-TreePP =head1 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 =head1 LICENSE This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut package XML::TreePP; use strict; use Carp; use Symbol; use vars qw( $VERSION ); $VERSION = '0.43'; my $XML_ENCODING = 'UTF-8'; my $INTERNAL_ENCODING = 'UTF-8'; my $USER_AGENT = 'XML-TreePP/'.$VERSION.' '; my $ATTR_PREFIX = '-'; my $TEXT_NODE_KEY = '#text'; my $USE_ENCODE_PM = ( $] >= 5.008 ); my $ALLOW_UTF8_FLAG = ( $] >= 5.008001 ); my $EMPTY_ELEMENT_TAG_END = ' />'; sub new { my $package = shift; my $self = {@_}; bless $self, $package; $self; } sub die { my $self = shift; my $mess = shift; return if $self->{ignore_error}; Carp::croak $mess; } sub warn { my $self = shift; my $mess = shift; return if $self->{ignore_error}; Carp::carp $mess; } sub set { my $self = shift; my $key = shift; my $val = shift; if ( defined $val ) { $self->{$key} = $val; } else { delete $self->{$key}; } } sub get { my $self = shift; my $key = shift; $self->{$key} if exists $self->{$key}; } sub writefile { my $self = shift; my $file = shift; my $tree = shift or return $self->die( 'Invalid tree' ); my $encode = shift; return $self->die( 'Invalid filename' ) unless defined $file; my $text = $self->write( $tree, $encode ); if ( $ALLOW_UTF8_FLAG && utf8::is_utf8( $text ) ) { utf8::encode( $text ); } $self->write_raw_xml( $file, $text ); } sub write { my $self = shift; my $tree = shift or return $self->die( 'Invalid tree' ); my $from = $self->{internal_encoding} || $INTERNAL_ENCODING; my $to = shift || $self->{output_encoding} || $XML_ENCODING; my $decl = $self->{xml_decl}; $decl = '' unless defined $decl; local $self->{__first_out}; if ( exists $self->{first_out} ) { my $keys = $self->{first_out}; $keys = [$keys] unless ref $keys; $self->{__first_out} = { map { $keys->[$_] => $_ } 0 .. $#$keys }; } local $self->{__last_out}; if ( exists $self->{last_out} ) { my $keys = $self->{last_out}; $keys = [$keys] unless ref $keys; $self->{__last_out} = { map { $keys->[$_] => $_ } 0 .. $#$keys }; } my $tnk = $self->{text_node_key} if exists $self->{text_node_key}; $tnk = $TEXT_NODE_KEY unless defined $tnk; local $self->{text_node_key} = $tnk; my $apre = $self->{attr_prefix} if exists $self->{attr_prefix}; $apre = $ATTR_PREFIX unless defined $apre; local $self->{__attr_prefix_len} = length($apre); local $self->{__attr_prefix_rex} = $apre; local $self->{__indent}; if ( exists $self->{indent} && $self->{indent} ) { $self->{__indent} = ' ' x $self->{indent}; } if ( ! UNIVERSAL::isa( $tree, 'HASH' )) { return $self->die( 'Invalid tree' ); } my $text = $self->hash_to_xml( undef, $tree ); if ( $from && $to ) { my $stat = $self->encode_from_to( \$text, $from, $to ); return $self->die( "Unsupported encoding: $to" ) unless $stat; } return $text if ( $decl eq '' ); join( "\n", $decl, $text ); } sub parsehttp { my $self = shift; local $self->{__user_agent}; if ( exists $self->{user_agent} ) { my $agent = $self->{user_agent}; $agent .= $USER_AGENT if ( $agent =~ /\s$/s ); $self->{__user_agent} = $agent if ( $agent ne '' ); } else { $self->{__user_agent} = $USER_AGENT; } my $http = $self->{__http_module}; unless ( $http ) { $http = $self->find_http_module(@_); $self->{__http_module} = $http; } if ( $http eq 'LWP::UserAgent' ) { return $self->parsehttp_lwp(@_); } elsif ( $http eq 'HTTP::Lite' ) { return $self->parsehttp_lite(@_); } else { return $self->die( "LWP::UserAgent or HTTP::Lite is required: $_[1]" ); } } sub find_http_module { my $self = shift || {}; if ( exists $self->{lwp_useragent} && ref $self->{lwp_useragent} ) { return 'LWP::UserAgent' if defined $LWP::UserAgent::VERSION; return 'LWP::UserAgent' if &load_lwp_useragent(); return $self->die( "LWP::UserAgent is required: $_[1]" ); } if ( exists $self->{http_lite} && ref $self->{http_lite} ) { return 'HTTP::Lite' if defined $HTTP::Lite::VERSION; return 'HTTP::Lite' if &load_http_lite(); return $self->die( "HTTP::Lite is required: $_[1]" ); } return 'LWP::UserAgent' if defined $LWP::UserAgent::VERSION; return 'HTTP::Lite' if defined $HTTP::Lite::VERSION; return 'LWP::UserAgent' if &load_lwp_useragent(); return 'HTTP::Lite' if &load_http_lite(); return $self->die( "LWP::UserAgent or HTTP::Lite is required: $_[1]" ); } sub load_lwp_useragent { return $LWP::UserAgent::VERSION if defined $LWP::UserAgent::VERSION; local $@; eval { require LWP::UserAgent; }; $LWP::UserAgent::VERSION; } sub load_http_lite { return $HTTP::Lite::VERSION if defined $HTTP::Lite::VERSION; local $@; eval { require HTTP::Lite; }; $HTTP::Lite::VERSION; } sub load_tie_ixhash { return $Tie::IxHash::VERSION if defined $Tie::IxHash::VERSION; local $@; eval { require Tie::IxHash; }; $Tie::IxHash::VERSION; } sub parsehttp_lwp { my $self = shift; my $method = shift or return $self->die( 'Invalid HTTP method' ); my $url = shift or return $self->die( 'Invalid URL' ); my $body = shift; my $header = shift; my $ua = $self->{lwp_useragent} if exists $self->{lwp_useragent}; if ( ! ref $ua ) { $ua = LWP::UserAgent->new(); $ua->env_proxy(); $ua->agent( $self->{__user_agent} ) if defined $self->{__user_agent}; } else { $ua->agent( $self->{__user_agent} ) if exists $self->{user_agent}; } my $req = HTTP::Request->new( $method, $url ); my $ct = 0; if ( ref $header ) { foreach my $field ( sort keys %$header ) { my $value = $header->{$field}; $req->header( $field => $value ); $ct ++ if ( $field =~ /^Content-Type$/i ); } } if ( defined $body && ! $ct ) { $req->header( 'Content-Type' => 'application/x-www-form-urlencoded' ); } $req->add_content_utf8($body) if defined $body; my $res = $ua->request($req); my $code = $res->code(); my $text; if ( $res->can( 'decoded_content' )) { $text = $res->decoded_content( charset => 'none' ); } else { $text = $res->content(); # less than LWP 5.802 } my $tree = $self->parse( \$text ) if $res->is_success(); wantarray ? ( $tree, $text, $code ) : $tree; } sub parsehttp_lite { my $self = shift; my $method = shift or return $self->die( 'Invalid HTTP method' ); my $url = shift or return $self->die( 'Invalid URL' ); my $body = shift; my $header = shift; my $http = HTTP::Lite->new(); $http->method($method); my $ua = 0; if ( ref $header ) { foreach my $field ( sort keys %$header ) { my $value = $header->{$field}; $http->add_req_header( $field, $value ); $ua ++ if ( $field =~ /^User-Agent$/i ); } } if ( defined $self->{__user_agent} && ! $ua ) { $http->add_req_header( 'User-Agent', $self->{__user_agent} ); } $http->{content} = $body if defined $body; my $code = $http->request($url) or return; my $text = $http->body(); my $tree = $self->parse( \$text ); wantarray ? ( $tree, $text, $code ) : $tree; } sub parsefile { my $self = shift; my $file = shift; return $self->die( 'Invalid filename' ) unless defined $file; my $text = $self->read_raw_xml($file); $self->parse( \$text ); } sub parse { my $self = shift; my $text = ref $_[0] ? ${$_[0]} : $_[0]; return $self->die( 'Null XML source' ) unless defined $text; my $from = &xml_decl_encoding(\$text) || $XML_ENCODING; my $to = $self->{internal_encoding} || $INTERNAL_ENCODING; if ( $from && $to ) { my $stat = $self->encode_from_to( \$text, $from, $to ); return $self->die( "Unsupported encoding: $from" ) unless $stat; } local $self->{__force_array}; local $self->{__force_array_all}; if ( exists $self->{force_array} ) { my $force = $self->{force_array}; $force = [$force] unless ref $force; $self->{__force_array} = { map { $_ => 1 } @$force }; $self->{__force_array_all} = $self->{__force_array}->{'*'}; } local $self->{__force_hash}; local $self->{__force_hash_all}; if ( exists $self->{force_hash} ) { my $force = $self->{force_hash}; $force = [$force] unless ref $force; $self->{__force_hash} = { map { $_ => 1 } @$force }; $self->{__force_hash_all} = $self->{__force_hash}->{'*'}; } my $tnk = $self->{text_node_key} if exists $self->{text_node_key}; $tnk = $TEXT_NODE_KEY unless defined $tnk; local $self->{text_node_key} = $tnk; my $apre = $self->{attr_prefix} if exists $self->{attr_prefix}; $apre = $ATTR_PREFIX unless defined $apre; local $self->{attr_prefix} = $apre; if ( exists $self->{use_ixhash} && $self->{use_ixhash} ) { return $self->die( "Tie::IxHash is required." ) unless &load_tie_ixhash(); } # Avoid segfaults when receving random input (RT #42441) if ( exists $self->{require_xml_decl} && $self->{require_xml_decl} ) { return $self->die( "XML declaration not found" ) unless looks_like_xml(\$text); } my $flat = $self->xml_to_flat(\$text); my $class = $self->{base_class} if exists $self->{base_class}; my $tree = $self->flat_to_tree( $flat, '', $class ); if ( ref $tree ) { if ( defined $class ) { bless( $tree, $class ); } elsif ( exists $self->{elem_class} && $self->{elem_class} ) { bless( $tree, $self->{elem_class} ); } } wantarray ? ( $tree, $text ) : $tree; } sub xml_to_flat { my $self = shift; my $textref = shift; # reference my $flat = []; my $prefix = $self->{attr_prefix}; my $ixhash = ( exists $self->{use_ixhash} && $self->{use_ixhash} ); my $deref = \&xml_unescape; my $xml_deref = ( exists $self->{xml_deref} && $self->{xml_deref} ); if ( $xml_deref ) { if (( exists $self->{utf8_flag} && $self->{utf8_flag} ) || ( $ALLOW_UTF8_FLAG && utf8::is_utf8( $$textref ))) { $deref = \&xml_deref_string; } else { $deref = \&xml_deref_octet; } } while ( $$textref =~ m{ ([^<]*) < (( \? ([^<>]*) \? )|( \!\[CDATA\[(.*?)\]\] )|( \!DOCTYPE\s+([^\[\]<>]*(?:\[.*?\]\s*)?) )|( \!--(.*?)-- )|( ([^\!\?\s<>](?:"[^"]*"|'[^']*'|[^"'<>])*) )) > ([^<]*) }sxg ) { my ( $ahead, $match, $typePI, $contPI, $typeCDATA, $contCDATA, $typeDocT, $contDocT, $typeCmnt, $contCmnt, $typeElem, $contElem, $follow ) = ( $1, $2, $3, $4, $5, $6, $7, $8, $9, $10, $11, $12, $13 ); if ( defined $ahead && $ahead =~ /\S/ ) { $ahead =~ s/([^\040-\076])/sprintf("\\x%02X",ord($1))/eg; $self->warn( "Invalid string: [$ahead] before <$match>" ); } if ($typeElem) { # Element my $node = {}; if ( $contElem =~ s#^/## ) { $node->{endTag}++; } elsif ( $contElem =~ s#/$## ) { $node->{emptyTag}++; } else { $node->{startTag}++; } $node->{tagName} = $1 if ( $contElem =~ s#^(\S+)\s*## ); unless ( $node->{endTag} ) { my $attr; while ( $contElem =~ m{ ([^\s\=\"\']+)\s*=\s*(?:(")(.*?)"|'(.*?)') }sxg ) { my $key = $1; my $val = &$deref( $2 ? $3 : $4 ); if ( ! ref $attr ) { $attr = {}; tie( %$attr, 'Tie::IxHash' ) if $ixhash; } $attr->{$prefix.$key} = $val; } $node->{attributes} = $attr if ref $attr; } push( @$flat, $node ); } elsif ($typeCDATA) { ## CDATASection if ( exists $self->{cdata_scalar_ref} && $self->{cdata_scalar_ref} ) { push( @$flat, \$contCDATA ); # as reference for scalar } else { push( @$flat, $contCDATA ); # as scalar like text node } } elsif ($typeCmnt) { # Comment (ignore) } elsif ($typeDocT) { # DocumentType (ignore) } elsif ($typePI) { # ProcessingInstruction (ignore) } else { $self->warn( "Invalid Tag: <$match>" ); } if ( $follow =~ /\S/ ) { # text node my $val = &$deref($follow); push( @$flat, $val ); } } $flat; } sub flat_to_tree { my $self = shift; my $source = shift; my $parent = shift; my $class = shift; my $tree = {}; my $text = []; if ( exists $self->{use_ixhash} && $self->{use_ixhash} ) { tie( %$tree, 'Tie::IxHash' ); } while ( scalar @$source ) { my $node = shift @$source; if ( !ref $node || UNIVERSAL::isa( $node, "SCALAR" ) ) { push( @$text, $node ); # cdata or text node next; } my $name = $node->{tagName}; if ( $node->{endTag} ) { last if ( $parent eq $name ); return $self->die( "Invalid tag sequence: <$parent>" ); } my $elem = $node->{attributes}; my $forcehash = $self->{__force_hash_all} || $self->{__force_hash}->{$name}; my $subclass; if ( defined $class ) { my $escname = $name; $escname =~ s/\W/_/sg; $subclass = $class.'::'.$escname; } if ( $node->{startTag} ) { # recursive call my $child = $self->flat_to_tree( $source, $name, $subclass ); next unless defined $child; my $hasattr = scalar keys %$elem if ref $elem; if ( UNIVERSAL::isa( $child, "HASH" ) ) { if ( $hasattr ) { # some attributes and some child nodes %$elem = ( %$elem, %$child ); } else { # some child nodes without attributes $elem = $child; } } else { if ( $hasattr ) { # some attributes and text node $elem->{$self->{text_node_key}} = $child; } elsif ( $forcehash ) { # only text node without attributes $elem = { $self->{text_node_key} => $child }; } else { # text node without attributes $elem = $child; } } } elsif ( $forcehash && ! ref $elem ) { $elem = {}; } # bless to a class by base_class or elem_class if ( ref $elem && UNIVERSAL::isa( $elem, "HASH" ) ) { if ( defined $subclass ) { bless( $elem, $subclass ); } elsif ( exists $self->{elem_class} && $self->{elem_class} ) { my $escname = $name; $escname =~ s/\W/_/sg; my $elmclass = $self->{elem_class}.'::'.$escname; bless( $elem, $elmclass ); } } # next unless defined $elem; $tree->{$name} ||= []; push( @{ $tree->{$name} }, $elem ); } if ( ! $self->{__force_array_all} ) { foreach my $key ( keys %$tree ) { next if $self->{__force_array}->{$key}; next if ( 1 < scalar @{ $tree->{$key} } ); $tree->{$key} = shift @{ $tree->{$key} }; } } my $haschild = scalar keys %$tree; if ( scalar @$text ) { if ( scalar @$text == 1 ) { # one text node (normal) $text = shift @$text; } elsif ( ! scalar grep {ref $_} @$text ) { # some text node splitted $text = join( '', @$text ); } else { # some cdata node my $join = join( '', map {ref $_ ? $$_ : $_} @$text ); $text = \$join; } if ( $haschild ) { # some child nodes and also text node $tree->{$self->{text_node_key}} = $text; } else { # only text node without child nodes $tree = $text; } } elsif ( ! $haschild ) { # no child and no text $tree = ""; } $tree; } sub hash_to_xml { my $self = shift; my $name = shift; my $hash = shift; my $out = []; my $attr = []; my $allkeys = [ keys %$hash ]; my $fo = $self->{__first_out} if ref $self->{__first_out}; my $lo = $self->{__last_out} if ref $self->{__last_out}; my $firstkeys = [ sort { $fo->{$a} <=> $fo->{$b} } grep { exists $fo->{$_} } @$allkeys ] if ref $fo; my $lastkeys = [ sort { $lo->{$a} <=> $lo->{$b} } grep { exists $lo->{$_} } @$allkeys ] if ref $lo; $allkeys = [ grep { ! exists $fo->{$_} } @$allkeys ] if ref $fo; $allkeys = [ grep { ! exists $lo->{$_} } @$allkeys ] if ref $lo; unless ( exists $self->{use_ixhash} && $self->{use_ixhash} ) { $allkeys = [ sort @$allkeys ]; } my $prelen = $self->{__attr_prefix_len}; my $pregex = $self->{__attr_prefix_rex}; my $textnk = $self->{text_node_key}; my $tagend = $self->{empty_element_tag_end} || $EMPTY_ELEMENT_TAG_END; foreach my $keys ( $firstkeys, $allkeys, $lastkeys ) { next unless ref $keys; my $elemkey = $prelen ? [ grep { substr($_,0,$prelen) ne $pregex } @$keys ] : $keys; my $attrkey = $prelen ? [ grep { substr($_,0,$prelen) eq $pregex } @$keys ] : []; foreach my $key ( @$elemkey ) { my $val = $hash->{$key}; if ( !defined $val ) { next if ($key eq $textnk); push( @$out, "<$key$tagend" ); } elsif ( UNIVERSAL::isa( $val, 'HASH' ) ) { my $child = $self->hash_to_xml( $key, $val ); push( @$out, $child ); } elsif ( UNIVERSAL::isa( $val, 'ARRAY' ) ) { my $child = $self->array_to_xml( $key, $val ); push( @$out, $child ); } elsif ( UNIVERSAL::isa( $val, 'SCALAR' ) ) { my $child = $self->scalaref_to_cdata( $key, $val ); push( @$out, $child ); } else { my $ref = ref $val; $self->warn( "Unsupported reference type: $ref in $key" ) if $ref; my $child = $self->scalar_to_xml( $key, $val ); push( @$out, $child ); } } foreach my $key ( @$attrkey ) { my $name = substr( $key, $prelen ); my $val = &xml_escape( $hash->{$key} ); push( @$attr, ' ' . $name . '="' . $val . '"' ); } } my $jattr = join( '', @$attr ); if ( defined $name && scalar @$out && ! grep { ! /^{__indent} ) { s/^(\s*<)/$self->{__indent}$1/mg foreach @$out; } unshift( @$out, "\n" ); } my $text = join( '', @$out ); if ( defined $name ) { if ( scalar @$out ) { $text = "<$name$jattr>$text\n"; } else { $text = "<$name$jattr$tagend\n"; } } $text; } sub array_to_xml { my $self = shift; my $name = shift; my $array = shift; my $out = []; my $tagend = $self->{empty_element_tag_end} || $EMPTY_ELEMENT_TAG_END; foreach my $val (@$array) { if ( !defined $val ) { push( @$out, "<$name$tagend\n" ); } elsif ( UNIVERSAL::isa( $val, 'HASH' ) ) { my $child = $self->hash_to_xml( $name, $val ); push( @$out, $child ); } elsif ( UNIVERSAL::isa( $val, 'ARRAY' ) ) { my $child = $self->array_to_xml( $name, $val ); push( @$out, $child ); } elsif ( UNIVERSAL::isa( $val, 'SCALAR' ) ) { my $child = $self->scalaref_to_cdata( $name, $val ); push( @$out, $child ); } else { my $ref = ref $val; $self->warn( "Unsupported reference type: $ref in $name" ) if $ref; my $child = $self->scalar_to_xml( $name, $val ); push( @$out, $child ); } } my $text = join( '', @$out ); $text; } sub scalaref_to_cdata { my $self = shift; my $name = shift; my $ref = shift; my $data = defined $$ref ? $$ref : ''; $data =~ s#(]])(>)#$1]]>'; $text = "<$name>$text\n" if ( $name ne $self->{text_node_key} ); $text; } sub scalar_to_xml { my $self = shift; my $name = shift; my $scalar = shift; my $copy = $scalar; my $text = &xml_escape($copy); $text = "<$name>$text\n" if ( $name ne $self->{text_node_key} ); $text; } sub write_raw_xml { my $self = shift; my $file = shift; my $fh = Symbol::gensym(); open( $fh, ">$file" ) or return $self->die( "$! - $file" ); print $fh @_; close($fh); } sub read_raw_xml { my $self = shift; my $file = shift; my $fh = Symbol::gensym(); open( $fh, $file ) or return $self->die( "$! - $file" ); local $/ = undef; my $text = <$fh>; close($fh); $text; } sub looks_like_xml { my $textref = shift; my $args = ( $$textref =~ /^(?:\s*\xEF\xBB\xBF)?\s*<\?xml(\s+\S.*)\?>/s )[0]; if ( ! $args ) { return; } return $args; } sub xml_decl_encoding { my $textref = shift; return unless defined $$textref; my $args = looks_like_xml($textref) or return; my $getcode = ( $args =~ /\s+encoding=(".*?"|'.*?')/ )[0] or return; $getcode =~ s/^['"]//; $getcode =~ s/['"]$//; $getcode; } sub encode_from_to { my $self = shift; my $txtref = shift or return; my $from = shift or return; my $to = shift or return; unless ( defined $Encode::EUCJPMS::VERSION ) { $from = 'EUC-JP' if ( $from =~ /\beuc-?jp-?(win|ms)$/i ); $to = 'EUC-JP' if ( $to =~ /\beuc-?jp-?(win|ms)$/i ); } my $RE_IS_UTF8 = qr/^utf-?8$/i; if ( $from =~ $RE_IS_UTF8 ) { $$txtref =~ s/^\xEF\xBB\xBF//s; # UTF-8 BOM (Byte Order Mark) } my $setflag = $self->{utf8_flag} if exists $self->{utf8_flag}; if ( ! $ALLOW_UTF8_FLAG && $setflag ) { return $self->die( "Perl 5.8.1 is required for utf8_flag: $]" ); } if ( $USE_ENCODE_PM ) { &load_encode(); my $encver = ( $Encode::VERSION =~ /^([\d\.]+)/ )[0]; my $check = ( $encver < 2.13 ) ? 0x400 : Encode::FB_XMLCREF(); my $encfrom = Encode::find_encoding($from) if $from; return $self->die( "Unknown encoding: $from" ) unless ref $encfrom; my $encto = Encode::find_encoding($to) if $to; return $self->die( "Unknown encoding: $to" ) unless ref $encto; if ( $ALLOW_UTF8_FLAG && utf8::is_utf8( $$txtref ) ) { if ( $to =~ $RE_IS_UTF8 ) { # skip } else { $$txtref = $encto->encode( $$txtref, $check ); } } else { $$txtref = $encfrom->decode( $$txtref ); if ( $to =~ $RE_IS_UTF8 && $setflag ) { # skip } else { $$txtref = $encto->encode( $$txtref, $check ); } } } elsif ( ( uc($from) eq 'ISO-8859-1' || uc($from) eq 'US-ASCII' || uc($from) eq 'LATIN-1' ) && uc($to) eq 'UTF-8' ) { &latin1_to_utf8($txtref); } else { my $jfrom = &get_jcode_name($from); my $jto = &get_jcode_name($to); return $to if ( uc($jfrom) eq uc($jto) ); if ( $jfrom && $jto ) { &load_jcode(); if ( defined $Jcode::VERSION ) { Jcode::convert( $txtref, $jto, $jfrom ); } else { return $self->die( "Jcode.pm is required: $from to $to" ); } } else { return $self->die( "Encode.pm is required: $from to $to" ); } } $to; } sub load_jcode { return if defined $Jcode::VERSION; local $@; eval { require Jcode; }; } sub load_encode { return if defined $Encode::VERSION; local $@; eval { require Encode; }; } sub latin1_to_utf8 { my $strref = shift; $$strref =~ s{ ([\x80-\xFF]) }{ pack( 'C2' => 0xC0|(ord($1)>>6),0x80|(ord($1)&0x3F) ) }exg; } sub get_jcode_name { my $src = shift; my $dst; if ( $src =~ /^utf-?8$/i ) { $dst = 'utf8'; } elsif ( $src =~ /^euc.*jp(-?(win|ms))?$/i ) { $dst = 'euc'; } elsif ( $src =~ /^(shift.*jis|cp932|windows-31j)$/i ) { $dst = 'sjis'; } elsif ( $src =~ /^iso-2022-jp/ ) { $dst = 'jis'; } $dst; } sub xml_escape { my $str = shift; return '' unless defined $str; # except for TAB(\x09),CR(\x0D),LF(\x0A) $str =~ s{ ([\x00-\x08\x0B\x0C\x0E-\x1F\x7F]) }{ sprintf( '&#%d;', ord($1) ); }gex; $str =~ s/&(?!#(\d+;|x[\dA-Fa-f]+;))/&/g; $str =~ s//>/g; $str =~ s/'/'/g; $str =~ s/"/"/g; $str; } sub xml_unescape { my $str = shift; my $map = {qw( quot " lt < gt > apos ' amp & )}; $str =~ s{ (&(?:\#(\d{1,3})|\#x([0-9a-fA-F]{1,2})|(quot|lt|gt|apos|amp));) }{ $4 ? $map->{$4} : &code_to_ascii( $3 ? hex($3) : $2, $1 ); }gex; $str; } sub xml_deref_octet { my $str = shift; my $map = {qw( quot " lt < gt > apos ' amp & )}; $str =~ s{ (&(?:\#(\d{1,7})|\#x([0-9a-fA-F]{1,6})|(quot|lt|gt|apos|amp));) }{ $4 ? $map->{$4} : &code_to_utf8( $3 ? hex($3) : $2, $1 ); }gex; $str; } sub xml_deref_string { my $str = shift; my $map = {qw( quot " lt < gt > apos ' amp & )}; $str =~ s{ (&(?:\#(\d{1,7})|\#x([0-9a-fA-F]{1,6})|(quot|lt|gt|apos|amp));) }{ $4 ? $map->{$4} : pack( U => $3 ? hex($3) : $2 ); }gex; $str; } sub code_to_ascii { my $code = shift; if ( $code <= 0x007F ) { return pack( C => $code ); } return shift if scalar @_; # default value sprintf( '&#%d;', $code ); } sub code_to_utf8 { my $code = shift; if ( $code <= 0x007F ) { return pack( C => $code ); } elsif ( $code <= 0x07FF ) { return pack( C2 => 0xC0|($code>>6), 0x80|($code&0x3F)); } elsif ( $code <= 0xFFFF ) { return pack( C3 => 0xE0|($code>>12), 0x80|(($code>>6)&0x3F), 0x80|($code&0x3F)); } elsif ( $code <= 0x10FFFF ) { return pack( C4 => 0xF0|($code>>18), 0x80|(($code>>12)&0x3F), 0x80|(($code>>6)&0x3F), 0x80|($code&0x3F)); } return shift if scalar @_; # default value sprintf( '&#x%04X;', $code ); } 1; XML-TreePP-0.43/example/envxml.cgi000755 000765 000024 00000000261 12236676324 017256 0ustar00u-sukestaff000000 000000 #!/usr/bin/perl use strict; use XML::TreePP; my $tree = { env => \%ENV }; my $tpp = XML::TreePP->new(); print "Content-Type: text/xml\n\n"; print $tpp->write( $tree ), "\n";