line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package MooseX::Traits; |
2
|
|
|
|
|
|
|
{ |
3
|
|
|
|
|
|
|
$MooseX::Traits::VERSION = '0.12'; |
4
|
|
|
|
|
|
|
} |
5
|
|
|
|
|
|
|
# git description: v0.11-14-gf2ce21c |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
BEGIN { |
8
|
6
|
|
|
6
|
|
186343
|
$MooseX::Traits::AUTHORITY = 'cpan:JROCKWAY'; |
9
|
|
|
|
|
|
|
} |
10
|
|
|
|
|
|
|
# ABSTRACT: automatically apply roles at object creation time |
11
|
6
|
|
|
6
|
|
4134
|
use Moose::Role; |
|
6
|
|
|
|
|
3267920
|
|
|
6
|
|
|
|
|
55
|
|
12
|
|
|
|
|
|
|
|
13
|
6
|
|
|
6
|
|
56100
|
use MooseX::Traits::Util qw(new_class_with_traits); |
|
6
|
|
|
|
|
18
|
|
|
6
|
|
|
|
|
43
|
|
14
|
|
|
|
|
|
|
|
15
|
6
|
|
|
6
|
|
1311
|
use warnings; |
|
6
|
|
|
|
|
13
|
|
|
6
|
|
|
|
|
163
|
|
16
|
6
|
|
|
6
|
|
36
|
use warnings::register; |
|
6
|
|
|
|
|
12
|
|
|
6
|
|
|
|
|
850
|
|
17
|
|
|
|
|
|
|
|
18
|
6
|
|
|
6
|
|
5128
|
use namespace::autoclean; |
|
6
|
|
|
|
|
10011
|
|
|
6
|
|
|
|
|
48
|
|
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
has '_trait_namespace' => ( |
21
|
|
|
|
|
|
|
# no accessors or init_arg |
22
|
|
|
|
|
|
|
init_arg => undef, |
23
|
|
|
|
|
|
|
isa => 'Str', |
24
|
|
|
|
|
|
|
is => 'bare', |
25
|
|
|
|
|
|
|
); |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
sub with_traits { |
28
|
22
|
|
|
22
|
1
|
77279
|
my ($class, @traits) = @_; |
29
|
|
|
|
|
|
|
|
30
|
22
|
|
|
|
|
118
|
my $new_class = new_class_with_traits( |
31
|
|
|
|
|
|
|
$class, |
32
|
|
|
|
|
|
|
@traits, |
33
|
|
|
|
|
|
|
); |
34
|
|
|
|
|
|
|
|
35
|
22
|
|
|
|
|
310
|
return $new_class->name; |
36
|
|
|
|
|
|
|
} |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
# somewhat deprecated, but use if you want to |
39
|
|
|
|
|
|
|
sub new_with_traits { |
40
|
16
|
|
|
16
|
1
|
123895
|
my $class = shift; |
41
|
|
|
|
|
|
|
|
42
|
16
|
|
|
|
|
52
|
my ($hashref, %args) = 0; |
43
|
16
|
100
|
|
|
|
67
|
if (ref($_[0]) eq 'HASH') { |
44
|
1
|
|
|
|
|
3
|
%args = %{ +shift }; |
|
1
|
|
|
|
|
5
|
|
45
|
1
|
|
|
|
|
4
|
$hashref = 1; |
46
|
|
|
|
|
|
|
} else { |
47
|
15
|
|
|
|
|
60
|
%args = @_; |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
|
50
|
16
|
|
100
|
|
|
90
|
my $traits = delete $args{traits} || []; |
51
|
|
|
|
|
|
|
|
52
|
16
|
100
|
|
|
|
102
|
my $new_class = $class->with_traits(ref $traits ? @$traits : $traits ); |
53
|
|
|
|
|
|
|
|
54
|
16
|
|
|
|
|
86
|
my $constructor = $new_class->meta->constructor_name; |
55
|
16
|
50
|
|
|
|
392
|
confess "$class ($new_class) does not have a constructor defined via the MOP?" |
56
|
|
|
|
|
|
|
if !$constructor; |
57
|
|
|
|
|
|
|
|
58
|
16
|
100
|
|
|
|
213
|
return $new_class->$constructor($hashref ? \%args : %args); |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
# this code is broken and should never have been added. i probably |
63
|
|
|
|
|
|
|
# won't delete it, but it is definitely not up-to-date with respect to |
64
|
|
|
|
|
|
|
# other features, and never will be. |
65
|
|
|
|
|
|
|
# |
66
|
|
|
|
|
|
|
# runtime role application is fundamentally broken. if you really |
67
|
|
|
|
|
|
|
# need it, write it yourself, but consider applying the roles before |
68
|
|
|
|
|
|
|
# you create an instance. |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
sub apply_traits { |
72
|
2
|
|
|
2
|
0
|
19516
|
my ($self, $traits, $rebless_params) = @_; |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
# disable this warning with "use MooseX::Traits; no warnings 'MooseX::Traits'" |
75
|
2
|
|
|
|
|
226
|
warnings::warnif('apply_traits is deprecated due to being fundamentally broken. '. |
76
|
|
|
|
|
|
|
q{disable this warning with "no warnings 'MooseX::Traits'"}); |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
# arrayify |
79
|
2
|
|
|
|
|
6
|
my @traits = $traits; |
80
|
2
|
100
|
|
|
|
11
|
@traits = @$traits if ref $traits; |
81
|
|
|
|
|
|
|
|
82
|
2
|
50
|
|
|
|
8
|
if (@traits) { |
83
|
2
|
|
|
|
|
11
|
@traits = MooseX::Traits::Util::resolve_traits( |
84
|
|
|
|
|
|
|
$self, @traits, |
85
|
|
|
|
|
|
|
); |
86
|
|
|
|
|
|
|
|
87
|
2
|
|
|
|
|
8
|
for my $trait (@traits){ |
88
|
3
|
|
50
|
|
|
9114
|
$trait->meta->apply($self, rebless_params => $rebless_params || {}); |
89
|
|
|
|
|
|
|
} |
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
} |
92
|
|
|
|
|
|
|
|
93
|
6
|
|
|
6
|
|
3343
|
no Moose::Role; |
|
6
|
|
|
|
|
17
|
|
|
6
|
|
|
|
|
69
|
|
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
1; |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
__END__ |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
=pod |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
=encoding UTF-8 |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
=for :stopwords Jonathan Rockway Infinity Interactive, Inc. http://www.iinteractive.com |
104
|
|
|
|
|
|
|
Chris Etheridge Matt S. Trout Rafael Kitover Shawn Moore Stevan Little |
105
|
|
|
|
|
|
|
Prather Tomas Doran Yuval Kogman Florian Ragwitz Hans Dieter Pearcey Jesse |
106
|
|
|
|
|
|
|
Luehrs Karen |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
=head1 NAME |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
MooseX::Traits - automatically apply roles at object creation time |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
=head1 VERSION |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
version 0.12 |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
=head1 SYNOPSIS |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
Given some roles: |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
package Role; |
121
|
|
|
|
|
|
|
use Moose::Role; |
122
|
|
|
|
|
|
|
has foo => ( is => 'ro', isa => 'Int' required => 1 ); |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
And a class: |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
package Class; |
127
|
|
|
|
|
|
|
use Moose; |
128
|
|
|
|
|
|
|
with 'MooseX::Traits'; |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
Apply the roles to the class at C<new> time: |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
my $class = Class->with_traits('Role')->new( foo => 42 ); |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
Then use your customized class: |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
$class->isa('Class'); # true |
137
|
|
|
|
|
|
|
$class->does('Role'); # true |
138
|
|
|
|
|
|
|
$class->foo; # 42 |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
=head1 DESCRIPTION |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
Often you want to create components that can be added to a class |
143
|
|
|
|
|
|
|
arbitrarily. This module makes it easy for the end user to use these |
144
|
|
|
|
|
|
|
components. Instead of requiring the user to create a named class |
145
|
|
|
|
|
|
|
with the desired roles applied, or apply roles to the instance |
146
|
|
|
|
|
|
|
one-by-one, he can just create a new class from yours with |
147
|
|
|
|
|
|
|
C<with_traits>, and then instantiate that. |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
There is also C<new_with_traits>, which exists for compatibility |
150
|
|
|
|
|
|
|
reasons. It accepts a C<traits> parameter, creates a new class with |
151
|
|
|
|
|
|
|
those traits, and then instantiates it. |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
Class->new_with_traits( traits => [qw/Foo Bar/], foo => 42, bar => 1 ) |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
returns exactly the same object as |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
Class->with_traits(qw/Foo Bar/)->new( foo => 42, bar => 1 ) |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
would. But you can also store the result of C<with_traits>, and call |
160
|
|
|
|
|
|
|
other methods: |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
my $c = Class->with_traits(qw/Foo Bar/); |
163
|
|
|
|
|
|
|
$c->new( foo => 42 ); |
164
|
|
|
|
|
|
|
$c->whatever( foo => 1234 ); |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
And so on. |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
=for Pod::Coverage apply_traits |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
=head1 METHODS |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
=over 4 |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
=item B<< $class->with_traits( @traits ) >> |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
Return a new class with the traits applied. Use like: |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
=item B<< $class->new_with_traits(%args, traits => \@traits) >> |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
C<new_with_traits> can also take a hashref, e.g.: |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
my $instance = $class->new_with_traits({ traits => \@traits, foo => 'bar' }); |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
=back |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
=head1 ATTRIBUTES YOUR CLASS GETS |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
This role will add the following attributes to the consuming class. |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
=head2 _trait_namespace |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
You can override the value of this attribute with C<default> to |
193
|
|
|
|
|
|
|
automatically prepend a namespace to the supplied traits. (This can |
194
|
|
|
|
|
|
|
be overridden by prefixing the trait name with C<+>.) |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
Example: |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
package Another::Trait; |
199
|
|
|
|
|
|
|
use Moose::Role; |
200
|
|
|
|
|
|
|
has 'bar' => ( |
201
|
|
|
|
|
|
|
is => 'ro', |
202
|
|
|
|
|
|
|
isa => 'Str', |
203
|
|
|
|
|
|
|
required => 1, |
204
|
|
|
|
|
|
|
); |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
package Another::Class; |
207
|
|
|
|
|
|
|
use Moose; |
208
|
|
|
|
|
|
|
with 'MooseX::Traits'; |
209
|
|
|
|
|
|
|
has '+_trait_namespace' => ( default => 'Another' ); |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
my $instance = Another::Class->new_with_traits( |
212
|
|
|
|
|
|
|
traits => ['Trait'], # "Another::Trait", not "Trait" |
213
|
|
|
|
|
|
|
bar => 'bar', |
214
|
|
|
|
|
|
|
); |
215
|
|
|
|
|
|
|
$instance->does('Trait') # false |
216
|
|
|
|
|
|
|
$instance->does('Another::Trait') # true |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
my $instance2 = Another::Class->new_with_traits( |
219
|
|
|
|
|
|
|
traits => ['+Trait'], # "Trait", not "Another::Trait" |
220
|
|
|
|
|
|
|
); |
221
|
|
|
|
|
|
|
$instance2->does('Trait') # true |
222
|
|
|
|
|
|
|
$instance2->does('Another::Trait') # false |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
=head1 AUTHOR |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
Jonathan Rockway <jrockway@cpan.org> |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
This software is copyright (c) 2008 by Infinity Interactive, Inc. http://www.iinteractive.com. |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
233
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
=head1 CONTRIBUTORS |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
=over 4 |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
=item * |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
Chris Prather <chris@prather.org> |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
=item * |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
Florian Ragwitz <rafl@debian.org> |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
=item * |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
Hans Dieter Pearcey <hdp@weftsoar.net> |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
=item * |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
Jesse Luehrs <doy@tozt.net> |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
=item * |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
Karen Etheridge <ether@cpan.org> |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
=item * |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
Matt S. Trout <mst@shadowcatsystems.co.uk> |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
=item * |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
Rafael Kitover <rkitover@cpan.org> |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
=item * |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
Shawn Moore <sartak@bestpractical.com> |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
=item * |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
Stevan Little <stevan.little@iinteractive.com> |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
=item * |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
Tomas Doran <bobtfish@bobtfish.net> |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
=item * |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
Yuval Kogman <nothingmuch@woobling.org> |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
=back |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
=cut |