XML-FeedPP-0.43/0000755000076400007640000000000011561510574012422 5ustar u-sukeu-sukeXML-FeedPP-0.43/Changes0000644000076400007640000001263111561506653013723 0ustar u-sukeu-suke# XML::FeedPP Changes 2011/05/08 (0.43) * fixed #67268: Wrong return value of description() with xhtml content in atom feeds https://rt.cpan.org/Ticket/Display.html?id=67268 (thanks to MDOM) 2010/10/31 (0.42) * fixed #55197: Not a HASH reference at XML/FeedPP.pm line 2260 https://rt.cpan.org/Ticket/Display.html?id=55197 (thanks to MDOM) 2009/11/21 (0.41) * supports generating CDATA section by setting SCALAR ref value like XML::TreePP. (thanks to Mario Domgoergen) * pod added to create an empty Atom 1.0 instance intended: XML::FeedPP::Atom::Atom10->new() (thanks to Andy Piper) 2009/04/07 (0.40) * fixed #44082: parse method refuses feeds with UTF-8 BOM http://rt.cpan.org/Public/Bug/Display.html?id=44082 (thanks to haarg) * supports to get attributes in multiple elements determinably. See 36_get_multiple.t * new() and load() methods accept -type argument to specify source type. http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=504143 (thanks to Anthony DeRobertis) * to_string() and to_file() methods accept options for XML::TreePP. 2009/03/12 (0.38) * fixed #36270: supports no XMLDecl on load() method https://rt.cpan.org/Ticket/Display.html?id=36270 (thanks to hirsch) * supports category element which has type="" or domain="" attribute ex. http://thesteampunkhome.blogspot.com/feeds/posts/default http://weather.livedoor.com/forecast/rss/index.xml http://picasaweb.google.com/data/feed/base/user/www.kawa.net/?alt=rss (thanks to greg, tsubok and t-saitoh) 2009/01/18 (0.37) * fixed #42472: items with 2 titles break the parser (thanks to thaabit) http://rt.cpan.org/Public/Bug/Display.html?id=42472 * fixed #41771: possible bug in $item->guid (thanks to PriggeScottM) http://rt.cpan.org/Public/Bug/Display.html?id=41771 2008/10/26 (0.36) * RFC1123 and RSS spec allow two-digit date format http://rt.cpan.org/Public/Bug/Display.html?id=36890 http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=503260 (thanks to Illtud Daniel and Anthony DeRobertis) 2008/05/18 (0.35) * supports multiple which is invalid though http://www.kawa.net/works/perl/feedpp/feedpp.html#com-2008-05-17T13:13:33Z "Pseudo-hashes are deprecated at FeedPP.pm line 1085." (thanks to nasano) * accepts some invalid W3CDTF format * merge() returns $self 2008/01/14 (0.34) * add time zones supported: UT EST EDT CST CDT MST MDT PST PDT http://www.rfc-editor.org/rfc/rfc2822.txt (thanks to Matti) 2008/01/05 (0.33) * Subversion on Google Code http://xml-treepp.googlecode.com/svn/trunk/XML-FeedPP/ * XML::FeedPP::Plugin::DumpJSON module branched http://search.cpan.org/dist/XML-FeedPP-Plugin-DumpJSON/ 2007/11/16 (0.31) not released * getting from multiple nodes is supported for 2007/08/20 (0.30) * Atom 1.0 supported. Atom 0.3 is still default. (thanks to takemaru) Note that future version of this would change its default as Atom 1.0. http://teahut.sakura.ne.jp/b/2007-06-24-1.html 2007/07/27 (0.22) * bugfix: Daylight saving time accepted. http://cpantesters.perl.org/show/XML-FeedPP.html#XML-FeedPP-0.21 2007/01/21 (0.21) * update new() method to allow key/value pairs to set elements. * update add_item() method to allow key/value pairs to set elements. * add elements() undocumented method which sets elements by key/value pairs. * add match_item() method which finds items by regular expressions. * update sort_item() method to recognizes time zone of items. * add get_pubDate_epoch() undocumented method which returns time as second. 2006/12/29 (0.20) beta * allow a date time format which comes without second. 2006/12/16 (0.19) * negative index supported: get_item() remove_item() limit_item() * POD updated (thanks to sierra and silver) 2006/12/15 (0.17) * $item->get('@attr') supported (thanks to javiermm) 2006/09/05 (0.16) * some of valid/invalid W3CDTF formats supported (thanks to Yamamoto) 2006/08/27 (0.15) * Atom 1.0 support got forward (thanks to Ole Kasper Olsen) 2006/05/07 (0.13) * buf fix: get_pubDate_rfc1123() for RDF/Atom * buf fix: image() for RDF, rdf:about attribute * image() for Atom supports additional content types: image/x-icon, etc. 2006/05/05 (0.12) * new method: clear_item() * image() method now supports XML::FeedPP::Atom as well. 2006/05/03 (0.11) * new method: remove_item() (thanks to JUNDU) * add_item() method now allows clone another item/entry instance. 2006/04/30 (0.10) * category() method fixed for more then one category. (thanks to vlajbert) * normalize() method normalizes pubDate element as well. (thanks to junichi) * load() method has additional arguments for XML::TreePP. (thanks to kisa) * source code passed perltidy. 2006/03/18 (0.08) * new methods: sort_item() uniq_item() limit_item() normalize() 2006/03/09 (0.07) * correct RSS/RDF/Atom file's format 2006/02/27 (0.05) * new methods: set() get() 2006/02/24 (0.03) * first release # http://groups.yahoo.com/group/xml-feedpp/ # http://annocpan.org/dist/XML-FeedPP/ # http://rt.cpan.org/Public/Dist/Display.html?Name=XML-FeedPP # http://www.kawa.net/works/perl/feedpp/feedpp-e.html (English) # http://www.kawa.net/works/perl/feedpp/feedpp.html#changes (Japanese) XML-FeedPP-0.43/make-dist.sh0000644000076400007640000000152311561507341014633 0ustar u-sukeu-suke#!/bin/sh die () { echo "$*" >&2 exit 1 } doit () { echo "\$ $*" >&2 $* || die "[ERROR:$?]" } egrep -v '^t/.*\.t$' MANIFEST > MANIFEST~ ls -t t/*.t | sort >> MANIFEST~ diff MANIFEST MANIFEST~ > /dev/null || doit /bin/mv -f MANIFEST~ MANIFEST /bin/rm -f MANIFEST~ [ -f Makefile ] && doit make clean [ -f META.yml ] || touch META.yml doit perl Makefile.PL doit make doit make disttest main=`grep 'lib/.*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 make dist [ -d blib ] && doit /bin/rm -fr blib [ -f pm_to_blib ] && doit /bin/rm -f pm_to_blib [ -f Makefile ] && doit /bin/rm -f Makefile [ -f Makefile.old ] && doit /bin/rm -f Makefile.old ls -lt *.tar.gz | head -1 XML-FeedPP-0.43/Makefile.PL0000644000076400007640000000060411561507341014372 0ustar u-sukeu-sukeuse ExtUtils::MakeMaker; use strict; my $opt = { NAME => 'XML-FeedPP', VERSION_FROM => 'lib/XML/FeedPP.pm', PREREQ_PM => { 'Test::More' => '0', 'XML::TreePP' => '0.39', }, }; my $mm = $ExtUtils::MakeMaker::VERSION; $mm =~ s/[^\d\.]+//g; $opt->{LICENSE} = 'perl' if ( $mm >= 6.3001 ); WriteMakefile( %$opt ); XML-FeedPP-0.43/MANIFEST0000644000076400007640000000150311561507456013557 0ustar u-sukeu-sukeMakefile.PL lib/XML/FeedPP.pm README Changes MANIFEST META.yml make-dist.sh t/01_new.t t/02_rss.t t/03_rdf.t t/04_atom.t t/05_round.t t/06_xmlns.t t/07_encoding.t t/08_datetime.t t/09_setget.t t/10_image.t t/11_media.t t/12_sort_item.t t/13_remove_item.t t/14_clear_item.t t/15_clone_item.t t/16_invalid_pubdate.t t/17_multi_category.t t/18_image_atom.t t/19_invalid_w3cdtf.t t/20_limit_item.t t/21_negative_item.t t/22_init_elements.t t/23_match_item.t t/24_get_epoch.t t/25_sort_timezone.t t/26_atom10_parse.t t/27_atom03_parse.t t/28_atom10_write.t t/29_rfc2822.t t/30_invalid_rdfseq.t t/31_two_digit_date.t t/32_two_titles.t t/33_guid.t t/34_category_type.t t/35_no_xml_decl.t t/36_get_multiple.t t/39_load_type.t t/40_xml_deref.t t/41_utf8_flag.t t/42_indent.t t/43_indent_atom.t t/44_cdata.t t/45_cdata_multi.t t/46_atom_xhtml.t XML-FeedPP-0.43/README0000644000076400007640000003270511561507510013305 0ustar u-sukeu-sukeNAME XML::FeedPP -- Parse/write/merge/edit RSS/RDF/Atom syndication feeds SYNOPSIS Get an RSS file and parse it: my $source = 'http://use.perl.org/index.rss'; my $feed = XML::FeedPP->new( $source ); print "Title: ", $feed->title(), "\n"; print "Date: ", $feed->pubDate(), "\n"; foreach my $item ( $feed->get_item() ) { print "URL: ", $item->link(), "\n"; print "Title: ", $item->title(), "\n"; } Generate an RDF file and save it: my $feed = XML::FeedPP::RDF->new(); $feed->title( "use Perl" ); $feed->link( "http://use.perl.org/" ); $feed->pubDate( "Thu, 23 Feb 2006 14:43:43 +0900" ); my $item = $feed->add_item( "http://search.cpan.org/~kawasaki/XML-TreePP-0.02" ); $item->title( "Pure Perl implementation for parsing/writing xml file" ); $item->pubDate( "2006-02-23T14:43:43+09:00" ); $feed->to_file( "index.rdf" ); Convert some RSS/RDF files to Atom format: my $feed = XML::FeedPP::Atom::Atom10->new(); # create empty atom file $feed->merge( "rss.xml" ); # load local RSS file $feed->merge( "http://www.kawa.net/index.rdf" ); # load remote RDF file my $now = time(); $feed->pubDate( $now ); # touch date my $atom = $feed->to_string(); # get Atom source code DESCRIPTION "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 these various formats. It is a pure Perl implementation and does not require any other module except for XML::TreePP. METHODS FOR FEED $feed = XML::FeedPP->new( "index.rss" ); This constructor method creates an "XML::FeedPP" feed instance. The only argument is the local filename. The format of $source must be one of the supported feed formats -- RSS, RDF or Atom -- or execution is halted. $feed = XML::FeedPP->new( "http://use.perl.org/index.rss" ); The URL on the remote web server is also available as the first argument. LWP::UserAgent is required to download it. $feed = XML::FeedPP->new( '...' ); The XML source code is also available as the first argument. $feed = XML::FeedPP->new( $source, -type => $type ); The "-type" argument allows you to specify type of $source from choice of 'file', 'url' or 'string'. $feed = XML::FeedPP->new( $source, utf8_flag => 1 ); This makes utf8 flag on for every feed elements. Perl 5.8.1 or later is required to use this. Note that any other options for "XML::TreePP" constructor are also allowed like this. See more detail on XML::TreePP. $feed = XML::FeedPP::RSS->new( $source ); This constructor method creates an instance for an RSS 2.0 feed. The first argument is optional, but must be valid an RSS source if specified. This method returns an empty instance when $source is undefined. $feed = XML::FeedPP::RDF->new( $source ); This constructor method creates an instance for RSS 1.0 (RDF) feed. The first argument is optional, but must be an RDF source if specified. This method returns an empty instance when $source is undefined. $feed = XML::FeedPP::Atom->new( $source ); This constructor method creates an instance for an Atom 0.3/1.0 feed. The first argument is optional, but must be an Atom source if specified. This method returns an empty instance when $source is undefined. Atom 1.0 feed is also supported since "XML::FeedPP" version 0.30. Atom 0.3 is still default, however, future version of this module would create Atom 1.0 as default. $feed = XML::FeedPP::Atom::Atom03->new(); This creates an empty Atom 0.3 instance obviously. $feed = XML::FeedPP::Atom::Atom10->new(); This creates an empty Atom 1.0 instance intended. $feed = XML::FeedPP::RSS->new( link => $link, title => $tile, ... ); This creates a RSS instance which has "link", "title" elements etc. $feed->load( $source ); This method loads an RSS/RDF/Atom file, much like "new()" method does. $feed->merge( $source ); This method merges an RSS/RDF/Atom file into the existing $feed instance. Top-level metadata from the imported feed is incorporated only if missing from the present feed. $string = $feed->to_string( $encoding ); This method generates XML source as string and returns it. The output $encoding is optional, and the default encoding is 'UTF-8'. On Perl 5.8 and later, any encodings supported by the Encode module are available. On Perl 5.005 and 5.6.1, only four encodings supported by the Jcode module are available: 'UTF-8', 'Shift_JIS', 'EUC-JP' and 'ISO-2022-JP'. 'UTF-8' is recommended for overall compatibility. $string = $feed->to_string( indent => 4 ); This makes the output more human readable by indenting appropriately. This does not strictly follow the XML specification but does looks nice. Note that any other options for "XML::TreePP" constructor are also allowed like this. See more detail on XML::TreePP. $feed->to_file( $filename, $encoding ); This method generate an XML file. The output $encoding is optional, and the default is 'UTF-8'. $item = $feed->add_item( $link ); This method creates a new item/entry and returns its instance. A mandatory $link argument is the URL of the new item/entry. $item = $feed->add_item( $srcitem ); This method duplicates an item/entry and adds it to $feed. $srcitem is a "XML::FeedPP::*::Item" class's instance which is returned by "get_item()" method, as described above. $item = $feed->add_item( link => $link, title => $tile, ... ); This method creates an new item/entry which has "link", "title" elements etc. $item = $feed->get_item( $index ); This method returns item(s) in a $feed. A valid zero-based array $index returns the corresponding item in the feed. An invalid $index yields undef. If $index is undefined in array context, it returns an array of all items. If $index is undefined in scalar context, it returns the number of items. @items = $feed->match_item( link => qr/.../, title => qr/.../, ... ); This method finds item(s) which match all regular expressions given. This method returns an array of all matched items in array context. This method returns the first matched item in scalar context. $feed->remove_item( $index or $link ); This method removes an item/entry specified by zero-based array index or link URL. $feed->clear_item(); This method removes all items/entries from the $feed. $feed->sort_item(); This method sorts the order of items in $feed by "pubDate". $feed->uniq_item(); This method makes items unique. The second and succeeding items that have the same link URL are removed. $feed->normalize(); This method calls both the "sort_item()" and "uniq_item()" methods. $feed->limit_item( $num ); Removes items in excess of the specified numeric limit. Items at the end of the list are removed. When preceded by "sort_item()" or "normalize()", this deletes more recent items. $feed->xmlns( "xmlns:media" => "http://search.yahoo.com/mrss" ); Adds an XML namespace at the document root of the feed. $url = $feed->xmlns( "xmlns:media" ); Returns the URL of the specified XML namespace. @list = $feed->xmlns(); Returns the list of all XML namespaces used in $feed. METHODS FOR CHANNEL $feed->title( $text ); This method sets/gets the feed's "title" element, returning its current value when $title is undefined. $feed->description( $html ); This method sets/gets the feed's "description" element in plain text or HTML, returning its current value when $html is undefined. It is mapped to "content" element for Atom 0.3/1.0. $feed->pubDate( $date ); This method sets/gets the feed's "pubDate" element for RSS, returning its current value when $date is undefined. It is mapped to "dc:date" element for RDF, "modified" for Atom 0.3, and "updated" for Atom 1.0. See also "DATE AND TIME FORMATS" section below. $feed->copyright( $text ); This method sets/gets the feed's "copyright" element for RSS, returning its current value when $text is undefined. It is mapped to "dc:rights" element for RDF, "copyright" for Atom 0.3, and "rights" for Atom 1.0. $feed->link( $url ); This method sets/gets the URL of the web site as the feed's "link" element, returning its current value when the $url is undefined. $feed->language( $lang ); This method sets/gets the feed's "language" element for RSS, returning its current value when the $lang is undefined. It is mapped to "dc:language" element for RDF, "feed xml:lang=""" for Atom 0.3/1.0. $feed->image( $url, $title, $link, $description, $width, $height ) This method sets/gets the feed's "image" element and its child nodes, returning a list of current values when any arguments are undefined. METHODS FOR ITEM $item->title( $text ); This method sets/gets the item's "title" element, returning its current value when the $text is undefined. $item->description( $html ); This method sets/gets the item's "description" element in HTML or plain text, returning its current value when $text is undefined. It is mapped to "content" element for Atom 0.3/1.0. $item->pubDate( $date ); This method sets/gets the item's "pubDate" element, returning its current value when $date is undefined. It is mapped to "dc:date" element for RDF, "modified" for Atom 0.3, and "updated" for Atom 1.0. See also "DATE AND TIME FORMATS" section below. $item->category( $text ); This method sets/gets the item's "category" element. returning its current value when $text is undefined. It is mapped to "dc:subject" element for RDF, and ignored for Atom 0.3. $item->author( $name ); This method sets/gets the item's "author" element, returning its current value when $name is undefined. It is mapped to "dc:creator" element for RDF, "author" for Atom 0.3/1.0. $item->guid( $guid, isPermaLink => $bool ); This method sets/gets the item's "guid" element, returning its current value when $guid is undefined. It is mapped to "id" element for Atom, and ignored for RDF. The second argument is optional. $item->set( $key => $value, ... ); This method sets customized node values or attributes. See also "ACCESSOR AND MUTATORS" section below. $value = $item->get( $key ); This method returns the node value or attribute. See also "ACCESSOR AND MUTATORS" section below. $link = $item->link(); This method returns the item's "link" element. ACCESSOR AND MUTATORS This module understands only subset of "rdf:*", "dc:*" modules and RSS/RDF/Atom's default namespaces by itself. There are NO native methods for any other external modules, such as "media:*". But "set()" and "get()" methods are available to get/set the value of any elements or attributes for these modules. $item->set( "module:name" => $value ); This sets the value of the child node: $value... $item->set( "module:name@attr" => $value ); This sets the value of the child node's attribute: ... $item->set( "@attr" => $value ); This sets the value of the item's attribute: ... $item->set( "hoge/pomu@hare" => $value ); This code sets the value of the child node's child node's attribute: ... DATE AND TIME FORMATS "XML::FeedPP" allows you to describe date/time using any of the three following formats: $date = "Thu, 23 Feb 2006 14:43:43 +0900"; This is the HTTP protocol's preferred format and RSS 2.0's native format, as defined by RFC 1123. $date = "2006-02-23T14:43:43+09:00"; W3CDTF is the native format of RDF, as defined by ISO 8601. $date = 1140705823; The last format is the number of seconds since the epoch, "1970-01-01T00:00:00Z". You know, this is the native format of Perl's "time()" function. USING MEDIA RSS To publish Media RSS, add the "media" namespace then use "set()" setter method to manipulate "media:content" element, etc. my $feed = XML::FeedPP::RSS->new(); $feed->xmlns('xmlns:media' => 'http://search.yahoo.com/mrss/'); my $item = $feed->add_item('http://www.example.com/index.html'); $item->set('media:content@url' => 'http://www.example.com/image.jpg'); $item->set('media:content@type' => 'image/jpeg'); $item->set('media:content@width' => 640); $item->set('media:content@height' => 480); MODULE DEPENDENCIES "XML::FeedPP" requires only XML::TreePP which likewise is a pure Perl implementation. The standard LWP::UserAgent is required to download feeds from remote web servers. "Jcode.pm" is required to convert Japanese encodings on Perl 5.005 and 5.6.1, but is NOT required on Perl 5.8.x and later. AUTHOR Yusuke Kawasaki, http://www.kawa.net/ COPYRIGHT The following copyright notice applies to all the files provided in this distribution, including binary files, unless explicitly noted otherwise. Copyright 2006-2011 Yusuke Kawasaki LICENSE This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. XML-FeedPP-0.43/lib/0000755000076400007640000000000011561510574013170 5ustar u-sukeu-sukeXML-FeedPP-0.43/lib/XML/0000755000076400007640000000000011561510574013630 5ustar u-sukeu-sukeXML-FeedPP-0.43/lib/XML/FeedPP.pm0000755000076400007640000022216711561506260015303 0ustar u-sukeu-suke=head1 NAME XML::FeedPP -- Parse/write/merge/edit RSS/RDF/Atom syndication feeds =head1 SYNOPSIS Get an RSS file and parse it: my $source = 'http://use.perl.org/index.rss'; my $feed = XML::FeedPP->new( $source ); print "Title: ", $feed->title(), "\n"; print "Date: ", $feed->pubDate(), "\n"; foreach my $item ( $feed->get_item() ) { print "URL: ", $item->link(), "\n"; print "Title: ", $item->title(), "\n"; } Generate an RDF file and save it: my $feed = XML::FeedPP::RDF->new(); $feed->title( "use Perl" ); $feed->link( "http://use.perl.org/" ); $feed->pubDate( "Thu, 23 Feb 2006 14:43:43 +0900" ); my $item = $feed->add_item( "http://search.cpan.org/~kawasaki/XML-TreePP-0.02" ); $item->title( "Pure Perl implementation for parsing/writing xml file" ); $item->pubDate( "2006-02-23T14:43:43+09:00" ); $feed->to_file( "index.rdf" ); Convert some RSS/RDF files to Atom format: my $feed = XML::FeedPP::Atom::Atom10->new(); # create empty atom file $feed->merge( "rss.xml" ); # load local RSS file $feed->merge( "http://www.kawa.net/index.rdf" ); # load remote RDF file my $now = time(); $feed->pubDate( $now ); # touch date my $atom = $feed->to_string(); # get Atom source code =head1 DESCRIPTION C 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 these various formats. It is a pure Perl implementation and does not require any other module except for XML::TreePP. =head1 METHODS FOR FEED =head2 $feed = XML::FeedPP->new( "index.rss" ); This constructor method creates an C feed instance. The only argument is the local filename. The format of $source must be one of the supported feed formats -- RSS, RDF or Atom -- or execution is halted. =head2 $feed = XML::FeedPP->new( "http://use.perl.org/index.rss" ); The URL on the remote web server is also available as the first argument. L is required to download it. =head2 $feed = XML::FeedPP->new( '...' ); The XML source code is also available as the first argument. =head2 $feed = XML::FeedPP->new( $source, -type => $type ); The C<-type> argument allows you to specify type of $source from choice of C<'file'>, C<'url'> or C<'string'>. =head2 $feed = XML::FeedPP->new( $source, utf8_flag => 1 ); This makes utf8 flag on for every feed elements. Perl 5.8.1 or later is required to use this. Note that any other options for C constructor are also allowed like this. See more detail on L. =head2 $feed = XML::FeedPP::RSS->new( $source ); This constructor method creates an instance for an RSS 2.0 feed. The first argument is optional, but must be valid an RSS source if specified. This method returns an empty instance when $source is undefined. =head2 $feed = XML::FeedPP::RDF->new( $source ); This constructor method creates an instance for RSS 1.0 (RDF) feed. The first argument is optional, but must be an RDF source if specified. This method returns an empty instance when $source is undefined. =head2 $feed = XML::FeedPP::Atom->new( $source ); This constructor method creates an instance for an Atom 0.3/1.0 feed. The first argument is optional, but must be an Atom source if specified. This method returns an empty instance when $source is undefined. Atom 1.0 feed is also supported since C version 0.30. Atom 0.3 is still default, however, future version of this module would create Atom 1.0 as default. =head2 $feed = XML::FeedPP::Atom::Atom03->new(); This creates an empty Atom 0.3 instance obviously. =head2 $feed = XML::FeedPP::Atom::Atom10->new(); This creates an empty Atom 1.0 instance intended. =head2 $feed = XML::FeedPP::RSS->new( link => $link, title => $tile, ... ); This creates a RSS instance which has C, C elements etc. =head2 $feed->load( $source ); This method loads an RSS/RDF/Atom file, much like C<new()> method does. =head2 $feed->merge( $source ); This method merges an RSS/RDF/Atom file into the existing $feed instance. Top-level metadata from the imported feed is incorporated only if missing from the present feed. =head2 $string = $feed->to_string( $encoding ); This method generates XML source as string and returns it. The output $encoding is optional, and the default encoding is 'UTF-8'. On Perl 5.8 and later, any encodings supported by the Encode module are available. On Perl 5.005 and 5.6.1, only four encodings supported by the Jcode module are available: 'UTF-8', 'Shift_JIS', 'EUC-JP' and 'ISO-2022-JP'. 'UTF-8' is recommended for overall compatibility. =head2 $string = $feed->to_string( indent => 4 ); This makes the output more human readable by indenting appropriately. This does not strictly follow the XML specification but does looks nice. Note that any other options for C<XML::TreePP> constructor are also allowed like this. See more detail on L<XML::TreePP>. =head2 $feed->to_file( $filename, $encoding ); This method generate an XML file. The output $encoding is optional, and the default is 'UTF-8'. =head2 $item = $feed->add_item( $link ); This method creates a new item/entry and returns its instance. A mandatory $link argument is the URL of the new item/entry. =head2 $item = $feed->add_item( $srcitem ); This method duplicates an item/entry and adds it to $feed. $srcitem is a C<XML::FeedPP::*::Item> class's instance which is returned by C<get_item()> method, as described above. =head2 $item = $feed->add_item( link => $link, title => $tile, ... ); This method creates an new item/entry which has C<link>, C<title> elements etc. =head2 $item = $feed->get_item( $index ); This method returns item(s) in a $feed. A valid zero-based array $index returns the corresponding item in the feed. An invalid $index yields undef. If $index is undefined in array context, it returns an array of all items. If $index is undefined in scalar context, it returns the number of items. =head2 @items = $feed->match_item( link => qr/.../, title => qr/.../, ... ); This method finds item(s) which match all regular expressions given. This method returns an array of all matched items in array context. This method returns the first matched item in scalar context. =head2 $feed->remove_item( $index or $link ); This method removes an item/entry specified by zero-based array index or link URL. =head2 $feed->clear_item(); This method removes all items/entries from the $feed. =head2 $feed->sort_item(); This method sorts the order of items in $feed by C<pubDate>. =head2 $feed->uniq_item(); This method makes items unique. The second and succeeding items that have the same link URL are removed. =head2 $feed->normalize(); This method calls both the C<sort_item()> and C<uniq_item()> methods. =head2 $feed->limit_item( $num ); Removes items in excess of the specified numeric limit. Items at the end of the list are removed. When preceded by C<sort_item()> or C<normalize()>, this deletes more recent items. =head2 $feed->xmlns( "xmlns:media" => "http://search.yahoo.com/mrss" ); Adds an XML namespace at the document root of the feed. =head2 $url = $feed->xmlns( "xmlns:media" ); Returns the URL of the specified XML namespace. =head2 @list = $feed->xmlns(); Returns the list of all XML namespaces used in $feed. =head1 METHODS FOR CHANNEL =head2 $feed->title( $text ); This method sets/gets the feed's C<title> element, returning its current value when $title is undefined. =head2 $feed->description( $html ); This method sets/gets the feed's C<description> element in plain text or HTML, returning its current value when $html is undefined. It is mapped to C<content> element for Atom 0.3/1.0. =head2 $feed->pubDate( $date ); This method sets/gets the feed's C<pubDate> element for RSS, returning its current value when $date is undefined. It is mapped to C<dc:date> element for RDF, C<modified> for Atom 0.3, and C<updated> for Atom 1.0. See also L</DATE AND TIME FORMATS> section below. =head2 $feed->copyright( $text ); This method sets/gets the feed's C<copyright> element for RSS, returning its current value when $text is undefined. It is mapped to C<dc:rights> element for RDF, C<copyright> for Atom 0.3, and C<rights> for Atom 1.0. =head2 $feed->link( $url ); This method sets/gets the URL of the web site as the feed's C<link> element, returning its current value when the $url is undefined. =head2 $feed->language( $lang ); This method sets/gets the feed's C<language> element for RSS, returning its current value when the $lang is undefined. It is mapped to C<dc:language> element for RDF, C<feed xml:lang=""> for Atom 0.3/1.0. =head2 $feed->image( $url, $title, $link, $description, $width, $height ) This method sets/gets the feed's C<image> element and its child nodes, returning a list of current values when any arguments are undefined. =head1 METHODS FOR ITEM =head2 $item->title( $text ); This method sets/gets the item's C<title> element, returning its current value when the $text is undefined. =head2 $item->description( $html ); This method sets/gets the item's C<description> element in HTML or plain text, returning its current value when $text is undefined. It is mapped to C<content> element for Atom 0.3/1.0. =head2 $item->pubDate( $date ); This method sets/gets the item's C<pubDate> element, returning its current value when $date is undefined. It is mapped to C<dc:date> element for RDF, C<modified> for Atom 0.3, and C<updated> for Atom 1.0. See also L</DATE AND TIME FORMATS> section below. =head2 $item->category( $text ); This method sets/gets the item's C<category> element. returning its current value when $text is undefined. It is mapped to C<dc:subject> element for RDF, and ignored for Atom 0.3. =head2 $item->author( $name ); This method sets/gets the item's C<author> element, returning its current value when $name is undefined. It is mapped to C<dc:creator> element for RDF, C<author> for Atom 0.3/1.0. =head2 $item->guid( $guid, isPermaLink => $bool ); This method sets/gets the item's C<guid> element, returning its current value when $guid is undefined. It is mapped to C<id> element for Atom, and ignored for RDF. The second argument is optional. =head2 $item->set( $key => $value, ... ); This method sets customized node values or attributes. See also L</ACCESSOR AND MUTATORS> section below. =head2 $value = $item->get( $key ); This method returns the node value or attribute. See also L</ACCESSOR AND MUTATORS> section below. =head2 $link = $item->link(); This method returns the item's C<link> element. =head1 ACCESSOR AND MUTATORS This module understands only subset of C<rdf:*>, C<dc:*> modules and RSS/RDF/Atom's default namespaces by itself. There are NO native methods for any other external modules, such as C<media:*>. But C<set()> and C<get()> methods are available to get/set the value of any elements or attributes for these modules. =head2 $item->set( "module:name" => $value ); This sets the value of the child node: <item><module:name>$value</module:name>...</item> =head2 $item->set( "module:name@attr" => $value ); This sets the value of the child node's attribute: <item><module:name attr="$value" />...</item> =head2 $item->set( "@attr" => $value ); This sets the value of the item's attribute: <item attr="$value">...</item> =head2 $item->set( "hoge/pomu@hare" => $value ); This code sets the value of the child node's child node's attribute: <item><hoge><pomu attr="$value" /></hoge>...</item> =head1 DATE AND TIME FORMATS C<XML::FeedPP> allows you to describe date/time using any of the three following formats: =head2 $date = "Thu, 23 Feb 2006 14:43:43 +0900"; This is the HTTP protocol's preferred format and RSS 2.0's native format, as defined by RFC 1123. =head2 $date = "2006-02-23T14:43:43+09:00"; W3CDTF is the native format of RDF, as defined by ISO 8601. =head2 $date = 1140705823; The last format is the number of seconds since the epoch, C<1970-01-01T00:00:00Z>. You know, this is the native format of Perl's C<time()> function. =head1 USING MEDIA RSS To publish Media RSS, add the C<media> namespace then use C<set()> setter method to manipulate C<media:content> element, etc. my $feed = XML::FeedPP::RSS->new(); $feed->xmlns('xmlns:media' => 'http://search.yahoo.com/mrss/'); my $item = $feed->add_item('http://www.example.com/index.html'); $item->set('media:content@url' => 'http://www.example.com/image.jpg'); $item->set('media:content@type' => 'image/jpeg'); $item->set('media:content@width' => 640); $item->set('media:content@height' => 480); =head1 MODULE DEPENDENCIES C<XML::FeedPP> requires only L<XML::TreePP> which likewise is a pure Perl implementation. The standard L<LWP::UserAgent> is required to download feeds from remote web servers. C<Jcode.pm> is required to convert Japanese encodings on Perl 5.005 and 5.6.1, but is NOT required on Perl 5.8.x and later. =head1 AUTHOR Yusuke Kawasaki, http://www.kawa.net/ =head1 COPYRIGHT The following copyright notice applies to all the files provided in this distribution, including binary files, unless explicitly noted otherwise. Copyright 2006-2011 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::FeedPP; use strict; use Carp; use Time::Local; use XML::TreePP; use vars qw( $VERSION $RSS20_VERSION $ATOM03_VERSION $XMLNS_RDF $XMLNS_RSS $XMLNS_DC $XMLNS_ATOM03 $XMLNS_NOCOPY $TREEPP_OPTIONS $MIME_TYPES $FEED_METHODS $ITEM_METHODS $XMLNS_ATOM10 ); $VERSION = "0.43"; $RSS20_VERSION = '2.0'; $ATOM03_VERSION = '0.3'; $XMLNS_RDF = 'http://www.w3.org/1999/02/22-rdf-syntax-ns#'; $XMLNS_RSS = 'http://purl.org/rss/1.0/'; $XMLNS_DC = 'http://purl.org/dc/elements/1.1/'; $XMLNS_ATOM03 = 'http://purl.org/atom/ns#'; $XMLNS_ATOM10 = 'http://www.w3.org/2005/Atom'; $XMLNS_NOCOPY = [qw( xmlns xmlns:rdf xmlns:dc xmlns:atom )]; $TREEPP_OPTIONS = { force_array => [qw( item rdf:li entry )], first_out => [qw( -xmlns:rdf -xmlns -rel -type url title link )], last_out => [qw( description image item items entry -width -height )], user_agent => "XML-FeedPP/$VERSION ", }; $MIME_TYPES = { reverse qw( image/bmp bmp image/gif gif image/jpeg jpeg image/jpeg jpg image/png png image/svg+xml svg image/x-icon ico image/x-xbitmap xbm image/x-xpixmap xpm )}; $FEED_METHODS = [qw( title description language copyright link pubDate image set )]; $ITEM_METHODS = [qw( title description category author link guid pubDate image set )]; sub new { my $package = shift; my( $init, $source, @rest ) = &XML::FeedPP::Util::param_even_odd(@_); Carp::croak "No feed source" unless defined $source; my $self = {}; bless $self, $package; $self->load($source, @rest); if ( exists $self->{rss} ) { XML::FeedPP::RSS->feed_bless($self); } elsif ( exists $self->{'rdf:RDF'} ) { XML::FeedPP::RDF->feed_bless($self); } elsif ( exists $self->{feed} ) { my $xmlns = $self->{feed}->{-xmlns} if exists $self->{feed}->{-xmlns}; if ( $xmlns eq $XMLNS_ATOM10 ) { XML::FeedPP::Atom::Atom10->feed_bless($self); } elsif ( $xmlns eq $XMLNS_ATOM03 ) { XML::FeedPP::Atom::Atom03->feed_bless($self); } else { XML::FeedPP::Atom->feed_bless($self); } } else { my $root = join( " ", sort keys %$self ); Carp::croak "Invalid feed format: $root"; } $self->validate_feed($source); $self->init_feed(); $self->elements(@$init) if ref $init; $self; } sub feed_bless { my $package = shift; my $self = shift; bless $self, $package; $self; } sub load { my $self = shift; my $source = shift; my $args = { @_ }; my $method = $args->{'-type'}; Carp::croak "No feed source" unless defined $source; if ( ! $method ) { if ( $source =~ m#^https?://#s ) { $method = 'url'; } elsif ( $source =~ m#(?:\s*\xEF\xBB\xBF)?\s* (<(\?xml|!DOCTYPE|rdf:RDF|rss|feed)\W)#xis ) { $method = 'string'; } elsif ( $source !~ /[\r\n]/ && -f $source ) { $method = 'file'; } else { Carp::croak "Invalid feed source: $source"; } } my $opts = { map { $_ => $args->{$_} } grep { ! /^-/ } keys %$args }; my $tpp = XML::TreePP->new(%$TREEPP_OPTIONS, %$opts); my $tree; if ( $method eq 'url' ) { $tree = $tpp->parsehttp( GET => $source ); } elsif ( $method eq 'string' ) { $tree = $tpp->parse($source); } elsif ( $method eq 'file' ) { $tree = $tpp->parsefile($source); } else { Carp::croak "Invalid load type: $method"; } Carp::croak "Loading failed: $source" unless ref $tree; %$self = %$tree; # override myself $self; } sub to_string { my $self = shift; my( $args, $encode, @rest ) = XML::FeedPP::Util::param_even_odd(@_); $args ||= \@rest; my @opts = ( output_encoding => $encode ) if $encode; my $tpp = XML::TreePP->new( %$TREEPP_OPTIONS, @opts, @$args ); $tpp->write( $self, $encode ); } sub to_file { my $self = shift; my $file = shift; my( $args, $encode, @rest ) = XML::FeedPP::Util::param_even_odd(@_); $args ||= \@rest; my @opts = ( output_encoding => $encode ) if $encode; my $tpp = XML::TreePP->new( %$TREEPP_OPTIONS, @opts, @$args ); $tpp->writefile( $file, $self, $encode ); } sub merge { my $self = shift; my $source = shift; my $target = ref $source ? $source : XML::FeedPP->new($source); $self->merge_channel($target); $self->merge_item($target); $self->normalize(); $self; } sub merge_channel { my $self = shift; my $target = shift or return; if ( ref $self eq ref $target ) { $self->merge_native_channel($target); } else { $self->merge_common_channel($target); } } sub merge_item { my $self = shift; my $target = shift or return; foreach my $item ( $target->get_item() ) { $self->add_item( $item ); } } sub merge_common_channel { my $self = shift; my $target = shift or return; my $title1 = $self->title(); my $title2 = $target->title(); $self->title($title2) if ( !defined $title1 && defined $title2 ); my $desc1 = $self->description(); my $desc2 = $target->description(); $self->description($desc2) if ( !defined $desc1 && defined $desc2 ); my $link1 = $self->link(); my $link2 = $target->link(); $self->link($link2) if ( !defined $link1 && defined $link2 ); my $lang1 = $self->language(); my $lang2 = $target->language(); $self->language($lang2) if ( !defined $lang1 && defined $lang2 ); my $right1 = $self->copyright(); my $right2 = $target->copyright(); $self->copyright($right2) if ( !defined $right1 && defined $right2 ); my $pubDate1 = $self->pubDate(); my $pubDate2 = $target->pubDate(); $self->pubDate($pubDate2) if ( !defined $pubDate1 && defined $pubDate2 ); my @image1 = $self->image(); my @image2 = $target->image(); $self->image(@image2) if ( !defined $image1[0] && defined $image2[0] ); my @xmlns1 = $self->xmlns(); my @xmlns2 = $target->xmlns(); my $xmlchk = { map { $_ => 1 } @xmlns1, @$XML::FeedPP::XMLNS_NOCOPY }; foreach my $ns (@xmlns2) { next if exists $xmlchk->{$ns}; $self->xmlns( $ns, $target->xmlns($ns) ); } $self->merge_module_nodes( $self->docroot, $target->docroot ); $self; } sub add_clone_item { my $self = shift; my $srcitem = shift or return; my $link = $srcitem->link() or return; my $dstitem = $self->add_item( $link ); if ( ref $dstitem eq ref $srcitem ) { XML::FeedPP::Util::merge_hash( $dstitem, $srcitem ); } else { # my $link = $srcitem->link(); # $dstitem->link($link) if defined $link; my $title = $srcitem->title(); $dstitem->title($title) if defined $title; my $description = $srcitem->description(); $dstitem->description($description) if defined $description; my $category = $srcitem->category(); $dstitem->category($category) if defined $category; my $author = $srcitem->author(); $dstitem->author($author) if defined $author; my $guid = $srcitem->guid(); $dstitem->guid($guid) if defined $guid; my $pubDate = $srcitem->pubDate(); $dstitem->pubDate($pubDate) if defined $pubDate; $self->merge_module_nodes( $dstitem, $srcitem ); } $dstitem; } sub merge_module_nodes { my $self = shift; my $item1 = shift; my $item2 = shift; foreach my $key ( grep { /:/ } keys %$item2 ) { next if ( $key =~ /^-?(dc|rdf|xmlns):/ ); # deep copy would be better $item1->{$key} = $item2->{$key}; } } sub normalize { my $self = shift; $self->normalize_pubDate(); $self->sort_item(); $self->uniq_item(); } sub normalize_pubDate { my $self = shift; foreach my $item ( $self->get_item() ) { my $date = $item->get_pubDate_native() or next; $item->pubDate( $date ); } my $date = $self->get_pubDate_native(); $self->pubDate( $date ) if $date; } sub xmlns { my $self = shift; my $ns = shift; my $url = shift; my $root = $self->docroot; if ( !defined $ns ) { my $list = [ grep { /^-xmlns(:\S|$)/ } keys %$root ]; return map { (/^-(.*)$/)[0] } @$list; } elsif ( !defined $url ) { return unless exists $root->{ '-' . $ns }; return $root->{ '-' . $ns }; } else { $root->{ '-' . $ns } = $url; } } sub get_pubDate_w3cdtf { my $self = shift; my $date = $self->get_pubDate_native(); XML::FeedPP::Util::get_w3cdtf($date); } sub get_pubDate_rfc1123 { my $self = shift; my $date = $self->get_pubDate_native(); XML::FeedPP::Util::get_rfc1123($date); } sub get_pubDate_epoch { my $self = shift; my $date = $self->get_pubDate_native(); XML::FeedPP::Util::get_epoch($date); } sub call { my $self = shift; my $name = shift; my $class = __PACKAGE__."::Plugin::".$name; my $pmfile = $class; $pmfile =~ s#::#/#g; $pmfile .= ".pm"; local $@; eval { require $pmfile; } unless defined $class->VERSION; Carp::croak "$class failed: $@" if $@; return $class->run( $self, @_ ); } sub elements { my $self = shift; my $args = [ @_ ]; my $methods = { map {$_=>1} @$FEED_METHODS }; while ( my $key = shift @$args ) { my $val = shift @$args; if ( $methods->{$key} ) { $self->$key( $val ); } else { $self->set( $key, $val ); } } } sub match_item { my $self = shift; my @list = $self->get_item(); return unless scalar @list; my $methods = { map {$_=>1} @$ITEM_METHODS }; my $args = [ @_ ]; my $out = []; foreach my $item ( @list ) { my $unmatch = 0; my $i = 0; while( 1 ) { my $key = $args->[$i++] or last; my $test = $args->[$i++]; my $got = $methods->{$key} ? $item->$key() : $item->get( $key ); unless ( $got =~ $test ) { $unmatch ++; last; } } unless ( $unmatch ) { return $item unless wantarray; push( @$out, $item ); } } @$out; } # ---------------------------------------------------------------- package XML::FeedPP::Plugin; use strict; sub run { my $class = shift; my $feed = shift; my $ref = ref $class ? ref $class : $class; Carp::croak $ref."->run() is not implemented"; } # ---------------------------------------------------------------- package XML::FeedPP::Item; use strict; use vars qw( @ISA ); @ISA = qw( XML::FeedPP::Element ); *get_pubDate_w3cdtf = \&XML::FeedPP::get_pubDate_w3cdtf; # import *get_pubDate_rfc1123 = \&XML::FeedPP::get_pubDate_rfc1123; *get_pubDate_epoch = \&XML::FeedPP::get_pubDate_epoch; sub elements { my $self = shift; my $args = [ @_ ]; my $methods = { map {$_=>1} @$XML::FeedPP::ITEM_METHODS }; while ( my $key = shift @$args ) { my $val = shift @$args; if ( $methods->{$key} ) { $self->$key( $val ); } else { $self->set( $key, $val ); } } } # ---------------------------------------------------------------- package XML::FeedPP::RSS; use strict; use vars qw( @ISA ); @ISA = qw( XML::FeedPP ); sub new { my $package = shift; my( $init, $source, @rest ) = &XML::FeedPP::Util::param_even_odd(@_); my $self = {}; bless $self, $package; if ( defined $source ) { $self->load($source, @rest); $self->validate_feed($source); } $self->init_feed(); $self->elements(@$init) if ref $init; $self; } sub channel_class { 'XML::FeedPP::RSS::Channel'; } sub item_class { 'XML::FeedPP::RSS::Item'; } sub validate_feed { my $self = shift; my $source = shift || $self; if ( !ref $self || !ref $self->{rss} ) { Carp::croak "Invalid RSS format: $source"; } } sub init_feed { my $self = shift or return; $self->{rss} ||= {}; if ( ! UNIVERSAL::isa( $self->{rss}, 'HASH' ) ) { Carp::croak "Invalid RSS format: $self->{rss}"; } $self->{rss}->{'-version'} ||= $XML::FeedPP::RSS20_VERSION; $self->{rss}->{channel} ||= $self->channel_class->new(); $self->channel_class->ref_bless( $self->{rss}->{channel} ); $self->{rss}->{channel}->{item} ||= []; if ( UNIVERSAL::isa( $self->{rss}->{channel}->{item}, 'HASH' ) ) { # only one item $self->{rss}->{channel}->{item} = [ $self->{rss}->{channel}->{item} ]; } foreach my $item ( @{ $self->{rss}->{channel}->{item} } ) { $self->item_class->ref_bless($item); } $self; } sub merge_native_channel { my $self = shift; my $tree = shift or next; XML::FeedPP::Util::merge_hash( $self->{rss}, $tree->{rss}, qw( channel ) ); XML::FeedPP::Util::merge_hash( $self->{rss}->{channel}, $tree->{rss}->{channel}, qw( item ) ); } sub add_item { my $self = shift; my( $init, $link, @rest ) = &XML::FeedPP::Util::param_even_odd(@_); Carp::croak "add_item needs an argument" if ( ! ref $init && ! $link ); if ( ref $link ) { return $self->add_clone_item( $link ); } my $item = XML::FeedPP::RSS::Item->new(@rest); $item->link($link) if $link; $item->elements(@$init) if ref $init; push( @{ $self->{rss}->{channel}->{item} }, $item ); $item; } sub clear_item { my $self = shift; $self->{rss}->{channel}->{item} = []; } sub remove_item { my $self = shift; my $remove = shift; my $list = $self->{rss}->{channel}->{item} or return; my @deleted; if ( $remove =~ /^-?\d+/ ) { @deleted = splice( @$list, $remove, 1 ); } else { @deleted = grep { $_->link() eq $remove } @$list; @$list = grep { $_->link() ne $remove } @$list; } wantarray ? @deleted : shift @deleted; } sub get_item { my $self = shift; my $num = shift; $self->{rss}->{channel}->{item} ||= []; if ( defined $num ) { return $self->{rss}->{channel}->{item}->[$num]; } elsif (wantarray) { return @{ $self->{rss}->{channel}->{item} }; } else { return scalar @{ $self->{rss}->{channel}->{item} }; } } sub sort_item { my $self = shift; my $list = $self->{rss}->{channel}->{item} or return; my $epoch = [ map { $_->get_pubDate_epoch() || 0 } @$list ]; my $sorted = [ map { $list->[$_] } sort { $epoch->[$b] <=> $epoch->[$a] } 0 .. $#$list ]; @$list = @$sorted; scalar @$list; } sub uniq_item { my $self = shift; my $list = $self->{rss}->{channel}->{item} or return; my $check = {}; my $uniq = []; foreach my $item (@$list) { my $link = $item->link(); push( @$uniq, $item ) unless $check->{$link}++; } @$list = @$uniq; scalar @$list; } sub limit_item { my $self = shift; my $limit = shift; my $list = $self->{rss}->{channel}->{item} or return; if ( $limit > 0 && $limit < scalar @$list ) { @$list = splice( @$list, 0, $limit ); # remove from end } elsif ( $limit < 0 && -$limit < scalar @$list ) { @$list = splice( @$list, $limit ); # remove from start } scalar @$list; } sub docroot { shift->{rss}; } sub channel { shift->{rss}->{channel}; } sub set { shift->{rss}->{channel}->set(@_); } sub get { shift->{rss}->{channel}->get(@_); } sub title { shift->{rss}->{channel}->get_or_set( "title", @_ ); } sub description { shift->{rss}->{channel}->get_or_set( "description", @_ ); } sub link { shift->{rss}->{channel}->get_or_set( "link", @_ ); } sub language { shift->{rss}->{channel}->get_or_set( "language", @_ ); } sub copyright { shift->{rss}->{channel}->get_or_set( "copyright", @_ ); } sub pubDate { my $self = shift; my $date = shift; return $self->get_pubDate_w3cdtf() unless defined $date; $date = XML::FeedPP::Util::get_rfc1123($date); $self->{rss}->{channel}->set_value( "pubDate", $date ); } sub get_pubDate_native { my $self = shift; $self->{rss}->{channel}->get_value("pubDate") # normal RSS 2.0 || $self->{rss}->{channel}->get_value("dc:date"); # strange } sub image { my $self = shift; my $url = shift; if ( defined $url ) { my ( $title, $link, $desc, $width, $height ) = @_; $self->{rss}->{channel}->{image} ||= {}; my $image = $self->{rss}->{channel}->{image}; $image->{url} = $url; $image->{title} = $title if defined $title; $image->{link} = $link if defined $link; $image->{description} = $desc if defined $desc; $image->{width} = $width if defined $width; $image->{height} = $height if defined $height; } elsif ( exists $self->{rss}->{channel}->{image} ) { my $image = $self->{rss}->{channel}->{image}; my $array = []; foreach my $key (qw( url title link description width height )) { push( @$array, exists $image->{$key} ? $image->{$key} : undef ); } return wantarray ? @$array : shift @$array; } undef; } # ---------------------------------------------------------------- package XML::FeedPP::RSS::Channel; use strict; use vars qw( @ISA ); @ISA = qw( XML::FeedPP::Element ); # ---------------------------------------------------------------- package XML::FeedPP::RSS::Item; use strict; use vars qw( @ISA ); @ISA = qw( XML::FeedPP::Item ); sub title { shift->get_or_set( "title", @_ ); } sub description { shift->get_or_set( "description", @_ ); } sub category { shift->get_set_array( "category", @_ ); } sub author { my $self = shift; if ( scalar @_ ) { $self->set_value( 'author', @_ ); } else { $self->get_value('author') || $self->get_value('dc:creator'); } } sub link { my $self = shift; my $link = shift; return $self->get_value("link") unless defined $link; $self->guid($link) unless defined $self->guid(); $self->set_value( link => $link ); } sub guid { my $self = shift; my $guid = shift; return $self->get_value("guid") unless defined $guid; my @args = @_; if ( ! scalar @args ) { # default @args = ( 'isPermaLink' => 'true' ); } elsif ( scalar @args == 1 ) { # XML::FeedPP 0.36's behavior unshift( @args, 'isPermaLink' ); } $self->set_value( guid => $guid, @args ); } sub pubDate { my $self = shift; my $date = shift; return $self->get_pubDate_w3cdtf() unless defined $date; $date = XML::FeedPP::Util::get_rfc1123($date); $self->set_value( "pubDate", $date ); } sub get_pubDate_native { my $self = shift; $self->get_value("pubDate") # normal RSS 2.0 || $self->get_value("dc:date"); # strange } sub image { my $self = shift; my $url = shift; if ( defined $url ) { my ( $title, $link, $desc, $width, $height ) = @_; $self->{image} ||= {}; my $image = $self->{image}; $image->{url} = $url; $image->{title} = $title if defined $title; $image->{link} = $link if defined $link; $image->{description} = $desc if defined $desc; $image->{width} = $width if defined $width; $image->{height} = $height if defined $height; } elsif ( exists $self->{image} ) { my $image = $self->{image}; my $array = []; foreach my $key (qw( url title link description width height )) { push( @$array, exists $image->{$key} ? $image->{$key} : undef ); } return wantarray ? @$array : shift @$array; } undef; } # ---------------------------------------------------------------- package XML::FeedPP::RDF; use strict; use vars qw( @ISA ); @ISA = qw( XML::FeedPP ); sub new { my $package = shift; my( $init, $source, @rest ) = &XML::FeedPP::Util::param_even_odd(@_); my $self = {}; bless $self, $package; if ( defined $source ) { $self->load($source, @rest); $self->validate_feed($source); } $self->init_feed(); $self->elements(@$init) if ref $init; $self; } sub channel_class { 'XML::FeedPP::RDF::Channel'; } sub item_class { 'XML::FeedPP::RDF::Item'; } sub validate_feed { my $self = shift; my $source = shift || $self; if ( !ref $self || !ref $self->{'rdf:RDF'} ) { Carp::croak "Invalid RDF format: $source"; } } sub init_feed { my $self = shift or return; $self->{'rdf:RDF'} ||= {}; if ( ! UNIVERSAL::isa( $self->{'rdf:RDF'}, 'HASH' ) ) { Carp::croak "Invalid RDF format: $self->{'rdf:RDF'}"; } $self->xmlns( 'xmlns' => $XML::FeedPP::XMLNS_RSS ); $self->xmlns( 'xmlns:rdf' => $XML::FeedPP::XMLNS_RDF ); $self->xmlns( 'xmlns:dc' => $XML::FeedPP::XMLNS_DC ); $self->{'rdf:RDF'}->{channel} ||= $self->channel_class->new(); $self->channel_class->ref_bless( $self->{'rdf:RDF'}->{channel} ); $self->{'rdf:RDF'}->{channel}->{items} ||= {}; $self->{'rdf:RDF'}->{channel}->{items}->{'rdf:Seq'} ||= {}; my $rdfseq = $self->{'rdf:RDF'}->{channel}->{items}->{'rdf:Seq'}; # http://www.kawa.net/works/perl/feedpp/feedpp.html#com-2008-05-17T13:13:33Z if ( UNIVERSAL::isa( $rdfseq, 'ARRAY' ) ) { my $num1 = scalar @$rdfseq; my $num2 = scalar grep { ref $_ && exists $_->{'rdf:li'} && ref $_->{'rdf:li'} } @$rdfseq; my $num3 = scalar grep { ref $_ && keys %$_ == 1 } @$rdfseq; if ( $num1 && $num1 == $num2 && $num1 == $num3 ) { my $newli = [ map { @{$_->{'rdf:li'}} } @$rdfseq ]; $rdfseq = { 'rdf:li' => $newli }; $self->{'rdf:RDF'}->{channel}->{items}->{'rdf:Seq'} = $rdfseq; } } $rdfseq->{'rdf:li'} ||= []; if ( UNIVERSAL::isa( $rdfseq->{'rdf:li'}, 'HASH' ) ) { $rdfseq->{'rdf:li'} = [ $rdfseq->{'rdf:li'} ]; } $self->{'rdf:RDF'}->{item} ||= []; if ( UNIVERSAL::isa( $self->{'rdf:RDF'}->{item}, 'HASH' ) ) { # force array when only one item exist $self->{'rdf:RDF'}->{item} = [ $self->{'rdf:RDF'}->{item} ]; } foreach my $item ( @{ $self->{'rdf:RDF'}->{item} } ) { $self->item_class->ref_bless($item); } $self; } sub merge_native_channel { my $self = shift; my $tree = shift or next; XML::FeedPP::Util::merge_hash( $self->{'rdf:RDF'}, $tree->{'rdf:RDF'}, qw( channel item ) ); XML::FeedPP::Util::merge_hash( $self->{'rdf:RDF'}->{channel}, $tree->{'rdf:RDF'}->{channel}, qw( items ) ); } sub add_item { my $self = shift; my( $init, $link, @rest ) = &XML::FeedPP::Util::param_even_odd(@_); Carp::croak "add_item needs an argument" if ( ! ref $init && ! $link ); if ( ref $link ) { return $self->add_clone_item( $link ); } my $rdfli = $self->item_class->new(); $rdfli->{'-rdf:resource'} = $link; $self->{'rdf:RDF'}->{channel}->{items}->{'rdf:Seq'}->{'rdf:li'} ||= []; push( @{ $self->{'rdf:RDF'}->{channel}->{items}->{'rdf:Seq'}->{'rdf:li'} }, $rdfli ); my $item = XML::FeedPP::RDF::Item->new(@rest); $item->link($link) if $link; $item->elements(@$init) if ref $init; push( @{ $self->{'rdf:RDF'}->{item} }, $item ); $item; } sub clear_item { my $self = shift; $self->{'rdf:RDF'}->{item} = []; $self->__refresh_items(); } sub remove_item { my $self = shift; my $remove = shift; my $list = $self->{'rdf:RDF'}->{item} or return; my @deleted; if ( $remove =~ /^-?\d+/ ) { @deleted = splice( @$list, $remove, 1 ); } else { @deleted = grep { $_->link() eq $remove } @$list; @$list = grep { $_->link() ne $remove } @$list; } $self->__refresh_items(); wantarray ? @deleted : shift @deleted; } sub get_item { my $self = shift; my $num = shift; $self->{'rdf:RDF'}->{item} ||= []; if ( defined $num ) { return $self->{'rdf:RDF'}->{item}->[$num]; } elsif (wantarray) { return @{ $self->{'rdf:RDF'}->{item} }; } else { return scalar @{ $self->{'rdf:RDF'}->{item} }; } } sub sort_item { my $self = shift; my $list = $self->{'rdf:RDF'}->{item} or return; my $epoch = [ map { $_->get_pubDate_epoch() || 0 } @$list ]; my $sorted = [ map { $list->[$_] } sort { $epoch->[$b] <=> $epoch->[$a] } 0 .. $#$list ]; @$list = @$sorted; $self->__refresh_items(); } sub uniq_item { my $self = shift; my $list = $self->{'rdf:RDF'}->{item} or return; my $check = {}; my $uniq = []; foreach my $item (@$list) { my $link = $item->link(); push( @$uniq, $item ) unless $check->{$link}++; } $self->{'rdf:RDF'}->{item} = $uniq; $self->__refresh_items(); } sub limit_item { my $self = shift; my $limit = shift; my $list = $self->{'rdf:RDF'}->{item} or return; if ( $limit > 0 && $limit < scalar @$list ) { @$list = splice( @$list, 0, $limit ); # remove from end } elsif ( $limit < 0 && -$limit < scalar @$list ) { @$list = splice( @$list, $limit ); # remove from start } $self->__refresh_items(); } sub __refresh_items { my $self = shift; my $list = $self->{'rdf:RDF'}->{item} or return; $self->{'rdf:RDF'}->{channel}->{items}->{'rdf:Seq'}->{'rdf:li'} = []; my $dest = $self->{'rdf:RDF'}->{channel}->{items}->{'rdf:Seq'}->{'rdf:li'}; foreach my $item (@$list) { my $rdfli = XML::FeedPP::Element->new(); $rdfli->{'-rdf:resource'} = $item->link(); push( @$dest, $rdfli ); } scalar @$dest; } sub docroot { shift->{'rdf:RDF'}; } sub channel { shift->{'rdf:RDF'}->{channel}; } sub set { shift->{'rdf:RDF'}->{channel}->set(@_); } sub get { shift->{'rdf:RDF'}->{channel}->get(@_); } sub title { shift->{'rdf:RDF'}->{channel}->get_or_set( "title", @_ ); } sub description { shift->{'rdf:RDF'}->{channel}->get_or_set( "description", @_ ); } sub language { shift->{'rdf:RDF'}->{channel}->get_or_set( "dc:language", @_ ); } sub copyright { shift->{'rdf:RDF'}->{channel}->get_or_set( "dc:rights", @_ ); } sub link { my $self = shift; my $link = shift; return $self->{'rdf:RDF'}->{channel}->get_value("link") unless defined $link; $self->{'rdf:RDF'}->{channel}->{'-rdf:about'} = $link; $self->{'rdf:RDF'}->{channel}->set_value( "link", $link, @_ ); } sub pubDate { my $self = shift; my $date = shift; return $self->get_pubDate_w3cdtf() unless defined $date; $date = XML::FeedPP::Util::get_w3cdtf($date); $self->{'rdf:RDF'}->{channel}->set_value( "dc:date", $date ); } sub get_pubDate_native { shift->{'rdf:RDF'}->{channel}->get_value("dc:date"); } *get_pubDate_w3cdtf = \&get_pubDate_native; sub image { my $self = shift; my $url = shift; if ( defined $url ) { my ( $title, $link ) = @_; $self->{'rdf:RDF'}->{channel}->{image} ||= {}; $self->{'rdf:RDF'}->{channel}->{image}->{'-rdf:resource'} = $url; $self->{'rdf:RDF'}->{image} ||= {}; $self->{'rdf:RDF'}->{image}->{'-rdf:about'} = $url; # fix my $image = $self->{'rdf:RDF'}->{image}; $image->{url} = $url; $image->{title} = $title if defined $title; $image->{link} = $link if defined $link; } elsif ( exists $self->{'rdf:RDF'}->{image} ) { my $image = $self->{'rdf:RDF'}->{image}; my $array = []; foreach my $key (qw( url title link )) { push( @$array, exists $image->{$key} ? $image->{$key} : undef ); } return wantarray ? @$array : shift @$array; } elsif ( exists $self->{'rdf:RDF'}->{channel}->{image} ) { return $self->{'rdf:RDF'}->{channel}->{image}->{'-rdf:resource'}; } undef; } # ---------------------------------------------------------------- package XML::FeedPP::RDF::Channel; use strict; use vars qw( @ISA ); @ISA = qw( XML::FeedPP::Element ); # ---------------------------------------------------------------- package XML::FeedPP::RDF::Item; use strict; use vars qw( @ISA ); @ISA = qw( XML::FeedPP::Item ); sub title { shift->get_or_set( "title", @_ ); } sub description { shift->get_or_set( "description", @_ ); } sub category { shift->get_set_array( "dc:subject", @_ ); } sub guid { undef; } # this element is NOT supported for RDF sub author { my $self = shift; my $author = shift; return $self->get_value('dc:creator') || $self->get_value('creator') unless defined $author; $self->set_value( 'dc:creator' => $author ); } sub link { my $self = shift; my $link = shift; return $self->get_value("link") unless defined $link; $self->{'-rdf:about'} = $link; $self->set_value( "link", $link, @_ ); } sub pubDate { my $self = shift; my $date = shift; return $self->get_pubDate_w3cdtf() unless defined $date; $date = XML::FeedPP::Util::get_w3cdtf($date); $self->set_value( "dc:date", $date ); } sub get_pubDate_native { shift->get_value("dc:date"); } *get_pubDate_w3cdtf = \&get_pubDate_native; # ---------------------------------------------------------------- package XML::FeedPP::Atom::Common; use strict; use vars qw( @ISA ); @ISA = qw( XML::FeedPP ); sub new { my $package = shift; my( $init, $source, @rest ) = &XML::FeedPP::Util::param_even_odd(@_); my $self = {}; bless $self, $package; if ( defined $source ) { $self->load($source, @rest); $self->validate_feed($source); } $self->init_feed(); $self->elements(@$init) if ref $init; $self; } sub validate_feed { my $self = shift; my $source = shift || $self; if ( !ref $self || !ref $self->{feed} ) { Carp::croak "Invalid Atom format: $source"; } } sub merge_native_channel { my $self = shift; my $tree = shift or next; XML::FeedPP::Util::merge_hash( $self->{feed}, $tree->{feed}, qw( entry ) ); } sub add_item { my $self = shift; my( $init, $link, @rest ) = &XML::FeedPP::Util::param_even_odd(@_); Carp::croak "add_item needs an argument" if ( ! ref $init && ! $link ); if ( ref $link ) { return $self->add_clone_item( $link ); } my $item = $self->item_class->new(@rest); $item->link($link) if $link; $item->elements(@$init) if ref $init; push( @{ $self->{feed}->{entry} }, $item ); $item; } sub clear_item { my $self = shift; $self->{feed}->{entry} = []; } sub remove_item { my $self = shift; my $remove = shift; my $list = $self->{feed}->{entry} or return; my @deleted; if ( $remove =~ /^-?\d+/ ) { @deleted = splice( @$list, $remove, 1 ); } else { @deleted = grep { $_->link() eq $remove } @$list; @$list = grep { $_->link() ne $remove } @$list; } wantarray ? @deleted : shift @deleted; } sub get_item { my $self = shift; my $num = shift; $self->{feed}->{entry} ||= []; if ( defined $num ) { return $self->{feed}->{entry}->[$num]; } elsif (wantarray) { return @{ $self->{feed}->{entry} }; } else { return scalar @{ $self->{feed}->{entry} }; } } sub sort_item { my $self = shift; my $list = $self->{feed}->{entry} or return; my $epoch = [ map { $_->get_pubDate_epoch() || 0 } @$list ]; my $sorted = [ map { $list->[$_] } sort { $epoch->[$b] <=> $epoch->[$a] } 0 .. $#$list ]; @$list = @$sorted; scalar @$list; } sub uniq_item { my $self = shift; my $list = $self->{feed}->{entry} or return; my $check = {}; my $uniq = []; foreach my $item (@$list) { my $link = $item->link(); push( @$uniq, $item ) unless $check->{$link}++; } @$list = @$uniq; } sub limit_item { my $self = shift; my $limit = shift; my $list = $self->{feed}->{entry} or return; if ( $limit > 0 && $limit < scalar @$list ) { @$list = splice( @$list, 0, $limit ); # remove from end } elsif ( $limit < 0 && -$limit < scalar @$list ) { @$list = splice( @$list, $limit ); # remove from start } scalar @$list; } sub docroot { shift->{feed}; } sub channel { shift->{feed}; } sub set { shift->{feed}->set(@_); } sub get { shift->{feed}->get(@_); } sub language { my $self = shift; my $lang = shift; return $self->{feed}->{'-xml:lang'} unless defined $lang; $self->{feed}->{'-xml:lang'} = $lang; } sub image { my $self = shift; my $href = shift; my $title = shift; my $link = $self->{feed}->{link} || []; $link = [$link] if UNIVERSAL::isa( $link, 'HASH' ); my $icon = ( grep { ref $_ && exists $_->{'-rel'} && ($_->{'-rel'} eq "icon" ) } @$link )[0]; my $rext = join( "|", map {"\Q$_\E"} keys %$XML::FeedPP::MIME_TYPES ); if ( defined $href ) { my $ext = ( $href =~ m#[^/]\.($rext)(\W|$)#i )[0]; my $type = $XML::FeedPP::MIME_TYPES->{$ext} if $ext; if ( ref $icon ) { $icon->{'-href'} = $href; $icon->{'-type'} = $type if $type; $icon->{'-title'} = $title if $title; } else { my $newicon = {}; $newicon->{'-rel'} = 'icon'; $newicon->{'-href'} = $href; $newicon->{'-type'} = $type if $type; $newicon->{'-title'} = $title if $title; my $flink = $self->{feed}->{link}; if ( UNIVERSAL::isa( $flink, 'ARRAY' )) { push( @$flink, $newicon ); } elsif ( UNIVERSAL::isa( $flink, 'HASH' )) { $self->{feed}->{link} = [ $flink, $newicon ]; } else { $self->{feed}->{link} = [ $newicon ]; } } } elsif ( ref $icon ) { my $array = [ $icon->{'-href'} ]; push( @$array, $icon->{'-title'} ) if exists $icon->{'-title'}; return wantarray ? @$array : shift @$array; } undef; } # ---------------------------------------------------------------- package XML::FeedPP::Atom::Atom03; use strict; use vars qw( @ISA ); @ISA = qw( XML::FeedPP::Atom::Common ); sub channel_class { 'XML::FeedPP::Atom::Atom03::Feed'; } sub item_class { 'XML::FeedPP::Atom::Atom03::Entry'; } sub init_feed { my $self = shift or return; $self->{feed} ||= $self->channel_class->new(); $self->channel_class->ref_bless( $self->{feed} ); if ( ! UNIVERSAL::isa( $self->{feed}, 'HASH' ) ) { Carp::croak "Invalid Atom 0.3 format: $self->{feed}"; } $self->xmlns( 'xmlns' => $XML::FeedPP::XMLNS_ATOM03 ); $self->{feed}->{'-version'} ||= $XML::FeedPP::ATOM03_VERSION; $self->{feed}->{entry} ||= []; if ( UNIVERSAL::isa( $self->{feed}->{entry}, 'HASH' ) ) { # if this feed has only one item $self->{feed}->{entry} = [ $self->{feed}->{entry} ]; } foreach my $item ( @{ $self->{feed}->{entry} } ) { $self->item_class->ref_bless($item); } $self->{feed}->{author} ||= { name => '' }; # dummy for validation $self; } sub title { my $self = shift; my $title = shift; return $self->{feed}->get_value('title') unless defined $title; $self->{feed}->set_value( 'title' => $title, type => 'text/plain' ); } sub description { my $self = shift; my $desc = shift; return $self->{feed}->get_value('tagline') || $self->{feed}->get_value('subtitle') unless defined $desc; $self->{feed}->set_value( 'tagline' => $desc, type => 'text/html', mode => 'escaped' ); } sub pubDate { my $self = shift; my $date = shift; return $self->get_pubDate_w3cdtf() unless defined $date; $date = XML::FeedPP::Util::get_w3cdtf($date); $self->{feed}->set_value( 'modified', $date ); } sub get_pubDate_native { my $self = shift; $self->{feed}->get_value('modified') # Atom 0.3 || $self->{feed}->get_value('updated'); # Atom 1.0 } *get_pubDate_w3cdtf = \&get_pubDate_native; sub copyright { my $self = shift; my $copy = shift; return $self->{feed}->get_value('copyright') || $self->{feed}->get_value('rights') unless defined $copy; $self->{feed}->set_value( 'copyright' => $copy ); } sub link { my $self = shift; my $href = shift; my $link = $self->{feed}->{link} || []; $link = [$link] if UNIVERSAL::isa( $link, 'HASH' ); $link = [ grep { ref $_ } @$link ]; $link = [ grep { ! exists $_->{'-rel'} || $_->{'-rel'} eq 'alternate' } @$link ]; $link = [ grep { ! exists $_->{'-type'} || $_->{'-type'} =~ m#^text/(x-)?html#i } @$link ]; my $html = shift @$link; if ( defined $href ) { if ( ref $html ) { $html->{'-href'} = $href; } else { my $hash = { -rel => 'alternate', -type => 'text/html', -href => $href, }; my $flink = $self->{feed}->{link}; if ( ! ref $flink ) { $self->{feed}->{link} = [ $hash ]; } elsif ( UNIVERSAL::isa( $flink, 'ARRAY' )) { push( @$flink, $hash ); } elsif ( UNIVERSAL::isa( $flink, 'HASH' )) { $self->{feed}->{link} = [ $flink, $hash ]; } } } elsif ( ref $html ) { return $html->{'-href'}; } return; } # ---------------------------------------------------------------- package XML::FeedPP::Atom::Atom10; use strict; use vars qw( @ISA ); @ISA = qw( XML::FeedPP::Atom::Common ); sub channel_class { 'XML::FeedPP::Atom::Atom10::Feed'; } sub item_class { 'XML::FeedPP::Atom::Atom10::Entry'; } sub init_feed { my $self = shift or return; $self->{feed} ||= $self->channel_class->new(); $self->channel_class->ref_bless( $self->{feed} ); if ( ! UNIVERSAL::isa( $self->{feed}, 'HASH' ) ) { Carp::croak "Invalid Atom 1.0 format: $self->{feed}"; } $self->xmlns( 'xmlns' => $XML::FeedPP::XMLNS_ATOM10 ); # $self->{feed}->{'-version'} ||= $XML::FeedPP::ATOM10_VERSION; $self->{feed}->{entry} ||= []; if ( UNIVERSAL::isa( $self->{feed}->{entry}, 'HASH' ) ) { # if this feed has only one item $self->{feed}->{entry} = [ $self->{feed}->{entry} ]; } foreach my $item ( @{ $self->{feed}->{entry} } ) { $self->item_class->ref_bless($item); } # $self->{feed}->{author} ||= { name => '' }; # dummy for validation $self; } sub title { my $self = shift; my $title = shift; return $self->{feed}->get_value('title') unless defined $title; $self->{feed}->set_value( 'title' => $title, @_ ); } sub description { my $self = shift; my $desc = shift; return $self->{feed}->get_value('content') || $self->{feed}->get_value('summary') || $self->{feed}->get_value('subtitle') || $self->{feed}->get_value('tagline') unless defined $desc; $self->{feed}->set_value( 'content' => $desc, @_ ); # type => 'text' } sub pubDate { my $self = shift; my $date = shift; return $self->get_pubDate_w3cdtf() unless defined $date; $date = XML::FeedPP::Util::get_w3cdtf($date); $self->{feed}->set_value( 'updated', $date ); } sub get_pubDate_native { my $self = shift; $self->{feed}->get_value('updated') # Atom 1.0 || $self->{feed}->get_value('modified') # Atom 0.3 } *get_pubDate_w3cdtf = \&get_pubDate_native; sub copyright { my $self = shift; my $copy = shift; return $self->{feed}->get_value('rights') || $self->{feed}->get_value('copyright') unless defined $copy; $self->{feed}->set_value( 'rights' => $copy ); } sub link { my $self = shift; my $href = shift; my $link = $self->{feed}->{link} || []; $link = [$link] if UNIVERSAL::isa( $link, 'HASH' ); $link = [ grep { ref $_ } @$link ]; $link = [ grep { ! exists $_->{'-rel'} || $_->{'-rel'} eq 'alternate' } @$link ]; my $html = shift @$link; if ( defined $href ) { if ( ref $html ) { $html->{'-href'} = $href; } else { my $hash = { -rel => 'alternate', -href => $href, }; my $flink = $self->{feed}->{link}; if ( ! ref $flink ) { $self->{feed}->{link} = [ $hash ]; } elsif ( UNIVERSAL::isa( $flink, 'ARRAY' )) { push( @$flink, $hash ); } elsif ( UNIVERSAL::isa( $flink, 'HASH' )) { $self->{feed}->{link} = [ $flink, $hash ]; } } } elsif ( ref $html ) { return $html->{'-href'}; } return; } # ---------------------------------------------------------------- package XML::FeedPP::Atom; use strict; use vars qw( @ISA ); @ISA = qw( XML::FeedPP::Atom::Atom03 ); # @ISA = qw( XML::FeedPP::Atom::Atom10 ); # if Atom 1.0 for default # ---------------------------------------------------------------- package XML::FeedPP::Atom::Common::Feed; use strict; use vars qw( @ISA ); @ISA = qw( XML::FeedPP::Element ); # <content type="xhtml"><div>...</div></content> # http://www.ietf.org/rfc/rfc4287.txt # 3. If the value of "type" is "xhtml", the content of atom:content # MUST be a single XHTML div element [XHTML] and SHOULD be suitable # for handling as XHTML. The XHTML div element itself MUST NOT be # considered part of the content. sub _fetch_value { my $self = shift; my $value = shift; if ( UNIVERSAL::isa( $value, 'HASH' ) && exists $value->{'-type'} && ($value->{'-type'} eq "xhtml")) { my $child = [ grep { /^[^\-\#]/ } keys %$value ]; if (scalar @$child == 1) { my $div = shift @$child; if ($div =~ /^([^:]+:)?div$/i) { return $value->{$div}; } } } $self->SUPER::_fetch_value($value); } # ---------------------------------------------------------------- package XML::FeedPP::Atom::Atom03::Feed; use strict; use vars qw( @ISA ); @ISA = qw( XML::FeedPP::Atom::Common::Feed ); # ---------------------------------------------------------------- package XML::FeedPP::Atom::Atom10::Feed; use strict; use vars qw( @ISA ); @ISA = qw( XML::FeedPP::Atom::Common::Feed ); # ---------------------------------------------------------------- package XML::FeedPP::Atom::Common::Entry; use strict; use vars qw( @ISA ); @ISA = qw( XML::FeedPP::Item ); sub author { my $self = shift; my $name = shift; unless ( defined $name ) { my $author = $self->{author}->{name} if ref $self->{author}; return $author; } my $author = ref $name ? $name : { name => $name }; $self->{author} = $author; } sub guid { shift->get_or_set( 'id', @_ ); } *_fetch_value = \&XML::FeedPP::Atom::Common::Feed::_fetch_value; # ---------------------------------------------------------------- package XML::FeedPP::Atom::Atom03::Entry; use strict; use vars qw( @ISA ); @ISA = qw( XML::FeedPP::Atom::Common::Entry ); sub description { my $self = shift; my $desc = shift; return $self->get_value('content') || $self->get_value('summary') unless defined $desc; $self->set_value( 'content' => $desc, type => 'text/html', mode => 'escaped' ); } sub link { my $self = shift; my $href = shift; my $link = $self->{link} || []; $link = [$link] if UNIVERSAL::isa( $link, 'HASH' ); $link = [ grep { ref $_ } @$link ]; $link = [ grep { ! exists $_->{'-rel'} || $_->{'-rel'} eq 'alternate' } @$link ]; $link = [ grep { ! exists $_->{'-type'} || $_->{'-type'} =~ m#^text/(x-)?html#i } @$link ]; my $html = shift @$link; if ( defined $href ) { if ( ref $html ) { $html->{'-href'} = $href; } else { my $hash = { -rel => 'alternate', -type => 'text/html', -href => $href, }; my $flink = $self->{link}; if ( ! ref $flink ) { $self->{link} = [ $hash ]; } elsif ( ref $flink && UNIVERSAL::isa( $flink, 'ARRAY' )) { push( @$flink, $hash ); } elsif ( ref $flink && UNIVERSAL::isa( $flink, 'HASH' )) { $self->{link} = [ $flink, $hash ]; } } $self->guid( $href ) unless defined $self->guid(); } elsif ( ref $html ) { return $html->{'-href'}; } return; } sub pubDate { my $self = shift; my $date = shift; return $self->get_pubDate_w3cdtf() unless defined $date; $date = XML::FeedPP::Util::get_w3cdtf($date); $self->set_value( 'issued', $date ); $self->set_value( 'modified', $date ); } sub get_pubDate_native { my $self = shift; $self->get_value('modified') # Atom 0.3 || $self->get_value('issued') # Atom 0.3 || $self->get_value('updated') # Atom 1.0 || $self->get_value('published'); # Atom 1.0 } *get_pubDate_w3cdtf = \&get_pubDate_native; sub title { my $self = shift; my $title = shift; return $self->get_value('title') unless defined $title; $self->set_value( 'title' => $title, type => 'text/plain' ); } sub category { undef; } # this element is NOT supported for Atom 0.3 # ---------------------------------------------------------------- package XML::FeedPP::Atom::Atom10::Entry; use strict; use vars qw( @ISA ); @ISA = qw( XML::FeedPP::Atom::Common::Entry ); sub description { my $self = shift; my $desc = shift; return $self->get_value('content') || $self->get_value('summary') unless defined $desc; $self->set_value( 'content' => $desc, @_ ); } sub link { my $self = shift; my $href = shift; my $link = $self->{link} || []; $link = [$link] if UNIVERSAL::isa( $link, 'HASH' ); $link = [ grep { ref $_ } @$link ]; $link = [ grep { ! exists $_->{'-rel'} || $_->{'-rel'} eq 'alternate' } @$link ]; my $html = shift @$link; if ( defined $href ) { if ( ref $html ) { $html->{'-href'} = $href; } else { my $hash = { # -rel => 'alternate', -href => $href, }; my $flink = $self->{link}; if ( ! ref $flink ) { $self->{link} = [ $hash ]; } elsif ( ref $flink && UNIVERSAL::isa( $flink, 'ARRAY' )) { push( @$flink, $hash ); } elsif ( ref $flink && UNIVERSAL::isa( $flink, 'HASH' )) { $self->{link} = [ $flink, $hash ]; } } $self->guid( $href ) unless defined $self->guid(); } elsif ( ref $html ) { return $html->{'-href'}; } return; } sub pubDate { my $self = shift; my $date = shift; return $self->get_pubDate_w3cdtf() unless defined $date; $date = XML::FeedPP::Util::get_w3cdtf($date); $self->set_value( 'updated', $date ); } sub get_pubDate_native { my $self = shift; $self->get_value('updated') # Atom 1.0 || $self->get_value('published') # Atom 1.0 || $self->get_value('issued') # Atom 0.3 || $self->get_value('modified'); # Atom 0.3 } *get_pubDate_w3cdtf = \&get_pubDate_native; sub title { my $self = shift; my $title = shift; my $type = shift || 'text'; return $self->get_value('title') unless defined $title; $self->set_value( 'title' => $title, type => $type ); } sub category { my $self = shift; if ( scalar @_ ) { my $cate = ref $_[0] ? $_[0] : \@_; my $list = [ map {+{-term=>$_}} @$cate ]; $self->{category} = ( scalar @$list > 1 ) ? $list : shift @$list; } else { return unless exists $self->{category}; my $list = $self->{category} || []; $list = [ $list ] if ( defined $list && ! UNIVERSAL::isa( $list, 'ARRAY' )); my $term = [ map {ref $_ && exists $_->{-term} && $_->{-term} } @$list ]; # return wantarray ? @$term : shift @$term; return ( scalar @$term > 1 ) ? $term : shift @$term; } } # ---------------------------------------------------------------- package XML::FeedPP::Element; use strict; sub new { my $package = shift; my $self = {@_}; bless $self, $package; $self; } sub ref_bless { my $package = shift; my $self = shift; bless $self, $package; $self; } sub set { my $self = shift; while ( scalar @_ ) { my $key = shift @_; my $val = shift @_; my $node = $self; while ( $key =~ s#^([^/]+)/##s ) { my $child = $1; if ( ref $node->{$child} ) { # ok } elsif ( defined $node->{$child} ) { $node->{$child} = { '#text' => $node->{$child} }; } else { $node->{$child} = {}; } $node = $node->{$child}; } my ( $tagname, $attr ) = split( /\@/, $key, 2 ); if ( $tagname eq "" && defined $attr ) { $node->{ '-' . $attr } = $val; } elsif ( defined $attr ) { if ( ref $node->{$tagname} && UNIVERSAL::isa( $node->{$tagname}, 'ARRAY' )) { $node->{$tagname} = shift @{$node->{$tagname}}; } my $hkey = '-' . $attr; if ( ref $node->{$tagname} ) { $node->{$tagname}->{$hkey} = $val; } elsif ( defined $node->{$tagname} ) { $node->{$tagname} = { '#text' => $node->{$tagname}, $hkey => $val, }; } else { $node->{$tagname} = { $hkey => $val }; } } elsif ( defined $tagname ) { if ( ref $node->{$tagname} && UNIVERSAL::isa( $node->{$tagname}, 'ARRAY' )) { $node->{$tagname} = shift @{$node->{$tagname}}; } if ( ref $node->{$tagname} ) { $node->{$tagname}->{'#text'} = $val; } else { $node->{$tagname} = $val; } } } } sub get { my $self = shift; my $key = shift; my $node = $self; while ( $key =~ s#^([^/]+)/##s ) { my $child = $1; return unless ref $node; return unless exists $node->{$child}; $node = $node->{$child}; } my ( $tagname, $attr ) = split( /\@/, $key, 2 ); return unless ref $node; # return unless exists $node->{$tagname}; if ( $tagname eq "" && defined $attr ) { # @attribute return unless exists $node->{ '-' . $attr }; return $node->{ '-' . $attr }; } elsif ( defined $attr ) { # node@attribute return unless ref $node->{$tagname}; my $hkey = '-' . $attr; if ( UNIVERSAL::isa( $node->{$tagname}, 'ARRAY' )) { my $list = [ map { ref $_ && exists $_->{$hkey} ? $_->{$hkey} : undef } @{$node->{$tagname}} ]; return @$list if wantarray; return ( grep { defined $_ } @$list )[0]; } return unless exists $node->{$tagname}->{$hkey}; return $node->{$tagname}->{$hkey}; } else { # node return $node->{$tagname} unless ref $node->{$tagname}; if ( UNIVERSAL::isa( $node->{$tagname}, 'ARRAY' )) { my $list = [ map { ref $_ ? $_->{'#text'} : $_ } @{$node->{$tagname}} ]; return @$list if wantarray; return ( grep { defined $_ } @$list )[0]; } return $node->{$tagname}->{'#text'}; } } sub get_set_array { my $self = shift; my $elem = shift; my $value = shift; if ( ref $value ) { $self->{$elem} = $value; } elsif ( defined $value ) { $value = [ $value, @_ ] if scalar @_; $self->{$elem} = $value; } else { my @ret = $self->get_value($elem); return scalar @ret > 1 ? \@ret : $ret[0]; } } sub get_or_set { my $self = shift; my $elem = shift; return scalar @_ ? $self->set_value( $elem, @_ ) : $self->get_value($elem); } sub get_value { my $self = shift; my $elem = shift; return unless exists $self->{$elem}; my $value = $self->{$elem}; return $value unless ref $value; # multiple elements if ( UNIVERSAL::isa( $value, 'ARRAY' )) { if ( wantarray ) { return map { $self->_fetch_value($_) } @$value; } else { return $self->_fetch_value($value->[0]); } } return $self->_fetch_value($value); } sub _fetch_value { my $self = shift; my $value = shift; if ( UNIVERSAL::isa( $value, 'HASH' )) { # text node of an element with attributes if ( exists $value->{'#text'} ) { return $self->_fetch_value($value->{'#text'}) } } elsif ( UNIVERSAL::isa( $value, 'SCALAR' )) { # CDATA section as a scalar reference return $$value; } return $value; } sub set_value { my $self = shift; my $elem = shift; my $text = shift; my $attr = \@_; if ( UNIVERSAL::isa( $self->{$elem}, 'HASH' )) { $self->{$elem}->{'#text'} = $text; } else { $self->{$elem} = $text; } $self->set_attr( $elem, @$attr ) if scalar @$attr; undef; } sub get_attr { my $self = shift; my $elem = shift; my $key = shift; return unless exists $self->{$elem}; return unless ref $self->{$elem}; return unless exists $self->{$elem}->{ '-' . $key }; $self->{$elem}->{ '-' . $key }; } sub set_attr { my $self = shift; my $elem = shift; my $attr = \@_; if ( defined $self->{$elem} ) { my $scalar = ref $self->{$elem}; $scalar = undef if ($scalar eq 'SCALAR'); if (! $scalar) { $self->{$elem} = { '#text' => $self->{$elem} }; } } else { $self->{$elem} = {}; } while ( scalar @$attr ) { my $key = shift @$attr; my $val = shift @$attr; if ( defined $val ) { # $val = $$val if (ref $val eq 'SCALAR'); $self->{$elem}->{ '-' . $key } = $val; } else { delete $self->{$elem}->{ '-' . $key }; } } undef; } # ---------------------------------------------------------------- package XML::FeedPP::Util; use strict; my ( @DoW, @MoY, %MoY ); @DoW = qw(Sun Mon Tue Wed Thu Fri Sat); @MoY = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); @MoY{ map { uc($_) } @MoY } = ( 1 .. 12 ); my $tz_now = time(); my $tz_offset = Time::Local::timegm( localtime($tz_now) ) - Time::Local::timegm( gmtime($tz_now) ); my $tz_hour = int( $tz_offset / 3600 ); my $tz_min = int( $tz_offset / 60 ) % 60; my $rfc1123_regexp = qr{ ^(?:[A-Za-z]+,\s*)? (\d+)\s+ ([A-Za-z]+)\s+ (\d+)\s+ (\d+):(\d+)(?::(\d+)(?:\.\d*)?)?\s* ([\+\-]\d+:?\d{2} | [ECMP][DS]T )? }xi; my $w3cdtf_regexp = qr{ ^(\d+)-(\d+)-(\d+) (?:T(\d+):(\d+)(?::(\d+)(?:\.\d*)?\:?)?\s* ([\+\-]\d+:?\d{2})?|$) }x; my $tzmap = {qw( EDT -4 EST -5 CDT -5 CST -6 MDT -6 MST -7 PDT -7 PST -8 )}; sub epoch_to_w3cdtf { my $epoch = shift; return unless defined $epoch; my ( $sec, $min, $hour, $day, $mon, $year ) = gmtime($epoch+$tz_offset); $year += 1900; $mon++; my $tz = $tz_offset ? sprintf( '%+03d:%02d', $tz_hour, $tz_min ) : 'Z'; sprintf( '%04d-%02d-%02dT%02d:%02d:%02d%s', $year, $mon, $day, $hour, $min, $sec, $tz ); } sub epoch_to_rfc1123 { my $epoch = shift; return unless defined $epoch; my ( $sec, $min, $hour, $mday, $mon, $year, $wday ) = gmtime($epoch+$tz_offset); $year += 1900; my $tz = $tz_offset ? sprintf( '%+03d%02d', $tz_hour, $tz_min ) : 'GMT'; sprintf( '%s, %02d %s %04d %02d:%02d:%02d %s', $DoW[$wday], $mday, $MoY[$mon], $year, $hour, $min, $sec, $tz ); } sub rfc1123_to_w3cdtf { my $str = shift; return unless defined $str; my ( $mday, $mon, $year, $hour, $min, $sec, $tz ) = ( $str =~ $rfc1123_regexp ); return unless ( $year && $mon && $mday ); $year += 2000 if $year < 77; $year += 1900 if $year < 100; $mon = $MoY{ uc($mon) } or return; if ( defined $tz && $tz ne '' && $tz ne 'GMT' ) { my $off = &get_tz_offset($tz) / 60; $tz = sprintf( '%+03d:%02d', $off/60, $off%60 ); } else { $tz = 'Z'; } sprintf( '%04d-%02d-%02dT%02d:%02d:%02d%s', $year, $mon, $mday, $hour, $min, $sec, $tz ); } sub w3cdtf_to_rfc1123 { my $str = shift; return unless defined $str; my ( $year, $mon, $mday, $hour, $min, $sec, $tz ) = ( $str =~ $w3cdtf_regexp ); return unless ( $year > 1900 && $mon && $mday ); $hour ||= 0; $min ||= 0; $sec ||= 0; my $epoch = Time::Local::timegm( $sec, $min, $hour, $mday, $mon-1, $year-1900 ); my $wday = ( gmtime($epoch) )[6]; if ( defined $tz && $tz ne '' && $tz ne 'Z' ) { my $off = &get_tz_offset($tz) / 60; $tz = sprintf( '%+03d%02d', $off/60, $off%60 ); } else { $tz = 'GMT'; } sprintf( '%s, %02d %s %04d %02d:%02d:%02d %s', $DoW[$wday], $mday, $MoY[ $mon - 1 ], $year, $hour, $min, $sec, $tz ); } sub rfc1123_to_epoch { my $str = shift; return unless defined $str; my ( $mday, $mon, $year, $hour, $min, $sec, $tz ) = ( $str =~ $rfc1123_regexp ); return unless ( $year && $mon && $mday ); $year += 2000 if $year < 77; $year += 1900 if $year < 100; $mon = $MoY{ uc($mon) } or return; my $epoch = Time::Local::timegm( $sec, $min, $hour, $mday, $mon-1, $year-1900 ); $epoch -= &get_tz_offset( $tz ); $epoch; } sub w3cdtf_to_epoch { my $str = shift; return unless defined $str; my ( $year, $mon, $mday, $hour, $min, $sec, $tz ) = ( $str =~ $w3cdtf_regexp ); return unless ( $year > 1900 && $mon && $mday ); $hour ||= 0; $min ||= 0; $sec ||= 0; my $epoch = Time::Local::timegm( $sec, $min, $hour, $mday, $mon-1, $year-1900 ); $epoch -= &get_tz_offset( $tz ); $epoch; } sub get_tz_offset { my $tz = shift; return 0 unless defined $tz; return $tzmap->{$tz}*60*60 if exists $tzmap->{$tz}; return 0 unless( $tz =~ m/^([\+\-]?)(\d+):?(\d{2})$/ ); my( $pm, $ho, $mi ) = ( $1, $2, $3 ); my $off = $ho * 60 + $mi; $off *= ( $pm eq "-" ) ? -60 : 60; $off; } sub get_w3cdtf { my $date = shift; return unless defined $date; if ( $date =~ /^\d+$/s ) { return &epoch_to_w3cdtf($date); } elsif ( $date =~ $rfc1123_regexp ) { return &rfc1123_to_w3cdtf($date); } elsif ( $date =~ $w3cdtf_regexp ) { return $date; } undef; } sub get_rfc1123 { my $date = shift; return unless defined $date; if ( $date =~ /^\d+$/s ) { return &epoch_to_rfc1123($date); } elsif ( $date =~ $rfc1123_regexp ) { return $date; } elsif ( $date =~ $w3cdtf_regexp ) { return &w3cdtf_to_rfc1123($date); } undef; } sub get_epoch { my $date = shift; return unless defined $date; if ( $date =~ /^\d+$/s ) { return $date; } elsif ( $date =~ $rfc1123_regexp ) { return &rfc1123_to_epoch($date); } elsif ( $date =~ $w3cdtf_regexp ) { return &w3cdtf_to_epoch($date); } undef; } sub merge_hash { my $base = shift or return; my $merge = shift or return; my $map = { map { $_ => 1 } @_ }; foreach my $key ( keys %$merge ) { next if exists $map->{$key}; next if exists $base->{$key}; $base->{$key} = $merge->{$key}; } } sub param_even_odd { if ( (scalar @_) % 2 == 0 ) { # even num of args - new( key1 => val1, key2 => arg2 ); my $array = [ @_ ]; return $array; } else { # odd num of args - new( first, key1 => val1, key2 => arg2 ); return ( undef, @_ ); } } # ---------------------------------------------------------------- 1; # ---------------------------------------------------------------- ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������XML-FeedPP-0.43/META.yml����������������������������������������������������������������������������0000664�0000764�0000764�00000000637�11561510574�013703� 0����������������������������������������������������������������������������������������������������ustar �u-suke��������������������������u-suke�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������--- #YAML:1.0 name: XML-FeedPP version: 0.43 abstract: ~ license: perl author: ~ generated_by: ExtUtils::MakeMaker version 6.42 distribution_type: module requires: Test::More: 0 XML::TreePP: 0.39 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.3.html version: 1.3 �������������������������������������������������������������������������������������������������XML-FeedPP-0.43/t/����������������������������������������������������������������������������������0000755�0000764�0000764�00000000000�11561510574�012665� 5����������������������������������������������������������������������������������������������������ustar �u-suke��������������������������u-suke�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������XML-FeedPP-0.43/t/13_remove_item.t������������������������������������������������������������������0000644�0000764�0000764�00000004174�11561507340�015673� 0����������������������������������������������������������������������������������������������������ustar �u-suke��������������������������u-suke�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# ---------------------------------------------------------------- use strict; use Test::More tests => 28; BEGIN { use_ok('XML::FeedPP') }; # ---------------------------------------------------------------- my $top = "http://www.kawa.net/"; my $links = [qw( http://www.kawa.net/xp/index-e.html http://www.kawa.net/xp/index-j.html http://kawa.at.webry.info/ http://www.flickr.com/photos/u-suke/ )]; # ---------------------------------------------------------------- my $feeds = [ XML::FeedPP::RSS->new(), XML::FeedPP::RDF->new(), XML::FeedPP::Atom->new(), ]; # ---------------------------------------------------------------- foreach my $feed ( @$feeds ) { my $type = ref $feed; $feed->link( $top ); foreach my $link ( @$links ) { $feed->add_item( $link ); } my $cnt = scalar @$links; is( scalar $feed->get_item(), $cnt, "$type count $cnt" ); my $remove1 = $feed->remove_item( 1 ); is( $remove1->link(), $links->[1], "$type remove_item by num 1" ); is( scalar $feed->get_item(), --$cnt, "$type count $cnt" ); my $remove2 = $feed->remove_item( $links->[2] ); is( $remove2->link(), $links->[2], "$type remove_item by link" ); is( scalar $feed->get_item(), --$cnt, "$type count $cnt" ); my $remove3 = $feed->remove_item( -1 ); is( $remove3->link(), $links->[3], "$type remove_item by num -1" ); is( scalar $feed->get_item(), --$cnt, "$type count $cnt" ); my $rest = $feed->get_item(0); is( $rest->link(), $links->[0], "$type item rest" ); } # ---------------------------------------------------------------- my $rdf = $feeds->[1]; my $rdfli = $rdf->{'rdf:RDF'}->{channel}->{items}->{'rdf:Seq'}->{'rdf:li'}; is( ref $rdfli, "ARRAY", "RDF rdf:li ARRAY" ); is( scalar @$rdfli, 1, "RDF rdf:li count" ); is( $rdfli->[0]->{'-rdf:resource'}, $links->[0], "RDF rdf:li link" ); # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������XML-FeedPP-0.43/t/39_load_type.t��������������������������������������������������������������������0000755�0000764�0000764�00000002214�11561507340�015344� 0����������������������������������������������������������������������������������������������������ustar �u-suke��������������������������u-suke�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# ---------------------------------------------------------------- use strict; use Test::More tests => 6; BEGIN { use_ok('XML::FeedPP') }; # ---------------------------------------------------------------- { local $@; my $source = '<dummy></dummy>'; eval { XML::FeedPP->new( $source ); }; like( $@, qr/Invalid feed source/, 'Invalid XML auto' ); } { local $@; my $source = 'dummy string'; eval { XML::FeedPP->new( $source ); }; like( $@, qr/Invalid feed source/, 'Invalid string auto' ); } { local $@; my $source = '<dummy></dummy>'; eval { XML::FeedPP->new( $source, -type => 'string' ); }; like( $@, qr/Invalid feed format/, 'Invalid XML type' ); } { local $@; my $source = 'dummy string'; eval { XML::FeedPP->new( $source, -type => 'string' ); }; like( $@, qr/Loading failed/, 'Invalid string type' ); } { local $@; my $source = 'dummy filename'; eval { XML::FeedPP->new( $source, -type => 'file' ); }; # like( $@, qr/No such file or directory/, 'Invalid filename' ); ok( $@, 'Invalid filename' ); } # ---------------------------------------------------------------- ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������XML-FeedPP-0.43/t/28_atom10_write.t�����������������������������������������������������������������0000644�0000764�0000764�00000012761�11561507340�015702� 0����������������������������������������������������������������������������������������������������ustar �u-suke��������������������������u-suke�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# ---------------------------------------------------------------- use strict; use Test::More tests => 58; BEGIN { use_ok('XML::FeedPP') }; # ---------------------------------------------------------------- my $Ftitle = 'Kawa.net_XP'; my $Fdescription = 'this_is_a_test.'; my $FpubDate = '2007-08-19T05:33:00+09:00'; my $Fcopyright = 'Yusuke_Kawasaki'; my $Flink = 'http://www.kawa.net/'; my $Flanguage = 'ja'; my $Fimage = 'http://www.kawa.net/xp/images/xp-title-128x32.gif'; my $Ititle = 'XML::FeedPP'; my $Idescription = 'testing_this_module!'; my $IpubDate = '2007-08-19T05:36+09:00'; my $Icategory1 = 'Apple'; my $Icategory2 = 'Orange'; my $Icategory3 = 'Melon'; my $Iauthor = 'Kawasaki_Yusuke'; my $Iguid = 'urn:uuid:4744168A-4DCB-11DC-B682-AF437E717A71'; my $Ilink = 'http://www.kawa.net/works/perl/feedpp/feedpp-e.html'; # ---------------------------------------------------------------- { my $atom = XML::FeedPP::Atom::Atom03->new(); ok( ref $atom, 'XML::FeedPP::Atom::Atom03' ); &roundtrip( $atom ); my $xml = $atom->to_string(); like( $xml, qr{ <title[^>]*> $Ftitle }sx, 'xml feed title' ); like( $xml, qr{ ]*> $Fdescription }sx, 'xml feed tagline' ); like( $xml, qr{ \Q$FpubDate\E }sx, 'xml feed modified' ); like( $xml, qr{ $Fcopyright }sx, 'xml feed copyright' ); like( $xml, qr{ ]*href=" $Flink " }sx, 'xml feed link alternative' ); like( $xml, qr{ ]*xml:lang="$Flanguage " }sx, 'xml feed lang' ); like( $xml, qr{ ]*href=" $Fimage " }sx, 'xml feed link icon' ); my $entry = ( $xml =~ m{ (.*) }xs )[0]; like( $entry, qr{ ]*href=" $Ilink " }sx, 'xml item link alternative' ); like( $entry, qr{ ]*> $Ititle }sx, 'xml item title' ); like( $entry, qr{ ]*> $Idescription }sx, 'xml item content' ); like( $entry, qr{ \Q$IpubDate\E }sx, 'xml item modified' ); like( $entry, qr{ \s* $Iauthor }sx, 'xml item author name' ); like( $entry, qr{ $Iguid }sx, 'xml item id' ); } # ---------------------------------------------------------------- { my $atom = XML::FeedPP::Atom::Atom10->new(); ok( ref $atom, 'XML::FeedPP::Atom::Atom10' ); &roundtrip( $atom ); my $xml = $atom->to_string(); like( $xml, qr{ ]*> $Ftitle }sx, 'xml feed title' ); like( $xml, qr{ ]*> $Fdescription }sx, 'xml feed content' ); like( $xml, qr{ \Q$FpubDate\E }sx, 'xml feed updated' ); like( $xml, qr{ $Fcopyright }sx, 'xml feed rights' ); like( $xml, qr{ ]*href=" $Flink " }sx, 'xml feed link alternative' ); like( $xml, qr{ ]*xml:lang="$Flanguage " }sx, 'xml feed lang' ); like( $xml, qr{ ]*href=" $Fimage " }sx, 'xml feed link icon' ); my $entry = ( $xml =~ m{ (.*) }xs )[0]; like( $entry, qr{ ]*href=" $Ilink " }sx, 'xml item link alternative' ); like( $entry, qr{ ]*> $Ititle }sx, 'xml item title' ); like( $entry, qr{ ]*> $Idescription }sx, 'xml item content' ); like( $entry, qr{ \Q$IpubDate\E }sx, 'xml item updated' ); like( $entry, qr{ \s* $Iauthor }sx, 'xml item author name' ); like( $entry, qr{ $Iguid }sx, 'xml item id' ); my $cat = $atom->get_item(0)->category; is( $cat->[0], $Icategory1, 'category 1' ); is( $cat->[1], $Icategory2, 'category 2' ); is( $cat->[2], $Icategory3, 'category 3' ); } # ---------------------------------------------------------------- sub roundtrip { my $atom = shift; $atom->title( $Ftitle ); $atom->description( $Fdescription ); $atom->pubDate( $FpubDate ); $atom->copyright( $Fcopyright ); $atom->link( $Flink ); $atom->language( $Flanguage ); $atom->image( $Fimage ); is( $atom->title, $Ftitle, 'roundtrip feed title' ); is( $atom->description, $Fdescription, 'roundtrip feed description' ); is( $atom->pubDate, $FpubDate, 'roundtrip feed pubDate' ); is( $atom->copyright, $Fcopyright, 'roundtrip feed copyright' ); is( $atom->link, $Flink, 'roundtrip feed link' ); is( $atom->language, $Flanguage, 'roundtrip feed language' ); is( $atom->image, $Fimage, 'roundtrip feed image' ); my $item = $atom->add_item( $Ilink ); $item->title( $Ititle ); $item->description( $Idescription ); $item->pubDate( $IpubDate ); $item->category( $Icategory1, $Icategory2, $Icategory3 ); $item->author( $Iauthor ); $item->guid( $Iguid ); is( $item->link, $Ilink, 'roundtrip item link' ); is( $item->title, $Ititle, 'roundtrip item title' ); is( $item->description, $Idescription, 'roundtrip item description' ); is( $item->pubDate, $IpubDate, 'roundtrip item pubDate' ); # is( $item->category, $Icategory, 'roundtrip item category' ); is( $item->author, $Iauthor, 'roundtrip item author' ); is( $item->guid, $Iguid, 'roundtrip item guid' ); } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- XML-FeedPP-0.43/t/33_guid.t0000755000076400007640000000402511561507340014310 0ustar u-sukeu-suke# ---------------------------------------------------------------- use strict; use Test::More tests => 14; BEGIN { use_ok('XML::FeedPP') }; # ---------------------------------------------------------------- &test_main(); # ---------------------------------------------------------------- sub test_main { my $feed = XML::FeedPP::RSS->new(); my $link0 = 'http://www.example.com/'; my $link1 = 'http://www.example.com/sample1.html'; my $link2 = 'http://www.example.com/sample2.html'; my $link3 = 'http://www.example.com/sample3.html'; my $title0 = 'sample channel'; my $title1 = 'sample item 1'; my $title2 = 'sample item 2'; my $title3 = 'sample item 3'; $feed->title( $title0 ); is( $feed->title, $title0, 'feed title' ); $feed->link( $link0 ); is( $feed->link, $link0, 'feed link' ); # default when missing my $item1 = $feed->add_item( $link1 ); is( $item1->link, $link1, 'item 1 link' ); $item1->guid( $link1 ); is( $item1->guid, $link1, 'guid without arguments' ); is( $item1->{guid}->{-isPermaLink}, 'true', 'isPermaLink without arguments' ); # old behavior my $item2 = $feed->add_item( $link2 ); is( $item2->link, $link2, 'item 2 link' ); $item2->guid( $link2, 'false' ); is( $item2->guid, $link2, 'guid with an argument' ); is( $item2->{guid}->{-isPermaLink}, 'false', 'isPermaLink with an argument' ); # documented behavior my $item3 = $feed->add_item( $link3 ); is( $item3->link, $link3, 'item 3 link' ); $item3->guid( $link3, isPermaLink => 'false' ); is( $item3->guid, $link3, 'guid with an argument' ); is( $item3->{guid}->{-isPermaLink}, 'false', 'isPermaLink with arguments' ); my $out = $feed->to_string(); my $cnt = {}; while ( $out =~ m##g ) { $cnt->{$1} ||= 0; $cnt->{$1} ++; } is( $cnt->{true}, 1, 'isPermaLink true 1' ); is( $cnt->{false}, 2, 'isPermaLink false 2' ); } # ---------------------------------------------------------------- XML-FeedPP-0.43/t/36_get_multiple.t0000755000076400007640000000433111561507340016055 0ustar u-sukeu-suke# ---------------------------------------------------------------- use strict; use Test::More tests => 13; BEGIN { use_ok('XML::FeedPP') }; # ---------------------------------------------------------------- { my $rss = <<'EOT'; AAA BBB FFF0 FFF3 EOT &test_main( $rss ); } # ---------------------------------------------------------------- sub test_main { my $source = shift; my $feed = XML::FeedPP->new( $source ); ok( $feed, 'TESTING DEFAULT' ); my $item0 = $feed->get_item( 0 ); my $val0i = $item0->get( '@test:iii' ); is( $val0i, 'III', '' ); my $val0a = $item0->get( 'test:aaa' ); is( $val0a, 'AAA', ' value' ); my $item1 = $feed->get_item( 1 ); my $val1b = $item1->get( 'test:bbb' ); my $val1c = $item1->get( 'test:bbb@ccc' ); is( $val1b, 'BBB', ' value' ); is( $val1c, 'CCC', ' attr' ); my $item2 = $feed->get_item( 2 ); my $val2e = $item2->get( 'test:ddd@eee' ); is( $val2e, 'EEE', ' attr' ); my $item3 = $feed->get_item( 3 ); my @val3f = $item3->get( 'test:fff' ); is( $val3f[0], 'FFF0', ' 1st value' ); is( $val3f[3], 'FFF3', ' 4th value' ); my $val3g = $item3->get( 'test:fff@ggg' ); is( $val3g, 'GGG', ' scalar context' ); my @val3g = $item3->get( 'test:fff@ggg' ); is( $val3g[2], 'GGG', ' array context' ); my $val3h = $item3->get( 'test:fff@hhh' ); is( $val3h, 'HHH', ' scalar context' ); my @val3h = $item3->get( 'test:fff@hhh' ); is( $val3h[3], 'HHH', ' array context' ); } # ---------------------------------------------------------------- XML-FeedPP-0.43/t/08_datetime.t0000644000076400007640000001443611561507340015162 0ustar u-sukeu-suke# ---------------------------------------------------------------- use strict; use Test::More tests => 50; BEGIN { use_ok('XML::FeedPP') }; # ---------------------------------------------------------------- my $date110u = 1100000000; my $date110w = "2004-11-09T11:33:20Z"; # 1100000000 my $date110h = "Tue, 09 Nov 2004 11:33:20 GMT"; my $date111w = "2005-03-05T14:20:00+09:00"; # 1110000000 my $date111h = "Sat, 05 Mar 2005 14:20:00 +0900"; my $date112w = "2005-06-29T08:06:30-09:00"; # 1120000000 my $date112h = "Wed, 29 Jun 2005 08:06:30 -0900"; my $date113w = "2005-10-23T01:53:20Z"; # 1130000000 my $date113h = "Sun, 23 Oct 2005 01:53:20 GMT"; my $date114w = "2006-02-15T19:40:00Z"; # 1140000000 my $date114h = "Wed, 15 Feb 2006 19:40:00 GMT"; my $url = "http://www.kawa.net/"; # ---------------------------------------------------------------- my $feed1 = XML::FeedPP::RSS->new(); $feed1->pubDate( $date111h ); is( $feed1->pubDate(), $date111w, "RSS: http - w3cdtf 1" ); $feed1->pubDate( $date112h ); is( $feed1->pubDate(), $date112w, "RSS: http - w3cdtf 2" ); $feed1->pubDate( $date113w ); is( $feed1->pubDate(), $date113w, "RSS: w3cdtf - http - w3cdtf 1" ); $feed1->pubDate( $date114w ); is( $feed1->pubDate(), $date114w, "RSS: w3cdtf - http - w3cdtf 2" ); # ---------------------------------------------------------------- my $feed2 = XML::FeedPP::RDF->new(); $feed2->pubDate( $date111h ); is( $feed2->pubDate(), $date111w, "RDF: http - w3cdtf 1" ); $feed2->pubDate( $date112w ); is( $feed2->pubDate(), $date112w, "RDF: w3cdtf - w3cdtf 1" ); $feed2->pubDate( $date113h ); is( $feed2->pubDate(), $date113w, "RDF: http - w3cdtf 2" ); $feed2->pubDate( $date114w ); is( $feed2->pubDate(), $date114w, "RDF: w3cdtf - w3cdtf 2" ); # ---------------------------------------------------------------- my $feed3 = XML::FeedPP::Atom->new(); $feed3->pubDate( $date111w ); is( $feed3->pubDate(), $date111w, "Atom: w3cdtf - w3cdtf 1" ); $feed3->pubDate( $date112h ); is( $feed3->pubDate(), $date112w, "Atom: http - w3cdtf 1" ); $feed3->pubDate( $date113w ); is( $feed3->pubDate(), $date113w, "Atom: w3cdtf - w3cdtf 2" ); $feed3->pubDate( $date114h ); is( $feed3->pubDate(), $date114w, "Atom: http - w3cdtf 2" ); # ---------------------------------------------------------------- is( $feed1->get_pubDate_native(), $date114h, "RSS: channel native" ); is( $feed2->get_pubDate_native(), $date114w, "RDF: channel native" ); is( $feed3->get_pubDate_native(), $date114w, "Atom: channel native" ); is( $feed1->get_pubDate_w3cdtf(), $date114w, "RSS: channel w3cdtf" ); is( $feed2->get_pubDate_w3cdtf(), $date114w, "RDF: channel w3cdtf" ); is( $feed3->get_pubDate_w3cdtf(), $date114w, "Atom: channel w3cdtf" ); is( $feed1->get_pubDate_rfc1123(), $date114h, "RSS: channel rfc1123" ); is( $feed2->get_pubDate_rfc1123(), $date114h, "RDF: channel rfc1123" ); is( $feed3->get_pubDate_rfc1123(), $date114h, "Atom: channel rfc1123" ); # ---------------------------------------------------------------- $feed1->pubDate( $date110u ); $feed2->pubDate( $date110u ); $feed3->pubDate( $date110u ); is( $feed1->get_pubDate_epoch(), $date110u, "RSS: channel epoch" ); is( $feed2->get_pubDate_epoch(), $date110u, "RDF: channel epoch" ); is( $feed3->get_pubDate_epoch(), $date110u, "Atom: channel epoch" ); my $w3c1 = $feed1->get_pubDate_w3cdtf(); my $w3c2 = $feed2->get_pubDate_w3cdtf(); my $w3c3 = $feed3->get_pubDate_w3cdtf(); is( $w3c2, $w3c1, "RSS/RDF: epoch - w3cdtf" ); is( $w3c3, $w3c1, "RSS/Atom: epoch - w3cdtf" ); my $http1 = $feed1->get_pubDate_rfc1123(); my $http2 = $feed2->get_pubDate_rfc1123(); my $http3 = $feed3->get_pubDate_rfc1123(); is( $http2, $http1, "RSS/RDF: epoch - http" ); is( $http3, $http1, "RSS/Atom: epoch - http" ); # ---------------------------------------------------------------- my $item1 = $feed1->add_item( $url ); my $item2 = $feed2->add_item( $url ); my $item3 = $feed3->add_item( $url ); # ---------------------------------------------------------------- $item1->pubDate( $date110u ); $item2->pubDate( $date110u ); $item3->pubDate( $date110u ); is( $item1->get_pubDate_epoch(), $date110u, "RSS: item epoch" ); is( $item2->get_pubDate_epoch(), $date110u, "RDF: item epoch" ); is( $item3->get_pubDate_epoch(), $date110u, "Atom: item epoch" ); # ---------------------------------------------------------------- $item1->pubDate( $date110h ); $item2->pubDate( $date110h ); $item3->pubDate( $date110h ); is( $item1->pubDate(), $date110w, "RSS: item http - w3cdtf" ); is( $item2->pubDate(), $date110w, "RDF: item http - w3cdtf" ); is( $item3->pubDate(), $date110w, "Atom: item http - w3cdtf" ); is( $item1->get_pubDate_native(), $date110h, "RSS: item native http" ); is( $item2->get_pubDate_native(), $date110w, "RDF: item native http" ); is( $item3->get_pubDate_native(), $date110w, "Atom: item native http" ); is( $item1->get_pubDate_w3cdtf(), $date110w, "RSS: item w3cdtf" ); is( $item2->get_pubDate_w3cdtf(), $date110w, "RDF: item w3cdtf" ); is( $item3->get_pubDate_w3cdtf(), $date110w, "Atom: item w3cdtf" ); # ---------------------------------------------------------------- $item1->pubDate( $date111w ); $item2->pubDate( $date111w ); $item3->pubDate( $date111w ); is( $item1->pubDate(), $date111w, "RSS: item http - w3cdtf" ); is( $item2->pubDate(), $date111w, "RDF: item http - w3cdtf" ); is( $item3->pubDate(), $date111w, "Atom: item http - w3cdtf" ); is( $item1->get_pubDate_native(), $date111h, "RSS: item native w3cdtf" ); is( $item2->get_pubDate_native(), $date111w, "RDF: item native w3cdtf" ); is( $item3->get_pubDate_native(), $date111w, "Atom: item native w3cdtf" ); is( $item1->get_pubDate_rfc1123(), $date111h, "RSS: item rfc1123" ); is( $item2->get_pubDate_rfc1123(), $date111h, "RDF: item rfc1123" ); is( $item3->get_pubDate_rfc1123(), $date111h, "Atom: item rfc1123" ); # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- XML-FeedPP-0.43/t/23_match_item.t0000644000076400007640000000633211561507340015471 0ustar u-sukeu-suke# ---------------------------------------------------------------- use strict; use Test::More tests => 22; BEGIN { use_ok('XML::FeedPP') }; # ---------------------------------------------------------------- my $flink = 'http://www.kawa.net/'; my $ftitle = 'Kawa.net XP'; my $ilink1 = 'http://kawa.at.webry.info/'; my $ilink2 = 'http://kawanet.blogspot.com/'; my $ilink3 = 'http://picasaweb.google.com/www.kawa.net/'; my $ititle1 = 'Kawa.net Blog (ja)'; my $ititle2 = 'Kawa.net Blog (en)'; my $ititle3 = 'Kawa.net Albums'; my $iorgkey = 'foo:bar'; my $iorgv1 = 'test #1'; my $iorgv2 = 'testing #2'; my $iorgv3 = 'tested #3'; # ---------------------------------------------------------------- my $initfeed = { link => $flink, title => $ftitle, }; # ---------------------------------------------------------------- my $initem1 = { link => $ilink1, title => $ititle1, $iorgkey => $iorgv1, }; # ---------------------------------------------------------------- my $initem2 = { link => $ilink2, title => $ititle2, $iorgkey => $iorgv2, }; # ---------------------------------------------------------------- my $initem3 = { link => $ilink3, title => $ititle3, $iorgkey => $iorgv3, }; # ---------------------------------------------------------------- my $feeds = [ XML::FeedPP::RSS->new( %$initfeed ), XML::FeedPP::RDF->new( %$initfeed ), XML::FeedPP::Atom->new( %$initfeed ), ]; foreach my $feed1 ( @$feeds ) { my $type = ref $feed1; my $item1 = $feed1->add_item( %$initem1 ); my $item2 = $feed1->add_item( %$initem2 ); my $item3 = $feed1->add_item( %$initem3 ); # ---------------------------------------------------------------- my @item8 = $feed1->get_item(); is( scalar @item8, 3, "$type feed has 3 items" ); # ---------------------------------------------------------------- my @item4 = $feed1->match_item( link => qr/google.com/i ); is( scalar @item4, 1, "$type match 1 item by title" ); is( $item4[0]->link(), $ilink3, "$type match google.com by link" ); # ---------------------------------------------------------------- my @item5 = $feed1->match_item( title => qr/blog/i ); is( scalar @item5, 2, "$type match 2 items by title" ); # ---------------------------------------------------------------- my @item6 = $feed1->match_item( $iorgkey => qr/^test/i ); is( scalar @item6, 3, "$type match 3 items by $iorgkey" ); # ---------------------------------------------------------------- my @item7 = $feed1->match_item( link => $ilink2, title => qr/blog/i, $iorgkey => qr/testing/i ); is( scalar @item7, 1, "$type match 1 item by 3 args" ); is( $item7[0]->link(), $ilink2, "$type match blogspot.com by 3 args" ); # ---------------------------------------------------------------- } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- XML-FeedPP-0.43/t/03_rdf.t0000644000076400007640000001217311561507340014130 0ustar u-sukeu-suke# ---------------------------------------------------------------- use strict; use Test::More tests => 32; BEGIN { use_ok('XML::FeedPP') }; # ---------------------------------------------------------------- my $ftitle = "Title of the site"; my $fdesc = "Description of the site"; my $fdateA = "Mon, 02 Jan 2006 03:04:05 +0600"; my $fdateB = "2006-01-02T03:04:05+06:00"; my $fright = "Owner of the site"; my $flink = "http://www.kawa.net/"; my $flang = "ja"; # ---------------------------------------------------------------- my $link1 = "http://www.perl.org/"; my $link2 = "http://use.perl.org/"; my $link3 = "http://cpan.perl.org/"; my $title1 = "The Perl Directory - perl.org"; my $title2 = "use Perl: All the Perl that's Practical to Extract and Report"; my $title3 = "The Comprehensive Perl Archive Network"; # ---------------------------------------------------------------- my $idesc = "Description of the first item"; my $icate = "Category of the first item"; my $idateA = "Sun, 11 Dec 2005 10:09:08 -0700"; my $idateB = "2005-12-11T10:09:08-07:00"; my $iauthor = "Author"; my $iguid = "GUID"; # ---------------------------------------------------------------- my $feed1 = XML::FeedPP::RDF->new(); $feed1->title( $ftitle ); $feed1->description( $fdesc ); $feed1->pubDate( $fdateB ); $feed1->copyright( $fright ); $feed1->link( $flink ); $feed1->language( $flang ); # ---------------------------------------------------------------- ok( 0 == $feed1->get_item(), "0 item" ); # ---------------------------------------------------------------- my $item1 = $feed1->add_item( $link1 ); $item1->title( $title1 ); $item1->pubDate( $idateB ); ok( 1 == $feed1->get_item(), "1 item" ); # ---------------------------------------------------------------- $item1->description( $idesc ); $item1->category( $icate ); $item1->author( $iauthor, isPermaLink => "false" ); $item1->guid( $iguid ); # ---------------------------------------------------------------- my $item2 = $feed1->add_item( $link2 ); $item2->title( $title2 ); $item2->pubDate( $idateA ); ok( 2 == $feed1->get_item(), "2 items" ); # ---------------------------------------------------------------- my $item3 = $feed1->add_item( $link3 ); $item3->title( $title3 ); $item3->pubDate( $idateA ); ok( 3 == $feed1->get_item(), "3 items" ); # ---------------------------------------------------------------- my $source1 = $feed1->to_string(); my $feed2 = XML::FeedPP::RDF->new( $source1 ); ok( 3 == $feed2->get_item(), "3 items" ); # ---------------------------------------------------------------- is( $feed2->title(), $ftitle, "RDF->title()" ); is( $feed2->description(), $fdesc, "RDF->description()" ); is( $feed2->pubDate(), $fdateB, "RDF->pubDate()" ); is( $feed2->copyright(), $fright, "RDF->copyright()" ); is( $feed2->link(), $flink, "RDF->link()" ); is( $feed2->language(), $flang, "RDF->language()" ); # ---------------------------------------------------------------- my $item4 = $feed2->get_item( 0 ); # ---------------------------------------------------------------- is( $item4->link(), $link1, "Item->title()" ); is( $item4->title(), $title1, "Item->title()" ); is( $item4->pubDate(), $idateB, "Item->pubDate()" ); is( $item4->description(), $idesc, "Item->description()" ); is( $item4->category(), $icate, "Item->category()" ); is( $item4->author(), $iauthor, "Item->author()" ); is( $item4->guid(), undef, "Item->guid()" ); # ---------------------------------------------------------------- my $source2 = $feed1->to_string(); is( $source1, $source2, "turn around - rss source." ); # ---------------------------------------------------------------- like( $source2, qr/]*>\s* \Q$ftitle\E/x, "" ); like( $source2, qr/<description[^>]*>\s* \Q$fdesc\E/x, "<description>" ); like( $source2, qr/<dc:date[^>]*>\s* \Q$fdateB\E/x, "<dc:date>" ); like( $source2, qr/<dc:rights[^>]*>\s* \Q$fright\E/x, "<dc:rights>" ); like( $source2, qr/<link[^>]*>\s* \Q$flink\E/x, "<link>" ); like( $source2, qr/<dc:lang[^>]*>\s* \Q$flang\E/x, "<dc:lang>" ); # ---------------------------------------------------------------- like( $source2, qr/<link[^>]*>\s* \Q$link1\E/x, "<link>" ); like( $source2, qr/<title[^>]*>\s* \Q$title1\E/x, "<title>" ); like( $source2, qr/<dc:date[^>]*>\s* \Q$idateB\E/x, "<dc:date>" ); like( $source2, qr/<description[^>]*>\s* \Q$idesc\E/x, "<description>" ); like( $source2, qr/<dc:subject[^>]*>\s* \Q$icate\E/x, "<dc:subject>" ); like( $source2, qr/<dc:creator[^>]*>\s* \Q$iauthor\E/x, "<creator>" ); # like( $source2, qr/<guid[^>]*>\s* \Q$iguid\E/x, "<guid>" ); # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������XML-FeedPP-0.43/t/11_media.t������������������������������������������������������������������������0000755�0000764�0000764�00000012046�11561501421�014427� 0����������������������������������������������������������������������������������������������������ustar �u-suke��������������������������u-suke�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# ---------------------------------------------------------------- use strict; use Test::More tests => 37; BEGIN { use_ok('XML::FeedPP') }; # ---------------------------------------------------------------- my $ftitle = "Title of the site"; my $fdesc = "Description of the site"; my $link1 = "http://www.perl.org/"; # ---------------------------------------------------------------- my $xmlns_media = 'http://search.yahoo.com/mrss/'; my $media_content_url = "http://www.kawa.net/xp/images/xp-title-512.gif"; my $media_content_type = "image/gif"; my $media_content_width = 512; my $media_content_height = 96; my $media_title_value = "media title"; my $media_text_value = "media value"; my $media_text_type = "html"; my $media_thumbnail_url = "http://www.kawa.net/xp/images/xp-title-256.gif"; my $media_thumbnail_width = 256; my $media_thumbnail_height = 48; my $media_credit_value = "credit value"; my $media_credit_scheme = "urn:kawanet:tags"; # ---------------------------------------------------------------- my $media_hash = { 'media:content@url' => $media_content_url, 'media:content@type' => $media_content_type, 'media:content@width' => $media_content_width, 'media:content@height' => $media_content_height, 'media:title' => $media_title_value, 'media:text' => $media_text_value, 'media:text@type' => $media_text_type, 'media:thumbnail@url' => $media_thumbnail_url, 'media:thumbnail@width' => $media_thumbnail_width, 'media:thumbnail@height' => $media_thumbnail_height, 'media:credit@scheme' => $media_credit_scheme, 'media:credit' => $media_credit_value, }; # ---------------------------------------------------------------- { my $feed1 = XML::FeedPP::RSS->new(); $feed1->title( $ftitle ); $feed1->xmlns( 'xmlns:media' => $xmlns_media ); is( $feed1->xmlns('xmlns:media'), $xmlns_media, '1. xmlns:media' ); my $item1 = $feed1->add_item( $link1 ); $item1->set( %$media_hash ); foreach my $key ( sort keys %$media_hash ) { is( $item1->get($key), $media_hash->{$key}, '1. '.$key ); } my $source1 = $feed1->to_string(); my $feed2 = XML::FeedPP::RDF->new(); $feed2->merge( $source1 ); my $item2 = $feed2->get_item(0); foreach my $key ( sort keys %$media_hash ) { is( $item2->get($key), $media_hash->{$key}, '2.'.$key ); } } # ---------------------------------------------------------------- { my $feed = XML::FeedPP::RSS->new(); $feed->xmlns('xmlns:media' => 'http://search.yahoo.com/mrss/'); my $item = $feed->add_item('http://www.example.com/index.html'); $item->set('media:content@url' => 'http://www.example.com/image.jpg'); $item->set('media:content@type' => 'image/jpeg'); $item->set('media:content@width' => 640); $item->set('media:content@height' => 480); my $source3 = $feed->to_string(); my $feed3 = XML::FeedPP->new($source3); is($feed3->xmlns('xmlns:media'), $xmlns_media, '3. xmlns:media'); my $item3 = $feed3->get_item(0); is($item3->link, 'http://www.example.com/index.html', '3. link'); is($item3->get('media:content@url'), 'http://www.example.com/image.jpg', '3. media:content@url'); is($item3->get('media:content@type'), 'image/jpeg', '3. media:content@type'); is($item3->get('media:content@width'), '640', '3. media:content@width'); is($item3->get('media:content@height'), '480', '3. media:content@height'); } # ---------------------------------------------------------------- { # SEE http://video.search.yahoo.com/mrss my $source4 = <<EOT; <rss version="2.0" xmlns:media="http://search.yahoo.com/mrss/" xmlns:creativeCommons="http://backend.userland.com/creativeCommonsRssModule"> <channel> <title>My Movie Review Site http://www.foo.com I review movies. Movie Title: Is this a good movie? http://www.foo.com/item1.htm http://www.creativecommons.org/licenses/by-nc/1.0 nonadult EOT my $feed4 = XML::FeedPP->new($source4); is($feed4->xmlns('xmlns:media'), $xmlns_media, '4. xmlns:media'); my $item4 = $feed4->get_item(0); is($item4->link, 'http://www.foo.com/item1.htm', '4. link'); is($item4->get('media:content@url'), 'http://www.foo.com/trailer.mov', '4. media:content@url'); is($item4->get('media:content@fileSize'), '12216320', '4. media:content@fileSize'); is($item4->get('media:content@type'), 'video/quicktime', '4. media:content@type'); } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- XML-FeedPP-0.43/t/25_sort_timezone.t0000644000076400007640000000404511561507340016261 0ustar u-sukeu-suke# ---------------------------------------------------------------- use strict; use Test::More tests => 19; BEGIN { use_ok('XML::FeedPP') }; # ---------------------------------------------------------------- my $link1 = "http://www.kawa.net/"; my $link2 = "http://kawa.at.webry.info/"; my $link3 = "http://kawanet.blogspot.com/"; my $link4 = "http://picasaweb.google.com/www.kawa.net/"; my $link5 = "http://del.icio.us/kawa.net"; # ---------------------------------------------------------------- my $date1 = "2004-11-09T11:33:20Z"; # 1100000000; my $date2 = "2004-11-09T11:33:20+01:00"; my $date3 = "2004-11-09T11:33:20-01:30"; my $date4 = "Tue, 09 Nov 2004 11:33:20 +0130"; my $date5 = "Tue, 09 Nov 2004 11:33:20 -0100"; # ---------------------------------------------------------------- my $feed1 = XML::FeedPP::RSS->new(); my $feed2 = XML::FeedPP::RDF->new(); my $feed3 = XML::FeedPP::Atom->new(); # ---------------------------------------------------------------- foreach my $feed0 ( $feed1, $feed2, $feed3 ) { my $mode = ref $feed0; $feed0->add_item( link => $link1, pubDate => $date1 ); $feed0->add_item( link => $link2, pubDate => $date2 ); $feed0->add_item( link => $link3, pubDate => $date3 ); $feed0->add_item( link => $link4, pubDate => $date4 ); $feed0->add_item( link => $link5, pubDate => $date5 ); $feed0->sort_item(); is( scalar $feed0->get_item(), 5, "$mode count 5" ); is( $feed0->get_item(0)->get_pubDate_w3cdtf(), $date3, "$mode sort 0" ); is( $feed0->get_item(1)->get_pubDate_rfc1123(), $date5, "$mode sort 1" ); is( $feed0->get_item(2)->get_pubDate_w3cdtf(), $date1, "$mode sort 2" ); is( $feed0->get_item(3)->get_pubDate_w3cdtf(), $date2, "$mode sort 3" ); is( $feed0->get_item(4)->get_pubDate_rfc1123(), $date4, "$mode sort 4" ); } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- XML-FeedPP-0.43/t/22_init_elements.t0000644000076400007640000001211311561507340016207 0ustar u-sukeu-suke# ---------------------------------------------------------------- use strict; use Test::More tests => 74; BEGIN { use_ok('XML::FeedPP') }; # ---------------------------------------------------------------- my $ftitle = 'Kawa.net XP'; my $fdesc = 'Description'; my $fdateA = 'Mon, 02 Jan 2006 03:04:05 +0600'; my $fdateB = '2006-01-02T03:04:05+06:00'; my $fright = 'Owner'; my $flink = 'http://www.kawa.net/'; my $flang = 'ja'; my $forgkey = 'hoge:pomu'; my $forgval = 'Original Namespace: hoge'; # ---------------------------------------------------------------- my $ilink1 = 'http://kawa.at.webry.info/'; my $ilink2 = 'http://kawanet.blogspot.com/'; my $ilink3 = 'http://picasaweb.google.com/www.kawa.net/'; my $ititle1 = 'Kawa.net Blog (ja)'; my $ititle2 = 'Kawa.net Blog (en)'; my $ititle3 = 'Kawa.net Albums'; my $idateA = 'Sun, 11 Dec 2005 10:09:08 -0700'; my $idateB = '2005-12-11T10:09:08-07:00'; my $idesc = 'Description'; my $icate = 'Category'; my $iauthor = 'Author'; my $iguid = 'GUID'; my $iorgkey = 'foo:bar'; my $iorgval = 'Original Namespace: foo'; # ---------------------------------------------------------------- my $initfeed = { title => $ftitle, description => $fdesc, pubDate => $fdateA, copyright => $fright, link => $flink, language => $flang, $forgkey => $forgval, }; # ---------------------------------------------------------------- my $initem1 = { link => $ilink1, title => $ititle1, pubDate => $idateA, description => $idesc, category => $icate, author => $iauthor, guid => $iguid, $iorgkey => $iorgval, }; # ---------------------------------------------------------------- my $initem2 = { link => $ilink2, title => $ititle2, pubDate => $idateB, }; # ---------------------------------------------------------------- my $initem3 = { link => $ilink3, title => $ititle3, pubDate => $idateA, }; # ---------------------------------------------------------------- my $feeds = [ XML::FeedPP::RSS->new( %$initfeed ), XML::FeedPP::RDF->new( %$initfeed ), XML::FeedPP::Atom->new( %$initfeed ), ]; # ---------------------------------------------------------------- foreach my $feed1 ( @$feeds ) { my $type = ref $feed1; ok( 0 == $feed1->get_item(), "$type Feed has no item" ); my $item1 = $feed1->add_item( %$initem1 ); ok( 1 == $feed1->get_item(), "$type Feed has one item" ); my $item2 = $feed1->add_item( %$initem2 ); ok( 2 == $feed1->get_item(), "$type Feed has two items" ); my $item3 = $feed1->add_item( %$initem3 ); ok( 3 == $feed1->get_item(), "$type Feed has three items" ); # ---------------------------------------------------------------- is( $feed1->title(), $ftitle, "$type Feed title()" ); is( $feed1->description(), $fdesc, "$type Feed description()" ); is( $feed1->pubDate(), $fdateB, "$type Feed pubDate()" ); is( $feed1->copyright(), $fright, "$type Feed copyright()" ); is( $feed1->link(), $flink, "$type Feed link()" ); is( $feed1->language(), $flang, "$type Feed language()" ); is( $feed1->get($forgkey), $forgval, "$type Feed set/get()" ); # ---------------------------------------------------------------- is( $item1->link(), $ilink1, "$type Item1 link()" ); is( $item1->title(), $ititle1, "$type Item1 title()" ); is( $item1->get_pubDate_w3cdtf(), $idateB, "$type Item1 pubDate()" ); is( $item1->description(), $idesc, "$type Item1 description()" ); is( $item1->author(), $iauthor, "$type Item1 author()" ); is( $item1->get($iorgkey), $iorgval, "$type Item1 set/get()" ); if ( $type ne 'XML::FeedPP::Atom' ) { is( $item1->category(), $icate, "$type Item1 category()" ); } if ( $type ne 'XML::FeedPP::RDF' ) { is( $item1->guid(), $iguid , "$type Item1 guid()" ); } # ---------------------------------------------------------------- is( $item2->link(), $ilink2, "$type Item2 link()" ); is( $item2->title(), $ititle2, "$type Item2 title()" ); is( $item2->get_pubDate_rfc1123(), $idateA, "$type Item2 pubDate()" ); # ---------------------------------------------------------------- is( $item3->link(), $ilink3, "$type Item3 link()" ); is( $item3->title(), $ititle3, "$type Item3 title()" ); is( $item3->get_pubDate_rfc1123(), $idateA, "$type Item3 pubDate()" ); } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- XML-FeedPP-0.43/t/27_atom03_parse.t0000644000076400007640000000712411561507340015660 0ustar u-sukeu-suke# ---------------------------------------------------------------- use strict; use Test::More tests => 22; BEGIN { use_ok('XML::FeedPP') }; # ---------------------------------------------------------------- # Sample Atom 0.3 sources from # http://www.mnot.net/drafts/draft-nottingham-atom-format-02.html # http://www.kanzaki.com/memo/2004/01/29-1 # ---------------------------------------------------------------- { my $sample = <<'EOT'; dive into mark 2003-12-13T18:30:02Z Mark Pilgrim Atom 0.3 snapshot tag:diveintomark.org,2003:3.2397 2003-12-13T08:29:29-04:00 2003-12-13T18:30:02Z EOT my $feed = XML::FeedPP->new( $sample ); ok( $feed->isa( 'XML::FeedPP::Atom::Atom03' ), 'XML::FeedPP::Atom::Atom03' ); is( $feed->title, 'dive into mark', 'feed title' ); is( $feed->link, 'http://diveintomark.org/', 'feed link' ); is( $feed->pubDate, '2003-12-13T18:30:02Z', 'feed pubDate' ); my @entry = $feed->get_item; is( scalar(@entry), 1, 'feed get_item' ); my $item = shift @entry; is( $item->title, 'Atom 0.3 snapshot', 'item title' ); is( $item->link, 'http://diveintomark.org/2003/12/13/atom03', 'item link' ); is( $item->guid, 'tag:diveintomark.org,2003:3.2397', 'item guid' ); is( $item->pubDate, '2003-12-13T18:30:02Z', 'item pubDate' ); } # ---------------------------------------------------------------- { my $sample = <<'EOT'; The Web KANZAKI - Japan, music and computer Talking about Contrabass and Semantic Web 2004-01-28 Contrabass Stories tag:kanzaki.com/bass/ Masahide Kanzaki 1995-12-15 2004-01-28T10:00:00Z Some talks on Contrabas and its music EOT my $feed = XML::FeedPP->new( $sample ); ok( $feed->isa( 'XML::FeedPP::Atom::Atom03' ), 'XML::FeedPP::Atom::Atom03' ); is( $feed->title, 'The Web KANZAKI - Japan, music and computer', 'feed title' ); is( $feed->description, 'Talking about Contrabass and Semantic Web', 'feed description' ); is( $feed->link, 'http://www.kanzaki.com', 'feed link' ); is( $feed->pubDate, '2004-01-28', 'feed pubDate' ); my @entry = $feed->get_item; is( scalar(@entry), 1, 'feed get_item' ); my $item = shift @entry; is( $item->title, 'Contrabass Stories', 'item title' ); is( $item->link, 'http://www.kanzaki.com/bass/', 'item link' ); is( $item->guid, 'tag:kanzaki.com/bass/', 'item guid' ); is( $item->author, 'Masahide Kanzaki', 'item author' ); is( $item->pubDate, '2004-01-28T10:00:00Z', 'item pubDate' ); is( $item->description, 'Some talks on Contrabas and its music', 'item description' ); } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- XML-FeedPP-0.43/t/31_two_digit_date.t0000755000076400007640000000457111561507340016352 0ustar u-sukeu-suke# ---------------------------------------------------------------- use strict; use Test::More tests => 21; BEGIN { use_ok('XML::FeedPP') }; # ---------------------------------------------------------------- =rfc733 date = 1*2DIGIT ["-"] month ; day month year ["-"] (2DIGIT /4DIGIT) ; e.g. 20 Aug [19]77 see also: http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=503260 =cut # ---------------------------------------------------------------- { my $rfc2822_2dy = { '300032400' => 'Thu, 05 Jul 79 14:20:00 GMT', '500032400' => 'Tue, 05 Nov 85 09:53:20 GMT', '700032400' => 'Sun, 08 Mar 92 05:26:40 GMT', '900032400' => 'Fri, 10 Jul 98 01:00:00 GMT', '1100032400' => 'Tue, 09 Nov 04 20:33:20 GMT', '1300032400' => 'Sun, 13 Mar 11 16:06:40 GMT', '1500032400' => 'Fri, 14 Jul 17 11:40:00 GMT', '1700032400' => 'Wed, 15 Nov 23 07:13:20 GMT', '1900032400' => 'Mon, 18 Mar 30 02:46:40 GMT', '2100032400' => 'Fri, 18 Jul 36 22:20:00 GMT', }; my $w3cdtf = { '300032400' => '1979-07-05T14:20:00Z', '500032400' => '1985-11-05T09:53:20Z', '700032400' => '1992-03-08T05:26:40Z', '900032400' => '1998-07-10T01:00:00Z', '1100032400' => '2004-11-09T20:33:20Z', '1300032400' => '2011-03-13T16:06:40Z', '1500032400' => '2017-07-14T11:40:00Z', '1700032400' => '2023-11-15T07:13:20Z', '1900032400' => '2030-03-18T02:46:40Z', '2100032400' => '2036-07-18T22:20:00Z', }; foreach my $key ( sort {$a<=>$b} keys %$rfc2822_2dy ) { my $try1 = $rfc2822_2dy->{$key}; my $chk1 = $w3cdtf->{$key}; my $out1 = XML::FeedPP::Util::rfc1123_to_w3cdtf( $try1 ); $out1 =~ s/[\+\-]00:00$/Z/; my $name = ( $try1 =~ /, (.*) \d+:/ )[0]; is( $out1, $chk1, 'rfc1123/w3cdtf '.$try1 ); } foreach my $key ( sort {$a<=>$b} keys %$rfc2822_2dy ) { my $try1 = $rfc2822_2dy->{$key}; my $out1 = XML::FeedPP::Util::rfc1123_to_epoch( $try1 ); my $name = ( $try1 =~ /, (.*) \d+:/ )[0]; is( $out1, $key, 'rfc1123/epoch '.$try1 ); } } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- XML-FeedPP-0.43/t/14_clear_item.t0000644000076400007640000000376611561507340015473 0ustar u-sukeu-suke# ---------------------------------------------------------------- use strict; use Test::More tests => 28; BEGIN { use_ok('XML::FeedPP') }; # ---------------------------------------------------------------- my $link0 = "http://www.kawa.net/"; my $title0 = "Site 0"; my $link1 = "http://www.kawa.net/xp/index-e.html"; my $title1 = "Entry 1"; my $link2 = "http://www.flickr.com/photos/u-suke/"; my $title2 = "Entry 2"; my $link3 = "http://kawa.at.webry.info/"; my $title3 = "Entry 3"; # ---------------------------------------------------------------- my $feeds = [ XML::FeedPP::RSS->new(), XML::FeedPP::RDF->new(), XML::FeedPP::Atom->new(), ]; # ---------------------------------------------------------------- foreach my $feed ( @$feeds ) { my $type = ref $feed; $feed->link( $link0 ); $feed->title( $title0 ); is( scalar $feed->get_item(), 0, "$type no item at first" ); my $item1 = $feed->add_item( $link1 ); $item1->title( $title1 ); my $item2 = $feed->add_item( $link2 ); $item2->title( $title2 ); my $item3 = $feed->add_item( $link3 ); $item3->title( $title3 ); is( scalar $feed->get_item(), 3, "$type 3 items" ); my $srcA = $feed->to_string(); ok( $srcA =~ m/clear_item(); is( scalar $feed->get_item(), 0, "$type no item after clear" ); my $srcB = $feed->to_string(); ok( $srcB !~ m/ 4; BEGIN { use_ok('XML::FeedPP') }; # ---------------------------------------------------------------- SKIP: { my $rss = XML::FeedPP::RSS->new(); like( $rss->to_string( "UTF-8" ), qr/<\?xml[^>]+encoding="UTF-8"/i, "RSS w/UTF-8" ); eval { require Encode; }; eval { require Jcode; } if ! defined $Encode::VERSION; if ( ! defined $Encode::VERSION && ! defined $Jcode::VERSION ) { skip( "Encode.pm or Jcode.pm is required: Shift_JIS", 2 ); } my $atom = XML::FeedPP::Atom->new(); like( $atom->to_string( "Shift_JIS" ), qr/<\?xml[^>]+encoding="Shift_JIS/i, "Atom w/Shift_JIS" ); if ( ! defined $Encode::VERSION ) { skip( "Encode.pm is required: ISO-8859-1", 1 ); } my $rdf = XML::FeedPP::RDF->new(); like( $rdf->to_string( "ISO-8859-1" ), qr/<\?xml[^>]+encoding="ISO-8859-1"/i, "RDF w/ISO-8859-1" ); } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- XML-FeedPP-0.43/t/35_no_xml_decl.t0000755000076400007640000000465511561507340015656 0ustar u-sukeu-suke# ---------------------------------------------------------------- use strict; use Test::More tests => 49; BEGIN { use_ok('XML::FeedPP') }; # ---------------------------------------------------------------- { my $rss = <<'EOT'; kawa.net http://www.kawa.net/ EOT my $rdf = <<'EOT'; kawa.net http://www.kawa.net/ EOT my $atom03 = <<'EOT'; kawa.net EOT my $atom10 = <<'EOT'; kawa.net EOT my $bom = "\xEF\xBB\xBF"; my $xml = ''; # without xml decl &test_main( 'NoDecl RSS 2.0', $rss ); &test_main( 'NoDecl RSS 1.0', $rdf ); &test_main( 'NoDecl Atom 0.3', $atom03 ); &test_main( 'NoDecl Atom 1.0', $atom10 ); # with xml decl &test_main( 'XMLDecl RSS 2.0', $xml.$rss ); &test_main( 'XMLDecl RSS 1.0', $xml.$rdf ); &test_main( 'XMLDecl Atom 0.3', $xml.$atom03 ); &test_main( 'XMLDecl Atom 1.0', $xml.$atom10 ); # with bom but no xml decl &test_main( 'BOM RSS 2.0', $bom.$rss ); &test_main( 'BOM RSS 1.0', $bom.$rdf ); &test_main( 'BOM Atom 0.3', $bom.$atom03 ); &test_main( 'BOM Atom 1.0', $bom.$atom10 ); # with bom and xml decl &test_main( 'BOM XMLDecl RSS 2.0', $bom.$xml.$rss ); &test_main( 'BOM XMLDecl RSS 1.0', $bom.$xml.$rdf ); &test_main( 'BOM XMLDecl Atom 0.3', $bom.$xml.$atom03 ); &test_main( 'BOM XMLDecl Atom 1.0', $bom.$xml.$atom10 ); } # ---------------------------------------------------------------- sub test_main { my $title = shift; my $source = shift; my $feed = XML::FeedPP->new($source); ok( $feed, 'load: '.$title ); is( +$feed->title, 'kawa.net', 'title: '.$title ); is( +$feed->link, 'http://www.kawa.net/', 'link: '.$title ); } # ---------------------------------------------------------------- XML-FeedPP-0.43/t/34_category_type.t0000755000076400007640000001247611561507340016250 0ustar u-sukeu-suke# ---------------------------------------------------------------- use strict; use Test::More tests => 113; BEGIN { use_ok('XML::FeedPP') }; # ---------------------------------------------------------------- { my $rss = <<'EOT'; http://www.example.com/1.html cate_a http://www.example.com/2.html cate_b cate_c http://www.example.com/3.html cate_d http://www.example.com/4.html cate_e cate_f http://www.example.com/5.html cate_g cate_h cate_i cate_j EOT &test_default( $rss ); my $rdf = &test_as_rdf( $rss ); &test_as_rss( $rdf ); my $atom10 = &test_as_atom10( $rss ); &test_as_rss( $atom10 ); } # ---------------------------------------------------------------- sub test_as_atom10 { my $source = shift; my $feed = XML::FeedPP::Atom::Atom10->new(); ok( $feed, 'TESTING AS Atom10' ); $feed->merge( $source ); my $xml = $feed->to_string(); &test_fetch( $feed ); &test_update( $feed ); $xml; } # ---------------------------------------------------------------- sub test_as_rdf { my $source = shift; my $feed = XML::FeedPP::RDF->new(); ok( $feed, 'TESTING AS RDF' ); $feed->merge( $source ); my $xml = $feed->to_string(); &test_fetch( $feed ); &test_update( $feed ); $xml; } # ---------------------------------------------------------------- sub test_as_rss { my $source = shift; my $feed = XML::FeedPP::RSS->new(); ok( $feed, 'TESTING AS RSS' ); $feed->merge( $source ); &test_fetch( $feed ); &test_update( $feed ); } # ---------------------------------------------------------------- sub test_default { my $source = shift; my $feed = XML::FeedPP->new( $source ); ok( $feed, 'TESTING DEFAULT' ); &test_fetch( $feed ); &test_attribute( $feed ); } # ---------------------------------------------------------------- sub test_update { my $feed = shift; my $cnt1 = 0; foreach my $item ( $feed->get_item() ) { $item->category( 'cate_'.$cnt1 ); $cnt1 ++; } my $cnt2 = 0; foreach my $item ( $feed->get_item() ) { my $cate = $item->category(); is( $cate, 'cate_'.$cnt2, 'update category '.$cnt2 ); $cnt2 ++; } } # ---------------------------------------------------------------- sub test_attribute { my $feed = shift; my $item0 = $feed->get_item( 0 ); $item0->set( 'category@type', 'XXX' ); my $type0 = $item0->get( 'category@type' ); is( $type0, 'XXX', '0: update type' ); my $item1 = $feed->get_item( 1 ); $item1->set( 'category@domain', 'YYY' ); my $doma1 = $item1->get( 'category@domain' ); is( $doma1, 'YYY', '1: update domain' ); my $item2 = $feed->get_item( 2 ); my $type2 = $item2->get( 'category@type' ); is( $type2, 'd', '2: with attribute / type' ); my $item3 = $feed->get_item( 3 ); my $type3 = $item3->get( 'category@type' ); my $doma3 = $item3->get( 'category@domain' ); is( $type3, 'e', '3: multiple with attribute / type' ); is( $doma3, 'f', '3: multiple with attribute / domain' ); my $item4 = $feed->get_item( 4 ); my @type4 = $item4->get( 'category@type' ); is( $type4[0], 'g', '4: mixed / type g' ); my @doma4 = $item4->get( 'category@domain' ); is( $doma4[2], 'i', '4: mixed / domain i' ); } # ---------------------------------------------------------------- sub test_fetch { my $feed = shift; my $item0 = $feed->get_item( 0 ); my $cate0 = $item0->category; is( $cate0, 'cate_a', '0: normal / val a' ); my $item1 = $feed->get_item( 1 ); my $cate1 = $item1->category; ok( ref $cate1, '1: multiple / ref' ); is( (scalar @$cate1), 2, '1: multiple / num' ); is( $cate1->[0], 'cate_b', '1: multiple / val b' ); is( $cate1->[1], 'cate_c', '1: multiple / val c' ); my $item2 = $feed->get_item( 2 ); my $cate2 = $item2->category; is( $cate2, 'cate_d', '2: with type / val d' ); my $item3 = $feed->get_item( 3 ); my $cate3 = $item3->category; ok( ref $cate3, '3: multiple with attribute / ref' ); is( (scalar @$cate3), 2, '3: multiple with attribute / num' ); is( $cate3->[0], 'cate_e', '3: multiple with attribute / val e' ); is( $cate3->[1], 'cate_f', '3: multiple with attribute / val f' ); my $item4 = $feed->get_item( 4 ); my $cate4 = $item4->category; ok( ref $cate4, '4: mixed / ref' ); is( (scalar @$cate4), 4, '4: mixed / num' ); is( $cate4->[0], 'cate_g', '4: mixed / val g' ); is( $cate4->[1], 'cate_h', '4: mixed / val h' ); is( $cate4->[2], 'cate_i', '4: mixed / val i' ); is( $cate4->[3], 'cate_j', '4: mixed / val j' ); } # ---------------------------------------------------------------- XML-FeedPP-0.43/t/41_utf8_flag.t0000755000076400007640000000461111561507340015237 0ustar u-sukeu-suke# ---------------------------------------------------------------- use strict; use Test::More; # ---------------------------------------------------------------- { local $@; eval { require 5.008001; }; plan skip_all => 'Perl 5.8.1 is required.' if $@; } { local $@; eval { require XML::TreePP; }; plan skip_all => 'XML::TreePP is not loaded.' if $@; } { my $ver = ( $XML::TreePP::VERSION =~ /^(\d+\.\d+)/ )[0]; my $chk = ( $ver >= 0.37 ); plan skip_all => "XML::TreePP $XML::TreePP::VERSION < 0.37" unless $chk; plan tests => 20; ok( $chk, 'XML::TreePP '.$ver ); use_ok('XML::FeedPP'); &test_main(); } # ---------------------------------------------------------------- sub test_main { my $rss = <<'EOT'; ©© ëë んん 漢漢 EOT my $feedA = XML::FeedPP->new( $rss, xml_deref => 1, utf8_flag => 0 ); my @itemA = $feedA->get_item; is( (scalar @itemA), 4, 'item count' ); ok( ! utf8::is_utf8($itemA[0]->title), "is_octets: c" ); ok( ! utf8::is_utf8($itemA[1]->title), "is_octets: e" ); ok( ! utf8::is_utf8($itemA[2]->title), "is_octets: n" ); ok( ! utf8::is_utf8($itemA[3]->title), "is_octets: k" ); is( $itemA[0]->title, "\xC2\xA9" x 2, "string: c" ); is( $itemA[1]->title, "\xC3\xAB" x 2, "string: e" ); is( $itemA[2]->title, "\xE3\x82\x93" x 2, "string: n" ); is( $itemA[3]->title, "\xE6\xBC\xA2" x 2, "string: k" ); my $feedB = XML::FeedPP->new( $rss, xml_deref => 1, utf8_flag => 1 ); my @itemB = $feedB->get_item; is( (scalar @itemB), 4, 'item count' ); ok( utf8::is_utf8($itemB[0]->title), "is_utf8: c" ); ok( utf8::is_utf8($itemB[1]->title), "is_utf8: e" ); ok( utf8::is_utf8($itemB[2]->title), "is_utf8: n" ); ok( utf8::is_utf8($itemB[3]->title), "is_utf8: k" ); is( $itemB[0]->title, chr(0x00A9) x 2, "string: c" ); is( $itemB[1]->title, chr(0x00EB) x 2, "string: e" ); is( $itemB[2]->title, chr(0x3093) x 2, "string: n" ); is( $itemB[3]->title, chr(0x6F22) x 2, "string: k" ); } # ---------------------------------------------------------------- XML-FeedPP-0.43/t/18_image_atom.t0000644000076400007640000000501411561507340015461 0ustar u-sukeu-suke# ---------------------------------------------------------------- use strict; use Test::More tests => 12; BEGIN { use_ok('XML::FeedPP') }; # ---------------------------------------------------------------- my $f_title = "Title of the site"; my $f_link = "http://www.kawa.net/"; my $f_image = "http://www.kawa.net/xp/images/mixi-3.jpg"; # ---------------------------------------------------------------- my $i_link = "http://www.perl.org/"; my $i_title = "The Perl Directory - perl.org"; # ---------------------------------------------------------------- my $feed1 = XML::FeedPP::Atom->new(); $feed1->title( $f_title ); $feed1->link( $f_link ); $feed1->image( $f_image ); my $item1 = $feed1->add_item( $i_link ); $item1->title( $i_title ); # ---------------------------------------------------------------- is( scalar $feed1->link(), $f_link, "Atom link 1" ); is( scalar $feed1->image(), $f_image, "Atom image 1" ); $feed1->image( $f_image ); $feed1->link( $f_link ); is( scalar $feed1->link(), $f_link, "Atom link 2" ); is( scalar $feed1->image(), $f_image, "Atom image 2" ); # ---------------------------------------------------------------- # Atom -> RDF -> Atom # ---------------------------------------------------------------- my $feed2 = XML::FeedPP::RDF->new(); $feed2->merge( $feed1->to_string() ); is( scalar $feed2->image(), $f_image, "RDF image" ); # ---------------------------------------------------------------- my $feed3 = XML::FeedPP::Atom->new(); $feed3->merge( $feed2->to_string() ); is( scalar $feed1->link(), $f_link, "Atom link 3" ); is( scalar $feed3->image(), $f_image, "Atom image 3" ); # ---------------------------------------------------------------- # Atom -> RSS -> Atom # ---------------------------------------------------------------- my $feed4 = XML::FeedPP::RSS->new(); $feed4->merge( $feed1->to_string() ); is( scalar $feed4->image(), $f_image, "RSS image" ); # ---------------------------------------------------------------- my $feed5 = XML::FeedPP::Atom->new(); $feed5->merge( $feed4->to_string() ); is( scalar $feed1->link(), $f_link, "Atom link 4" ); is( scalar $feed5->image(), $f_image, "Atom image 4" ); # ---------------------------------------------------------------- is( $feed3->to_string(), $feed5->to_string(), "Atom source" ); # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- XML-FeedPP-0.43/t/10_image.t0000644000076400007640000000722511561507340014437 0ustar u-sukeu-suke# ---------------------------------------------------------------- use strict; use Test::More tests => 17; BEGIN { use_ok('XML::FeedPP') }; # ---------------------------------------------------------------- my $ftitle = "Title of the site"; my $fdesc = "Description of the site"; my $fdateA = "Mon, 02 Jan 2006 03:04:05 +0600"; my $fdateB = "2006-01-02T03:04:05+06:00"; my $fright = "Owner of the site"; my $flink = "http://www.kawa.net/"; my $flang = "ja"; my $link1 = "http://www.perl.org/"; my $title1 = "The Perl Directory - perl.org"; # ---------------------------------------------------------------- my $image_url = "http://www.kawa.net/xp/images/mixi-3.jpg"; my $image_title = "Yusuke Kawasaki"; my $image_link = "http://www.kawa.net/"; my $image_desc = "Hello from Japan!"; my $image_width = 640; my $image_height = 480; # ---------------------------------------------------------------- my $feed1 = XML::FeedPP::RSS->new(); $feed1->title( $ftitle ); $feed1->description( $fdesc ); $feed1->pubDate( $fdateA ); $feed1->copyright( $fright ); $feed1->link( $flink ); $feed1->language( $flang ); my $item1 = $feed1->add_item( $link1 ); $item1->title( $title1 ); $feed1->image( $image_url, $image_title, $image_link ); my $source1 = $feed1->to_string(); # ---------------------------------------------------------------- my @image1 = $feed1->image(); is( $image1[0], $image_url , "image_url" ); is( $image1[1], $image_title , "image_title" ); is( $image1[2], $image_link , "image_link" ); # ---------------------------------------------------------------- # RSS -> RDF # ---------------------------------------------------------------- my $feed2 = XML::FeedPP::RDF->new(); $feed2->merge( $source1 ); my $source2 = $feed2->to_string(); # ---------------------------------------------------------------- # RDF -> RSS # ---------------------------------------------------------------- my $feed3 = XML::FeedPP::RSS->new(); $feed3->merge( $source2 ); my $source3 = $feed3->to_string(); is( $source1, $source3, "turn round" ); # ---------------------------------------------------------------- $feed3->image( $image_url, $image_title, $image_link, $image_desc, $image_width, $image_height ); my @image3 = $feed3->image(); is( $image3[0], $image_url , "image_url" ); is( $image3[1], $image_title , "image_title" ); is( $image3[2], $image_link , "image_link" ); is( $image3[3], $image_desc , "image_desc" ); is( $image3[4], $image_width , "image_width" ); is( $image3[5], $image_height, "image_height" ); # ---------------------------------------------------------------- my $source4 = $feed3->to_string(); like( $source4, qr{ ]*>.*]*>\s*\Q$image_url\E\s*.* }xs, "" ); like( $source4, qr{ ]*>.*]*>\s*\Q$image_title\E\s*.* }xs, "" ); like( $source4, qr{ <image[^>]*>.*<link[^>]*>\s*\Q$image_link\E\s*</link>.*</image> }xs, "<image><link>" ); like( $source4, qr{ <image[^>]*>.*<description[^>]*>\s*\Q$image_desc\E\s*</description>.*</image> }xs, "<image><description>" ); like( $source4, qr{ <image[^>]*>.*<width[^>]*>\s*\Q$image_width\E\s*</width>.*</image> }xs, "<image><width>" ); like( $source4, qr{ <image[^>]*>.*<height[^>]*>\s*\Q$image_height\E\s*</height>.*</image> }xs, "<image><height>" ); # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������XML-FeedPP-0.43/t/44_cdata.t������������������������������������������������������������������������0000644�0000764�0000764�00000004445�11561507340�014441� 0����������������������������������������������������������������������������������������������������ustar �u-suke��������������������������u-suke�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# ---------------------------------------------------------------- use strict; use Test::More tests => 57; BEGIN { use_ok('XML::FeedPP') }; # ---------------------------------------------------------------- my $flink = "http://www.kawa.net/"; my $ilink = "http://kawanet.blogspot.com/"; my $ftitle = "hoge"; my $ititle = "pomu"; my $fdesc = "foo"; my $idesc = "bar"; # ---------------------------------------------------------------- my $feeds = [ XML::FeedPP::RDF->new(), XML::FeedPP::RSS->new(), XML::FeedPP::Atom::Atom03->new(), XML::FeedPP::Atom::Atom10->new(), ]; # ---------------------------------------------------------------- foreach my $feed1 ( @$feeds ) { my $type = ref $feed1; $feed1->link($flink); $feed1->title(\$ftitle); $feed1->description(\$fdesc); my $item1 = $feed1->add_item($ilink); $item1->link($ilink); $item1->title(\$ititle); $item1->description(\$idesc); my $source = $feed1->to_string(); my $feed2 = XML::FeedPP ->new($source); my $item2 = $feed2->get_item(0); is( $feed1->link(), $flink, "$type feed link"); is( $feed1->title(), $ftitle, "$type feed title"); is( $feed1->description(), $fdesc, "$type feed description"); like( $source, qr/<!\[CDATA\[\Q$ftitle\E\]\]>/s, "$type feed title source" ); like( $source, qr/<!\[CDATA\[\Q$fdesc\E\]\]>/s, "$type feed description source" ); is( $feed2->title(), $ftitle, "$type feed title back"); is( $feed2->description(), $fdesc, "$type feed description back"); is( $item1->link(), $ilink, "$type item link"); is( $item1->title(), $ititle, "$type item title"); is( $item1->description(), $idesc, "$type item description"); like( $source, qr/<!\[CDATA\[\Q$ititle\E\]\]>/s, "$type item title source" ); like( $source, qr/<!\[CDATA\[\Q$idesc\E\]\]>/s, "$type item description source" ); is( $item2->title(), $ititle, "$type item title back"); is( $item2->description(), $idesc, "$type item description back"); } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������XML-FeedPP-0.43/t/30_invalid_rdfseq.t���������������������������������������������������������������0000755�0000764�0000764�00000012003�11561507340�016342� 0����������������������������������������������������������������������������������������������������ustar �u-suke��������������������������u-suke�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# ---------------------------------------------------------------- use strict; use Test::More tests => 13; BEGIN { use_ok('XML::FeedPP') }; # ---------------------------------------------------------------- my $invalid = <<'EOT'; <?xml version="1.0" encoding="UTF-8" ?> <rdf:RDF xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#" xmlns:dc="http://purl.org/dc/elements/1.1/" xmlns:sy="http://purl.org/rss/1.0/modules/syndication/" xmlns:cc="http://web.resource.org/cc/" xmlns="http://purl.org/rss/1.0/" xml:lang="ja"> <channel rdf:about="http://www.cnc.co.jp/news/xml/rss.xml"> <dc:language>ja</dc:language> <dc:date>2008-03-24T16:54:33 +0900</dc:date> <items> <rdf:Seq> <rdf:li rdf:resource="http://www.example.com/sample1.html" /> </rdf:Seq> <rdf:Seq> <rdf:li rdf:resource="http://www.example.com/sample2.html" /> </rdf:Seq> <rdf:Seq> <rdf:li rdf:resource="http://www.example.com/sample3.html" /> </rdf:Seq> </items> </channel> <item rdf:about="http://www.example.com/sample1.html"> <title>sample item #1 http://www.example.com/sample1.html 2008-03-24T16:54:33 +0900 sample item #2 http://www.example.com/sample2.html 2008-02-29T18:21:38 +0900 sample item #3 http://www.example.com/sample3.html 2008-02-25T11:54:15 +0900 EOT # ---------------------------------------------------------------- my $valid = <<'EOT'; ja 2008-03-24T16:54:33+09:00 sample item #1 http://www.example.com/sample1.html 2008-03-24T16:54:33+09:00 sample item #2 http://www.example.com/sample2.html 2008-02-29T18:21:38+09:00 sample item #3 http://www.example.com/sample3.html 2008-02-25T11:54:15+09:00 EOT # ---------------------------------------------------------------- my $vfeed = XML::FeedPP->new( $valid ); is( $vfeed->pubDate, '2008-03-24T16:54:33+09:00', 'valid feed pubDate' ); is( scalar $vfeed->get_item(), 3, 'valid feed item number' ); my $vitem = $vfeed->get_item( 2 ); is( $vitem->title, 'sample item #3', 'valid item title' ); is( $vitem->pubDate, '2008-02-25T11:54:15+09:00', 'valid item pubDate' ); # ---------------------------------------------------------------- my $ifeed = XML::FeedPP->new( $invalid ); is( $ifeed->pubDate, '2008-03-24T16:54:33 +0900', 'invalid feed pubDate' ); is( scalar $ifeed->get_item(), 3, 'invalid feed item number' ); my $iitem = $ifeed->get_item( 2 ); is( $iitem->title, 'sample item #3', 'invalid item title' ); is( $iitem->pubDate, '2008-02-25T11:54:15 +0900', 'invalid item pubDate' ); # ---------------------------------------------------------------- my $isource = $ifeed->to_string(); my $rss = XML::FeedPP::RSS->new(); $rss->merge( $isource ); my $rsource = $rss->to_string(); my $rfeed = XML::FeedPP::RDF->new(); $rfeed->merge( $rsource ); # ---------------------------------------------------------------- is( $rfeed->pubDate, '2008-03-24T16:54:33+09:00', 'round trip feed pubDate' ); is( scalar $rfeed->get_item(), 3, 'round trip feed item number' ); my $ritem = $rfeed->get_item( 2 ); is( $ritem->title, 'sample item #3', 'round trip item title' ); is( $ritem->pubDate, '2008-02-25T11:54:15+09:00', 'round trip item pubDate' ); # ---------------------------------------------------------------- XML-FeedPP-0.43/t/46_atom_xhtml.t0000755000076400007640000000577511561467027015564 0ustar u-sukeu-suke# ---------------------------------------------------------------- use strict; use Test::More tests => 20; BEGIN { use_ok('XML::FeedPP') }; # ---------------------------------------------------------------- { my $sample = <<'EOT'; <xhtml:div> Less: <xhtml:em><</xhtml:em> </xhtml:div>

[Update: The Atom draft is finished.]

This is XHTML content.
This is XHTML content. This is XHTML content.
EOT my $feed = XML::FeedPP->new( $sample ); my $title = $feed->title; is(ref $title, 'HASH', 'feed title is HASH'); ok(! exists $title->{'xhtml:div'}, 'feed title does NOT have div'); like($title->{'xhtml:em'}, qr/get_item; is( scalar(@entry), 4, 'feed get_item' ); # entry 1 $item = shift @entry; $desc = $item->description; is(ref $desc, 'HASH', 'entry 1 /content is HASH'); ok(! exists $desc->{'div'}, 'entry 1 /content does NOT have /div'); ok(exists $desc->{p}, 'entry 1 /content/div/p'); is($desc->{-xmlns}, 'http://www.w3.org/1999/xhtml', 'entry 1 /content/div/@xmlns'); is($desc->{p}->{i}, '[Update: The Atom draft is finished.]', 'entry 1 /content/div/p/i'); # entry 2 $item = shift @entry; $desc = $item->description; is(ref $desc, 'HASH', 'entry 2 /content is HASH'); ok(! exists $desc->{'div'}, 'entry 2 /content does NOT have /div'); is($desc->{-xmlns}, 'http://www.w3.org/1999/xhtml', 'entry 2 /content/div/@xmlns'); is($desc->{b}, 'XHTML', 'entry 2 /content/div/b'); # entry 3 $item = shift @entry; $desc = $item->description; is(ref $desc, 'HASH', 'entry 3 /content is HASH'); ok(! exists $desc->{'xhtml:div'}, 'entry 3 /content does NOT have /xhtml:div'); is($desc->{'xhtml:b'}, 'XHTML', 'entry 3 /content/div/b'); # entry 4 $item = shift @entry; $desc = $item->description; is(ref $desc, 'HASH', 'entry 4 /content is HASH'); ok(! exists $desc->{'xh:div'}, 'entry 4 /content does NOT have /xh:div'); is($desc->{'xh:b'}, 'XHTML', 'entry 4 /content/div/b'); } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- XML-FeedPP-0.43/t/45_cdata_multi.t0000644000076400007640000000441011561507340015644 0ustar u-sukeu-suke# ---------------------------------------------------------------- use strict; use Test::More tests => 23; BEGIN { use_ok('XML::FeedPP') }; # ---------------------------------------------------------------- my $url = "http://www.kawa.net/"; my $cate1 = "hoge"; my $cate2 = "pomu"; my $cate3 = "foobar"; my $catem = [ \$cate1, \$cate2, \$cate3 ]; my $caten = scalar @$catem; # ---------------------------------------------------------------- my $feed0 = XML::FeedPP::RSS->new(); $feed0->link( $url ); my $item0 = $feed0->add_item( $url ); $item0->category( $catem ); ok( ref $item0->category(), "init multi ref" ); my $source = $feed0->to_string(); like( $source, qr/>new(), XML::FeedPP::RSS->new(), # XML::FeedPP::Atom::Atom10->new(), # Atom 1.0's doesn't use CDATA ]; # ---------------------------------------------------------------- foreach my $feed1 ( @$feeds ) { my $type = ref $feed1; $feed1->merge( $source ); my $item1 = $feed1->get_item(0); my $icate = $item1->category(); ok( ref $icate, "$type load ref" ); is( scalar @$icate, $caten, "$type load count" ); $item1->category( \$cate1 ); is( $item1->category(), $cate1, "$type one" ); like( $feed1->to_string(), qr/>category( $catem ); my $jcate = $item1->category(); ok( ref $jcate, "$type multi ref" ); is( scalar @$jcate, $caten, "$type multi count" ); $source = $feed1->to_string(); like( $source, qr/> 26; BEGIN { use_ok('XML::FeedPP') }; # ---------------------------------------------------------------- my $url = "http://www.kawa.net/"; my $cate1 = "hoge"; my $cate2 = "pomu"; my $cate3 = "foobar"; my $catem = [ $cate1, $cate2, $cate3 ]; my $caten = scalar @$catem; # ---------------------------------------------------------------- my $feed0 = XML::FeedPP::RSS->new(); $feed0->link( $url ); my $item0 = $feed0->add_item( $url ); $item0->category( $catem ); ok( ref $item0->category(), "init multi ref" ); my $source = $feed0->to_string(); like( $source, qr/>\s*\Q$cate1\E\s*\s*\Q$cate2\E\s*\s*\Q$cate3\E\s*new(), XML::FeedPP::RSS->new(), XML::FeedPP::Atom::Atom10->new(), ]; # ---------------------------------------------------------------- foreach my $feed1 ( @$feeds ) { my $type = ref $feed1; $feed1->merge( $source ); my $item1 = $feed1->get_item(0); my $icate = $item1->category(); my $icatn = scalar @$icate if ref $icate; is( $icatn, $caten, "$type load count" ); $item1->category( $cate1 ); is( $item1->category(), $cate1, "$type one" ); ok( $feed1->to_string() =~ /\W\Q$cate1\E\W/s, "$type one source" ); $item1->category( $catem ); my $jcate = $item1->category(); my $jcatn = scalar @$jcate if ref $jcate; is( $jcatn, $caten, "$type multi count" ); $source = $feed1->to_string(); like( $source, qr/\W\Q$cate1\E\W/s, "$type multi 1/3" ); like( $source, qr/\W\Q$cate2\E\W/s, "$type multi 2/3" ); like( $source, qr/\W\Q$cate3\E\W/s, "$type multi 3/3" ); } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- XML-FeedPP-0.43/t/24_get_epoch.t0000644000076400007640000000611411561507340015313 0ustar u-sukeu-suke# ---------------------------------------------------------------- use strict; use Test::More tests => 27; BEGIN { use_ok('XML::FeedPP') }; # ---------------------------------------------------------------- my $epo0a = time(); my $rfc1z = [ 'Sun, 21 Jan 2007 22:23:24', 'Sun, 21 Jan 2007 22:23:24 +09:00', 'Sun, 14 Jan 2007 13:12:11 +10:30', 'Sun, 7 Jan 2007 8:09:10 -11:30', ]; my $w3c2z = [ '2007-01-21T20:19:18Z', '2007-01-21T20:19:18+09:00', '2007-01-28T12:11:10+09:30', '2007-02-04T05:06:07-08:30', ]; # ---------------------------------------------------------------- my $w3c0a = &XML::FeedPP::Util::epoch_to_w3cdtf( $epo0a ); my $epo0b = &XML::FeedPP::Util::w3cdtf_to_epoch( $w3c0a ); is( $epo0b, $epo0a, "1: epoch-w3cdtf-epoch $epo0a" ); # ---------------------------------------------------------------- my $rfc0a = &XML::FeedPP::Util::epoch_to_rfc1123( $epo0a ); my $epo0c = &XML::FeedPP::Util::rfc1123_to_epoch( $rfc0a ); is( $epo0c, $epo0a, "1: epoch-rfc1123-epoch $epo0a" ); # ---------------------------------------------------------------- my $cnt = 2; foreach my $rfc1a ( @$rfc1z ) { my $epo1a = &XML::FeedPP::Util::rfc1123_to_epoch( $rfc1a ); ok( $epo1a > 0, "$cnt: rfc1123-epoch $rfc1a" ); my $rfc1b = &XML::FeedPP::Util::epoch_to_rfc1123( $epo1a ); my $epo1b = &XML::FeedPP::Util::rfc1123_to_epoch( $rfc1b ); my $rfc1c = &XML::FeedPP::Util::epoch_to_rfc1123( $epo1b ); is( $rfc1b, $rfc1c, "$cnt: rfc1123-epoch-rfc1123 $rfc1a" ); $cnt ++; } # ---------------------------------------------------------------- foreach my $w3c2a ( @$w3c2z ) { my $epo2a = &XML::FeedPP::Util::w3cdtf_to_epoch( $w3c2a ); ok( $epo2a > 0, "$cnt: w3cdtf-epoch $w3c2a" ); my $w3c2b = &XML::FeedPP::Util::epoch_to_w3cdtf( $epo2a ); my $epo2b = &XML::FeedPP::Util::w3cdtf_to_epoch( $w3c2b ); my $w3c2c = &XML::FeedPP::Util::epoch_to_w3cdtf( $epo2b ); is( $w3c2b, $w3c2c, "$cnt: w3cdtf-epoch-w3cdtf $w3c2a" ); $cnt ++; } # ---------------------------------------------------------------- foreach my $rfc3a ( @$rfc1z ) { my $w3c3a = &XML::FeedPP::Util::get_w3cdtf( $rfc3a ); my $epo3a = &XML::FeedPP::Util::get_epoch( $rfc3a ); my $epo3b = &XML::FeedPP::Util::get_epoch( $w3c3a ); is( $epo3b, $epo3a, "$cnt: rfc1123/w3cdtf-epoch $rfc3a" ); $cnt ++; } # ---------------------------------------------------------------- foreach my $w3c4a ( @$w3c2z ) { my $rfc4a = &XML::FeedPP::Util::get_rfc1123( $w3c4a ); my $epo4a = &XML::FeedPP::Util::get_epoch( $w3c4a ); my $epo4b = &XML::FeedPP::Util::get_epoch( $rfc4a ); is( $epo4b, $epo4a, "$cnt: rfc1123/w3cdtf-epoch $w3c4a" ); $cnt ++; } # ---------------------------------------------------------------- # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- XML-FeedPP-0.43/t/40_xml_deref.t0000755000076400007640000000416411561507340015327 0ustar u-sukeu-suke# ---------------------------------------------------------------- use strict; use Test::More; # ---------------------------------------------------------------- { local $@; eval { require XML::TreePP; }; plan skip_all => 'XML::TreePP is not loaded.' if $@; } { my $ver = ( $XML::TreePP::VERSION =~ /^(\d+\.\d+)/ )[0]; my $chk = ( $ver >= 0.37 ); plan skip_all => "XML::TreePP $XML::TreePP::VERSION < 0.37" unless $chk; plan tests => 28; ok( $chk, 'XML::TreePP '.$ver ); use_ok('XML::FeedPP'); &test_main(); } # ---------------------------------------------------------------- sub test_main { my $rss = <<'EOT'; © © ë ë EOT my $feedA = XML::FeedPP->new( $rss, xml_deref => 0 ); my $cntA = $feedA->get_item; is( $cntA, 4, 'item count' ); foreach my $item ( $feedA->get_item ) { my $title = $item->title; my $description = $item->description; ok( $title ne $description, 'no deref unmatch' ); like( $title, qr/&#\w+;/, 'no deref title '.$title ); like( $description, qr/&#\w+;/, 'no deref description '.$description ); } my $feedB = XML::FeedPP->new( $rss, xml_deref => 1 ); my $cntB = $feedB->get_item; is( $cntB, 4, 'item count' ); foreach my $item ( $feedB->get_item ) { my $title = $item->title; my $description = $item->description; ok( $title eq $description, 'xml_deref match' ); unlike( $title, qr/&#\w+;/, 'xml_deref title '.$title ); unlike( $description, qr/&#\w+;/, 'xml_deref description '.$description ); } } # ---------------------------------------------------------------- XML-FeedPP-0.43/t/42_indent.t0000755000076400007640000000464211561507340014646 0ustar u-sukeu-suke# ---------------------------------------------------------------- use strict; use Test::More; # ---------------------------------------------------------------- { local $@; eval { require 5.008001; }; plan skip_all => 'Perl 5.8.1 is required.' if $@; } # ---------------------------------------------------------------- { plan tests => 31; use_ok('XML::FeedPP'); &test_indent( 2 ); &test_indent( 4 ); } # ---------------------------------------------------------------- sub test_indent { my $indent = shift; my $feed = XML::FeedPP::RSS->new(); $feed->title( "\xC3\xAB" ); my $string1 = $feed->to_string( indent => $indent ); my $string2 = $feed->to_string( 'UTF-8' , indent => $indent ); my $string3 = $feed->to_string( 'Latin-1', indent => $indent ); my $string4 = $feed->to_string( output_encoding => 'UTF-8' , indent => $indent ); my $string5 = $feed->to_string( output_encoding => 'Latin-1', indent => $indent ); is( encoding($string1), 'UTF-8', 'encoding default' ); is( encoding($string2), 'UTF-8', 'encoding 3 args UTF-8' ); is( encoding($string3), 'LATIN-1', 'encoding 3 args Latin-1' ); is( encoding($string4), 'UTF-8', 'encoding 4 args UTF-8' ); is( encoding($string5), 'LATIN-1', 'encoding 4 args Latin-1' ); is( title($string1), "\xC3\xAB", 'title default' ); is( title($string2), "\xC3\xAB", 'title 3 args UTF-8' ); is( title($string3), "\xEB", 'title 3 args Latin-1' ); is( title($string4), "\xC3\xAB", 'title 4 args UTF-8' ); is( title($string5), "\xEB", 'title 4 args Latin-1' ); is( indent($string1), ' ' x $indent, 'indent default' ); is( indent($string2), ' ' x $indent, 'indent 3 args UTF-8' ); is( indent($string3), ' ' x $indent, 'indent 3 args Latin-1' ); is( indent($string4), ' ' x $indent, 'indent 4 args UTF-8' ); is( indent($string5), ' ' x $indent, 'indent 4 args Latin-1' ); } # ---------------------------------------------------------------- sub indent { my $str = shift; my $indent = ( $str =~ m#^(\040+)#m )[0]; $indent; } sub encoding { my $str = shift; my $encoding = ( $str =~ m#]*encoding="([^"]*)"# )[0]; uc($encoding); } sub title { my $str = shift; my $title = ( $str =~ m#([^<>]*)# )[0]; $title =~ s/^\s+//; $title =~ s/\s+$//; $title; } # ---------------------------------------------------------------- XML-FeedPP-0.43/t/19_invalid_w3cdtf.t0000644000076400007640000000357411561507340016271 0ustar u-sukeu-suke# ---------------------------------------------------------------- use strict; use Test::More tests => 11; BEGIN { use_ok('XML::FeedPP') }; # ---------------------------------------------------------------- my $map = { # valid - http://www.w3.org/TR/NOTE-datetime "2001-02-03" => "2001-02-03T00:00:00Z", "2002-03-04T05:06Z" => "2002-03-04T05:06:00Z", "2003-04-05T06:07+08:30" => "2003-04-05T06:07:00+08:30", "2004-05-06T07:08:09Z" => "2004-05-06T07:08:09Z", "2005-06-07T08:09:10-11:30" => "2005-06-07T08:09:10-11:30", "2006-07-08T09:10:11.12Z" => "2006-07-08T09:10:11Z", "2007-08-09T10:11:12.13+14:30" => "2007-08-09T10:11:12+14:30", # invalid - http://portal.nifty.com/rss/headline.rdf "2000-01-02T03:04:05:+09:00" => "2000-01-02T03:04:05+09:00", # invalid - http://www.cnc.co.jp/news/xml/rss.xml "2008-03-24T16:54:33 +0900" => "2008-03-24T16:54:33+09:00", }; # ---------------------------------------------------------------- my $rss = XML::FeedPP::RSS->new(); foreach my $try ( sort keys %$map ) { my $url = "http://www.kawa.net/?date=$try"; my $item3 = $rss->add_item( $url ); $item3->pubDate( $try ); } my $xml = $rss->to_string(); my $rdf = XML::FeedPP::RDF->new(); $rdf->merge( $xml ); my $check = {}; foreach my $item4 ( $rdf->get_item() ) { my $url = $item4->link(); my $try = (split( /=/, $url ))[1]; next unless defined $map->{$try}; $check->{$try} ++; is( $item4->pubDate(), $map->{$try}, "RSS to RDF: $try" ); } is( (scalar keys %$check), (scalar keys %$map), "RSS to RDF: checked" ); # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- XML-FeedPP-0.43/t/04_atom.t0000644000076400007640000003260411561507340014317 0ustar u-sukeu-suke# ---------------------------------------------------------------- use strict; use Test::More tests => 94; BEGIN { use_ok('XML::FeedPP') }; # ---------------------------------------------------------------- my $ftitle = "Title of the site"; my $fdesc = "Description of the site"; my $fdateA = "Mon, 02 Jan 2006 03:04:05 +0600"; my $fdateB = "2006-01-02T03:04:05+06:00"; my $fright = "Owner of the site"; my $flink = "http://www.kawa.net/"; my $flang = "ja"; # ---------------------------------------------------------------- my $link1 = "http://www.perl.org/"; my $link2 = "http://use.perl.org/"; my $link3 = "http://cpan.perl.org/"; my $title1 = "The Perl Directory - perl.org"; my $title2 = "use Perl: All the Perl that's Practical to Extract and Report"; my $title3 = "The Comprehensive Perl Archive Network"; # ---------------------------------------------------------------- my $idesc = "Description of the first item"; my $icate = "Category of the first item"; my $idateA = "Sun, 11 Dec 2005 10:09:08 -0700"; my $idateB = "2005-12-11T10:09:08-07:00"; my $iauthor = "Author"; my $iguid = "GUID"; # ---------------------------------------------------------------- # Atom (default version) # ---------------------------------------------------------------- my $feed1 = XML::FeedPP::Atom->new(); $feed1->title( $ftitle ); $feed1->description( $fdesc ); $feed1->pubDate( $fdateB ); $feed1->copyright( $fright ); $feed1->link( $flink ); $feed1->language( $flang ); # ---------------------------------------------------------------- ok( 0 == $feed1->get_item(), "0 item" ); # ---------------------------------------------------------------- my $item1 = $feed1->add_item( $link1 ); $item1->title( $title1 ); $item1->pubDate( $idateB ); ok( 1 == $feed1->get_item(), "1 item" ); # ---------------------------------------------------------------- $item1->description( $idesc ); $item1->category( $icate ); $item1->author( $iauthor, isPermaLink => "false" ); $item1->guid( $iguid ); # ---------------------------------------------------------------- my $item2 = $feed1->add_item( $link2 ); $item2->title( $title2 ); $item2->pubDate( $idateA ); ok( 2 == $feed1->get_item(), "2 items" ); # ---------------------------------------------------------------- my $item3 = $feed1->add_item( $link3 ); $item3->title( $title3 ); $item3->pubDate( $idateA ); ok( 3 == $feed1->get_item(), "3 items" ); # ---------------------------------------------------------------- my $source1 = $feed1->to_string(); my $feed2 = XML::FeedPP::Atom->new( $source1 ); ok( 3 == $feed2->get_item(), "3 items" ); # ---------------------------------------------------------------- is( $feed2->title(), $ftitle, "Atom->title()" ); is( $feed2->description(), $fdesc, "Atom->description()" ); is( $feed2->pubDate(), $fdateB, "Atom->pubDate()" ); is( $feed2->copyright(), $fright, "Atom->copyright()" ); is( $feed2->link(), $flink, "Atom->link()" ); is( $feed2->language(), $flang, "Atom->language()" ); # ---------------------------------------------------------------- my $item4 = $feed2->get_item( 0 ); # ---------------------------------------------------------------- is( $item4->link(), $link1, "Entry->link()" ); is( $item4->title(), $title1, "Entry->title()" ); is( $item4->pubDate(), $idateB, "Entry->pubDate()" ); is( $item4->description(), $idesc, "Entry->description()" ); is( $item4->category(), undef, "Entry->category()" ); is( $item4->author(), $iauthor, "Entry->author()" ); is( $item4->guid(), $iguid, "Entry->guid()" ); # ---------------------------------------------------------------- my $source2 = $feed1->to_string(); # warn "\n$source2\n"; is( $source1, $source2, "turn around - rss source." ); # ---------------------------------------------------------------- like( $source2, qr/]*>\s* \Q$ftitle\E/x, "" ); like( $source2, qr/<tagline[^>]*>\s* \Q$fdesc\E/x, "<tagline>" ); like( $source2, qr/<modified[^>]*>\s* \Q$fdateB\E/x, "<modified>" ); like( $source2, qr/<copyright[^>]*>\s* \Q$fright\E/x, "<copyright>" ); like( $source2, qr/<link[^>]* href="\Q$flink\E/x, '<link href="">' ); like( $source2, qr/<feed[^>]* xml:lang="\Q$flang\E/x, '<feed xml:lang="">' ); # ---------------------------------------------------------------- like( $source2, qr/<link[^>]* href="\Q$link1\E/x, '<link href="">' ); like( $source2, qr/<title[^>]*>\s* \Q$title1\E/x, "<title>" ); like( $source2, qr/<issued[^>]*>\s* \Q$idateB\E/x, "<issued>" ); like( $source2, qr/<content[^>]*>\s* \Q$idesc\E/x, "<content>" ); # like( $source2, qr/<category[^>]*>\s* \Q$icate\E/x, "<category>" ); like( $source2, qr/<name[^>]*>\s* \Q$iauthor\E/x, "<author><name>" ); like( $source2, qr/<id[^>]*>\s* \Q$iguid\E/x, "<id>" ); # ---------------------------------------------------------------- # Atom 0.3 # ---------------------------------------------------------------- $feed1 = XML::FeedPP::Atom::Atom03->new(); $feed1->title( $ftitle ); $feed1->description( $fdesc ); $feed1->pubDate( $fdateB ); $feed1->copyright( $fright ); $feed1->link( $flink ); $feed1->language( $flang ); # ---------------------------------------------------------------- ok( 0 == $feed1->get_item(), "0 item" ); # ---------------------------------------------------------------- $item1 = $feed1->add_item( $link1 ); $item1->title( $title1 ); $item1->pubDate( $idateB ); ok( 1 == $feed1->get_item(), "1 item" ); # ---------------------------------------------------------------- $item1->description( $idesc ); $item1->category( $icate ); $item1->author( $iauthor, isPermaLink => "false" ); $item1->guid( $iguid ); # ---------------------------------------------------------------- $item2 = $feed1->add_item( $link2 ); $item2->title( $title2 ); $item2->pubDate( $idateA ); ok( 2 == $feed1->get_item(), "2 items" ); # ---------------------------------------------------------------- $item3 = $feed1->add_item( $link3 ); $item3->title( $title3 ); $item3->pubDate( $idateA ); ok( 3 == $feed1->get_item(), "3 items" ); # ---------------------------------------------------------------- $source1 = $feed1->to_string(); $feed2 = XML::FeedPP::Atom::Atom03->new( $source1 ); ok( 3 == $feed2->get_item(), "3 items" ); # ---------------------------------------------------------------- is( $feed2->title(), $ftitle, "Atom->title()" ); is( $feed2->description(), $fdesc, "Atom->description()" ); is( $feed2->pubDate(), $fdateB, "Atom->pubDate()" ); is( $feed2->copyright(), $fright, "Atom->copyright()" ); is( $feed2->link(), $flink, "Atom->link()" ); is( $feed2->language(), $flang, "Atom->language()" ); # ---------------------------------------------------------------- $item4 = $feed2->get_item( 0 ); # ---------------------------------------------------------------- is( $item4->link(), $link1, "Entry->link()" ); is( $item4->title(), $title1, "Entry->title()" ); is( $item4->pubDate(), $idateB, "Entry->pubDate()" ); is( $item4->description(), $idesc, "Entry->description()" ); is( $item4->category(), undef, "Entry->category()" ); is( $item4->author(), $iauthor, "Entry->author()" ); is( $item4->guid(), $iguid, "Entry->guid()" ); # ---------------------------------------------------------------- $source2 = $feed1->to_string(); # warn "\n$source2\n"; is( $source1, $source2, "turn around - rss source." ); # ---------------------------------------------------------------- like( $source2, qr/<title[^>]*>\s* \Q$ftitle\E/x, "<title>" ); like( $source2, qr/<tagline[^>]*>\s* \Q$fdesc\E/x, "<tagline>" ); like( $source2, qr/<modified[^>]*>\s* \Q$fdateB\E/x, "<modified>" ); like( $source2, qr/<copyright[^>]*>\s* \Q$fright\E/x, "<copyright>" ); like( $source2, qr/<link[^>]* href="\Q$flink\E/x, '<link href="">' ); like( $source2, qr/<feed[^>]* xml:lang="\Q$flang\E/x, '<feed xml:lang="">' ); # ---------------------------------------------------------------- like( $source2, qr/<link[^>]* href="\Q$link1\E/x, '<link href="">' ); like( $source2, qr/<title[^>]*>\s* \Q$title1\E/x, "<title>" ); like( $source2, qr/<issued[^>]*>\s* \Q$idateB\E/x, "<issued>" ); like( $source2, qr/<content[^>]*>\s* \Q$idesc\E/x, "<content>" ); # like( $source2, qr/<category[^>]*>\s* \Q$icate\E/x, "<category>" ); like( $source2, qr/<name[^>]*>\s* \Q$iauthor\E/x, "<author><name>" ); like( $source2, qr/<id[^>]*>\s* \Q$iguid\E/x, "<id>" ); # ---------------------------------------------------------------- # Atom 1.0 # ---------------------------------------------------------------- $feed1 = XML::FeedPP::Atom::Atom10->new(); $feed1->title( $ftitle ); $feed1->description( $fdesc ); $feed1->pubDate( $fdateB ); $feed1->copyright( $fright ); $feed1->link( $flink ); $feed1->language( $flang ); # ---------------------------------------------------------------- ok( 0 == $feed1->get_item(), "0 item" ); # ---------------------------------------------------------------- $item1 = $feed1->add_item( $link1 ); $item1->title( $title1 ); $item1->pubDate( $idateB ); ok( 1 == $feed1->get_item(), "1 item" ); # ---------------------------------------------------------------- $item1->description( $idesc ); $item1->category( $icate ); $item1->author( $iauthor, isPermaLink => "false" ); $item1->guid( $iguid ); # ---------------------------------------------------------------- $item2 = $feed1->add_item( $link2 ); $item2->title( $title2 ); $item2->pubDate( $idateA ); ok( 2 == $feed1->get_item(), "2 items" ); # ---------------------------------------------------------------- $item3 = $feed1->add_item( $link3 ); $item3->title( $title3 ); $item3->pubDate( $idateA ); ok( 3 == $feed1->get_item(), "3 items" ); # ---------------------------------------------------------------- $source1 = $feed1->to_string(); $feed2 = XML::FeedPP::Atom::Atom10->new( $source1 ); ok( 3 == $feed2->get_item(), "3 items" ); # ---------------------------------------------------------------- is( $feed2->title(), $ftitle, "Atom->title()" ); is( $feed2->description(), $fdesc, "Atom->description()" ); is( $feed2->pubDate(), $fdateB, "Atom->pubDate()" ); is( $feed2->copyright(), $fright, "Atom->copyright()" ); is( $feed2->link(), $flink, "Atom->link()" ); is( $feed2->language(), $flang, "Atom->language()" ); # ---------------------------------------------------------------- $item4 = $feed2->get_item( 0 ); # ---------------------------------------------------------------- is( $item4->link(), $link1, "Entry->link()" ); is( $item4->title(), $title1, "Entry->title()" ); is( $item4->pubDate(), $idateB, "Entry->pubDate()" ); is( $item4->description(), $idesc, "Entry->description()" ); is( $item4->category(), $icate, "Entry->category()" ); is( $item4->author(), $iauthor, "Entry->author()" ); is( $item4->guid(), $iguid, "Entry->guid()" ); # ---------------------------------------------------------------- $source2 = $feed1->to_string(); # warn "\n$source2\n"; is( $source1, $source2, "turn around - rss source." ); # ---------------------------------------------------------------- like( $source2, qr/<title[^>]*>\s* \Q$ftitle\E/x, "<title>" ); # like( $source2, qr/<subtitle[^>]*>\s* \Q$fdesc\E/x, "<subtitle>" ); like( $source2, qr/<content[^>]*>\s* \Q$fdesc\E/x, "<content>" ); like( $source2, qr/<updated[^>]*>\s* \Q$fdateB\E/x, "<updated>" ); like( $source2, qr/<rights[^>]*>\s* \Q$fright\E/x, "<rights>" ); like( $source2, qr/<link[^>]* href="\Q$flink\E/x, '<link href="">' ); like( $source2, qr/<feed[^>]* xml:lang="\Q$flang\E/x, '<feed xml:lang="">' ); # ---------------------------------------------------------------- like( $source2, qr/<link[^>]* href="\Q$link1\E/x, '<link href="">' ); like( $source2, qr/<title[^>]*>\s* \Q$title1\E/x, "<title>" ); # like( $source2, qr/<published[^>]*>\s* \Q$idateB\E/x, "<published>" ); like( $source2, qr/<updated[^>]*>\s* \Q$idateB\E/x, "<updated>" ); like( $source2, qr/<content[^>]*>\s* \Q$idesc\E/x, "<content>" ); # like( $source2, qr/<category[^>]*>\s* \Q$icate\E/x, "<category>" ); like( $source2, qr/<name[^>]*>\s* \Q$iauthor\E/x, "<author><name>" ); like( $source2, qr/<id[^>]*>\s* \Q$iguid\E/x, "<id>" ); # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- ����������������������������������������������������������������������������������������������������������������������������XML-FeedPP-0.43/t/32_two_titles.t�������������������������������������������������������������������0000755�0000764�0000764�00000005114�11561507340�015554� 0����������������������������������������������������������������������������������������������������ustar �u-suke��������������������������u-suke�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# ---------------------------------------------------------------- use strict; use Test::More tests => 13; BEGIN { use_ok('XML::FeedPP') }; # ---------------------------------------------------------------- { my $source = <<'EOT'; <?xml version="1.0" encoding="UTF-8" ?> <rss version="2.0"> <channel> <title>sample channel sample channel http://www.example.com/ sample channel http://www.example.com/sample1.html http://www.example.com/sample1.html sample item #1 http://www.example.com/sample2.html http://www.example.com/sample2.html sample item #2 A sample item #2 B http://www.example.com/sample3.html http://www.example.com/sample3.html sample item #3 A sample item #3 B
EOT &test_main( $source ); } # ---------------------------------------------------------------- sub test_main { my $source = shift; my $feed = XML::FeedPP->new( $source ); my $ftitle = $feed->title; is( $ftitle, 'sample channel', 'feed title' ); my @ftitles = $feed->title; is( (scalar @ftitles), 2, 'num of feed titles' ); my $item1 = $feed->get_item( 0 ); my $ititle1 = $item1->title; is( $ititle1, 'sample item #1', '1: item title with xmlns' ); my @ititles1 = $item1->title; is( (scalar @ititles1), 1, '1: num of item titles' ); my $item2 = $feed->get_item( 1 ); my $ititle2 = $item2->title; is( $ititle2, 'sample item #2 A', '2: item title by array' ); my @ititles2 = $item2->title; is( (scalar @ititles2), 2, '2: num of item titles' ); is( $ititles2[0], 'sample item #2 A', '2A: item title' ); is( $ititles2[1], 'sample item #2 B', '2B: item title' ); my $item3 = $feed->get_item( 2 ); my $ititle3 = $item3->title; is( $ititle3, 'sample item #3 A', '3: item title with xmlns by array' ); my @ititles3 = $item3->title; is( (scalar @ititles3), 2, '3: num of item titles' ); is( $ititles3[0], 'sample item #3 A', '3A: item title' ); is( $ititles3[1], 'sample item #3 B', '3B: item title with xmlns' ); } # ---------------------------------------------------------------- XML-FeedPP-0.43/t/15_clone_item.t0000644000076400007640000000540711561507340015500 0ustar u-sukeu-suke# ---------------------------------------------------------------- use strict; use Test::More tests => 49; BEGIN { use_ok('XML::FeedPP') }; # ---------------------------------------------------------------- my $link = "http://www.kawa.net/"; my $title = "Kawa.net XP"; my $description = "Yusuke Kawasaki's website"; my $author = "Yusuke Kawasaki"; my $pubDate = "2004-11-09T11:33:20Z"; # ---------------------------------------------------------------- my $media = { 'media:title' => 'Kawa.net xp', 'media:text' => 'Welcome to Kawa.net xp', 'media:text@type' => 'text', 'media:thumbnail@url' => 'http://www.kawa.net/xp/images/xp-title-256.gif', 'media:thumbnail@width' => 256, 'media:thumbnail@height' => 48, 'media:content@url' => 'http://www.kawa.net/xp/images/xp-title-512.gif', 'media:content@type' => 'image/gif', 'media:content@width' => 512, 'media:content@height' => 96, }; # ---------------------------------------------------------------- my $feed0 = XML::FeedPP::RSS->new(); $feed0->link( $link ); my $item0 = $feed0->add_item( $link ); $item0->title( $title ); $item0->description( $description ); $item0->author( $author ); $item0->pubDate( $pubDate ); $item0->set( %$media ); # ---------------------------------------------------------------- my $prev = $item0; # ---------------------------------------------------------------- my $feeds = [ XML::FeedPP::RSS->new(), XML::FeedPP::RDF->new(), XML::FeedPP::RDF->new(), XML::FeedPP::Atom->new(), XML::FeedPP::Atom->new(), XML::FeedPP::RSS->new(), ]; # ---------------------------------------------------------------- foreach my $feed1 ( @$feeds ) { my $type = ref $feed1; $feed1->link( $link ); my $item1 = $feed1->add_item( $prev ); is( $item1->link(), $link, "$type link" ); is( $item1->title(), $title, "$type title" ); is( $item1->description(), $description, "$type description" ); is( $item1->author(), $author, "$type author" ); is( $item1->pubDate(), $pubDate, "$type pubDate" ); is( $item1->get('media:title'), $media->{'media:title'}, "$type media:title" ); is( $item1->get('media:text'), $media->{'media:text'}, "$type media:text" ); is( $item1->get('media:content@url'), $media->{'media:content@url'}, "$type media:content\@url" ); $prev = $item1; } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- XML-FeedPP-0.43/t/09_setget.t0000644000076400007640000000474711561507340014666 0ustar u-sukeu-suke# ---------------------------------------------------------------- use strict; use Test::More tests => 145; BEGIN { use_ok('XML::FeedPP') }; # ---------------------------------------------------------------- my $ftitle = "Title of the site"; my $fdesc = "Description of the site"; my $ilink = "http://www.kawa.net/"; # ---------------------------------------------------------------- my $hash = { 'elem1' => 'ELEM01', 'elem2@attr2' => 'ATTR02', 'elem3' => 'ELEM03', 'elem3@attr3' => 'ATTR03', 'elem4' => 'ELEM03', 'elem4@attr4' => 'ATTR04', 'elem4@attr5' => 'ATTR05', 'elem4/elem6' => 'ELEM06', 'elem7/elem8' => 'ELEM08', 'elem7/elem8@attr8' => 'ATTR08', 'elem7/elem8' => 'ELEM08', 'elem9/elem10' => 'ATTR10', 'elem9/elem11' => 'ELEM10', 'elem9/elem12@attr12' => 'ELEM12', '@attr13' => 'ATTR13', }; # ---------------------------------------------------------------- my $noexists = [ 'not:exist', 'not@exist', 'not/exist', 'not/exist@attr', 'elem1/not:exist', 'elem1/not:exist@attr', 'elem2/not:exist', 'elem2/not:exist@attr', 'elem4/not:exist', 'elem4/not:exist@attr', ]; # ---------------------------------------------------------------- my $feeds = [ XML::FeedPP::RDF->new(), XML::FeedPP::RSS->new(), XML::FeedPP::RDF->new(), ]; # ---------------------------------------------------------------- foreach my $feed1 ( @$feeds ) { my $type = ref $feed1; $feed1->title( $ftitle ); $feed1->set( %$hash ); foreach my $key ( sort keys %$hash ) { is( $feed1->get($key), $hash->{$key}, "$type channel $key" ); } foreach my $key ( @$noexists ) { ok( ! defined $feed1->get($key), "$type channel $key" ); } my $item1 = $feed1->add_item( $ilink ); $item1->set( %$hash ); foreach my $key ( sort keys %$hash ) { is( $item1->get($key), $hash->{$key}, "$type item $key" ); } foreach my $key ( @$noexists ) { ok( ! defined $item1->get($key), "$type item $key" ); } } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- XML-FeedPP-0.43/t/06_xmlns.t0000644000076400007640000000572211561507340014523 0ustar u-sukeu-suke# ---------------------------------------------------------------- use strict; use Test::More tests => 19; BEGIN { use_ok('XML::FeedPP') }; # ---------------------------------------------------------------- my $ftitle = "Title of the site"; my $fdesc = "Description of the site"; # ---------------------------------------------------------------- my $xmlns_media = 'http://search.yahoo.com/mrss'; my $xmlns_taxo = 'http://purl.org/rss/1.0/modules/taxonomy/'; my $xmlns_syn = 'http://purl.org/rss/1.0/modules/syndication/'; # ---------------------------------------------------------------- my $feed1 = XML::FeedPP::RSS->new(); $feed1->title( $ftitle ); my $xmlns1 = $feed1->xmlns(); is( join(" ",sort $feed1->xmlns()), "", "RSS xmlns=".$xmlns1 ); $feed1->xmlns( 'xmlns:syn' => $xmlns_syn ); is( $xmlns_syn, $feed1->xmlns('xmlns:syn'), 'RSS xmlns:syn' ); ok( $xmlns1+1 == scalar $feed1->xmlns(), 'RSS +1' ); my $source1 = $feed1->to_string(); like( $source1, qr{ ]+ xmlns:syn="\Q$xmlns_syn\E" }x, 'RSS to_string' ); # ---------------------------------------------------------------- my $feed2 = XML::FeedPP::RDF->new(); $feed2->title( $ftitle ); my $xmlns2 = $feed2->xmlns(); is( join(" ",sort $feed2->xmlns()), "xmlns xmlns:dc xmlns:rdf", "RDF xmlns=".$xmlns2 ); $feed2->xmlns( 'xmlns:taxo' => $xmlns_taxo ); is( $xmlns_taxo, $feed2->xmlns('xmlns:taxo'), 'RDF xmlns:taxo' ); ok( $xmlns2+1 == scalar $feed2->xmlns(), 'RDF +1' ); my $source2 = $feed2->to_string(); like( $source2, qr{ ]+ xmlns:taxo="\Q$xmlns_taxo\E" }x, 'RDF to_string' ); # ---------------------------------------------------------------- my $feed3 = XML::FeedPP::Atom->new(); $feed3->title( $ftitle ); my $xmlns3 = $feed3->xmlns(); is( join(" ",sort $feed3->xmlns()), "xmlns", "Atom xmlns=".$xmlns3 ); $feed3->xmlns( 'xmlns:media' => $xmlns_media ); is( $xmlns_media, $feed3->xmlns('xmlns:media'), 'Atom xmlns:media' ); ok( $xmlns3+1 == scalar $feed3->xmlns(), 'Atom +1' ); my $source3 = $feed3->to_string(); like( $source3, qr{ ]+ xmlns:media="\Q$xmlns_media\E" }x, 'RDF to_string' ); # ---------------------------------------------------------------- $feed1->merge( $source2 ); is( $xmlns_taxo, $feed1->xmlns('xmlns:taxo'), 'RSS xmlns:taxo' ); $feed1->merge( $source3 ); ok( $xmlns1+3 == scalar $feed1->xmlns(), 'RSS +3' ); # ---------------------------------------------------------------- $feed2->merge( $source3 ); is( $xmlns_media, $feed2->xmlns('xmlns:media'), 'RDF xmlns:media' ); $feed2->merge( $source1 ); ok( $xmlns2+3 == scalar $feed2->xmlns(), 'RDF +3' ); # ---------------------------------------------------------------- $feed3->merge( $source1 ); is( $xmlns_syn, $feed1->xmlns('xmlns:syn'), 'Atom xmlns:syn' ); $feed3->merge( $source2 ); ok( $xmlns3+3 == scalar $feed3->xmlns(), 'Atom +3' ); # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- XML-FeedPP-0.43/t/12_sort_item.t0000644000076400007640000000425311561507340015362 0ustar u-sukeu-suke# ---------------------------------------------------------------- use strict; use Test::More tests => 19; BEGIN { use_ok('XML::FeedPP') }; # ---------------------------------------------------------------- my $link1 = "http://www.kawa.net/"; my $link2 = "http://www.flickr.com/photos/u-suke/"; my $link3 = "http://feeds.feedburner.com/u-suke/"; my $link4 = "http://kawa.suprglu.com/"; my $link5 = "http://del.icio.us/kawa.net"; # ---------------------------------------------------------------- my $date1 = 1100000000; my $date2 = "2005-03-05T14:20:00+09:00"; # 1110000000 my $date3 = "Wed, 29 Jun 2005 08:06:30 -0900"; # 1120000000 my $date4 = "2005-10-23T01:53:20Z"; # 1130000000 my $date5 = "Wed, 15 Feb 2006 19:40:00 GMT"; # 1140000000 # ---------------------------------------------------------------- my $feed1 = XML::FeedPP::RSS->new(); my $feed2 = XML::FeedPP::RDF->new(); my $feed3 = XML::FeedPP::Atom->new(); # ---------------------------------------------------------------- my $map = { $link1 => $date1, $link2 => $date2, $link3 => $date3, $link4 => $date4, $link5 => $date5, }; # ---------------------------------------------------------------- foreach my $f ( $feed1, $feed2, $feed3 ) { foreach my $u ( sort keys %$map ) { my $i = $f->add_item( $u ); $i->pubDate( $map->{$u} ) if $map->{$u}; } my $mode = ( (ref $f) =~ /([^:]+)$/ )[0]; is( 5, scalar $f->get_item(), "$mode count #1" ); $f->sort_item(); is( 5, scalar $f->get_item(), "$mode count #2" ); is( $date2, $f->get_item(3)->pubDate(), "$mode sort #1" ); is( $date4, $f->get_item(1)->pubDate(), "$mode sort #2" ); $f->get_item(4)->link( $link3 ); $f->get_item(3)->link( $link3 ); $f->normalize(); is( 3, scalar $f->get_item(), "$mode count #3" ); $f->limit_item( 1 ); is( 1, scalar $f->get_item(), "$mode count #4" ); } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- XML-FeedPP-0.43/t/43_indent_atom.t0000644000076400007640000000227011561507340015657 0ustar u-sukeu-suke# ---------------------------------------------------------------- use strict; use Test::More; # ---------------------------------------------------------------- my $link = "http://www.kawa.net/"; my $title = "foobar"; # ---------------------------------------------------------------- { plan tests => 9; use_ok('XML::FeedPP'); my $feeds = [ XML::FeedPP::RDF->new(), XML::FeedPP::RSS->new(), XML::FeedPP::Atom::Atom03->new(), XML::FeedPP::Atom::Atom10->new(), ]; foreach my $feed1 ( @$feeds ) { &test_indent( 2, $feed1 ); &test_indent( 4, $feed1 ); } } # ---------------------------------------------------------------- sub test_indent { my $indent = shift; my $feed = shift; my $type = ref $feed; $feed->link($link); $feed->add_item($link); my $string1 = $feed->to_string( indent => $indent ); is( indent($string1), ' ' x $indent, "$type indent $indent" ); } # ---------------------------------------------------------------- sub indent { my $str = shift; my $indent = ( $str =~ m#^(\040+)#m )[0]; $indent; } # ---------------------------------------------------------------- XML-FeedPP-0.43/t/21_negative_item.t0000644000076400007640000000344311561507340016175 0ustar u-sukeu-suke# ---------------------------------------------------------------- use strict; use Test::More tests => 28; BEGIN { use_ok('XML::FeedPP') }; # ---------------------------------------------------------------- my $link1 = "http://www.kawa.net/"; my $link2 = "http://www.youtube.com/user/YusukeKawasaki"; my $link3 = "http://picasaweb.google.com/www.kawa.net/"; my $link4 = "http://kawanet.blogspot.com/"; my $link5 = "http://del.icio.us/kawa.net"; # ---------------------------------------------------------------- my $feed1 = XML::FeedPP::RSS->new(); my $feed2 = XML::FeedPP::RDF->new(); my $feed3 = XML::FeedPP::Atom->new(); # ---------------------------------------------------------------- my $links = [ $link1, $link2, $link3, $link4, $link5 ]; # ---------------------------------------------------------------- foreach my $f ( $feed1, $feed2, $feed3 ) { my $mode = ( (ref $f) =~ /([^:]+)$/ )[0]; foreach my $u ( @$links ) { $f->add_item( $u ); } is( $f->get_item(-2)->link(), $link4, "$mode get_item -2" ); is( $f->remove_item(-2)->link(), $link4, "$mode remove_item -2" ); is( $f->get_item(0)->link(), $link1, "$mode get_item 0" ); is( $f->remove_item(0)->link(), $link1, "$mode remove_item 0" ); is( $f->get_item(-1)->link(), $link5, "$mode get_item -1" ); is( $f->remove_item(-1)->link(), $link5, "$mode remove_item -1" ); is( $f->get_item(1)->link(), $link3, "$mode get_item 1" ); is( $f->remove_item(1)->link(), $link3, "$mode remove_item 1" ); is( scalar $f->get_item(), 1, "$mode count 1" ); } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- XML-FeedPP-0.43/t/05_round.t0000644000076400007640000001136211561507340014505 0ustar u-sukeu-suke# ---------------------------------------------------------------- use strict; use Test::More tests => 21; BEGIN { use_ok('XML::FeedPP') }; # ---------------------------------------------------------------- my $ftitle = "Title of the site"; my $fdesc = "Description of the site"; my $fdateA = "Mon, 02 Jan 2006 03:04:05 +0600"; my $fdateB = "2006-01-02T03:04:05+06:00"; my $fright = "Owner of the site"; my $flink = "http://www.kawa.net/"; my $flang = "ja"; # ---------------------------------------------------------------- my $link1 = "http://www.perl.org/"; my $link2 = "http://use.perl.org/"; my $link3 = "http://cpan.perl.org/"; my $title1 = "The Perl Directory - perl.org"; my $title2 = "use Perl: All the Perl that's Practical to Extract and Report"; my $title3 = "The Comprehensive Perl Archive Network"; # ---------------------------------------------------------------- my $idesc = "Description of the first item"; my $icate = "Category of the first item"; my $idateA = "Sun, 11 Dec 2005 10:09:08 -0700"; my $idateB = "2005-12-11T10:09:08-07:00"; my $iauthor = "Author"; my $iguid = "GUID"; # ---------------------------------------------------------------- my $feed1 = XML::FeedPP::RSS->new(); $feed1->title( $ftitle ); $feed1->description( $fdesc ); $feed1->pubDate( $fdateA ); $feed1->copyright( $fright ); $feed1->link( $flink ); $feed1->language( $flang ); # ---------------------------------------------------------------- my $item1 = $feed1->add_item( $link1 ); $item1->title( $title1 ); $item1->pubDate( $idateA ); $item1->description( $idesc ); $item1->category( $icate ); $item1->author( $iauthor, isPermaLink => "false" ); $item1->guid( $iguid ); # ---------------------------------------------------------------- ok( 1 == scalar $feed1->get_item(), "RSS 1st" ); my $source1 = $feed1->to_string(); # ---------------------------------------------------------------- # Round1: RSS -> RDF -> Atom -> RSS (w/1item) # ---------------------------------------------------------------- my $feed2 = XML::FeedPP::RDF->new(); $feed2->merge( $source1 ); ok( 1 == $feed2->get_item(), "RDF 1st" ); my $source2 = $feed2->to_string(); my $feed3 = XML::FeedPP::Atom->new(); $feed3->merge( $source2 ); ok( 1 == $feed3->get_item(), "Atom 1st" ); my $source3 = $feed3->to_string(); my $feed4 = XML::FeedPP::RSS->new(); $feed4->merge( $source3 ); ok( 1 == $feed4->get_item(), "RSS 2nd A" ); # ---------------------------------------------------------------- my $item2 = $feed4->add_item( $link2 ); $item2->title( $title2 ); $item2->pubDate( $idateA ); my $item3 = $feed4->add_item( $link3 ); $item3->title( $title3 ); $item3->pubDate( $idateA ); ok( 3 == $feed4->get_item(), "RSS 2nd B" ); # ---------------------------------------------------------------- # Round2: RSS -> Atom -> RDF -> RSS (w/3items) # ---------------------------------------------------------------- my $source4 = $feed4->to_string(); my $feed5 = XML::FeedPP::Atom->new(); $feed5->merge( $source4 ); ok( 3 == $feed5->get_item(), "Atom 2nd" ); my $source5 = $feed5->to_string(); my $feed6 = XML::FeedPP::RDF->new(); $feed6->merge( $source5 ); ok( 3 == $feed6->get_item(), "RDF 2nd" ); my $source6 = $feed6->to_string(); my $feed7 = XML::FeedPP::RSS->new(); $feed7->merge( $source6 ); ok( 3 == $feed7->get_item(), "RSS 3rd" ); my $source7 = $feed7->to_string(); # ---------------------------------------------------------------- is( $source4, $source7, "turn round" ); is( $feed7->title(), $ftitle, "RSS->title()" ); is( $feed7->description(), $fdesc, "RSS->description()" ); is( $feed7->pubDate(), $fdateB, "RSS->pubDate()" ); is( $feed7->copyright(), $fright, "RSS->copyright()" ); is( $feed7->link(), $flink, "RSS->link()" ); is( $feed7->language(), $flang, "RSS->language()" ); # ---------------------------------------------------------------- my $item7 = $feed7->get_item( 0 ); is( $item7->link(), $link1, "Item->title()" ); is( $item7->title(), $title1, "Item->title()" ); is( $item7->pubDate(), $idateB, "Item->pubDate()" ); is( $item7->description(), $idesc, "Item->description()" ); is( $item7->author(), $iauthor, "Item->author()" ); # ---------------------------------------------------------------- # use Data::Dumper; # my $text = Dumper( $feed1 ); # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- XML-FeedPP-0.43/t/16_invalid_pubdate.t0000644000076400007640000000757011561507340016520 0ustar u-sukeu-suke# ---------------------------------------------------------------- use strict; use Test::More tests => 13; BEGIN { use_ok('XML::FeedPP') }; # ---------------------------------------------------------------- my $date110w = "2004-11-09T11:33:20Z"; # 1100000000 my $date110h = "Tue, 09 Nov 2004 11:33:20 GMT"; my $date111w = "2005-03-05T14:20:00+09:00"; # 1110000000 my $date111h = "Sat, 05 Mar 2005 14:20:00 +0900"; my $date112w = "2005-06-29T08:06:30-09:00"; # 1120000000 my $date112h = "Wed, 29 Jun 2005 08:06:30 -0900"; my $date113w = "2005-10-23T01:53:20Z"; # 1130000000 my $date113h = "Sun, 23 Oct 2005 01:53:20 GMT"; my $date114w = "2006-02-15T19:40:00Z"; # 1140000000 my $date114h = "Wed, 15 Feb 2006 19:40:00 GMT"; # ---------------------------------------------------------------- my $url = "http://www.kawa.net/"; # ---------------------------------------------------------------- my $src_rss = <<"EOT"; $url $date110w $url $date111w EOT # ---------------------------------------------------------------- my $src_rdf = <<"EOT"; $url $date112h $url $date113h EOT # ---------------------------------------------------------------- my $src_atom = <<"EOT"; $date114h $date110h $date111h EOT # ---------------------------------------------------------------- my $feed_rss = XML::FeedPP->new( $src_rss ); $feed_rss->normalize(); is( $feed_rss->pubDate(), $date110w, "rss channel pubDate()" ); my $item_rss = $feed_rss->get_item(0); is( $item_rss->pubDate(), $date111w, "rss item pubDate()" ); my $out_rss = $feed_rss->to_string(); ok( $out_rss =~ /\Q$date110h\E/, "rss channel to_string()" ); ok( $out_rss =~ /\Q$date111h\E/, "rss item to_string()" ); # ---------------------------------------------------------------- my $feed_rdf = XML::FeedPP->new( $src_rdf ); $feed_rdf->normalize(); is( $feed_rdf->pubDate(), $date112w, "rdf channel pubDate()" ); my $item_rdf = $feed_rdf->get_item(0); is( $item_rdf->pubDate(), $date113w, "rdf item pubDate()" ); my $out_rdf = $feed_rdf->to_string(); ok( $out_rdf =~ /\Q$date112w\E/, "rdf channel to_string()" ); ok( $out_rdf =~ /\Q$date113w\E/, "rdf item to_string()" ); # ---------------------------------------------------------------- my $feed_atom = XML::FeedPP->new( $src_atom ); $feed_atom->normalize(); is( $feed_atom->pubDate(), $date114w, "atom channel pubDate()" ); my $item_atom = $feed_atom->get_item(0); is( $item_atom->pubDate(), $date111w, "atom item pubDate()" ); my $out_atom = $feed_atom->to_string(); ok( $out_atom =~ /\Q$date114w\E/, "atom channel to_string()" ); ok( $out_atom =~ /\Q$date111w\E/, "atom item to_string()" ); # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- XML-FeedPP-0.43/t/02_rss.t0000644000076400007640000001222411561507340014160 0ustar u-sukeu-suke# ---------------------------------------------------------------- use strict; use Test::More tests => 33; BEGIN { use_ok('XML::FeedPP') }; # ---------------------------------------------------------------- my $ftitle = "Title of the site"; my $fdesc = "Description of the site"; my $fdateA = "Mon, 02 Jan 2006 03:04:05 +0600"; my $fdateB = "2006-01-02T03:04:05+06:00"; my $fright = "Owner of the site"; my $flink = "http://www.kawa.net/"; my $flang = "ja"; # ---------------------------------------------------------------- my $link1 = "http://www.perl.org/"; my $link2 = "http://use.perl.org/"; my $link3 = "http://cpan.perl.org/"; my $title1 = "The Perl Directory - perl.org"; my $title2 = "use Perl: All the Perl that's Practical to Extract and Report"; my $title3 = "The Comprehensive Perl Archive Network"; # ---------------------------------------------------------------- my $idesc = "Description of the first item"; my $icate = "Category of the first item"; my $idateA = "Sun, 11 Dec 2005 10:09:08 -0700"; my $idateB = "2005-12-11T10:09:08-07:00"; my $iauthor = "Author"; my $iguid = "GUID"; # ---------------------------------------------------------------- my $feed1 = XML::FeedPP::RSS->new(); $feed1->title( $ftitle ); $feed1->description( $fdesc ); $feed1->pubDate( $fdateA ); $feed1->copyright( $fright ); $feed1->link( $flink ); $feed1->language( $flang ); # ---------------------------------------------------------------- ok( 0 == $feed1->get_item(), "0 item" ); # ---------------------------------------------------------------- my $item1 = $feed1->add_item( $link1 ); $item1->title( $title1 ); $item1->pubDate( $idateA ); ok( 1 == $feed1->get_item(), "1 item" ); # ---------------------------------------------------------------- $item1->description( $idesc ); $item1->category( $icate ); $item1->author( $iauthor, isPermaLink => "false" ); $item1->guid( $iguid ); # ---------------------------------------------------------------- my $item2 = $feed1->add_item( $link2 ); $item2->title( $title2 ); $item2->pubDate( $idateA ); ok( 2 == $feed1->get_item(), "2 items" ); # ---------------------------------------------------------------- my $item3 = $feed1->add_item( $link3 ); $item3->title( $title3 ); $item3->pubDate( $idateA ); ok( 3 == $feed1->get_item(), "3 items" ); # ---------------------------------------------------------------- my $source1 = $feed1->to_string(); my $feed2 = XML::FeedPP::RSS->new( $source1 ); ok( 3 == $feed2->get_item(), "3 items" ); # ---------------------------------------------------------------- is( $feed2->title(), $ftitle, "RSS->title()" ); is( $feed2->description(), $fdesc, "RSS->description()" ); is( $feed2->pubDate(), $fdateB, "RSS->pubDate()" ); is( $feed2->copyright(), $fright, "RSS->copyright()" ); is( $feed2->link(), $flink, "RSS->link()" ); is( $feed2->language(), $flang, "RSS->language()" ); # ---------------------------------------------------------------- my $item4 = $feed2->get_item( 0 ); # ---------------------------------------------------------------- is( $item4->link(), $link1, "Item->link()" ); is( $item4->title(), $title1, "Item->title()" ); is( $item4->pubDate(), $idateB, "Item->pubDate()" ); is( $item4->description(), $idesc, "Item->description()" ); is( $item4->category(), $icate, "Item->category()" ); is( $item4->author(), $iauthor, "Item->author()" ); is( $item4->guid(), $iguid , "Item->guid()" ); # ---------------------------------------------------------------- my $source2 = $feed1->to_string(); is( $source1, $source2, "turn around - rss source." ); # ---------------------------------------------------------------- like( $source2, qr/]*>\s* \Q$ftitle\E/x, "" ); like( $source2, qr/<description[^>]*>\s*\Q$fdesc\E/x, "<description>" ); like( $source2, qr/<pubDate[^>]*>\s* \Q$fdateA\E/x, "<pubDate>" ); like( $source2, qr/<copyright[^>]*>\s* \Q$fright\E/x, "<copyright>" ); like( $source2, qr/<link[^>]*>\s* \Q$flink\E/x, "<link>" ); like( $source2, qr/<language[^>]*>\s* \Q$flang\E/x, "<language>" ); # ---------------------------------------------------------------- like( $source2, qr/<link[^>]*>\s* \Q$link1\E/x, "<link>" ); like( $source2, qr/<title[^>]*>\s* \Q$title1\E/x, "<title>" ); like( $source2, qr/<pubDate[^>]*>\s* \Q$idateA\E/x, "<pubDate>" ); like( $source2, qr/<description[^>]*>\s* \Q$idesc\E/x, "<description>" ); like( $source2, qr/<category[^>]*>\s* \Q$icate\E/x, "<category>" ); like( $source2, qr/<author[^>]*>\s* \Q$iauthor\E/x, "<author>" ); like( $source2, qr/<guid[^>]*>\s* \Q$iguid\E/x, "<guid>" ); # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������XML-FeedPP-0.43/t/01_new.t��������������������������������������������������������������������������0000644�0000764�0000764�00000002210�11561507340�014133� 0����������������������������������������������������������������������������������������������������ustar �u-suke��������������������������u-suke�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# ---------------------------------------------------------------- use strict; use Test::More tests => 6; BEGIN { use_ok('XML::FeedPP') }; # ---------------------------------------------------------------- my $rss = XML::FeedPP::RSS->new(); like( $rss->to_string(), qr/<rss/, "rss" ); # ---------------------------------------------------------------- my $rdf = XML::FeedPP::RDF->new(); like( $rdf->to_string(), qr/<rdf:RDF/, "rdf" ); # ---------------------------------------------------------------- my $atom = XML::FeedPP::Atom->new(); like( $atom->to_string(), qr/<feed/, "atom" ); # ---------------------------------------------------------------- my $atom03 = XML::FeedPP::Atom::Atom03->new(); like( $atom03->to_string(), qr/<feed[^>]*version="0.3"/, "atom 0.3" ); # ---------------------------------------------------------------- my $atom10 = XML::FeedPP::Atom::Atom10->new(); like( $atom10->to_string(), qr{<feed[^>]*http://www.w3.org/2005/Atom}, "atom 1.0" ); # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������XML-FeedPP-0.43/t/29_rfc2822.t����������������������������������������������������������������������0000644�0000764�0000764�00000005223�11561507340�014453� 0����������������������������������������������������������������������������������������������������ustar �u-suke��������������������������u-suke�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# ---------------------------------------------------------------- use strict; use Test::More tests => 11; BEGIN { use_ok('XML::FeedPP') }; # ---------------------------------------------------------------- =rfc2822 obs-zone = "UT" / "GMT" / ; Universal Time ; North American UT ; offsets "EST" / "EDT" / ; Eastern: - 5/ - 4 "CST" / "CDT" / ; Central: - 6/ - 5 "MST" / "MDT" / ; Mountain: - 7/ - 6 "PST" / "PDT" / ; Pacific: - 8/ - 7 EDT is semantically equivalent to -0400 EST is semantically equivalent to -0500 CDT is semantically equivalent to -0500 CST is semantically equivalent to -0600 MDT is semantically equivalent to -0600 MST is semantically equivalent to -0700 PDT is semantically equivalent to -0700 PST is semantically equivalent to -0800 =cut # ---------------------------------------------------------------- { my $rfc2822 = { '1200000000' => 'Thu, 10 Jan 2008 21:20:00 GMT', '1210000000' => 'Mon, 05 May 2008 15:06:40 UT', '1220000000' => 'Fri, 29 Aug 2008 08:53:20 EDT', '1230000000' => 'Tue, 23 Dec 2008 02:40:00 EST', '1240000000' => 'Fri, 17 Apr 2009 20:26:40 CDT', '1250000000' => 'Tue, 11 Aug 2009 14:13:20 CST', '1260000000' => 'Sat, 05 Dec 2009 08:00:00 MDT', '1270000000' => 'Wed, 31 Mar 2010 01:46:40 MST', '1280000000' => 'Sat, 24 Jul 2010 19:33:20 PDT', '1290000000' => 'Wed, 17 Nov 2010 13:20:00 PST', }; my $w3cdtf = { '1200000000' => '2008-01-10T21:20:00Z', '1210000000' => '2008-05-05T15:06:40Z', '1220000000' => '2008-08-29T08:53:20-04:00', '1230000000' => '2008-12-23T02:40:00-05:00', '1240000000' => '2009-04-17T20:26:40-05:00', '1250000000' => '2009-08-11T14:13:20-06:00', '1260000000' => '2009-12-05T08:00:00-06:00', '1270000000' => '2010-03-31T01:46:40-07:00', '1280000000' => '2010-07-24T19:33:20-07:00', '1290000000' => '2010-11-17T13:20:00-08:00', }; foreach my $key ( sort keys %$rfc2822 ) { my $input = $rfc2822->{$key}; my $check = $w3cdtf->{$key}; my $out = XML::FeedPP::Util::rfc1123_to_w3cdtf( $input ); $out =~ s/[\+\-]00:00$/Z/; my $name = ( $input =~ /(\w+)$/ )[0]; is( $out, $check, $name ); } } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������XML-FeedPP-0.43/t/26_atom10_parse.t�����������������������������������������������������������������0000644�0000764�0000764�00000011343�11561405740�015654� 0����������������������������������������������������������������������������������������������������ustar �u-suke��������������������������u-suke�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# ---------------------------------------------------------------- use strict; use Test::More tests => 23; BEGIN { use_ok('XML::FeedPP') }; # ---------------------------------------------------------------- # Sample Atom 1.0 sources from http://www.ietf.org/rfc/rfc4287 # ---------------------------------------------------------------- { my $sample = <<'EOT'; <?xml version="1.0" encoding="utf-8"?> <feed xmlns="http://www.w3.org/2005/Atom"> <title>Example Feed 2003-12-13T18:30:02Z John Doe urn:uuid:60a76c80-d399-11d9-b93C-0003939e0af6 Atom-Powered Robots Run Amok urn:uuid:1225c695-cfb8-4ebb-aaaa-80da344efa6a 2003-12-13T18:30:02Z Some text. EOT my $feed = XML::FeedPP->new( $sample ); ok( $feed->isa( 'XML::FeedPP::Atom::Atom10' ), 'XML::FeedPP::Atom::Atom10' ); is( $feed->title, 'Example Feed', 'feed title' ); is( $feed->link, 'http://example.org/', 'feed link' ); is( $feed->pubDate, '2003-12-13T18:30:02Z', 'feed pubDate' ); # is( $feed->author, 'John Doe', 'feed author' ); # is( $feed->guid, 'urn:uuid:60a76c80-d399-11d9-b93C-0003939e0af6', 'feed guid' ); my @entry = $feed->get_item; is( scalar(@entry), 1, 'feed get_item' ); my $item = shift @entry; is( $item->title, 'Atom-Powered Robots Run Amok', 'item title' ); is( $item->link, 'http://example.org/2003/12/13/atom03', 'item link' ); is( $item->guid, 'urn:uuid:1225c695-cfb8-4ebb-aaaa-80da344efa6a', 'item guid' ); is( $item->pubDate, '2003-12-13T18:30:02Z', 'item pubDate' ); is( $item->description, 'Some text.', 'item description' ); } # ---------------------------------------------------------------- { my $sample = <<'EOT'; dive into mark A <em>lot</em> of effort went into making this effortless 2005-07-31T12:29:29Z tag:example.org,2003:3 Copyright (c) 2003, Mark Pilgrim Example Toolkit Atom draft-07 snapshot tag:example.org,2003:3.2397 2005-07-31T12:29:29Z 2003-12-13T08:29:29-04:00 Mark Pilgrim http://example.org/ f8dy@example.com Sam Ruby Joe Gregorio

[Update: The Atom draft is finished.]

EOT my $feed = XML::FeedPP->new( $sample ); ok( $feed->isa( 'XML::FeedPP::Atom::Atom10' ), 'XML::FeedPP::Atom::Atom10' ); is( $feed->title, 'dive into mark', 'feed title' ); like( $feed->description, qr/effortless/, 'feed description' ); my $desc = $feed->description; print "[$desc]\n"; is( $feed->pubDate, '2005-07-31T12:29:29Z', 'feed pubDate' ); # is( $feed->guid, 'tag:example.org,2003:3', 'feed guid' ); is( $feed->link, 'http://example.org/', 'feed link' ); is( $feed->copyright, 'Copyright (c) 2003, Mark Pilgrim', 'feed copyright' ); my @entry = $feed->get_item; is( scalar(@entry), 1, 'feed get_item' ); my $item = shift @entry; is( $item->title, 'Atom draft-07 snapshot', 'item title' ); is( $item->link, 'http://example.org/2005/04/02/atom', 'item link' ); is( $item->guid, 'tag:example.org,2003:3.2397', 'item guid' ); is( $item->pubDate, '2005-07-31T12:29:29Z', 'item pubDate' ); is( $item->author, 'Mark Pilgrim', 'item author' ); $desc = $item->description; print "[$desc]\n"; use Data::Dumper; print Dumper($desc); } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- XML-FeedPP-0.43/t/20_limit_item.t0000644000076400007640000000445611561507340015515 0ustar u-sukeu-suke# ---------------------------------------------------------------- use strict; use Test::More tests => 40; BEGIN { use_ok('XML::FeedPP') }; # ---------------------------------------------------------------- my $link1 = "http://www.kawa.net/"; my $link2 = "http://www.youtube.com/user/YusukeKawasaki"; my $link3 = "http://picasaweb.google.com/www.kawa.net/"; my $link4 = "http://kawanet.blogspot.com/"; my $link5 = "http://del.icio.us/kawa.net"; # ---------------------------------------------------------------- my $feed1 = XML::FeedPP::RSS->new(); my $feed2 = XML::FeedPP::RDF->new(); my $feed3 = XML::FeedPP::Atom->new(); # ---------------------------------------------------------------- my $links = [ $link1, $link2, $link3, $link4, $link5 ]; # ---------------------------------------------------------------- foreach my $f ( $feed1, $feed2, $feed3 ) { my $mode = ( (ref $f) =~ /([^:]+)$/ )[0]; foreach my $u ( @$links ) { $f->add_item( $u ); } $f->limit_item( 4 ); is( scalar $f->get_item(), 4, "$mode limit_item 4 count" ); is( $f->get_item(0)->link(), $link1, "$mode limit_item 4 link 0" ); is( $f->get_item(3)->link(), $link4, "$mode limit_item 4 link 3" ); $f->limit_item( -3 ); is( scalar $f->get_item(), 3, "$mode limit_recent_item 3 count" ); is( $f->get_item(0)->link(), $link2, "$mode limit_recent_item 3 link 0" ); is( $f->get_item(2)->link(), $link4, "$mode limit_recent_item 3 link 2" ); $f->limit_item( 2 ); is( scalar $f->get_item(), 2, "$mode limit_item 2 count" ); is( $f->get_item(0)->link(), $link2, "$mode limit_item 2 link 0" ); is( $f->get_item(1)->link(), $link3, "$mode limit_item 2 link 1" ); $f->limit_item( -1 ); is( scalar $f->get_item(), 1, "$mode limit_recent_item 1 count" ); is( $f->get_item(0)->link(), $link3, "$mode limit_recent_item 1 link 0" ); $f->limit_item( 10 ); is( scalar $f->get_item(), 1, "$mode limit_item 10 count" ); $f->limit_item( -10 ); is( scalar $f->get_item(), 1, "$mode limit_recent_item 10 count" ); } # ---------------------------------------------------------------- ;1; # ----------------------------------------------------------------