File Coverage

blib/lib/MooX/SingleArg.pm
Criterion Covered Total %
statement 33 35 94.2
branch 13 18 72.2
condition 3 3 100.0
subroutine 11 11 100.0
pod 3 4 75.0
total 63 71 88.7


line stmt bran cond sub pod time code
1             package MooX::SingleArg;
2              
3             $MooX::SingleArg::VERSION = '0.06';
4              
5             =head1 NAME
6              
7             MooX::SingleArg - Support single-argument instantiation.
8              
9             =head2 SYNOPSIS
10              
11             package Foo;
12             use Moo;
13             with 'MooX::SingleArg';
14             Foo->single_arg('bar');
15             has bar => ( is=>'ro' );
16            
17             my $foo = Foo->new( 'goo' );
18             print $foo->bar(); # goo
19              
20             =cut
21              
22 1     1   10015 use Class::Method::Modifiers qw( install_modifier );
  1         1490  
  1         60  
23 1     1   7 use Carp qw( croak );
  1         2  
  1         39  
24              
25 1     1   5 use Moo::Role;
  1         2  
  1         5  
26 1     1   800 use strictures 2;
  1         1778  
  1         43  
27 1     1   656 use namespace::clean;
  1         11371  
  1         7  
28              
29             with 'MooX::BuildArgsHooks';
30              
31             around NORMALIZE_BUILDARGS => sub{
32             my ($orig, $class, @args) = @_;
33              
34             @args = $class->NORMALIZE_SINGLE_ARG_BUILDARGS( @args );
35              
36             return $class->$orig( @args );
37             };
38              
39             sub NORMALIZE_SINGLE_ARG_BUILDARGS {
40 4     4 0 9 my ($class, @args) = @_;
41              
42             # Force force_single_arg to be set as we want it immutable
43             # on this class once the first object has been instantiated.
44 4 100       54 $class->force_single_arg( 0 ) if !defined $class->force_single_arg();
45              
46 4 50       11 croak "No single_arg was declared for the $class class" unless $class->has_single_arg();
47              
48 4 100       12 return( @args ) if @args!=1;
49              
50 3 100 100     44 return( @args ) unless ref($args[0]) ne 'HASH' or $class->force_single_arg();
51              
52 2         36 return( $class->single_arg() => $args[0] );
53             }
54              
55             =head1 CLASS ARGUMENTS
56              
57             =head2 single_arg
58              
59             __PACKAGE__->single_arg( 'foo' );
60              
61             Use this to declare the C of the single argument.
62              
63             =cut
64              
65             sub single_arg {
66 2     2 1 1788 my ($class, $value) = @_;
67              
68             install_modifier(
69             $class, 'around', 'single_arg' => sub{
70 6 50   6   127 if (@_>2) { croak "single_arg has already been set to $value on $class" }
  0         0  
71 6         21 return $value;
72             },
73 2 50       15 ) if defined $value;
74              
75 2         557 return $value;
76             }
77              
78             =head2 force_single_arg
79              
80             __PACKAGE__->force_single_arg( 1 );
81              
82             Causes single-argument processing to happen even if a hashref
83             is passed in as the single argument.
84              
85             =cut
86              
87             sub force_single_arg {
88 3     3 1 9 my ($class, $value) = @_;
89              
90             install_modifier(
91             $class, 'around', 'force_single_arg' => sub{
92 5 50   5   108 if (@_>2) { croak "force_single_arg has already been set to $value on $class" }
  0         0  
93 5         17 return $value;
94             },
95 3 100       19 ) if defined $value;
96              
97 3         574 return $value;
98             }
99              
100             =head1 CLASS METHODS
101              
102             =head2 has_single_arg
103              
104             Returns true if L has been called.
105              
106             =cut
107              
108             sub has_single_arg {
109 4     4 1 7 my $class = shift;
110 4 50       76 return defined( $class->single_arg() ) ? 1 : 0;
111             }
112              
113             1;
114             __END__