File Coverage

blib/lib/Mock/Data.pm
Criterion Covered Total %
statement 61 88 69.3
branch 29 52 55.7
condition 8 18 44.4
subroutine 11 16 68.7
pod 9 9 100.0
total 118 183 64.4


line stmt bran cond sub pod time code
1             package Mock::Data;
2              
3             # ABSTRACT: Extensible toolkit for generating mock data
4             our $VERSION = '0.01'; # VERSION
5              
6              
7 6     6   975875 use strict;
  6         37  
  6         190  
8 6     6   41 use warnings;
  6         42  
  6         406  
9             BEGIN {
10 6 50   6   65 require MRO::Compat if "$]" < '5.009005';
11 6         30 require mro;
12 6         8966 mro::set_mro(__PACKAGE__, 'c3');
13             }
14             require Storable;
15             require Module::Runtime;
16              
17              
18             sub new {
19 14     14 1 62710 my $class= shift;
20 14 50       107 my $self= ref $class? $class->clone
21             : bless {
22             generators => {}, # can't initialize, plugins go first
23             generator_state => {},
24             _generator_cache => {},
25             _loaded_plugins => {},
26             }, $class;
27 14 100       51 if (@_) {
28 10 50 66     73 my $args
    100 33        
29             = (@_ == 1 && ref $_[0] eq 'ARRAY')? { plugins => $_[0] }
30             : (@_ == 1 && ref $_[0] eq 'HASH')? $_[0]
31             : { @_ };
32 10 100       32 if (my $plugins= $args->{plugins}) {
33             $self= $self->load_plugin($_)
34 8 50       33 for ref $plugins? @$plugins : ( $plugins );
35             }
36             $self->add_generators($args->{generators})
37 10 100       48 if $args->{generators};
38             }
39 14         42 return $self;
40             }
41              
42              
43             sub clone {
44 0     0 1 0 my $self= shift;
45             my $new= {
46             %$self,
47             # Shallow clone generators and _loaded_plugins
48 0         0 _loaded_plugins => { %{ $self->{_loaded_plugins} } },
49 0         0 generators => { %{ $self->{generators} } },
50             # deep clone generator_state
51 0         0 generator_state => Storable::dclone($self->{generator_state}),
52             # clear cache
53             _generator_cache => {},
54             };
55             # Allow generators to handle cloned state
56 0         0 for (values %{ $new->{generators} }) {
  0         0  
57 0 0       0 $_= $_->clone if ref->can('clone');
58             }
59 0         0 bless $new, ref $self;
60             }
61              
62              
63             sub generators {
64 71 50   71 1 8696 return $_[0]{generators} if @_ == 1;
65             # Coerce generators
66 0         0 my %new= %{ $_[1] };
  0         0  
67 0         0 $_= Mock::Data::Util::coerce_generator($_) for values %new;
68             # clear cache first
69 0         0 %{$_[0]{_generator_cache}}= ();
  0         0  
70 0         0 return $_[0]{generators}= \%new;
71             }
72              
73             sub generator_state {
74 0 0   0 1 0 $_[0]{generator_state}= $_[1] if @_ > 1;
75 0         0 $_[0]{generator_state};
76             }
77              
78              
79             sub load_plugin {
80 10     10 1 23 my ($self, $name)= @_;
81 10 50       31 return $self if $self->{_loaded_plugins}{$name};
82 10         35 my $class= "Mock::Data::Plugin::$name";
83 10 50       80 unless ($class->can('apply_mockdata_plugin')) {
84 0         0 Module::Runtime::require_module($class);
85 0 0       0 $class->can('apply_mockdata_plugin')
86             or Carp::croak("No such method ${class}->apply_mockdata_plugin");
87             }
88 10         32 my $new= $class->apply_mockdata_plugin($self);
89 10 50 33     70 ref($new) && ref($new)->isa(__PACKAGE__)
90             or Carp::croak("$class->apply_mockdata_plugin did not return a Mock::Data");
91 10         29 ++$self->{_loaded_plugins}{$name};
92 10         27 return $new;
93             }
94              
95              
96             sub add_generators {
97 9     9 1 28 my $self= shift;
98 9 100       30 my @args= @_ == 1? %{ $_[0] } : @_;
  3         14  
99 9         23 while (@args) {
100 22         53 my ($name, $gen)= splice @args, 0, 2;
101 22         57 $gen= Mock::Data::Util::coerce_generator($gen);
102 22         67 $self->generators->{$name}= $gen;
103 22         40 delete $self->{_generator_cache}{$name};
104 22 100 66     96 if ($name =~ /::([^:]+)$/ and !defined $self->generators->{$1}) {
105 12         21 $self->generators->{$1}= $gen;
106             }
107             }
108 9         21 $self;
109             }
110              
111             sub combine_generators {
112 4     4 1 24 my $self= shift;
113 4 50       13 my @args= @_ == 1? %{ $_[0] } : @_;
  0         0  
114 4         11 while (@args) {
115 4         12 my ($name, $gen)= splice @args, 0, 2;
116 4         14 $gen= Mock::Data::Util::coerce_generator($gen);
117 4         9 my $merged= $gen;
118 4 50       19 if (defined (my $cur= $self->generators->{$name})) {
119 0         0 $merged= $cur->combine_generator($gen);
120 0         0 delete $self->{_generator_cache}{$name};
121             }
122 4         9 $self->generators->{$name}= $merged;
123            
124             # If given a namespace-qualified name, also install as the 'leaf' of that name
125 4 50       33 if ($name =~ /::([^:]+)$/) {
126 4         12 ($name, $merged)= ($1, $gen);
127 4 100       10 if (defined (my $cur= $self->generators->{$name})) {
128 1         4 $merged= $cur->combine_generator($gen);
129 1         2 delete $self->{_generator_cache}{$name};
130             }
131 4         11 $self->generators->{$name}= $merged;
132             }
133             }
134 4         8 $self;
135             }
136              
137              
138             sub call {
139 17     17 1 15152 my ($self, $name)= (shift, shift);
140 17 50       43 defined $self->{generators}{$name}
141             or Carp::croak("No such generator '$name'");
142 17 100       67 return $self->{generators}{$name}->generate($self, @_) if @_;
143             # If no params, call the cached compiled version
144 4   66     43 ($self->{_generator_cache}{$name} ||= $self->{generators}{$name}->compile)
145             ->($self, @_);
146             }
147              
148              
149             sub wrap {
150 0     0 1 0 my ($self, $name)= (shift, shift);
151 0         0 my $gen= $self->{generators}{$name};
152 0 0       0 defined $gen or Carp::croak("No such generator '$name'");
153             my $code= @_? $gen->compile(@_)
154 0 0 0     0 : ($self->{_generator_cache}{$name} ||= $gen->compile);
155 0     0   0 return sub { $code->($self) }
156 0         0 }
157              
158             our $AUTOLOAD;
159             sub AUTOLOAD {
160 7     7   41 my $self= shift;
161 7 50       18 Carp::croak("No method $AUTOLOAD in package $self") unless ref $self;
162 7         22 my $name= substr($AUTOLOAD, rindex($AUTOLOAD,':')+1);
163 7         19 $self->call($name, @_);
164             # don't install, because generators are defined per-instance not per-package
165             }
166              
167       0     sub DESTROY {} # prevent AUTOLOAD from triggering on ->DESTROY
168              
169              
170             sub import {
171 6     6   8603 Mock::Data::Util->export_to_level(1, @_);
172             }
173              
174             require Mock::Data::Util;
175              
176             __END__