File | /project/perl/lib/Class/Accessor.pm |
Statements Executed | 1958 |
Statement Execution Time | 28.0ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
463 | 3 | 2 | 18.3ms | 232ms | __ANON__[:395] | Class::Accessor::
6 | 1 | 1 | 4.59ms | 6.29ms | _mk_accessors | Class::Accessor::
15 | 2 | 2 | 1.48ms | 1.48ms | new | Class::Accessor::
30 | 1 | 1 | 527µs | 527µs | accessor_name_for | Class::Accessor::
30 | 1 | 1 | 499µs | 499µs | mutator_name_for | Class::Accessor::
17 | 2 | 2 | 410µs | 410µs | make_accessor | Class::Accessor::
6 | 6 | 6 | 315µs | 6.60ms | mk_accessors | Class::Accessor::
0 | 0 | 0 | 0s | 0s | BEGIN | Class::Accessor::
0 | 0 | 0 | 0s | 0s | __ANON__[:422] | Class::Accessor::
0 | 0 | 0 | 0s | 0s | __ANON__[:449] | Class::Accessor::
0 | 0 | 0 | 0s | 0s | _carp | Class::Accessor::
0 | 0 | 0 | 0s | 0s | _croak | Class::Accessor::
0 | 0 | 0 | 0s | 0s | best_practice_accessor_name_for | Class::Accessor::
0 | 0 | 0 | 0s | 0s | best_practice_mutator_name_for | Class::Accessor::
0 | 0 | 0 | 0s | 0s | follow_best_practice | Class::Accessor::
0 | 0 | 0 | 0s | 0s | get | Class::Accessor::
0 | 0 | 0 | 0s | 0s | make_ro_accessor | Class::Accessor::
0 | 0 | 0 | 0s | 0s | make_wo_accessor | Class::Accessor::
0 | 0 | 0 | 0s | 0s | mk_ro_accessors | Class::Accessor::
0 | 0 | 0 | 0s | 0s | mk_wo_accessors | Class::Accessor::
0 | 0 | 0 | 0s | 0s | set | Class::Accessor::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Class::Accessor; | ||||
2 | 1 | 5µs | require 5.00502; | ||
3 | 3 | 333µs | 1 | 24µs | use strict; # spent 24µs making 1 call to strict::import |
4 | 1 | 5µs | $Class::Accessor::VERSION = '0.30'; | ||
5 | |||||
6 | =head1 NAME | ||||
7 | |||||
8 | Class::Accessor - Automated accessor generation | ||||
9 | |||||
10 | =head1 SYNOPSIS | ||||
11 | |||||
12 | package Employee; | ||||
13 | use base qw(Class::Accessor); | ||||
14 | Employee->mk_accessors(qw(name role salary)); | ||||
15 | |||||
16 | # Meanwhile, in a nearby piece of code! | ||||
17 | # Class::Accessor provides new(). | ||||
18 | my $mp = Foo->new({ name => "Marty", role => "JAPH" }); | ||||
19 | |||||
20 | my $job = $mp->role; # gets $mp->{role} | ||||
21 | $mp->salary(400000); # sets $mp->{salary} = 400000 (I wish) | ||||
22 | |||||
23 | # like my @info = @{$mp}{qw(name role)} | ||||
24 | my @info = $mp->get(qw(name role)); | ||||
25 | |||||
26 | # $mp->{salary} = 400000 | ||||
27 | $mp->set('salary', 400000); | ||||
28 | |||||
29 | |||||
30 | =head1 DESCRIPTION | ||||
31 | |||||
32 | This module automagically generates accessors/mutators for your class. | ||||
33 | |||||
34 | Most of the time, writing accessors is an exercise in cutting and | ||||
35 | pasting. You usually wind up with a series of methods like this: | ||||
36 | |||||
37 | sub name { | ||||
38 | my $self = shift; | ||||
39 | if(@_) { | ||||
40 | $self->{name} = $_[0]; | ||||
41 | } | ||||
42 | return $self->{name}; | ||||
43 | } | ||||
44 | |||||
45 | sub salary { | ||||
46 | my $self = shift; | ||||
47 | if(@_) { | ||||
48 | $self->{salary} = $_[0]; | ||||
49 | } | ||||
50 | return $self->{salary}; | ||||
51 | } | ||||
52 | |||||
53 | # etc... | ||||
54 | |||||
55 | One for each piece of data in your object. While some will be unique, | ||||
56 | doing value checks and special storage tricks, most will simply be | ||||
57 | exercises in repetition. Not only is it Bad Style to have a bunch of | ||||
58 | repetitious code, but its also simply not lazy, which is the real | ||||
59 | tragedy. | ||||
60 | |||||
61 | If you make your module a subclass of Class::Accessor and declare your | ||||
62 | accessor fields with mk_accessors() then you'll find yourself with a | ||||
63 | set of automatically generated accessors which can even be | ||||
64 | customized! | ||||
65 | |||||
66 | The basic set up is very simple: | ||||
67 | |||||
68 | package My::Class; | ||||
69 | use base qw(Class::Accessor); | ||||
70 | My::Class->mk_accessors( qw(foo bar car) ); | ||||
71 | |||||
72 | Done. My::Class now has simple foo(), bar() and car() accessors | ||||
73 | defined. | ||||
74 | |||||
75 | =head2 What Makes This Different? | ||||
76 | |||||
77 | What makes this module special compared to all the other method | ||||
78 | generating modules (L<"SEE ALSO">)? By overriding the get() and set() | ||||
79 | methods you can alter the behavior of the accessors class-wide. Also, | ||||
80 | the accessors are implemented as closures which should cost a bit less | ||||
81 | memory than most other solutions which generate a new method for each | ||||
82 | accessor. | ||||
83 | |||||
84 | |||||
85 | =head1 METHODS | ||||
86 | |||||
87 | =head2 new | ||||
88 | |||||
89 | my $obj = Class->new; | ||||
90 | my $obj = $other_obj->new; | ||||
91 | |||||
92 | my $obj = Class->new(\%fields); | ||||
93 | my $obj = $other_obj->new(\%fields); | ||||
94 | |||||
95 | Class::Accessor provides a basic constructor. It generates a | ||||
96 | hash-based object and can be called as either a class method or an | ||||
97 | object method. | ||||
98 | |||||
99 | It takes an optional %fields hash which is used to initialize the | ||||
100 | object (handy if you use read-only accessors). The fields of the hash | ||||
101 | correspond to the names of your accessors, so... | ||||
102 | |||||
103 | package Foo; | ||||
104 | use base qw(Class::Accessor); | ||||
105 | Foo->mk_accessors('foo'); | ||||
106 | |||||
107 | my $obj = Class->new({ foo => 42 }); | ||||
108 | print $obj->foo; # 42 | ||||
109 | |||||
110 | however %fields can contain anything, new() will shove them all into | ||||
111 | your object. Don't like it? Override it. | ||||
112 | |||||
113 | =cut | ||||
114 | |||||
115 | # spent 1.48ms within Class::Accessor::new which was called 15 times, avg 99µs/call:
# 10 times (1.16ms+0s) by Class::DBI::Column::new at line 52 of Class/DBI/Column.pm, avg 116µs/call
# 5 times (320µs+0s) by Class::DBI::Relationship::_init at line 24 of Class/DBI/Relationship.pm, avg 64µs/call | ||||
116 | 60 | 1.52ms | my($proto, $fields) = @_; | ||
117 | my($class) = ref $proto || $proto; | ||||
118 | |||||
119 | $fields = {} unless defined $fields; | ||||
120 | |||||
121 | # make a copy of $fields. | ||||
122 | bless {%$fields}, $class; | ||||
123 | } | ||||
124 | |||||
125 | =head2 mk_accessors | ||||
126 | |||||
127 | Class->mk_accessors(@fields); | ||||
128 | |||||
129 | This creates accessor/mutator methods for each named field given in | ||||
130 | @fields. Foreach field in @fields it will generate two accessors. | ||||
131 | One called "field()" and the other called "_field_accessor()". For | ||||
132 | example: | ||||
133 | |||||
134 | # Generates foo(), _foo_accessor(), bar() and _bar_accessor(). | ||||
135 | Class->mk_accessors(qw(foo bar)); | ||||
136 | |||||
137 | See L<CAVEATS AND TRICKS/"Overriding autogenerated accessors"> | ||||
138 | for details. | ||||
139 | |||||
140 | =cut | ||||
141 | |||||
142 | # spent 6.60ms (315µs+6.29) within Class::Accessor::mk_accessors which was called 6 times, avg 1.10ms/call:
# once (53µs+1.43ms) by base::import at line 35 of Class/DBI/Query.pm
# once (55µs+1.29ms) by base::import at line 16 of Class/DBI/Plugin/Pager.pm
# once (57µs+1.06ms) by base::import at line 32 of Class/DBI/Column.pm
# once (48µs+1.01ms) by base::import at line 8 of Class/DBI/Relationship.pm
# once (51µs+854µs) by Class::DBI::_require_class at line 83 of Class/DBI/Search/Basic.pm
# once (51µs+640µs) by base::import at line 5 of Data/Page.pm | ||||
143 | 12 | 297µs | my($self, @fields) = @_; | ||
144 | |||||
145 | $self->_mk_accessors('rw', @fields); # spent 6.29ms making 6 calls to Class::Accessor::_mk_accessors, avg 1.05ms/call | ||||
146 | } | ||||
147 | |||||
148 | |||||
149 | { | ||||
150 | 4 | 1.90ms | 1 | 115µs | no strict 'refs'; # spent 115µs making 1 call to strict::unimport |
151 | |||||
152 | # spent 6.29ms (4.59+1.70) within Class::Accessor::_mk_accessors which was called 6 times, avg 1.05ms/call:
# 6 times (4.59ms+1.70ms) by Class::Accessor::mk_accessors at line 145, avg 1.05ms/call | ||||
153 | 30 | 315µs | my($self, $access, @fields) = @_; | ||
154 | my $class = ref $self || $self; | ||||
155 | my $ra = $access eq 'rw' || $access eq 'ro'; | ||||
156 | my $wa = $access eq 'rw' || $access eq 'wo'; | ||||
157 | |||||
158 | foreach my $field (@fields) { | ||||
159 | 120 | 1.97ms | 30 | 527µs | my $accessor_name = $self->accessor_name_for($field); # spent 527µs making 30 calls to Class::Accessor::accessor_name_for, avg 18µs/call |
160 | my $mutator_name = $self->mutator_name_for($field); # spent 499µs making 30 calls to Class::Accessor::mutator_name_for, avg 17µs/call | ||||
161 | if( $accessor_name eq 'DESTROY' or $mutator_name eq 'DESTROY' ) { | ||||
162 | $self->_carp("Having a data accessor named DESTROY in '$class' is unwise."); | ||||
163 | } | ||||
164 | 120 | 1.51ms | if ($accessor_name eq $mutator_name) { | ||
165 | my $accessor; | ||||
166 | if ($ra && $wa) { # spent 315µs making 14 calls to Class::Accessor::Fast::make_accessor, avg 23µs/call
# spent 202µs making 9 calls to Class::Accessor::Chained::Fast::make_accessor, avg 22µs/call
# spent 155µs making 7 calls to Class::Accessor::make_accessor, avg 22µs/call | ||||
167 | $accessor = $self->make_accessor($field); | ||||
168 | } elsif ($ra) { | ||||
169 | $accessor = $self->make_ro_accessor($field); | ||||
170 | } else { | ||||
171 | $accessor = $self->make_wo_accessor($field); | ||||
172 | } | ||||
173 | unless (defined &{"${class}::$accessor_name"}) { | ||||
174 | *{"${class}::$accessor_name"} = $accessor; | ||||
175 | } | ||||
176 | 60 | 507µs | if ($accessor_name eq $field) { | ||
177 | # the old behaviour | ||||
178 | my $alias = "_${field}_accessor"; | ||||
179 | *{"${class}::$alias"} = $accessor unless defined &{"${class}::$alias"}; | ||||
180 | } | ||||
181 | } else { | ||||
182 | if ($ra and not defined &{"${class}::$accessor_name"}) { | ||||
183 | *{"${class}::$accessor_name"} = $self->make_ro_accessor($field); | ||||
184 | } | ||||
185 | if ($wa and not defined &{"${class}::$mutator_name"}) { | ||||
186 | *{"${class}::$mutator_name"} = $self->make_wo_accessor($field); | ||||
187 | } | ||||
188 | } | ||||
189 | } | ||||
190 | } | ||||
191 | |||||
192 | sub follow_best_practice { | ||||
193 | my($self) = @_; | ||||
194 | my $class = ref $self || $self; | ||||
195 | *{"${class}::accessor_name_for"} = \&best_practice_accessor_name_for; | ||||
196 | *{"${class}::mutator_name_for"} = \&best_practice_mutator_name_for; | ||||
197 | } | ||||
198 | |||||
199 | } | ||||
200 | |||||
201 | =head2 mk_ro_accessors | ||||
202 | |||||
203 | Class->mk_ro_accessors(@read_only_fields); | ||||
204 | |||||
205 | Same as mk_accessors() except it will generate read-only accessors | ||||
206 | (ie. true accessors). If you attempt to set a value with these | ||||
207 | accessors it will throw an exception. It only uses get() and not | ||||
208 | set(). | ||||
209 | |||||
210 | package Foo; | ||||
211 | use base qw(Class::Accessor); | ||||
212 | Class->mk_ro_accessors(qw(foo bar)); | ||||
213 | |||||
214 | # Let's assume we have an object $foo of class Foo... | ||||
215 | print $foo->foo; # ok, prints whatever the value of $foo->{foo} is | ||||
216 | $foo->foo(42); # BOOM! Naughty you. | ||||
217 | |||||
218 | |||||
219 | =cut | ||||
220 | |||||
221 | sub mk_ro_accessors { | ||||
222 | my($self, @fields) = @_; | ||||
223 | |||||
224 | $self->_mk_accessors('ro', @fields); | ||||
225 | } | ||||
226 | |||||
227 | =head2 mk_wo_accessors | ||||
228 | |||||
229 | Class->mk_wo_accessors(@write_only_fields); | ||||
230 | |||||
231 | Same as mk_accessors() except it will generate write-only accessors | ||||
232 | (ie. mutators). If you attempt to read a value with these accessors | ||||
233 | it will throw an exception. It only uses set() and not get(). | ||||
234 | |||||
235 | B<NOTE> I'm not entirely sure why this is useful, but I'm sure someone | ||||
236 | will need it. If you've found a use, let me know. Right now its here | ||||
237 | for orthoginality and because its easy to implement. | ||||
238 | |||||
239 | package Foo; | ||||
240 | use base qw(Class::Accessor); | ||||
241 | Class->mk_wo_accessors(qw(foo bar)); | ||||
242 | |||||
243 | # Let's assume we have an object $foo of class Foo... | ||||
244 | $foo->foo(42); # OK. Sets $self->{foo} = 42 | ||||
245 | print $foo->foo; # BOOM! Can't read from this accessor. | ||||
246 | |||||
247 | =cut | ||||
248 | |||||
249 | sub mk_wo_accessors { | ||||
250 | my($self, @fields) = @_; | ||||
251 | |||||
252 | $self->_mk_accessors('wo', @fields); | ||||
253 | } | ||||
254 | |||||
255 | =head1 DETAILS | ||||
256 | |||||
257 | An accessor generated by Class::Accessor looks something like | ||||
258 | this: | ||||
259 | |||||
260 | # Your foo may vary. | ||||
261 | sub foo { | ||||
262 | my($self) = shift; | ||||
263 | if(@_) { # set | ||||
264 | return $self->set('foo', @_); | ||||
265 | } | ||||
266 | else { | ||||
267 | return $self->get('foo'); | ||||
268 | } | ||||
269 | } | ||||
270 | |||||
271 | Very simple. All it does is determine if you're wanting to set a | ||||
272 | value or get a value and calls the appropriate method. | ||||
273 | Class::Accessor provides default get() and set() methods which | ||||
274 | your class can override. They're detailed later. | ||||
275 | |||||
276 | =head2 follow_best_practice | ||||
277 | |||||
278 | In Damian's Perl Best Practices book he recommends separate get and set methods | ||||
279 | with the prefix set_ and get_ to make it explicit what you intend to do. If you | ||||
280 | want to create those accessor methods instead of the default ones, call: | ||||
281 | |||||
282 | __PACKAGE__->follow_best_practice | ||||
283 | |||||
284 | =head2 accessor_name_for / mutator_name_for | ||||
285 | |||||
286 | You may have your own crazy ideas for the names of the accessors, so you can | ||||
287 | make those happen by overriding C<accessor_name_for> and C<mutator_name_for> in | ||||
288 | your subclass. (I copied that idea from Class::DBI.) | ||||
289 | |||||
290 | =cut | ||||
291 | |||||
292 | sub best_practice_accessor_name_for { | ||||
293 | my ($class, $field) = @_; | ||||
294 | return "get_$field"; | ||||
295 | } | ||||
296 | |||||
297 | sub best_practice_mutator_name_for { | ||||
298 | my ($class, $field) = @_; | ||||
299 | return "set_$field"; | ||||
300 | } | ||||
301 | |||||
302 | # spent 527µs within Class::Accessor::accessor_name_for which was called 30 times, avg 18µs/call:
# 30 times (527µs+0s) by Class::Accessor::_mk_accessors at line 159, avg 18µs/call | ||||
303 | 60 | 646µs | my ($class, $field) = @_; | ||
304 | return $field; | ||||
305 | } | ||||
306 | |||||
307 | # spent 499µs within Class::Accessor::mutator_name_for which was called 30 times, avg 17µs/call:
# 30 times (499µs+0s) by Class::Accessor::_mk_accessors at line 160, avg 17µs/call | ||||
308 | 60 | 555µs | my ($class, $field) = @_; | ||
309 | return $field; | ||||
310 | } | ||||
311 | |||||
312 | =head2 Modifying the behavior of the accessor | ||||
313 | |||||
314 | Rather than actually modifying the accessor itself, it is much more | ||||
315 | sensible to simply override the two key methods which the accessor | ||||
316 | calls. Namely set() and get(). | ||||
317 | |||||
318 | If you -really- want to, you can override make_accessor(). | ||||
319 | |||||
320 | =head2 set | ||||
321 | |||||
322 | $obj->set($key, $value); | ||||
323 | $obj->set($key, @values); | ||||
324 | |||||
325 | set() defines how generally one stores data in the object. | ||||
326 | |||||
327 | override this method to change how data is stored by your accessors. | ||||
328 | |||||
329 | =cut | ||||
330 | |||||
331 | sub set { | ||||
332 | my($self, $key) = splice(@_, 0, 2); | ||||
333 | |||||
334 | if(@_ == 1) { | ||||
335 | $self->{$key} = $_[0]; | ||||
336 | } | ||||
337 | elsif(@_ > 1) { | ||||
338 | $self->{$key} = [@_]; | ||||
339 | } | ||||
340 | else { | ||||
341 | $self->_croak("Wrong number of arguments received"); | ||||
342 | } | ||||
343 | } | ||||
344 | |||||
345 | =head2 get | ||||
346 | |||||
347 | $value = $obj->get($key); | ||||
348 | @values = $obj->get(@keys); | ||||
349 | |||||
350 | get() defines how data is retreived from your objects. | ||||
351 | |||||
352 | override this method to change how it is retreived. | ||||
353 | |||||
354 | =cut | ||||
355 | |||||
356 | sub get { | ||||
357 | my $self = shift; | ||||
358 | |||||
359 | if(@_ == 1) { | ||||
360 | return $self->{$_[0]}; | ||||
361 | } | ||||
362 | elsif( @_ > 1 ) { | ||||
363 | return @{$self}{@_}; | ||||
364 | } | ||||
365 | else { | ||||
366 | $self->_croak("Wrong number of arguments received"); | ||||
367 | } | ||||
368 | } | ||||
369 | |||||
370 | =head2 make_accessor | ||||
371 | |||||
372 | $accessor = Class->make_accessor($field); | ||||
373 | |||||
374 | Generates a subroutine reference which acts as an accessor for the given | ||||
375 | $field. It calls get() and set(). | ||||
376 | |||||
377 | If you wish to change the behavior of your accessors, try overriding | ||||
378 | get() and set() before you start mucking with make_accessor(). | ||||
379 | |||||
380 | =cut | ||||
381 | |||||
382 | # spent 410µs within Class::Accessor::make_accessor which was called 17 times, avg 24µs/call:
# 10 times (255µs+0s) by Class::DBI::_mk_column_accessors at line 359 of Class/DBI.pm, avg 26µs/call
# 7 times (155µs+0s) by Class::Accessor::_mk_accessors at line 166, avg 22µs/call | ||||
383 | 34 | 501µs | my ($class, $field) = @_; | ||
384 | |||||
385 | # Build a closure around $field. | ||||
386 | # spent 232ms (18.3+214) within Class::Accessor::__ANON__[/project/perl/lib/Class/Accessor.pm:395] which was called 463 times, avg 501µs/call:
# 461 times (18.2ms+202ms) by main::RUNTIME at line 8 of ddd2.pl, avg 477µs/call
# once (40µs+11.3ms) by main::RUNTIME at line 10 of ddd2.pl
# once (39µs+419µs) by Class::DBI::_flesh at line 857 of Class/DBI.pm | ||||
387 | 926 | 4.93ms | my $self = shift; | ||
388 | |||||
389 | 463 | 12.7ms | if(@_) { | ||
390 | return $self->set($field, @_); | ||||
391 | } | ||||
392 | else { | ||||
393 | return $self->get($field); # spent 214ms making 463 calls to Class::DBI::get, avg 461µs/call, recursion: max depth 1, time 419µs | ||||
394 | } | ||||
395 | }; | ||||
396 | } | ||||
397 | |||||
398 | =head2 make_ro_accessor | ||||
399 | |||||
400 | $read_only_accessor = Class->make_ro_accessor($field); | ||||
401 | |||||
402 | Generates a subroutine refrence which acts as a read-only accessor for | ||||
403 | the given $field. It only calls get(). | ||||
404 | |||||
405 | Override get() to change the behavior of your accessors. | ||||
406 | |||||
407 | =cut | ||||
408 | |||||
409 | sub make_ro_accessor { | ||||
410 | my($class, $field) = @_; | ||||
411 | |||||
412 | return sub { | ||||
413 | my $self = shift; | ||||
414 | |||||
415 | if (@_) { | ||||
416 | my $caller = caller; | ||||
417 | $self->_croak("'$caller' cannot alter the value of '$field' on objects of class '$class'"); | ||||
418 | } | ||||
419 | else { | ||||
420 | return $self->get($field); | ||||
421 | } | ||||
422 | }; | ||||
423 | } | ||||
424 | |||||
425 | =head2 make_wo_accessor | ||||
426 | |||||
427 | $read_only_accessor = Class->make_wo_accessor($field); | ||||
428 | |||||
429 | Generates a subroutine refrence which acts as a write-only accessor | ||||
430 | (mutator) for the given $field. It only calls set(). | ||||
431 | |||||
432 | Override set() to change the behavior of your accessors. | ||||
433 | |||||
434 | =cut | ||||
435 | |||||
436 | sub make_wo_accessor { | ||||
437 | my($class, $field) = @_; | ||||
438 | |||||
439 | return sub { | ||||
440 | my $self = shift; | ||||
441 | |||||
442 | unless (@_) { | ||||
443 | my $caller = caller; | ||||
444 | $self->_croak("'$caller' cannot access the value of '$field' on objects of class '$class'"); | ||||
445 | } | ||||
446 | else { | ||||
447 | return $self->set($field, @_); | ||||
448 | } | ||||
449 | }; | ||||
450 | } | ||||
451 | |||||
452 | =head1 EXCEPTIONS | ||||
453 | |||||
454 | If something goes wrong Class::Accessor will warn or die by calling Carp::carp | ||||
455 | or Carp::croak. If you don't like this you can override _carp() and _croak() in | ||||
456 | your subclass and do whatever else you want. | ||||
457 | |||||
458 | =cut | ||||
459 | |||||
460 | 3 | 297µs | use Carp (); | ||
461 | |||||
462 | sub _carp { | ||||
463 | my ($self, $msg) = @_; | ||||
464 | Carp::carp($msg || $self); | ||||
465 | return; | ||||
466 | } | ||||
467 | |||||
468 | sub _croak { | ||||
469 | my ($self, $msg) = @_; | ||||
470 | Carp::croak($msg || $self); | ||||
471 | return; | ||||
472 | } | ||||
473 | |||||
474 | =head1 EFFICIENCY | ||||
475 | |||||
476 | Class::Accessor does not employ an autoloader, thus it is much faster | ||||
477 | than you'd think. Its generated methods incur no special penalty over | ||||
478 | ones you'd write yourself. | ||||
479 | |||||
480 | Here are Schwern's results of benchmarking Class::Accessor, | ||||
481 | Class::Accessor::Fast, a hand-written accessor, and direct hash access. | ||||
482 | |||||
483 | Benchmark: timing 500000 iterations of By Hand - get, By Hand - set, | ||||
484 | C::A - get, C::A - set, C::A::Fast - get, C::A::Fast - set, | ||||
485 | Direct - get, Direct - set... | ||||
486 | |||||
487 | By Hand - get: 4 wallclock secs ( 5.09 usr + 0.00 sys = 5.09 CPU) | ||||
488 | @ 98231.83/s (n=500000) | ||||
489 | By Hand - set: 5 wallclock secs ( 6.06 usr + 0.00 sys = 6.06 CPU) | ||||
490 | @ 82508.25/s (n=500000) | ||||
491 | C::A - get: 9 wallclock secs ( 9.83 usr + 0.01 sys = 9.84 CPU) | ||||
492 | @ 50813.01/s (n=500000) | ||||
493 | C::A - set: 11 wallclock secs ( 9.95 usr + 0.00 sys = 9.95 CPU) | ||||
494 | @ 50251.26/s (n=500000) | ||||
495 | C::A::Fast - get: 6 wallclock secs ( 4.88 usr + 0.00 sys = 4.88 CPU) | ||||
496 | @ 102459.02/s (n=500000) | ||||
497 | C::A::Fast - set: 6 wallclock secs ( 5.83 usr + 0.00 sys = 5.83 CPU) | ||||
498 | @ 85763.29/s (n=500000) | ||||
499 | Direct - get: 0 wallclock secs ( 0.89 usr + 0.00 sys = 0.89 CPU) | ||||
500 | @ 561797.75/s (n=500000) | ||||
501 | Direct - set: 2 wallclock secs ( 0.87 usr + 0.00 sys = 0.87 CPU) | ||||
502 | @ 574712.64/s (n=500000) | ||||
503 | |||||
504 | So Class::Accessor::Fast is just as fast as one you'd write yourself | ||||
505 | while Class::Accessor is twice as slow, a price paid for flexibility. | ||||
506 | Direct hash access is about six times faster, but provides no | ||||
507 | encapsulation and no flexibility. | ||||
508 | |||||
509 | Of course, its not as simple as saying "Class::Accessor is twice as | ||||
510 | slow as one you write yourself". These are benchmarks for the | ||||
511 | simplest possible accessor, if your accessors do any sort of | ||||
512 | complicated work (such as talking to a database or writing to a file) | ||||
513 | the time spent doing that work will quickly swamp the time spend just | ||||
514 | calling the accessor. In that case, Class::Accessor and the ones you | ||||
515 | write will tend to be just as fast. | ||||
516 | |||||
517 | |||||
518 | =head1 EXAMPLES | ||||
519 | |||||
520 | Here's an example of generating an accessor for every public field of | ||||
521 | your class. | ||||
522 | |||||
523 | package Altoids; | ||||
524 | |||||
525 | use base qw(Class::Accessor Class::Fields); | ||||
526 | use fields qw(curiously strong mints); | ||||
527 | Altoids->mk_accessors( Altoids->show_fields('Public') ); | ||||
528 | |||||
529 | sub new { | ||||
530 | my $proto = shift; | ||||
531 | my $class = ref $proto || $proto; | ||||
532 | return fields::new($class); | ||||
533 | } | ||||
534 | |||||
535 | my Altoids $tin = Altoids->new; | ||||
536 | |||||
537 | $tin->curiously('Curiouser and curiouser'); | ||||
538 | print $tin->{curiously}; # prints 'Curiouser and curiouser' | ||||
539 | |||||
540 | |||||
541 | # Subclassing works, too. | ||||
542 | package Mint::Snuff; | ||||
543 | use base qw(Altoids); | ||||
544 | |||||
545 | my Mint::Snuff $pouch = Mint::Snuff->new; | ||||
546 | $pouch->strong('Blow your head off!'); | ||||
547 | print $pouch->{strong}; # prints 'Blow your head off!' | ||||
548 | |||||
549 | |||||
550 | Here's a simple example of altering the behavior of your accessors. | ||||
551 | |||||
552 | package Foo; | ||||
553 | use base qw(Class::Accessor); | ||||
554 | Foo->mk_accessor(qw(this that up down)); | ||||
555 | |||||
556 | sub get { | ||||
557 | my $self = shift; | ||||
558 | |||||
559 | # Note every time someone gets some data. | ||||
560 | print STDERR "Getting @_\n"; | ||||
561 | |||||
562 | $self->SUPER::get(@_); | ||||
563 | } | ||||
564 | |||||
565 | sub set { | ||||
566 | my ($self, $key) = splice(@_, 0, 2); | ||||
567 | |||||
568 | # Note every time someone sets some data. | ||||
569 | print STDERR "Setting $key to @_\n"; | ||||
570 | |||||
571 | $self->SUPER::set($key, @_); | ||||
572 | } | ||||
573 | |||||
574 | |||||
575 | =head1 CAVEATS AND TRICKS | ||||
576 | |||||
577 | Class::Accessor has to do some internal wackiness to get its | ||||
578 | job done quickly and efficiently. Because of this, there's a few | ||||
579 | tricks and traps one must know about. | ||||
580 | |||||
581 | Hey, nothing's perfect. | ||||
582 | |||||
583 | =head2 Don't make a field called DESTROY | ||||
584 | |||||
585 | This is bad. Since DESTROY is a magical method it would be bad for us | ||||
586 | to define an accessor using that name. Class::Accessor will | ||||
587 | carp if you try to use it with a field named "DESTROY". | ||||
588 | |||||
589 | =head2 Overriding autogenerated accessors | ||||
590 | |||||
591 | You may want to override the autogenerated accessor with your own, yet | ||||
592 | have your custom accessor call the default one. For instance, maybe | ||||
593 | you want to have an accessor which checks its input. Normally, one | ||||
594 | would expect this to work: | ||||
595 | |||||
596 | package Foo; | ||||
597 | use base qw(Class::Accessor); | ||||
598 | Foo->mk_accessors(qw(email this that whatever)); | ||||
599 | |||||
600 | # Only accept addresses which look valid. | ||||
601 | sub email { | ||||
602 | my($self) = shift; | ||||
603 | my($email) = @_; | ||||
604 | |||||
605 | if( @_ ) { # Setting | ||||
606 | require Email::Valid; | ||||
607 | unless( Email::Valid->address($email) ) { | ||||
608 | carp("$email doesn't look like a valid address."); | ||||
609 | return; | ||||
610 | } | ||||
611 | } | ||||
612 | |||||
613 | return $self->SUPER::email(@_); | ||||
614 | } | ||||
615 | |||||
616 | There's a subtle problem in the last example, and its in this line: | ||||
617 | |||||
618 | return $self->SUPER::email(@_); | ||||
619 | |||||
620 | If we look at how Foo was defined, it called mk_accessors() which | ||||
621 | stuck email() right into Foo's namespace. There *is* no | ||||
622 | SUPER::email() to delegate to! Two ways around this... first is to | ||||
623 | make a "pure" base class for Foo. This pure class will generate the | ||||
624 | accessors and provide the necessary super class for Foo to use: | ||||
625 | |||||
626 | package Pure::Organic::Foo; | ||||
627 | use base qw(Class::Accessor); | ||||
628 | Pure::Organic::Foo->mk_accessors(qw(email this that whatever)); | ||||
629 | |||||
630 | package Foo; | ||||
631 | use base qw(Pure::Organic::Foo); | ||||
632 | |||||
633 | And now Foo::email() can override the generated | ||||
634 | Pure::Organic::Foo::email() and use it as SUPER::email(). | ||||
635 | |||||
636 | This is probably the most obvious solution to everyone but me. | ||||
637 | Instead, what first made sense to me was for mk_accessors() to define | ||||
638 | an alias of email(), _email_accessor(). Using this solution, | ||||
639 | Foo::email() would be written with: | ||||
640 | |||||
641 | return $self->_email_accessor(@_); | ||||
642 | |||||
643 | instead of the expected SUPER::email(). | ||||
644 | |||||
645 | |||||
646 | =head1 AUTHORS | ||||
647 | |||||
648 | Copyright 2005 Marty Pauley <marty+perl@kasei.com> | ||||
649 | |||||
650 | This program is free software; you can redistribute it and/or modify it under | ||||
651 | the same terms as Perl itself. That means either (a) the GNU General Public | ||||
652 | License or (b) the Artistic License. | ||||
653 | |||||
654 | =head2 ORIGINAL AUTHOR | ||||
655 | |||||
656 | Michael G Schwern <schwern@pobox.com> | ||||
657 | |||||
658 | =head2 THANKS | ||||
659 | |||||
660 | Liz, for performance tweaks. | ||||
661 | |||||
662 | Tels, for his big feature request/bug report. | ||||
663 | |||||
664 | |||||
665 | =head1 SEE ALSO | ||||
666 | |||||
667 | L<Class::Accessor::Fast> | ||||
668 | |||||
669 | These are some modules which do similar things in different ways | ||||
670 | L<Class::Struct>, L<Class::Methodmaker>, L<Class::Generate>, | ||||
671 | L<Class::Class>, L<Class::Contract> | ||||
672 | |||||
673 | L<Class::DBI> for an example of this module in use. | ||||
674 | |||||
675 | =cut | ||||
676 | |||||
677 | 1 | 12µs | 1; |