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