lib/XML/Feed.pm

   1 # $Id$
   2
   3 package XML::Feed;
   4 use strict;
   5
   6 use base qw( Class::ErrorHandler );
   7 use Feed::Find;
   8 use URI::Fetch;
   9 use LWP::UserAgent;
  10 use Carp;
  11 use Module::Pluggable search_path => "XML::Feed::Format",
  12                       require     => 1,
  13                       sub_name    => 'formatters';
  14
  15 our $VERSION = '0.43';
  16 our $MULTIPLE_ENCLOSURES = 0;
  17 our @formatters;
  18 BEGIN {
  19         @formatters = __PACKAGE__->formatters;
  20 }
  21
  22 sub new {
  23     my $class = shift;
  24     my $format = shift || 'Atom';
  25     my $format_class = 'XML::Feed::Format::' . $format;
  26     eval "use $format_class";
  27     Carp::croak("Unsupported format $format: $@") if $@;
  28     my $feed = bless {}, join('::', __PACKAGE__, "Format", $format);
  29     $feed->init_empty(@_) or return $class->error($feed->errstr);
  30     $feed;
  31 }
  32
  33 sub init_empty { 1 }
  34
  35 sub parse {
  36     my $class = shift;
  37     my($stream, $specified_format) = @_;
  38     return $class->error("Stream parameter is required") unless $stream;
  39     my $feed = bless {}, $class;
  40     my $xml = '';
  41     if (UNIVERSAL::isa($stream, 'URI')) {
  42         my $ua  = LWP::UserAgent->new;
  43         $ua->env_proxy; # force allowing of proxies
  44         my $res = URI::Fetch->fetch($stream, UserAgent => $ua)
  45             or return $class->error(URI::Fetch->errstr);
  46         return $class->error("This feed has been permanently removed")
  47             if $res->status == URI::Fetch::URI_GONE();
  48         $xml = $res->content;
  49     } elsif (ref($stream) eq 'SCALAR') {
  50         $xml = $$stream;
  51     } elsif (ref($stream)) {
  52         while (read($stream, my($chunk), 8192)) {
  53             $xml .= $chunk;
  54         }
  55     } else {
  56         open my $fh, $stream
  57             or return $class->error("Can't open $stream: $!");
  58         while (read $fh, my($chunk), 8192) {
  59             $xml .= $chunk;
  60         }
  61         close $fh;
  62     }
  63     return $class->error("Can't get feed XML content from $stream")
  64         unless $xml;
  65     my $format;
  66     if ($specified_format) {
  67         $format = $specified_format;
  68     } else {
  69         $format = $feed->identify_format(\$xml) or return $class->error($feed->errstr);
  70     }
  71
  72     my $format_class = join '::', __PACKAGE__, "Format", $format;
  73     eval "use $format_class";
  74     return $class->error("Unsupported format $format: $@") if $@;
  75     bless $feed, $format_class;
  76     $feed->init_string(\$xml) or return $class->error($feed->errstr);
  77     $feed;
  78 }
  79
  80 sub identify_format {
  81     my $feed   = shift;
  82     my($xml)   = @_;
  83         foreach my $class (@formatters) {
  84                 my ($name) = ($class =~ m!([^:]+)$!);
  85                 # TODO ugly
  86                 my $tmp = $$xml;
  87                 return $name if eval { $class->identify(\$tmp) };
  88                 return $feed->error($@) if $@;
  89         }
  90         return $feed->error("Cannot detect feed type");
  91 }
  92
  93 sub _get_first_tag {
  94         my $class  = shift;
  95         my ($xml)  = @_;
  96
  97
  98     ## Auto-detect feed type based on first element. This is prone
  99     ## to breakage, but then again we don't want to parse the whole
 100     ## feed ourselves.
 101     my $tag;
 102     while ($$xml =~ /<(\S+)/sg) {
 103         (my $t = $1) =~ tr/a-zA-Z0-9:\-\?!//cd;
 104         my $first = substr $t, 0, 1;
 105         $tag = $t, last unless $first eq '?' || $first eq '!';
 106     }
 107         die ("Cannot find first element") unless $tag;
 108     $tag =~ s/^.*://;
 109         return $tag;
 110 }
 111
 112 sub find_feeds {
 113     my $class = shift;
 114     my($uri) = @_;
 115     my @feeds = Feed::Find->find($uri)
 116         or return $class->error(Feed::Find->errstr);
 117     @feeds;
 118 }
 119
 120 sub convert {
 121     my $feed = shift;
 122     my($format) = @_;
 123     my $new = XML::Feed->new($format);
 124     for my $field (qw( title link description language author copyright modified generator )) {
 125         my $val = $feed->$field();
 126         next unless defined $val;
 127         $new->$field($val);
 128     }
 129     for my $entry ($feed->entries) {
 130         $new->add_entry($entry->convert($format));
 131     }
 132     $new;
 133 }
 134
 135 sub splice {
 136     my $feed = shift;
 137     my($other) = @_;
 138     my %ids = map { $_->id => 1 } $feed->entries;
 139     for my $entry ($other->entries) {
 140         $feed->add_entry($entry) unless $ids{$entry->id}++;
 141     }
 142 }
 143
 144 sub _convert_entry {
 145     my $feed   = shift;
 146     my $entry  = shift;
 147     my $feed_format  = ref($feed);   $feed_format  =~ s!^XML::Feed::Format::!!;
 148     my $entry_format = ref($entry);  $entry_format =~ s!^XML::Feed::Entry::Format::!!;
 149     return $entry if $entry_format eq $feed_format;
 150     return $entry->convert($feed_format);
 151 }
 152
 153 sub base;
 154 sub format;
 155 sub title;
 156 sub link;
 157 sub self_link;
 158 sub description;
 159 sub language;
 160 sub author;
 161 sub copyright;
 162 sub modified;
 163 sub generator;
 164 sub add_entry;
 165 sub entries;
 166 sub as_xml;
 167 sub id;
 168
 169 sub tagline { shift->description(@_) }
 170 sub items   { $_[0]->entries     }
 171
 172 1;
 173 __END__
 174
 175 =head1 NAME
 176
 177 XML::Feed - Syndication feed parser and auto-discovery
 178
 179 =head1 SYNOPSIS
 180
 181     use XML::Feed;
 182     my $feed = XML::Feed->parse(URI->new('http://example.com/atom.xml'))
 183         or die XML::Feed->errstr;
 184     print $feed->title, "\n";
 185     for my $entry ($feed->entries) {
 186     }
 187
 188     ## Find all of the syndication feeds on a given page, using
 189     ## auto-discovery.
 190     my @feeds = XML::Feed->find_feeds('http://example.com/');
 191
 192 =head1 DESCRIPTION
 193
 194 I<XML::Feed> is a syndication feed parser for both RSS and Atom feeds. It
 195 also implements feed auto-discovery for finding feeds, given a URI.
 196
 197 I<XML::Feed> supports the following syndication feed formats:
 198
 199 =over 4
 200
 201 =item * RSS 0.91
 202
 203 =item * RSS 1.0
 204
 205 =item * RSS 2.0
 206
 207 =item * Atom
 208
 209 =back
 210
 211 The goal of I<XML::Feed> is to provide a unified API for parsing and using
 212 the various syndication formats. The different flavors of RSS and Atom
 213 handle data in different ways: date handling; summaries and content;
 214 escaping and quoting; etc. This module attempts to remove those differences
 215 by providing a wrapper around the formats and the classes implementing
 216 those formats (I<XML::RSS> and I<XML::Atom::Feed>). For example, dates are
 217 handled differently in each of the above formats. To provide a unified API for
 218 date handling, I<XML::Feed> converts all date formats transparently into
 219 I<DateTime> objects, which it then returns to the caller.
 220
 221 =head1 USAGE
 222
 223 =head2 XML::Feed->new($format)
 224
 225 Creates a new empty I<XML::Feed> object using the format I<$format>.
 226
 227     $feed = XML::Feed->new('Atom');
 228     $feed = XML::Feed->new('RSS');
 229     $feed = XML::Feed->new('RSS', version => '0.91');
 230
 231 =head2 XML::Feed->parse($stream)
 232
 233 =head2 XML::Feed->parse($stream, $format)
 234
 235 Parses a syndication feed identified by I<$stream>. I<$stream> can be any
 236 one of the following:
 237
 238 =over 4
 239
 240 =item * Scalar reference
 241
 242 A reference to string containing the XML body of the feed.
 243
 244 =item * Filehandle
 245
 246 An open filehandle from which the feed XML will be read.
 247
 248 =item * File name
 249
 250 The name of a file containing the feed XML.
 251
 252 =item * URI object
 253
 254 A URI from which the feed XML will be retrieved.
 255
 256 =back
 257
 258 I<$format> allows you to override format guessing.
 259
 260 =head2 XML::Feed->find_feeds($uri)
 261
 262 Given a URI I<$uri>, use auto-discovery to find all of the feeds linked
 263 from that page (using I<E<lt>linkE<gt>> tags).
 264
 265 Returns a list of feed URIs.
 266
 267 =head2 XML::Feed->identify_format($xml)
 268
 269 Given the xml of a feed return what format it is in (C<Atom>, or some version of C<RSS>).
 270
 271 =head2 $feed->convert($format)
 272
 273 Converts the I<XML::Feed> object into the I<$format> format, and returns
 274 the new object.
 275
 276 =head2 $feed->splice($other_feed)
 277
 278 Splices in all of the entries from the feed I<$other_feed> into I<$feed>,
 279 skipping posts that are already in I<$feed>.
 280
 281 =head2 $feed->format
 282
 283 Returns the format of the feed (C<Atom>, or some version of C<RSS>).
 284
 285 =head2 $feed->title([ $title ])
 286
 287 The title of the feed/channel.
 288
 289 =head2 $feed->base([ $base ])
 290
 291 The url base of the feed/channel.
 292
 293 =head2 $feed->link([ $uri ])
 294
 295 The permalink of the feed/channel.
 296
 297 =head2 $feed->tagline([ $tagline ])
 298
 299 The description or tagline of the feed/channel.
 300
 301 =head2 $feed->description([ $description ])
 302
 303 Alias for I<$feed-E<gt>tagline>.
 304
 305 =head2 $feed->author([ $author ])
 306
 307 The author of the feed/channel.
 308
 309 =head2 $feed->language([ $language ])
 310
 311 The language of the feed.
 312
 313 =head2 $feed->copyright([ $copyright ])
 314
 315 The copyright notice of the feed.
 316
 317 =head2 $feed->modified([ $modified ])
 318
 319 A I<DateTime> object representing the last-modified date of the feed.
 320
 321 If present, I<$modified> should be a I<DateTime> object.
 322
 323 =head2 $feed->generator([ $generator ])
 324
 325 The generator of the feed.
 326
 327 =head2 $feed->self_link ([ $uri ])
 328
 329 The Atom Self-link of the feed:
 330
 331 L<http://validator.w3.org/feed/docs/warning/MissingAtomSelfLink.html>
 332
 333 A string.
 334
 335 =head2 $feed->entries
 336
 337 A list of the entries/items in the feed. Returns an array containing
 338 I<XML::Feed::Entry> objects.
 339
 340 =head2 $feed->items
 341
 342 A synonym for I<$feed->entries>.
 343
 344 =head2 $feed->add_entry($entry)
 345
 346 Adds an entry to the feed. I<$entry> should be an I<XML::Feed::Entry>
 347 object in the correct format for the feed.
 348
 349 =head2 $feed->as_xml
 350
 351 Returns an XML representation of the feed, in the format determined by
 352 the current format of the I<$feed> object.
 353
 354 =head1 PACKAGE VARIABLES
 355
 356 =over 4
 357
 358 =item C<$XML::Feed::RSS::PREFERRED_PARSER>
 359
 360 If you want to use another RSS parser class than XML::RSS (default), you can
 361 change the class by setting C<$PREFERRED_PARSER> variable in XML::Feed::RSS
 362 package.
 363
 364     $XML::Feed::RSS::PREFERRED_PARSER = "XML::RSS::LibXML";
 365
 366 B<Note:> this will only work for parsing feeds, not creating feeds.
 367
 368 B<Note:> Only C<XML::RSS::LibXML> version 0.3004 is known to work at the moment.
 369
 370 =item C<$XML::Feed::MULTIPLE_ENCLOSURES>
 371
 372 Although the RSS specification states that there can be at most one enclosure per item
 373 some feeds break this rule.
 374
 375 If this variable is set then C<XML::Feed> captures all of them and makes them available as a list.
 376
 377 Otherwise it returns the last enclosure parsed.
 378
 379 B<Note:> C<XML::RSS> version 1.44 is needed for this to work.
 380
 381 =back
 382
 383 =cut
 384
 385 =head1 VALID FEEDS
 386
 387 For reference, this cgi script will create valid, albeit nonsensical feeds
 388 (according to C<http://feedvalidator.org> anyway) for Atom 1.0 and RSS 0.90,
 389 0.91, 1.0 and 2.0.
 390
 391     #!perl -w
 392
 393     use strict;
 394     use CGI;
 395     use CGI::Carp qw(fatalsToBrowser);
 396     use DateTime;
 397     use XML::Feed;
 398
 399     my $cgi  = CGI->new;
 400     my @args = ( $cgi->param('format') || "Atom" );
 401     push @args, ( version => $cgi->param('version') ) if $cgi->param('version');
 402
 403     my $feed = XML::Feed->new(@args);
 404     $feed->id("http://".time.rand()."/");
 405     $feed->title('Test Feed');
 406     $feed->link($cgi->url);
 407     $feed->self_link($cgi->url( -query => 1, -full => 1, -rewrite => 1) );
 408     $feed->modified(DateTime->now);
 409
 410     my $entry = XML::Feed::Entry->new();
 411     $entry->id("http://".time.rand()."/");
 412     $entry->link("http://example.com");
 413     $entry->title("Test entry");
 414     $entry->summary("Test summary");
 415     $entry->content("Foo");
 416     $entry->modified(DateTime->now);
 417     $entry->author('test@example.com (Testy McTesterson)');
 418     $feed->add_entry($entry);
 419
 420     my $mime = ("Atom" eq $feed->format) ? "application/atom+xml" : "application/rss+xml";
 421     print $cgi->header($mime);
 422     print $feed->as_xml;
 423
 424
 425 =head1 LICENSE
 426
 427 I<XML::Feed> is free software; you may redistribute it and/or modify it
 428 under the same terms as Perl itself.
 429
 430 =head1 AUTHOR & COPYRIGHT
 431
 432 Except where otherwise noted, I<XML::Feed> is Copyright 2004-2008
 433 Six Apart, cpan@sixapart.com. All rights reserved.
 434
 435 =head1 SUBVERSION
 436
 437 The latest version of I<XML::Feed> can be found at
 438
 439     http://code.sixapart.com/svn/XML-Feed/trunk/
 440
 441 =cut