line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Class::MOP::Attribute; |
2
|
|
|
|
|
|
|
our $VERSION = '2.2206'; |
3
|
|
|
|
|
|
|
|
4
|
450
|
|
|
450
|
|
8553
|
use strict; |
|
450
|
|
|
|
|
1209
|
|
|
450
|
|
|
|
|
14548
|
|
5
|
450
|
|
|
450
|
|
2592
|
use warnings; |
|
450
|
|
|
|
|
1102
|
|
|
450
|
|
|
|
|
12640
|
|
6
|
|
|
|
|
|
|
|
7
|
450
|
|
|
450
|
|
2635
|
use Class::MOP::Method::Accessor; |
|
450
|
|
|
|
|
1083
|
|
|
450
|
|
|
|
|
12412
|
|
8
|
|
|
|
|
|
|
|
9
|
450
|
|
|
450
|
|
2661
|
use Carp 'confess'; |
|
450
|
|
|
|
|
1179
|
|
|
450
|
|
|
|
|
26238
|
|
10
|
450
|
|
|
450
|
|
3926
|
use Scalar::Util 'blessed', 'weaken'; |
|
450
|
|
|
|
|
1288
|
|
|
450
|
|
|
|
|
24506
|
|
11
|
450
|
|
|
450
|
|
3837
|
use Try::Tiny; |
|
450
|
|
|
|
|
1270
|
|
|
450
|
|
|
|
|
28537
|
|
12
|
|
|
|
|
|
|
|
13
|
450
|
|
|
450
|
|
3183
|
use parent 'Class::MOP::Object', 'Class::MOP::Mixin::AttributeCore'; |
|
450
|
|
|
|
|
1095
|
|
|
450
|
|
|
|
|
3037
|
|
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
# NOTE: (meta-circularity) |
16
|
|
|
|
|
|
|
# This method will be replaced in the |
17
|
|
|
|
|
|
|
# boostrap section of Class::MOP, by |
18
|
|
|
|
|
|
|
# a new version which uses the |
19
|
|
|
|
|
|
|
# &Class::MOP::Class::construct_instance |
20
|
|
|
|
|
|
|
# method to build an attribute meta-object |
21
|
|
|
|
|
|
|
# which itself is described with attribute |
22
|
|
|
|
|
|
|
# meta-objects. |
23
|
|
|
|
|
|
|
# - Ain't meta-circularity grand? :) |
24
|
|
|
|
|
|
|
sub new { |
25
|
56820
|
|
|
56820
|
1
|
213898
|
my ( $class, @args ) = @_; |
26
|
|
|
|
|
|
|
|
27
|
56820
|
100
|
|
|
|
190604
|
unshift @args, "name" if @args % 2 == 1; |
28
|
56820
|
|
|
|
|
215325
|
my %options = @args; |
29
|
|
|
|
|
|
|
|
30
|
56820
|
|
|
|
|
108699
|
my $name = $options{name}; |
31
|
|
|
|
|
|
|
|
32
|
56820
|
100
|
|
|
|
114810
|
(defined $name) |
33
|
|
|
|
|
|
|
|| $class->_throw_exception( MOPAttributeNewNeedsAttributeName => class => $class, |
34
|
|
|
|
|
|
|
params => \%options |
35
|
|
|
|
|
|
|
); |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
$options{init_arg} = $name |
38
|
56816
|
100
|
|
|
|
143362
|
if not exists $options{init_arg}; |
39
|
56816
|
100
|
|
|
|
110466
|
if(exists $options{builder}){ |
40
|
|
|
|
|
|
|
$class->_throw_exception( BuilderMustBeAMethodName => class => $class, |
41
|
|
|
|
|
|
|
params => \%options |
42
|
|
|
|
|
|
|
) |
43
|
482
|
100
|
66
|
|
|
3429
|
if ref $options{builder} || !(defined $options{builder}); |
44
|
|
|
|
|
|
|
$class->_throw_exception( BothBuilderAndDefaultAreNotAllowed => class => $class, |
45
|
|
|
|
|
|
|
params => \%options |
46
|
|
|
|
|
|
|
) |
47
|
476
|
100
|
|
|
|
2340
|
if exists $options{default}; |
48
|
|
|
|
|
|
|
} else { |
49
|
|
|
|
|
|
|
($class->is_default_a_coderef(\%options)) |
50
|
|
|
|
|
|
|
|| $class->_throw_exception( ReferencesAreNotAllowedAsDefault => class => $class, |
51
|
|
|
|
|
|
|
params => \%options, |
52
|
|
|
|
|
|
|
attribute_name => $options{name} |
53
|
|
|
|
|
|
|
) |
54
|
56334
|
100
|
100
|
|
|
194278
|
if exists $options{default} && ref $options{default}; |
|
|
|
100
|
|
|
|
|
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
|
57
|
56800
|
100
|
66
|
|
|
150659
|
if( $options{required} and not( defined($options{builder}) || defined($options{init_arg}) || exists $options{default} ) ) { |
|
|
|
100
|
|
|
|
|
58
|
1
|
|
|
|
|
5
|
$class->_throw_exception( RequiredAttributeLacksInitialization => class => $class, |
59
|
|
|
|
|
|
|
params => \%options |
60
|
|
|
|
|
|
|
); |
61
|
|
|
|
|
|
|
} |
62
|
|
|
|
|
|
|
|
63
|
56799
|
|
|
|
|
204422
|
$class->_new(\%options); |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
sub _new { |
67
|
54494
|
|
|
54494
|
|
83145
|
my $class = shift; |
68
|
|
|
|
|
|
|
|
69
|
54494
|
100
|
|
|
|
113829
|
return Class::MOP::Class->initialize($class)->new_object(@_) |
70
|
|
|
|
|
|
|
if $class ne __PACKAGE__; |
71
|
|
|
|
|
|
|
|
72
|
54082
|
50
|
|
|
|
109116
|
my $options = @_ == 1 ? $_[0] : {@_}; |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
bless { |
75
|
|
|
|
|
|
|
'name' => $options->{name}, |
76
|
|
|
|
|
|
|
'accessor' => $options->{accessor}, |
77
|
|
|
|
|
|
|
'reader' => $options->{reader}, |
78
|
|
|
|
|
|
|
'writer' => $options->{writer}, |
79
|
|
|
|
|
|
|
'predicate' => $options->{predicate}, |
80
|
|
|
|
|
|
|
'clearer' => $options->{clearer}, |
81
|
|
|
|
|
|
|
'builder' => $options->{builder}, |
82
|
|
|
|
|
|
|
'init_arg' => $options->{init_arg}, |
83
|
|
|
|
|
|
|
exists $options->{default} |
84
|
|
|
|
|
|
|
? ('default' => $options->{default}) |
85
|
|
|
|
|
|
|
: (), |
86
|
|
|
|
|
|
|
'initializer' => $options->{initializer}, |
87
|
|
|
|
|
|
|
'definition_context' => $options->{definition_context}, |
88
|
|
|
|
|
|
|
# keep a weakened link to the |
89
|
|
|
|
|
|
|
# class we are associated with |
90
|
54082
|
100
|
|
|
|
681952
|
'associated_class' => undef, |
91
|
|
|
|
|
|
|
# and a list of the methods |
92
|
|
|
|
|
|
|
# associated with this attr |
93
|
|
|
|
|
|
|
'associated_methods' => [], |
94
|
|
|
|
|
|
|
# this let's us keep track of |
95
|
|
|
|
|
|
|
# our order inside the associated |
96
|
|
|
|
|
|
|
# class |
97
|
|
|
|
|
|
|
'insertion_order' => undef, |
98
|
|
|
|
|
|
|
}, $class; |
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
# NOTE: |
102
|
|
|
|
|
|
|
# this is a primitive (and kludgy) clone operation |
103
|
|
|
|
|
|
|
# for now, it will be replaced in the Class::MOP |
104
|
|
|
|
|
|
|
# bootstrap with a proper one, however we know |
105
|
|
|
|
|
|
|
# that this one will work fine for now. |
106
|
|
|
|
|
|
|
sub clone { |
107
|
|
|
|
|
|
|
my $self = shift; |
108
|
|
|
|
|
|
|
my %options = @_; |
109
|
|
|
|
|
|
|
(blessed($self)) |
110
|
|
|
|
|
|
|
|| confess "Can only clone an instance"; |
111
|
|
|
|
|
|
|
# this implementation is overwritten by the bootstrap process, |
112
|
|
|
|
|
|
|
# so this exception will never trigger. If it ever does occur, |
113
|
|
|
|
|
|
|
# it indicates a gigantic problem with the most internal parts |
114
|
|
|
|
|
|
|
# of Moose, so we wouldn't want a Moose-based exception object anyway |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
return bless { %{$self}, %options } => ref($self); |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
sub initialize_instance_slot { |
120
|
163262
|
|
|
163262
|
1
|
266819
|
my ($self, $meta_instance, $instance, $params) = @_; |
121
|
163262
|
|
|
|
|
299671
|
my $init_arg = $self->{'init_arg'}; |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
# try to fetch the init arg from the %params ... |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
# if nothing was in the %params, we can use the |
126
|
|
|
|
|
|
|
# attribute's default value (if it has one) |
127
|
163262
|
100
|
100
|
|
|
570779
|
if(defined $init_arg and exists $params->{$init_arg}){ |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
128
|
|
|
|
|
|
|
$self->_set_initial_slot_value( |
129
|
|
|
|
|
|
|
$meta_instance, |
130
|
|
|
|
|
|
|
$instance, |
131
|
90629
|
|
|
|
|
183173
|
$params->{$init_arg}, |
132
|
|
|
|
|
|
|
); |
133
|
|
|
|
|
|
|
} |
134
|
|
|
|
|
|
|
elsif (exists $self->{'default'}) { |
135
|
38895
|
|
|
|
|
118693
|
$self->_set_initial_slot_value( |
136
|
|
|
|
|
|
|
$meta_instance, |
137
|
|
|
|
|
|
|
$instance, |
138
|
|
|
|
|
|
|
$self->default($instance), |
139
|
|
|
|
|
|
|
); |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
elsif (defined( my $builder = $self->{'builder'})) { |
142
|
9
|
100
|
|
|
|
53
|
if ($builder = $instance->can($builder)) { |
143
|
8
|
|
|
|
|
26
|
$self->_set_initial_slot_value( |
144
|
|
|
|
|
|
|
$meta_instance, |
145
|
|
|
|
|
|
|
$instance, |
146
|
|
|
|
|
|
|
$instance->$builder, |
147
|
|
|
|
|
|
|
); |
148
|
|
|
|
|
|
|
} |
149
|
|
|
|
|
|
|
else { |
150
|
1
|
|
|
|
|
4
|
$self->_throw_exception( BuilderMethodNotSupportedForAttribute => attribute => $self, |
151
|
|
|
|
|
|
|
instance => $instance |
152
|
|
|
|
|
|
|
); |
153
|
|
|
|
|
|
|
} |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
} |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
sub _set_initial_slot_value { |
158
|
132831
|
|
|
132831
|
|
224186
|
my ($self, $meta_instance, $instance, $value) = @_; |
159
|
|
|
|
|
|
|
|
160
|
132831
|
|
|
|
|
272573
|
my $slot_name = $self->name; |
161
|
|
|
|
|
|
|
|
162
|
132831
|
100
|
|
|
|
258257
|
return $meta_instance->set_slot_value($instance, $slot_name, $value) |
163
|
|
|
|
|
|
|
unless $self->has_initializer; |
164
|
|
|
|
|
|
|
|
165
|
12
|
|
|
|
|
53
|
my $callback = $self->_make_initializer_writer_callback( |
166
|
|
|
|
|
|
|
$meta_instance, $instance, $slot_name |
167
|
|
|
|
|
|
|
); |
168
|
|
|
|
|
|
|
|
169
|
12
|
|
|
|
|
54
|
my $initializer = $self->initializer; |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
# most things will just want to set a value, so make it first arg |
172
|
12
|
|
|
|
|
49
|
$instance->$initializer($value, $callback, $self); |
173
|
|
|
|
|
|
|
} |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
sub _make_initializer_writer_callback { |
176
|
12
|
|
|
12
|
|
23
|
my $self = shift; |
177
|
12
|
|
|
|
|
36
|
my ($meta_instance, $instance, $slot_name) = @_; |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
return sub { |
180
|
11
|
|
|
11
|
|
1343
|
$meta_instance->set_slot_value($instance, $slot_name, $_[0]); |
181
|
12
|
|
|
|
|
67
|
}; |
182
|
|
|
|
|
|
|
} |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
sub get_read_method { |
185
|
246
|
|
|
246
|
1
|
1570
|
my $self = shift; |
186
|
246
|
|
100
|
|
|
1387
|
my $reader = $self->reader || $self->accessor; |
187
|
|
|
|
|
|
|
# normal case ... |
188
|
246
|
100
|
|
|
|
1280
|
return $reader unless ref $reader; |
189
|
|
|
|
|
|
|
# the HASH ref case |
190
|
35
|
|
|
|
|
132
|
my ($name) = %$reader; |
191
|
35
|
|
|
|
|
105
|
return $name; |
192
|
|
|
|
|
|
|
} |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
sub get_write_method { |
195
|
121
|
|
|
121
|
1
|
204
|
my $self = shift; |
196
|
121
|
|
100
|
|
|
684
|
my $writer = $self->writer || $self->accessor; |
197
|
|
|
|
|
|
|
# normal case ... |
198
|
121
|
50
|
|
|
|
798
|
return $writer unless ref $writer; |
199
|
|
|
|
|
|
|
# the HASH ref case |
200
|
0
|
|
|
|
|
0
|
my ($name) = %$writer; |
201
|
0
|
|
|
|
|
0
|
return $name; |
202
|
|
|
|
|
|
|
} |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
sub get_read_method_ref { |
205
|
121
|
|
|
121
|
1
|
495
|
my $self = shift; |
206
|
121
|
100
|
100
|
|
|
392
|
if ((my $reader = $self->get_read_method) && $self->associated_class) { |
207
|
107
|
|
|
|
|
417
|
return $self->associated_class->get_method($reader); |
208
|
|
|
|
|
|
|
} |
209
|
|
|
|
|
|
|
else { |
210
|
14
|
|
|
11
|
|
66
|
my $code = sub { $self->get_value(@_) }; |
|
11
|
|
|
|
|
8277
|
|
211
|
14
|
100
|
|
|
|
61
|
if (my $class = $self->associated_class) { |
212
|
10
|
|
|
|
|
103
|
return $class->method_metaclass->wrap( |
213
|
|
|
|
|
|
|
$code, |
214
|
|
|
|
|
|
|
package_name => $class->name, |
215
|
|
|
|
|
|
|
name => '__ANON__' |
216
|
|
|
|
|
|
|
); |
217
|
|
|
|
|
|
|
} |
218
|
|
|
|
|
|
|
else { |
219
|
4
|
|
|
|
|
13
|
return $code; |
220
|
|
|
|
|
|
|
} |
221
|
|
|
|
|
|
|
} |
222
|
|
|
|
|
|
|
} |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
sub get_write_method_ref { |
225
|
111
|
|
|
111
|
1
|
239
|
my $self = shift; |
226
|
111
|
100
|
100
|
|
|
266
|
if ((my $writer = $self->get_write_method) && $self->associated_class) { |
227
|
83
|
|
|
|
|
268
|
return $self->associated_class->get_method($writer); |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
else { |
230
|
28
|
|
|
47
|
|
142
|
my $code = sub { $self->set_value(@_) }; |
|
47
|
|
|
|
|
14860
|
|
231
|
28
|
100
|
|
|
|
124
|
if (my $class = $self->associated_class) { |
232
|
24
|
|
|
|
|
161
|
return $class->method_metaclass->wrap( |
233
|
|
|
|
|
|
|
$code, |
234
|
|
|
|
|
|
|
package_name => $class->name, |
235
|
|
|
|
|
|
|
name => '__ANON__' |
236
|
|
|
|
|
|
|
); |
237
|
|
|
|
|
|
|
} |
238
|
|
|
|
|
|
|
else { |
239
|
4
|
|
|
|
|
12
|
return $code; |
240
|
|
|
|
|
|
|
} |
241
|
|
|
|
|
|
|
} |
242
|
|
|
|
|
|
|
} |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
# slots |
245
|
|
|
|
|
|
|
|
246
|
172170
|
|
|
172170
|
1
|
504144
|
sub slots { (shift)->name } |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
# class association |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
sub attach_to_class { |
251
|
56788
|
|
|
56788
|
1
|
95351
|
my ($self, $class) = @_; |
252
|
56788
|
100
|
100
|
|
|
306725
|
(blessed($class) && $class->isa('Class::MOP::Class')) |
253
|
|
|
|
|
|
|
|| $self->_throw_exception( AttachToClassNeedsAClassMOPClassInstanceOrASubclass => attribute => $self, |
254
|
|
|
|
|
|
|
class => $class |
255
|
|
|
|
|
|
|
); |
256
|
56784
|
|
|
|
|
229366
|
weaken($self->{'associated_class'} = $class); |
257
|
|
|
|
|
|
|
} |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
sub detach_from_class { |
260
|
26
|
|
|
26
|
1
|
66
|
my $self = shift; |
261
|
26
|
|
|
|
|
76
|
$self->{'associated_class'} = undef; |
262
|
|
|
|
|
|
|
} |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
# method association |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
sub associate_method { |
267
|
109299
|
|
|
109299
|
1
|
213679
|
my ($self, $method) = @_; |
268
|
109299
|
|
|
|
|
156076
|
push @{$self->{'associated_methods'}} => $method; |
|
109299
|
|
|
|
|
287905
|
|
269
|
|
|
|
|
|
|
} |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
## Slot management |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
sub set_initial_value { |
274
|
3299
|
|
|
3299
|
1
|
9002
|
my ($self, $instance, $value) = @_; |
275
|
3299
|
|
|
|
|
12614
|
$self->_set_initial_slot_value( |
276
|
|
|
|
|
|
|
Class::MOP::Class->initialize(ref($instance))->get_meta_instance, |
277
|
|
|
|
|
|
|
$instance, |
278
|
|
|
|
|
|
|
$value |
279
|
|
|
|
|
|
|
); |
280
|
|
|
|
|
|
|
} |
281
|
|
|
|
|
|
|
|
282
|
400
|
|
|
400
|
1
|
909
|
sub set_value { shift->set_raw_value(@_) } |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
sub set_raw_value { |
285
|
401
|
|
|
401
|
1
|
1430
|
my $self = shift; |
286
|
401
|
|
|
|
|
682
|
my ($instance, $value) = @_; |
287
|
|
|
|
|
|
|
|
288
|
401
|
|
|
|
|
1122
|
my $mi = Class::MOP::Class->initialize(ref($instance))->get_meta_instance; |
289
|
401
|
|
|
|
|
1515
|
return $mi->set_slot_value($instance, $self->name, $value); |
290
|
|
|
|
|
|
|
} |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
sub _inline_set_value { |
293
|
153572
|
|
|
153572
|
|
220748
|
my $self = shift; |
294
|
153572
|
|
|
|
|
268100
|
return $self->_inline_instance_set(@_) . ';'; |
295
|
|
|
|
|
|
|
} |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
sub _inline_instance_set { |
298
|
154462
|
|
|
154462
|
|
199713
|
my $self = shift; |
299
|
154462
|
|
|
|
|
244359
|
my ($instance, $value) = @_; |
300
|
|
|
|
|
|
|
|
301
|
154462
|
|
|
|
|
430322
|
my $mi = $self->associated_class->get_meta_instance; |
302
|
154460
|
|
|
|
|
441346
|
return $mi->inline_set_slot_value($instance, $self->name, $value); |
303
|
|
|
|
|
|
|
} |
304
|
|
|
|
|
|
|
|
305
|
6479
|
|
|
6479
|
1
|
14384
|
sub get_value { shift->get_raw_value(@_) } |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
sub get_raw_value { |
308
|
6481
|
|
|
6481
|
1
|
9745
|
my $self = shift; |
309
|
6481
|
|
|
|
|
11060
|
my ($instance) = @_; |
310
|
|
|
|
|
|
|
|
311
|
6481
|
|
|
|
|
19614
|
my $mi = Class::MOP::Class->initialize(ref($instance))->get_meta_instance; |
312
|
6481
|
|
|
|
|
26108
|
return $mi->get_slot_value($instance, $self->name); |
313
|
|
|
|
|
|
|
} |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
sub _inline_get_value { |
316
|
28966
|
|
|
28966
|
|
51966
|
my $self = shift; |
317
|
28966
|
|
|
|
|
63521
|
return $self->_inline_instance_get(@_) . ';'; |
318
|
|
|
|
|
|
|
} |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
sub _inline_instance_get { |
321
|
32966
|
|
|
32966
|
|
50206
|
my $self = shift; |
322
|
32966
|
|
|
|
|
57270
|
my ($instance) = @_; |
323
|
|
|
|
|
|
|
|
324
|
32966
|
|
|
|
|
115389
|
my $mi = $self->associated_class->get_meta_instance; |
325
|
32965
|
|
|
|
|
116010
|
return $mi->inline_get_slot_value($instance, $self->name); |
326
|
|
|
|
|
|
|
} |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
sub has_value { |
329
|
7340
|
|
|
7340
|
1
|
11572
|
my $self = shift; |
330
|
7340
|
|
|
|
|
12649
|
my ($instance) = @_; |
331
|
|
|
|
|
|
|
|
332
|
7340
|
|
|
|
|
21653
|
my $mi = Class::MOP::Class->initialize(ref($instance))->get_meta_instance; |
333
|
7340
|
|
|
|
|
29226
|
return $mi->is_slot_initialized($instance, $self->name); |
334
|
|
|
|
|
|
|
} |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
sub _inline_has_value { |
337
|
6327
|
|
|
6327
|
|
10893
|
my $self = shift; |
338
|
6327
|
|
|
|
|
15675
|
return $self->_inline_instance_has(@_) . ';'; |
339
|
|
|
|
|
|
|
} |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
sub _inline_instance_has { |
342
|
7080
|
|
|
7080
|
|
11607
|
my $self = shift; |
343
|
7080
|
|
|
|
|
14011
|
my ($instance) = @_; |
344
|
|
|
|
|
|
|
|
345
|
7080
|
|
|
|
|
27155
|
my $mi = $self->associated_class->get_meta_instance; |
346
|
7079
|
|
|
|
|
30555
|
return $mi->inline_is_slot_initialized($instance, $self->name); |
347
|
|
|
|
|
|
|
} |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
sub clear_value { |
350
|
15
|
|
|
15
|
1
|
26
|
my $self = shift; |
351
|
15
|
|
|
|
|
31
|
my ($instance) = @_; |
352
|
|
|
|
|
|
|
|
353
|
15
|
|
|
|
|
41
|
my $mi = Class::MOP::Class->initialize(ref($instance))->get_meta_instance; |
354
|
15
|
|
|
|
|
63
|
return $mi->deinitialize_slot($instance, $self->name); |
355
|
|
|
|
|
|
|
} |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
sub _inline_clear_value { |
358
|
80
|
|
|
80
|
|
229
|
my $self = shift; |
359
|
80
|
|
|
|
|
434
|
return $self->_inline_instance_clear(@_) . ';'; |
360
|
|
|
|
|
|
|
} |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
sub _inline_instance_clear { |
363
|
80
|
|
|
80
|
|
212
|
my $self = shift; |
364
|
80
|
|
|
|
|
220
|
my ($instance) = @_; |
365
|
|
|
|
|
|
|
|
366
|
80
|
|
|
|
|
424
|
my $mi = $self->associated_class->get_meta_instance; |
367
|
79
|
|
|
|
|
677
|
return $mi->inline_deinitialize_slot($instance, $self->name); |
368
|
|
|
|
|
|
|
} |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
## load em up ... |
371
|
|
|
|
|
|
|
|
372
|
104988
|
|
|
104988
|
1
|
550126
|
sub accessor_metaclass { 'Class::MOP::Method::Accessor' } |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
sub _process_accessors { |
375
|
108222
|
|
|
108222
|
|
252477
|
my ($self, $type, $accessor, $generate_as_inline_methods) = @_; |
376
|
|
|
|
|
|
|
|
377
|
108222
|
100
|
|
|
|
151250
|
my $method_ctx = { %{ $self->definition_context || {} } }; |
|
108222
|
|
|
|
|
682677
|
|
378
|
|
|
|
|
|
|
|
379
|
108222
|
100
|
|
|
|
282452
|
if (ref($accessor)) { |
380
|
31507
|
100
|
|
|
|
66132
|
(ref($accessor) eq 'HASH') |
381
|
|
|
|
|
|
|
|| $self->_throw_exception( BadOptionFormat => attribute => $self, |
382
|
|
|
|
|
|
|
option_value => $accessor, |
383
|
|
|
|
|
|
|
option_name => $type |
384
|
|
|
|
|
|
|
); |
385
|
|
|
|
|
|
|
|
386
|
31505
|
|
|
|
|
41954
|
my ($name, $method) = %{$accessor}; |
|
31505
|
|
|
|
|
91284
|
|
387
|
|
|
|
|
|
|
|
388
|
31505
|
|
|
|
|
70522
|
$method_ctx->{description} = $self->_accessor_description($name, $type); |
389
|
|
|
|
|
|
|
|
390
|
31505
|
|
|
|
|
63420
|
$method = $self->accessor_metaclass->wrap( |
391
|
|
|
|
|
|
|
$method, |
392
|
|
|
|
|
|
|
attribute => $self, |
393
|
|
|
|
|
|
|
package_name => $self->associated_class->name, |
394
|
|
|
|
|
|
|
name => $name, |
395
|
|
|
|
|
|
|
associated_metaclass => $self->associated_class, |
396
|
|
|
|
|
|
|
definition_context => $method_ctx, |
397
|
|
|
|
|
|
|
); |
398
|
31505
|
|
|
|
|
84981
|
$self->associate_method($method); |
399
|
31505
|
|
|
|
|
148864
|
return ($name, $method); |
400
|
|
|
|
|
|
|
} |
401
|
|
|
|
|
|
|
else { |
402
|
76715
|
|
66
|
|
|
300352
|
my $inline_me = ($generate_as_inline_methods && $self->associated_class->instance_metaclass->is_inlinable); |
403
|
76715
|
|
|
|
|
109385
|
my $method; |
404
|
|
|
|
|
|
|
try { |
405
|
76715
|
|
|
76715
|
|
3085937
|
$method_ctx->{description} = $self->_accessor_description($accessor, $type); |
406
|
|
|
|
|
|
|
|
407
|
76712
|
|
|
|
|
179900
|
$method = $self->accessor_metaclass->new( |
408
|
|
|
|
|
|
|
attribute => $self, |
409
|
|
|
|
|
|
|
is_inline => $inline_me, |
410
|
|
|
|
|
|
|
accessor_type => $type, |
411
|
|
|
|
|
|
|
package_name => $self->associated_class->name, |
412
|
|
|
|
|
|
|
name => $accessor, |
413
|
|
|
|
|
|
|
associated_metaclass => $self->associated_class, |
414
|
|
|
|
|
|
|
definition_context => $method_ctx, |
415
|
|
|
|
|
|
|
); |
416
|
|
|
|
|
|
|
} |
417
|
|
|
|
|
|
|
catch { |
418
|
3
|
|
|
3
|
|
74
|
$self->_throw_exception( CouldNotCreateMethod => attribute => $self, |
419
|
|
|
|
|
|
|
option_value => $accessor, |
420
|
|
|
|
|
|
|
option_name => $type, |
421
|
|
|
|
|
|
|
error => $_ |
422
|
|
|
|
|
|
|
); |
423
|
76715
|
|
|
|
|
478934
|
}; |
424
|
76712
|
|
|
|
|
1221613
|
$self->associate_method($method); |
425
|
76712
|
|
|
|
|
359756
|
return ($accessor, $method); |
426
|
|
|
|
|
|
|
} |
427
|
|
|
|
|
|
|
} |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
sub _accessor_description { |
430
|
108220
|
|
|
108220
|
|
169147
|
my $self = shift; |
431
|
108220
|
|
|
|
|
191198
|
my ($name, $type) = @_; |
432
|
|
|
|
|
|
|
|
433
|
108220
|
|
|
|
|
478270
|
my $desc = "$type " . $self->associated_class->name . "::$name"; |
434
|
108217
|
100
|
|
|
|
327006
|
if ( $name ne $self->name ) { |
435
|
45625
|
|
|
|
|
139211
|
$desc .= " of attribute " . $self->name; |
436
|
|
|
|
|
|
|
} |
437
|
|
|
|
|
|
|
|
438
|
108217
|
|
|
|
|
277555
|
return $desc; |
439
|
|
|
|
|
|
|
} |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
sub install_accessors { |
442
|
86134
|
|
|
86134
|
1
|
136834
|
my $self = shift; |
443
|
86134
|
|
|
|
|
120467
|
my $inline = shift; |
444
|
86134
|
|
|
|
|
232938
|
my $class = $self->associated_class; |
445
|
|
|
|
|
|
|
|
446
|
86134
|
100
|
|
|
|
212140
|
$class->add_method( |
447
|
|
|
|
|
|
|
$self->_process_accessors('accessor' => $self->accessor(), $inline) |
448
|
|
|
|
|
|
|
) if $self->has_accessor(); |
449
|
|
|
|
|
|
|
|
450
|
86134
|
100
|
|
|
|
232230
|
$class->add_method( |
451
|
|
|
|
|
|
|
$self->_process_accessors('reader' => $self->reader(), $inline) |
452
|
|
|
|
|
|
|
) if $self->has_reader(); |
453
|
|
|
|
|
|
|
|
454
|
86132
|
100
|
|
|
|
274155
|
$class->add_method( |
455
|
|
|
|
|
|
|
$self->_process_accessors('writer' => $self->writer(), $inline) |
456
|
|
|
|
|
|
|
) if $self->has_writer(); |
457
|
|
|
|
|
|
|
|
458
|
86132
|
100
|
|
|
|
212425
|
$class->add_method( |
459
|
|
|
|
|
|
|
$self->_process_accessors('predicate' => $self->predicate(), $inline) |
460
|
|
|
|
|
|
|
) if $self->has_predicate(); |
461
|
|
|
|
|
|
|
|
462
|
86130
|
100
|
|
|
|
217832
|
$class->add_method( |
463
|
|
|
|
|
|
|
$self->_process_accessors('clearer' => $self->clearer(), $inline) |
464
|
|
|
|
|
|
|
) if $self->has_clearer(); |
465
|
|
|
|
|
|
|
|
466
|
86130
|
|
|
|
|
334763
|
return; |
467
|
|
|
|
|
|
|
} |
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
{ |
470
|
|
|
|
|
|
|
my $_remove_accessor = sub { |
471
|
|
|
|
|
|
|
my ($accessor, $class) = @_; |
472
|
|
|
|
|
|
|
if (ref($accessor) && ref($accessor) eq 'HASH') { |
473
|
|
|
|
|
|
|
($accessor) = keys %{$accessor}; |
474
|
|
|
|
|
|
|
} |
475
|
|
|
|
|
|
|
my $method = $class->get_method($accessor); |
476
|
|
|
|
|
|
|
$class->remove_method($accessor) |
477
|
|
|
|
|
|
|
if (ref($method) && $method->isa('Class::MOP::Method::Accessor')); |
478
|
|
|
|
|
|
|
}; |
479
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
sub remove_accessors { |
481
|
68
|
|
|
68
|
1
|
148
|
my $self = shift; |
482
|
|
|
|
|
|
|
# TODO: |
483
|
|
|
|
|
|
|
# we really need to make sure to remove from the |
484
|
|
|
|
|
|
|
# associates methods here as well. But this is |
485
|
|
|
|
|
|
|
# such a slimly used method, I am not worried |
486
|
|
|
|
|
|
|
# about it right now. |
487
|
68
|
100
|
|
|
|
262
|
$_remove_accessor->($self->accessor(), $self->associated_class()) if $self->has_accessor(); |
488
|
68
|
100
|
|
|
|
273
|
$_remove_accessor->($self->reader(), $self->associated_class()) if $self->has_reader(); |
489
|
68
|
100
|
|
|
|
299
|
$_remove_accessor->($self->writer(), $self->associated_class()) if $self->has_writer(); |
490
|
68
|
100
|
|
|
|
268
|
$_remove_accessor->($self->predicate(), $self->associated_class()) if $self->has_predicate(); |
491
|
68
|
100
|
|
|
|
237
|
$_remove_accessor->($self->clearer(), $self->associated_class()) if $self->has_clearer(); |
492
|
68
|
|
|
|
|
182
|
return; |
493
|
|
|
|
|
|
|
} |
494
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
} |
496
|
|
|
|
|
|
|
|
497
|
|
|
|
|
|
|
1; |
498
|
|
|
|
|
|
|
|
499
|
|
|
|
|
|
|
# ABSTRACT: Attribute Meta Object |
500
|
|
|
|
|
|
|
|
501
|
|
|
|
|
|
|
__END__ |
502
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
=pod |
504
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
=encoding UTF-8 |
506
|
|
|
|
|
|
|
|
507
|
|
|
|
|
|
|
=head1 NAME |
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
Class::MOP::Attribute - Attribute Meta Object |
510
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
=head1 VERSION |
512
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
version 2.2206 |
514
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
=head1 SYNOPSIS |
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
Class::MOP::Attribute->new( |
518
|
|
|
|
|
|
|
foo => ( |
519
|
|
|
|
|
|
|
accessor => 'foo', # dual purpose get/set accessor |
520
|
|
|
|
|
|
|
predicate => 'has_foo', # predicate check for defined-ness |
521
|
|
|
|
|
|
|
init_arg => '-foo', # class->new will look for a -foo key |
522
|
|
|
|
|
|
|
default => 'BAR IS BAZ!' # if no -foo key is provided, use this |
523
|
|
|
|
|
|
|
) |
524
|
|
|
|
|
|
|
); |
525
|
|
|
|
|
|
|
|
526
|
|
|
|
|
|
|
Class::MOP::Attribute->new( |
527
|
|
|
|
|
|
|
bar => ( |
528
|
|
|
|
|
|
|
reader => 'bar', # getter |
529
|
|
|
|
|
|
|
writer => 'set_bar', # setter |
530
|
|
|
|
|
|
|
predicate => 'has_bar', # predicate check for defined-ness |
531
|
|
|
|
|
|
|
init_arg => ':bar', # class->new will look for a :bar key |
532
|
|
|
|
|
|
|
# no default value means it is undef |
533
|
|
|
|
|
|
|
) |
534
|
|
|
|
|
|
|
); |
535
|
|
|
|
|
|
|
|
536
|
|
|
|
|
|
|
=head1 DESCRIPTION |
537
|
|
|
|
|
|
|
|
538
|
|
|
|
|
|
|
The Attribute Protocol is almost entirely an invention of |
539
|
|
|
|
|
|
|
C<Class::MOP>. Perl 5 does not have a consistent notion of |
540
|
|
|
|
|
|
|
attributes. There are so many ways in which this is done, and very few |
541
|
|
|
|
|
|
|
(if any) are easily discoverable by this module. |
542
|
|
|
|
|
|
|
|
543
|
|
|
|
|
|
|
With that said, this module attempts to inject some order into this |
544
|
|
|
|
|
|
|
chaos, by introducing a consistent API which can be used to create |
545
|
|
|
|
|
|
|
object attributes. |
546
|
|
|
|
|
|
|
|
547
|
|
|
|
|
|
|
=head1 METHODS |
548
|
|
|
|
|
|
|
|
549
|
|
|
|
|
|
|
=head2 Creation |
550
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
=over 4 |
552
|
|
|
|
|
|
|
|
553
|
|
|
|
|
|
|
=item B<< Class::MOP::Attribute->new($name, ?%options) >> |
554
|
|
|
|
|
|
|
|
555
|
|
|
|
|
|
|
An attribute must (at the very least), have a C<$name>. All other |
556
|
|
|
|
|
|
|
C<%options> are added as key-value pairs. |
557
|
|
|
|
|
|
|
|
558
|
|
|
|
|
|
|
=over 8 |
559
|
|
|
|
|
|
|
|
560
|
|
|
|
|
|
|
=item * init_arg |
561
|
|
|
|
|
|
|
|
562
|
|
|
|
|
|
|
This is a string value representing the expected key in an |
563
|
|
|
|
|
|
|
initialization hash. For instance, if we have an C<init_arg> value of |
564
|
|
|
|
|
|
|
C<-foo>, then the following code will Just Work. |
565
|
|
|
|
|
|
|
|
566
|
|
|
|
|
|
|
MyClass->meta->new_object( -foo => 'Hello There' ); |
567
|
|
|
|
|
|
|
|
568
|
|
|
|
|
|
|
If an init_arg is not assigned, it will automatically use the |
569
|
|
|
|
|
|
|
attribute's name. If C<init_arg> is explicitly set to C<undef>, the |
570
|
|
|
|
|
|
|
attribute cannot be specified during initialization. |
571
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
=item * builder |
573
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
This provides the name of a method that will be called to initialize |
575
|
|
|
|
|
|
|
the attribute. This method will be called on the object after it is |
576
|
|
|
|
|
|
|
constructed. It is expected to return a valid value for the attribute. |
577
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
=item * default |
579
|
|
|
|
|
|
|
|
580
|
|
|
|
|
|
|
This can be used to provide an explicit default for initializing the |
581
|
|
|
|
|
|
|
attribute. If the default you provide is a subroutine reference, then |
582
|
|
|
|
|
|
|
this reference will be called I<as a method> on the object. |
583
|
|
|
|
|
|
|
|
584
|
|
|
|
|
|
|
If the value is a simple scalar (string or number), then it can be |
585
|
|
|
|
|
|
|
just passed as is. However, if you wish to initialize it with a HASH |
586
|
|
|
|
|
|
|
or ARRAY ref, then you need to wrap that inside a subroutine |
587
|
|
|
|
|
|
|
reference: |
588
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
Class::MOP::Attribute->new( |
590
|
|
|
|
|
|
|
'foo' => ( |
591
|
|
|
|
|
|
|
default => sub { [] }, |
592
|
|
|
|
|
|
|
) |
593
|
|
|
|
|
|
|
); |
594
|
|
|
|
|
|
|
|
595
|
|
|
|
|
|
|
# or ... |
596
|
|
|
|
|
|
|
|
597
|
|
|
|
|
|
|
Class::MOP::Attribute->new( |
598
|
|
|
|
|
|
|
'foo' => ( |
599
|
|
|
|
|
|
|
default => sub { {} }, |
600
|
|
|
|
|
|
|
) |
601
|
|
|
|
|
|
|
); |
602
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
If you wish to initialize an attribute with a subroutine reference |
604
|
|
|
|
|
|
|
itself, then you need to wrap that in a subroutine as well: |
605
|
|
|
|
|
|
|
|
606
|
|
|
|
|
|
|
Class::MOP::Attribute->new( |
607
|
|
|
|
|
|
|
'foo' => ( |
608
|
|
|
|
|
|
|
default => sub { |
609
|
|
|
|
|
|
|
sub { print "Hello World" } |
610
|
|
|
|
|
|
|
}, |
611
|
|
|
|
|
|
|
) |
612
|
|
|
|
|
|
|
); |
613
|
|
|
|
|
|
|
|
614
|
|
|
|
|
|
|
And lastly, if the value of your attribute is dependent upon some |
615
|
|
|
|
|
|
|
other aspect of the instance structure, then you can take advantage of |
616
|
|
|
|
|
|
|
the fact that when the C<default> value is called as a method: |
617
|
|
|
|
|
|
|
|
618
|
|
|
|
|
|
|
Class::MOP::Attribute->new( |
619
|
|
|
|
|
|
|
'object_identity' => ( |
620
|
|
|
|
|
|
|
default => sub { Scalar::Util::refaddr( $_[0] ) }, |
621
|
|
|
|
|
|
|
) |
622
|
|
|
|
|
|
|
); |
623
|
|
|
|
|
|
|
|
624
|
|
|
|
|
|
|
Note that there is no guarantee that attributes are initialized in any |
625
|
|
|
|
|
|
|
particular order, so you cannot rely on the value of some other |
626
|
|
|
|
|
|
|
attribute when generating the default. |
627
|
|
|
|
|
|
|
|
628
|
|
|
|
|
|
|
=item * initializer |
629
|
|
|
|
|
|
|
|
630
|
|
|
|
|
|
|
This option can be either a method name or a subroutine |
631
|
|
|
|
|
|
|
reference. This method will be called when setting the attribute's |
632
|
|
|
|
|
|
|
value in the constructor. Unlike C<default> and C<builder>, the |
633
|
|
|
|
|
|
|
initializer is only called when a value is provided to the |
634
|
|
|
|
|
|
|
constructor. The initializer allows you to munge this value during |
635
|
|
|
|
|
|
|
object construction. |
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
The initializer is called as a method with three arguments. The first |
638
|
|
|
|
|
|
|
is the value that was passed to the constructor. The second is a |
639
|
|
|
|
|
|
|
subroutine reference that can be called to actually set the |
640
|
|
|
|
|
|
|
attribute's value, and the last is the associated |
641
|
|
|
|
|
|
|
C<Class::MOP::Attribute> object. |
642
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
This contrived example shows an initializer that sets the attribute to |
644
|
|
|
|
|
|
|
twice the given value. |
645
|
|
|
|
|
|
|
|
646
|
|
|
|
|
|
|
Class::MOP::Attribute->new( |
647
|
|
|
|
|
|
|
'doubled' => ( |
648
|
|
|
|
|
|
|
initializer => sub { |
649
|
|
|
|
|
|
|
my ( $self, $value, $set, $attr ) = @_; |
650
|
|
|
|
|
|
|
$set->( $value * 2 ); |
651
|
|
|
|
|
|
|
}, |
652
|
|
|
|
|
|
|
) |
653
|
|
|
|
|
|
|
); |
654
|
|
|
|
|
|
|
|
655
|
|
|
|
|
|
|
Since an initializer can be a method name, you can easily make |
656
|
|
|
|
|
|
|
attribute initialization use the writer: |
657
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
Class::MOP::Attribute->new( |
659
|
|
|
|
|
|
|
'some_attr' => ( |
660
|
|
|
|
|
|
|
writer => 'some_attr', |
661
|
|
|
|
|
|
|
initializer => 'some_attr', |
662
|
|
|
|
|
|
|
) |
663
|
|
|
|
|
|
|
); |
664
|
|
|
|
|
|
|
|
665
|
|
|
|
|
|
|
Your writer (actually, a wrapper around the writer, using |
666
|
|
|
|
|
|
|
L<method modifications|Moose::Manual::MethodModifiers>) will need to examine |
667
|
|
|
|
|
|
|
C<@_> and determine under which |
668
|
|
|
|
|
|
|
context it is being called: |
669
|
|
|
|
|
|
|
|
670
|
|
|
|
|
|
|
around 'some_attr' => sub { |
671
|
|
|
|
|
|
|
my $orig = shift; |
672
|
|
|
|
|
|
|
my $self = shift; |
673
|
|
|
|
|
|
|
# $value is not defined if being called as a reader |
674
|
|
|
|
|
|
|
# $setter and $attr are only defined if being called as an initializer |
675
|
|
|
|
|
|
|
my ($value, $setter, $attr) = @_; |
676
|
|
|
|
|
|
|
|
677
|
|
|
|
|
|
|
# the reader behaves normally |
678
|
|
|
|
|
|
|
return $self->$orig if not @_; |
679
|
|
|
|
|
|
|
|
680
|
|
|
|
|
|
|
# mutate $value as desired |
681
|
|
|
|
|
|
|
# $value = <something($value); |
682
|
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
# if called as an initializer, set the value and we're done |
684
|
|
|
|
|
|
|
return $setter->($row) if $setter; |
685
|
|
|
|
|
|
|
|
686
|
|
|
|
|
|
|
# otherwise, call the real writer with the new value |
687
|
|
|
|
|
|
|
$self->$orig($row); |
688
|
|
|
|
|
|
|
}; |
689
|
|
|
|
|
|
|
|
690
|
|
|
|
|
|
|
=back |
691
|
|
|
|
|
|
|
|
692
|
|
|
|
|
|
|
The C<accessor>, C<reader>, C<writer>, C<predicate> and C<clearer> |
693
|
|
|
|
|
|
|
options all accept the same parameters. You can provide the name of |
694
|
|
|
|
|
|
|
the method, in which case an appropriate default method will be |
695
|
|
|
|
|
|
|
generated for you. Or instead you can also provide hash reference |
696
|
|
|
|
|
|
|
containing exactly one key (the method name) and one value. The value |
697
|
|
|
|
|
|
|
should be a subroutine reference, which will be installed as the |
698
|
|
|
|
|
|
|
method itself. |
699
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
=over 8 |
701
|
|
|
|
|
|
|
|
702
|
|
|
|
|
|
|
=item * accessor |
703
|
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
An C<accessor> is a standard Perl-style read/write accessor. It will |
705
|
|
|
|
|
|
|
return the value of the attribute, and if a value is passed as an |
706
|
|
|
|
|
|
|
argument, it will assign that value to the attribute. |
707
|
|
|
|
|
|
|
|
708
|
|
|
|
|
|
|
Note that C<undef> is a legitimate value, so this will work: |
709
|
|
|
|
|
|
|
|
710
|
|
|
|
|
|
|
$object->set_something(undef); |
711
|
|
|
|
|
|
|
|
712
|
|
|
|
|
|
|
=item * reader |
713
|
|
|
|
|
|
|
|
714
|
|
|
|
|
|
|
This is a basic read-only accessor. It returns the value of the |
715
|
|
|
|
|
|
|
attribute. |
716
|
|
|
|
|
|
|
|
717
|
|
|
|
|
|
|
=item * writer |
718
|
|
|
|
|
|
|
|
719
|
|
|
|
|
|
|
This is a basic write accessor, it accepts a single argument, and |
720
|
|
|
|
|
|
|
assigns that value to the attribute. |
721
|
|
|
|
|
|
|
|
722
|
|
|
|
|
|
|
Note that C<undef> is a legitimate value, so this will work: |
723
|
|
|
|
|
|
|
|
724
|
|
|
|
|
|
|
$object->set_something(undef); |
725
|
|
|
|
|
|
|
|
726
|
|
|
|
|
|
|
=item * predicate |
727
|
|
|
|
|
|
|
|
728
|
|
|
|
|
|
|
The predicate method returns a boolean indicating whether or not the |
729
|
|
|
|
|
|
|
attribute has been explicitly set. |
730
|
|
|
|
|
|
|
|
731
|
|
|
|
|
|
|
Note that the predicate returns true even if the attribute was set to |
732
|
|
|
|
|
|
|
a false value (C<0> or C<undef>). |
733
|
|
|
|
|
|
|
|
734
|
|
|
|
|
|
|
=item * clearer |
735
|
|
|
|
|
|
|
|
736
|
|
|
|
|
|
|
This method will uninitialize the attribute. After an attribute is |
737
|
|
|
|
|
|
|
cleared, its C<predicate> will return false. |
738
|
|
|
|
|
|
|
|
739
|
|
|
|
|
|
|
=item * definition_context |
740
|
|
|
|
|
|
|
|
741
|
|
|
|
|
|
|
Mostly, this exists as a hook for the benefit of Moose. |
742
|
|
|
|
|
|
|
|
743
|
|
|
|
|
|
|
This option should be a hash reference containing several keys which |
744
|
|
|
|
|
|
|
will be used when inlining the attribute's accessors. The keys should |
745
|
|
|
|
|
|
|
include C<line>, the line number where the attribute was created, and |
746
|
|
|
|
|
|
|
either C<file> or C<description>. |
747
|
|
|
|
|
|
|
|
748
|
|
|
|
|
|
|
This information will ultimately be used when eval'ing inlined |
749
|
|
|
|
|
|
|
accessor code so that error messages report a useful line and file |
750
|
|
|
|
|
|
|
name. |
751
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
=back |
753
|
|
|
|
|
|
|
|
754
|
|
|
|
|
|
|
=item B<< $attr->clone(%options) >> |
755
|
|
|
|
|
|
|
|
756
|
|
|
|
|
|
|
This clones the attribute. Any options you provide will override the |
757
|
|
|
|
|
|
|
settings of the original attribute. You can change the name of the new |
758
|
|
|
|
|
|
|
attribute by passing a C<name> key in C<%options>. |
759
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
=back |
761
|
|
|
|
|
|
|
|
762
|
|
|
|
|
|
|
=head2 Informational |
763
|
|
|
|
|
|
|
|
764
|
|
|
|
|
|
|
These are all basic read-only accessors for the values passed into |
765
|
|
|
|
|
|
|
the constructor. |
766
|
|
|
|
|
|
|
|
767
|
|
|
|
|
|
|
=over 4 |
768
|
|
|
|
|
|
|
|
769
|
|
|
|
|
|
|
=item B<< $attr->name >> |
770
|
|
|
|
|
|
|
|
771
|
|
|
|
|
|
|
Returns the attribute's name. |
772
|
|
|
|
|
|
|
|
773
|
|
|
|
|
|
|
=item B<< $attr->accessor >> |
774
|
|
|
|
|
|
|
|
775
|
|
|
|
|
|
|
=item B<< $attr->reader >> |
776
|
|
|
|
|
|
|
|
777
|
|
|
|
|
|
|
=item B<< $attr->writer >> |
778
|
|
|
|
|
|
|
|
779
|
|
|
|
|
|
|
=item B<< $attr->predicate >> |
780
|
|
|
|
|
|
|
|
781
|
|
|
|
|
|
|
=item B<< $attr->clearer >> |
782
|
|
|
|
|
|
|
|
783
|
|
|
|
|
|
|
The C<accessor>, C<reader>, C<writer>, C<predicate>, and C<clearer> |
784
|
|
|
|
|
|
|
methods all return exactly what was passed to the constructor, so it |
785
|
|
|
|
|
|
|
can be either a string containing a method name, or a hash reference. |
786
|
|
|
|
|
|
|
|
787
|
|
|
|
|
|
|
=item B<< $attr->initializer >> |
788
|
|
|
|
|
|
|
|
789
|
|
|
|
|
|
|
Returns the initializer as passed to the constructor, so this may be |
790
|
|
|
|
|
|
|
either a method name or a subroutine reference. |
791
|
|
|
|
|
|
|
|
792
|
|
|
|
|
|
|
=item B<< $attr->init_arg >> |
793
|
|
|
|
|
|
|
|
794
|
|
|
|
|
|
|
=item B<< $attr->is_default_a_coderef >> |
795
|
|
|
|
|
|
|
|
796
|
|
|
|
|
|
|
=item B<< $attr->builder >> |
797
|
|
|
|
|
|
|
|
798
|
|
|
|
|
|
|
=item B<< $attr->default($instance) >> |
799
|
|
|
|
|
|
|
|
800
|
|
|
|
|
|
|
The C<$instance> argument is optional. If you don't pass it, the |
801
|
|
|
|
|
|
|
return value for this method is exactly what was passed to the |
802
|
|
|
|
|
|
|
constructor, either a simple scalar or a subroutine reference. |
803
|
|
|
|
|
|
|
|
804
|
|
|
|
|
|
|
If you I<do> pass an C<$instance> and the default is a subroutine |
805
|
|
|
|
|
|
|
reference, then the reference is called as a method on the |
806
|
|
|
|
|
|
|
C<$instance> and the generated value is returned. |
807
|
|
|
|
|
|
|
|
808
|
|
|
|
|
|
|
=item B<< $attr->slots >> |
809
|
|
|
|
|
|
|
|
810
|
|
|
|
|
|
|
Return a list of slots required by the attribute. This is usually just |
811
|
|
|
|
|
|
|
one, the name of the attribute. |
812
|
|
|
|
|
|
|
|
813
|
|
|
|
|
|
|
A slot is the name of the hash key used to store the attribute in an |
814
|
|
|
|
|
|
|
object instance. |
815
|
|
|
|
|
|
|
|
816
|
|
|
|
|
|
|
=item B<< $attr->get_read_method >> |
817
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
=item B<< $attr->get_write_method >> |
819
|
|
|
|
|
|
|
|
820
|
|
|
|
|
|
|
Returns the name of a method suitable for reading or writing the value |
821
|
|
|
|
|
|
|
of the attribute in the associated class. |
822
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
If an attribute is read- or write-only, then these methods can return |
824
|
|
|
|
|
|
|
C<undef> as appropriate. |
825
|
|
|
|
|
|
|
|
826
|
|
|
|
|
|
|
=item B<< $attr->has_read_method >> |
827
|
|
|
|
|
|
|
|
828
|
|
|
|
|
|
|
=item B<< $attr->has_write_method >> |
829
|
|
|
|
|
|
|
|
830
|
|
|
|
|
|
|
This returns a boolean indicating whether the attribute has a I<named> |
831
|
|
|
|
|
|
|
read or write method. |
832
|
|
|
|
|
|
|
|
833
|
|
|
|
|
|
|
=item B<< $attr->get_read_method_ref >> |
834
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
=item B<< $attr->get_write_method_ref >> |
836
|
|
|
|
|
|
|
|
837
|
|
|
|
|
|
|
Returns the subroutine reference of a method suitable for reading or |
838
|
|
|
|
|
|
|
writing the attribute's value in the associated class. These methods |
839
|
|
|
|
|
|
|
always return a subroutine reference, regardless of whether or not the |
840
|
|
|
|
|
|
|
attribute is read- or write-only. |
841
|
|
|
|
|
|
|
|
842
|
|
|
|
|
|
|
=item B<< $attr->insertion_order >> |
843
|
|
|
|
|
|
|
|
844
|
|
|
|
|
|
|
If this attribute has been inserted into a class, this returns a zero |
845
|
|
|
|
|
|
|
based index regarding the order of insertion. |
846
|
|
|
|
|
|
|
|
847
|
|
|
|
|
|
|
=back |
848
|
|
|
|
|
|
|
|
849
|
|
|
|
|
|
|
=head2 Informational predicates |
850
|
|
|
|
|
|
|
|
851
|
|
|
|
|
|
|
These are all basic predicate methods for the values passed into C<new>. |
852
|
|
|
|
|
|
|
|
853
|
|
|
|
|
|
|
=over 4 |
854
|
|
|
|
|
|
|
|
855
|
|
|
|
|
|
|
=item B<< $attr->has_accessor >> |
856
|
|
|
|
|
|
|
|
857
|
|
|
|
|
|
|
=item B<< $attr->has_reader >> |
858
|
|
|
|
|
|
|
|
859
|
|
|
|
|
|
|
=item B<< $attr->has_writer >> |
860
|
|
|
|
|
|
|
|
861
|
|
|
|
|
|
|
=item B<< $attr->has_predicate >> |
862
|
|
|
|
|
|
|
|
863
|
|
|
|
|
|
|
=item B<< $attr->has_clearer >> |
864
|
|
|
|
|
|
|
|
865
|
|
|
|
|
|
|
=item B<< $attr->has_initializer >> |
866
|
|
|
|
|
|
|
|
867
|
|
|
|
|
|
|
=item B<< $attr->has_init_arg >> |
868
|
|
|
|
|
|
|
|
869
|
|
|
|
|
|
|
This will be I<false> if the C<init_arg> was set to C<undef>. |
870
|
|
|
|
|
|
|
|
871
|
|
|
|
|
|
|
=item B<< $attr->has_default >> |
872
|
|
|
|
|
|
|
|
873
|
|
|
|
|
|
|
This will be I<false> if the C<default> was set to C<undef>, since |
874
|
|
|
|
|
|
|
C<undef> is the default C<default> anyway. |
875
|
|
|
|
|
|
|
|
876
|
|
|
|
|
|
|
=item B<< $attr->has_builder >> |
877
|
|
|
|
|
|
|
|
878
|
|
|
|
|
|
|
=item B<< $attr->has_insertion_order >> |
879
|
|
|
|
|
|
|
|
880
|
|
|
|
|
|
|
This will be I<false> if this attribute has not be inserted into a class |
881
|
|
|
|
|
|
|
|
882
|
|
|
|
|
|
|
=back |
883
|
|
|
|
|
|
|
|
884
|
|
|
|
|
|
|
=head2 Value management |
885
|
|
|
|
|
|
|
|
886
|
|
|
|
|
|
|
These methods are basically "back doors" to the instance, and can be |
887
|
|
|
|
|
|
|
used to bypass the regular accessors, but still stay within the MOP. |
888
|
|
|
|
|
|
|
|
889
|
|
|
|
|
|
|
These methods are not for general use, and should only be used if you |
890
|
|
|
|
|
|
|
really know what you are doing. |
891
|
|
|
|
|
|
|
|
892
|
|
|
|
|
|
|
=over 4 |
893
|
|
|
|
|
|
|
|
894
|
|
|
|
|
|
|
=item B<< $attr->initialize_instance_slot($meta_instance, $instance, $params) >> |
895
|
|
|
|
|
|
|
|
896
|
|
|
|
|
|
|
This method is used internally to initialize the attribute's slot in |
897
|
|
|
|
|
|
|
the object C<$instance>. |
898
|
|
|
|
|
|
|
|
899
|
|
|
|
|
|
|
The C<$params> is a hash reference of the values passed to the object |
900
|
|
|
|
|
|
|
constructor. |
901
|
|
|
|
|
|
|
|
902
|
|
|
|
|
|
|
It's unlikely that you'll need to call this method yourself. |
903
|
|
|
|
|
|
|
|
904
|
|
|
|
|
|
|
=item B<< $attr->set_value($instance, $value) >> |
905
|
|
|
|
|
|
|
|
906
|
|
|
|
|
|
|
Sets the value without going through the accessor. Note that this |
907
|
|
|
|
|
|
|
works even with read-only attributes. |
908
|
|
|
|
|
|
|
|
909
|
|
|
|
|
|
|
=item B<< $attr->set_raw_value($instance, $value) >> |
910
|
|
|
|
|
|
|
|
911
|
|
|
|
|
|
|
Sets the value with no side effects such as a trigger. |
912
|
|
|
|
|
|
|
|
913
|
|
|
|
|
|
|
This doesn't actually apply to Class::MOP attributes, only to subclasses. |
914
|
|
|
|
|
|
|
|
915
|
|
|
|
|
|
|
=item B<< $attr->set_initial_value($instance, $value) >> |
916
|
|
|
|
|
|
|
|
917
|
|
|
|
|
|
|
Sets the value without going through the accessor. This method is only |
918
|
|
|
|
|
|
|
called when the instance is first being initialized. |
919
|
|
|
|
|
|
|
|
920
|
|
|
|
|
|
|
=item B<< $attr->get_value($instance) >> |
921
|
|
|
|
|
|
|
|
922
|
|
|
|
|
|
|
Returns the value without going through the accessor. Note that this |
923
|
|
|
|
|
|
|
works even with write-only accessors. |
924
|
|
|
|
|
|
|
|
925
|
|
|
|
|
|
|
=item B<< $attr->get_raw_value($instance) >> |
926
|
|
|
|
|
|
|
|
927
|
|
|
|
|
|
|
Returns the value without any side effects such as lazy attributes. |
928
|
|
|
|
|
|
|
|
929
|
|
|
|
|
|
|
Doesn't actually apply to Class::MOP attributes, only to subclasses. |
930
|
|
|
|
|
|
|
|
931
|
|
|
|
|
|
|
=item B<< $attr->has_value($instance) >> |
932
|
|
|
|
|
|
|
|
933
|
|
|
|
|
|
|
Return a boolean indicating whether the attribute has been set in |
934
|
|
|
|
|
|
|
C<$instance>. This how the default C<predicate> method works. |
935
|
|
|
|
|
|
|
|
936
|
|
|
|
|
|
|
=item B<< $attr->clear_value($instance) >> |
937
|
|
|
|
|
|
|
|
938
|
|
|
|
|
|
|
This will clear the attribute's value in C<$instance>. This is what |
939
|
|
|
|
|
|
|
the default C<clearer> calls. |
940
|
|
|
|
|
|
|
|
941
|
|
|
|
|
|
|
Note that this works even if the attribute does not have any |
942
|
|
|
|
|
|
|
associated read, write or clear methods. |
943
|
|
|
|
|
|
|
|
944
|
|
|
|
|
|
|
=back |
945
|
|
|
|
|
|
|
|
946
|
|
|
|
|
|
|
=head2 Class association |
947
|
|
|
|
|
|
|
|
948
|
|
|
|
|
|
|
These methods allow you to manage the attributes association with |
949
|
|
|
|
|
|
|
the class that contains it. These methods should not be used |
950
|
|
|
|
|
|
|
lightly, nor are they very magical, they are mostly used internally |
951
|
|
|
|
|
|
|
and by metaclass instances. |
952
|
|
|
|
|
|
|
|
953
|
|
|
|
|
|
|
=over 4 |
954
|
|
|
|
|
|
|
|
955
|
|
|
|
|
|
|
=item B<< $attr->associated_class >> |
956
|
|
|
|
|
|
|
|
957
|
|
|
|
|
|
|
This returns the L<Class::MOP::Class> with which this attribute is |
958
|
|
|
|
|
|
|
associated, if any. |
959
|
|
|
|
|
|
|
|
960
|
|
|
|
|
|
|
=item B<< $attr->attach_to_class($metaclass) >> |
961
|
|
|
|
|
|
|
|
962
|
|
|
|
|
|
|
This method stores a weakened reference to the C<$metaclass> object |
963
|
|
|
|
|
|
|
internally. |
964
|
|
|
|
|
|
|
|
965
|
|
|
|
|
|
|
This method does not remove the attribute from its old class, |
966
|
|
|
|
|
|
|
nor does it create any accessors in the new class. |
967
|
|
|
|
|
|
|
|
968
|
|
|
|
|
|
|
It is probably best to use the L<Class::MOP::Class> C<add_attribute> |
969
|
|
|
|
|
|
|
method instead. |
970
|
|
|
|
|
|
|
|
971
|
|
|
|
|
|
|
=item B<< $attr->detach_from_class >> |
972
|
|
|
|
|
|
|
|
973
|
|
|
|
|
|
|
This method removes the associate metaclass object from the attribute |
974
|
|
|
|
|
|
|
it has one. |
975
|
|
|
|
|
|
|
|
976
|
|
|
|
|
|
|
This method does not remove the attribute itself from the class, or |
977
|
|
|
|
|
|
|
remove its accessors. |
978
|
|
|
|
|
|
|
|
979
|
|
|
|
|
|
|
It is probably best to use the L<Class::MOP::Class> |
980
|
|
|
|
|
|
|
C<remove_attribute> method instead. |
981
|
|
|
|
|
|
|
|
982
|
|
|
|
|
|
|
=back |
983
|
|
|
|
|
|
|
|
984
|
|
|
|
|
|
|
=head2 Attribute Accessor generation |
985
|
|
|
|
|
|
|
|
986
|
|
|
|
|
|
|
=over 4 |
987
|
|
|
|
|
|
|
|
988
|
|
|
|
|
|
|
=item B<< $attr->accessor_metaclass >> |
989
|
|
|
|
|
|
|
|
990
|
|
|
|
|
|
|
Accessor methods are generated using an accessor metaclass. By |
991
|
|
|
|
|
|
|
default, this is L<Class::MOP::Method::Accessor>. This method returns |
992
|
|
|
|
|
|
|
the name of the accessor metaclass that this attribute uses. |
993
|
|
|
|
|
|
|
|
994
|
|
|
|
|
|
|
=item B<< $attr->associate_method($method) >> |
995
|
|
|
|
|
|
|
|
996
|
|
|
|
|
|
|
This associates a L<Class::MOP::Method> object with the |
997
|
|
|
|
|
|
|
attribute. Typically, this is called internally when an attribute |
998
|
|
|
|
|
|
|
generates its accessors. |
999
|
|
|
|
|
|
|
|
1000
|
|
|
|
|
|
|
=item B<< $attr->associated_methods >> |
1001
|
|
|
|
|
|
|
|
1002
|
|
|
|
|
|
|
This returns the list of methods which have been associated with the |
1003
|
|
|
|
|
|
|
attribute. |
1004
|
|
|
|
|
|
|
|
1005
|
|
|
|
|
|
|
=item B<< $attr->install_accessors >> |
1006
|
|
|
|
|
|
|
|
1007
|
|
|
|
|
|
|
This method generates and installs code for the attribute's accessors. |
1008
|
|
|
|
|
|
|
It is typically called from the L<Class::MOP::Class> C<add_attribute> |
1009
|
|
|
|
|
|
|
method. |
1010
|
|
|
|
|
|
|
|
1011
|
|
|
|
|
|
|
=item B<< $attr->remove_accessors >> |
1012
|
|
|
|
|
|
|
|
1013
|
|
|
|
|
|
|
This method removes all of the accessors associated with the |
1014
|
|
|
|
|
|
|
attribute. |
1015
|
|
|
|
|
|
|
|
1016
|
|
|
|
|
|
|
This does not currently remove methods from the list returned by |
1017
|
|
|
|
|
|
|
C<associated_methods>. |
1018
|
|
|
|
|
|
|
|
1019
|
|
|
|
|
|
|
=item B<< $attr->inline_get >> |
1020
|
|
|
|
|
|
|
|
1021
|
|
|
|
|
|
|
=item B<< $attr->inline_set >> |
1022
|
|
|
|
|
|
|
|
1023
|
|
|
|
|
|
|
=item B<< $attr->inline_has >> |
1024
|
|
|
|
|
|
|
|
1025
|
|
|
|
|
|
|
=item B<< $attr->inline_clear >> |
1026
|
|
|
|
|
|
|
|
1027
|
|
|
|
|
|
|
These methods return a code snippet suitable for inlining the relevant |
1028
|
|
|
|
|
|
|
operation. They expect strings containing variable names to be used in the |
1029
|
|
|
|
|
|
|
inlining, like C<'$self'> or C<'$_[1]'>. |
1030
|
|
|
|
|
|
|
|
1031
|
|
|
|
|
|
|
=back |
1032
|
|
|
|
|
|
|
|
1033
|
|
|
|
|
|
|
=head2 Introspection |
1034
|
|
|
|
|
|
|
|
1035
|
|
|
|
|
|
|
=over 4 |
1036
|
|
|
|
|
|
|
|
1037
|
|
|
|
|
|
|
=item B<< Class::MOP::Attribute->meta >> |
1038
|
|
|
|
|
|
|
|
1039
|
|
|
|
|
|
|
This will return a L<Class::MOP::Class> instance for this class. |
1040
|
|
|
|
|
|
|
|
1041
|
|
|
|
|
|
|
It should also be noted that L<Class::MOP> will actually bootstrap |
1042
|
|
|
|
|
|
|
this module by installing a number of attribute meta-objects into its |
1043
|
|
|
|
|
|
|
metaclass. |
1044
|
|
|
|
|
|
|
|
1045
|
|
|
|
|
|
|
=back |
1046
|
|
|
|
|
|
|
|
1047
|
|
|
|
|
|
|
=head1 AUTHORS |
1048
|
|
|
|
|
|
|
|
1049
|
|
|
|
|
|
|
=over 4 |
1050
|
|
|
|
|
|
|
|
1051
|
|
|
|
|
|
|
=item * |
1052
|
|
|
|
|
|
|
|
1053
|
|
|
|
|
|
|
Stevan Little <stevan@cpan.org> |
1054
|
|
|
|
|
|
|
|
1055
|
|
|
|
|
|
|
=item * |
1056
|
|
|
|
|
|
|
|
1057
|
|
|
|
|
|
|
Dave Rolsky <autarch@urth.org> |
1058
|
|
|
|
|
|
|
|
1059
|
|
|
|
|
|
|
=item * |
1060
|
|
|
|
|
|
|
|
1061
|
|
|
|
|
|
|
Jesse Luehrs <doy@cpan.org> |
1062
|
|
|
|
|
|
|
|
1063
|
|
|
|
|
|
|
=item * |
1064
|
|
|
|
|
|
|
|
1065
|
|
|
|
|
|
|
Shawn M Moore <sartak@cpan.org> |
1066
|
|
|
|
|
|
|
|
1067
|
|
|
|
|
|
|
=item * |
1068
|
|
|
|
|
|
|
|
1069
|
|
|
|
|
|
|
יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org> |
1070
|
|
|
|
|
|
|
|
1071
|
|
|
|
|
|
|
=item * |
1072
|
|
|
|
|
|
|
|
1073
|
|
|
|
|
|
|
Karen Etheridge <ether@cpan.org> |
1074
|
|
|
|
|
|
|
|
1075
|
|
|
|
|
|
|
=item * |
1076
|
|
|
|
|
|
|
|
1077
|
|
|
|
|
|
|
Florian Ragwitz <rafl@debian.org> |
1078
|
|
|
|
|
|
|
|
1079
|
|
|
|
|
|
|
=item * |
1080
|
|
|
|
|
|
|
|
1081
|
|
|
|
|
|
|
Hans Dieter Pearcey <hdp@cpan.org> |
1082
|
|
|
|
|
|
|
|
1083
|
|
|
|
|
|
|
=item * |
1084
|
|
|
|
|
|
|
|
1085
|
|
|
|
|
|
|
Chris Prather <chris@prather.org> |
1086
|
|
|
|
|
|
|
|
1087
|
|
|
|
|
|
|
=item * |
1088
|
|
|
|
|
|
|
|
1089
|
|
|
|
|
|
|
Matt S Trout <mstrout@cpan.org> |
1090
|
|
|
|
|
|
|
|
1091
|
|
|
|
|
|
|
=back |
1092
|
|
|
|
|
|
|
|
1093
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
1094
|
|
|
|
|
|
|
|
1095
|
|
|
|
|
|
|
This software is copyright (c) 2006 by Infinity Interactive, Inc. |
1096
|
|
|
|
|
|
|
|
1097
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
1098
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
1099
|
|
|
|
|
|
|
|
1100
|
|
|
|
|
|
|
=cut |