File Coverage

blib/lib/Test/Sims.pm
Criterion Covered Total %
statement 92 93 98.9
branch 17 18 94.4
condition 3 3 100.0
subroutine 20 20 100.0
pod 2 2 100.0
total 134 136 98.5


line stmt bran cond sub pod time code
1             package Test::Sims;
2              
3 10     10   199455 use strict;
  10         21  
  10         400  
4 10     10   55 use warnings;
  10         18  
  10         814  
5              
6             our $VERSION = "20130412";
7              
8             =head1 NAME
9              
10             Test::Sims - Helps build semi-random data for testing
11              
12             =head1 SYNOPSIS
13              
14             package My::Sims;
15              
16             use Test::Sims;
17              
18             # Creates rand_name() and exported on demand.
19             make_rand name => [
20             qw(Mal Zoe Jayne Kaylee Inara River Simon Wash Zoe Book)
21             ];
22              
23             # Automatically exported
24             sub sim_character {
25             my %defaults = (
26             name => rand_name(),
27             series => "Firefly",
28             );
29              
30             require Character;
31             return Character->new(
32             %defaults, @_;
33             );
34             }
35              
36              
37             =head1 DESCRIPTION
38              
39             B! While very well tested behaviors may
40             change. The interface is not stable.
41              
42             This is a module to help building semi-random data for testing and to
43             create large, nested, interesting data structures.
44              
45             This module contains no new assertions, but it does tie in with
46             Test::Builder.
47              
48             It does two things. It contains functions which make generating
49             random data easier and it allows you to write repeatable, yet random,
50             test data.
51              
52             =head2 make_rand()
53              
54             my $code = make_rand $name => \@list;
55             my $code = make_rand $name => sub { ... };
56              
57             Creates a subroutine called C<> and exports it on request.
58              
59             If a @list is given it will generate a subroutine which returns
60             elements out of @list at random. It takes C and C arguments
61             to control how many.
62              
63             my @items = rand_$name(
64             min => $min_random_items,
65             max => $max_random_items
66             );
67              
68             C and C both default to 1. So by default you get 1 item.
69              
70             If a subroutine is given it will simply give that routine a name.
71             This is just to get the convenience of adding it to the exports.
72              
73             Also adds it to a "rand" export tag.
74              
75             {
76             package Sim::Firefly;
77              
78             make_rand crew => [
79             qw(Zoe Wash Mal River Simon Book Jayne Kaylee Inara)
80             ];
81             }
82              
83             ...later...
84              
85             {
86             use Sim::Firefly ":rand";
87              
88             my $crew = rand_crew; # 1 name
89             my @crew = rand_crew( max => 3 ); # 1, 2 or 3 names
90             }
91              
92              
93             =head2 export_sims()
94              
95             export_sims();
96              
97             A utility function which causes your module to export all the
98             functions called C<>. It also creates an export tag called
99             "sims".
100              
101             You should call this at the end of your Sim package.
102              
103              
104             =head2 Controlling randomness
105              
106             You can control the random seed used by Test::Sims by setting the
107             C environment variable. This is handy to make test runs
108             repeatable.
109              
110             TEST_SIMS_SEED=12345 perl -Ilib t/some_test.t
111              
112             Test::Sims will output the seed used at the end of each test run. If
113             the test failed it will be visible to the user, otherwise it will be a
114             TAP comment and only visible if the test is run verbosely.
115              
116             If having new data every run is too chaotic for you, you can set
117             TEST_SIMS_SEED to something which will remain fixed during a
118             development session. Perhaps the PID of your shell or your uid or
119             the date (20090704, for example).
120              
121              
122             =head2 C functions
123              
124             Test::Sims doesn't do anything with functions named C but
125             export them. Generally we recommend they're written like so:
126              
127             sub sim_thing {
128             my %defaults = (
129             name => rand_name(),
130             age => rand_age(),
131             motto => rand_text(),
132             picture => rand_image(),
133             );
134              
135             return Thing->new( %defaults, @_ );
136             }
137              
138             This way you can get a completely random Thing.
139              
140             my $thing = sim_thing();
141              
142             Or you can lock down the bits you need leaving the rest to float free.
143              
144             # Joe's motto and picture remain random
145             my $joe = sim_thing(
146             name => "Joe",
147             age => 64
148             );
149              
150              
151             =cut
152              
153 10     10   65 use base qw(Exporter);
  10         21  
  10         1926  
154             our @EXPORT = qw(make_rand export_sims);
155              
156             # Yes, its not a great seed but it doesn't have to be secure.
157             my $Seed = defined $ENV{TEST_SIMS_SEED} ? $ENV{TEST_SIMS_SEED} : (time ^ ($$ * $< * $());
158              
159             # XXX If something else calls srand() we're in trouble
160             srand $Seed;
161              
162             ## no critic (Subroutines::RequireArgUnpacking)
163             sub import {
164 7     7   131 my $class = shift;
165 7         15 my $caller = caller;
166              
167             {
168 10     10   224 no strict 'refs';
  10         19  
  10         9752  
  7         17  
169 7 100       874 unshift @{ $caller . "::ISA" }, "Exporter" unless $caller->isa("Exporter");
  6         78  
170             }
171              
172 7         19565 return __PACKAGE__->export_to_level( 1, $class, @_ );
173             }
174              
175             sub make_rand {
176 6     6 1 15172 my $name = shift;
177 6         14 my $thing = shift;
178              
179 6 100       32 my $items = ref $thing eq "ARRAY" ? $thing : [];
180              
181 6         20 my $caller = caller;
182              
183             my $code = ref $thing eq 'CODE' ? $thing : sub {
184 5     5   79 my %args = @_;
185 5 100       18 $args{min} = 1 unless defined $args{min};
186 5 100       17 $args{max} = 1 unless defined $args{max};
187              
188 5         21 my $max = int rand( $args{max} - $args{min} + 1 ) + $args{min};
189              
190 5         9 my @return;
191 5         11 for( 1 .. $max ) {
192 12         42 push @return, $items->[ rand @$items ];
193             }
194              
195 5 100       39 return @return == 1 ? $return[0] : @return;
196 6 100       54 };
197              
198 6         20 my $func = "rand_$name";
199 6         28 _alias( $caller, $func, $code );
200 6         20 _add_to_export_ok( $caller, $func );
201 6         21 _add_to_export_tags( $caller, $func, 'rand' );
202              
203 6         18 return $code;
204             }
205              
206             sub export_sims {
207 1     1 1 5 my $caller = caller;
208              
209 1         2 my $symbols = do {
210 10     10   60 no strict 'refs';
  10         19  
  10         1752  
211 1         2 \%{ $caller . '::' };
  1         4  
212             };
213              
214 1         12 my @sim_funcs = grep { *{ $symbols->{$_} }{CODE} }
  2         3  
  2         13  
215             grep /^sim_/, keys %$symbols;
216 1         4 for my $func (@sim_funcs) {
217 2         6 _add_to_export( $caller, $func );
218 2         4 _add_to_export_tags( $caller, $func, 'sims' );
219             }
220              
221 1         3 return;
222             }
223              
224             sub _add_to_export_ok {
225 6     6   14 my( $package, $func ) = @_;
226              
227 10     10   66 no strict 'refs';
  10         24  
  10         772  
228 6         9 push @{ $package . '::EXPORT_OK' }, $func;
  6         35  
229              
230 6         13 return;
231             }
232              
233             sub _add_to_export {
234 2     2   5 my( $package, $func ) = @_;
235              
236 10     10   49 no strict 'refs';
  10         41  
  10         743  
237 2         3 push @{ $package . '::EXPORT' }, $func;
  2         7  
238              
239 2         3 return;
240             }
241              
242             sub _add_to_export_tags {
243 8     8   17 my( $package, $func, $tag ) = @_;
244              
245 10     10   47 no strict 'refs';
  10         17  
  10         894  
246 8         15 my $export_tags = \%{ $package . '::EXPORT_TAGS' };
  8         41  
247 8         100 push @{ $export_tags->{$tag} }, $func;
  8         48  
248              
249 8         21 return;
250             }
251              
252             sub _alias {
253 6     6   17 my( $package, $func, $code ) = @_;
254              
255 10     10   47 no strict 'refs';
  10         19  
  10         3093  
256 6         14 *{ $package . '::' . $func } = $code;
  6         84  
257              
258 6         15 return;
259             }
260              
261              
262             sub _test_was_successful {
263 8     8   25 my $tb = shift;
264              
265 8 50       105 if( $tb->can("history") ) {
266 0         0 return $tb->history->test_was_successful;
267             }
268             else {
269 8   100     40 return $tb->summary && !( grep !$_, $tb->summary );
270             }
271             }
272              
273             sub _display_seed {
274 8     8   25 my $tb = shift;
275              
276 8         33 my $ok = _test_was_successful($tb);
277 8         237 my $msg = "TEST_SIMS_SEED=$Seed";
278 8 100       670 $ok ? $tb->note($msg) : $tb->diag($msg);
279              
280 8         845 return;
281             }
282              
283             END {
284 5     5   8788 require Test::Builder;
285 5         24 my $tb = Test::Builder->new;
286              
287 5 100       42 if( defined $tb->has_plan ) {
288 4         47 _display_seed($tb);
289             }
290             }
291              
292             1;
293              
294              
295             =head1 EXAMPLE
296              
297             Here's an example of making a simple package to generate random dates.
298              
299             package Sim::Date;
300              
301             use strict;
302             use warnings;
303              
304             require DateTime;
305             use Test::Sims;
306              
307             make_rand year => [1800..2100];
308              
309             sub sim_datetime {
310             my %args = @_;
311              
312             my $year = $args{year} || rand_year();
313             my $date = DateTime->new( year => $year );
314              
315             my $days_in_year = $date->is_leap_year ? 366 : 365;
316             my $secs = rand( $days_in_year * 24 * 60 * 60 );
317             $date->add( seconds => $secs );
318              
319             $date->set( %args );
320              
321             return $date;
322             }
323              
324             export_sims();
325              
326             And then using it.
327              
328             use Sim::Date;
329              
330             # Random date.
331             my $date = sim_datetime;
332              
333             # Random date in July 2009
334             my $date = sim_datetime(
335             year => 2009,
336             month => 7,
337             );
338              
339              
340             =head1 ENVIRONMENT
341              
342             =head3 TEST_SIMS_SEED
343              
344             If defined its value will be used to make tests repeatable. See
345             L.
346              
347              
348             =head1 SEE ALSO
349              
350             "Generating Test Data with The Sims"
351             L
352             is a set of slides outlining the Sims testing technique which this
353             module is supporting.
354              
355             L for common rand_* routines.
356              
357             L to generate random data from a set of rules.
358              
359              
360             =head1 SOURCE
361              
362             The source code repository can be found at
363             L.
364              
365             The latest release can be found at
366             L.
367              
368              
369             =head1 BUGS
370              
371             Please report bugs, problems, rough corners, feedback and suggestions
372             to L.
373              
374             Report early, report often.
375              
376              
377             =head1 THANKS
378              
379             Thanks go to the folks at Blackstar and Grant Street Group for helping
380             to develop this technique.
381              
382              
383             =head1 LICENSE and COPYRIGHT
384              
385             Copyright 2009 Michael G Schwern Eschwern@pobox.comE
386              
387             This program is free software; you can redistribute it and/or
388             modify it under the same terms as Perl itself.
389              
390             See F
391              
392             =cut
393