lib/XML/Feed.pm

   1 # $Id: Feed.pm 1958 2006-08-14 05:31:27Z btrott $
   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.40';
  16 our @formatters;
  17 BEGIN {
  18         @formatters = __PACKAGE__->formatters;
  19 }
  20
  21 sub new {
  22     my $class = shift;
  23     my $format = shift || 'Atom';
  24     my $format_class = 'XML::Feed::Format::' . $format;
  25     eval "use $format_class";
  26     Carp::croak("Unsupported format $format: $@") if $@;
  27     my $feed = bless {}, join('::', __PACKAGE__, "Format", $format);
  28     $feed->init_empty(@_) or return $class->error($feed->errstr);
  29     $feed;
  30 }
  31
  32 sub init_empty { 1 }
  33
  34 sub parse {
  35     my $class = shift;
  36     my($stream, $specified_format) = @_;
  37     return $class->error("Stream parameter is required") unless $stream;
  38     my $feed = bless {}, $class;
  39     my $xml = '';
  40     if (UNIVERSAL::isa($stream, 'URI')) {
  41         my $ua  = LWP::UserAgent->new;
  42         $ua->env_proxy; # force allowing of proxies
  43         my $res = URI::Fetch->fetch($stream, UserAgent => $ua)
  44             or return $class->error(URI::Fetch->errstr);
  45         return $class->error("This feed has been permanently removed")
  46             if $res->status == URI::Fetch::URI_GONE();
  47         $xml = $res->content;
  48     } elsif (ref($stream) eq 'SCALAR') {
  49         $xml = $$stream;
  50     } elsif (ref($stream)) {
  51         while (read($stream, my($chunk), 8192)) {
  52             $xml .= $chunk;
  53         }
  54     } else {
  55         open my $fh, $stream
  56             or return $class->error("Can't open $stream: $!");
  57         while (read $fh, my($chunk), 8192) {
  58             $xml .= $chunk;
  59         }
  60         close $fh;
  61     }
  62     return $class->error("Can't get feed XML content from $stream")
  63         unless $xml;
  64     my $format;
  65     if ($specified_format) {
  66         $format = $specified_format;
  67     } else {
  68         $format = $feed->identify_format(\$xml) or return $class->error($feed->errstr);
  69     }
  70
  71     my $format_class = join '::', __PACKAGE__, "Format", $format;
  72     eval "use $format_class";
  73     return $class->error("Unsupported format $format: $@") if $@;
  74     bless $feed, $format_class;
  75     $feed->init_string(\$xml) or return $class->error($feed->errstr);
  76     $feed;
  77 }
  78
  79 sub identify_format {
  80     my $feed   = shift;
  81     my($xml)   = @_;
  82         foreach my $class (@formatters) {
  83                 my ($name) = ($class =~ m!([^:]+)$!);
  84                 # TODO ugly
  85                 my $tmp = $$xml;
  86                 return $name if eval { $class->identify(\$tmp) };
  87                 return $feed->error($@) if $@;
  88         }
  89         return $feed->error("Cannot detect feed type");
  90 }
  91
  92 sub _get_first_tag {
  93         my $class  = shift;
  94         my ($xml)  = @_;
  95
  96
  97     ## Auto-detect feed type based on first element. This is prone
  98     ## to breakage, but then again we don't want to parse the whole
  99     ## feed ourselves.
 100     my $tag;
 101     while ($$xml =~ /<(\S+)/sg) {
 102         (my $t = $1) =~ tr/a-zA-Z0-9:\-\?!//cd;
 103         my $first = substr $t, 0, 1;
 104         $tag = $t, last unless $first eq '?' || $first eq '!';
 105     }
 106         die ("Cannot find first element") unless $tag;
 107     $tag =~ s/^.*://;
 108         return $tag;
 109 }
 110
 111 sub find_feeds {
 112     my $class = shift;
 113     my($uri) = @_;
 114     my @feeds = Feed::Find->find($uri)
 115         or return $class->error(Feed::Find->errstr);
 116     @feeds;
 117 }
 118
 119 sub convert {
 120     my $feed = shift;
 121     my($format) = @_;
 122     my $new = XML::Feed->new($format);
 123     for my $field (qw( title link description language author copyright modified generator )) {
 124         my $val = $feed->$field();
 125         next unless defined $val;
 126         $new->$field($val);
 127     }
 128     for my $entry ($feed->entries) {
 129         $new->add_entry($entry->convert($format));
 130     }
 131     $new;
 132 }
 133
 134 sub splice {
 135     my $feed = shift;
 136     my($other) = @_;
 137     my %ids = map { $_->id => 1 } $feed->entries;
 138     for my $entry ($other->entries) {
 139         $feed->add_entry($entry) unless $ids{$entry->id}++;
 140     }
 141 }
 142
 143 sub _convert_entry {
 144     my $feed   = shift;
 145     my $entry  = shift;
 146     my $feed_format  = ref($feed);   $feed_format  =~ s!^XML::Feed::Format::!!;
 147     my $entry_format = ref($entry);  $entry_format =~ s!^XML::Feed::Entry::Format::!!;
 148     return $entry if $entry_format eq $feed_format;
 149     return $entry->convert($feed_format);
 150 }
 151
 152 sub base;
 153 sub format;
 154 sub title;
 155 sub link;
 156 sub self_link;
 157 sub description;
 158 sub language;
 159 sub author;
 160 sub copyright;
 161 sub modified;
 162 sub generator;
 163 sub add_entry;
 164 sub entries;
 165 sub as_xml;
 166 sub id;
 167
 168 sub tagline { shift->description(@_) }
 169 sub items   { $_[0]->entries     }
 170
 171 1;
 172 __END__
 173
 174 =head1 NAME
 175
 176 XML::Feed - Syndication feed parser and auto-discovery
 177
 178 =head1 SYNOPSIS
 179
 180     use XML::Feed;
 181     my $feed = XML::Feed->parse(URI->new('http://example.com/atom.xml'))
 182         or die XML::Feed->errstr;
 183     print $feed->title, "\n";
 184     for my $entry ($feed->entries) {
 185     }
 186
 187     ## Find all of the syndication feeds on a given page, using
 188     ## auto-discovery.
 189     my @feeds = XML::Feed->find_feeds('http://example.com/');
 190
 191 =head1 DESCRIPTION
 192
 193 I<XML::Feed> is a syndication feed parser for both RSS and Atom feeds. It
 194 also implements feed auto-discovery for finding feeds, given a URI.
 195
 196 I<XML::Feed> supports the following syndication feed formats:
 197
 198 =over 4
 199
 200 =item * RSS 0.91
 201
 202 =item * RSS 1.0
 203
 204 =item * RSS 2.0
 205
 206 =item * Atom
 207
 208 =back
 209
 210 The goal of I<XML::Feed> is to provide a unified API for parsing and using
 211 the various syndication formats. The different flavors of RSS and Atom
 212 handle data in different ways: date handling; summaries and content;
 213 escaping and quoting; etc. This module attempts to remove those differences
 214 by providing a wrapper around the formats and the classes implementing
 215 those formats (I<XML::RSS> and I<XML::Atom::Feed>). For example, dates are
 216 handled differently in each of the above formats. To provide a unified API for
 217 date handling, I<XML::Feed> converts all date formats transparently into
 218 I<DateTime> objects, which it then returns to the caller.
 219
 220 =head1 USAGE
 221
 222 =head2 XML::Feed->new($format)
 223
 224 Creates a new empty I<XML::Feed> object using the format I<$format>.
 225
 226     $feed = XML::Feed->new('Atom');
 227     $feed = XML::Feed->new('RSS');
 228     $feed = XML::Feed->new('RSS', version => '0.91');
 229
 230 =head2 XML::Feed->parse($stream)
 231
 232 =head2 XML::Feed->parse($stream, $format)
 233
 234 Parses a syndication feed identified by I<$stream>. 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 I<XML::Feed::Entry> objects.
 338
 339 =head2 $feed->items
 340
 341 A synonym for I<$feed->entries>.
 342
 343 =head2 $feed->add_entry($entry)
 344
 345 Adds an entry to the feed. I<$entry> should be an I<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::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 XML::Feed::RSS
 361 package.
 362
 363     $XML::Feed::RSS::PREFERRED_PARSER = "XML::RSS::LibXML";
 364
 365 B<Note:> this will only work for parsing feeds, not creating feeds.
 366
 367 =back
 368
 369 =head1 VALID FEEDS
 370
 371 For reference, this cgi script will create valid, albeit nonsensical feeds
 372 (according to C<http://feedvalidator.org> anyway) for Atom 1.0 and RSS 0.90,
 373 0.91, 1.0 and 2.0.
 374
 375     #!perl -w
 376
 377     use strict;
 378     use CGI;
 379     use CGI::Carp qw(fatalsToBrowser);
 380     use DateTime;
 381     use XML::Feed;
 382
 383     my $cgi  = CGI->new;
 384     my @args = ( $cgi->param('format') || "Atom" );
 385     push @args, ( version => $cgi->param('version') ) if $cgi->param('version');
 386
 387     my $feed = XML::Feed->new(@args);
 388     $feed->id("http://".time.rand()."/");
 389     $feed->title('Test Feed');
 390     $feed->link($cgi->url);
 391     $feed->self_link($cgi->url( -query => 1, -full => 1, -rewrite => 1) );
 392     $feed->modified(DateTime->now);
 393
 394     my $entry = XML::Feed::Entry->new();
 395     $entry->id("http://".time.rand()."/");
 396     $entry->link("http://example.com");
 397     $entry->title("Test entry");
 398     $entry->summary("Test summary");
 399     $entry->content("Foo");
 400     $entry->modified(DateTime->now);
 401     $entry->author('test@example.com (Testy McTesterson)');
 402     $feed->add_entry($entry);
 403
 404     my $mime = ("Atom" eq $feed->format) ? "application/atom+xml" : "application/rss+xml";
 405     print $cgi->header($mime);
 406     print $feed->as_xml;
 407
 408
 409 =head1 LICENSE
 410
 411 I<XML::Feed> is free software; you may redistribute it and/or modify it
 412 under the same terms as Perl itself.
 413
 414 =head1 AUTHOR & COPYRIGHT
 415
 416 Except where otherwise noted, I<XML::Feed> is Copyright 2004-2008
 417 Six Apart, cpan@sixapart.com. All rights reserved.
 418
 419 =head1 SUBVERSION
 420
 421 The latest version of I<XML::Feed> can be found at
 422
 423     http://code.sixapart.com/svn/XML-Feed/trunk/
 424
 425 =cut