line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Venus::Role::Buildable; |
2
|
|
|
|
|
|
|
|
3
|
87
|
|
|
87
|
|
1576
|
use 5.018; |
|
87
|
|
|
|
|
292
|
|
4
|
|
|
|
|
|
|
|
5
|
87
|
|
|
87
|
|
451
|
use strict; |
|
87
|
|
|
|
|
182
|
|
|
87
|
|
|
|
|
1978
|
|
6
|
87
|
|
|
87
|
|
512
|
use warnings; |
|
87
|
|
|
|
|
242
|
|
|
87
|
|
|
|
|
2703
|
|
7
|
|
|
|
|
|
|
|
8
|
87
|
|
|
87
|
|
536
|
use Venus::Role 'with'; |
|
87
|
|
|
|
|
216
|
|
|
87
|
|
|
|
|
647
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
# BUILDERS |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
sub BUILD { |
13
|
13451
|
|
|
13451
|
0
|
25147
|
my ($self, $args) = @_; |
14
|
|
|
|
|
|
|
|
15
|
13451
|
100
|
|
|
|
51333
|
if ($self->can('build_self')) { |
16
|
8219
|
|
|
|
|
27102
|
$self->build_self($args); |
17
|
|
|
|
|
|
|
} |
18
|
|
|
|
|
|
|
|
19
|
13451
|
|
|
|
|
32494
|
return $self; |
20
|
|
|
|
|
|
|
} |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
sub BUILDARGS { |
23
|
13451
|
|
|
13451
|
0
|
29717
|
my ($self, @args) = @_; |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
# build_nil accepts a single-arg (empty hash) |
26
|
13451
|
|
100
|
|
|
54531
|
my $present = @args == 1 && ref $args[0] eq 'HASH' && !%{$args[0]}; |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
# empty hash argument |
29
|
13451
|
100
|
100
|
|
|
76977
|
if ($self->can('build_nil') && $present) { |
30
|
1
|
|
|
|
|
19
|
@args = ($self->build_nil($args[0])); |
31
|
|
|
|
|
|
|
} |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
# build_arg accepts a single-arg (non-hash) |
34
|
13451
|
|
100
|
|
|
41763
|
my $inflate = @args == 1 && ref $args[0] ne 'HASH'; |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
# single argument |
37
|
13451
|
100
|
100
|
|
|
72859
|
if ($self->can('build_arg') && $inflate) { |
38
|
3551
|
|
|
|
|
14514
|
@args = ($self->build_arg($args[0])); |
39
|
|
|
|
|
|
|
} |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
# build_args should not accept a single-arg (non-hash) |
42
|
13451
|
|
66
|
|
|
41603
|
my $ignore = @args == 1 && ref $args[0] ne 'HASH'; |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
# standard arguments |
45
|
13451
|
100
|
66
|
|
|
58975
|
if ($self->can('build_args') && !$ignore) { |
46
|
2749
|
100
|
|
|
|
14249
|
@args = ($self->build_args(@args == 1 ? $args[0] : {@args})); |
47
|
|
|
|
|
|
|
} |
48
|
|
|
|
|
|
|
|
49
|
13451
|
|
|
|
|
47122
|
return (@args); |
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
# EXPORTS |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
sub EXPORT { |
55
|
444
|
|
|
444
|
0
|
1441
|
['BUILDARGS'] |
56
|
|
|
|
|
|
|
} |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
1; |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
=head1 NAME |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
Venus::Role::Buildable - Buildable Role |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
=cut |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
=head1 ABSTRACT |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
Buildable Role for Perl 5 |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
=cut |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
=head1 SYNOPSIS |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
package Example; |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
use Venus::Class; |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
with 'Venus::Role::Buildable'; |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
attr 'test'; |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
package main; |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
my $example = Example->new; |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
# $example->test; |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
=cut |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
=head1 DESCRIPTION |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
This package modifies the consuming package and provides methods for hooking |
95
|
|
|
|
|
|
|
into object construction of the consuming class, e.g. handling single-arg |
96
|
|
|
|
|
|
|
object construction. |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
=cut |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
=head1 METHODS |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
This package provides the following methods: |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
=cut |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
=head2 build_arg |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
build_arg(Any $data) (HashRef) |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
The build_arg method, if defined, is only called during object construction |
111
|
|
|
|
|
|
|
when a single non-hashref is provided. |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
I> |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
=over 4 |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
=item build_arg example 1 |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
package Example1; |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
use Venus::Class; |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
attr 'x'; |
127
|
|
|
|
|
|
|
attr 'y'; |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
with 'Venus::Role::Buildable'; |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
sub build_arg { |
132
|
|
|
|
|
|
|
my ($self, $data) = @_; |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
$data = { x => $data, y => $data }; |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
return $data; |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
package main; |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
my $example = Example1->new(10); |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
# $example->x; |
144
|
|
|
|
|
|
|
# $example->y; |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
=back |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
=cut |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
=head2 build_args |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
build_args(HashRef $data) (HashRef) |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
The build_args method, if defined, is only called during object construction to |
155
|
|
|
|
|
|
|
hook into the handling of the arguments provided. |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
I> |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
=over 4 |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
=item build_args example 1 |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
package Example2; |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
use Venus::Class; |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
attr 'x'; |
168
|
|
|
|
|
|
|
attr 'y'; |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
with 'Venus::Role::Buildable'; |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
sub build_args { |
173
|
|
|
|
|
|
|
my ($self, $data) = @_; |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
$data->{x} ||= int($data->{x} || 100); |
176
|
|
|
|
|
|
|
$data->{y} ||= int($data->{y} || 100); |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
return $data; |
179
|
|
|
|
|
|
|
} |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
package main; |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
my $example = Example2->new(x => 10, y => 10); |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
# $example->x; |
186
|
|
|
|
|
|
|
# $example->y; |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
=back |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
=cut |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
=head2 build_nil |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
build_nil(HashRef $data) (Any) |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
The build_nil method, if defined, is only called during object construction |
197
|
|
|
|
|
|
|
when a single empty hashref is provided. |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
I> |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
=over 4 |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
=item build_nil example 1 |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
package Example4; |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
use Venus::Class; |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
attr 'x'; |
210
|
|
|
|
|
|
|
attr 'y'; |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
with 'Venus::Role::Buildable'; |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
sub build_nil { |
215
|
|
|
|
|
|
|
my ($self, $data) = @_; |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
$data = { x => 10, y => 10 }; |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
return $data; |
220
|
|
|
|
|
|
|
} |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
package main; |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
my $example = Example4->new({}); |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
# $example->x; |
227
|
|
|
|
|
|
|
# $example->y; |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
=back |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
=cut |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
=head2 build_self |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
build_self(HashRef $data) (Self) |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
The build_self method, if defined, is only called during object construction |
238
|
|
|
|
|
|
|
after all arguments have been handled and set. |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
I> |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
=over 4 |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
=item build_self example 1 |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
package Example3; |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
use Venus::Class; |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
attr 'x'; |
251
|
|
|
|
|
|
|
attr 'y'; |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
with 'Venus::Role::Buildable'; |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
sub build_self { |
256
|
|
|
|
|
|
|
my ($self, $data) = @_; |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
die if !$self->x; |
259
|
|
|
|
|
|
|
die if !$self->y; |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
return $self; |
262
|
|
|
|
|
|
|
} |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
package main; |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
my $example = Example3->new(x => 10, y => 10); |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
# $example->x; |
269
|
|
|
|
|
|
|
# $example->y; |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
=back |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
=cut |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
=head1 AUTHORS |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
Awncorp, C |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
=cut |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
=head1 LICENSE |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
Copyright (C) 2000, Al Newkirk. |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
This program is free software, you can redistribute it and/or modify it under |
286
|
|
|
|
|
|
|
the terms of the Apache license version 2.0. |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
=cut |