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
  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);
  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     }
 146     @entries;
 147 }
 148
 149 sub add_entry {
 150     my $feed  = shift;
 151     my $entry = shift || return;
 152     $entry    = $feed->_convert_entry($entry);
 153     $feed->{rss}->add_item(%{ $entry->unwrap });
 154 }
 155
 156 sub as_xml { $_[0]->{rss}->as_string }
 157
 158 package XML::Feed::Entry::Format::RSS;
 159 use strict;
 160
 161 use XML::Feed::Content;
 162
 163 use base qw( XML::Feed::Entry );
 164
 165 sub init_empty { $_[0]->{entry} = { } }
 166
 167 sub base {
 168     my $entry = shift;
 169     @_ ? $entry->{entry}->{'xml:base'} = $_[0] : $entry->{entry}->{'xml:base'};
 170 }
 171
 172 sub title {
 173     my $entry = shift;
 174     @_ ? $entry->{entry}{title} = $_[0] : $entry->{entry}{title};
 175 }
 176
 177 sub link {
 178     my $entry = shift;
 179     if (@_) {
 180         $entry->{entry}{link} = $_[0];
 181         ## For RSS 2.0 output from XML::RSS. Sigh.
 182         $entry->{entry}{permaLink} = $_[0];
 183     } else {
 184         $entry->{entry}{link} || $entry->{entry}{guid};
 185     }
 186 }
 187
 188 sub summary {
 189     my $item = shift->{entry};
 190     if (@_) {
 191         $item->{description} = ref($_[0]) eq 'XML::Feed::Content' ?
 192             $_[0]->body : $_[0];
 193         ## Because of the logic below, we need to add some dummy content,
 194         ## so that we'll properly recognize the description we enter as
 195         ## the summary.
 196         if (!$item->{content}{encoded} &&
 197             !$item->{'http://www.w3.org/1999/xhtml'}{body}) {
 198             $item->{content}{encoded} = ' ';
 199         }
 200     } else {
 201         ## Some RSS feeds use <description> for a summary, and some use it
 202         ## for the full content. Pretty gross. We don't want to return the
 203         ## full content if the caller expects a summary, so the heuristic is:
 204         ## if the <entry> contains both a <description> and one of the elements
 205         ## typically used for the full content, use <description> as summary.
 206         my $txt;
 207         if ($item->{description} &&
 208             ($item->{content}{encoded} ||
 209              $item->{'http://www.w3.org/1999/xhtml'}{body})) {
 210             $txt = $item->{description};
 211         }
 212         XML::Feed::Content->wrap({ type => 'text/plain', body => $txt });
 213     }
 214 }
 215
 216 sub content {
 217     my $item = shift->{entry};
 218     if (@_) {
 219         my $c;
 220         if (ref($_[0]) eq 'XML::Feed::Content') {
 221             if (defined $_[0]->base) {
 222                 $c = { 'content' => $_[0]->body, 'xml:base' => $_[0]->base };
 223             } else {
 224                 $c = $_[0]->body;
 225             }
 226         } else {
 227             $c = $_[0];
 228         }
 229         $item->{content}{encoded} = $c;
 230     } else {
 231         my $base;
 232         my $body =
 233             $item->{content}{encoded} ||
 234             $item->{'http://www.w3.org/1999/xhtml'}{body} ||
 235             $item->{description};
 236         if ('HASH' eq ref($body)) {
 237             $base = $body->{'xml:base'};
 238             $body = $body->{content};
 239         }
 240         XML::Feed::Content->wrap({ type => 'text/html', body => $body, base => $base });
 241     }
 242 }
 243
 244 sub category {
 245     my $item = shift->{entry};
 246     if (@_) {
 247         $item->{category} = $item->{dc}{subject} = $_[0];
 248     } else {
 249         $item->{category} || $item->{dc}{subject};
 250     }
 251 }
 252
 253 sub author {
 254     my $item = shift->{entry};
 255     if (@_) {
 256         $item->{author} = $item->{dc}{creator} = $_[0];
 257     } else {
 258         $item->{author} || $item->{dc}{creator};
 259     }
 260 }
 261
 262 ## XML::RSS doesn't give us access to the rdf:about for the <item>,
 263 ## so we have to fall back to the <link> element in RSS 1.0 feeds.
 264 sub id {
 265     my $item = shift->{entry};
 266     if (@_) {
 267         $item->{guid} = $_[0];
 268     } else {
 269         $item->{guid} || $item->{link};
 270     }
 271 }
 272
 273 sub issued {
 274     my $item = shift->{entry};
 275     if (@_) {
 276         $item->{dc}{date} = DateTime::Format::W3CDTF->format_datetime($_[0]);
 277         $item->{pubDate} = DateTime::Format::Mail->format_datetime($_[0]);
 278     } else {
 279         ## Either of these could die if the format is invalid.
 280         my $date;
 281         eval {
 282             if (my $ts = $item->{pubDate}) {
 283                 my $parser = DateTime::Format::Mail->new;
 284                 $parser->loose;
 285                 $date = $parser->parse_datetime($ts);
 286             } elsif ($ts = $item->{dc}{date}) {
 287                 $date = DateTime::Format::W3CDTF->parse_datetime($ts);
 288             }
 289         };
 290         return $date;
 291     }
 292 }
 293
 294 sub modified {
 295     my $item = shift->{entry};
 296     if (@_) {
 297         $item->{dcterms}{modified} =
 298             DateTime::Format::W3CDTF->format_datetime($_[0]);
 299     } else {
 300         if (my $ts = $item->{dcterms}{modified}) {
 301             return eval { DateTime::Format::W3CDTF->parse_datetime($ts) };
 302         }
 303     }
 304 }
 305
 306 sub lat {
 307     my $item = shift->{entry};
 308     if (@_) {
 309         $item->{geo}{lat} = $_[0];
 310     } else {
 311         return $item->{geo}{lat};
 312     }
 313 }
 314
 315 sub long {
 316     my $item = shift->{entry};
 317     if (@_) {
 318         $item->{geo}{long} = $_[0];
 319     } else {
 320          return $item->{geo}{long};
 321     }
 322 }
 323
 324
 325 1;