File Coverage

blib/lib/Geo/Hashing/Source/Peeron.pm
Criterion Covered Total %
statement 21 21 100.0
branch 4 8 50.0
condition 5 15 33.3
subroutine 5 5 100.0
pod 0 1 0.0
total 35 50 70.0


line stmt bran cond sub pod time code
1             #!/usr/bin/perl -w
2             #
3             # $Id: Peeron.pm 255 2008-06-21 03:48:46Z dan $
4             #
5              
6             package Geo::Hashing::Source::Peeron;
7              
8 1     1   6 use strict;
  1         3  
  1         38  
9 1     1   7 use warnings;
  1         1  
  1         41  
10 1     1   6 use Carp;
  1         1  
  1         99  
11             require Exporter;
12 1     1   890 use LWP::Simple qw/$ua get/;
  1         115132  
  1         11  
13              
14             =head1 NAME
15              
16             Geo::Hashing::Source::Peeron - Retrieve DJIA opening values from irc.peeron.com
17              
18             =head1 SYNOPSIS
19              
20             use Geo::Hashing;
21             my $g = new Geo::Hashing(source => 'peeron');
22             printf "Today's offset is at %.6f, %.6f.\n", $g->lat, $g->lon;
23              
24             =head1 DESCRIPTION
25              
26             See documentation of Geo::Hashing.
27              
28             =cut
29              
30             $ua->agent("Geo::Hashing/" . $Geo::Hashing::VERSION);
31             my $URL = "http://irc.peeron.com/xkcd/map/data/%04d/%02d/%02d";
32              
33             our @ISA = qw/Exporter/;
34             our @EXPORT = qw/get_djia/;
35              
36             sub get_djia {
37 14     14 0 24 my $self = shift;
38 14         27 my $date = shift;
39              
40 14 50       32 croak "Invalid call to get_djia - missing date!" unless $date;
41              
42 14         56 my ($y, $m, $d) = split /-/, $date, 3;
43 14 50 33     81 croak "Invalid year $y" unless $y and $y >= 1928;
44 14 50 33     111 croak "Invalid month $m" unless $m and $m >= 1 and $m <= 12;
      33        
45 14 50 33     98 croak "Invalid day $d" unless $d and $d >= 1 and $m <= 31;
      33        
46              
47 14         102 my $page = get(sprintf($URL, $y, $m, $d));
48              
49 14         4378765 return $page;
50             }
51              
52             =head1 AUTHOR
53              
54             Dan Boger, Ezigdon@gmail.comE
55              
56             =head1 COPYRIGHT AND LICENSE
57              
58             Copyright (C) 2008 by Dan Boger
59              
60             This library is free software; you can redistribute it and/or modify
61             it under the same terms as Perl itself, either Perl version 5.10.0 or,
62             at your option, any later version of Perl 5 you may have available.
63              
64             =cut
65             1;