Added tests for bug 73160. And code to make them pass.
[catagits/XML-Feed.git] / lib / XML / Feed / Format / RSS.pm
CommitLineData
3353d70c 1# $Id$
0d5e38d1 2
729cd7a8 3package XML::Feed::Format::RSS;
0d5e38d1 4use strict;
5
6use base qw( XML::Feed );
0d5e38d1 7use DateTime::Format::Mail;
8use DateTime::Format::W3CDTF;
723eaa15 9use XML::Atom::Util qw(iso2dt);
7b5fccb1 10use XML::Feed::Enclosure;
0d5e38d1 11
973e1f9e 12our $PREFERRED_PARSER = "XML::RSS";
13
9b6bc912 14
15sub identify {
16 my $class = shift;
17 my $xml = shift;
18 my $tag = $class->_get_first_tag($xml);
19 return ($tag eq 'rss' || $tag eq 'RDF');
20}
21
973e1f9e 22sub init_empty {
4e9c4625 23 my ($feed, %args) = @_;
24 $args{'version'} ||= '2.0';
973e1f9e 25 eval "use $PREFERRED_PARSER"; die $@ if $@;
4e9c4625 26 $feed->{rss} = $PREFERRED_PARSER->new(%args);
fe3b3201 27 $feed->{rss}->add_module(prefix => "content", uri => 'http://purl.org/rss/1.0/modules/content/');
813f78d8 28 $feed->{rss}->add_module(prefix => "dcterms", uri => 'http://purl.org/dc/terms/');
9a36f82c 29 $feed->{rss}->add_module(prefix => "atom", uri => 'http://www.w3.org/2005/Atom');
30 $feed->{rss}->add_module(prefix => "geo", uri => 'http://www.w3.org/2003/01/geo/wgs84_pos#');
973e1f9e 31 $feed;
32}
33
0d5e38d1 34sub init_string {
35 my $feed = shift;
36 my($str) = @_;
973e1f9e 37 $feed->init_empty;
b1aa7a62 38 my $opts = {
39 hashrefs_instead_of_strings => 1,
40 };
41 $opts->{allow_multiple} = [ 'enclosure' ] if $XML::Feed::MULTIPLE_ENCLOSURES;
0d5e38d1 42 if ($str) {
b1aa7a62 43 $feed->{rss}->parse($$str, $opts );
0d5e38d1 44 }
45 $feed;
46}
47
48sub format { 'RSS ' . $_[0]->{rss}->{'version'} }
49
50## The following elements are the same in all versions of RSS.
973e1f9e 51sub title { shift->{rss}->channel('title', @_) }
710ed823 52sub link {
53 my $link = shift->{rss}->channel('link', @_);
54 $link =~ s/^\s+//;
55 $link =~ s/\s+$//;
56 return $link;
57}
973e1f9e 58sub description { shift->{rss}->channel('description', @_) }
e23387f1 59sub updated { shift->modified(@_) }
0d5e38d1 60
813f78d8 61# This doesn't exist in RSS
62sub id { }
63
0d5e38d1 64## This is RSS 2.0 only--what's the equivalent in RSS 1.0?
973e1f9e 65sub copyright { shift->{rss}->channel('copyright', @_) }
0d5e38d1 66
5383a560 67sub base {
68 my $feed = shift;
69 if (@_) {
70 $feed->{rss}->{'xml:base'} = $_[0];
71 } else {
72 $feed->{rss}->{'xml:base'};
73 }
74}
75
0d5e38d1 76## The following all work transparently in any RSS version.
77sub language {
973e1f9e 78 my $feed = shift;
79 if (@_) {
80 $feed->{rss}->channel('language', $_[0]);
81 $feed->{rss}->channel->{dc}{language} = $_[0];
82 } else {
83 $feed->{rss}->channel('language') ||
84 $feed->{rss}->channel->{dc}{language};
85 }
0d5e38d1 86}
87
9a36f82c 88sub self_link {
89 my $feed = shift;
90
91 if (@_) {
92 my $uri = shift;
93
94 $feed->{rss}->channel->{'atom'}{'link'} =
95 {
96 rel => "self",
97 href => $uri,
98 type => "application/rss+xml",
99 };
100 }
101
102 return $feed->{rss}->channel->{'atom'}{'link'};
103}
104
105
0d5e38d1 106sub generator {
973e1f9e 107 my $feed = shift;
108 if (@_) {
109 $feed->{rss}->channel('generator', $_[0]);
110 $feed->{rss}->channel->{'http://webns.net/mvcb/'}{generatorAgent} =
111 $_[0];
112 } else {
113 $feed->{rss}->channel('generator') ||
114 $feed->{rss}->channel->{'http://webns.net/mvcb/'}{generatorAgent};
115 }
0d5e38d1 116}
117
118sub author {
973e1f9e 119 my $feed = shift;
120 if (@_) {
121 $feed->{rss}->channel('webMaster', $_[0]);
122 $feed->{rss}->channel->{dc}{creator} = $_[0];
123 } else {
124 $feed->{rss}->channel('webMaster') ||
125 $feed->{rss}->channel->{dc}{creator};
126 }
0d5e38d1 127}
128
129sub modified {
973e1f9e 130 my $rss = shift->{rss};
131 if (@_) {
132 $rss->channel('pubDate',
133 DateTime::Format::Mail->format_datetime($_[0]));
134 ## XML::RSS is so weird... if I set this, it will try to use
135 ## the value for the lastBuildDate, which I don't want--because
136 ## this date is formatted for an RSS 1.0 feed. So it's commented out.
137 #$rss->channel->{dc}{date} =
138 # DateTime::Format::W3CDTF->format_datetime($_[0]);
fe3b3201 139 } else {
140 my $date;
141 eval {
142 if (my $ts = $rss->channel('pubDate')) {
710ed823 143 $ts =~ s/^\s+//;
144 $ts =~ s/\s+$//;
fe3b3201 145 $date = DateTime::Format::Mail->parse_datetime($ts);
146 } elsif ($ts = $rss->channel->{dc}{date}) {
710ed823 147 $ts =~ s/^\s+//;
148 $ts =~ s/\s+$//;
fe3b3201 149 $date = DateTime::Format::W3CDTF->parse_datetime($ts);
150 }
151 };
152 return $date;
0d5e38d1 153 }
154}
155
156sub entries {
157 my $rss = $_[0]->{rss};
158 my @entries;
159 for my $item (@{ $rss->{items} }) {
729cd7a8 160 push @entries, XML::Feed::Entry::Format::RSS->wrap($item);
3bdbab6f 161 $entries[-1]->{_version} = $rss->{'version'};
0d5e38d1 162 }
163 @entries;
164}
165
973e1f9e 166sub add_entry {
33d4cb3f 167 my $feed = shift;
168 my $entry = shift || return;
169 $entry = $feed->_convert_entry($entry);
973e1f9e 170 $feed->{rss}->add_item(%{ $entry->unwrap });
171}
172
173sub as_xml { $_[0]->{rss}->as_string }
174
729cd7a8 175package XML::Feed::Entry::Format::RSS;
0d5e38d1 176use strict;
177
3bdbab6f 178sub format { 'RSS ' . $_[0]->{'_version'} }
179
a749d9b9 180use XML::Feed::Content;
181
0d5e38d1 182use base qw( XML::Feed::Entry );
183
973e1f9e 184sub init_empty { $_[0]->{entry} = { } }
185
5383a560 186sub base {
187 my $entry = shift;
188 @_ ? $entry->{entry}->{'xml:base'} = $_[0] : $entry->{entry}->{'xml:base'};
189}
190
973e1f9e 191sub title {
192 my $entry = shift;
193 @_ ? $entry->{entry}{title} = $_[0] : $entry->{entry}{title};
194}
195
196sub link {
197 my $entry = shift;
198 if (@_) {
199 $entry->{entry}{link} = $_[0];
200 ## For RSS 2.0 output from XML::RSS. Sigh.
201 $entry->{entry}{permaLink} = $_[0];
202 } else {
710ed823 203 my $link = $entry->{entry}{link} ||
204 $entry->{entry}{permaLink} ||
205 $entry->{entry}{guid};
206 $link =~ s/^\s+//;
207 $link =~ s/\s+$//;
208
973e1f9e 209 }
210}
a749d9b9 211
212sub summary {
973e1f9e 213 my $item = shift->{entry};
214 if (@_) {
215 $item->{description} = ref($_[0]) eq 'XML::Feed::Content' ?
216 $_[0]->body : $_[0];
217 ## Because of the logic below, we need to add some dummy content,
218 ## so that we'll properly recognize the description we enter as
219 ## the summary.
fe3b3201 220 if (!$item->{content}{encoded} &&
973e1f9e 221 !$item->{'http://www.w3.org/1999/xhtml'}{body}) {
fe3b3201 222 $item->{content}{encoded} = ' ';
973e1f9e 223 }
224 } else {
225 ## Some RSS feeds use <description> for a summary, and some use it
226 ## for the full content. Pretty gross. We don't want to return the
227 ## full content if the caller expects a summary, so the heuristic is:
228 ## if the <entry> contains both a <description> and one of the elements
229 ## typically used for the full content, use <description> as summary.
230 my $txt;
231 if ($item->{description} &&
fe3b3201 232 ($item->{content}{encoded} ||
973e1f9e 233 $item->{'http://www.w3.org/1999/xhtml'}{body})) {
234 $txt = $item->{description};
723eaa15 235 ## Blogspot's 'short' RSS feeds do this in the Atom namespace
236 ## for no obviously good reason.
237 } elsif ($item->{'http://www.w3.org/2005/Atom'}{summary}) {
238 $txt = $item->{'http://www.w3.org/2005/Atom'}{summary};
973e1f9e 239 }
240 XML::Feed::Content->wrap({ type => 'text/plain', body => $txt });
a749d9b9 241 }
a749d9b9 242}
0d5e38d1 243
244sub content {
973e1f9e 245 my $item = shift->{entry};
246 if (@_) {
e3b96b9c 247 my $c;
248 if (ref($_[0]) eq 'XML::Feed::Content') {
249 if (defined $_[0]->base) {
250 $c = { 'content' => $_[0]->body, 'xml:base' => $_[0]->base };
251 } else {
252 $c = $_[0]->body;
253 }
254 } else {
255 $c = $_[0];
256 }
fe3b3201 257 $item->{content}{encoded} = $c;
973e1f9e 258 } else {
7c89ffff 259 my $base;
973e1f9e 260 my $body =
fe3b3201 261 $item->{content}{encoded} ||
973e1f9e 262 $item->{'http://www.w3.org/1999/xhtml'}{body} ||
e3b96b9c 263 $item->{description};
264 if ('HASH' eq ref($body)) {
265 $base = $body->{'xml:base'};
266 $body = $body->{content};
267 }
7c89ffff 268 XML::Feed::Content->wrap({ type => 'text/html', body => $body, base => $base });
973e1f9e 269 }
0d5e38d1 270}
271
272sub category {
a0cca2a4 273 my $entry = shift;
274 my $item = $entry->{entry};
973e1f9e 275 if (@_) {
a0cca2a4 276 my @tmp = ($entry->category, @_);
277 $item->{category} = [@tmp];
278 $item->{dc}{subject} = [@tmp];
973e1f9e 279 } else {
a0cca2a4 280 my $r = $item->{category} || $item->{dc}{subject};
e5a65e5e 281 my @r = ref($r) eq 'ARRAY' ? @$r : defined $r? ($r) : ();
a0cca2a4 282 return wantarray? @r : $r[0];
973e1f9e 283 }
0d5e38d1 284}
285
286sub author {
973e1f9e 287 my $item = shift->{entry};
288 if (@_) {
289 $item->{author} = $item->{dc}{creator} = $_[0];
290 } else {
291 $item->{author} || $item->{dc}{creator};
292 }
0d5e38d1 293}
294
295## XML::RSS doesn't give us access to the rdf:about for the <item>,
296## so we have to fall back to the <link> element in RSS 1.0 feeds.
297sub id {
973e1f9e 298 my $item = shift->{entry};
299 if (@_) {
300 $item->{guid} = $_[0];
301 } else {
302 $item->{guid} || $item->{link};
303 }
0d5e38d1 304}
305
306sub issued {
973e1f9e 307 my $item = shift->{entry};
308 if (@_) {
309 $item->{dc}{date} = DateTime::Format::W3CDTF->format_datetime($_[0]);
310 $item->{pubDate} = DateTime::Format::Mail->format_datetime($_[0]);
311 } else {
ecac864a 312 ## Either of these could die if the format is invalid.
313 my $date;
314 eval {
315 if (my $ts = $item->{pubDate}) {
316 my $parser = DateTime::Format::Mail->new;
317 $parser->loose;
710ed823 318 $ts =~ s/^\s+//;
319 $ts =~ s/\s+$//;
ecac864a 320 $date = $parser->parse_datetime($ts);
daba7240 321 } elsif ($ts = $item->{dc}{date} or $ts = $item->{dcterms}{date}) {
710ed823 322 $ts =~ s/^\s+//;
323 $ts =~ s/\s+$//;
324 $date = DateTime::Format::W3CDTF->parse_datetime($ts);
ecac864a 325 }
326 };
327 return $date;
0d5e38d1 328 }
329}
330
331sub modified {
973e1f9e 332 my $item = shift->{entry};
333 if (@_) {
fe3b3201 334 $item->{dcterms}{modified} =
973e1f9e 335 DateTime::Format::W3CDTF->format_datetime($_[0]);
336 } else {
710ed823 337 if (my $ts = $item->{dcterms}{modified} ||
338 $item->{'http://www.w3.org/2005/Atom'}{updated}) {
339 $ts =~ s/^\s+//;
340 $ts =~ s/\s+$//;
723eaa15 341 return eval { DateTime::Format::W3CDTF->parse_datetime($ts) } || eval { XML::Atom::Util::iso2dt($ts) };
342 }
0d5e38d1 343 }
344}
345
9a36f82c 346sub lat {
347 my $item = shift->{entry};
348 if (@_) {
bd19b444 349 $item->{geo}{lat} = $_[0];
9a36f82c 350 } else {
bd19b444 351 return $item->{geo}{lat};
9a36f82c 352 }
353}
354
355sub long {
356 my $item = shift->{entry};
357 if (@_) {
bd19b444 358 $item->{geo}{long} = $_[0];
9a36f82c 359 } else {
bd19b444 360 return $item->{geo}{long};
9a36f82c 361 }
362}
363
12a4079f 364sub enclosure {
365 my $entry = shift;
366
367 if (@_) {
368 my $enclosure = shift;
b1aa7a62 369 my $val = {
af6b00a4 370 url => $enclosure->{url},
371 type => $enclosure->{type},
372 length => $enclosure->{length}
b1aa7a62 373 };
374 if ($XML::Feed::MULTIPLE_ENCLOSURES) {
375 push @{$entry->{entry}->{enclosure}}, $val;
376 } else {
377 $entry->{entry}->{enclosure} = $val;
378 }
12a4079f 379 } else {
b1aa7a62 380 my $tmp = $entry->{entry}->{enclosure};
7b5fccb1 381 if (defined $tmp) {
382 my @encs = map { XML::Feed::Enclosure->new($_) }
383 (ref $tmp eq 'ARRAY')? @$tmp : ($tmp);
384 return ($XML::Feed::MULTIPLE_ENCLOSURES)? @encs : $encs[-1];
385 }
386 return;
12a4079f 387 }
af6b00a4 388}
9a36f82c 389
0d5e38d1 3901;