File Coverage

blib/lib/WWW/Comic/Plugin/DinosaurComics.pm
Criterion Covered Total %
statement 12 27 44.4
branch 0 6 0.0
condition 0 3 0.0
subroutine 4 6 66.6
pod 1 2 50.0
total 17 44 38.6


line stmt bran cond sub pod time code
1             package WWW::Comic::Plugin::DinosaurComics;
2              
3 2     2   51521 use warnings;
  2         5  
  2         59  
4 2     2   10 use strict;
  2         3  
  2         63  
5              
6 2     2   2547 use HTML::TreeBuilder;
  2         87585  
  2         26  
7              
8 2     2   91 use vars qw($VERSION @ISA %COMICS);
  2         4  
  2         1307  
9              
10             our $VERSION = '0.01';
11             @ISA = qw(WWW::Comic::Plugin);
12             %COMICS = ( dinosaur_comics => 'Dinosaur Comics');
13              
14             sub new {
15 0     0 1   my $class = shift;
16 0           my $self = { uri => 'http://www.qwantz.com' };
17 0           bless $self, $class;
18 0           $self->{ua} = $self->_new_agent;
19 0           return $self
20             }
21              
22             sub strip_url {
23 0     0 0   my ( $self, %args ) = @_;
24              
25 0 0         unless ( $self->{cur} ) {
26 0           my $r = $self->{ua}->get( "$self->{uri}/index.php" );
27              
28 0 0         if ( $r->is_success ) {
29 0           $self->{tree} = HTML::TreeBuilder->new_from_content( $r->content );
30 0           $self->{cur} = $self->{tree}->look_down( _tag => 'img', class => 'comic' )->attr( 'src' );
31 0           $self->{cur} =~ s/^.*comic2-//;
32 0           $self->{cur} =~ s/\.png//
33             }
34             else {
35 0           $self->{cur} = 2372;
36             }
37             }
38            
39 0 0 0       return ( ( exists $args{id} and $args{id} =~ /\d+$/ and $args{id} <= $self->{cur} )
40             ? "$self->{uri}/comics/comic2-$args{id}.png"
41             : "$self->{uri}/comics/comic2-$self->{cur}.png"
42             )
43             }
44              
45             =head1 NAME
46              
47             WWW::Comic::Plugin::DinosaurComics - WWW::Comic plugin to fetch Dinosaur Comics
48              
49             =head1 SYNOPSIS
50              
51             See L for full details.
52              
53             use strict;
54             use warnings;
55              
56             use WWW::Comic;
57              
58             my $wc = new WWW::Comic;
59              
60             my $latest = $wc->get_strip( comic => 'dinosaur_comics' );
61              
62             my $favorite = $wc->get_strip( comic => 'dinosaur_comics', id => 1999 );
63              
64             =head1 DESCRIPTION
65              
66             A plugin for L to fetch Dinosaur Comics from http://www.qwantz.com/
67              
68             See L and L for information on the WWW::Comic
69             interface.
70              
71             =head1 METHODS
72              
73             =over 4
74              
75             =item new
76              
77             Constructor - see L for usage
78              
79             =back
80              
81             =cut
82              
83             =head1 AUTHOR
84              
85             Luke Poskitt, C<< >>
86              
87             =head1 BUGS
88              
89             Please report any bugs or feature requests to C, or through
90             the web interface at L. I will be notified, and then you'll
91             automatically be notified of progress on your bug as I make changes.
92              
93              
94              
95              
96             =head1 SUPPORT
97              
98             You can find documentation for this module with the perldoc command.
99              
100             perldoc WWW::Comic::Plugin::DinosaurComics
101              
102              
103             You can also look for information at:
104              
105             =over 4
106              
107             =item * RT: CPAN's request tracker
108              
109             L
110              
111             =item * AnnoCPAN: Annotated CPAN documentation
112              
113             L
114              
115             =item * CPAN Ratings
116              
117             L
118              
119             =item * Search CPAN
120              
121             L
122              
123             =back
124              
125              
126             =head1 ACKNOWLEDGEMENTS
127              
128              
129             =head1 LICENSE AND COPYRIGHT
130              
131             Copyright 2013 Luke Poskitt.
132              
133             This program is free software; you can redistribute it and/or modify it
134             under the terms of either: the GNU General Public License as published
135             by the Free Software Foundation; or the Artistic License.
136              
137             See http://dev.perl.org/licenses/ for more information.
138              
139              
140             =cut
141              
142             1; # End of WWW::Comic::Plugin::DinosaurComics