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.48';
  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 (L<XML::RSS> and L<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 L<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> and returns an
 236 I<XML::Feed> obhect. I<$stream> can be any
 237 one of the following:
 238
 239 =over 4
 240
 241 =item * Scalar reference
 242
 243 A reference to string containing the XML body of the feed.
 244
 245 =item * Filehandle
 246
 247 An open filehandle from which the feed XML will be read.
 248
 249 =item * File name
 250
 251 The name of a file containing the feed XML.
 252
 253 =item * URI object
 254
 255 A URI from which the feed XML will be retrieved.
 256
 257 =back
 258
 259 I<$format> allows you to override format guessing.
 260
 261 =head2 XML::Feed->find_feeds($uri)
 262
 263 Given a URI I<$uri>, use auto-discovery to find all of the feeds linked
 264 from that page (using I<E<lt>linkE<gt>> tags).
 265
 266 Returns a list of feed URIs.
 267
 268 =head2 XML::Feed->identify_format($xml)
 269
 270 Given the xml of a feed return what format it is in (C<Atom>, or some version of C<RSS>).
 271
 272 =head2 $feed->convert($format)
 273
 274 Converts the I<XML::Feed> object into the I<$format> format, and returns
 275 the new object.
 276
 277 =head2 $feed->splice($other_feed)
 278
 279 Splices in all of the entries from the feed I<$other_feed> into I<$feed>,
 280 skipping posts that are already in I<$feed>.
 281
 282 =head2 $feed->format
 283
 284 Returns the format of the feed (C<Atom>, or some version of C<RSS>).
 285
 286 =head2 $feed->title([ $title ])
 287
 288 The title of the feed/channel.
 289
 290 =head2 $feed->base([ $base ])
 291
 292 The url base of the feed/channel.
 293
 294 =head2 $feed->link([ $uri ])
 295
 296 The permalink of the feed/channel.
 297
 298 =head2 $feed->tagline([ $tagline ])
 299
 300 The description or tagline of the feed/channel.
 301
 302 =head2 $feed->description([ $description ])
 303
 304 Alias for I<$feed-E<gt>tagline>.
 305
 306 =head2 $feed->author([ $author ])
 307
 308 The author of the feed/channel.
 309
 310 =head2 $feed->language([ $language ])
 311
 312 The language of the feed.
 313
 314 =head2 $feed->copyright([ $copyright ])
 315
 316 The copyright notice of the feed.
 317
 318 =head2 $feed->modified([ $modified ])
 319
 320 A I<DateTime> object representing the last-modified date of the feed.
 321
 322 If present, I<$modified> should be a I<DateTime> object.
 323
 324 =head2 $feed->generator([ $generator ])
 325
 326 The generator of the feed.
 327
 328 =head2 $feed->self_link ([ $uri ])
 329
 330 The Atom Self-link of the feed:
 331
 332 L<http://validator.w3.org/feed/docs/warning/MissingAtomSelfLink.html>
 333
 334 A string.
 335
 336 =head2 $feed->entries
 337
 338 A list of the entries/items in the feed. Returns an array containing
 339 L<XML::Feed::Entry> objects.
 340
 341 =head2 $feed->items
 342
 343 A synonym (alias) for <$feed-E<gt>entries>.
 344
 345 =head2 $feed->add_entry($entry)
 346
 347 Adds an entry to the feed. I<$entry> should be an L<XML::Feed::Entry>
 348 object in the correct format for the feed.
 349
 350 =head2 $feed->as_xml
 351
 352 Returns an XML representation of the feed, in the format determined by
 353 the current format of the I<$feed> object.
 354
 355 =head1 PACKAGE VARIABLES
 356
 357 =over 4
 358
 359 =item C<$XML::Feed::Format::RSS::PREFERRED_PARSER>
 360
 361 If you want to use another RSS parser class than XML::RSS (default), you can
 362 change the class by setting C<$PREFERRED_PARSER> variable in the
 363 XML::Feed::Format::RSS package.
 364
 365     $XML::Feed::Format::RSS::PREFERRED_PARSER = "XML::RSS::LibXML";
 366
 367 B<Note:> this will only work for parsing feeds, not creating feeds.
 368
 369 B<Note:> Only C<XML::RSS::LibXML> version 0.3004 is known to work at the moment.
 370
 371 =item C<$XML::Feed::MULTIPLE_ENCLOSURES>
 372
 373 Although the RSS specification states that there can be at most one enclosure per item
 374 some feeds break this rule.
 375
 376 If this variable is set then C<XML::Feed> captures all of them and makes them available as a list.
 377
 378 Otherwise it returns the last enclosure parsed.
 379
 380 B<Note:> C<XML::RSS> version 1.44 is needed for this to work.
 381
 382 =back
 383
 384 =cut
 385
 386 =head1 VALID FEEDS
 387
 388 For reference, this cgi script will create valid, albeit nonsensical feeds
 389 (according to C<http://feedvalidator.org> anyway) for Atom 1.0 and RSS 0.90,
 390 0.91, 1.0 and 2.0.
 391
 392     #!perl -w
 393
 394     use strict;
 395     use CGI;
 396     use CGI::Carp qw(fatalsToBrowser);
 397     use DateTime;
 398     use XML::Feed;
 399
 400     my $cgi  = CGI->new;
 401     my @args = ( $cgi->param('format') || "Atom" );
 402     push @args, ( version => $cgi->param('version') ) if $cgi->param('version');
 403
 404     my $feed = XML::Feed->new(@args);
 405     $feed->id("http://".time.rand()."/");
 406     $feed->title('Test Feed');
 407     $feed->link($cgi->url);
 408     $feed->self_link($cgi->url( -query => 1, -full => 1, -rewrite => 1) );
 409     $feed->modified(DateTime->now);
 410
 411     my $entry = XML::Feed::Entry->new();
 412     $entry->id("http://".time.rand()."/");
 413     $entry->link("http://example.com");
 414     $entry->title("Test entry");
 415     $entry->summary("Test summary");
 416     $entry->content("Foo");
 417     $entry->modified(DateTime->now);
 418     $entry->author('test@example.com (Testy McTesterson)');
 419     $feed->add_entry($entry);
 420
 421     my $mime = ("Atom" eq $feed->format) ? "application/atom+xml" : "application/rss+xml";
 422     print $cgi->header($mime);
 423     print $feed->as_xml;
 424
 425
 426 =head1 LICENSE
 427
 428 I<XML::Feed> is free software; you may redistribute it and/or modify it
 429 under the same terms as Perl itself.
 430
 431 =head1 AUTHOR & COPYRIGHT
 432
 433 Except where otherwise noted, I<XML::Feed> is Copyright 2004-2008
 434 Six Apart. All rights reserved.
 435
 436 =head1 SUPPORT
 437
 438 For support contact the XML::Feed mailing list - xml-feed@perlhacks.com.
 439
 440 =head1 SOURCE CODE
 441
 442 The latest version of I<XML::Feed> can be found at
 443
 444     http://github.com/davorg/XML-Feed
 445
 446 =cut