File Coverage

blib/lib/Acme/Magic8Ball.pm
Criterion Covered Total %
statement 26 26 100.0
branch 4 4 100.0
condition 2 2 100.0
subroutine 5 5 100.0
pod 1 1 100.0
total 38 38 100.0


line stmt bran cond sub pod time code
1             package Acme::Magic8Ball;
2              
3 3     3   2378 use strict;
  3         6  
  3         135  
4              
5             require Exporter;
6 3     3   15 use vars qw($VERSION $CONSISTENT @EXPORT_OK @ISA);
  3         6  
  3         344  
7              
8              
9              
10             # are we ever going to need enhancements? Apparently yes :(
11             $VERSION = "1.3";
12             $CONSISTENT = 0;
13             @ISA = qw(Exporter);
14             @EXPORT_OK = qw(ask);
15              
16 3     3   3333 use Data::Dumper;
  3         19638  
  3         886  
17              
18             sub import {
19 3     3   31 $CONSISTENT = grep { /^:consistent$/ } @_;
  7         20  
20 3         6 @_ = grep { !/^:consistent$/ } @_;
  7         18  
21 3         118 goto &Exporter::import;
22             }
23              
24             =head1 NAME
25              
26             Acme::Magic8Ball - ask the Magic 8 Ball a question
27              
28             =head1 SYNOPSIS
29              
30             use Acme::Magic8Ball qw(ask);
31             my $reply = ask("Is this module any use whatsoever?");
32            
33             ... you can also pass in your own list of answers ...
34              
35             my $reply = ask("What should the next bit be?", 0, 1); # reply will always be 0 or 1
36              
37             ... or make answers consistent ...
38              
39             use Acme::Magic8Ball qw(ask :consistent);
40             for (0..1000) {
41             my $reply = ask("Is this module any use whatsoever?"); # reply will always be the same
42             }
43            
44             =head1 DESCRIPTION
45              
46             This is an almost utterly pointless module. But I needed it. So there.
47              
48             =head1 METHODS
49              
50             =head2 ask [answers]
51              
52             Ask and ye shall receive!
53              
54             If you don't pass in an array of answers it will use the traditional ones.
55              
56             =cut
57            
58             sub ask {
59 1006   100 1006 1 5326 my $question = shift || return "You must ask a question!";
60 1005         1064 my @answers = @_;
61              
62 1005 100       1578 unless (@answers) {
63 1004         1083 my $pos = tell DATA;
64 1004         14074 @answers = map { chomp; $_ } ;
  20080         15688  
  20080         22068  
65 1004         5598 seek DATA, $pos,0;
66             }
67 1005 100       1772 return $answers[rand @answers] unless $CONSISTENT;
68              
69 1002         951 my $hashcode = 0;
70 1002         11823 $hashcode += ord($_) foreach split(//, $question);
71 1002         5658 return $answers[$hashcode % scalar(@answers) - 1];
72             }
73              
74             =head1 AUTHOR
75              
76             Simon Wistow
77              
78             =head1 COPYING
79              
80             Copyright 2005, Simon Wistow
81              
82             Distributed under the same terms as Perl itself.
83              
84             =head1 DEVELOPMENT
85              
86             You can get the latest version from
87              
88             https://github.com/simonwistow/Acme-Magic8Ball
89              
90             =head1 SEE ALSO
91              
92             The 8 Ball FAQ - http://8ball.ofb.net/faq.html
93              
94             Mattel (who own the 8 Ball) - http://www.mattel.com
95              
96             =cut
97              
98              
99              
100              
101             __DATA__