lib/XML/Feed/Format/RSS.pm

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