File Coverage

lib/MooX/NewDefaults.pm
Criterion Covered Total %
statement 21 26 80.7
branch 4 6 66.6
condition n/a
subroutine 5 5 100.0
pod 1 1 100.0
total 31 38 81.5


line stmt bran cond sub pod time code
1 4     4   156248 use 5.008;
  4         17  
  4         168  
2 4     4   23 use strict;
  4         8  
  4         127  
3 4     4   32 use warnings;
  4         8  
  4         391  
4              
5             package MooX::NewDefaults;
6              
7             our $VERSION = '0.001001';
8              
9             # ABSTRACT: Alter attribute defaults with less pain
10              
11             our $AUTHORITY = 'cpan:KENTNL'; # AUTHORITY
12              
13 4         58 use Sub::Exporter::Progressive -setup => {
14             exports => [qw( default_for )],
15             groups => {
16             default => [qw( default_for )],
17             },
18 4     4   8675 };
  4         1787  
19              
20             sub default_for {
21 3     3 1 71359 my ( $name_proto, @args ) = @_;
22 3         13 my $target = caller;
23              
24 3 100       19 my (@name_proto) = 'ARRAY' eq ref $name_proto ? @{$name_proto} : $name_proto;
  1         3  
25              
26 3 50       19 if ( @args != 1 ) {
27 0         0 require Carp;
28 0         0 Carp::croak(
29             sprintf q[Invalid options for %s default: Single argument expected, got %s],
30 0         0 join( ', ', map { "'$_'" } @name_proto ),
31             scalar @args,
32             );
33             }
34 3         14 my $coderef;
35 3 50       56 if ( not $coderef = $target->can('has') ) {
36 0         0 require Carp;
37 0         0 Carp::croak( sprintf q[Calling class %s cannot "has". Did you forget to "use Moo"?], $target, );
38             }
39              
40             # Calling '->has()' directly of course doesn't work, because it doesn't expect
41             # $_[0] to be a class, but the attribute name.
42             #
43             # The class itself is baked into $target::has during `use Moo`
44 3         10 return $coderef->( [ map { "+$_" } @name_proto ], default => @args );
  4         37  
45             }
46              
47             1;
48              
49             __END__