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