lib/XML/Feed.pm

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