File Coverage

blib/lib/Mojo/Feed/Reader.pm
Criterion Covered Total %
statement 68 71 95.7
branch 36 44 81.8
condition 9 14 64.2
subroutine 14 15 93.3
pod 3 3 100.0
total 130 147 88.4


line stmt bran cond sub pod time code
1             package Mojo::Feed::Reader;
2 8     8   1937877 use Mojo::Base -base;
  8         62  
  8         50  
3              
4 8     8   2935 use Mojo::UserAgent;
  8         772645  
  8         61  
5 8     8   3205 use Mojo::Feed;
  8         29  
  8         49  
6 8     8   326 use Mojo::File 'path';
  8         18  
  8         432  
7 8     8   48 use Mojo::Util 'decode', 'trim';
  8         15  
  8         397  
8 8     8   47 use Carp qw(carp croak);
  8         13  
  8         389  
9 8     8   45 use Scalar::Util qw(blessed);
  8         43  
  8         10019  
10              
11             has charset => 'UTF-8';
12              
13             has ua => sub { Mojo::UserAgent->new };
14              
15             sub parse {
16 48     48 1 244537 my ( $self, $xml, $charset ) = @_;
17 48 50       182 return undef unless ($xml);
18 48         221 my ( $body, $source, $url, $file, $feed );
19 48 100       154 if ( $body = $self->_from_string($xml) ) {
    100          
    50          
20 8         54 $feed = Mojo::Feed->new( body => $body );
21             }
22             elsif ( $file = $self->_from_file($xml) ) {
23 32         287 $feed = Mojo::Feed->new( file => $file );
24             }
25             elsif ( $url = $self->_from_url($xml) ) {
26 8         63 $feed = Mojo::Feed->new( url => $url, ua => $self->ua );
27             }
28             else {
29 0         0 croak "unknown argument $xml";
30             }
31 48 50       483 $feed->charset($charset) if ($charset);
32 48 100       157 return ( $feed->is_valid ) ? $feed : undef;
33             }
34              
35             sub _from_string {
36 48     48   126 my ( $self, $xml ) = @_;
37 48 100       192 my $str = ( !ref $xml ) ? $xml : ( ref $xml eq 'SCALAR' ) ? $$xml : '';
    100          
38 48 100       315 return ( $str =~ /^\s*\
39             }
40              
41             sub _from_url {
42 8     8   20 my ( $self, $xml ) = @_;
43 8 0 33     87 my $url =
    50          
44             ( blessed $xml && $xml->isa('Mojo::URL') ) ? $xml->clone()
45             : ( $xml =~ /^https?\:/ ) ? Mojo::URL->new("$xml")
46             : undef;
47 8         369 return $url;
48             }
49              
50             sub _from_file {
51 40     40   97 my ( $self, $xml ) = @_;
52 40 100 66     760 my $file =
    50          
    100          
53             ( ref $xml )
54             ? ( blessed $xml && $xml->can('slurp') )
55             ? $xml
56             : undef
57             : ( -r "$xml" ) ? Mojo::File->new($xml)
58             : undef;
59 40         371 return $file;
60             }
61              
62             # discover - get RSS/Atom feed URL from argument.
63             # Code adapted to use Mojolicious from Feed::Find by Benjamin Trott
64             # Any stupid mistakes are my own
65             sub discover {
66 27     27 1 107387 my ( $self, $url ) = @_;
67              
68             # $self->ua->max_redirects(5)->connect_timeout(30);
69             return $self->ua->get_p($url)
70 0     0   0 ->catch( sub { my ($err) = shift; croak "Connection Error: $err" } )
  0         0  
71             ->then(
72             sub {
73 27     27   192440 my ($tx) = @_;
74 27 100 66     92 if ( $tx->res->is_success && $tx->res->code == 200 ) {
75 25         764 my $feed = Mojo::Feed->new(url => $tx->req->url);
76 25 100       402 return $feed->url if ($feed->is_feed_content_type($tx->res->headers->content_type));
77 21         98 my @feeds = $feed->find_feed_links($tx->res);
78 21 100       123 return @feeds if (@feeds);
79 10         68 $feed->body($tx->res->body);
80 10 100       365 $feed->charset($tx->res->content->charset) if ($tx->res->content->charset);
81 10 100       480 return $feed->url if ($feed->is_valid);
82             }
83 10         474046 return;
84             }
85 27         100 );
86             }
87              
88             sub parse_opml {
89 6     6 1 19294 my ( $self, $opml_file ) = @_;
90 6 100       28 my $opml_str = decode $self->charset,
91             ( ref $opml_file )
92             ? $opml_file->slurp
93             : Mojo::File->new($opml_file)->slurp;
94 6         3063 my $d = Mojo::DOM->new->parse($opml_str);
95 6         323689 my ( %subscriptions, %categories );
96 6         40 for my $item ( $d->find(q{outline})->each ) {
97 1924         409986 my $node = $item->attr;
98 1924 100       21248 if ( !defined $node->{xmlUrl} ) {
99 80   66     301 my $cat = $node->{title} || $node->{text};
100 80         208 $categories{$cat} =
101             $item->children('[xmlUrl]')->map( 'attr', 'xmlUrl' );
102             }
103             else { # file by RSS URL:
104 1844         4983 $subscriptions{ $node->{xmlUrl} } = $node;
105             }
106             }
107              
108             # assign categories
109 6         784 for my $cat ( keys %categories ) {
110 80         233 for my $rss ( $categories{$cat}->each ) {
111             next
112 1840 50       4691 unless ( $subscriptions{$rss} )
113             ; # don't auto-vivify for empty "categories"
114 1840   100     5956 $subscriptions{$rss}{'categories'} ||= [];
115 1840         2068 push @{ $subscriptions{$rss}{'categories'} }, $cat;
  1840         3950  
116             }
117             }
118 6         3555 return ( values %subscriptions );
119             }
120              
121             1;
122             __END__