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   2088173 use Mojo::Base -base;
  8         70  
  8         58  
3              
4 8     8   3379 use Mojo::UserAgent;
  8         832219  
  8         177  
5 8     8   3835 use Mojo::Feed;
  8         29  
  8         73  
6 8     8   449 use Mojo::File 'path';
  8         34  
  8         537  
7 8     8   52 use Mojo::Util 'decode', 'trim';
  8         18  
  8         431  
8 8     8   53 use Carp qw(carp croak);
  8         17  
  8         436  
9 8     8   47 use Scalar::Util qw(blessed);
  8         26  
  8         11258  
10              
11             has charset => 'UTF-8';
12              
13             has ua => sub { Mojo::UserAgent->new };
14              
15             sub parse {
16 47     47 1 254817 my ( $self, $xml, $charset ) = @_;
17 47 50       195 return undef unless ($xml);
18 47         246 my ( $body, $source, $url, $file, $feed );
19 47 100       175 if ( $body = $self->_from_string($xml) ) {
    100          
    50          
20 7         45 $feed = Mojo::Feed->new( body => $body );
21             }
22             elsif ( $file = $self->_from_file($xml) ) {
23 32         301 $feed = Mojo::Feed->new( file => $file );
24             }
25             elsif ( $url = $self->_from_url($xml) ) {
26 8         91 $feed = Mojo::Feed->new( url => $url, ua => $self->ua );
27             }
28             else {
29 0         0 croak "unknown argument $xml";
30             }
31 47 50       527 $feed->charset($charset) if ($charset);
32 47 100       183 return ( $feed->is_valid ) ? $feed : undef;
33             }
34              
35             sub _from_string {
36 47     47   126 my ( $self, $xml ) = @_;
37 47 100       239 my $str = ( !ref $xml ) ? $xml : ( ref $xml eq 'SCALAR' ) ? $$xml : '';
    100          
38 47 100       351 return ( $str =~ /^\s*\
39             }
40              
41             sub _from_url {
42 8     8   30 my ( $self, $xml ) = @_;
43 8 0 33     102 my $url =
    50          
44             ( blessed $xml && $xml->isa('Mojo::URL') ) ? $xml->clone()
45             : ( $xml =~ /^https?\:/ ) ? Mojo::URL->new("$xml")
46             : undef;
47 8         463 return $url;
48             }
49              
50             sub _from_file {
51 40     40   121 my ( $self, $xml ) = @_;
52 40 100 66     1186 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         504 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 135633 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   273298 my ($tx) = @_;
74 27 100 66     126 if ( $tx->res->is_success && $tx->res->code == 200 ) {
75 25         942 my $feed = Mojo::Feed->new(url => $tx->req->url);
76 25 100       520 return $feed->url if ($feed->is_feed_content_type($tx->res->headers->content_type));
77 21         118 my @feeds = $feed->find_feed_links($tx->res);
78 21 100       177 return @feeds if (@feeds);
79 10         82 $feed->body($tx->res->body);
80 10 100       519 $feed->charset($tx->res->content->charset) if ($tx->res->content->charset);
81 10 100       658 return $feed->url if ($feed->is_valid);
82             }
83 10         518596 return;
84             }
85 27         142 );
86             }
87              
88             sub parse_opml {
89 6     6 1 20735 my ( $self, $opml_file ) = @_;
90 6 100       35 my $opml_str = decode $self->charset,
91             ( ref $opml_file )
92             ? $opml_file->slurp
93             : Mojo::File->new($opml_file)->slurp;
94 6         3843 my $d = Mojo::DOM->new->parse($opml_str);
95 6         349736 my ( %subscriptions, %categories );
96 6         42 for my $item ( $d->find(q{outline})->each ) {
97 1924         458576 my $node = $item->attr;
98 1924 100       23204 if ( !defined $node->{xmlUrl} ) {
99 80   66     344 my $cat = $node->{title} || $node->{text};
100 80         229 $categories{$cat} =
101             $item->children('[xmlUrl]')->map( 'attr', 'xmlUrl' );
102             }
103             else { # file by RSS URL:
104 1844         5397 $subscriptions{ $node->{xmlUrl} } = $node;
105             }
106             }
107              
108             # assign categories
109 6         660 for my $cat ( keys %categories ) {
110 80         231 for my $rss ( $categories{$cat}->each ) {
111             next
112 1840 50       4582 unless ( $subscriptions{$rss} )
113             ; # don't auto-vivify for empty "categories"
114 1840   100     6521 $subscriptions{$rss}{'categories'} ||= [];
115 1840         2211 push @{ $subscriptions{$rss}{'categories'} }, $cat;
  1840         4338  
116             }
117             }
118 6         2973 return ( values %subscriptions );
119             }
120              
121             1;
122             __END__