local-lib5/lib/perl5/XML/Atom/Feed.pm

   1 # $Id$
   2
   3 package XML::Atom::Feed;
   4 use strict;
   5 use base qw( XML::Atom::Thing );
   6
   7 use XML::Atom;
   8 use XML::Atom::Entry;
   9 BEGIN {
  10     if (LIBXML) {
  11         *entries = \&entries_libxml;
  12         *add_entry = \&add_entry_libxml;
  13     } else {
  14         *entries = \&entries_xpath;
  15         *add_entry = \&add_entry_xpath;
  16     }
  17 }
  18
  19 sub init {
  20     my $atom = shift;
  21     my %param = @_ == 1 ? (Stream => $_[0]) : @_;
  22     if (UNIVERSAL::isa($param{Stream}, 'URI')) {
  23         my @feeds = __PACKAGE__->find_feeds($param{Stream});
  24         return $atom->error("Can't find Atom file") unless @feeds;
  25         my $ua = LWP::UserAgent->new;
  26         my $req = HTTP::Request->new(GET => $feeds[0]);
  27         my $res = $ua->request($req);
  28         if ($res->is_success) {
  29             $param{Stream} = \$res->content;
  30         }
  31     }
  32     $atom->SUPER::init(%param);
  33 }
  34
  35 sub find_feeds {
  36     my $class = shift;
  37     my($uri) = @_;
  38     my $ua = LWP::UserAgent->new;
  39     my $req = HTTP::Request->new(GET => $uri);
  40     my $res = $ua->request($req);
  41     return unless $res->is_success;
  42     my @feeds;
  43     if ($res->content_type eq 'text/html' || $res->content_type eq 'application/xhtml+xml') {
  44         my $base_uri = $uri;
  45         my $find_links = sub {
  46             my($tag, $attr) = @_;
  47             if ($tag eq 'link') {
  48                 return unless $attr->{rel};
  49                 my %rel = map { $_ => 1 } split /\s+/, lc($attr->{rel});
  50                 (my $type = lc $attr->{type}) =~ s/^\s*//;
  51                 $type =~ s/\s*$//;
  52                 push @feeds, URI->new_abs($attr->{href}, $base_uri)->as_string
  53                    if $rel{alternate} &&
  54                       $type eq 'application/atom+xml';
  55             } elsif ($tag eq 'base') {
  56                 $base_uri = $attr->{href};
  57             }
  58         };
  59         require HTML::Parser;
  60         my $p = HTML::Parser->new(api_version => 3,
  61                                   start_h => [ $find_links, "tagname, attr" ]);
  62         $p->parse($res->content);
  63     } else {
  64         @feeds = ($uri);
  65     }
  66     @feeds;
  67 }
  68
  69 sub element_name { 'feed' }
  70 *language = \&lang; # legacy
  71
  72
  73 sub version {
  74     my $feed = shift;
  75     my $elem = $feed->elem;
  76     if (@_) {
  77         $elem->setAttribute('version', $_[0]);
  78     }
  79     $elem->getAttribute('version') || $feed->SUPER::version(@_);
  80 }
  81
  82 sub entries_libxml {
  83     my $feed = shift;
  84     my @res = $feed->elem->getElementsByTagNameNS($feed->ns, 'entry') or return;
  85     my @entries;
  86     for my $res (@res) {
  87         my $entry = XML::Atom::Entry->new(Elem => $res->cloneNode(1));
  88         push @entries, $entry;
  89     }
  90     @entries;
  91 }
  92
  93 sub entries_xpath {
  94     my $feed = shift;
  95     my $set = $feed->elem->find("descendant-or-self::*[local-name()='entry' and namespace-uri()='" . $feed->ns . "']");
  96     my @entries;
  97     for my $elem ($set->get_nodelist) {
  98         ## Delete the link to the parent (feed) element, and append
  99         ## the default Atom namespace.
 100         $elem->del_parent_link;
 101         my $ns = XML::XPath::Node::Namespace->new('#default' => $feed->ns);
 102         $elem->appendNamespace($ns);
 103         my $entry = XML::Atom::Entry->new(Elem => $elem);
 104         push @entries, $entry;
 105     }
 106     @entries;
 107 }
 108
 109 sub add_entry_libxml {
 110     my $feed = shift;
 111     my($entry, $opt) = @_;
 112     $opt ||= {};
 113     # When doing an insert, we try to insert before the first <entry> so
 114     # that we don't screw up any preamble.  If there are no existing
 115     # <entry>'s, then fall back to appending, which should be
 116     # semantically identical.
 117     my ($first_entry) =
 118         $feed->elem->getChildrenByTagNameNS($entry->ns, 'entry');
 119     if ($opt->{mode} && $opt->{mode} eq 'insert' && $first_entry) {
 120         $feed->elem->insertBefore($entry->elem, $first_entry);
 121     } else {
 122         $feed->elem->appendChild($entry->elem);
 123     }
 124 }
 125
 126 sub add_entry_xpath {
 127     my $feed = shift;
 128     my($entry, $opt) = @_;
 129     $opt ||= {};
 130     my $set = $feed->elem->find("*[local-name()='entry' and namespace-uri()='" . $entry->ns . "']");
 131     my $first_entry = $set ? ($set->get_nodelist)[0] : undef;
 132     if ($opt->{mode} && $opt->{mode} eq 'insert' && $first_entry) {
 133         $feed->elem->insertBefore($entry->elem, $first_entry);
 134     } else {
 135         $feed->elem->appendChild($entry->elem);
 136     }
 137 }
 138
 139 __PACKAGE__->mk_elem_accessors(qw( generator ));
 140 __PACKAGE__->mk_xml_attr_accessors(qw( lang base ));
 141
 142 __PACKAGE__->_rename_elements('modified' => 'updated');
 143 __PACKAGE__->_rename_elements('tagline' => 'subtitle');
 144
 145 1;
 146 __END__
 147
 148 =head1 NAME
 149
 150 XML::Atom::Feed - Atom feed
 151
 152 =head1 SYNOPSIS
 153
 154     use XML::Atom::Feed;
 155     use XML::Atom::Entry;
 156     my $feed = XML::Atom::Feed->new;
 157     $feed->title('My Weblog');
 158     $feed->id('tag:example.com,2006:feed-id');
 159     my $entry = XML::Atom::Entry->new;
 160     $entry->title('First Post');
 161     $entry->id('tag:example.com,2006:entry-id');
 162     $entry->content('Post Body');
 163     $feed->add_entry($entry);
 164     $feed->add_entry($entry, { mode => 'insert' });
 165
 166     my @entries = $feed->entries;
 167     my $xml = $feed->as_xml;
 168
 169     ## Get a list of the <link rel="..." /> tags in the feed.
 170     my $links = $feed->link;
 171
 172     ## Find all of the Atom feeds on a given page, using auto-discovery.
 173     my @uris = XML::Atom::Feed->find_feeds('http://www.example.com/');
 174
 175     ## Use auto-discovery to load the first Atom feed on a given page.
 176     my $feed = XML::Atom::Feed->new(URI->new('http://www.example.com/'));
 177
 178 =head1 USAGE
 179
 180 =head2 XML::Atom::Feed->new([ $stream ])
 181
 182 Creates a new feed object, and if I<$stream> is supplied, fills it with the
 183 data specified by I<$stream>.
 184
 185 Automatically handles autodiscovery if I<$stream> is a URI (see below).
 186
 187 Returns the new I<XML::Atom::Feed> object. On failure, returns C<undef>.
 188
 189 I<$stream> can be any one of the following:
 190
 191 =over 4
 192
 193 =item * Reference to a scalar
 194
 195 This is treated as the XML body of the feed.
 196
 197 =item * Scalar
 198
 199 This is treated as the name of a file containing the feed XML.
 200
 201 =item * Filehandle
 202
 203 This is treated as an open filehandle from which the feed XML can be read.
 204
 205 =item * URI object
 206
 207 This is treated as a URI, and the feed XML will be retrieved from the URI.
 208
 209 If the content type returned from fetching the content at URI is
 210 I<text/html>, this method will automatically try to perform auto-discovery
 211 by looking for a I<E<lt>linkE<gt>> tag describing the feed URL. If such
 212 a URL is found, the feed XML will be automatically retrieved.
 213
 214 If the URI is already of a feed, no auto-discovery is necessary, and the
 215 feed XML will be retrieved and parsed as normal.
 216
 217 =back
 218
 219 =head2 XML::Atom::Feed->find_feeds($uri)
 220
 221 Given a URI I<$uri>, use auto-discovery to find all of the Atom feeds linked
 222 from that page (using I<E<lt>linkE<gt>> tags).
 223
 224 Returns a list of feed URIs.
 225
 226 =head2 $feed->link
 227
 228 If called in scalar context, returns an I<XML::Atom::Link> object
 229 corresponding to the first I<E<lt>linkE<gt>> tag found in the feed.
 230
 231 If called in list context, returns a list of I<XML::Atom::Link> objects
 232 corresponding to all of the I<E<lt>linkE<gt>> tags found in the feed.
 233
 234 =head2 $feed->add_link($link)
 235
 236 Adds the link I<$link>, which must be an I<XML::Atom::Link> object, to
 237 the feed as a new I<E<lt>linkE<gt>> tag. For example:
 238
 239     my $link = XML::Atom::Link->new;
 240     $link->type('text/html');
 241     $link->rel('alternate');
 242     $link->href('http://www.example.com/');
 243     $feed->add_link($link);
 244
 245 =head2 $feed->add_entry($entry)
 246
 247 Adds the entry I<$entry>, which must be an I<XML::Atom::Entry> object,
 248 to the feed. If you want to add an entry before existent entries, you can pass optional hash reference containing C<mode> value set to C<insert>.
 249
 250   $feed->add_entry($entry, { mode => 'insert' });
 251
 252 =head2 $feed->entries
 253
 254 Returns list of XML::Atom::Entry objects contained in the feed.
 255
 256 =head2 $feed->language
 257
 258 Returns the language of the feed, from I<xml:lang>.
 259
 260 =head2 $feed->author([ $author ])
 261
 262 Returns an I<XML::Atom::Person> object representing the author of the entry,
 263 or C<undef> if there is no author information present.
 264
 265 If I<$author> is supplied, it should be an I<XML::Atom::Person> object
 266 representing the author. For example:
 267
 268     my $author = XML::Atom::Person->new;
 269     $author->name('Foo Bar');
 270     $author->email('foo@bar.com');
 271     $feed->author($author);
 272
 273 =head2 $feed->id([ $id ])
 274
 275 Returns an id for the feed. If I<$id> is supplied, set the id. When
 276 generating the new feed, it is your responsibility to generate unique
 277 ID for the feed and set to XML::Atom::Feed object. You can use I<http>
 278 permalink, I<tag> URI scheme or I<urn:uuid> for handy.
 279
 280 =head1 UNICODE FLAGS
 281
 282 By default, XML::Atom takes off all the Unicode flag fro mthe feed content. For example,
 283
 284   my $title = $feed->title;
 285
 286 the variable C<$title> contains UTF-8 bytes without Unicode flag set,
 287 even if the feed title contains some multibyte chracters.
 288
 289 If you don't like this behaviour and wants to andle everything as
 290 Unicode characters (rather than UTF-8 bytes), set
 291 C<$XML::Atom::ForceUnicode> flag to 1.
 292
 293   $XML::Atom::ForceUnicode = 1;
 294
 295 then all the data returned from XML::Atom::Feed object and
 296 XML::Atom::Entry object etc., will have Unicode flag set.
 297
 298 The only exception will be C<< $entry->content->body >>, if content
 299 type is not text/* (e.g. image/gif). In that case, the content body is
 300 still binary data, without Unicode flag set.
 301
 302 =head1 CREATING ATOM 1.0 FEEDS
 303
 304 By default, XML::Atom::Feed and other classes (Entry, Link and
 305 Content) will create entities using Atom 0.3 namespaces. In order to
 306 create 1.0 feed and entry elements, you can set I<Version> as a
 307 parameter, like:
 308
 309   $feed = XML::Atom::Feed->new(Version => 1.0);
 310   $entry = XML::Atom::Entry->new(Version => 1.0);
 311
 312 Setting those Version to every element would be sometimes painful. In
 313 that case, you can override the default version number by setting
 314 C<$XML::Atom::DefaultVersion> global variable to "1.0".
 315
 316   use XML::Atom;
 317
 318   $XML::Atom::DefaultVersion = "1.0";
 319
 320   my $feed = XML::Atom::Feed->new;
 321   $feed->title("blah");
 322
 323   my $entry = XML::Atom::Entry->new;
 324   $feed->add_entry($entry);
 325
 326   $feed->version; # 1.0
 327
 328 =head1 AUTHOR & COPYRIGHT
 329
 330 Please see the I<XML::Atom> manpage for author, copyright, and license
 331 information.
 332
 333 =cut