File Coverage

blib/lib/Math/Random/MT/Auto/Range.pm
Criterion Covered Total %
statement 84 88 95.4
branch 15 24 62.5
condition 5 11 45.4
subroutine 21 21 100.0
pod 6 8 75.0
total 131 152 86.1


line stmt bran cond sub pod time code
1             package Math::Random::MT::Auto::Range; {
2              
3 3     3   3251 use strict;
  3         10  
  3         94  
4 3     3   15 use warnings;
  3         5  
  3         168  
5              
6             our $VERSION = '6.23';
7             $VERSION = eval $VERSION;
8              
9 3     3   20 use Scalar::Util 1.18;
  3         52  
  3         167  
10              
11             # Declare ourself as a subclass
12 3     3   18 use Object::InsideOut 'Math::Random::MT::Auto' => [ ':!auto' ];
  3         6  
  3         25  
13              
14              
15             ### Inside-out Object Attributes ###
16              
17             # Object data is stored in these attribute hashes, and is keyed to the object
18             # by a unique ID that is stored in the object's scalar reference.
19             #
20             # These hashes are declared using the 'Field' attribute.
21              
22             # Range information for our objects
23             my %type_of :Field; # Type of return value: INTEGER or DOUBLE
24             my %low_for :Field; # Low end of the range
25             my %high_for :Field; # High end of the range
26             my %range_for :Field; # 'Difference' between LOW and HIGH
27             # (used for performance considerations)
28              
29              
30             ### Inside-out Object Internal Subroutines ###
31              
32             my %init_args :InitArgs = (
33             'LOW' => {
34             'REGEX' => qr/^lo(?:w)?$/i,
35             'MANDATORY' => 1,
36             'TYPE' => 'NUMBER',
37             },
38             'HIGH' => {
39             'REGEX' => qr/^hi(?:gh)?$/i,
40             'MANDATORY' => 1,
41             'TYPE' => 'NUMBER',
42             },
43             'TYPE' => qr/^type$/i, # Range type
44             );
45              
46             # Object initializer
47             sub _init :Init
48             {
49 5         64 my $self = $_[0];
50 5         12 my $args = $_[1]; # Hash ref containing arguments from object
51             # constructor as specified by %init_args above
52              
53             # Default 'TYPE' to 'INTEGER' if 'LOW' and 'HIGH' are both integers.
54             # Otherwise, default to 'DOUBLE'.
55 5 100       21 if (! exists($$args{'TYPE'})) {
56 2         6 my $lo = $$args{'LOW'};
57 2         6 my $hi = $$args{'HIGH'};
58 2 50 33     15 $$args{'TYPE'} = (($lo == int($lo)) && ($hi == int($hi)))
59             ? 'INTEGER'
60             : 'DOUBLE';
61             }
62              
63             # Initialize object
64 5         29 $self->set_range_type($$args{'TYPE'});
65 5         23 $self->set_range($$args{'LOW'}, $$args{'HIGH'});
66 3     3   1257 }
  3         7  
  3         25  
67              
68              
69             ### Object Methods ###
70              
71             # Sets numeric type random values
72             sub set_range_type
73             {
74 6     6 1 13 my $self = shift;
75              
76             # Check argument
77 6         11 my $type = $_[0];
78 6 50 33     75 if (! defined($type) || $type !~ /^[ID]/i) {
79 0 0       0 MRMA::Args->die(
80             'caller_level' => (caller() eq __PACKAGE__) ? 2 : 0,
81             'message' => "Bad range type: $type",
82             'Usage' => q/Range type must be 'INTEGER' or 'DOUBLE'/);
83             }
84              
85 6 100       40 $type_of{$$self} = ($type =~ /^I/i) ? 'INTEGER' : 'DOUBLE';
86             }
87              
88              
89             # Return current range type
90             sub get_range_type
91             {
92 3     3 1 7141 my $self = shift;
93 3         19 return ($type_of{$$self});
94             }
95              
96              
97             # Set random number range
98             sub set_range
99             {
100 6     6 1 15 my $self = shift;
101              
102             # Check for arguments
103 6         16 my ($lo, $hi) = @_;
104 6 50 33     65 if (! Scalar::Util::looks_like_number($lo) ||
105             ! Scalar::Util::looks_like_number($hi))
106             {
107 0         0 MRMA::Args->die(
108             'message' => q/Bad range arguments/,
109             'Usage' => q/Range must be specified using 2 numeric arguments/);
110             }
111              
112             # Ensure arguments are of the proper type
113 6 100       28 if ($type_of{$$self} eq 'INTEGER') {
114 5         17 $lo = int($lo);
115 5         12 $hi = int($hi);
116             } else {
117 1         2 $lo = 0.0 + $lo;
118 1         4 $hi = 0.0 + $hi;
119             }
120             # Make sure 'LOW' and 'HIGH' are not the same
121 6 50       30 if ($lo == $hi) {
122 0 0       0 MRMA::Args->die(
123             'caller_level' => (caller() eq __PACKAGE__) ? 2 : 0,
124             'message' => q/Invalid arguments: LOW and HIGH are equal/,
125             'Usage' => q/The range must be a non-zero interval/);
126             }
127             # Ensure LOW < HIGH
128 6 50       20 if ($lo > $hi) {
129 0         0 ($lo, $hi) = ($hi, $lo);
130             }
131              
132             # Set range parameters
133 6         54 $low_for{$$self} = $lo;
134 6         18 $high_for{$$self} = $hi;
135 6 100       31 if ($type_of{$$self} eq 'INTEGER') {
136 5         33 $range_for{$$self} = ($high_for{$$self} - $low_for{$$self}) + 1;
137             } else {
138 1         6 $range_for{$$self} = $high_for{$$self} - $low_for{$$self};
139             }
140             }
141              
142              
143             # Return object's random number range
144             sub get_range
145             {
146 3     3 1 8 my $self = shift;
147 3         17 return ($low_for{$$self}, $high_for{$$self});
148             }
149              
150              
151             # Return a random number of the configured type and within the configured
152             # range.
153             sub rrand
154             {
155 1048     1048 1 552807 my $self = $_[0];
156              
157 1048 100       3525 if ($type_of{$$self} eq 'INTEGER') {
158             # Integer random number range [LOW, HIGH]
159 1018         5048 return (($self->irand() % $range_for{$$self}) + $low_for{$$self});
160             } else {
161             # Floating-point random number range [LOW, HIGH)
162 30         117 return ($self->rand($range_for{$$self}) + $low_for{$$self});
163             }
164             }
165              
166              
167             ### Overloading ###
168              
169             sub as_string :Stringify :Numerify
170             {
171 2     2 0 1025 return ($_[0]->rrand());
172 3     3   2336 }
  3         6  
  3         17  
173              
174             sub bool :Boolify
175             {
176 1     1 0 585 return ($_[0]->rrand() & 1);
177 3     3   843 }
  3         7  
  3         12  
178              
179             sub array :Arrayify
180             {
181 2     2 1 1212 my $self = $_[0];
182 2   100     8 my $count = $_[1] || 1;
183              
184 2         4 my @ary;
185 2         3 do {
186 4         8 push(@ary, $self->rrand());
187             } while (--$count > 0);
188              
189 2         10 return (\@ary);
190 3     3   848 }
  3         8  
  3         14  
191              
192             sub _code :Codify
193             {
194 1     1   619 my $self = $_[0];
195 1     1   6 return (sub { $self->rrand(); });
  1         5  
196 3     3   768 }
  3         6  
  3         14  
197              
198              
199             ### Serialization ###
200              
201             # Support for ->dump() method
202             sub _dump :Dumper
203             {
204 1         13 my $obj = shift;
205              
206             return ({
207             'HIGH' => $high_for{$$obj},
208             'LOW' => $low_for{$$obj},
209 1         9 'TYPE' => $type_of{$$obj}
210             });
211 3     3   800 }
  3         13  
  3         13  
212              
213             # Support for Object::InsideOut::pump()
214             sub _pump :Pumper
215             {
216 1         65 my ($obj, $data) = @_;
217              
218 1         6 $obj->set_range_type($$data{'TYPE'});
219 1         6 $obj->set_range($$data{'LOW'}, $$data{'HIGH'});
220 3     3   783 }
  3         9  
  3         12  
221              
222             } # End of package's lexical scope
223              
224             1;
225              
226             __END__