File Coverage

blib/lib/App/Rssfilter/Match/AbcPreviews.pm
Criterion Covered Total %
statement 14 14 100.0
branch 4 6 66.6
condition n/a
subroutine 5 5 100.0
pod n/a
total 23 25 92.0


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