File Coverage

blib/lib/Mock/Data/GeneratorSub.pm
Criterion Covered Total %
statement 24 35 68.5
branch 10 20 50.0
condition 1 6 16.6
subroutine 6 7 85.7
pod 3 3 100.0
total 44 71 61.9


line stmt bran cond sub pod time code
1             package Mock::Data::GeneratorSub;
2 12     12   77 use strict;
  12         27  
  12         482  
3 12     12   59 use warnings;
  12         18  
  12         6855  
4             require Mock::Data::Generator;
5             our @ISA= qw( Mock::Data::Generator );
6              
7             # ABSTRACT: Wrap a coderef to become a blessed Generator object
8             our $VERSION = '0.04'; # VERSION
9              
10              
11             sub new {
12 72     72 1 150 my ($class, $coderef, @params)= @_;
13 72 50       187 if (ref $coderef eq 'HASH') {
14 0 0       0 @params= @{ $coderef->{params} || [] };
  0         0  
15 0         0 $coderef= $coderef->{coderef};
16             }
17 72 50       154 if (ref $class) {
18 0   0     0 $coderef ||= $class->{coderef};
19 0         0 @params= $class->_merge_params(@params);
20 0         0 $class= ref $class;
21             }
22 72 50       172 Scalar::Util::reftype($coderef) eq 'CODE' or Carp::croak("Not a coderef");
23 72         345 bless {
24             coderef => $coderef,
25             params => \@params,
26             }, $class;
27             }
28              
29             sub _merge_params {
30 190     190   242 my $self= shift;
31 190         271 my $p= $self->{params};
32 190 50       421 my $named_p= ref $p->[0] eq 'HASH'? $p->[0] : undef;
33             # Merge any options-by-name newly supplied with options-by-name from @params
34 190 0       331 unshift @_, (ref $_[0] eq 'HASH')? { %$named_p, %{shift @_} } : $named_p
  0 50       0  
35             if $named_p;
36             # Append positional params if none provided
37 190 100       476 push @_, @{$p}[1..$#$p]
  189         313  
38             unless @_ > 1;
39 190         606 return @_;
40             }
41              
42              
43             sub generate {
44 191     191 1 320 my ($self, $mock)= (shift, shift);
45 191 100       472 $self->{coderef}->($mock, @_? $self->_merge_params(@_) : @{$self->{params}});
  1         27  
46             }
47              
48              
49             sub compile {
50 38     38 1 64 my $self= shift;
51 38         90 my $params= $self->{params};
52 38 50 33     335 return $self->{coderef} unless @_ || @$params;
53 0           my @new_params= $self->_merge_params(@_);
54 0           my $coderef= $self->{coderef};
55 0     0     return sub { $coderef->(shift, @new_params) };
  0            
56             }
57              
58             1;
59              
60             __END__