ЭЛЕКТРОННАЯ БИБЛИОТЕКА КОАПП |
Сборники Художественной, Технической, Справочной, Английской, Нормативной, Исторической, и др. литературы. |
13.11. Generating Attribute Methods Using AUTOLOADProblemYour object needs accessor methods to set or get its data fields, and you're tired of writing them all out one at a time. SolutionCarefully use Perl's AUTOLOAD mechanism as a proxy method generator so you don't have to create them all yourself each time you want to add a new data field. DiscussionPerl's AUTOLOAD mechanism intercepts all possible undefined method calls. So as not to permit arbitrary data names, we'll store the list of permitted fields in a hash. The AUTOLOAD method will check to verify that the accessed field is in that hash. package Person;
use strict;
use Carp;
use vars qw($AUTOLOAD %ok_field);
# Authorize four attribute fields
for my $attr ( qw(name age peers parent) ) { $ok_field{$attr}++; }
sub AUTOLOAD {
my $self = shift;
my $attr = $AUTOLOAD;
$attr =~ s/.*:://;
return unless $attr =~ /[^A-Z]/; # skip DESTROY and all-cap methods
croak "invalid attribute method: -> This class supports a constructor named use Person;
my ($dad, $kid);
$dad = Person->new;
$dad->name("Jason");
$dad->age(23);
$kid = $dad->new;
$kid->name("Rachel");
$kid->age(2);
printf "Kid's parent is %s\n", $kid->parent->name;
This is tricky when producing inheritance trees. Suppose you'd like an Employee class that had every data attribute of the Person class, plus two new ones, like Here's a version that takes this into consideration: sub AUTOLOAD { my $self = shift; my $attr = $AUTOLOAD; $attr =~ s/.*:://; return if $attr eq 'DESTROY'; if ($ok_field{$attr}) { $self->{uc $attr} = shift if @_; return $self->{uc $attr}; } else { my $superior = "SUPER::$attr"; $self->$superior(@_); } } If the attribute isn't in our OK list, we'll pass it up to our superior, hoping that it can cope with it. But you can't inherit this We could try to cope with these limitations, but See AlsoThe examples using AUTOLOAD in perltoot (1); Chapter 5 of Programming Perl; Recipe 10.15; Recipe 13.12 |