File Coverage

blib/lib/MooseX/Role/Parameterized.pm
Criterion Covered Total %
statement 39 39 100.0
branch 6 6 100.0
condition 4 6 66.6
subroutine 12 12 100.0
pod 0 5 0.0
total 61 68 89.7


line stmt bran cond sub pod time code
1             package MooseX::Role::Parameterized; # git description: v1.09-8-g721b0f1
2             # ABSTRACT: Moose roles with composition parameters
3             # KEYWORDS: moose extension parameter role arguments dynamic parameterised parameterizable parameterisable
4              
5             our $VERSION = '1.10';
6              
7 27     27   2543147 use 5.008001;
  27         68  
8 27     27   8931 use Moose 2.0300 ();
  27         5851311  
  27         784  
9 27     27   166 use Moose::Exporter;
  27         33  
  27         139  
10 27     27   1068 use Carp 'confess';
  27         34  
  27         1550  
11 27     27   109 use Moose::Util 'find_meta';
  27         30  
  27         214  
12 27     27   19249 use namespace::clean 0.19;
  27         113485  
  27         134  
13              
14 27     27   15652 use MooseX::Role::Parameterized::Meta::Trait::Parameterizable;
  27         71  
  27         9015  
15              
16             our $CURRENT_METACLASS;
17              
18 276     276 0 1635 sub current_metaclass { $CURRENT_METACLASS }
19              
20             my $meta_lookup = sub {
21             my $for = shift;
22             current_metaclass() || find_meta($for);
23             };
24              
25             Moose::Exporter->setup_import_methods(
26             also => 'Moose::Role',
27             with_caller => [ 'parameter', 'role' ],
28             with_meta => [ 'method', 'with' ],
29             meta_lookup => $meta_lookup,
30             role_metaroles => {
31             role => ['MooseX::Role::Parameterized::Meta::Trait::Parameterizable'],
32             },
33             );
34              
35             sub parameter {
36 34     34 0 89833 my $caller = shift;
37              
38 34 100 66     125 confess "'parameter' may not be used inside of the role block"
39             if current_metaclass && current_metaclass->genitor->name eq $caller;
40              
41 33         176 my $meta = find_meta($caller);
42              
43 33         394 my $names = shift;
44 33 100       136 $names = [$names] if !ref($names);
45              
46 33         78 for my $name (@$names) {
47 34         2946 $meta->add_parameter($name => (
48             is => 'ro',
49             @_,
50             ));
51             }
52             }
53              
54             sub role (&) {
55 33     33 0 108844 my $caller = shift;
56 33         59 my $role_generator = shift;
57              
58 33 100 66     186 confess "'role' may not be used inside of the role block"
59             if current_metaclass && current_metaclass->genitor->name eq $caller;
60              
61 32         125 find_meta($caller)->role_generator($role_generator);
62             }
63              
64             sub method {
65 32     32 0 91 my $meta = shift;
66 32         33 my $name = shift;
67 32         31 my $body = shift;
68              
69 32         857 my $method = $meta->method_metaclass->wrap(
70             package_name => $meta->name,
71             name => $name,
72             body => $body,
73             );
74              
75 32         2132 $meta->add_method($name => $method);
76             }
77              
78             sub with {
79 8     8 0 35 local $CURRENT_METACLASS = undef;
80 8         32 Moose::Role::with(@_);
81             }
82              
83              
84             1;
85              
86             __END__
87              
88             =pod
89              
90             =encoding UTF-8
91              
92             =head1 NAME
93              
94             MooseX::Role::Parameterized - Moose roles with composition parameters
95              
96             =head1 VERSION
97              
98             version 1.10
99              
100             =head1 SYNOPSIS
101              
102             package Counter;
103             use MooseX::Role::Parameterized;
104              
105             parameter name => (
106             isa => 'Str',
107             required => 1,
108             );
109              
110             role {
111             my $p = shift;
112              
113             my $name = $p->name;
114              
115             has $name => (
116             is => 'rw',
117             isa => 'Int',
118             default => 0,
119             );
120              
121             method "increment_$name" => sub {
122             my $self = shift;
123             $self->$name($self->$name + 1);
124             };
125              
126             method "reset_$name" => sub {
127             my $self = shift;
128             $self->$name(0);
129             };
130             };
131              
132             package MyGame::Weapon;
133             use Moose;
134              
135             with Counter => { name => 'enchantment' };
136              
137             package MyGame::Wand;
138             use Moose;
139              
140             with Counter => { name => 'zapped' };
141              
142             =head1 DESCRIPTION
143              
144             Your parameterized role consists of two new things: parameter declarations
145             and a C<role> block.
146              
147             Parameters are declared using the L</parameter> keyword which very much
148             resembles L<Moose/has>. You can use any option that L<Moose/has> accepts. The
149             default value for the C<is> option is C<ro> as that's a very common case. Use
150             C<< is => 'bare' >> if you want no accessor. These parameters will get their
151             values when the consuming class (or role) uses L<Moose/with>. A parameter
152             object will be constructed with these values, and passed to the C<role> block.
153              
154             The C<role> block then uses the usual L<Moose::Role> keywords to build up a
155             role. You can shift off the parameter object to inspect what the consuming
156             class provided as parameters. You use the parameters to customize your
157             role however you wish.
158              
159             There are many possible implementations for parameterized roles (hopefully with
160             a consistent enough API); I believe this to be the easiest and most flexible
161             design. Coincidentally, Pugs originally had an eerily similar design.
162              
163             See L<MooseX::Role::Parameterized::Extending> for some tips on how to extend
164             this module.
165              
166             =head2 Why a parameters object?
167              
168             I've been asked several times "Why use a parameter I<object> and not just a
169             parameter I<hashref>? That would eliminate the need to explicitly declare your
170             parameters."
171              
172             The benefits of using an object are similar to the benefits of using Moose. You
173             get an easy way to specify lazy defaults, type constraint, delegation, and so
174             on. You get to use MooseX modules.
175              
176             =for Pod::Coverage current_metaclass method parameter role with
177              
178             =head1 L<MooseX::Role::Parameterized::Tutorial>
179              
180             B<Stop!> If you're new here, please read
181             L<MooseX::Role::Parameterized::Tutorial> for a much gentler introduction.
182              
183             =for stopwords metaobject
184              
185             You also get the usual introspective and intercessory abilities that come
186             standard with the metaobject protocol. Ambitious users should be able to add
187             traits to the parameters metaclass to further customize behavior. Please let
188             me know if you're doing anything viciously complicated with this extension. :)
189              
190             =head1 CAVEATS
191              
192             You must use this syntax to declare methods in the role block:
193             C<< method NAME => sub { ... }; >>. This is due to a limitation in Perl. In
194             return though you can use parameters I<in your methods>!
195              
196             =head1 SEE ALSO
197              
198             L<http://sartak.org/2009/01/parametric-roles-in-perl-5.html>
199              
200             L<http://sartak.org/2009/05/the-design-of-parameterized-roles.html>
201              
202             L<http://stevan-little.blogspot.com/2009/07/thoughts-on-parameterized-roles.html>
203              
204             L<http://perldition.org/articles/Parameterized%20Roles%20with%20MooseX::Declare.pod>
205              
206             L<http://www.modernperlbooks.com/mt/2011/01/the-parametric-role-of-my-mvc-plugin-system.html>
207              
208             L<http://jjnapiorkowski.typepad.com/modern-perl/2010/08/parameterized-roles-and-method-traits-redo.html>
209              
210             L<http://sartak.org/talks/yapc-asia-2009/(parameterized)-roles/>
211              
212             =for stopwords Joose
213              
214             L<https://github.com/SamuraiJack/JooseX-Role-Parameterized> - this extension ported to JavaScript's Joose
215              
216             =head1 SUPPORT
217              
218             Bugs may be submitted through L<the RT bug tracker|https://rt.cpan.org/Public/Dist/Display.html?Name=MooseX-Role-Parameterized>
219             (or L<bug-MooseX-Role-Parameterized@rt.cpan.org|mailto:bug-MooseX-Role-Parameterized@rt.cpan.org>).
220              
221             There is also a mailing list available for users of this distribution, at
222             L<http://lists.perl.org/list/moose.html>.
223              
224             There is also an irc channel available for users of this distribution, at
225             L<C<#moose> on C<irc.perl.org>|irc://irc.perl.org/#moose>.
226              
227             =head1 AUTHOR
228              
229             Shawn M Moore <code@sartak.org>
230              
231             =head1 CONTRIBUTORS
232              
233             =for stopwords Karen Etheridge Dave Rolsky Jesse Luehrs Oliver Charles Yuval Kogman Robert 'phaylon' Sedlacek Florian Ragwitz Mark Fowler Chris Weyl Csson Andy Jack Ricardo Signes Todd Hepler
234              
235             =over 4
236              
237             =item *
238              
239             Karen Etheridge <ether@cpan.org>
240              
241             =item *
242              
243             Dave Rolsky <autarch@urth.org>
244              
245             =item *
246              
247             Jesse Luehrs <doy@tozt.net>
248              
249             =item *
250              
251             Oliver Charles <oliver.g.charles@googlemail.com>
252              
253             =item *
254              
255             Yuval Kogman <nothingmuch@woobling.org>
256              
257             =item *
258              
259             Robert 'phaylon' Sedlacek <rs@474.at>
260              
261             =item *
262              
263             Florian Ragwitz <rafl@debian.org>
264              
265             =item *
266              
267             Mark Fowler <mark@twoshortplanks.com>
268              
269             =item *
270              
271             Chris Weyl <cweyl@alumni.drew.edu>
272              
273             =item *
274              
275             Csson <erik.carlsson@live.com>
276              
277             =item *
278              
279             Andy Jack <github@veracity.ca>
280              
281             =item *
282              
283             Ricardo Signes <rjbs@cpan.org>
284              
285             =item *
286              
287             Todd Hepler <thepler@employees.org>
288              
289             =back
290              
291             =head1 COPYRIGHT AND LICENSE
292              
293             This software is copyright (c) 2008 by Shawn M Moore.
294              
295             This is free software; you can redistribute it and/or modify it under
296             the same terms as the Perl 5 programming language system itself.
297              
298             =cut