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