File Coverage

blib/lib/Mock/Data/Set.pm
Criterion Covered Total %
statement 69 89 77.5
branch 23 46 50.0
condition 16 32 50.0
subroutine 13 14 92.8
pod 7 7 100.0
total 128 188 68.0


line stmt bran cond sub pod time code
1             package Mock::Data::Set;
2 9     9   238366 use strict;
  9         20  
  9         299  
3 9     9   45 use warnings;
  9         19  
  9         11093  
4             require Mock::Data::Generator;
5             our @ISA= qw( Mock::Data::Generator );
6              
7             # ABSTRACT: Generator which returns one item from a set
8             our $VERSION = '0.01'; # VERSION
9              
10              
11             sub new {
12 19     19 1 7230 my $class= shift;
13 19 100 66     150 my %args= @_ == 1 && ref $_[0] eq 'HASH'? %{$_[0]}
  0 50 66     0  
14             : @_ == 1 && ref $_[0] eq 'ARRAY'? ( items => $_[0] )
15             : @_;
16 19         87 bless \%args, $class;
17             }
18              
19             sub new_weighted {
20 2     2 1 3121 my $class= shift;
21 2 50       11 @_ & 1 and Carp::croak("Odd number of elements given to new_weighted, need (value => weight) pairs");
22 2         6 my (@items, @weights);
23 2         6 while (@_) {
24 7         14 push @items, shift;
25 7         14 push @weights, shift;
26             }
27 2         9 $class->new(items => \@items, weights => \@weights);
28             }
29              
30              
31             sub items {
32 131     131 1 7455 my $self= shift;
33 131 50       316 return $self->{items} unless @_;
34 0         0 my $val= shift;
35 0 0       0 delete $self->{_odds_table} if $#{$self->{items}} != $#$val;
  0         0  
36 0         0 return $self->{items}= $val;
37             }
38              
39             sub weights {
40 118     118 1 685 my $self= shift;
41 118 50       278 return $self->{weights} unless @_;
42 0         0 delete $self->{_odds_table};
43 0         0 return $self->{weights}= shift;
44             }
45              
46              
47             sub generate {
48 108     108 1 2060 my $self= shift;
49 108         167 my $items= $self->items;
50 108         146 my $pick;
51 108 100       163 if (!$self->weights) {
52 7         25 $pick= rand( scalar @$items );
53             } else {
54             # binary search for the random number
55 101         143 my $tbl= $self->_odds_table;
56 101         185 my ($min, $max, $r)= (0, $#$items, rand);
57 101         445 while ($min+1 < $max) {
58 141         245 my $mid= int(($max+$min)/2);
59 141 100       215 if ($r < $tbl->[$mid]) { $max= $mid-1; }
  60         114  
60 81         205 else { $min= $mid; }
61             }
62 101 100 100     285 $pick= ($max > $min && $tbl->[$max] <= $r)? $max : $min;
63             }
64 108         170 my $cmp_item= $items->[$pick];
65 108 100 66     328 return $cmp_item unless ref $cmp_item && ref($cmp_item)->can('generate');
66 4         31 $cmp_item->generate(@_);
67             }
68              
69             sub _odds_table {
70 101   66 101   220 $_[0]{_odds_table} ||= $_[0]->_build__odds_table;
71             }
72              
73             sub _build__odds_table {
74 2     2   4 my $self= shift;
75 2         5 my $items= $self->items;
76 2         5 my $weights= $self->weights;
77 2         5 my $total= 0;
78             $total += ($weights->[$_] ||= 1)
79 2   50     17 for 0..$#$items;
80 2         3 my $sum= 0;
81 2         6 return [ map { my $x= $sum; $sum += $_; $x/$total } @$weights ]
  7         9  
  7         9  
  7         22  
82             }
83              
84              
85             sub compile {
86 5     5 1 239 my $self= shift;
87 5         14 my $items= $self->items;
88 5         11 my @compiled;
89 5         15 for (@$items) {
90 5 100 66     32 if (ref && ref->can('generate')) {
91             # Some items are generators. Compile a list of them, but only the generators.
92 2 50 33     19 @compiled= map +(ref && ref->can('generate')? $_->compile : undef), @$items;
93 2         5 last;
94             }
95             }
96            
97 5 50       13 if (!$self->weights) {
98             return !@compiled
99 2     2   24 ? sub { $items->[int rand scalar @$items] }
100             : sub {
101 2     2   7 my $pick= int rand scalar @$items;
102 2 50       7 $compiled[$pick]? $compiled[$pick]->(@_) : $items->[$pick];
103 5 100       38 };
104             }
105             else {
106 0         0 my $odds_table= $self->_odds_table;
107             return sub {
108             # binary search for the random number
109 0     0   0 my ($min, $max, $r)= (0, $#$items, rand);
110 0         0 while ($min+1 < $max) {
111 0         0 my $mid= int(($max+$min)/2);
112 0 0       0 if ($r < $odds_table->[$mid]) { $max= $mid-1; }
  0         0  
113 0         0 else { $min= $mid; }
114             }
115 0 0 0     0 my $pick= ($max > $min && $odds_table->[$max] <= $r)? $max : $min;
116 0 0       0 $compiled[$pick]? $compiled[$pick]->(@_) : $items->[$pick];
117             }
118 0         0 }
119             }
120              
121              
122             sub combine_generator {
123 1     1 1 3 my ($self, $peer)= @_;
124 1         2 my @items= @{$self->items};
  1         4  
125 1         6 my $weights= $self->weights;
126 1 50       13 if ($peer->isa('Mock::Data::Set')) {
127 1         4 my $peer_items= $peer->items;
128 1         3 my $peer_weights= $peer->weights;
129 1 50 33     6 if ($weights || $peer_weights) {
130 0 0       0 $weights= [
    0          
131             $weights? @$weights : (map 1, @items),
132             $peer_weights? @$peer_weights : (map 1, @$peer_items),
133             ];
134             }
135 1         4 push @items, @$peer_items;
136             } else {
137 0         0 push @items, $peer;
138 0 0 0     0 $weights= $weights && @$weights? [ @$weights, List::Util::sum0(@$weights)/@$weights ] : undef;
139             }
140 1         6 return Mock::Data::Set->new(
141             items => \@items,
142             weights => $weights,
143             );
144             }
145              
146             require Mock::Data::Util;
147              
148             __END__