File Coverage

blib/lib/WWW/Comic/Plugin/CyanideAndHappiness.pm
Criterion Covered Total %
statement 12 32 37.5
branch 0 4 0.0
condition 0 2 0.0
subroutine 4 6 66.6
pod 2 2 100.0
total 18 46 39.1


line stmt bran cond sub pod time code
1             package WWW::Comic::Plugin::CyanideAndHappiness;
2              
3 2     2   51088 use warnings;
  2         4  
  2         76  
4 2     2   11 use strict;
  2         3  
  2         69  
5 2     2   13 use Carp;
  2         8  
  2         176  
6              
7 2     2   13 use vars qw($VERSION @ISA %COMICS);
  2         4  
  2         913  
8             our $VERSION = '0.01';
9             @ISA = qw(WWW::Comic::Plugin);
10             %COMICS = ( cyanideandhappiness => 'Cyanide and Happiness' );
11              
12             # $Id: CyanideAndHappiness.pm 326 2008-04-04 22:28:44Z davidp $
13              
14             =head1 NAME
15              
16             WWW::Comic::Plugin::CyanideAndHappiness - WWW::Comic plugin to fetch C+H
17              
18             =head1 VERSION
19              
20             Version 0.01
21              
22              
23             =head1 SYNOPSIS
24              
25             See L for full details, but here's a brief example:
26              
27             use WWW::Comic;
28             my $wc = new WWW::Comic;
29             my $latest_candh_strip_url
30             = WWW::Comic->strip_url(comic => 'cyanideandhappiness');
31            
32              
33             =head1 DESCRIPTION
34              
35             A plugin for L to fetch the Cyanide and Happiness comic from
36             http://www.explosm.net/
37              
38             See L and L for information on the WWW::Comic
39             interface.
40              
41              
42             =head1 FUNCTIONS
43              
44             =over 4
45              
46             =item new
47              
48             Constructor - see L for usage
49              
50             =cut
51              
52              
53             sub new {
54 0     0 1   my $class = shift;
55 0           my $self = { homepage => 'http://www.explosm.net/comics/' };
56 0           bless $self, $class;
57 0           return $self;
58             }
59              
60             =item strip_url
61              
62             Returns the URL to the current strip image (or, if given the 'id' param,
63             the URL to that particular strip)
64              
65             =cut
66              
67             sub strip_url {
68 0     0 1   my $self = shift;
69 0           my %param = @_;
70            
71 0   0       my $id = $param{id} || 'new';
72 0           my $url = $self->{homepage} . "$id/";
73            
74 0           my $response = $self->_new_agent->get($url);
75 0 0         if ($response->is_success) {
76 0           my $html = $response->content;
77 0           my $alt_text = 'Cyanide and Happiness, a daily webcomic';
78 0 0         if ($html =~ m{$alt_text}msi)
79             {
80 0           my $url = $1;
81 0           return $url;
82             } else {
83 0           carp "Failed to find C+H comic strip at $url";
84 0           warn "Content was:\n$html\n";
85 0           return;
86             }
87            
88             } else {
89 0           carp "Failed to fetch $url - " . $response->status_line;
90 0           return;
91             }
92            
93             }
94              
95             =back
96              
97             =head1 AUTHOR
98              
99             David Precious, C<< >>
100              
101             =head1 BUGS
102              
103             Please report any bugs or feature requests to
104             C,
105             or through the web interface at
106             L.
107             I will be notified, and then you'll automatically be notified of progress on
108             your bug as I make changes.
109              
110              
111              
112              
113             =head1 SUPPORT
114              
115             You can find documentation for this module with the perldoc command.
116              
117             perldoc WWW::Comic::Plugin::CyanideAndHappiness
118              
119              
120             You can also look for information at:
121              
122             =over 4
123              
124             =item * RT: CPAN's request tracker
125              
126             L
127              
128             =item * AnnoCPAN: Annotated CPAN documentation
129              
130             L
131              
132             =item * CPAN Ratings
133              
134             L
135              
136             =item * Search CPAN
137              
138             L
139              
140             =back
141              
142              
143             =head1 ACKNOWLEDGEMENTS
144              
145             To Nicola Worthington (NICOLAW) for writing WWW::Comic
146              
147             =head1 COPYRIGHT & LICENSE
148              
149             Copyright 2008 David Precious, all rights reserved.
150              
151             This program is free software; you can redistribute it and/or modify it
152             under the same terms as Perl itself.
153              
154              
155             =cut
156              
157             1; # End of WWW::Comic::Plugin::CyanideAndHappiness