r32610 - in /branches/upstream/libxml-rss-perl/current: Changes MANIFEST META.yml lib/XML/RSS.pm lib/XML/RSS/Private/Output/Base.pm t/enclosures-multi.t t/test_manifest t/xml-base.t
ryan52-guest at users.alioth.debian.org
ryan52-guest at users.alioth.debian.org
Sat Apr 4 04:00:30 UTC 2009
Author: ryan52-guest
Date: Sat Apr 4 04:00:09 2009
New Revision: 32610
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=32610
Log:
[svn-upgrade] Integrating new upstream version, libxml-rss-perl (1.44)
Added:
branches/upstream/libxml-rss-perl/current/t/enclosures-multi.t
branches/upstream/libxml-rss-perl/current/t/xml-base.t
Modified:
branches/upstream/libxml-rss-perl/current/Changes
branches/upstream/libxml-rss-perl/current/MANIFEST
branches/upstream/libxml-rss-perl/current/META.yml
branches/upstream/libxml-rss-perl/current/lib/XML/RSS.pm
branches/upstream/libxml-rss-perl/current/lib/XML/RSS/Private/Output/Base.pm
branches/upstream/libxml-rss-perl/current/t/test_manifest
Modified: branches/upstream/libxml-rss-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libxml-rss-perl/current/Changes?rev=32610&op=diff
==============================================================================
--- branches/upstream/libxml-rss-perl/current/Changes (original)
+++ branches/upstream/libxml-rss-perl/current/Changes Sat Apr 4 04:00:09 2009
@@ -1,4 +1,10 @@
Revision history for Perl module XML::RSS
+
+1.44 - April 1, 2009
+ - Applied a patch from Simon Wistow (after some modifications) to
+ add support for multiple enclosures.
+ - Added the t/xml-base.t test file from Simon Wistow to test for
+ xml:base. Corrected for style.
1.43 - January 12, 2009
- Fixed the date on the last entry on this changelog, to say "2009"
Modified: branches/upstream/libxml-rss-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libxml-rss-perl/current/MANIFEST?rev=32610&op=diff
==============================================================================
--- branches/upstream/libxml-rss-perl/current/MANIFEST (original)
+++ branches/upstream/libxml-rss-perl/current/MANIFEST Sat Apr 4 04:00:09 2009
@@ -65,6 +65,7 @@
t/data/merlyn1.rss
t/data/rss-permalink.xml
t/enclosures2.t
+t/enclosures-multi.t
t/enclosures.t
t/encode-output.t
t/encoding.t
@@ -80,4 +81,5 @@
t/test-generated-items.t
t/test_manifest
t/version.t
+t/xml-base.t
t/xml-header.t
Modified: branches/upstream/libxml-rss-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libxml-rss-perl/current/META.yml?rev=32610&op=diff
==============================================================================
--- branches/upstream/libxml-rss-perl/current/META.yml (original)
+++ branches/upstream/libxml-rss-perl/current/META.yml Sat Apr 4 04:00:09 2009
@@ -1,6 +1,6 @@
---
name: XML-RSS
-version: 1.43
+version: 1.44
author:
- 'Original code: Jonathan Eisenzopf <eisen at pobox.com>'
- |-
@@ -24,7 +24,7 @@
provides:
XML::RSS:
file: lib/XML/RSS.pm
- version: 1.43
+ version: 1.44
XML::RSS::Private::Output::Base:
file: lib/XML/RSS/Private/Output/Base.pm
XML::RSS::Private::Output::Roles::ImageDims:
@@ -39,7 +39,7 @@
file: lib/XML/RSS/Private/Output/V1_0.pm
XML::RSS::Private::Output::V2_0:
file: lib/XML/RSS/Private/Output/V2_0.pm
-generated_by: Module::Build version 0.31
+generated_by: Module::Build version 0.32
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.2.html
version: 1.2
Modified: branches/upstream/libxml-rss-perl/current/lib/XML/RSS.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libxml-rss-perl/current/lib/XML/RSS.pm?rev=32610&op=diff
==============================================================================
--- branches/upstream/libxml-rss-perl/current/lib/XML/RSS.pm (original)
+++ branches/upstream/libxml-rss-perl/current/lib/XML/RSS.pm Sat Apr 4 04:00:09 2009
@@ -17,7 +17,7 @@
use vars qw($VERSION $AUTOLOAD @ISA $AUTO_ADD);
-$VERSION = '1.43';
+$VERSION = '1.44';
$AUTO_ADD = 0;
@@ -329,6 +329,8 @@
# initialize items
$self->{items} = [];
+ delete $self->{_allow_multiple};
+
my $ok_fields = $self->_get_ok_fields();
my $ver_ok_fields =
@@ -1121,15 +1123,18 @@
}
if (keys(%attribs)) {
if ($el_verdict) {
- $self->_last_item->{$el} = \%attribs if keys %attribs;
+ $self->_last_item->{$el} =
+ $self->_make_array($el, $self->_last_item->{$el}, \%attribs);
}
else {
- $self->_last_item->{$el_ns}->{$el} = \%attribs;
+ $self->_last_item->{$el_ns}->{$el} =
+ $self->_make_array($el, $self->_last_item->{$el_ns}->{$el}, \%attribs);
my $prefix = $self->{modules}->{$el_ns};
if ($prefix) {
- $self->_last_item->{$prefix}->{$el} = \%attribs;
+ $self->_last_item->{$prefix}->{$el} =
+ $self->_make_array($el, $self->_last_item->{$prefix}->{$el}, \%attribs);
}
}
}
@@ -1153,6 +1158,38 @@
$self->{'channel'}->{$el} = "";
}
}
+}
+
+sub _make_array {
+ my $self = shift;
+ my $el = shift;
+ my $old = shift;
+ my $new = shift;
+
+ if (!$self->_allow_multiple($el)) {
+ return $new;
+ }
+
+ if (!defined $old) {
+ $old = [];
+ } elsif (ref($old) ne 'ARRAY') {
+ $old = [$old];
+ }
+ push @$old, $new;
+ return $old;
+}
+
+sub _allow_multiple {
+ my $self = shift;
+ my $el = shift;
+
+ $self->{_allow_multiple} ||=
+ {
+ map { $_ => 1 }
+ @{$self->_parse_options->{allow_multiple} || []}
+ };
+
+ return $self->{_allow_multiple}->{$el};
}
sub _handle_end {
@@ -1738,6 +1775,14 @@
=over 4
+=item * allow_multiple
+
+Takes an array ref of names which indicates which elements should
+be allowed to have multiple occurrences. So, for example, to parse
+feeds with multiple enclosures
+
+ $rss->parse($xml, { allow_multiple => ['enclosure'] });
+
=item * hashrefs_instead_of_strings
If true, then some items (so far "C<description>") will become hash-references
Modified: branches/upstream/libxml-rss-perl/current/lib/XML/RSS/Private/Output/Base.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libxml-rss-perl/current/lib/XML/RSS/Private/Output/Base.pm?rev=32610&op=diff
==============================================================================
--- branches/upstream/libxml-rss-perl/current/lib/XML/RSS/Private/Output/Base.pm (original)
+++ branches/upstream/libxml-rss-perl/current/lib/XML/RSS/Private/Output/Base.pm Sat Apr 4 04:00:09 2009
@@ -934,7 +934,7 @@
sub _out_item_source {
my ($self, $item) = @_;
-
+
if (defined $item->{source} && defined $item->{sourceUrl}) {
$self->_out('<source url="'
. $self->_encode($item->{sourceUrl}) . '">'
@@ -943,17 +943,29 @@
}
}
-sub _out_item_enclosure {
- my ($self, $item) = @_;
-
- if (my $e = $item->{enclosure}) {
+sub _out_single_item_enclosure {
+ my ($self, $item, $enc) = @_;
+
+ return
$self->_out(
"<enclosure " .
- join(' ',
- map { "$_=\"" . $self->_encode($e->{$_}) . '"' } keys(%$e)
+ join(' ',
+ map { "$_=\"" . $self->_encode($enc->{$_}) . '"' } keys(%$enc)
) .
" />\n"
);
+}
+
+sub _out_item_enclosure {
+ my ($self, $item) = @_;
+
+ if (my $enc = $item->{enclosure}) {
+ foreach my $sub (
+ (ref($enc) eq "ARRAY") ? @$enc : ($enc)
+ )
+ {
+ $self->_out_single_item_enclosure($item, $sub)
+ }
}
}
Added: branches/upstream/libxml-rss-perl/current/t/enclosures-multi.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libxml-rss-perl/current/t/enclosures-multi.t?rev=32610&op=file
==============================================================================
--- branches/upstream/libxml-rss-perl/current/t/enclosures-multi.t (added)
+++ branches/upstream/libxml-rss-perl/current/t/enclosures-multi.t Sat Apr 4 04:00:09 2009
@@ -1,0 +1,85 @@
+use strict;
+use warnings;
+
+use Test::More tests => 6;
+
+use XML::RSS;
+
+use constant RSS_VERSION => "2.0";
+use constant RSS_CHANNEL_TITLE => "Example 2.0 Channel";
+
+use constant RSS_DOCUMENT => qq(<?xml version="1.0"?>
+<rss version="2.0">
+ <channel>
+ <title>Example 2.0 Channel</title>
+ <link>http://example.com/</link>
+ <description>To lead by example</description>
+ <language>en-us</language>
+ <managingEditor>editor\@example.com</managingEditor>
+ <webMaster>webmaster\@example.com</webMaster>
+ <docs>http://backend.userland.com/rss</docs>
+ <generator>The Superest Dooperest RSS Generator</generator>
+ <lastBuildDate>Mon, 02 Sep 2002 03:19:17 GMT</lastBuildDate>
+ <ttl>60</ttl>
+
+ <item>
+ <title>News for September the Second</title>
+ <link>http://example.com/2002/09/02</link>
+ <description>other things happened today</description>
+ <comments>http://example.com/2002/09/02/comments.html</comments>
+ <author>joeuser\@example.com</author>
+ <pubDate>Mon, 02 Sep 2002 03:19:00 GMT</pubDate>
+ <guid isPermaLink="true">http://example.com/2002/09/02</guid>
+ <enclosure url="http://example.com/test.mp3" length="5352283" type="audio/mpeg" />
+ <enclosure url="http://example.com/test2.mp3" length="5352283" type="audio/mpeg" />
+ </item>
+
+ </channel>
+</rss>);
+
+
+
+{
+ my $xml = XML::RSS->new();
+ # TEST
+ isa_ok($xml,"XML::RSS");
+
+ eval { $xml->parse(RSS_DOCUMENT); };
+ # TEST
+ is($@,'',"Parsed RSS feed");
+
+ # TEST
+ is_deeply($xml->{items}->[0]->{enclosure},
+ { url => "http://example.com/test2.mp3",
+ length => "5352283",
+ type => "audio/mpeg" }, "got enclosure");
+
+}
+
+{
+ my $xml = XML::RSS->new;
+
+ eval { $xml->parse(RSS_DOCUMENT, { allow_multiple => [ 'enclosure' ] } ) };
+ # TEST
+ is($@,'',"Parsed RSS feed again");
+
+ # TEST
+ is_deeply($xml->{items}->[0]->{enclosure}->[0],
+ {
+ url => "http://example.com/test.mp3",
+ length => "5352283",
+ type => "audio/mpeg"
+ },
+ "got first enclosure"
+ );
+
+ # TEST
+ is_deeply($xml->{items}->[0]->{enclosure}->[1],
+ {
+ url => "http://example.com/test2.mp3",
+ length => "5352283",
+ type => "audio/mpeg"
+ },
+ "got second enclosure"
+ );
+}
Modified: branches/upstream/libxml-rss-perl/current/t/test_manifest
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libxml-rss-perl/current/t/test_manifest?rev=32610&op=diff
==============================================================================
--- branches/upstream/libxml-rss-perl/current/t/test_manifest (original)
+++ branches/upstream/libxml-rss-perl/current/t/test_manifest Sat Apr 4 04:00:09 2009
@@ -22,6 +22,7 @@
auto_add_modules.t
enclosures.t
enclosures2.t
+enclosures-multi.t
encode-output.t
test-generated-items.t
pod-coverage.t
@@ -30,3 +31,4 @@
xml-header.t
add-item-insert-vs-append.t
guid.t
+xml-base.t
Added: branches/upstream/libxml-rss-perl/current/t/xml-base.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libxml-rss-perl/current/t/xml-base.t?rev=32610&op=file
==============================================================================
--- branches/upstream/libxml-rss-perl/current/t/xml-base.t (added)
+++ branches/upstream/libxml-rss-perl/current/t/xml-base.t Sat Apr 4 04:00:09 2009
@@ -1,0 +1,132 @@
+use strict;
+use warnings;
+
+use Test::More tests => 13;
+
+use XML::RSS;
+
+
+sub output_contains
+{
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+ my ($rss_output, $sub_string, $msg) = @_;
+
+ my $ok = ok (index ($rss_output,
+ $sub_string) >= 0,
+ $msg
+ );
+ if (! $ok)
+ {
+ diag(
+ "Could not find the substring [$sub_string]"
+ . " in:{{{{\n$rss_output\n}}}}\n"
+ );
+ }
+ return $ok;
+}
+
+my $xml;
+
+{
+ my $rss;
+
+ $rss = XML::RSS->new( 'xml:base' => 'http://example.com' );
+
+ # TEST
+ ok ($rss, "Created new rss");
+
+ # TEST
+ is($rss->{'xml:base'}, 'http://example.com', 'Got base');
+
+ $rss->{'xml:base'} = 'http://foo.com/';
+
+ # TEST
+ ok($rss->channel(
+ title => 'Test Feed',
+ link => "http://example.com",
+ description => "Foo",
+ ), "Added channel");
+
+ # TEST
+ ok($rss->add_item(
+ title => 'foo',
+ 'xml:base' => "http://foo.com/archive/",
+ description => {
+ content => "Bar",
+ 'xml:base' => "http://foo.com/archive/1.html",
+ }
+ ), "Added item");
+
+ $xml = $rss->as_rss_2_0();
+
+ # TEST
+ ok($xml, "Got xml");
+
+ # TEST
+ output_contains(
+ $xml,
+ 'xml:base="http://foo.com/"',
+ "Found rss base"
+ );
+
+ # TEST
+ output_contains(
+ $xml,
+ 'xml:base="http://foo.com/archive/"',
+ "Found item base"
+ );
+
+ # TEST
+ output_contains(
+ $xml,
+ 'xml:base="http://foo.com/archive/1.html"',
+ "Found description base"
+ );
+}
+
+{
+ my $rss = XML::RSS->new;
+
+ # TEST
+ ok(
+ $rss->parse($xml, { hashrefs_instead_of_strings => 1 }),
+ "Reparsed xml"
+ );
+
+ # TEST
+ is(
+ $rss->{'xml:base'},
+ 'http://foo.com/',
+ "Found parsed rss base"
+ );
+
+ # TEST
+ is(
+ scalar(@{$rss->{items}}),
+ 1,
+ "Got 1 item"
+ );
+
+ my $item = $rss->{items}->[0];
+
+ # TEST
+ is(
+ $item->{'xml:base'},
+ 'http://foo.com/archive/',
+ "Found parsed item base"
+ );
+
+ {
+ if (ref $item->{description} eq 'HASH') {
+ # TEST
+ is(
+ $item->{description}->{'xml:base'},
+ 'http://foo.com/archive/1.html',
+ "Found parsed description base"
+ );
+ } else {
+ fail("Description is not a hash ref");
+ }
+ }
+}
+
More information about the Pkg-perl-cvs-commits
mailing list