File Coverage

blib/lib/App/Rssfilter/Match/AbcPreviews.pm
Criterion Covered Total %
statement 18 18 100.0
branch 4 4 100.0
condition 6 9 66.6
subroutine 5 5 100.0
pod n/a
total 33 36 91.6


line stmt bran cond sub pod time code
1             # ABSTRACT: match an ABC preview RSS item
2              
3 1     1   82198 use strict;
  1         2  
  1         26  
4 1     1   6 use warnings;
  1         1  
  1         50  
5              
6              
7             package App::Rssfilter::Match::AbcPreviews;
8             $App::Rssfilter::Match::AbcPreviews::VERSION = '0.08'; # TRIAL
9 1     1   906 use Method::Signatures;
  1         79803  
  1         7  
10              
11              
12 1 100   1   158373 func match ( $item ) {
  5 100   5   2112  
  4         6  
  4         14  
13 3         12 my $guid = $item->at('guid');
14 3         734 my $title = $item->at('title');
15 3   66     371 my $guid_preview = defined $guid && $guid->text =~ / [^-] preview /xms;
16 3   66     297 my $title_no_preview = defined $title && $title->text =~ / preview /ixms;
17 3   66     103 return $guid_preview && ! $title_no_preview;
18             }
19              
20             1;
21              
22             __END__
23              
24             =pod
25              
26             =encoding UTF-8
27              
28             =head1 NAME
29              
30             App::Rssfilter::Match::AbcPreviews - match an ABC preview RSS item
31              
32             =head1 VERSION
33              
34             version 0.08
35              
36             =head1 SYNOPSIS
37              
38             use App::Rssfilter::Match::AbcPreviews;
39            
40             use Mojo::DOM;
41             my $rss = Mojo::DOM->new( <<"End_of_RSS" );
42             <rss>
43             <channel>
44             <item>
45             <guid>http://www.abc.net.au/preview/some_article</guid>
46             <description>here is an article which is in preview mode</description>
47             </item>
48             <item>
49             <guid>http://www.abc.net.au/entertainment/new-preview-of-movie</guid>
50             <description>here is an article about a preview of a movie</description>
51             </item>
52             </channel>
53             </rss>
54             End_of_RSS
55              
56             print $_, "\n" for $rss->find( 'item' )->grep( \&App::Rssfilter::Match::AbcPreviews::match );
57              
58             # or with an App::Rssfilter::Rule
59              
60             use App::Rssfilter::Rule;
61             App::Rssfilter::Rule->new(
62             condition => 'AbcPreviews',
63             action => sub { print shift->to_string, "\n" },
64             )->constrain( $rss );
65              
66             # either way, prints
67              
68             # <item>
69             # <guid>http://www.abc.net.au/preview/some_article</guid>
70             # <description>here is an article which is in preview mode</description>
71             # </item>
72              
73             =head1 DESCRIPTION
74              
75             This module will match an RSS item if its GUID contains 'C<preview>', unless 'C<preview>' is also in the title of the item. The Australian Broadcasting Corporation RSS feeds occasionally include items whose GUIDS contain 'C<preview>' and link to non-existent pages, so this matcher was created to find them.
76              
77             =head1 FUNCTIONS
78              
79             =head2 match
80              
81             my $item_is_preview = App::Rssfilter::Match::AbcPreviews::match( $item );
82              
83             Returns true if C<$item> contains 'C<preview>' in its GUID and not in its title.
84              
85             =head1 SEE ALSO
86              
87             =over 4
88              
89             =item *
90              
91             L<App::Rssfilter>
92              
93             =item *
94              
95             L<App::Rssfilter::Rule>
96              
97             =back
98              
99             =head1 AUTHOR
100              
101             Daniel Holz <dgholz@gmail.com>
102              
103             =head1 COPYRIGHT AND LICENSE
104              
105             This software is copyright (c) 2015 by Daniel Holz.
106              
107             This is free software; you can redistribute it and/or modify it under
108             the same terms as the Perl 5 programming language system itself.
109              
110             =cut