File Coverage

blib/lib/Mojo/Feed.pm
Criterion Covered Total %
statement 98 100 98.0
branch 25 30 83.3
condition 12 20 60.0
subroutine 22 22 100.0
pod 4 4 100.0
total 161 176 91.4


line stmt bran cond sub pod time code
1             package Mojo::Feed;
2 11     11   1954488 use Mojo::Base '-base';
  11         383224  
  11         72  
3 11     11   3323 use Mojo::DOM;
  11         44972  
  11         298  
4 11     11   1136 use Mojo::File;
  11         52642  
  11         469  
5 11     11   1075 use Mojo::URL;
  11         16215  
  11         75  
6 11     11   1614 use Mojo::UserAgent;
  11         415796  
  11         78  
7 11     11   423 use Mojo::Util qw(decode trim);
  11         63  
  11         662  
8              
9 11     11   76 use Carp qw(croak);
  11         22  
  11         547  
10 11     11   69 use List::Util;
  11         22  
  11         702  
11 11     11   4160 use HTTP::Date qw(str2time);
  11         14804  
  11         653  
12              
13 11     11   4762 use Mojo::Feed::Item;
  11         55  
  11         70  
14              
15             use overload
16 67     67   51216 bool => sub { shift->is_valid },
17 12     12   10971 '""' => sub { shift->to_string },
18 11     11   1049 fallback => 1;
  11         24  
  11         78  
19              
20             our $VERSION = "0.19";
21              
22             has charset => 'UTF-8';
23              
24             has ua => sub { Mojo::UserAgent->new() };
25             has max_redirects => sub { $ENV{MOJO_MAX_REDIRECTS} || 3 };
26             has redirects => sub { [] };
27             has related => sub { [] };
28              
29             has url => sub { Mojo::URL->new() };
30             has file => sub { Mojo::File->new() };
31             has source => sub {
32             my $self = shift;
33             return
34             ($self->url ne '') ? $self->url
35             : (-f $self->file) ? $self->file
36             : undef;
37             };
38              
39             has body => sub {
40             my $self = shift;
41             if ($self->url ne '') {
42             return $self->_load();
43             }
44             else { # skip file tests, just slurp (for Mojo::Asset::File)
45             return $self->file->slurp();
46             }
47             };
48              
49             has text => sub {
50             my $self = shift;
51             return decode($self->charset, $self->body) || '';
52             };
53              
54             has dom => sub {
55             my ($self) = @_;
56             return Mojo::DOM->new($self->text);
57             };
58              
59             has feed_type => sub {
60             my $top = shift->dom->children->first;
61             my $tag = $top->tag;
62             my $version = $top->attr('version');
63             my $ns = $top->attr('namespace');
64             return
65             ($tag =~ /feed/i)
66             ? ($version)
67             ? 'Atom ' . $version
68             : 'Atom 1.0'
69             : ($tag =~ /rss/i) ? 'RSS ' . $version
70             : ($tag =~ /rdf/i) ? 'RSS 1.0'
71             : 'unknown';
72             };
73              
74             my %generic = (
75             description => ['description', 'tagline', 'subtitle'],
76             published => [
77             'published', 'pubDate', 'dc\:date', 'created',
78             'issued', 'updated', 'modified'
79             ],
80             author => ['author', 'dc\:creator', 'webMaster'],
81             title => ['title'],
82             subtitle => ['subtitle', 'tagline'],
83             link => ['link:not([rel])', 'link[rel=alternate]'],
84             );
85              
86             foreach my $k (keys %generic) {
87             has $k => sub {
88             my $self = shift;
89             for my $generic (@{$generic{$k}}) {
90             if (my $p = $self->dom->at("channel > $generic, feed > $generic")) {
91             if ($k eq 'author' && $p->at('name')) {
92             return trim $p->at('name')->text;
93             }
94             my $text = trim($p->text || $p->content || $p->attr('href') || '');
95             if ($k eq 'published') {
96             return str2time($text);
97             }
98             return $text;
99             }
100             }
101             return;
102             };
103             }
104              
105             has items => sub {
106             my $self = shift;
107             $self->dom->find('item, entry')
108             ->map(sub { Mojo::Feed::Item->new(dom => $_, feed => $self) });
109             };
110              
111             has is_valid => sub {
112             shift->dom->children->first->tag =~ /^(feed|rss|rdf|rdf:rdf)$/i;
113             };
114              
115             sub is_feed_content_type {
116 110     110 1 1279 my ($self, $content_type) = @_;
117             # use split to remove charset attribute from content_type header
118 110         466 ($content_type) = split(/[; ]+/, $content_type);
119             # feed mime-types:
120 110         386 my @feed_types = (
121             'application/x.atom+xml', 'application/atom+xml',
122             'application/xml', 'text/xml',
123             'application/rss+xml', 'application/rdf+xml'
124             );
125 110     530   670 return List::Util::first { $_ eq $content_type } @feed_types;
  530         1139  
126             }
127              
128              
129             sub _load {
130 40     40   96 my ($self) = @_;
131 40         127 my $tx = $self->ua->get($self->url);
132 40         354063 my $result = $tx->result; # this will croak on network errors
133              
134 40 50 66     1046 if ($result->is_error) {
    100          
135 0         0 $self->is_valid(undef);
136 0         0 croak "Error getting feed from url ", $self->url, ": ", $result->message;
137             }
138              
139             # Redirect:
140             elsif ($result->code == 301 || $result->code == 302) {
141 12         367 my $new_url = Mojo::URL->new($result->headers->location);
142 12         1308 push @{$self->redirects}, $self->url;
  12         44  
143 12         92 $self->url($new_url);
144 12 100       66 if (@{$self->redirects} > $self->max_redirects) {
  12         41  
145 2         28 $self->is_valid(undef);
146 2         848 croak "Number of redirects exceeded when loading feed"
147             }
148 10         111 return $self->_load();
149             }
150              
151             # Is this a feed (by content type)?
152 28 100       932 if ($self->is_feed_content_type($result->headers->content_type)) {
153 17 50       94 $self->charset($result->content->charset) if ($result->content->charset);
154 17         462 return $result->body;
155             }
156             else {
157             # we are in a web page. PHEAR.
158              
159             # Set real (absolute) URL (is this only relevant for testing?):
160 11 100       45 if ($self->url ne $tx->req->url) {
161 5         1011 push @{$self->redirects}, $self->url; # for logging?
  5         25  
162 5         36 $self->url($tx->req->url);
163             }
164 11         2490 my @feeds = $self->find_feed_links($result);
165              
166 11 100       47 if (@feeds) {
167 5         11 push @{$self->redirects}, $self->url; # not really a redirect, but save it
  5         19  
168 5         46 $self->url(shift @feeds);
169              
170             # save any remaining feed links as related
171 5 100       39 push @{$self->related}, @feeds if (@feeds);
  2         10  
172 5         22 return $self->_load();
173             }
174             else {
175             # call me crazy, but maybe this is just a feed served as HTML?
176 6         26 my $test = Mojo::Feed->new( url => $self->url, body => $result->body );
177 6 100       315 $test->charset($result->content->charset) if ($result->content->charset);
178 6 100       295 if ($test->is_valid) {
179             # can't avoid parsing twice;
180             # body is probably being called in the dom initializer
181             # :(
182             # $self->dom($test->dom);
183 5 50       210783 $self->charset($test->charset) if ($test->charset);
184 5         101 return $test->body;
185             }
186             else {
187 1         4314 $self->is_valid(undef);
188 1         11 croak "No valid feed found at ", $self->url;
189             }
190             }
191             }
192             }
193              
194             sub find_feed_links {
195 32     32 1 211 my ($self, $result) = @_;
196 32         66 my @feeds;
197              
198             # Find feed link elements in HEAD:
199 32   33     163 my $base
200             = Mojo::URL->new(
201             $result->dom->find('head base')->map('attr', 'href')->join('') || $self->url)
202             ->to_abs($self->url);
203 32   33     907977 my $title
204             = $result->dom->find('head > title')->map('text')->join('') || $self->url;
205             $result->dom->find('head link')->each(sub {
206 338     338   124340 my $attrs = $_->attr();
207 338 100       4042 return unless ($attrs->{'rel'});
208 332         910 my %rel = map { $_ => 1 } split /\s+/, lc($attrs->{'rel'});
  332         879  
209 332 100       723 my $type = ($attrs->{'type'}) ? lc trim $attrs->{'type'} : undef;
210 332 50 100     1310 if ($type && $self->is_feed_content_type($type)
      33        
      66        
211             && ($rel{'alternate'} || $rel{'service.feed'}))
212             {
213 21         80 push @feeds, Mojo::URL->new($attrs->{'href'})->to_abs($base);
214             }
215 32         161068 });
216              
217             # Find feed links ()
218 32         68418 state $feed_exp = qr/((\.(?:rss|xml|rdf)$)|(\/feed\/*$)|(feeds*\.))/;
219             $result->dom->find('a')->grep(sub {
220 854 50   854   189960 $_->attr('href') && $_->attr('href') =~ /$feed_exp/io;
221             })->each(sub {
222 8     8   2357 push @feeds, Mojo::URL->new($_->attr('href'))->to_abs($base);
223 32         151 });
224 32         19698 return @feeds;
225             }
226              
227             sub to_hash {
228 25     25 1 81 my $self = shift;
229 25   100     124 my $hash = {map { $_ => '' . ($self->$_ || '') } (keys %generic)};
  150         5939  
230 25         129 $hash->{items} = $self->items->map('to_hash')->to_array;
231 25         367 return $hash;
232             }
233              
234             sub to_string {
235 12     12 1 57 shift->dom->to_string;
236             }
237              
238             1;
239             __END__