correspond to the names of your accessors, so...
package Foo;
use base qw(Class::Accessor);
Foo->mk_accessors('foo');
my $obj = Class->new({ foo => 42 });
print $obj->foo; # 42
however %fields can contain anything, new() will shove them all into
your object. Don't like it? Override it.
=cut
sub new {
my($proto, $fields) = @_;
my($class) = ref $proto || $proto;
$fields = {} unless defined $fields;
# make a copy of $fields.
bless {%$fields}, $class;
}
=head2 mk_accessors
Class->mk_accessors(@fields);
This creates accessor/mutator methods for each named field given in
@fields. Foreach field in @fields it will generate two accessors.
One called "field()" and the other called "_field_accessor()". For
example:
# Generates foo(), _foo_accessor(), bar() and _bar_accessor().
Class->mk_accessors(qw(foo bar));
See L<CAVEATS AND TRICKS/"Overriding autogenerated accessors">
for details.
=cut
sub mk_accessors {
my($self, @fields) = @_;
$self->_mk_accessors('rw', @fields);
}
{
no strict 'refs';
sub _mk_accessors {
my($self, $access, @fields) = @_;
my $class = ref $self || $self;
my $ra = $access eq 'rw' || $access eq 'ro';
my $wa = $access eq 'rw' || $access eq 'wo';
foreach my $field (@fields) {
my $accessor_name = $self->accessor_name_for($field);
my $mutator_name = $self->mutator_name_for($field);
if( $accessor_name eq 'DESTROY' or $mutator_name eq 'DESTROY' ) {
$self->_carp("Having a data accessor named DESTROY in '$class' is unwise.");
}
if ($accessor_name eq $mutator_name) {
my $accessor;
if ($ra && $wa) {
$accessor = $self->make_accessor($field);
} elsif ($ra) {
$accessor = $self->make_ro_accessor($field);
} else {
$accessor = $self->make_wo_accessor($field);
}
unless (defined &{"${class}::$accessor_name"}) {
*{"${class}::$accessor_name"} = $accessor;
}
if ($accessor_name eq $field) {
# the old behaviour
my $alias = "_${field}_accessor";
*{"${class}::$alias"} = $accessor unless defined &{"${class}::$alias"};
}
} else {
if ($ra and not defined &{"${class}::$accessor_name"}) {
*{"${class}::$accessor_name"} = $self->make_ro_accessor($field);
}
if ($wa and not defined &{"${class}::$mutator_name"}) {
*{"${class}::$mutator_name"} = $self->make_wo_accessor($field);
}
}
}
}
sub follow_best_practice {
my($self) = @_;
my $class = ref $self || $self;
*{"${class}::accessor_name_for"} = \&best_practice_accessor_name_for;
*{"${class}::mutator_name_for"} = \&best_practice_mutator_name_for;
}
}
=2= |