File Coverage

blib/lib/random.pm
Criterion Covered Total %
statement 22 22 100.0
branch 9 10 90.0
condition 2 2 100.0
subroutine 7 7 100.0
pod 1 1 100.0
total 41 42 97.6


line stmt bran cond sub pod time code
1             package random;
2              
3 3     3   90311 use warnings;
  3         7  
  3         112  
4 3     3   19 use strict;
  3         6  
  3         104  
5 3     3   84 use 5.010;
  3         48  
  3         843  
6              
7             =head1 NAME
8              
9             random - have rand() return integers or fixed values
10              
11             =head1 VERSION
12              
13             Version 0.01
14              
15             =cut
16              
17             our $VERSION = '0.02';
18              
19              
20             =head1 SYNOPSIS
21              
22             use random;
23              
24             my $dice = 1 + rand 6; # one of 1 .. 6
25              
26             # or
27             use random qw(integer);
28              
29             my $dice = 1 + rand 6; # one of 1 .. 6
30              
31             use random qw(fixed 6); # cheat on dice
32              
33             my $six = rand; # 6
34              
35              
36             =head1 EXPORT
37              
38             Nothing.
39              
40             =head1 FUNCTIONS
41              
42             =head2 import
43              
44             =cut
45              
46             sub import {
47 3     3   22 shift; #
48 3 100       20 my %args = @_<=1? ( "integer" => 1) : @_;
49            
50 3 50       24 $^H{random} = $args{fixed} ? $args{fixed}
    100          
51             : $args{integer} ? -123456789
52             : undef;
53             return
54 3         1743 }
55              
56             =head2 unimport
57              
58             =cut
59              
60             sub unimport {
61 1     1   8 undef $^H{random};
62 1         1854 return;
63             }
64              
65             =head2 rand
66              
67             when random (integer) is in effect it returns int(rand)
68              
69             when random (fixed) is in effect it returns the fixed value
70              
71             otherwise CORE::rand
72              
73             =cut
74              
75             sub rand {
76 3     3 1 1302 my $ctrl_h = ( caller 0 )[10];
77 3   100     210 my $param = $_[0] // 1;
78 3 100       21 if ( !defined $ctrl_h->{random}) {
    100          
79 1         7 return CORE::rand($param);
80             }
81             elsif ( -123456789 eq $ctrl_h->{random} ){
82 1         74 return int($param * CORE::rand);
83             }
84             else {
85 1         11 return $ctrl_h->{random};
86             }
87             }
88              
89             BEGIN {
90 3     3   118 *CORE::GLOBAL::rand = *random::rand;
91             }
92              
93              
94             =head1 AUTHOR
95              
96             Joerg Meltzer, C<< >>
97              
98             =head1 BUGS
99              
100             Please report any bugs or feature requests to C, or through
101             the web interface at L. I will be notified, and then you'll
102             automatically be notified of progress on your bug as I make changes.
103              
104             The fixed value -123456789 doesn't work. The value is reserved to make the integer option work.
105              
106              
107             =head1 SUPPORT
108              
109             You can find documentation for this module with the perldoc command.
110              
111             perldoc random
112              
113              
114             You can also look for information at:
115              
116             =over 4
117              
118             =item * RT: CPAN's request tracker
119              
120             L
121              
122             =item * AnnoCPAN: Annotated CPAN documentation
123              
124             L
125              
126             =item * CPAN Ratings
127              
128             L
129              
130             =item * Search CPAN
131              
132             L
133              
134             =back
135              
136              
137             =head1 ACKNOWLEDGEMENTS
138              
139             Thanx goes to Abeltje (http://yapc.tv/2008/ye/lt/lt2-02-abeltje-fixedtime).
140             I learned about pragmas watching your show.
141              
142             =head1 COPYRIGHT & LICENSE
143              
144             Copyright 2009 Joerg Meltzer, all rights reserved.
145              
146             This program is free software; you can redistribute it and/or modify it
147             under the same terms as Perl itself.
148              
149              
150             =cut
151              
152             "Der liebe Gott wuerfelt nicht.";