lib/XML/Feed/RSS.pm

   1 # $Id: RSS.pm 1917 2006-02-07 07:11:44Z 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 = shift;
  14     eval "use $PREFERRED_PARSER"; die $@ if $@;
  15     $feed->{rss} = $PREFERRED_PARSER->new( version => '2.0' );
  16     $feed;
  17 }
  18
  19 sub init_string {
  20     my $feed = shift;
  21     my($str) = @_;
  22     $feed->init_empty;
  23     if ($str) {
  24         $feed->{rss}->parse($$str);
  25     }
  26     $feed;
  27 }
  28
  29 sub format { 'RSS ' . $_[0]->{rss}->{'version'} }
  30
  31 ## The following elements are the same in all versions of RSS.
  32 sub title       { shift->{rss}->channel('title', @_) }
  33 sub link        { shift->{rss}->channel('link', @_) }
  34 sub description { shift->{rss}->channel('description', @_) }
  35
  36 ## This is RSS 2.0 only--what's the equivalent in RSS 1.0?
  37 sub copyright   { shift->{rss}->channel('copyright', @_) }
  38
  39 ## The following all work transparently in any RSS version.
  40 sub language {
  41     my $feed = shift;
  42     if (@_) {
  43         $feed->{rss}->channel('language', $_[0]);
  44         $feed->{rss}->channel->{dc}{language} = $_[0];
  45     } else {
  46         $feed->{rss}->channel('language') ||
  47         $feed->{rss}->channel->{dc}{language};
  48     }
  49 }
  50
  51 sub generator {
  52     my $feed = shift;
  53     if (@_) {
  54         $feed->{rss}->channel('generator', $_[0]);
  55         $feed->{rss}->channel->{'http://webns.net/mvcb/'}{generatorAgent} =
  56             $_[0];
  57     } else {
  58         $feed->{rss}->channel('generator') ||
  59         $feed->{rss}->channel->{'http://webns.net/mvcb/'}{generatorAgent};
  60     }
  61 }
  62
  63 sub author {
  64     my $feed = shift;
  65     if (@_) {
  66         $feed->{rss}->channel('webMaster', $_[0]);
  67         $feed->{rss}->channel->{dc}{creator} = $_[0];
  68     } else {
  69         $feed->{rss}->channel('webMaster') ||
  70         $feed->{rss}->channel->{dc}{creator};
  71     }
  72 }
  73
  74 sub modified {
  75     my $rss = shift->{rss};
  76     if (@_) {
  77         $rss->channel('pubDate',
  78             DateTime::Format::Mail->format_datetime($_[0]));
  79         ## XML::RSS is so weird... if I set this, it will try to use
  80         ## the value for the lastBuildDate, which I don't want--because
  81         ## this date is formatted for an RSS 1.0 feed. So it's commented out.
  82         #$rss->channel->{dc}{date} =
  83         #    DateTime::Format::W3CDTF->format_datetime($_[0]);
  84     } else {
  85         if (my $ts = $rss->channel('pubDate')) {
  86             return DateTime::Format::Mail->parse_datetime($ts);
  87         } elsif ($ts = $rss->channel->{dc}{date}) {
  88             return DateTime::Format::W3CDTF->parse_datetime($ts);
  89         }
  90     }
  91 }
  92
  93 sub entries {
  94     my $rss = $_[0]->{rss};
  95     my @entries;
  96     for my $item (@{ $rss->{items} }) {
  97         push @entries, XML::Feed::Entry::RSS->wrap($item);
  98     }
  99     @entries;
 100 }
 101
 102 sub add_entry {
 103     my $feed = shift;
 104     my($entry) = @_;
 105     $feed->{rss}->add_item(%{ $entry->unwrap });
 106 }
 107
 108 sub as_xml { $_[0]->{rss}->as_string }
 109
 110 package XML::Feed::Entry::RSS;
 111 use strict;
 112
 113 use XML::Feed::Content;
 114
 115 use base qw( XML::Feed::Entry );
 116
 117 sub init_empty { $_[0]->{entry} = { } }
 118
 119 sub title {
 120     my $entry = shift;
 121     @_ ? $entry->{entry}{title} = $_[0] : $entry->{entry}{title};
 122 }
 123
 124 sub link {
 125     my $entry = shift;
 126     if (@_) {
 127         $entry->{entry}{link} = $_[0];
 128         ## For RSS 2.0 output from XML::RSS. Sigh.
 129         $entry->{entry}{permaLink} = $_[0];
 130     } else {
 131         $entry->{entry}{link} || $entry->{entry}{guid};
 132     }
 133 }
 134
 135 sub summary {
 136     my $item = shift->{entry};
 137     if (@_) {
 138         $item->{description} = ref($_[0]) eq 'XML::Feed::Content' ?
 139             $_[0]->body : $_[0];
 140         ## Because of the logic below, we need to add some dummy content,
 141         ## so that we'll properly recognize the description we enter as
 142         ## the summary.
 143         if (!$item->{'http://purl.org/rss/1.0/modules/content/'}{encoded} &&
 144             !$item->{'http://www.w3.org/1999/xhtml'}{body}) {
 145             $item->{'http://purl.org/rss/1.0/modules/content/'}{encoded} = ' ';
 146         }
 147     } else {
 148         ## Some RSS feeds use <description> for a summary, and some use it
 149         ## for the full content. Pretty gross. We don't want to return the
 150         ## full content if the caller expects a summary, so the heuristic is:
 151         ## if the <entry> contains both a <description> and one of the elements
 152         ## typically used for the full content, use <description> as summary.
 153         my $txt;
 154         if ($item->{description} &&
 155             ($item->{'http://purl.org/rss/1.0/modules/content/'}{encoded} ||
 156              $item->{'http://www.w3.org/1999/xhtml'}{body})) {
 157             $txt = $item->{description};
 158         }
 159         XML::Feed::Content->wrap({ type => 'text/plain', body => $txt });
 160     }
 161 }
 162
 163 sub content {
 164     my $item = shift->{entry};
 165     if (@_) {
 166         my $c = ref($_[0]) eq 'XML::Feed::Content' ? $_[0]->body : $_[0];
 167         $item->{'http://purl.org/rss/1.0/modules/content/'}{encoded} = $c;
 168     } else {
 169         my $body =
 170             $item->{'http://purl.org/rss/1.0/modules/content/'}{encoded} ||
 171             $item->{'http://www.w3.org/1999/xhtml'}{body} ||
 172             $item->{description};
 173         XML::Feed::Content->wrap({ type => 'text/html', body => $body });
 174     }
 175 }
 176
 177 sub category {
 178     my $item = shift->{entry};
 179     if (@_) {
 180         $item->{category} = $item->{dc}{subject} = $_[0];
 181     } else {
 182         $item->{category} || $item->{dc}{subject};
 183     }
 184 }
 185
 186 sub author {
 187     my $item = shift->{entry};
 188     if (@_) {
 189         $item->{author} = $item->{dc}{creator} = $_[0];
 190     } else {
 191         $item->{author} || $item->{dc}{creator};
 192     }
 193 }
 194
 195 ## XML::RSS doesn't give us access to the rdf:about for the <item>,
 196 ## so we have to fall back to the <link> element in RSS 1.0 feeds.
 197 sub id {
 198     my $item = shift->{entry};
 199     if (@_) {
 200         $item->{guid} = $_[0];
 201     } else {
 202         $item->{guid} || $item->{link};
 203     }
 204 }
 205
 206 sub issued {
 207     my $item = shift->{entry};
 208     if (@_) {
 209         $item->{dc}{date} = DateTime::Format::W3CDTF->format_datetime($_[0]);
 210         $item->{pubDate} = DateTime::Format::Mail->format_datetime($_[0]);
 211     } else {
 212         ## Either of these could die if the format is invalid.
 213         my $date;
 214         eval {
 215             if (my $ts = $item->{pubDate}) {
 216                 my $parser = DateTime::Format::Mail->new;
 217                 $parser->loose;
 218                 $date = $parser->parse_datetime($ts);
 219             } elsif ($ts = $item->{dc}{date}) {
 220                 $date = DateTime::Format::W3CDTF->parse_datetime($ts);
 221             }
 222         };
 223         return $date;
 224     }
 225 }
 226
 227 sub modified {
 228     my $item = shift->{entry};
 229     if (@_) {
 230         $item->{'http://purl.org/rss/1.0/modules/dcterms/'}{modified} =
 231             DateTime::Format::W3CDTF->format_datetime($_[0]);
 232     } else {
 233         if (my $ts = $item->{'http://purl.org/rss/1.0/modules/dcterms/'}{modified}) {
 234             return eval { DateTime::Format::W3CDTF->parse_datetime($ts) };
 235         }
 236     }
 237 }
 238
 239 1;