File Coverage

blib/lib/XML/Atom/Feed.pm

Criterion	Covered	Total	%
statement	6	6	100.0
branch			n/a
condition			n/a
subroutine	2	2	100.0
pod			n/a
total	8	8	100.0

# $Id$

package XML::Atom::Feed;
use strict;
use base qw( XML::Atom::Thing );

use XML::Atom;
use XML::Atom::Entry;
BEGIN {
    if (LIBXML) {
        *entries = \&entries_libxml;
        *add_entry = \&add_entry_libxml;
    } else {
        *entries = \&entries_xpath;
        *add_entry = \&add_entry_xpath;
    }
}

sub init {
    my $atom = shift;
    my %param = @_ == 1 ? (Stream => $_[0]) : @_;
    if (UNIVERSAL::isa($param{Stream}, 'URI')) {
        my @feeds = __PACKAGE__->find_feeds($param{Stream});
        return $atom->error("Can't find Atom file") unless @feeds;
        my $ua = LWP::UserAgent->new;
        my $req = HTTP::Request->new(GET => $feeds[0]);
        my $res = $ua->request($req);
        if ($res->is_success) {
            $param{Stream} = \$res->content;
        }
    }
    $atom->SUPER::init(%param);
}

sub find_feeds {
    my $class = shift;
    my($uri) = @_;
    my $ua = LWP::UserAgent->new;
    my $req = HTTP::Request->new(GET => $uri);
    my $res = $ua->request($req);
    return unless $res->is_success;
    my @feeds;
    if ($res->content_type eq 'text/html' || $res->content_type eq 'application/xhtml+xml') {
        my $base_uri = $uri;
        my $find_links = sub {
            my($tag, $attr) = @_;
            if ($tag eq 'link') {
                return unless $attr->{rel};
                my %rel = map { $_ => 1 } split /\s+/, lc($attr->{rel});
                (my $type = lc $attr->{type}) =~ s/^\s*//;
                $type =~ s/\s*$//;
                push @feeds, URI->new_abs($attr->{href}, $base_uri)->as_string
                   if $rel{alternate} &&
                      $type eq 'application/atom+xml';
            } elsif ($tag eq 'base') {
                $base_uri = $attr->{href};
            }
        };
        require HTML::Parser;
        my $p = HTML::Parser->new(api_version => 3,
                                  start_h => [ $find_links, "tagname, attr" ]);
        $p->parse($res->content);
    } else {
        @feeds = ($uri);
    }
    @feeds;
}

sub element_name { 'feed' }
*language = \⟨ # legacy


sub version {
    my $feed = shift;
    my $elem = $feed->elem;
    if (@_) {
        $elem->setAttribute('version', $_[0]);
    }
    $elem->getAttribute('version') || $feed->SUPER::version(@_);
}

sub entries_libxml {
    my $feed = shift;
    my @res = $feed->elem->getElementsByTagNameNS($feed->ns, 'entry') or return;
    my @entries;
    for my $res (@res) {
        my $entry = XML::Atom::Entry->new(Elem => $res->cloneNode(1));
        push @entries, $entry;
    }
    @entries;
}

sub entries_xpath {
    my $feed = shift;
    my $set = $feed->elem->find("descendant-or-self::*[local-name()='entry' and namespace-uri()='" . $feed->ns . "']");
    my @entries;
    for my $elem ($set->get_nodelist) {
        ## Delete the link to the parent (feed) element, and append
        ## the default Atom namespace.
        $elem->del_parent_link;
        my $ns = XML::XPath::Node::Namespace->new('#default' => $feed->ns);
        $elem->appendNamespace($ns);
        my $entry = XML::Atom::Entry->new(Elem => $elem);
        push @entries, $entry;
    }
    @entries;
}

sub add_entry_libxml {
    my $feed = shift;
    my($entry, $opt) = @_;
    $opt ||= {};
    # When doing an insert, we try to insert before the first  so
    # that we don't screw up any preamble.  If there are no existing
    # 's, then fall back to appending, which should be
    # semantically identical.
    my ($first_entry) =
        $feed->elem->getChildrenByTagNameNS($entry->ns, 'entry');
    if ($opt->{mode} && $opt->{mode} eq 'insert' && $first_entry) {
        $feed->elem->insertBefore($entry->elem, $first_entry);
    } else {
        $feed->elem->appendChild($entry->elem);
    }
}

sub add_entry_xpath {
    my $feed = shift;
    my($entry, $opt) = @_;
    $opt ||= {};
    my $set = $feed->elem->find("*[local-name()='entry' and namespace-uri()='" . $entry->ns . "']");
    my $first_entry = $set ? ($set->get_nodelist)[0] : undef;
    if ($opt->{mode} && $opt->{mode} eq 'insert' && $first_entry) {
        $feed->elem->insertBefore($entry->elem, $first_entry);
    } else {
        $feed->elem->appendChild($entry->elem);
    }
}

__PACKAGE__->mk_elem_accessors(qw( generator ));
__PACKAGE__->mk_xml_attr_accessors(qw( lang base ));

__PACKAGE__->_rename_elements('modified' => 'updated');
__PACKAGE__->_rename_elements('tagline' => 'subtitle');

1;
__END__