lib/XML/Feed/RSS.pm

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