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
 167 sub tagline { shift->description(@_) }
 168 sub items   { $_[0]->entries     }
 169
 170 # RFC 5005
 171 sub first_link;
 172 sub last_link;
 173 sub previous_link;
 174 sub next_link;
 175 sub current_link;
 176 sub prev_archive_link;
 177 sub next_archive_link;
 178
 179 1;
 180 __END__
 181
 182 =head1 NAME
 183
 184 XML::Feed - Syndication feed parser and auto-discovery
 185
 186 =head1 SYNOPSIS
 187
 188     use XML::Feed;
 189     my $feed = XML::Feed->parse(URI->new('http://example.com/atom.xml'))
 190         or die XML::Feed->errstr;
 191     print $feed->title, "\n";
 192     for my $entry ($feed->entries) {
 193     }
 194
 195     ## Find all of the syndication feeds on a given page, using
 196     ## auto-discovery.
 197     my @feeds = XML::Feed->find_feeds('http://example.com/');
 198
 199 =head1 DESCRIPTION
 200
 201 I<XML::Feed> is a syndication feed parser for both RSS and Atom feeds. It
 202 also implements feed auto-discovery for finding feeds, given a URI.
 203
 204 I<XML::Feed> supports the following syndication feed formats:
 205
 206 =over 4
 207
 208 =item * RSS 0.91
 209
 210 =item * RSS 1.0
 211
 212 =item * RSS 2.0
 213
 214 =item * Atom
 215
 216 =back
 217
 218 The goal of I<XML::Feed> is to provide a unified API for parsing and using
 219 the various syndication formats. The different flavors of RSS and Atom
 220 handle data in different ways: date handling; summaries and content;
 221 escaping and quoting; etc. This module attempts to remove those differences
 222 by providing a wrapper around the formats and the classes implementing
 223 those formats (L<XML::RSS> and L<XML::Atom::Feed>). For example, dates are
 224 handled differently in each of the above formats. To provide a unified API for
 225 date handling, I<XML::Feed> converts all date formats transparently into
 226 L<DateTime> objects, which it then returns to the caller.
 227
 228 =head1 USAGE
 229
 230 =head2 XML::Feed->new($format)
 231
 232 Creates a new empty I<XML::Feed> object using the format I<$format>.
 233
 234     $feed = XML::Feed->new('Atom');
 235     $feed = XML::Feed->new('RSS');
 236     $feed = XML::Feed->new('RSS', version => '0.91');
 237
 238 =head2 XML::Feed->parse($stream)
 239
 240 =head2 XML::Feed->parse($stream, $format)
 241
 242 Parses a syndication feed identified by I<$stream> and returns an
 243 I<XML::Feed> obhect. I<$stream> can be any
 244 one of the following:
 245
 246 =over 4
 247
 248 =item * Scalar reference
 249
 250 A reference to string containing the XML body of the feed.
 251
 252 =item * Filehandle
 253
 254 An open filehandle from which the feed XML will be read.
 255
 256 =item * File name
 257
 258 The name of a file containing the feed XML.
 259
 260 =item * URI object
 261
 262 A URI from which the feed XML will be retrieved.
 263
 264 =back
 265
 266 I<$format> allows you to override format guessing.
 267
 268 =head2 XML::Feed->find_feeds($uri)
 269
 270 Given a URI I<$uri>, use auto-discovery to find all of the feeds linked
 271 from that page (using I<E<lt>linkE<gt>> tags).
 272
 273 Returns a list of feed URIs.
 274
 275 =head2 XML::Feed->identify_format($xml)
 276
 277 Given the xml of a feed return what format it is in (C<Atom>, or some version of C<RSS>).
 278
 279 =head2 $feed->convert($format)
 280
 281 Converts the I<XML::Feed> object into the I<$format> format, and returns
 282 the new object.
 283
 284 =head2 $feed->splice($other_feed)
 285
 286 Splices in all of the entries from the feed I<$other_feed> into I<$feed>,
 287 skipping posts that are already in I<$feed>.
 288
 289 =head2 $feed->format
 290
 291 Returns the format of the feed (C<Atom>, or some version of C<RSS>).
 292
 293 =head2 $feed->title([ $title ])
 294
 295 The title of the feed/channel.
 296
 297 =head2 $feed->base([ $base ])
 298
 299 The url base of the feed/channel.
 300
 301 =head2 $feed->link([ $uri ])
 302
 303 The permalink of the feed/channel.
 304
 305 =head2 $feed->tagline([ $tagline ])
 306
 307 The description or tagline of the feed/channel.
 308
 309 =head2 $feed->description([ $description ])
 310
 311 Alias for I<$feed-E<gt>tagline>.
 312
 313 =head2 $feed->author([ $author ])
 314
 315 The author of the feed/channel.
 316
 317 =head2 $feed->language([ $language ])
 318
 319 The language of the feed.
 320
 321 =head2 $feed->copyright([ $copyright ])
 322
 323 The copyright notice of the feed.
 324
 325 =head2 $feed->modified([ $modified ])
 326
 327 A I<DateTime> object representing the last-modified date of the feed.
 328
 329 If present, I<$modified> should be a I<DateTime> object.
 330
 331 =head2 $feed->generator([ $generator ])
 332
 333 The generator of the feed.
 334
 335 =head2 $feed->self_link ([ $uri ])
 336
 337 The Atom Self-link of the feed:
 338
 339 L<http://validator.w3.org/feed/docs/warning/MissingAtomSelfLink.html>
 340
 341 A string.
 342
 343 =head2 $feed->entries
 344
 345 A list of the entries/items in the feed. Returns an array containing
 346 L<XML::Feed::Entry> objects.
 347
 348 =head2 $feed->items
 349
 350 A synonym (alias) for <$feed-E<gt>entries>.
 351
 352 =head2 $feed->add_entry($entry)
 353
 354 Adds an entry to the feed. I<$entry> should be an L<XML::Feed::Entry>
 355 object in the correct format for the feed.
 356
 357 =head2 $feed->as_xml
 358
 359 Returns an XML representation of the feed, in the format determined by
 360 the current format of the I<$feed> object.
 361
 362 =head2 $feed->first_link ([ $uri ])
 363
 364 The Atom First-link for feed paging and archiving (RFC 5005).
 365
 366 L<http://tools.ietf.org/html/rfc5005>
 367
 368 =head2 $feed->last_link ([ $uri ])
 369
 370 The Atom Last-link for feed paging and archiving.
 371
 372 =head2 $feed->next_link ([ $uri ])
 373
 374 The Atom Next-link for feed paging and archiving.
 375
 376 =head2 $feed->previous_link ([ $uri ])
 377
 378 The Atom Previous-link for feed paging and archiving.
 379
 380 =head2 $feed->current_link ([ $uri ])
 381
 382 The Atom Current-link for feed paging and archiving.
 383
 384 =head2 $feed->next_archive_link ([ $uri ])
 385
 386 The Atom Next-link for feed paging and archiving.
 387
 388 =head2 $feed->prev_archive_link ([ $uri ])
 389
 390 The Atom Prev-Archive-link for feed paging and archiving.
 391
 392 =head1 PACKAGE VARIABLES
 393
 394 =over 4
 395
 396 =item C<$XML::Feed::Format::RSS::PREFERRED_PARSER>
 397
 398 If you want to use another RSS parser class than XML::RSS (default), you can
 399 change the class by setting C<$PREFERRED_PARSER> variable in the
 400 XML::Feed::Format::RSS package.
 401
 402     $XML::Feed::Format::RSS::PREFERRED_PARSER = "XML::RSS::LibXML";
 403
 404 B<Note:> this will only work for parsing feeds, not creating feeds.
 405
 406 B<Note:> Only C<XML::RSS::LibXML> version 0.3004 is known to work at the moment.
 407
 408 =item C<$XML::Feed::MULTIPLE_ENCLOSURES>
 409
 410 Although the RSS specification states that there can be at most one enclosure per item
 411 some feeds break this rule.
 412
 413 If this variable is set then C<XML::Feed> captures all of them and makes them available as a list.
 414
 415 Otherwise it returns the last enclosure parsed.
 416
 417 B<Note:> C<XML::RSS> version 1.44 is needed for this to work.
 418
 419 =back
 420
 421 =cut
 422
 423 =head1 VALID FEEDS
 424
 425 For reference, this cgi script will create valid, albeit nonsensical feeds
 426 (according to C<http://feedvalidator.org> anyway) for Atom 1.0 and RSS 0.90,
 427 0.91, 1.0 and 2.0.
 428
 429     #!perl -w
 430
 431     use strict;
 432     use CGI;
 433     use CGI::Carp qw(fatalsToBrowser);
 434     use DateTime;
 435     use XML::Feed;
 436
 437     my $cgi  = CGI->new;
 438     my @args = ( $cgi->param('format') || "Atom" );
 439     push @args, ( version => $cgi->param('version') ) if $cgi->param('version');
 440
 441     my $feed = XML::Feed->new(@args);
 442     $feed->id("http://".time.rand()."/");
 443     $feed->title('Test Feed');
 444     $feed->link($cgi->url);
 445     $feed->self_link($cgi->url( -query => 1, -full => 1, -rewrite => 1) );
 446     $feed->modified(DateTime->now);
 447
 448     my $entry = XML::Feed::Entry->new();
 449     $entry->id("http://".time.rand()."/");
 450     $entry->link("http://example.com");
 451     $entry->title("Test entry");
 452     $entry->summary("Test summary");
 453     $entry->content("Foo");
 454     $entry->modified(DateTime->now);
 455     $entry->author('test@example.com (Testy McTesterson)');
 456     $feed->add_entry($entry);
 457
 458     my $mime = ("Atom" eq $feed->format) ? "application/atom+xml" : "application/rss+xml";
 459     print $cgi->header($mime);
 460     print $feed->as_xml;
 461
 462
 463 =head1 LICENSE
 464
 465 I<XML::Feed> is free software; you may redistribute it and/or modify it
 466 under the same terms as Perl itself.
 467
 468 =head1 AUTHOR & COPYRIGHT
 469
 470 Except where otherwise noted, I<XML::Feed> is Copyright 2004-2008
 471 Six Apart. All rights reserved.
 472
 473 =head1 SUPPORT
 474
 475 For support contact the XML::Feed mailing list - xml-feed@perlhacks.com.
 476
 477 =head1 SOURCE CODE
 478
 479 The latest version of I<XML::Feed> can be found at
 480
 481     http://github.com/davorg/XML-Feed
 482
 483 =cut