1 package Class::Accessor;
4 $Class::Accessor::VERSION = '0.34';
7 my($proto, $fields) = @_;
8 my($class) = ref $proto || $proto;
10 $fields = {} unless defined $fields;
12 # make a copy of $fields.
13 bless {%$fields}, $class;
17 my($self, @fields) = @_;
19 $self->_mk_accessors('rw', @fields);
22 if (eval { require Sub::Name }) {
30 my ($class, @what) = @_;
33 if (/^(?:antlers|moose-?like)$/i) {
34 *{"${caller}::has"} = sub {
36 $caller->_mk_accessors(($args{is}||"rw"), $f);
38 *{"${caller}::extends"} = sub {
39 @{"${caller}::ISA"} = @_;
40 unless (grep $_->can("_mk_accessors"), @_) {
41 push @{"${caller}::ISA"}, $class;
44 # we'll use their @ISA as a default, in case it happens to be
46 &{"${caller}::extends"}(@{"${caller}::ISA"});
51 sub follow_best_practice {
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;
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';
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.");
70 if ($accessor_name eq $mutator_name) {
73 $accessor = $self->make_accessor($field);
75 $accessor = $self->make_ro_accessor($field);
77 $accessor = $self->make_wo_accessor($field);
79 my $fullname = "${class}::$accessor_name";
81 unless (defined &{$fullname}) {
82 subname($fullname, $accessor) if defined &subname;
84 *{$fullname} = $accessor;
86 if ($accessor_name eq $field) {
88 my $alias = "${class}::_${field}_accessor";
89 subname($alias, $accessor) if defined &subname and not $subnamed;
90 *{$alias} = $accessor unless defined &{$alias};
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;
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;
111 sub mk_ro_accessors {
112 my($self, @fields) = @_;
114 $self->_mk_accessors('ro', @fields);
117 sub mk_wo_accessors {
118 my($self, @fields) = @_;
120 $self->_mk_accessors('wo', @fields);
123 sub best_practice_accessor_name_for {
124 my ($class, $field) = @_;
128 sub best_practice_mutator_name_for {
129 my ($class, $field) = @_;
133 sub accessor_name_for {
134 my ($class, $field) = @_;
138 sub mutator_name_for {
139 my ($class, $field) = @_;
144 my($self, $key) = splice(@_, 0, 2);
147 $self->{$key} = $_[0];
150 $self->{$key} = [@_];
153 $self->_croak("Wrong number of arguments received");
161 return $self->{$_[0]};
167 $self->_croak("Wrong number of arguments received");
172 my ($class, $field) = @_;
178 return $self->set($field, @_);
180 return $self->get($field);
185 sub make_ro_accessor {
186 my($class, $field) = @_;
193 $self->_croak("'$caller' cannot alter the value of '$field' on objects of class '$class'");
196 return $self->get($field);
201 sub make_wo_accessor {
202 my($class, $field) = @_;
209 $self->_croak("'$caller' cannot access the value of '$field' on objects of class '$class'");
212 return $self->set($field, @_);
221 my ($self, $msg) = @_;
222 Carp::carp($msg || $self);
227 my ($self, $msg) = @_;
228 Carp::croak($msg || $self);
238 Class::Accessor - Automated accessor generation
243 use base qw(Class::Accessor);
244 Foo->follow_best_practice;
245 Foo->mk_accessors(qw(name role salary));
247 # or if you prefer a Moose-like interface...
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" );
255 # Meanwhile, in a nearby piece of code!
256 # Class::Accessor provides new().
257 my $mp = Foo->new({ name => "Marty", role => "JAPH" });
259 my $job = $mp->role; # gets $mp->{role}
260 $mp->salary(400000); # sets $mp->{salary} = 400000 # I wish
262 # like my @info = @{$mp}{qw(name role)}
263 my @info = $mp->get(qw(name role));
265 # $mp->{salary} = 400000
266 $mp->set('salary', 400000);
271 This module automagically generates accessors/mutators for your class.
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:
279 $self->{name} = $_[0];
281 return $self->{name};
287 $self->{salary} = $_[0];
289 return $self->{salary};
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
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
305 The basic set up is very simple:
308 use base qw(Class::Accessor);
309 Foo->mk_accessors( qw(far bar car) );
311 Done. Foo now has simple far(), bar() and car() accessors
314 Alternatively, if you want to follow Damian's I<best practice> guidelines
318 use base qw(Class::Accessor);
319 Foo->follow_best_practice;
320 Foo->mk_accessors( qw(far bar car) );
322 B<Note:> you must call C<follow_best_practice> before calling C<mk_accessors>.
326 By popular demand we now have a simple Moose-like interface. You can now do:
329 use Class::Accessor "antlers";
330 has far => ( is => "rw" );
331 has bar => ( is => "rw" );
332 has car => ( is => "rw" );
334 Currently only the C<is> attribute is supported.
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
345 my $obj = $other_obj->new;
347 my $obj = Foo->new(\%fields);
348 my $obj = $other_obj->new(\%fields);
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...
355 use base qw(Class::Accessor);
356 Foo->mk_accessors('foo');
358 my $obj = Foo->new({ foo => 42 });
359 print $obj->foo; # 42
361 however %fields can contain anything, new() will shove them all into
364 =head1 MAKING ACCESSORS
366 =head2 follow_best_practice
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:
372 __PACKAGE__->follow_best_practice
374 B<before> you call any of the accessor-making methods.
376 =head2 accessor_name_for / mutator_name_for
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.)
384 __PACKAGE__->mk_accessors(@fields);
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
391 # Generates foo(), _foo_accessor(), bar() and _bar_accessor().
392 __PACKAGE__->mk_accessors(qw(foo bar));
394 See L<CAVEATS AND TRICKS/"Overriding autogenerated accessors">
397 =head2 mk_ro_accessors
399 __PACKAGE__->mk_ro_accessors(@read_only_fields);
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
407 use base qw(Class::Accessor);
408 Foo->mk_ro_accessors(qw(foo bar));
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.
415 =head2 mk_wo_accessors
417 __PACKAGE__->mk_wo_accessors(@write_only_fields);
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().
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.
428 use base qw(Class::Accessor);
429 Foo->mk_wo_accessors(qw(foo bar));
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.
437 If you prefer a Moose-like interface to create accessors, you can use C<has> by
438 importing this module like this:
440 use Class::Accessor "antlers";
444 use Class::Accessor "moose-like";
446 Then you can declare accessors like this:
448 has alpha => ( is => "rw", isa => "Str" );
449 has beta => ( is => "ro", isa => "Str" );
450 has gamma => ( is => "wo", isa => "Str" );
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.
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
462 extends(qw/Foo Bar/);
466 An accessor generated by Class::Accessor looks something like
473 return $self->set('foo', @_);
476 return $self->get('foo');
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.
485 =head2 Modifying the behavior of the accessor
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().
491 If you -really- want to, you can override make_accessor().
495 $obj->set($key, $value);
496 $obj->set($key, @values);
498 set() defines how generally one stores data in the object.
500 override this method to change how data is stored by your accessors.
504 $value = $obj->get($key);
505 @values = $obj->get(@keys);
507 get() defines how data is retreived from your objects.
509 override this method to change how it is retreived.
513 $accessor = __PACKAGE__->make_accessor($field);
515 Generates a subroutine reference which acts as an accessor for the given
516 $field. It calls get() and set().
518 If you wish to change the behavior of your accessors, try overriding
519 get() and set() before you start mucking with make_accessor().
521 =head2 make_ro_accessor
523 $read_only_accessor = __PACKAGE__->make_ro_accessor($field);
525 Generates a subroutine refrence which acts as a read-only accessor for
526 the given $field. It only calls get().
528 Override get() to change the behavior of your accessors.
530 =head2 make_wo_accessor
532 $read_only_accessor = __PACKAGE__->make_wo_accessor($field);
534 Generates a subroutine refrence which acts as a write-only accessor
535 (mutator) for the given $field. It only calls set().
537 Override set() to change the behavior of your accessors.
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.
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.
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% --
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% --
565 Class::Accessor::Fast is faster than methods written by an average programmer
566 (where "average" is based on Schwern's example code).
568 Class::Accessor is slower than average, but more flexible.
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
574 Direct hash access is, of course, much faster than all of these, but it
575 provides no encapsulation.
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.
587 Here's an example of generating an accessor for every public field of
592 use base qw(Class::Accessor Class::Fields);
593 use fields qw(curiously strong mints);
594 Altoids->mk_accessors( Altoids->show_fields('Public') );
598 my $class = ref $proto || $proto;
599 return fields::new($class);
602 my Altoids $tin = Altoids->new;
604 $tin->curiously('Curiouser and curiouser');
605 print $tin->{curiously}; # prints 'Curiouser and curiouser'
608 # Subclassing works, too.
610 use base qw(Altoids);
612 my Mint::Snuff $pouch = Mint::Snuff->new;
613 $pouch->strong('Blow your head off!');
614 print $pouch->{strong}; # prints 'Blow your head off!'
617 Here's a simple example of altering the behavior of your accessors.
620 use base qw(Class::Accessor);
621 Foo->mk_accessors(qw(this that up down));
626 # Note every time someone gets some data.
627 print STDERR "Getting @_\n";
629 $self->SUPER::get(@_);
633 my ($self, $key) = splice(@_, 0, 2);
635 # Note every time someone sets some data.
636 print STDERR "Setting $key to @_\n";
638 $self->SUPER::set($key, @_);
642 =head1 CAVEATS AND TRICKS
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.
648 Hey, nothing's perfect.
650 =head2 Don't make a field called DESTROY
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".
656 =head2 Overriding autogenerated accessors
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:
664 use base qw(Class::Accessor);
665 Foo->mk_accessors(qw(email this that whatever));
667 # Only accept addresses which look valid.
673 require Email::Valid;
674 unless( Email::Valid->address($email) ) {
675 carp("$email doesn't look like a valid address.");
680 return $self->SUPER::email(@_);
683 There's a subtle problem in the last example, and it's in this line:
685 return $self->SUPER::email(@_);
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:
693 package Pure::Organic::Foo;
694 use base qw(Class::Accessor);
695 Pure::Organic::Foo->mk_accessors(qw(email this that whatever));
698 use base qw(Pure::Organic::Foo);
700 And now Foo::email() can override the generated
701 Pure::Organic::Foo::email() and use it as SUPER::email().
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:
708 return $self->_email_accessor(@_);
710 instead of the expected SUPER::email().
715 Copyright 2009 Marty Pauley <marty+perl@kasei.com>
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.
721 =head2 ORIGINAL AUTHOR
723 Michael G Schwern <schwern@pobox.com>
727 Liz and RUZ for performance tweaks.
729 Tels, for his big feature request/bug report.
731 Various presenters at YAPC::Asia 2009 for criticising the non-Moose interface.
735 See L<Class::Accessor::Fast> and L<Class::Accessor::Faster> if speed is more
736 important than flexibility.
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>
742 See L<Class::DBI> for an example of this module in use.