← Index
Performance Profile   « block view • line view • sub view »
For /wise/base/deliv/dev/bin/getfix
  Run on Thu May 20 15:30:03 2010
Reported on Thu May 20 16:25:28 2010

File/wise/base/static/lib/perl5/site_perl/5.10.0/Class/Accessor.pm
Statements Executed62
Total Time0.001626 seconds

Subroutines — ordered by exclusive time
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1118.8e-50.00017Class::Accessor::_mk_accessors
1112.7e-50.00020Class::Accessor::mk_accessors
3112.7e-52.7e-5Class::Accessor::mutator_name_for
3112.6e-52.6e-5Class::Accessor::accessor_name_for
00000Class::Accessor::BEGIN
00000Class::Accessor::__ANON__[:395]
00000Class::Accessor::__ANON__[:422]
00000Class::Accessor::__ANON__[:449]
00000Class::Accessor::_carp
00000Class::Accessor::_croak
00000Class::Accessor::best_practice_accessor_name_for
00000Class::Accessor::best_practice_mutator_name_for
00000Class::Accessor::follow_best_practice
00000Class::Accessor::get
00000Class::Accessor::make_accessor
00000Class::Accessor::make_ro_accessor
00000Class::Accessor::make_wo_accessor
00000Class::Accessor::mk_ro_accessors
00000Class::Accessor::mk_wo_accessors
00000Class::Accessor::new
00000Class::Accessor::set

LineStmts.Exclusive
Time		Avg.Code
1package Class::Accessor;
216.8e-56.8e-5require 5.00502;
330.000186.2e-5use strict;
# spent 10µs making 1 call to strict::import
411.0e-61.0e-6$Class::Accessor::VERSION = '0.31';
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
32This module automagically generates accessors/mutators for your class.
33
34Most of the time, writing accessors is an exercise in cutting and
35pasting. 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
55One for each piece of data in your object. While some will be unique,
56doing value checks and special storage tricks, most will simply be
57exercises in repetition. Not only is it Bad Style to have a bunch of
58repetitious code, but its also simply not lazy, which is the real
59tragedy.
60
61If you make your module a subclass of Class::Accessor and declare your
62accessor fields with mk_accessors() then you'll find yourself with a
63set of automatically generated accessors which can even be
64customized!
65
66The 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
72Done. My::Class now has simple foo(), bar() and car() accessors
73defined.
74
75=head2 What Makes This Different?
76
77What makes this module special compared to all the other method
78generating modules (L<"SEE ALSO">)? By overriding the get() and set()
79methods you can alter the behavior of the accessors class-wide. Also,
80the accessors are implemented as closures which should cost a bit less
81memory than most other solutions which generate a new method for each
82accessor.
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
95Class::Accessor provides a basic constructor. It generates a
96hash-based object and can be called as either a class method or an
97object method.
98
99It takes an optional %fields hash which is used to initialize the
100object (handy if you use read-only accessors). The fields of the hash
101correspond 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
110however %fields can contain anything, new() will shove them all into
111your object. Don't like it? Override it.
112
113=cut
114
115sub new {
116 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
129This creates accessor/mutator methods for each named field given in
130@fields. Foreach field in @fields it will generate two accessors.
131One called "field()" and the other called "_field_accessor()". For
132example:
133
134 # Generates foo(), _foo_accessor(), bar() and _bar_accessor().
135 Class->mk_accessors(qw(foo bar));
136
137See L<CAVEATS AND TRICKS/"Overriding autogenerated accessors">
138for details.
139
140=cut
141
142
# spent 200µs (27+173) within Class::Accessor::mk_accessors which was called # once (27µs+173µs) at line 5 of /wise/base/static/lib/perl5/site_perl/5.10.0/Data/Page.pm
sub mk_accessors {
14322.0e-51.0e-5 my($self, @fields) = @_;
144
145 $self->_mk_accessors('rw', @fields);
# spent 173µs making 1 call to Class::Accessor::_mk_accessors
146}
147
148
149{
15040.001070.00027 no strict 'refs';
# spent 23µs making 1 call to strict::unimport
151
152
# spent 173µs (88+85) within Class::Accessor::_mk_accessors which was called # once (88µs+85µs) by Class::Accessor::mk_accessors at line 145
sub _mk_accessors {
153350.000123.5e-6 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 my $accessor_name = $self->accessor_name_for($field);
# spent 26µs making 3 calls to Class::Accessor::accessor_name_for, avg 9µs/call
160 my $mutator_name = $self->mutator_name_for($field);
# spent 27µs making 3 calls to Class::Accessor::mutator_name_for, avg 9µ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 if ($accessor_name eq $mutator_name) {
165 my $accessor;
166 if ($ra && $wa) {
# spent 32µs making 3 calls to Class::Accessor::Chained::Fast::make_accessor, avg 11µ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 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
205Same as mk_accessors() except it will generate read-only accessors
206(ie. true accessors). If you attempt to set a value with these
207accessors it will throw an exception. It only uses get() and not
208set().
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
221sub 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
231Same as mk_accessors() except it will generate write-only accessors
232(ie. mutators). If you attempt to read a value with these accessors
233it will throw an exception. It only uses set() and not get().
234
235B<NOTE> I'm not entirely sure why this is useful, but I'm sure someone
236will need it. If you've found a use, let me know. Right now its here
237for 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
249sub mk_wo_accessors {
250 my($self, @fields) = @_;
251
252 $self->_mk_accessors('wo', @fields);
253}
254
255=head1 DETAILS
256
257An accessor generated by Class::Accessor looks something like
258this:
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
271Very simple. All it does is determine if you're wanting to set a
272value or get a value and calls the appropriate method.
273Class::Accessor provides default get() and set() methods which
274your class can override. They're detailed later.
275
276=head2 follow_best_practice
277
278In Damian's Perl Best Practices book he recommends separate get and set methods
279with the prefix set_ and get_ to make it explicit what you intend to do. If you
280want 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
286You may have your own crazy ideas for the names of the accessors, so you can
287make those happen by overriding C<accessor_name_for> and C<mutator_name_for> in
288your subclass. (I copied that idea from Class::DBI.)
289
290=cut
291
292sub best_practice_accessor_name_for {
293 my ($class, $field) = @_;
294 return "get_$field";
295}
296
297sub best_practice_mutator_name_for {
298 my ($class, $field) = @_;
299 return "set_$field";
300}
301
302
# spent 26µs within Class::Accessor::accessor_name_for which was called 3 times, avg 9µs/call: # 3 times (26µs+0) by Class::Accessor::_mk_accessors at line 159, avg 9µs/call
sub accessor_name_for {
30361.6e-52.7e-6 my ($class, $field) = @_;
304 return $field;
305}
306
307
# spent 27µs within Class::Accessor::mutator_name_for which was called 3 times, avg 9µs/call: # 3 times (27µs+0) by Class::Accessor::_mk_accessors at line 160, avg 9µs/call
sub mutator_name_for {
30861.0e-51.7e-6 my ($class, $field) = @_;
309 return $field;
310}
311
312=head2 Modifying the behavior of the accessor
313
314Rather than actually modifying the accessor itself, it is much more
315sensible to simply override the two key methods which the accessor
316calls. Namely set() and get().
317
318If 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
325set() defines how generally one stores data in the object.
326
327override this method to change how data is stored by your accessors.
328
329=cut
330
331sub 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
350get() defines how data is retreived from your objects.
351
352override this method to change how it is retreived.
353
354=cut
355
356sub 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
374Generates a subroutine reference which acts as an accessor for the given
375$field. It calls get() and set().
376
377If you wish to change the behavior of your accessors, try overriding
378get() and set() before you start mucking with make_accessor().
379
380=cut
381
382sub make_accessor {
383 my ($class, $field) = @_;
384
385 # Build a closure around $field.
386 return sub {
387 my $self = shift;
388
389 if(@_) {
390 return $self->set($field, @_);
391 }
392 else {
393 return $self->get($field);
394 }
395 };
396}
397
398=head2 make_ro_accessor
399
400 $read_only_accessor = Class->make_ro_accessor($field);
401
402Generates a subroutine refrence which acts as a read-only accessor for
403the given $field. It only calls get().
404
405Override get() to change the behavior of your accessors.
406
407=cut
408
409sub 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
429Generates a subroutine refrence which acts as a write-only accessor
430(mutator) for the given $field. It only calls set().
431
432Override set() to change the behavior of your accessors.
433
434=cut
435
436sub 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
454If something goes wrong Class::Accessor will warn or die by calling Carp::carp
455or Carp::croak. If you don't like this you can override _carp() and _croak() in
456your subclass and do whatever else you want.
457
458=cut
459
46030.000134.5e-5use Carp ();
461
462sub _carp {
463 my ($self, $msg) = @_;
464 Carp::carp($msg || $self);
465 return;
466}
467
468sub _croak {
469 my ($self, $msg) = @_;
470 Carp::croak($msg || $self);
471 return;
472}
473
474=head1 EFFICIENCY
475
476Class::Accessor does not employ an autoloader, thus it is much faster
477than you'd think. Its generated methods incur no special penalty over
478ones you'd write yourself.
479
480 accessors:
481 Rate Basic Average Fast Faster Direct
482 Basic 189150/s -- -42% -51% -55% -89%
483 Average 327679/s 73% -- -16% -22% -82%
484 Fast 389212/s 106% 19% -- -8% -78%
485 Faster 421646/s 123% 29% 8% -- -76%
486 Direct 1771243/s 836% 441% 355% 320% --
487
488 mutators:
489 Rate Basic Average Fast Faster Direct
490 Basic 173769/s -- -34% -53% -59% -90%
491 Average 263046/s 51% -- -29% -38% -85%
492 Fast 371158/s 114% 41% -- -13% -78%
493 Faster 425821/s 145% 62% 15% -- -75%
494 Direct 1699081/s 878% 546% 358% 299% --
495
496Class::Accessor::Fast is faster than methods written by an average programmer
497(where "average" is based on Schwern's example code).
498
499Class::Accessor is slower than average, but more flexible.
500
501Class::Accessor::Faster is even faster than Class::Accessor::Fast. It uses an
502array internally, not a hash. This could be a good or bad feature depending on
503your point of view.
504
505Direct hash access is, of course, much faster than all of these, but it
506provides no encapsulation.
507
508Of course, its not as simple as saying "Class::Accessor is slower than
509average". These are benchmarks for a simple accessor. If your accessors do
510any sort of complicated work (such as talking to a database or writing to a
511file) the time spent doing that work will quickly swamp the time spend just
512calling the accessor. In that case, Class::Accessor and the ones you write
513will be roughly the same speed.
514
515
516=head1 EXAMPLES
517
518Here's an example of generating an accessor for every public field of
519your class.
520
521 package Altoids;
522
523 use base qw(Class::Accessor Class::Fields);
524 use fields qw(curiously strong mints);
525 Altoids->mk_accessors( Altoids->show_fields('Public') );
526
527 sub new {
528 my $proto = shift;
529 my $class = ref $proto || $proto;
530 return fields::new($class);
531 }
532
533 my Altoids $tin = Altoids->new;
534
535 $tin->curiously('Curiouser and curiouser');
536 print $tin->{curiously}; # prints 'Curiouser and curiouser'
537
538
539 # Subclassing works, too.
540 package Mint::Snuff;
541 use base qw(Altoids);
542
543 my Mint::Snuff $pouch = Mint::Snuff->new;
544 $pouch->strong('Blow your head off!');
545 print $pouch->{strong}; # prints 'Blow your head off!'
546
547
548Here's a simple example of altering the behavior of your accessors.
549
550 package Foo;
551 use base qw(Class::Accessor);
552 Foo->mk_accessor(qw(this that up down));
553
554 sub get {
555 my $self = shift;
556
557 # Note every time someone gets some data.
558 print STDERR "Getting @_\n";
559
560 $self->SUPER::get(@_);
561 }
562
563 sub set {
564 my ($self, $key) = splice(@_, 0, 2);
565
566 # Note every time someone sets some data.
567 print STDERR "Setting $key to @_\n";
568
569 $self->SUPER::set($key, @_);
570 }
571
572
573=head1 CAVEATS AND TRICKS
574
575Class::Accessor has to do some internal wackiness to get its
576job done quickly and efficiently. Because of this, there's a few
577tricks and traps one must know about.
578
579Hey, nothing's perfect.
580
581=head2 Don't make a field called DESTROY
582
583This is bad. Since DESTROY is a magical method it would be bad for us
584to define an accessor using that name. Class::Accessor will
585carp if you try to use it with a field named "DESTROY".
586
587=head2 Overriding autogenerated accessors
588
589You may want to override the autogenerated accessor with your own, yet
590have your custom accessor call the default one. For instance, maybe
591you want to have an accessor which checks its input. Normally, one
592would expect this to work:
593
594 package Foo;
595 use base qw(Class::Accessor);
596 Foo->mk_accessors(qw(email this that whatever));
597
598 # Only accept addresses which look valid.
599 sub email {
600 my($self) = shift;
601 my($email) = @_;
602
603 if( @_ ) { # Setting
604 require Email::Valid;
605 unless( Email::Valid->address($email) ) {
606 carp("$email doesn't look like a valid address.");
607 return;
608 }
609 }
610
611 return $self->SUPER::email(@_);
612 }
613
614There's a subtle problem in the last example, and its in this line:
615
616 return $self->SUPER::email(@_);
617
618If we look at how Foo was defined, it called mk_accessors() which
619stuck email() right into Foo's namespace. There *is* no
620SUPER::email() to delegate to! Two ways around this... first is to
621make a "pure" base class for Foo. This pure class will generate the
622accessors and provide the necessary super class for Foo to use:
623
624 package Pure::Organic::Foo;
625 use base qw(Class::Accessor);
626 Pure::Organic::Foo->mk_accessors(qw(email this that whatever));
627
628 package Foo;
629 use base qw(Pure::Organic::Foo);
630
631And now Foo::email() can override the generated
632Pure::Organic::Foo::email() and use it as SUPER::email().
633
634This is probably the most obvious solution to everyone but me.
635Instead, what first made sense to me was for mk_accessors() to define
636an alias of email(), _email_accessor(). Using this solution,
637Foo::email() would be written with:
638
639 return $self->_email_accessor(@_);
640
641instead of the expected SUPER::email().
642
643
644=head1 AUTHORS
645
646Copyright 2007 Marty Pauley <marty+perl@kasei.com>
647
648This program is free software; you can redistribute it and/or modify it under
649the same terms as Perl itself. That means either (a) the GNU General Public
650License or (b) the Artistic License.
651
652=head2 ORIGINAL AUTHOR
653
654Michael G Schwern <schwern@pobox.com>
655
656=head2 THANKS
657
658Liz and RUZ for performance tweaks.
659
660Tels, for his big feature request/bug report.
661
662
663=head1 SEE ALSO
664
665L<Class::Accessor::Fast>
666
667These are some modules which do similar things in different ways
668L<Class::Struct>, L<Class::Methodmaker>, L<Class::Generate>,
669L<Class::Class>, L<Class::Contract>
670
671L<Class::DBI> for an example of this module in use.
672
673=cut
674
67514.0e-64.0e-61;

Report produced by the NYTProf 2.07 Perl profiler, developed by Tim Bunce and Adam Kaplan.