package Person; use strict; use Carp;

use vars qw($AUTOLOAD %ok fielcl); » Проверка четырех атрибутов

for my Sattr ( qw(name age peers parent) ) { $ok fielcl{$attr}++; }

sub AUTOLOAD {

my $self = shift; my $attr = SAUTOLOAD; Sattr =~ s/..;; ;

return unless Sattr = /["A-Z]/; # Пропустить DESTROY и другие

# методы, имена которых

# записаны в верхнем регистре croak "invalid attribute method: ->Sattr()" unless Sok field{Sattr}; $self->{uc Sattr) = shift if @ ;

return Sself->{uc Sattr};

sub new {

my Sproto = shift;

my Sclass = ref(Sproto) Sproto;

my Sparent = ref(Sproto) && Sproto;

my Sself = {};

bless($self, Sclass);

$self->parent($parent);

return Sself;

Класс содержит конструктор new и четыре метода атрибутов: name, age, peers и parent. Модуль используется следующим образом:

use Person; my (Sdad, Skid); $dad = Person->new; $dad->name("Jason"); $dad->age(23); Skid = Sdad->new; Skid->name("Rachel"); Skid->age(2);

printf "Kids parent is %s\n", Skid->parent->name; Jason

В иерархиях наследования это рещение вызывает некоторые затруднения. Предположим, вам понадобился класс Employee, который содержит все атрибуты данных класса Person и еще два атрибута (например, salary и boss). Класс Employee не может определять методы своих атрибутов с помощью унаследованного варианта Person:: AUTOLOAD - следовательно, каждому классу нужна собственная функция AUTOLOAD. Она проверяет атрибуты данного класса, но вместо вызова сгоак при отсутствии атрибута вызывает переопределенную версию суперкласса.

13.12. Решение проблемы наследования данных 477

С учетом этого AUTOLOAD может выглядеть так:

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 Ssuperior = "SUPER;:$attr",

$self->$superior(@ );

Если атрибут отсутствует в списке, мы передаем его суперклассу, надеясь, что он справится с его обработкой. Однако такой вариант AUTOLOAD наследовать нельзя; каждый класс должен иметь собственную версию, поскольку работа с данными осуществляется напрямую, а не через объект.

Еще худшая ситуация возникает, если класс А наследует от классов В и С, каждый из которых определяет собственную версию AUTOLOAD - в этом случае при вызове неопределенного метода А будет вызвана функция AUTOLOAD лишь одного из двух родительских классов.

С этими ограничениями можно было бы справиться, но всевозможные заплатки, исправления и обходные пути вскоре начинают громоздиться друг на друге. Для сложных ситуаций существуют более удачные решения.

> Смотри также-

Рецепты 10.15; 13.12. Пример использования AUTOLOAD приведен в per/toot(l).

13.12. Решение проблемы наследования данных

Проблема

Вы хотите унаследовать от существующего класса и дополнить его несколькими новыми методами, но не знаете, какие поля данных используются родительским классом. Как безопасно дополнить хэш объекта новым пространством имен и не повредить данные предков?

Решение

Снабдите каждое имя поля префиксом, состоящим из имени класса и разделителя, - например, одного или двух подчеркиваний.

Комментарий

в недрах стандартной объектно-ориентированной стратегии Perl спрятана одна неприятная проблема: знание точного представления класса нарушает иллюзию абстракции. Субкласс должен находиться в чрезвычайно близких отношениях со своими базовыми классами.

Давайте сделаем вид, что все мы входим в одну счастливую объектно-ориентированную семью и объекты всегда реализуются с помощью хэшей - мы попросту игнорируем классы, в чьих представлениях используются массивы, и наследуем лишь от классов на основе модели хэша (как показано в perlbot(i), эта проблема решается с помощью агрегирования и делегирования). Но даже с таким предположением наследующий класс не может с абсолютной уверенностью работать с ключами хэша. Даже если мы согласимся ограничиваться методами доступа для работы с атрибутами, значения которых задавались не нами, как узнать, что устанавливаемый нами ключ не используется родительским классом? Представьте себе, что в вашем классе используется поле count, но поле с таким же именем встречается в одном из пра-пра-правнуков. Имя count (подчеркивание обозначает номинальную закрытость) не поможет, поскольку потомки могут сделать то же самое.

Одно из возможных решений - использовать для атрибутов префиксы, совпадающие с именем пакета. Следовательно, если вы хотите создать поле age в классе Employee, для обеспечения безопасности можно воспользоваться Егар1оуее аде. Метод доступа может выглядеть так:

sub Employee-.age { my Sself = shift;

$self->{Employee age} = shift if @ ; return $self->{Employee age);

Модуль Class::Spirit, описанный в рецепте 13.5, предоставляет еще более радикальное решение. Представьте себе один файл:

package Person,

use Class Attributes; # Объясняется ниже mkattr qw(name age peers parent),

и другой файл:

package Employee, @ISA = qw(Person); use Class.:Attributes; mkattr qw(salary age boss);

Вы обратили внимание на общий атрибут age? Если эти атрибуты должны быть логически раздельными, то мы не сможем использовать $self->{age} даже для текущего объекта внутри модуля! Проблема решается следующей реализацией функции Class;:Attributes::mkattr;

package Class;:Attributes; i

use strict, use Carp,