File Coverage

blib/lib/Mock/Populate.pm
Criterion Covered Total %
statement 20 22 90.9
branch n/a
condition n/a
subroutine 8 8 100.0
pod n/a
total 28 30 93.3


line stmt bran cond sub pod time code
1             package Mock::Populate;
2             BEGIN {
3 2     2   2002 $Mock::Populate::AUTHORITY = 'cpan:GENE';
4             }
5              
6             # ABSTRACT: Mock data creation
7              
8             our $VERSION = '0.0901';
9              
10 2     2   16 use strict;
  2         5  
  2         66  
11 2     2   10 use warnings;
  2         4  
  2         74  
12              
13 2     2   10 use constant NDATA => 10;
  2         5  
  2         129  
14 2     2   10 use constant PREC => 2;
  2         2  
  2         77  
15 2     2   9 use constant DOF => 2;
  2         3  
  2         69  
16 2     2   9 use constant SIZE => 8;
  2         2  
  2         73  
17              
18 2     2   1017 use Data::SimplePassword;
  0            
  0            
19             use Date::Range;
20             use Date::Simple qw(date today);
21             use Image::Dot;
22             use List::Util qw(shuffle);
23             use Mock::Person;
24             use Statistics::Distributions;
25             use Text::Password::Pronounceable;
26             use Text::Unidecode;
27             use Time::Local;
28              
29              
30             sub date_ranger {
31             my %args = @_;
32             # Set defaults.
33             $args{start} ||= '2001-01-01';
34             $args{end} ||= today();
35             $args{N} ||= NDATA;
36              
37             # Convert the dates into a range.
38             my $date1 = date($args{start});
39             my $date2 = date($args{end});
40             my $range = Date::Range->new($date1, $date2);
41              
42             # Declare the number of days in the range.
43             my $offset = 0;
44              
45             # Bucket for our result list.
46             my @results;
47              
48             for(1 .. $args{N}) {
49             # Get a random number of days in the range.
50             $offset = int(rand $range->length);
51              
52             # Save the stringified start date plus the offest.
53             my $date = $date1 + $offset;
54             push @results, "$date";
55             }
56              
57             return \@results;
58             }
59              
60              
61             sub date_modifier {
62             # Get the number of days in the future and the date list.
63             my ($offset, @dates) = @_;
64              
65             # Bucket for our result list.
66             my @results;
67              
68             for my $date (@dates) {
69             # Cast the current date string as an object.
70             my $current = date($date);
71              
72             # Get a random number of days in the future.
73             my $m = int(rand $offset) + 1;
74              
75             # Save the stringified date plus the offest.
76             $date = $current + $m;
77             push @results, "$date";
78             }
79              
80             return \@results;
81             }
82              
83              
84             sub time_ranger {
85             my %args = @_;
86             # Set defaults.
87             $args{stamp} ||= 1;
88             $args{start} ||= '00:00:00';
89             $args{end} ||= '';
90             $args{N} ||= NDATA;
91              
92             # Split the :-separated times.
93             my @start = split ':', $args{start};
94             my @end = $args{end} ? split(':', $args{end}) : _now();
95             #warn "S->E: @start -> @end\n";
96              
97             # Compute the number of seconds between start and end.
98             my $start_time = timegm(@start[2, 1, 0], (localtime(time))[3, 4, 5]);
99             my $end_time = timegm(@end[2, 1, 0], (localtime(time))[3, 4, 5]);
100             my $range = $end_time - $start_time;
101             #warn "R: $end_time (@end) - $start_time (@start) = $range\n";
102              
103             # Declare the number of seconds.
104             my $offset = 0;
105              
106             # Bucket for our result list.
107             my @results;
108              
109             # Generate a time, N times.
110             for(1 .. $args{N}) {
111             # Get a random number of seconds in the range.
112             $offset = int(rand $range);
113              
114             # Print the start time plus the offest seconds.
115             if ($args{stamp}) {
116             # In HH:MM::SS format.
117             my $time = scalar localtime($start_time + $offset);
118             push @results, (split / /, $time)[3];
119             }
120             else {
121             # As a number of seconds from the "epoc."
122             push @results, $start_time + $offset;
123             }
124             }
125              
126             return \@results;
127             }
128              
129             sub _now { # Return hour, minute, second.
130             return (localtime(time))[2, 1, 0];
131             }
132              
133              
134             sub number_ranger {
135             my %args = @_;
136             # Set defaults.
137             $args{start} ||= 0;
138             $args{end} ||= NDATA;
139             $args{prec} ||= PREC;
140             $args{random} ||= 1;
141             $args{N} ||= NDATA;
142              
143             # Bucket for our result list.
144             my @results;
145              
146             # Do we want random numbers?
147             if ($args{random}) {
148             # Roll!
149             for(1 .. $args{N}) {
150             # Get our random candidate.
151             my $x = rand($args{end});
152             # Make sure it is above the start value.
153             while ($x < $args{start}) {
154             $x = rand($args{end});
155             }
156             push @results, $x;
157             }
158             }
159             else {
160             # Use a simple sequence of integers.
161             @results = ($args{start} .. $args{end});
162             }
163              
164             return \@results;
165             }
166              
167              
168             sub name_ranger {
169             my %args = @_;
170             # Set defaults.
171             $args{gender} ||= 0;
172             $args{names} ||= 2;
173             $args{country} ||= 'us';
174             $args{N} ||= NDATA;
175              
176             # Bucket for our result list.
177             my @results;
178              
179             # Roll!
180             for my $i (1 .. $args{N}) {
181             # Get our random person.
182             my $p = '';
183             # If gender is 'both' alternate male-female.
184             # Or if gender is not 'male' then ...female!
185             if (($args{gender} eq 'b' && $i % 2) || $args{gender} eq 'f') {
186             $p = Mock::Person::name(sex => 'female', country => $args{country});
187             }
188             else {
189             $p = Mock::Person::name(sex => 'male', country => $args{country});
190             }
191             # Only use the requested number of names.
192             my @names = split / /, $p;
193             my $name = '';
194             if ($args{names} == 1) {
195             push @results, $names[-1];
196             }
197             elsif ($args{names} == 2) {
198             push @results, "@names[0,-1]";
199             }
200             else {
201             push @results, $p;
202             }
203             }
204              
205             return \@results;
206             }
207              
208              
209             sub email_modifier {
210             my @people = @_;
211              
212             # Bucket for our results.
213             my @results = ();
214              
215             # Generate email addresses if requested.
216             my @tld = qw( com net org edu );
217              
218             for my $p (@people) {
219             # Break up the name.
220             my @name = split / /, $p;
221              
222             # Turn any unicode characters into something ascii.
223             $_ = unidecode($_) for @name;
224              
225             # Add an email address for the person.
226             my $email = lc($name[0]);
227             $email .= '.'. lc($name[-1]) if @name > 1;
228             $email .= '@example.' . $tld[rand @tld];
229             push @results, $email;
230             }
231              
232             return \@results;
233             }
234              
235              
236             sub distributor {
237             my %args = @_;
238             # Set defaults.
239             $args{type} ||= 'u';
240             $args{prec} ||= PREC;
241             $args{dof} ||= DOF;
242             $args{N} ||= NDATA;
243              
244             # Separate numerator/denominator for F degs-of-freedm.
245             my $e = 1;
246             ($args{dof}, $e) = split(/\//, $args{dof}) if $args{type} eq 'f';
247              
248             # Bucket for our result list.
249             my @results;
250              
251             # Roll!
252             for(1 .. $args{N}) {
253             # Select distribution.
254             if ($args{type} eq 'c') {
255             # Chi-squared
256             push @results, Statistics::Distributions::chisqrdistr($args{dof}, rand);
257             }
258             elsif ($args{type} eq 's') {
259             # Student's T
260             push @results, Statistics::Distributions::tdistr($args{dof}, rand);
261             }
262             elsif ($args{type} eq 'f') {
263             # F distribution
264             push @results, Statistics::Distributions::fdistr($args{dof}, $e, rand);
265             }
266             else {
267             # Normal
268             push @results, Statistics::Distributions::udistr(rand);
269             }
270             }
271              
272             return \@results;
273             }
274              
275              
276             sub shuffler {
277             # Get the desired number of data-points.
278             my $n = defined $_[0] ? shift : 9;
279             # Get the items to shuffle.
280             my @items = @_ ? @_ : ('a' .. 'j');
281             return [ shuffle(@items) ];
282             }
283              
284              
285             sub string_ranger {
286             my %args = @_;
287             # Set defaults.
288             $args{length} ||= SIZE;
289             $args{type} ||= 'default';
290             $args{N} ||= NDATA;
291              
292             # Declare a pw instance.
293             my $sp = Data::SimplePassword->new;
294              
295             # Declare the types (lifted directly from rndpassword).
296             my $chars = {
297             default => [ 0..9, 'a'..'z', 'A'..'Z' ],
298             ascii => [ map { sprintf "%c", $_ } 33 .. 126 ],
299             base64 => [ 0..9, 'a'..'z', 'A'..'Z', qw(+ /) ],
300             path => [ 0..9, 'a'..'z', 'A'..'Z', qw(. /) ],
301             simple => [ 0..9, 'a'..'z' ],
302             alpha => [ 'a'..'z' ],
303             digit => [ 0..9 ],
304             binary => [ qw(0 1) ],
305             morse => [ qw(. -) ],
306             hex => [ 0..9, 'a'..'f' ],
307             pron => [],
308             };
309             # Set the chars based on the given type.
310             $sp->chars( @{ $chars->{$args{type}} } );
311              
312             # Declare a bucket for our results.
313             my @results = ();
314              
315             # Roll!
316             for(1 .. $args{N}) {
317             if ($args{type} eq 'pron') {
318             push @results, Text::Password::Pronounceable->generate(
319             $args{length}, $args{length});
320             }
321             else {
322             push @results, $sp->make_password($args{length});
323             }
324             }
325              
326             return \@results;
327             }
328              
329              
330             sub image_ranger {
331             my %args = @_;
332             # Set defaults.
333             $args{size} ||= SIZE;
334             $args{N} ||= NDATA;
335              
336             # Declare a bucket for our results.
337             my @results = ();
338              
339             # Start with a 1x1 pixel image.
340             my $img = dot_PNG_RGB(0, 0, 0);
341              
342             # XXX This is naive and sad:
343             # Pull-apart the image data.
344             (my $head = $img) =~ s/^(.*?IDAT).*$/$1/ms;
345             (my $tail = $img) =~ s/^.*?(IEND.*)$/$1/ms;
346             $img =~ s/^.*?IDAT(.*?)IEND.*$/$1/ms;
347              
348             for (1 .. $args{N}) {
349             # Increase the byte size (not dimension).
350             my $i = $head . ($img x int(rand $args{size})) . $tail;
351             #warn "L: ",length($i), "\n";
352              
353             # Save the result.
354             push @results, $i;
355             }
356              
357             return \@results;
358             }
359              
360              
361             sub collate {
362             # Accept any number of columns.
363             my @columns = @_;
364              
365             # Make a copy of the columns to peel off.
366             my @lists = @columns;
367              
368             # Declare the bucket for our arrayrefs.
369             my @results = ();
370              
371             # Add each list item to rows of collated.
372             for my $list (@columns) {
373             for my $i (0 .. @$list - 1) {
374             push @{ $results[$i] }, $list->[$i];
375             }
376             }
377              
378             return \@results;
379             }
380              
381             1;
382              
383             __END__