File Coverage

blib/lib/Acme/24.pm
Criterion Covered Total %
statement 46 55 83.6
branch 5 14 35.7
condition 4 11 36.3
subroutine 8 9 88.8
pod 0 3 0.0
total 63 92 68.4


line stmt bran cond sub pod time code
1             =pod
2              
3             =head1 NAME
4              
5             Acme::24 - Your favourite TV-show Acme module
6              
7             =head1 SYNOPSIS
8              
9             use Acme::24;
10              
11             # Tell me some random quote about Jack Bauer
12             print Acme::24->random_jackbauer_fact();
13             # 'Jack Bauer went out to the desert, and was bitten by a rattlesnake.
14             # The snake died.'
15              
16             # Returns an arrayref with 24 random facts
17             my $facts = Acme::24->random_jackbauer_facts();
18              
19             # Every call collects 24 random facts in a text file
20             # called `/tmp/superhero.txt' in fortune text format
21             Acme::24->collect_facts('/tmp/superhero.txt');
22              
23             =head1 DESCRIPTION
24              
25             This module was written because I'm somewhat crazy, and I'm also
26             passionate about the 24 tv-show, but in particular of the
27             B, Jack Bauer, a mythical super-hero,
28             something between Duke Nukem and Chuck Norris.
29              
30             =head1 BUGS
31              
32             One probably: this module should not really be on CPAN, it takes space,
33             although fortunately only a little.
34              
35             =head1 AUTHOR
36              
37             Cosimo Streppone, L
38              
39             =head1 LICENSE
40              
41             Artistic License, same as Perl itself.
42              
43             =cut
44              
45             package Acme::24;
46              
47             $VERSION = '0.04';
48              
49 3     3   2483 use strict;
  3         6  
  3         117  
50 3     3   26 use warnings;
  3         4  
  3         86  
51 3     3   2592 use LWP::Simple ();
  3         283090  
  3         83  
52 3     3   2758 use XML::RSSLite ();
  3         8250  
  3         109  
53              
54 3     3   27 use constant URL => 'http://www.notrly.com/jackbauer';
  3         6  
  3         2140  
55              
56             # Returns one random fact
57             sub random_jackbauer_fact
58             {
59 1     1 0 413 my $url = URL;
60 1         5 my $page = LWP::Simple::get($url);
61 1         845317 my $fact = '';
62              
63 1 50       21 if($page =~ m(

([^<]+)

))
64             {
65 1         6 $fact = $1;
66 1         4 $fact =~ s/^\s+//;
67 1         11 $fact =~ s/\s+$//;
68              
69 1 50   1   74 if(eval('use HTML::Entities'))
  1         10  
  1         2  
  1         94  
70             {
71 0         0 HTML::Entities::decode_entities($fact);
72             }
73              
74 1         4 $fact .= "\n";
75             }
76              
77 1         6 return($fact);
78              
79             }
80              
81             # Returns an array of 24 random facts
82             sub random_jackbauer_facts
83             {
84 1     1 0 12 my @facts = ();
85 1         4 my $url = URL . '/rss.php';
86 1         3 my $tries = 5;
87 1         3 my %seen;
88              
89 1   66     13 while ($tries-- > 0 && @facts < 24) {
90 2         6 my %result;
91 2         16 my $feed = LWP::Simple::get($url);
92 2         862427 XML::RSSLite::parseRSS(\%result, \$feed);
93 2 50 33     13157 if (exists $result{item} && UNIVERSAL::isa($result{item}, 'ARRAY'))
94             {
95 2         5 for my $fact (@{ $result{item} }) {
  2         13  
96 30 50       76 next if exists $seen{$fact->{title}};
97 30         56 push @facts, $fact->{title};
98 30         82 $seen{$fact->{title}} = undef;
99             }
100             }
101 2         2000344 sleep 1;
102             }
103              
104 1 50 33     13 if (@facts && scalar(@facts) > 24) {
105 1         8 splice(@facts, 24);
106             }
107              
108 1         25 return(\@facts);
109             }
110              
111             # Build a database of Jack Bauer facts
112             sub collect_facts
113             {
114 0     0 0 0 my($self, $file) = @_;
115 0   0     0 $file ||= './jackbauer.txt';
116 0         0 my $new_facts = $self->random_jackbauer_facts();
117 0 0       0 return unless $new_facts;
118 0 0       0 open(my $fh, '>>' . $file) or return;
119 0         0 for(@$new_facts)
120             {
121 0         0 print $fh $_, "\n%\n";
122             }
123 0         0 close($fh);
124             }
125              
126              
127             unless (caller) {
128              
129             print random_jackbauer_fact();
130              
131             # Collect random Jack Bauer facts
132             #$| = 1;
133             #while(1)
134             #{
135             # Acme::24->collect_facts() and print '.';
136             #}
137              
138             }
139              
140             1;
141