File Coverage

blib/lib/WWW/Comic/Plugin/Wulffmorgenthaler.pm
Criterion Covered Total %
statement 12 34 35.2
branch 0 8 0.0
condition n/a
subroutine 4 6 66.6
pod 2 2 100.0
total 18 50 36.0


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