File Coverage

blib/lib/MooseX/OneArgNew.pm
Criterion Covered Total %
statement 9 9 100.0
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 12 12 100.0


line stmt bran cond sub pod time code
1              
2             use MooseX::Role::Parameterized 1.01;
3 2     2   4843 # ABSTRACT: teach ->new to accept single, non-hashref arguments
  2         131500  
  2         10  
4              
5             #pod =head1 SYNOPSIS
6             #pod
7             #pod In our class definition:
8             #pod
9             #pod package Delivery;
10             #pod use Moose;
11             #pod with('MooseX::OneArgNew' => {
12             #pod type => 'Existing::Message::Type',
13             #pod init_arg => 'message',
14             #pod });
15             #pod
16             #pod has message => (isa => 'Existing::Message::Type', required => 1);
17             #pod
18             #pod has to => (
19             #pod is => 'ro',
20             #pod isa => 'Str',
21             #pod lazy => 1,
22             #pod default => sub {
23             #pod my ($self) = @_;
24             #pod $self->message->get('To');
25             #pod },
26             #pod );
27             #pod
28             #pod When making a message:
29             #pod
30             #pod # The traditional way:
31             #pod
32             #pod my $delivery = Delivery->new({ message => $message });
33             #pod # or
34             #pod my $delivery = Delivery->new({ message => $message, to => $to });
35             #pod
36             #pod # With one-arg new:
37             #pod
38             #pod my $delivery = Delivery->new($message);
39             #pod
40             #pod =head1 DESCRIPTION
41             #pod
42             #pod MooseX::OneArgNew lets your constructor take a single argument, which will be
43             #pod translated into the value for a one-entry hashref. It is a L<parameterized
44             #pod role|MooseX::Role::Parameterized> with three parameters:
45             #pod
46             #pod =begin :list
47             #pod
48             #pod = type
49             #pod
50             #pod The Moose type that the single argument must be for the one-arg form to work.
51             #pod This should be an existing type, and may be either a string type or a
52             #pod MooseX::Type.
53             #pod
54             #pod = init_arg
55             #pod
56             #pod This is the string that will be used as the key for the hashref constructed
57             #pod from the one-arg call to new.
58             #pod
59             #pod = coerce
60             #pod
61             #pod If true, a single argument to new will be coerced into the expected type if
62             #pod possible. Keep in mind that if there are no coercions for the type, this will
63             #pod be an error, and that if a coercion from HashRef exists, you might be getting
64             #pod yourself into a weird situation.
65             #pod
66             #pod =end :list
67             #pod
68             #pod =head2 WARNINGS
69             #pod
70             #pod You can apply MooseX::OneArgNew more than once, but if more than one
71             #pod application's type matches a single argument to C<new>, the behavior is
72             #pod undefined and likely to cause bugs.
73             #pod
74             #pod It would be a B<very bad idea> to supply a type that could accept a normal
75             #pod hashref of arguments to C<new>.
76             #pod
77             #pod =cut
78              
79             use Moose::Util::TypeConstraints;
80 2     2   53529  
  2         3  
  2         13  
81             use namespace::autoclean;
82 2     2   3152  
  2         3  
  2         13  
83             subtype 'MooseX::OneArgNew::_Type',
84             as 'Moose::Meta::TypeConstraint';
85              
86             coerce 'MooseX::OneArgNew::_Type',
87             from 'Str',
88             via { Moose::Util::TypeConstraints::find_type_constraint($_) };
89              
90             parameter type => (
91             isa => 'MooseX::OneArgNew::_Type',
92             coerce => 1,
93             required => 1,
94             );
95              
96             parameter coerce => (
97             isa => 'Bool',
98             default => 0,
99             );
100              
101             parameter init_arg => (
102             isa => 'Str',
103             required => 1,
104             );
105              
106             role {
107             my $p = shift;
108              
109             around BUILDARGS => sub {
110             my $orig = shift;
111             my $self = shift;
112             return $self->$orig(@_) unless @_ == 1;
113              
114             my $value = $p->coerce ? $p->type->coerce($_[0]) : $_[0];
115             return $self->$orig(@_) unless $p->type->check($value);
116              
117             return { $p->init_arg => $value }
118             };
119             };
120              
121             1;
122              
123              
124             =pod
125              
126             =encoding UTF-8
127              
128             =head1 NAME
129              
130             MooseX::OneArgNew - teach ->new to accept single, non-hashref arguments
131              
132             =head1 VERSION
133              
134             version 0.006
135              
136             =head1 SYNOPSIS
137              
138             In our class definition:
139              
140             package Delivery;
141             use Moose;
142             with('MooseX::OneArgNew' => {
143             type => 'Existing::Message::Type',
144             init_arg => 'message',
145             });
146              
147             has message => (isa => 'Existing::Message::Type', required => 1);
148              
149             has to => (
150             is => 'ro',
151             isa => 'Str',
152             lazy => 1,
153             default => sub {
154             my ($self) = @_;
155             $self->message->get('To');
156             },
157             );
158              
159             When making a message:
160              
161             # The traditional way:
162              
163             my $delivery = Delivery->new({ message => $message });
164             # or
165             my $delivery = Delivery->new({ message => $message, to => $to });
166              
167             # With one-arg new:
168              
169             my $delivery = Delivery->new($message);
170              
171             =head1 DESCRIPTION
172              
173             MooseX::OneArgNew lets your constructor take a single argument, which will be
174             translated into the value for a one-entry hashref. It is a L<parameterized
175             role|MooseX::Role::Parameterized> with three parameters:
176              
177             =over 4
178              
179             =item type
180              
181             The Moose type that the single argument must be for the one-arg form to work.
182             This should be an existing type, and may be either a string type or a
183             MooseX::Type.
184              
185             =item init_arg
186              
187             This is the string that will be used as the key for the hashref constructed
188             from the one-arg call to new.
189              
190             =item coerce
191              
192             If true, a single argument to new will be coerced into the expected type if
193             possible. Keep in mind that if there are no coercions for the type, this will
194             be an error, and that if a coercion from HashRef exists, you might be getting
195             yourself into a weird situation.
196              
197             =back
198              
199             =head2 WARNINGS
200              
201             You can apply MooseX::OneArgNew more than once, but if more than one
202             application's type matches a single argument to C<new>, the behavior is
203             undefined and likely to cause bugs.
204              
205             It would be a B<very bad idea> to supply a type that could accept a normal
206             hashref of arguments to C<new>.
207              
208             =head1 PERL VERSION
209              
210             This module should work on any version of perl still receiving updates from
211             the Perl 5 Porters. This means it should work on any version of perl released
212             in the last two to three years. (That is, if the most recently released
213             version is v5.40, then this module should work on both v5.40 and v5.38.)
214              
215             Although it may work on older versions of perl, no guarantee is made that the
216             minimum required version will not be increased. The version may be increased
217             for any reason, and there is no promise that patches will be accepted to lower
218             the minimum required perl.
219              
220             =head1 AUTHOR
221              
222             Ricardo Signes <rjbs@semiotic.systems>
223              
224             =head1 CONTRIBUTORS
225              
226             =for stopwords George Hartzell William Orr
227              
228             =over 4
229              
230             =item *
231              
232             George Hartzell <hartzell@alerce.com>
233              
234             =item *
235              
236             William Orr <will@worrbase.com>
237              
238             =back
239              
240             =head1 COPYRIGHT AND LICENSE
241              
242             This software is copyright (c) 2022 by Ricardo Signes.
243              
244             This is free software; you can redistribute it and/or modify it under
245             the same terms as the Perl 5 programming language system itself.
246              
247             =cut