lib/XML/Feed/Format/RSS.pm

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