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