| File | /usr/share/perl5/Class/Accessor.pm |
| Statements Executed | 116 |
| Total Time | 0.0017763 seconds |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 146µs | 266µs | Class::Accessor::_mk_accessors |
| 6 | 1 | 1 | 56µs | 56µs | Class::Accessor::make_accessor |
| 6 | 1 | 1 | 33µs | 33µs | Class::Accessor::mutator_name_for |
| 6 | 1 | 1 | 32µs | 32µs | Class::Accessor::accessor_name_for |
| 1 | 1 | 1 | 22µs | 288µs | Class::Accessor::mk_accessors |
| 0 | 0 | 0 | 0s | 0s | Class::Accessor::BEGIN |
| 0 | 0 | 0 | 0s | 0s | Class::Accessor::__ANON__[:395] |
| 0 | 0 | 0 | 0s | 0s | Class::Accessor::__ANON__[:422] |
| 0 | 0 | 0 | 0s | 0s | Class::Accessor::__ANON__[:449] |
| 0 | 0 | 0 | 0s | 0s | Class::Accessor::_carp |
| 0 | 0 | 0 | 0s | 0s | Class::Accessor::_croak |
| 0 | 0 | 0 | 0s | 0s | Class::Accessor::best_practice_accessor_name_for |
| 0 | 0 | 0 | 0s | 0s | Class::Accessor::best_practice_mutator_name_for |
| 0 | 0 | 0 | 0s | 0s | Class::Accessor::follow_best_practice |
| 0 | 0 | 0 | 0s | 0s | Class::Accessor::get |
| 0 | 0 | 0 | 0s | 0s | Class::Accessor::make_ro_accessor |
| 0 | 0 | 0 | 0s | 0s | Class::Accessor::make_wo_accessor |
| 0 | 0 | 0 | 0s | 0s | Class::Accessor::mk_ro_accessors |
| 0 | 0 | 0 | 0s | 0s | Class::Accessor::mk_wo_accessors |
| 0 | 0 | 0 | 0s | 0s | Class::Accessor::new |
| 0 | 0 | 0 | 0s | 0s | Class::Accessor::set |
| Line | Stmts. | Exclusive Time | Avg. | Code |
|---|---|---|---|---|
| 1 | package Class::Accessor; | |||
| 2 | 1 | 31µs | 31µs | require 5.00502; |
| 3 | 3 | 160µs | 53µs | use strict; # spent 7µs making 1 call to strict::import |
| 4 | 1 | 700ns | 700ns | $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 | ||||
| 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 it's 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 | sub 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 | ||||
| 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 288µs (22+266) within Class::Accessor::mk_accessors which was called
# once (22µs+266µs) at line 10 of /usr/share/perl5/MARC/Charset/Code.pm | |||
| 143 | 1 | 6µs | 6µs | my($self, @fields) = @_; |
| 144 | ||||
| 145 | 1 | 14µs | 14µs | $self->_mk_accessors('rw', @fields); # spent 266µs making 1 call to Class::Accessor::_mk_accessors |
| 146 | } | |||
| 147 | ||||
| 148 | ||||
| 149 | { | |||
| 150 | 4 | 1.15ms | 287µs | no strict 'refs'; # spent 24µs making 1 call to strict::unimport |
| 151 | ||||
| 152 | # spent 266µs (146+121) within Class::Accessor::_mk_accessors which was called
# once (146µs+121µs) by Class::Accessor::mk_accessors at line 145 | |||
| 153 | 1 | 5µs | 5µs | my($self, $access, @fields) = @_; |
| 154 | 1 | 800ns | 800ns | my $class = ref $self || $self; |
| 155 | 1 | 6µs | 6µs | my $ra = $access eq 'rw' || $access eq 'ro'; |
| 156 | 1 | 800ns | 800ns | my $wa = $access eq 'rw' || $access eq 'wo'; |
| 157 | ||||
| 158 | 1 | 2µs | 2µs | foreach my $field (@fields) { |
| 159 | 6 | 31µs | 5µs | my $accessor_name = $self->accessor_name_for($field); # spent 32µs making 6 calls to Class::Accessor::accessor_name_for, avg 5µs/call |
| 160 | 6 | 29µs | 5µs | my $mutator_name = $self->mutator_name_for($field); # spent 33µs making 6 calls to Class::Accessor::mutator_name_for, avg 6µs/call |
| 161 | 6 | 3µs | 467ns | 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 | 6 | 6µs | 1µs | if ($accessor_name eq $mutator_name) { |
| 165 | 6 | 1µs | 183ns | my $accessor; |
| 166 | 6 | 28µs | 5µs | if ($ra && $wa) { # spent 56µs making 6 calls to Class::Accessor::make_accessor, avg 9µ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 | 6 | 24µs | 4µs | unless (defined &{"${class}::$accessor_name"}) { |
| 174 | *{"${class}::$accessor_name"} = $accessor; | |||
| 175 | } | |||
| 176 | 6 | 5µs | 767ns | if ($accessor_name eq $field) { |
| 177 | # the old behaviour | |||
| 178 | 6 | 5µs | 783ns | my $alias = "_${field}_accessor"; |
| 179 | 6 | 48µs | 8µs | *{"${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 it's here | |||
| 237 | for orthoginality and because it's 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 32µs within Class::Accessor::accessor_name_for which was called 6 times, avg 5µs/call:
# 6 times (32µs+0s) by Class::Accessor::_mk_accessors at line 159, avg 5µs/call | |||
| 303 | 6 | 9µs | 2µs | my ($class, $field) = @_; |
| 304 | 6 | 6µs | 1µs | return $field; |
| 305 | } | |||
| 306 | ||||
| 307 | # spent 33µs within Class::Accessor::mutator_name_for which was called 6 times, avg 6µs/call:
# 6 times (33µs+0s) by Class::Accessor::_mk_accessors at line 160, avg 6µs/call | |||
| 308 | 6 | 8µs | 1µs | my ($class, $field) = @_; |
| 309 | 6 | 6µs | 983ns | 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 56µs within Class::Accessor::make_accessor which was called 6 times, avg 9µs/call:
# 6 times (56µs+0s) by Class::Accessor::_mk_accessors at line 166, avg 9µs/call | |||
| 383 | 6 | 14µs | 2µs | 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 | 6 | 24µs | 4µs | }; |
| 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 | 150µs | 50µ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 | 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 | ||||
| 496 | Class::Accessor::Fast is faster than methods written by an average programmer | |||
| 497 | (where "average" is based on Schwern's example code). | |||
| 498 | ||||
| 499 | Class::Accessor is slower than average, but more flexible. | |||
| 500 | ||||
| 501 | Class::Accessor::Faster is even faster than Class::Accessor::Fast. It uses an | |||
| 502 | array internally, not a hash. This could be a good or bad feature depending on | |||
| 503 | your point of view. | |||
| 504 | ||||
| 505 | Direct hash access is, of course, much faster than all of these, but it | |||
| 506 | provides no encapsulation. | |||
| 507 | ||||
| 508 | Of course, it's not as simple as saying "Class::Accessor is slower than | |||
| 509 | average". These are benchmarks for a simple accessor. If your accessors do | |||
| 510 | any sort of complicated work (such as talking to a database or writing to a | |||
| 511 | file) the time spent doing that work will quickly swamp the time spend just | |||
| 512 | calling the accessor. In that case, Class::Accessor and the ones you write | |||
| 513 | will be roughly the same speed. | |||
| 514 | ||||
| 515 | ||||
| 516 | =head1 EXAMPLES | |||
| 517 | ||||
| 518 | Here's an example of generating an accessor for every public field of | |||
| 519 | your 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 | ||||
| 548 | Here'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 | ||||
| 575 | Class::Accessor has to do some internal wackiness to get its | |||
| 576 | job done quickly and efficiently. Because of this, there's a few | |||
| 577 | tricks and traps one must know about. | |||
| 578 | ||||
| 579 | Hey, nothing's perfect. | |||
| 580 | ||||
| 581 | =head2 Don't make a field called DESTROY | |||
| 582 | ||||
| 583 | This is bad. Since DESTROY is a magical method it would be bad for us | |||
| 584 | to define an accessor using that name. Class::Accessor will | |||
| 585 | carp if you try to use it with a field named "DESTROY". | |||
| 586 | ||||
| 587 | =head2 Overriding autogenerated accessors | |||
| 588 | ||||
| 589 | You may want to override the autogenerated accessor with your own, yet | |||
| 590 | have your custom accessor call the default one. For instance, maybe | |||
| 591 | you want to have an accessor which checks its input. Normally, one | |||
| 592 | would 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 | ||||
| 614 | There's a subtle problem in the last example, and it's in this line: | |||
| 615 | ||||
| 616 | return $self->SUPER::email(@_); | |||
| 617 | ||||
| 618 | If we look at how Foo was defined, it called mk_accessors() which | |||
| 619 | stuck email() right into Foo's namespace. There *is* no | |||
| 620 | SUPER::email() to delegate to! Two ways around this... first is to | |||
| 621 | make a "pure" base class for Foo. This pure class will generate the | |||
| 622 | accessors 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 | ||||
| 631 | And now Foo::email() can override the generated | |||
| 632 | Pure::Organic::Foo::email() and use it as SUPER::email(). | |||
| 633 | ||||
| 634 | This is probably the most obvious solution to everyone but me. | |||
| 635 | Instead, what first made sense to me was for mk_accessors() to define | |||
| 636 | an alias of email(), _email_accessor(). Using this solution, | |||
| 637 | Foo::email() would be written with: | |||
| 638 | ||||
| 639 | return $self->_email_accessor(@_); | |||
| 640 | ||||
| 641 | instead of the expected SUPER::email(). | |||
| 642 | ||||
| 643 | ||||
| 644 | =head1 AUTHORS | |||
| 645 | ||||
| 646 | Copyright 2007 Marty Pauley <marty+perl@kasei.com> | |||
| 647 | ||||
| 648 | This program is free software; you can redistribute it and/or modify it under | |||
| 649 | the same terms as Perl itself. That means either (a) the GNU General Public | |||
| 650 | License or (b) the Artistic License. | |||
| 651 | ||||
| 652 | =head2 ORIGINAL AUTHOR | |||
| 653 | ||||
| 654 | Michael G Schwern <schwern@pobox.com> | |||
| 655 | ||||
| 656 | =head2 THANKS | |||
| 657 | ||||
| 658 | Liz and RUZ for performance tweaks. | |||
| 659 | ||||
| 660 | Tels, for his big feature request/bug report. | |||
| 661 | ||||
| 662 | ||||
| 663 | =head1 SEE ALSO | |||
| 664 | ||||
| 665 | L<Class::Accessor::Fast> | |||
| 666 | ||||
| 667 | These are some modules which do similar things in different ways | |||
| 668 | L<Class::Struct>, L<Class::Methodmaker>, L<Class::Generate>, | |||
| 669 | L<Class::Class>, L<Class::Contract> | |||
| 670 | ||||
| 671 | L<Class::DBI> for an example of this module in use. | |||
| 672 | ||||
| 673 | =cut | |||
| 674 | ||||
| 675 | 1 | 7µs | 7µs | 1; |