File Coverage

blib/lib/WWW/Comic/Plugin/Jerkcity.pm
Criterion Covered Total %
statement 9 25 36.0
branch 0 6 0.0
condition 0 3 0.0
subroutine 3 6 50.0
pod 1 3 33.3
total 13 43 30.2


line stmt bran cond sub pod time code
1             package WWW::Comic::Plugin::Jerkcity;
2              
3 2     2   46296 use warnings;
  2         5  
  2         68  
4 2     2   11 use strict;
  2         4  
  2         81  
5              
6 2     2   11 use vars qw($VERSION @ISA %COMICS);
  2         14  
  2         1071  
7              
8             our @V = qw(SLURP SUCK GAG CHOKE HUFF GARGLE LICK JERK);
9             our @N = qw(DONGS BONGS DICKS PISS COCKS TITS);
10             our $VERSION = '0.8008135';
11             @ISA = qw(WWW::Comic::Plugin);
12             %COMICS = ( jerkcity => 'Jerkcity');
13              
14             sub new {
15 0     0 1   my $class = shift;
16 0           my $self = { uri => 'http://www.jerkcity.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         $self->{cur} or do { my $r = $self->{ua}->get( "$self->{uri}/high.txt" );
  0            
26 0 0         chomp ( $self->{cur} = ( $r->is_success ? $r->content : 5121 ) ) };
27              
28 0 0 0       return ( ( exists $args{id} and $args{id} =~ /\d+$/ and $args{id} <= $self->{cur} )
29             ? "$self->{uri}/jerkcity$args{id}.gif"
30             : "$self->{uri}/today.gif"
31             )
32             }
33              
34             sub get_strip {
35 0     0 0   my ( $self, @args ) = @_;
36 0           my $agent = $self->{ua}->agent;
37 0           $self->{ua}->agent( $V[ int rand @V ] . " " . $N[ int rand @N ] . "/$VERSION" );
38 0           my $strip = $self->SUPER::get_strip( @args );
39 0           $self->{ua}->agent( $agent );
40 0           return $strip
41             }
42              
43             =head1 NAME
44              
45             WWW::Comic::Plugin::Jerkcity - WWW::Comic plugin to fetch Jerkcity
46              
47             =head1 SYNOPSIS
48              
49             See L for full details.
50              
51             use strict;
52             use warnings;
53              
54             use WWW::Comic;
55              
56             my $huglaghalglah = new WWW::Comic;
57              
58             my $latest = $huglaghalglah->get_strip( comic => 'jerkcity' );
59              
60             my $specific = $huglaghalglah->get_strip( comic => 'jerkcity', id => 23 );
61              
62             =head1 DESCRIPTION
63              
64             A plugin for L to fetch the Jerkcity comic from http://www.jerkcity.com/
65              
66             See L and L for information on the WWW::Comic
67             interface.
68              
69              
70             =head1 FUNCTIONS
71              
72             =over 4
73              
74             =item new
75              
76             Constructor - see L for usage
77              
78             =back
79              
80             =cut
81              
82             =head1 AUTHOR
83              
84             Luke Poskitt, C<< >>
85              
86             =head1 BUGS
87              
88             Please report any bugs or feature requests to C, or through
89             the web interface at L. I will be notified, and then you'll
90             automatically be notified of progress on your bug as I make changes.
91              
92              
93             =head1 SUPPORT
94              
95             You can find documentation for this module with the perldoc command.
96              
97             perldoc WWW::Comic::Plugin::Jerkcity
98              
99              
100             You can also look for information at:
101              
102             =over 4
103              
104             =item * RT: CPAN's request tracker
105              
106             L
107              
108             =item * AnnoCPAN: Annotated CPAN documentation
109              
110             L
111              
112             =item * CPAN Ratings
113              
114             L
115              
116             =item * Search CPAN
117              
118             L
119              
120             =back
121              
122             =head1 ACKNOWLEDGEMENTS
123              
124             =head1 LICENSE AND COPYRIGHT
125              
126             Copyright 2013 Luke Poskitt.
127              
128             This program is free software; you can redistribute it and/or modify it
129             under the terms of either: the GNU General Public License as published
130             by the Free Software Foundation; or the Artistic License.
131              
132             See http://dev.perl.org/licenses/ for more information.
133              
134             =cut
135              
136              
137              
138             1;