File Coverage

blib/lib/Bot/BasicBot/Pluggable/Module/XKCD.pm
Criterion Covered Total %
statement 40 44 90.9
branch 11 14 78.5
condition n/a
subroutine 7 9 77.7
pod 0 2 0.0
total 58 69 84.0


line stmt bran cond sub pod time code
1             package Bot::BasicBot::Pluggable::Module::XKCD;
2              
3 2     2   49368 use warnings;
  2         4  
  2         59  
4 2     2   10 use strict;
  2         4  
  2         63  
5              
6 2     2   11 use base qw(Bot::BasicBot::Pluggable::Module);
  2         13  
  2         1064  
7              
8 2     2   1531 use URI::Title qw(title);
  2         209622  
  2         151  
9 2     2   1896 use LWP::Simple;
  2         114610  
  2         22  
10              
11             =head1 NAME
12              
13             Bot::BasicBot::Pluggable::Module::XKCD - Get xkcd comic links and titles
14              
15             =head1 VERSION
16              
17             Version 0.06
18              
19             =cut
20              
21             our $VERSION = '0.06';
22              
23              
24             =head1 SYNOPSIS
25              
26             Searches for xkcd comics by name or number and outputs a link and title
27              
28             =head1 IRC USAGE
29              
30             =over 4
31              
32             =item xkcd []
33              
34             Return the title and link to a comic matching the id or regex given. If
35             nothing is given, use the latest comic.
36              
37             =back
38              
39             =cut
40              
41             sub help {
42 0     0 0 0 return "xkcd [id|regex] - give title and link for matching comic";
43             }
44              
45             sub told {
46 5     5 0 29 my ($self, $mess) = @_;
47 5         14 my $body = $mess->{body};
48              
49 5         24 my ($command, $param) = split /\s+/, $body, 2;
50 5         18 $command = lc $command;
51              
52 5 100       34 if ($command eq "xkcd") {
53 4         9 my $url;
54 4 100       29 if (!defined $param) {
    100          
55 1         3 $url = 'http://xkcd.com/';
56             } elsif ($param =~ /^\d+$/) {
57 1         4 $url = "http://xkcd.com/$param/";
58             } else {
59 2         5 my $num = eval { # just in case someone gives us some horrific RE
60 2         14 local $_ = get "http://xkcd.com/archive/";
61 2     0   975561 local $SIG{ALRM} = sub { die "timed out\n" };
  0         0  
62 2         25 alarm 10; # XXX: \o/ magic numbers
63 2     1   4721 m{href="/(\d+)/".*$param}i;
  1         19  
  1         3  
  1         27  
64 2         74678 alarm 0;
65 2         77 return $1;
66             };
67 2 50       18 if ($@) {
68 0 0       0 die unless $@ eq "timed out\n";
69 0         0 return "Timed out.";
70             }
71 2 100       15 $url = "http://xkcd.com/$num/" if $num;
72             }
73              
74 4         34 my $title = title($url);
75              
76 4 100       1045047 return "Couldn't get comic" unless defined $title;
77              
78 3         19 $title =~ s/^xkcd: //;
79              
80 3         44 return "$title - $url";
81             }
82             }
83              
84              
85             =head1 AUTHOR
86              
87             Josh Holland, C<< >>
88              
89             =head1 BUGS
90              
91             Please report any bugs or feature requests to C, or through
92             the web interface at L. I will be notified, and then you'll
93             automatically be notified of progress on your bug as I make changes.
94              
95              
96              
97              
98             =head1 SUPPORT
99              
100             You can find documentation for this module with the perldoc command.
101              
102             perldoc Bot::BasicBot::Pluggable::Module::XKCD
103              
104              
105             You can also look for information at:
106              
107             =over 4
108              
109             =item * RT: CPAN's request tracker
110              
111             L
112              
113             =item * AnnoCPAN: Annotated CPAN documentation
114              
115             L
116              
117             =item * CPAN Ratings
118              
119             L
120              
121             =item * Search CPAN
122              
123             L
124              
125             =back
126              
127              
128             =head1 LICENSE AND COPYRIGHT
129              
130             Copyright 2011 Josh Holland.
131              
132             This program is free software; you can redistribute it and/or modify it
133             under the terms of either: the GNU General Public License as published
134             by the Free Software Foundation; or the Artistic License.
135              
136             See http://dev.perl.org/licenses/ for more information.
137              
138              
139             =cut
140              
141             1; # End of Bot::BasicBot::Pluggable::Module::XKCD