| 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
|
|
|
|
|
|
|
|