line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package MooseX::Role::BuildInstanceOf; |
2
|
|
|
|
|
|
|
BEGIN { |
3
|
1
|
|
|
1
|
|
1039
|
$MooseX::Role::BuildInstanceOf::AUTHORITY = 'cpan:FLORA'; |
4
|
|
|
|
|
|
|
} |
5
|
|
|
|
|
|
|
{ |
6
|
|
|
|
|
|
|
$MooseX::Role::BuildInstanceOf::VERSION = '0.08'; |
7
|
|
|
|
|
|
|
} |
8
|
|
|
|
|
|
|
# ABSTRACT: Less Boilerplate when you need lots of Instances |
9
|
|
|
|
|
|
|
{ |
10
|
1
|
|
|
1
|
|
557
|
use MooseX::Role::Parameterized 0.13; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
use 5.008001; |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
use Moose::Util::TypeConstraints; |
14
|
|
|
|
|
|
|
my $ClassName = subtype as 'ClassName'; |
15
|
|
|
|
|
|
|
coerce $ClassName, from 'Str', via { Class::MOP::load_class($_); $_ }; |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
my $CodeRef = subtype as 'CodeRef'; |
18
|
|
|
|
|
|
|
coerce $CodeRef, from 'ArrayRef', via { my $args = $_; sub { $args } }; |
19
|
|
|
|
|
|
|
no Moose::Util::TypeConstraints; |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
parameter 'target' => ( |
22
|
|
|
|
|
|
|
isa => 'Str', |
23
|
|
|
|
|
|
|
is => 'ro', |
24
|
|
|
|
|
|
|
required => 1, |
25
|
|
|
|
|
|
|
); |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
my $decamelize = sub { |
28
|
|
|
|
|
|
|
my $s = shift; |
29
|
|
|
|
|
|
|
$s =~ s{([^a-zA-Z]?)([A-Z]*)([A-Z])([a-z]?)}{ |
30
|
|
|
|
|
|
|
my $fc = pos($s)==0; |
31
|
|
|
|
|
|
|
my ($p0,$p1,$p2,$p3) = ($1,lc$2,lc$3,$4); |
32
|
|
|
|
|
|
|
my $t = $p0 || $fc ? $p0 : '_'; |
33
|
|
|
|
|
|
|
$t .= $p3 ? $p1 ? "${p1}_$p2$p3" : "$p2$p3" : "$p1$p2"; |
34
|
|
|
|
|
|
|
$t; |
35
|
|
|
|
|
|
|
}ge; |
36
|
|
|
|
|
|
|
$s; |
37
|
|
|
|
|
|
|
}; |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
parameter 'prefix' => ( |
40
|
|
|
|
|
|
|
isa => 'Str', |
41
|
|
|
|
|
|
|
is => 'ro', |
42
|
|
|
|
|
|
|
required => 1, |
43
|
|
|
|
|
|
|
lazy => 1, |
44
|
|
|
|
|
|
|
default => sub { |
45
|
|
|
|
|
|
|
my $self = shift @_; |
46
|
|
|
|
|
|
|
my $target = $self->target; |
47
|
|
|
|
|
|
|
$target = ($target =~m/(::|~)(.+)$/)[1]; |
48
|
|
|
|
|
|
|
return $decamelize->($target); |
49
|
|
|
|
|
|
|
}, |
50
|
|
|
|
|
|
|
); |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
parameter 'constructor' => ( |
53
|
|
|
|
|
|
|
isa => 'Str', |
54
|
|
|
|
|
|
|
is => 'ro', |
55
|
|
|
|
|
|
|
required => 1, |
56
|
|
|
|
|
|
|
default => 'new', |
57
|
|
|
|
|
|
|
); |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
parameter 'args' => ( |
60
|
|
|
|
|
|
|
isa => $CodeRef, |
61
|
|
|
|
|
|
|
is => 'ro', |
62
|
|
|
|
|
|
|
required => 1, |
63
|
|
|
|
|
|
|
coerce => 1, |
64
|
|
|
|
|
|
|
default => sub { [] }, |
65
|
|
|
|
|
|
|
); |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
parameter 'fixed_args' => ( |
68
|
|
|
|
|
|
|
isa => $CodeRef, |
69
|
|
|
|
|
|
|
is => 'ro', |
70
|
|
|
|
|
|
|
required => 1, |
71
|
|
|
|
|
|
|
coerce => 1, |
72
|
|
|
|
|
|
|
default => sub { [] }, |
73
|
|
|
|
|
|
|
); |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
parameter 'inherited_args' => ( |
76
|
|
|
|
|
|
|
isa => 'ArrayRef', |
77
|
|
|
|
|
|
|
is => 'ro', |
78
|
|
|
|
|
|
|
required => 1, |
79
|
|
|
|
|
|
|
default => sub { [] }, |
80
|
|
|
|
|
|
|
); |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
parameter 'type' => ( |
83
|
|
|
|
|
|
|
isa => 'Str', |
84
|
|
|
|
|
|
|
is => 'ro', |
85
|
|
|
|
|
|
|
required => 1, |
86
|
|
|
|
|
|
|
default => sub { 'attribute' }, |
87
|
|
|
|
|
|
|
); |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
role { |
90
|
|
|
|
|
|
|
my $parameters = shift @_; |
91
|
|
|
|
|
|
|
my $prefix = $parameters->prefix; |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
has $prefix."_class" => ( |
94
|
|
|
|
|
|
|
is => 'ro', |
95
|
|
|
|
|
|
|
isa => $ClassName, |
96
|
|
|
|
|
|
|
lazy_build => 1, |
97
|
|
|
|
|
|
|
coerce => 1, |
98
|
|
|
|
|
|
|
handles => { |
99
|
|
|
|
|
|
|
"create_".$prefix => $parameters->constructor, |
100
|
|
|
|
|
|
|
}, |
101
|
|
|
|
|
|
|
); |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
method "normalize_".$prefix."target" => sub { |
104
|
|
|
|
|
|
|
my $self = shift @_; |
105
|
|
|
|
|
|
|
my $class = ref $self ? ref $self:$self; |
106
|
|
|
|
|
|
|
my $target = $parameters->target; |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
if($target =~m/^::/) { |
109
|
|
|
|
|
|
|
$target = $class.$target; |
110
|
|
|
|
|
|
|
} elsif($target =~s/^~//) { |
111
|
|
|
|
|
|
|
my $first = ($class =~m/^(.+?)::/)[0]; |
112
|
|
|
|
|
|
|
$first = $first ? $first : $class; |
113
|
|
|
|
|
|
|
$target = $first.'::'.$target; ## get anything! |
114
|
|
|
|
|
|
|
} |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
return $target; |
117
|
|
|
|
|
|
|
}; |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
method "_build_". $prefix ."_class" => sub { |
120
|
|
|
|
|
|
|
my $normalize_target = "normalize_".$prefix."target"; |
121
|
|
|
|
|
|
|
return shift->$normalize_target; |
122
|
|
|
|
|
|
|
}; |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
has $prefix."_args" => ( |
125
|
|
|
|
|
|
|
is => 'ro', |
126
|
|
|
|
|
|
|
isa => 'ArrayRef', |
127
|
|
|
|
|
|
|
lazy_build => 1, |
128
|
|
|
|
|
|
|
); |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
method "_build_". $prefix ."_args" => sub { |
131
|
|
|
|
|
|
|
return $parameters->args->(); |
132
|
|
|
|
|
|
|
}; |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
has $prefix."_fixed_args" => ( |
135
|
|
|
|
|
|
|
is => 'ro', |
136
|
|
|
|
|
|
|
init_arg => undef, |
137
|
|
|
|
|
|
|
isa => 'ArrayRef', |
138
|
|
|
|
|
|
|
lazy_build => 1, |
139
|
|
|
|
|
|
|
); |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
method "_build_". $prefix ."_fixed_args" => sub { |
142
|
|
|
|
|
|
|
return $parameters->fixed_args->(); |
143
|
|
|
|
|
|
|
}; |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
has $prefix."_inherited_args" => ( |
146
|
|
|
|
|
|
|
is => 'ro', |
147
|
|
|
|
|
|
|
init_arg => undef, |
148
|
|
|
|
|
|
|
isa => 'ArrayRef', |
149
|
|
|
|
|
|
|
lazy_build => 1, |
150
|
|
|
|
|
|
|
); |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
method "_build_". $prefix ."_inherited_args" => sub { |
153
|
|
|
|
|
|
|
my $self = shift; |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
my @args = @{ $parameters->inherited_args }; |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
my %resolved_args; |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
for my $arg ( @args ) { |
160
|
|
|
|
|
|
|
if ( ! ref $arg ) { |
161
|
|
|
|
|
|
|
$resolved_args{ $arg } = $self->$arg; |
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
elsif( ref $arg eq 'HASH' ) { |
164
|
|
|
|
|
|
|
while( my ($k,$v) = each %$arg ) { |
165
|
|
|
|
|
|
|
$resolved_args{ $k } = ref $v ? $v->($self) : $self->$v; |
166
|
|
|
|
|
|
|
} |
167
|
|
|
|
|
|
|
} |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
return [ %resolved_args ]; |
171
|
|
|
|
|
|
|
}; |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
## This needs to be broken out into roles or something |
174
|
|
|
|
|
|
|
## not so lame... |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
if($parameters->type eq 'attribute') { |
177
|
|
|
|
|
|
|
has $prefix => ( |
178
|
|
|
|
|
|
|
is => 'ro', |
179
|
|
|
|
|
|
|
init_arg => undef, |
180
|
|
|
|
|
|
|
lazy_build => 1, |
181
|
|
|
|
|
|
|
); |
182
|
|
|
|
|
|
|
} elsif($parameters->type eq 'factory') { |
183
|
|
|
|
|
|
|
method "$prefix", sub { |
184
|
|
|
|
|
|
|
my $self = shift @_; |
185
|
|
|
|
|
|
|
my $build = "_build_".$prefix; |
186
|
|
|
|
|
|
|
return $self->$build; |
187
|
|
|
|
|
|
|
} |
188
|
|
|
|
|
|
|
} else { |
189
|
|
|
|
|
|
|
die $parameters->type ." is not a recognized type"; |
190
|
|
|
|
|
|
|
} |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
method "_build_". $prefix => sub { |
193
|
|
|
|
|
|
|
my $self = shift @_; |
194
|
|
|
|
|
|
|
my $create = "create_".$prefix; |
195
|
|
|
|
|
|
|
my $merge = "merge_".$prefix."_args"; |
196
|
|
|
|
|
|
|
my $instance = $self->$create($self->$merge); |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
my $normalize_target = "normalize_".$prefix."target"; |
199
|
|
|
|
|
|
|
my $target_class = $self->$normalize_target; |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
if($instance->isa($target_class)) { |
202
|
|
|
|
|
|
|
return $instance; |
203
|
|
|
|
|
|
|
} else { |
204
|
|
|
|
|
|
|
die ref($instance)."is not a $target_class."; |
205
|
|
|
|
|
|
|
} |
206
|
|
|
|
|
|
|
}; |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
method "merge_".$prefix ."_args" => sub { |
209
|
|
|
|
|
|
|
my $self = shift @_; |
210
|
|
|
|
|
|
|
my $fixed_args = $prefix."_fixed_args"; |
211
|
|
|
|
|
|
|
my $inherited_args = $prefix."_inherited_args"; |
212
|
|
|
|
|
|
|
my $args = $prefix."_args"; |
213
|
|
|
|
|
|
|
return ( |
214
|
|
|
|
|
|
|
@{ $self->$inherited_args }, |
215
|
|
|
|
|
|
|
@{$self->$fixed_args}, |
216
|
|
|
|
|
|
|
@{$self->$args}, |
217
|
|
|
|
|
|
|
); |
218
|
|
|
|
|
|
|
}; |
219
|
|
|
|
|
|
|
} |
220
|
|
|
|
|
|
|
} 1; |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
1; |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
=pod |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
=encoding utf-8 |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
=head1 NAME |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
MooseX::Role::BuildInstanceOf - Less Boilerplate when you need lots of Instances |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
=head1 SYNOPSIS |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
Here is the "canonical" form of this role's parameters: |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
package MyApp::Album; |
240
|
|
|
|
|
|
|
use Moose; |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
with 'MooseX::Role::BuildInstanceOf' => { |
243
|
|
|
|
|
|
|
target => 'MyApp::Album::Photo', |
244
|
|
|
|
|
|
|
prefix => 'photo', |
245
|
|
|
|
|
|
|
constructor => 'new', |
246
|
|
|
|
|
|
|
args => [], |
247
|
|
|
|
|
|
|
fixed_args => [], |
248
|
|
|
|
|
|
|
}; |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
Given this, your "MyApp::Album" will now have an attribute called 'photo', which |
251
|
|
|
|
|
|
|
is an instance of "MyApp::Album::Photo". Other methods and attributes are also |
252
|
|
|
|
|
|
|
created. |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
my $album = MyApp::Album->new; |
255
|
|
|
|
|
|
|
my $photo = $album->photo; ## $photo ISA MyApp::Album::Photo |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
Not all parameters are required. We attempt sane defaults, for example the above |
258
|
|
|
|
|
|
|
could also be written as: |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
package MyApp::Album; |
261
|
|
|
|
|
|
|
use Moose; |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
with 'MooseX::Role::BuildInstanceOf' => {target => '::Photo'}; |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
And could be constructed and used as in the preceeding example. |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
Using this role is basically shorthand to create attributes and method. Think |
268
|
|
|
|
|
|
|
of it like a template. Given the above parameters, this role calls a 'template' |
269
|
|
|
|
|
|
|
and builds the following code into your class: |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
package MyApp::Album; |
272
|
|
|
|
|
|
|
use Moose; |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
has photo_class => ( |
275
|
|
|
|
|
|
|
is => 'ro', |
276
|
|
|
|
|
|
|
# this type automatically coerces any string by trying to load it as a class |
277
|
|
|
|
|
|
|
isa => $anonymous_type, |
278
|
|
|
|
|
|
|
coerce => 1, |
279
|
|
|
|
|
|
|
required => 1, |
280
|
|
|
|
|
|
|
default => 'MyApp::Album::Photo', |
281
|
|
|
|
|
|
|
lazy => 1, |
282
|
|
|
|
|
|
|
handles => { |
283
|
|
|
|
|
|
|
create_photo => 'new', |
284
|
|
|
|
|
|
|
}, |
285
|
|
|
|
|
|
|
); |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
has photo_args => ( |
288
|
|
|
|
|
|
|
is => 'ro', |
289
|
|
|
|
|
|
|
isa => 'ArrayRef', |
290
|
|
|
|
|
|
|
lazy_build => 1, |
291
|
|
|
|
|
|
|
); |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
sub _build_photo_args { |
294
|
|
|
|
|
|
|
return []; |
295
|
|
|
|
|
|
|
}; |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
has photo_fixed_args => ( |
298
|
|
|
|
|
|
|
is => 'ro', |
299
|
|
|
|
|
|
|
init_arg => undef, |
300
|
|
|
|
|
|
|
isa => 'ArrayRef', |
301
|
|
|
|
|
|
|
lazy_build => 1, |
302
|
|
|
|
|
|
|
); |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
sub _build_args_fixed_args { |
305
|
|
|
|
|
|
|
return []; ## Populated from 'fixed_args' parameter |
306
|
|
|
|
|
|
|
}; |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
has photo => ( |
309
|
|
|
|
|
|
|
is => 'ro', |
310
|
|
|
|
|
|
|
isa => 'Object', |
311
|
|
|
|
|
|
|
init_arg => undef, |
312
|
|
|
|
|
|
|
lazy_build => 1, |
313
|
|
|
|
|
|
|
); |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
sub _build_photo { |
316
|
|
|
|
|
|
|
my $self = shift @_; |
317
|
|
|
|
|
|
|
my $create = 'create_photo'; |
318
|
|
|
|
|
|
|
$self->$create($self->merge_album_args); |
319
|
|
|
|
|
|
|
} |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
sub merge_photo_args { |
322
|
|
|
|
|
|
|
my $self = shift @_; |
323
|
|
|
|
|
|
|
my $fixed_args = "photo_fixed_args"; |
324
|
|
|
|
|
|
|
my $args = "photo_args"; |
325
|
|
|
|
|
|
|
return ( |
326
|
|
|
|
|
|
|
@{$self->$fixed_args}, |
327
|
|
|
|
|
|
|
@{$self->$args}, |
328
|
|
|
|
|
|
|
); |
329
|
|
|
|
|
|
|
}; |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
The above example removed a few extraneous bits, we were getting a little long |
332
|
|
|
|
|
|
|
for a SYNOPSIS. |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
This role can be called multiple times, either against other target classes, or |
335
|
|
|
|
|
|
|
even the same class (although using a different prefix. You can also modify the |
336
|
|
|
|
|
|
|
generated methods or attributes in the normal L<Moose> way. See </COOKBOOK> |
337
|
|
|
|
|
|
|
for examples. |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
You can now instantiate your class with the following (assuming your MyApp::Photos |
340
|
|
|
|
|
|
|
class defines a 'source_dir' attribute.) |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
my $album = MyApp::Album->new(photo_args=>[source_dir=>'~/photos']); |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
The overall goal here being to allow you to defer choice of class and arguments |
345
|
|
|
|
|
|
|
to when the class is actually used, thus achieving maximum flexibility. We can |
346
|
|
|
|
|
|
|
do with with a minimum of Boilerplate code, thus encouraging rather than punishing |
347
|
|
|
|
|
|
|
well separated and clean design. |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
Please review the test example and case in '/t' for more assistance. |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
=head1 DESCRIPTION |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
There can often be a tension between coding for flexibility and for future growth |
354
|
|
|
|
|
|
|
and writing code that is terse, to the point, and solves the smallest possible |
355
|
|
|
|
|
|
|
business problem that is brought to you. Writing the minimum code to solve a |
356
|
|
|
|
|
|
|
particular problem has merit, yet can eventually leave you with an application |
357
|
|
|
|
|
|
|
that has many hacky modifications and is hard to test in an isolated manner. |
358
|
|
|
|
|
|
|
Minimum code should not imply minimum forward planning or poorly tested code. |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
For me, doing the right thing means I need to both limit myself to the smallest |
361
|
|
|
|
|
|
|
possible solution for a given business case, yet make sure I am not writing CODE |
362
|
|
|
|
|
|
|
that is impossible to grow over time in a clean manner. Generally I attempt to |
363
|
|
|
|
|
|
|
do this by clearly separating the problem domains under a business case into |
364
|
|
|
|
|
|
|
distinct classes. I then tie all the functional bits together in the loosest |
365
|
|
|
|
|
|
|
manner possible. L<Moose> makes this easy, with its powerful attribute features, |
366
|
|
|
|
|
|
|
type coercions and Roles to augment classical inheritance. |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
Loose coupling and deep configurability work well with inversion of control |
369
|
|
|
|
|
|
|
systems, like L<Bread::Board> or the IOC built into the L<Catalyst> MVC |
370
|
|
|
|
|
|
|
framework. It helps me to defer decisions to the proper authority and also |
371
|
|
|
|
|
|
|
makes it easier to test my logic, since pieces are easier to test independently. |
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
Although this leaves me with the design I desire, I find there's a lot of |
374
|
|
|
|
|
|
|
repeated boilerplate code and logic, particularly in my main application class |
375
|
|
|
|
|
|
|
which often will marshall several underlying classes, each of which is |
376
|
|
|
|
|
|
|
performing a particular job. For example: |
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
package MyApp::WebPage; |
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
use Moose; |
381
|
|
|
|
|
|
|
use Path::Class qw(file); |
382
|
|
|
|
|
|
|
use MyApp::Web::Text; |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
has text => (is=>'ro', required=>1, lazy_build=>1); |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
sub _build_text { |
387
|
|
|
|
|
|
|
file("~/text_for_webpage")->slurp; |
388
|
|
|
|
|
|
|
} |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
NOTE: For clarity I removed some of the extra type constraint checking and type |
391
|
|
|
|
|
|
|
coercions I'd normally have here. Please see the test cases in '/t' for a working |
392
|
|
|
|
|
|
|
example. |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
This retrieves the text for a single webpage. But what happens when you want |
395
|
|
|
|
|
|
|
to reuse the same class to load webpage data from different directories? |
396
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
package MyApp::WebPage; |
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
use Moose; |
400
|
|
|
|
|
|
|
use Path::Class qw(file); |
401
|
|
|
|
|
|
|
use MyApp::Web::Text; |
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
has root => (is=>'ro', required=>1); |
404
|
|
|
|
|
|
|
has text => (is=>'ro', required=>1, lazy_build=>1); |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
sub _build_text { |
407
|
|
|
|
|
|
|
my ($self) = @_; |
408
|
|
|
|
|
|
|
file($self->root)->slurp; |
409
|
|
|
|
|
|
|
} |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
(Again, I removed the normal type checking and sanity/security checks in order |
412
|
|
|
|
|
|
|
to keep things to the point). |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
Well, now I start to think that the job of slurping up text really belongs to |
415
|
|
|
|
|
|
|
another dedicated class, since WebPage is about methods on web media, and is |
416
|
|
|
|
|
|
|
not concerned at all with storage or storage mediums. Delegating the job of |
417
|
|
|
|
|
|
|
retrieval to a different class also has the big upsides of making it easier to |
418
|
|
|
|
|
|
|
test each class in turn and gives me more reuseable code. It also makes each |
419
|
|
|
|
|
|
|
class smaller in terms of code line weight, and that promotes understanding. |
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
package MyApp::WebPage; |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
use Moose; |
424
|
|
|
|
|
|
|
use MyApp::Storage |
425
|
|
|
|
|
|
|
use MyApp::Web::Text; |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
has root => (is=>'ro', required=>1); |
428
|
|
|
|
|
|
|
has storage => (is=>'ro', required=>1, lazy_build=>1); |
429
|
|
|
|
|
|
|
has text => (is=>'ro', required=>1, lazy_build=>1); |
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
sub _build_storage { |
432
|
|
|
|
|
|
|
MyApp::Storage->new(root=>$self->root); |
433
|
|
|
|
|
|
|
} |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
sub _build_text { |
436
|
|
|
|
|
|
|
my ($self) = @_; |
437
|
|
|
|
|
|
|
$self->storage->get_text; |
438
|
|
|
|
|
|
|
} |
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
Then what happens when you start to realize Storage needs additional args, or |
441
|
|
|
|
|
|
|
you need to be able to read from a subversion repository or a database? Now |
442
|
|
|
|
|
|
|
you need more control over which Storage class is loaded, and more flexibility |
443
|
|
|
|
|
|
|
in what args are passed. You also find out that you are going to need subclasses |
444
|
|
|
|
|
|
|
of 'MyApp::Web::Text', since some text is going to be HTML and others in Wiki |
445
|
|
|
|
|
|
|
format. You may end up with something like: |
446
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
package MyApp::WebPage; |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
use Moose; |
450
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
has storage_class => ( |
452
|
|
|
|
|
|
|
is => 'ro', |
453
|
|
|
|
|
|
|
# this type automatically coerces any string by trying to load it as a class |
454
|
|
|
|
|
|
|
isa => $anonymous_type, |
455
|
|
|
|
|
|
|
coerce => 1, |
456
|
|
|
|
|
|
|
required => 1, |
457
|
|
|
|
|
|
|
default => 'MyApp::Storage', |
458
|
|
|
|
|
|
|
handles => { create_storage => 'new' }, |
459
|
|
|
|
|
|
|
); |
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
has storage_args => ( |
462
|
|
|
|
|
|
|
is => 'ro', |
463
|
|
|
|
|
|
|
isa => 'ArrayRef', |
464
|
|
|
|
|
|
|
required => 1, |
465
|
|
|
|
|
|
|
); |
466
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
has storage => (is=>'ro', required=>1, lazy_build=>1); |
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
sub _build_storage { |
470
|
|
|
|
|
|
|
my ($self) = @_; |
471
|
|
|
|
|
|
|
$self->create_storage(@{$self->storage_args}); |
472
|
|
|
|
|
|
|
} |
473
|
|
|
|
|
|
|
|
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
has text_class => ( |
476
|
|
|
|
|
|
|
is => 'ro', |
477
|
|
|
|
|
|
|
# this type automatically coerces any string by trying to load it as a class |
478
|
|
|
|
|
|
|
isa => $anonymous_type, |
479
|
|
|
|
|
|
|
coerce => 1, |
480
|
|
|
|
|
|
|
required => 1, |
481
|
|
|
|
|
|
|
default => 'MyApp::Text', |
482
|
|
|
|
|
|
|
handles => { create_text => 'new' }, |
483
|
|
|
|
|
|
|
); |
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
has text_args => ( |
486
|
|
|
|
|
|
|
is => 'ro', |
487
|
|
|
|
|
|
|
isa => 'ArrayRef', |
488
|
|
|
|
|
|
|
required => 1, |
489
|
|
|
|
|
|
|
); |
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
has text => (is=>'ro', required=>1, lazy_build=>1); |
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
sub _build_text { |
494
|
|
|
|
|
|
|
my ($self) = @_; |
495
|
|
|
|
|
|
|
$self->create_text(@{$self->text_args}); |
496
|
|
|
|
|
|
|
} |
497
|
|
|
|
|
|
|
|
498
|
|
|
|
|
|
|
Which would allow a very flexibile instantiation: |
499
|
|
|
|
|
|
|
|
500
|
|
|
|
|
|
|
my $app = MyApp->new( |
501
|
|
|
|
|
|
|
storage_class=>'MyApp::Storage::WebStorage', |
502
|
|
|
|
|
|
|
storage_args=>[host_website=>'http://mystorage.com/'] |
503
|
|
|
|
|
|
|
text_class=>'MyApp::WikiText, |
504
|
|
|
|
|
|
|
text_args=>[wiki_links=>1] |
505
|
|
|
|
|
|
|
); |
506
|
|
|
|
|
|
|
|
507
|
|
|
|
|
|
|
But is pretty verbose. And if you wanted to add enough useful hooks so that |
508
|
|
|
|
|
|
|
your subclassers can modify the whole process as needed, then you are going to |
509
|
|
|
|
|
|
|
end up with even more repeated code. |
510
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
With L<MooseX::Role::BuildInstanceOf> you could simple do instead: |
512
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
package MyApp::WebPage; |
514
|
|
|
|
|
|
|
use Moose; |
515
|
|
|
|
|
|
|
with 'MooseX::Role::BuildInstanceOf' => {target=>'~Storage'}; |
516
|
|
|
|
|
|
|
with 'MooseX::Role::BuildInstanceOf' => {target=>'~Text'}; |
517
|
|
|
|
|
|
|
|
518
|
|
|
|
|
|
|
So basically you are free to concentrate on building your classes and let this |
519
|
|
|
|
|
|
|
role do the heavy lifting of providing a sane system to tie it all together and |
520
|
|
|
|
|
|
|
maintain flexibility to your subclassers. |
521
|
|
|
|
|
|
|
|
522
|
|
|
|
|
|
|
=head1 NAME |
523
|
|
|
|
|
|
|
|
524
|
|
|
|
|
|
|
MooseX::Role::BuildInstanceOf - Less Boilerplate when you need lots of Instances |
525
|
|
|
|
|
|
|
|
526
|
|
|
|
|
|
|
=head1 PARAMETERS |
527
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
This role defines the following parameters: |
529
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
=head2 target |
531
|
|
|
|
|
|
|
|
532
|
|
|
|
|
|
|
'target' is the only required parameter since it defines the target class that |
533
|
|
|
|
|
|
|
you wish to have aggregated into your class. This should be a real package |
534
|
|
|
|
|
|
|
name in the form of a string, although if you prepend a "::" to the value we |
535
|
|
|
|
|
|
|
will assume the target class is under the current classes namespace. For |
536
|
|
|
|
|
|
|
example: |
537
|
|
|
|
|
|
|
|
538
|
|
|
|
|
|
|
package MyApp::Album; |
539
|
|
|
|
|
|
|
use Moose; |
540
|
|
|
|
|
|
|
|
541
|
|
|
|
|
|
|
with 'MooseX::Role::BuildInstanceOf' => { |
542
|
|
|
|
|
|
|
target => '::Page', |
543
|
|
|
|
|
|
|
}; |
544
|
|
|
|
|
|
|
|
545
|
|
|
|
|
|
|
Would be the same as: |
546
|
|
|
|
|
|
|
|
547
|
|
|
|
|
|
|
package MyApp::Album; |
548
|
|
|
|
|
|
|
use Moose; |
549
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
with 'MooseX::Role::BuildInstanceOf' => { |
551
|
|
|
|
|
|
|
target => 'MyApp::Album::Page', |
552
|
|
|
|
|
|
|
}; |
553
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
Given a valid target, we will infer prefix and other required bits. If for |
555
|
|
|
|
|
|
|
some reason the default values result in a namespace conflict, you can resolve |
556
|
|
|
|
|
|
|
the conflict by specifying a value. |
557
|
|
|
|
|
|
|
|
558
|
|
|
|
|
|
|
You can also prepend a "~" to your 'target' class, in which case we will |
559
|
|
|
|
|
|
|
assume the classes root namespace is the '~' or 'home' namespace. For example: |
560
|
|
|
|
|
|
|
|
561
|
|
|
|
|
|
|
package MyApp::Album; |
562
|
|
|
|
|
|
|
use Moose; |
563
|
|
|
|
|
|
|
|
564
|
|
|
|
|
|
|
with 'MooseX::Role::BuildInstanceOf' => { |
565
|
|
|
|
|
|
|
target => '~Folder, |
566
|
|
|
|
|
|
|
}; |
567
|
|
|
|
|
|
|
|
568
|
|
|
|
|
|
|
Would be the same as: |
569
|
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
package MyApp::Album; |
571
|
|
|
|
|
|
|
use Moose; |
572
|
|
|
|
|
|
|
|
573
|
|
|
|
|
|
|
with 'MooseX::Role::BuildInstanceOf' => { |
574
|
|
|
|
|
|
|
target => 'MyApp::Folder', |
575
|
|
|
|
|
|
|
}; |
576
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
In this case we assume that 'MyApp' is the root home namespace. |
578
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
Please note that when you specify a 'target' you are setting a default type. |
580
|
|
|
|
|
|
|
You are free to change the target when you instantiate the object, however if |
581
|
|
|
|
|
|
|
you choose an object that is not of the same type as what you specified in |
582
|
|
|
|
|
|
|
target, this will result in a runtime error. For example: |
583
|
|
|
|
|
|
|
|
584
|
|
|
|
|
|
|
package MyApp::Album; |
585
|
|
|
|
|
|
|
use Moose; |
586
|
|
|
|
|
|
|
|
587
|
|
|
|
|
|
|
with 'MooseX::Role::BuildInstanceOf' => { |
588
|
|
|
|
|
|
|
target => 'MyApp::Folder', |
589
|
|
|
|
|
|
|
}; |
590
|
|
|
|
|
|
|
|
591
|
|
|
|
|
|
|
You could do (assuming 'MyApp::Folder::Music' is a subclass of MyApp::Folder) |
592
|
|
|
|
|
|
|
|
593
|
|
|
|
|
|
|
my $album = MyApp::Album->new(folder_class=>'MyApp::Folder::Music'); |
594
|
|
|
|
|
|
|
|
595
|
|
|
|
|
|
|
However this would generate an error: |
596
|
|
|
|
|
|
|
|
597
|
|
|
|
|
|
|
my $album = MyApp::Album->new(folder_class=>'MyApp::NotAFolderAtAll); |
598
|
|
|
|
|
|
|
|
599
|
|
|
|
|
|
|
=head2 prefix |
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
'prefix' is an optional parameter that defines the unique string prepended to |
602
|
|
|
|
|
|
|
each of the generated attributes and methods. By default we take the last |
603
|
|
|
|
|
|
|
part of the namespace passed in 'target' and process it through L<String::CamelCase> |
604
|
|
|
|
|
|
|
to decamelize the path, however if this will result in namespace collision, |
605
|
|
|
|
|
|
|
you can set something unique manually. |
606
|
|
|
|
|
|
|
|
607
|
|
|
|
|
|
|
Example: |
608
|
|
|
|
|
|
|
|
609
|
|
|
|
|
|
|
package MyApp::Album; |
610
|
|
|
|
|
|
|
use Moose; |
611
|
|
|
|
|
|
|
|
612
|
|
|
|
|
|
|
with 'MooseX::Role::BuildInstanceOf' => { |
613
|
|
|
|
|
|
|
target => 'MyApp::Folder', |
614
|
|
|
|
|
|
|
}; |
615
|
|
|
|
|
|
|
|
616
|
|
|
|
|
|
|
with 'MooseX::Role::BuildInstanceOf' => { |
617
|
|
|
|
|
|
|
target => 'MyApp::Secured::Folder', prefix=> 'secured_folder' |
618
|
|
|
|
|
|
|
}; |
619
|
|
|
|
|
|
|
|
620
|
|
|
|
|
|
|
=head2 constructor |
621
|
|
|
|
|
|
|
|
622
|
|
|
|
|
|
|
This defaults to new. Change this string to point to the actual name of the |
623
|
|
|
|
|
|
|
constructor you wish, such as in the case where you've created your own custom |
624
|
|
|
|
|
|
|
constructors or you are using something like L<MooseX::Traits> |
625
|
|
|
|
|
|
|
|
626
|
|
|
|
|
|
|
package MyApp::Album; |
627
|
|
|
|
|
|
|
use Moose; |
628
|
|
|
|
|
|
|
|
629
|
|
|
|
|
|
|
with 'MooseX::Role::BuildInstanceOf' => { |
630
|
|
|
|
|
|
|
target => 'MyApp::ClassWithTraits', constructor => 'new_with_traits', |
631
|
|
|
|
|
|
|
}; |
632
|
|
|
|
|
|
|
|
633
|
|
|
|
|
|
|
=head2 args |
634
|
|
|
|
|
|
|
|
635
|
|
|
|
|
|
|
Although the goal of this role is to offer a lot of flexibility via configuration |
636
|
|
|
|
|
|
|
it also makes sense to set rational defaults, as to help people along for the most |
637
|
|
|
|
|
|
|
common cases. Setting 'args' will create a default set of arguments passed to the |
638
|
|
|
|
|
|
|
target class when we go to create it. If the person using the class chooses to |
639
|
|
|
|
|
|
|
set args, then those will override the defaults. |
640
|
|
|
|
|
|
|
|
641
|
|
|
|
|
|
|
package MyApp::Album; |
642
|
|
|
|
|
|
|
use Moose; |
643
|
|
|
|
|
|
|
|
644
|
|
|
|
|
|
|
with 'MooseX::Role::BuildInstanceOf' => { |
645
|
|
|
|
|
|
|
target => 'MyApp::Image', args => [source_dir=>'~/Pictures'] |
646
|
|
|
|
|
|
|
}; |
647
|
|
|
|
|
|
|
|
648
|
|
|
|
|
|
|
my $personal_album = MyApp::Album->new; |
649
|
|
|
|
|
|
|
$personal_album->list_images; ## List images from '~/Pictures/' |
650
|
|
|
|
|
|
|
|
651
|
|
|
|
|
|
|
my $shared_album = MyApp::Album->new(image_args=>[source_dir=>'/shared']); |
652
|
|
|
|
|
|
|
$shared_album->list_images; ## List images from '/shared' |
653
|
|
|
|
|
|
|
|
654
|
|
|
|
|
|
|
=head2 fixed_args |
655
|
|
|
|
|
|
|
|
656
|
|
|
|
|
|
|
Similar to 'args', however this args are 'fixed' and will always be sent to the |
657
|
|
|
|
|
|
|
target class at creation time. |
658
|
|
|
|
|
|
|
|
659
|
|
|
|
|
|
|
package MyApp::Album; |
660
|
|
|
|
|
|
|
use Moose; |
661
|
|
|
|
|
|
|
|
662
|
|
|
|
|
|
|
with 'MooseX::Role::BuildInstanceOf' => { |
663
|
|
|
|
|
|
|
target => 'MyApp::Image', |
664
|
|
|
|
|
|
|
args => [source_dir=>'~/Pictures'], |
665
|
|
|
|
|
|
|
fixed_args => [show_types=>[qw/jpg gif png/]], |
666
|
|
|
|
|
|
|
}; |
667
|
|
|
|
|
|
|
|
668
|
|
|
|
|
|
|
In this case you could change the source_dir but not the 'show_types' at |
669
|
|
|
|
|
|
|
instantiation time. If your subclasses really need to do this, they would |
670
|
|
|
|
|
|
|
need to override some of the generated methods. See the next section for |
671
|
|
|
|
|
|
|
more information. |
672
|
|
|
|
|
|
|
|
673
|
|
|
|
|
|
|
=head2 inherited_args |
674
|
|
|
|
|
|
|
|
675
|
|
|
|
|
|
|
Additional args copied from the current class and passed to the target class |
676
|
|
|
|
|
|
|
at instantiation time. Individual args can be passed as strings (which is |
677
|
|
|
|
|
|
|
assumed to be the argument name, both the current and target classes), |
678
|
|
|
|
|
|
|
or as a hash ref. In the latter case, the hash's keys are the name of the |
679
|
|
|
|
|
|
|
attribute in the target class, and the value can either be a string (name |
680
|
|
|
|
|
|
|
of the attribute in the main class) or a coderef (which will be evaluated |
681
|
|
|
|
|
|
|
with the master object to determine the argument value). |
682
|
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
package MyApp::Album; |
684
|
|
|
|
|
|
|
use Moose; |
685
|
|
|
|
|
|
|
|
686
|
|
|
|
|
|
|
has root_dir => ( is => 'ro' ); |
687
|
|
|
|
|
|
|
has is_public => ( is => 'ro' ); |
688
|
|
|
|
|
|
|
|
689
|
|
|
|
|
|
|
with 'MooseX::Role::BuildInstanceOf' => { |
690
|
|
|
|
|
|
|
target => 'MyApp::Image', |
691
|
|
|
|
|
|
|
inherited_args => [ |
692
|
|
|
|
|
|
|
'root_dir', |
693
|
|
|
|
|
|
|
{ world_visible => 'is_public' }, |
694
|
|
|
|
|
|
|
{ parent_album => sub { shift @_ } }, |
695
|
|
|
|
|
|
|
} |
696
|
|
|
|
|
|
|
}; |
697
|
|
|
|
|
|
|
|
698
|
|
|
|
|
|
|
In this example, the creation of the image target object |
699
|
|
|
|
|
|
|
would be quivalent to |
700
|
|
|
|
|
|
|
|
701
|
|
|
|
|
|
|
$image = MyApp::Image->new( |
702
|
|
|
|
|
|
|
root_dir => $album->root_dir, |
703
|
|
|
|
|
|
|
world_visible => $album->is_public, |
704
|
|
|
|
|
|
|
parent_album => $album, |
705
|
|
|
|
|
|
|
); |
706
|
|
|
|
|
|
|
|
707
|
|
|
|
|
|
|
=head2 type |
708
|
|
|
|
|
|
|
|
709
|
|
|
|
|
|
|
By default we create an attribute that holds an instance of the 'target'. |
710
|
|
|
|
|
|
|
However, in some cases you would prefer to get a fresh instance for each |
711
|
|
|
|
|
|
|
call to {$prefix}. For example, you may have a set of items that are |
712
|
|
|
|
|
|
|
loaded from a directory, where the directory can be updated. In which case |
713
|
|
|
|
|
|
|
you can set the type to 'factory' and instead of an attribute, we will |
714
|
|
|
|
|
|
|
generate a method. |
715
|
|
|
|
|
|
|
|
716
|
|
|
|
|
|
|
Default value is 'attribute'. |
717
|
|
|
|
|
|
|
|
718
|
|
|
|
|
|
|
=head1 CODE GENERATION |
719
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
This role creates a number of attributes and methods in your class. All |
721
|
|
|
|
|
|
|
generated items are under the 'prefix' you set, so you should be able to |
722
|
|
|
|
|
|
|
avoid namespace collision. The following section reviews the generated |
723
|
|
|
|
|
|
|
attribute and methods, and has a brief discussion about how or when you may |
724
|
|
|
|
|
|
|
wish to modified them in subclasses, or to create particular effects. |
725
|
|
|
|
|
|
|
|
726
|
|
|
|
|
|
|
=head2 GENERATED ATTRIBUTES |
727
|
|
|
|
|
|
|
|
728
|
|
|
|
|
|
|
This role generates the following attributes into your class. |
729
|
|
|
|
|
|
|
|
730
|
|
|
|
|
|
|
=head3 {$prefix}_class |
731
|
|
|
|
|
|
|
|
732
|
|
|
|
|
|
|
This holds a ClassName, which is a normalized and loaded version of the |
733
|
|
|
|
|
|
|
string specified in the 'target' parameter by default. You can put a |
734
|
|
|
|
|
|
|
different class here, but if it's not the same class as specified in the |
735
|
|
|
|
|
|
|
'target' you must ensure that is is a subclass, otherwise you will get a |
736
|
|
|
|
|
|
|
runtime error. |
737
|
|
|
|
|
|
|
|
738
|
|
|
|
|
|
|
=head3 {$prefix}_args |
739
|
|
|
|
|
|
|
|
740
|
|
|
|
|
|
|
This will contain whatever you specified in 'args' as a default. The person |
741
|
|
|
|
|
|
|
instantiating the class can override them, but you can use this to specify some |
742
|
|
|
|
|
|
|
sane defaults. |
743
|
|
|
|
|
|
|
|
744
|
|
|
|
|
|
|
=head3 {$prefix}_fixed_args |
745
|
|
|
|
|
|
|
|
746
|
|
|
|
|
|
|
Additional args passed to the target class at instantiation time, which cannot |
747
|
|
|
|
|
|
|
be overidden by the person instantiating the class. Your subclassers, however |
748
|
|
|
|
|
|
|
can, if they are willing to go to trouble (see section below under GENERATED |
749
|
|
|
|
|
|
|
METHODS for more.) |
750
|
|
|
|
|
|
|
|
751
|
|
|
|
|
|
|
=head3 {$prefix}_inherited_args |
752
|
|
|
|
|
|
|
|
753
|
|
|
|
|
|
|
Additional args copied from the current class and passed to the target class |
754
|
|
|
|
|
|
|
at instantiation time. |
755
|
|
|
|
|
|
|
|
756
|
|
|
|
|
|
|
=head2 {$prefix} |
757
|
|
|
|
|
|
|
|
758
|
|
|
|
|
|
|
Contains an instance of the target class (the class name found in {$prefix}_class.) |
759
|
|
|
|
|
|
|
You can easily add delegates here, for example: |
760
|
|
|
|
|
|
|
|
761
|
|
|
|
|
|
|
package MyApp::Album; |
762
|
|
|
|
|
|
|
use Moose; |
763
|
|
|
|
|
|
|
|
764
|
|
|
|
|
|
|
with 'MooseX::Role::BuildInstanceOf' => { |
765
|
|
|
|
|
|
|
target => 'MyApp::Image', args => [source_dir=>'~/Pictures'] |
766
|
|
|
|
|
|
|
}; |
767
|
|
|
|
|
|
|
|
768
|
|
|
|
|
|
|
'+image' => (handles => [qw/get_image delete_image/]); |
769
|
|
|
|
|
|
|
|
770
|
|
|
|
|
|
|
Please note this is the default behavior (what you get if you set the parameter |
771
|
|
|
|
|
|
|
'type' to 'attribute' or merely leave it default. Please see below for what gets |
772
|
|
|
|
|
|
|
generated when the 'type' is 'factory'. |
773
|
|
|
|
|
|
|
|
774
|
|
|
|
|
|
|
=head2 GENERATED METHODS |
775
|
|
|
|
|
|
|
|
776
|
|
|
|
|
|
|
This role generates the following methods into your class. |
777
|
|
|
|
|
|
|
|
778
|
|
|
|
|
|
|
=head3 normalize_{$prefix}_target |
779
|
|
|
|
|
|
|
|
780
|
|
|
|
|
|
|
This examines the string you passed in the target parameter and attempts to |
781
|
|
|
|
|
|
|
normalize it (deal with the :: and ~ shortcuts mentioned above). There's |
782
|
|
|
|
|
|
|
not likely to be user serviceable bit here, unless you are trying to add you |
783
|
|
|
|
|
|
|
own shortcut types. |
784
|
|
|
|
|
|
|
|
785
|
|
|
|
|
|
|
=head3 _build_{$prefix}_class |
786
|
|
|
|
|
|
|
|
787
|
|
|
|
|
|
|
If you don't set a {$prefix}_class we will use the parameter 'target' as the |
788
|
|
|
|
|
|
|
default. |
789
|
|
|
|
|
|
|
|
790
|
|
|
|
|
|
|
=head3 _build_{$prefix}_args |
791
|
|
|
|
|
|
|
|
792
|
|
|
|
|
|
|
Sets the default args for your class. Subclasses may wish to modify this if |
793
|
|
|
|
|
|
|
they want to set different defaults. |
794
|
|
|
|
|
|
|
|
795
|
|
|
|
|
|
|
=head3 _build_{$prefix}_fixed_args |
796
|
|
|
|
|
|
|
|
797
|
|
|
|
|
|
|
as above but for the fixed_args. |
798
|
|
|
|
|
|
|
|
799
|
|
|
|
|
|
|
=head3 _build_{$prefix}_inherited_args |
800
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
as above but for the inherited_args. |
802
|
|
|
|
|
|
|
|
803
|
|
|
|
|
|
|
=head3 _build_{$prefix} |
804
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
You may wish to modify this if you want more control over how your classes are |
806
|
|
|
|
|
|
|
instantiated. |
807
|
|
|
|
|
|
|
|
808
|
|
|
|
|
|
|
=head3 merge_{$prefix}_args |
809
|
|
|
|
|
|
|
|
810
|
|
|
|
|
|
|
This controls the process of merging args and fixed_args. This is a good spot |
811
|
|
|
|
|
|
|
to modify if you need more control over exactly how the args are presented. For |
812
|
|
|
|
|
|
|
example, you may wish to supply arguments whos values are from other attributes |
813
|
|
|
|
|
|
|
in th class. |
814
|
|
|
|
|
|
|
|
815
|
|
|
|
|
|
|
package MyApp::Album; |
816
|
|
|
|
|
|
|
use Moose; |
817
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
with 'MooseX::Role::BuildInstanceOf' => { |
819
|
|
|
|
|
|
|
target => 'MyApp::Folder', |
820
|
|
|
|
|
|
|
}; |
821
|
|
|
|
|
|
|
|
822
|
|
|
|
|
|
|
with 'MooseX::Role::BuildInstanceOf' => { |
823
|
|
|
|
|
|
|
target => 'MyApp::Image', |
824
|
|
|
|
|
|
|
}; |
825
|
|
|
|
|
|
|
|
826
|
|
|
|
|
|
|
around 'merge_folder_args' => sub { |
827
|
|
|
|
|
|
|
my ($orig, $self) = @_; |
828
|
|
|
|
|
|
|
my @args = $self->$orig; |
829
|
|
|
|
|
|
|
return ( |
830
|
|
|
|
|
|
|
image => $self->image, |
831
|
|
|
|
|
|
|
@args, |
832
|
|
|
|
|
|
|
); |
833
|
|
|
|
|
|
|
}; |
834
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
In the above case the Folder needed an Image as part of its instantiation. |
836
|
|
|
|
|
|
|
|
837
|
|
|
|
|
|
|
=head2 {$prefix} |
838
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
Returns an instance of the {$prefix}_class using the whatever is in the arguments. |
840
|
|
|
|
|
|
|
Since this is a method you will get a new instance each time. |
841
|
|
|
|
|
|
|
|
842
|
|
|
|
|
|
|
You will need to set the 'type' parameter to 'factory'. |
843
|
|
|
|
|
|
|
|
844
|
|
|
|
|
|
|
with 'MooseX::Role::BuildInstanceOf' => { |
845
|
|
|
|
|
|
|
target=>'~Set', |
846
|
|
|
|
|
|
|
type=>'factory', |
847
|
|
|
|
|
|
|
}; |
848
|
|
|
|
|
|
|
|
849
|
|
|
|
|
|
|
=head1 COOKBOOK |
850
|
|
|
|
|
|
|
|
851
|
|
|
|
|
|
|
The following are example usage for this Role. |
852
|
|
|
|
|
|
|
|
853
|
|
|
|
|
|
|
=head2 Combine with L<MooseX::Traits> |
854
|
|
|
|
|
|
|
|
855
|
|
|
|
|
|
|
L<MooseX::Traits> allows you to apply roles to a class at instantiation time. |
856
|
|
|
|
|
|
|
It does this by adding an additional constructor called 'new_with_traits.'. I |
857
|
|
|
|
|
|
|
Find using this role adds an additional level of flexibility which gives the |
858
|
|
|
|
|
|
|
user of my class even more power. If you want to make sure the 'traits' |
859
|
|
|
|
|
|
|
argument is properly passed to your L<MooseX::Traits> based classes, you need to |
860
|
|
|
|
|
|
|
specify the alternative constructor: |
861
|
|
|
|
|
|
|
|
862
|
|
|
|
|
|
|
package MyApp::WebPage; |
863
|
|
|
|
|
|
|
use Moose; |
864
|
|
|
|
|
|
|
|
865
|
|
|
|
|
|
|
with 'MooseX::Role::BuildInstanceOf' => { |
866
|
|
|
|
|
|
|
target=>'~Storage', |
867
|
|
|
|
|
|
|
}; |
868
|
|
|
|
|
|
|
|
869
|
|
|
|
|
|
|
with 'MooseX::Role::BuildInstanceOf' => { |
870
|
|
|
|
|
|
|
target=>'~Text', |
871
|
|
|
|
|
|
|
constructor=>'new_with_traits', |
872
|
|
|
|
|
|
|
}; |
873
|
|
|
|
|
|
|
|
874
|
|
|
|
|
|
|
Then you can use the 'traits' argument, it will get passed corrected: |
875
|
|
|
|
|
|
|
|
876
|
|
|
|
|
|
|
my $app = MyApp->new( |
877
|
|
|
|
|
|
|
storage_class=>'MyApp::Storage::WebStorage', |
878
|
|
|
|
|
|
|
storage_args=>[host_website=>'http://mystorage.com/'] |
879
|
|
|
|
|
|
|
text_class=>'MyApp::WikiText, |
880
|
|
|
|
|
|
|
text_args=>[traits=>[qw/BasicTheme WikiLinks AllowImages/]] |
881
|
|
|
|
|
|
|
); |
882
|
|
|
|
|
|
|
|
883
|
|
|
|
|
|
|
=head2 You have a bunch of target classes |
884
|
|
|
|
|
|
|
|
885
|
|
|
|
|
|
|
If you have a bunch of classes to target and you like all the defaults, you |
886
|
|
|
|
|
|
|
can just loop: |
887
|
|
|
|
|
|
|
|
888
|
|
|
|
|
|
|
package MyApp::WebPage; |
889
|
|
|
|
|
|
|
use Moose; |
890
|
|
|
|
|
|
|
|
891
|
|
|
|
|
|
|
foreach my $target(qw/::Storage ::Text ::Image ::Album/) { |
892
|
|
|
|
|
|
|
with 'MooseX::Role::BuildInstanceOf' => {target=>$target}; |
893
|
|
|
|
|
|
|
} |
894
|
|
|
|
|
|
|
|
895
|
|
|
|
|
|
|
Which would save you even more boilerplate / repeated code. |
896
|
|
|
|
|
|
|
|
897
|
|
|
|
|
|
|
=head2 You want additional type constraints on the generated attributes. |
898
|
|
|
|
|
|
|
|
899
|
|
|
|
|
|
|
Sometimes you may wish to ensure that the generated attribute conforms to a |
900
|
|
|
|
|
|
|
particular interface. You can use stand Moose syntax to add or override any |
901
|
|
|
|
|
|
|
generated method. |
902
|
|
|
|
|
|
|
|
903
|
|
|
|
|
|
|
package MyApp::Album; |
904
|
|
|
|
|
|
|
use Moose; |
905
|
|
|
|
|
|
|
|
906
|
|
|
|
|
|
|
with 'MooseX::Role::BuildInstanceOf' => {target => '::Photo'}; |
907
|
|
|
|
|
|
|
'+photo' => (does=>'MyApp::Role::Photo'); |
908
|
|
|
|
|
|
|
|
909
|
|
|
|
|
|
|
The above would ensure that whatever instance is created, it conforms to a |
910
|
|
|
|
|
|
|
particular Role. |
911
|
|
|
|
|
|
|
|
912
|
|
|
|
|
|
|
=head1 DISCUSSION |
913
|
|
|
|
|
|
|
|
914
|
|
|
|
|
|
|
Generally speaking, I believe this role is best suited for usage in a sort of |
915
|
|
|
|
|
|
|
'middle' complexity level. That is, when the app has become somewhat complex |
916
|
|
|
|
|
|
|
but not yet so much as to warrant seeking out an IOC solution, of which |
917
|
|
|
|
|
|
|
L<Bread::Board> is an ideal candidate. However this is not to say that IOC |
918
|
|
|
|
|
|
|
containers in general and L<Bread::Board> in particular cannot scale downward. |
919
|
|
|
|
|
|
|
In fact such a system may be useful even for relatively small projects. My |
920
|
|
|
|
|
|
|
recommendation is that if you are finding yourself heavily modifying this role |
921
|
|
|
|
|
|
|
to get it to work for you, you might find your code clearer if you simple |
922
|
|
|
|
|
|
|
took on the additional technical understanding and use L<Bread::Board> instead. |
923
|
|
|
|
|
|
|
|
924
|
|
|
|
|
|
|
=head1 TODO |
925
|
|
|
|
|
|
|
|
926
|
|
|
|
|
|
|
Currently the instance slot holding the instance attribute (ie, the 'photo' in |
927
|
|
|
|
|
|
|
the above example) only has an 'Object' type constraint on it. We hack in a post |
928
|
|
|
|
|
|
|
instantiation check to make sure the create object isa of the default target type |
929
|
|
|
|
|
|
|
but it is a bit hacky. Would be nice if this code validate against a role as well. |
930
|
|
|
|
|
|
|
|
931
|
|
|
|
|
|
|
Would be great if we could detect if the underlying target is using L<MooseX::Traits> |
932
|
|
|
|
|
|
|
or one of the other standard MooseX roles that add an alternative constructor and |
933
|
|
|
|
|
|
|
use that as the default constructor over 'new'. |
934
|
|
|
|
|
|
|
|
935
|
|
|
|
|
|
|
Since the Role doesn't know anything about the Class, we can't normalize any |
936
|
|
|
|
|
|
|
incoming {$prefix}_class class names in the same way we do with 'target'. We |
937
|
|
|
|
|
|
|
could do this with a second attribute that is used to defer checking until after |
938
|
|
|
|
|
|
|
the class is loaded, but this adds even more generated attributes so I'm not |
939
|
|
|
|
|
|
|
convinced its the best way. |
940
|
|
|
|
|
|
|
|
941
|
|
|
|
|
|
|
Another thing that would be useful is that if the 'target' is a Role, we 'do |
942
|
|
|
|
|
|
|
the right thing' in regards to setting a useful type constraint and constructor. |
943
|
|
|
|
|
|
|
|
944
|
|
|
|
|
|
|
=head1 SEE ALSO |
945
|
|
|
|
|
|
|
|
946
|
|
|
|
|
|
|
The following modules or resources may be of interest. |
947
|
|
|
|
|
|
|
|
948
|
|
|
|
|
|
|
L<Moose>, L<Moose::Role>, L<MooseX::Role::Parameterized>, L<Bread::Board> |
949
|
|
|
|
|
|
|
|
950
|
|
|
|
|
|
|
=head1 AUTHOR |
951
|
|
|
|
|
|
|
|
952
|
|
|
|
|
|
|
John Napiorkowski C<< <jjnapiork@cpan.org> >> |
953
|
|
|
|
|
|
|
Florian Ragwitz C<< <rafl@debian.org> >> |
954
|
|
|
|
|
|
|
|
955
|
|
|
|
|
|
|
=head1 COPYRIGHT & LICENSE |
956
|
|
|
|
|
|
|
|
957
|
|
|
|
|
|
|
Copyright 2009, John Napiorkowski C<< <jjnapiork@cpan.org> >> |
958
|
|
|
|
|
|
|
|
959
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify |
960
|
|
|
|
|
|
|
it under the same terms as Perl itself. |
961
|
|
|
|
|
|
|
|
962
|
|
|
|
|
|
|
=head1 AUTHORS |
963
|
|
|
|
|
|
|
|
964
|
|
|
|
|
|
|
=over 4 |
965
|
|
|
|
|
|
|
|
966
|
|
|
|
|
|
|
=item * |
967
|
|
|
|
|
|
|
|
968
|
|
|
|
|
|
|
John Napiorkowski <jjnapiork@cpan.org> |
969
|
|
|
|
|
|
|
|
970
|
|
|
|
|
|
|
=item * |
971
|
|
|
|
|
|
|
|
972
|
|
|
|
|
|
|
Florian Ragwitz <rafl@debian.org> |
973
|
|
|
|
|
|
|
|
974
|
|
|
|
|
|
|
=back |
975
|
|
|
|
|
|
|
|
976
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
977
|
|
|
|
|
|
|
|
978
|
|
|
|
|
|
|
This software is copyright (c) 2011 by John Napiorkowski. |
979
|
|
|
|
|
|
|
|
980
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
981
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
982
|
|
|
|
|
|
|
|
983
|
|
|
|
|
|
|
=cut |
984
|
|
|
|
|
|
|
|
985
|
|
|
|
|
|
|
|
986
|
|
|
|
|
|
|
__END__ |
987
|
|
|
|
|
|
|
|
988
|
|
|
|
|
|
|
Maybe call this MX::Helper::Role::BuildInstanceOf ??? |
989
|
|
|
|
|
|
|
|