HTML page
 |
 |
13.6. Клонирование объектов
Проблема
Вы хотите написать конструктор, который может вызываться для существующего объекта.Решение
Начните свой конструктор примерно так:my $proto = shift;
mу $class = ref($proto) || $proto;
mу $parent = ref($proto) && $proto;
Переменная $class содержит класс, к которому выполняется приведение, а переменная $parent либо равна false, либо ссылается на клонируемый объект.
Комментарий
Иногда требуется создать объект, тип которого совпадает с типом другого, существующего объекта. Вариант:$ob1 = SomeClass->new();
# Далее
$ob2 = (ref $ob1)->new();
выглядит не очень понятно. Вместо этого хотелось бы иметь конструктор, который может вызываться для класса или существующего объекта. В качестве метода класса он возвращает новый объект, инициализированный по умолчанию, В качестве метода экземпляра он возвращает новый объект, инициализированный данными объекта, для которого он был вызван:
$ob1 = widget->new();
$ob2 = $ob1->new();
Следующая версия new учитывает эти соображения:
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my $parent = ref($proto) && $proto;
my $self;
# Проверить, переопределяется ли new из @ISA
if (@ISA && $proto->SUPER::can('new') {
$self = $proto->SUPER: :new((">_);
} else {
$self = {};
bless ($self, $proto);
} bless($self, $class);
$self->{PARENT} = $parent;
$self->{START} = time(); # Инициализировать поля данных
$self->{AGE} = 0;
return $self;
}
Инициализация не сводится к простому копированию данных из объекта-ири-тотппа. Если вы пишете класс связанного списка или бинарного дерева, при вызове в качестве метода экземпляра ваш конструктор может вернуть новый объект, включенный в дерево или список.
> Смотри также ------------------------------- perlobj(1); рецепты 13.1; 13.9; 13.13.
13.7. Косвенный вызов методов
Проблема
Требуется вызвать метод по имени, которое станет известно лишь во время выполнения программы.Решение
Сохраните имя метода в строковом виде в скалярной переменной и укажите имя переменной там, где обычно указывается имя метода - справа от оператора ->:$methname = "flicker";
$obj->$methname(10); # Вызывает
$ob->riicker(10);
# Три метода объекта вызываются по именам
foreach $m ( qw(start run stop) ) { $obj->$m();
}
Комментарий
Имя метода не всегда известно на стадии компиляции. Как известно, получить адрес метода нельзя, но можно сохранить его имя. Если имя хранится в скалярной переменной $meth, то для объекта $crystal этот метод вызывается так:$crystal->$meth().
@methods = qw(name rank serno);
%his_info = map { $_ => $ob->$_() } @methods:
# Эквивалентно:
%his_info = (
'name' => $ob->name(),
'rank' => $ob->rank(),
'serno' => $ob->serno(), );
Если вам никак не обойтись без получения адреса метода, попробуйте переосмыслить свой алгоритм. Например, вместо неправильной записи \$ob->method(), при которой применяется к возвращаемому значению или значениям метода, поступите следующим образом:
my $fnref = sub { $ob->method(@_) };
Когда придет время косвенного вызова этого метода, напишите:
$fnref->(10, "fred");
# это даст правильный вызов метода:
$obj->method(10, "fred");
Такое решение работает даже в том случае, если $ob находится вне области действия и потому является предпочтительным. Ссылку на код, возвращаемую методом сап() класса UNIVERSAL, вероятно, не следует использовать для косвенного вызова методов. Нельзя быть уверенным в том, что она будет соответствовать правильному методу для объекта произвольного класса. Например, следующий фрагмент крайне сомнителен:
$obj->can('method_name')->($obj_target, arguments) vif $obj_target->isa( ref $obj );
Ссылка, возвращаемая can, может и не соответствовать правильному методу для $obj2. Вероятно, разумнее ограничиться проверкой метода сап() в логическом условии.
> Смотри также -------------------------------
perlobj(1); рецепт 11.8.
13.8. Определение принадлежности субкласса
Проблема
Требуется узнать, является ли объект экземпляром некоторого класса или одной i из его субклассов. Например, надо выяснить, можно ли вызвать для объекта неко торый метод.Решение
Воспользуйтесь методами специального класса UNIVERSAL:$obj->isa("HTTP::Message"); # Как метод объекта
HTTP::Response->isa("HTTP::Message"); # Как метод класса
if ($obj->can("method_name")) {....} # Проверка метода
Комментарий
Для нас было бы очень удобно, чтобы все объекты в конечном счете происходили от общего базового класса. Тогда их можно было бы наделить общими методами, не дополняя по отдельности каждый массив @>ISA. В действительности такая возможность существует. Хотя вы этого не видите, но Perl считает, что в конце @ISA находится один дополнительный элемент - пакет с именем NIVERSAL.В версии 5.003 класс UNIVERSAL не содержал ни одного стандартного метода, но вы могли занести в него все, что считали нужным. Однако в версии 5.004 UNIVERSA1 уже содержит несколько методов. Они встроены непосредственно в двоичный файл Perl и потому на их загрузку не расходуется дополнительное время. К числу стандартных методов относятся isa, can и VERSION. Метод isa сообщает, "является ли" (is а) объект или класс чем-то другим, избавляя вас от необходимости самостоятельно просматривать иерархию:
$has_io = $fd->isa("IO::Handle");
$itza_handle = 10::socket->isa("IO::Handle");
Также существует мнение, что обычно лучше попробовать вызвать метод. Считается, что явные проверки типов вроде показанной выше слишком ограничивают свободу действий. Метод can вызывается для объекта или класса и сообщает, соответствует ли его строковый аргумент допустимому имени метода для данного класса. Он возвращает ссылку на функцию данного метода:
$his_print_method = $obj->can(' as_string');
Наконец, метод VERSION проверяет, содержит ли класс (или класс объекта) пакетную глобальную переменную $VERSION с достаточно высоким значением:
Some_Module->VERSION(3.0);
$his_vers = $obj->VERSION();
Тем не менее нам обычно не приходится вызывать VERSION самим. Вспомните: имена функций, записанные в верхнем регистре, означают, что функция вызывается Perl автоматически. В нашем случае это происходит, когда в программе встречается строка вида:
use Some_Module 3.0;
Если вам захочется включить проверку версии в класс Person, описанный выше, юбавьте в файл Person.pm следующий фрагмент:
use vars qw($VERSION);
$VERSION = '1.01';
Затем в пользовательской программе ставится команда use Person 1.01; -это позволяет проверить версию и убедиться в том, что она равна указанной или превышает ее. Помните, что версия не обязана точно совпадать с указанной, а должна быть не меньше ее. Впрочем, в настоящее время параллельная установка нескольких версий одного модуля не поддерживается.
> Смотри также --------------------------------
Документация но стандартному модулю UNIVERSAL. Ключевое слово use описано Qperlfunc(\).
13.9. Создание класса с поддержкой наследования
Проблема
Вы не уверены в том, правильно ли вы спроектировали свой класс и может ли он использоваться в наследовании.Решение
Воспользуйтесь "проверкой пустого субкласса".Комментарий
Допустим, вы реализовали класс Person с конструктором new и методами аде и name. Тривиальная реализация выглядит так:package Person;
sub new {
my $class = shift;
my $self = { };
return bless $self, $class;
}
SUD name {
my $.self = shift;
$self->{NAME} = shift if @_;
return $self->{NAME};
} sub age {
my $self = shift;
$self->{AGE} = shift if @_;
return $self->{AGE};
}
Пример использования класса может выглядеть так:
use Person;
my $dude = person->new.();
$dude->name("Jason");
$dude->age(23);
printf "%s is age %d.\n", $dude->name, $dude->age;
Теперь рассмотрим другой класс с именем Employee: package Employee;
use Person;
@ISA = ("person");
1;
Ничего особенно интересного. Класс всего лишь загружает класс Person и заявляет, что все необходимые методы Employee наследует от Person. Поскольку Employee не имеет собственных методов, он получит от Person все методы.
Мы хотим, чтобы поведение класса Person полностью воспроизводилось в Employee. Создание подобных пустых классов называется "проверкой пустого субкласса"; иначе говоря, мы создаем производный класс, который не делает ничего, кроме наследования от базового. Если базовый класс спроектирован нормально, то производный класс в точности воспроизведет его поведение. Это означает, что при простой замене имени класса все остальное будет работать:
use Employee;
my $empl = employee->new();
$empl->name("Jason");
$empl->age(23);
printf "%s is age %d.\n",
$empl->name, $empl->age;
Под "нормальным проектированием" имеется в виду использование только двухаргументной формы bless, отказ от прямого доступа к данным класса и отсутствие экспортирования. В определенной выше функции Person:: new() мы проявили необходимую осторожность: в конструкторе используются некоторые пакетные данные, но ссылка на них хранится в самом объекте. Другие методы обращаются к пакетным данным через эту ссылку, поэтому проблем быть не должно.
Но почему мы сказали "функции Person ::new()" - разве это не метод? Дело в том, что метод представляет собой функцию, первый аргумент которой определяет имя класса (пакет) или объект (приведенную ссылку). Person:: new - это функция, которая в конечном счете вызывается методами Person->new и Employee->new. Хотя вызов метода очень похож на вызов функции, они все же отличаются. Если вы начнете путать функции с методами, то очень скоро у вас не останется ничего, кроме неработающих программ. Во-первых, функции отличаются от методов фактическими конвенциями вызова - метод вызывается с дополнительным аргументом. Во-вторых, вызовы функций не поддерживают наследования, а методы - поддерживают. Если вы привыкнете к вызовам вида: Вызов метода Вызов функции Person->new()
Person::new("Pcrson") Employee->new()
Person::new("Employee")
$him = person::new(); # НЕВЕРНО в программе возникнет нетривиальная проблема, поскольку функция не получит ожидаемого аргумента "Person" и не сможет привести его к переданному классу. Еще хуже, если вам захочется вызвать функцию Employee:: new(). Такой функции не существует! Это всего лишь вызов унаследованного метода. Мораль: не вызывайте функции там, где нужно вызывать методы.
> Смотри также --------------------------------
perltoot(1),perlobj(1) и perlbot{1); рецепты 13.1; 13.10.
13.10. Вызов переопределенных методов
Проблема
Конструктор переопределяет конструктор суперкласса. Вы хотите вызвать конструктор суперкласса из своего конструктора.Решение
Используйте специальный класс, SUPER:sub meth {
my $self = shift;
$self->SUPER::meth():
}
Комментарий
В таких языках, как C++, где конструкторы не выделяют память, а ограничиваются инициализацией объекта, конструкторы базовых классов вызываются автоматически. В таких языках, как Java и Perl, приходится вызывать их самостоятельно. Для вызова методов конкретного класса используется формулировка $self-SUPER: :meth(). Она представляет собой расширение обычной записи с началом поиска в определенном базовом классе и допустима только в переопределенных методах. Сравните несколько вариантов:$self->meth(); # Вызвать первый найденный meth
$self->Where::meth(); # Начать поиск с пакета "Where"
$self->SUPER::meth(); # Вызвать переопределенную версию
Вероятно, простым пользователям класса следует ограничиться первым вариантом. Второй вариант возможен, но не рекомендуется. Последний вариант м.',1:ст вызываться только в переопределенном методе.
Переопределяющий конструктор должен вызвать конструктор своего к.чагса SUPER, в котором выполняется выделение памяти и приведение объекта, и ограничиться инициализацией нолей данных. В данном случае код выделения памяти желательно отделять от кода инициализации объекта. Пусть имя начинается с символа подчеркивания - условного обозначения номинально закрытого метода, аналога таблички "Руками не трогать".
sub new {
my $classname = shift; # Какой класс мы конструируем?
my $self = $classname->SUPER::new(@>_);
$self->_init(@_):
return $self; # Вернуть
}
sub _init {
my $self = shift;
$self->{START} = time(); # Инициализировать поля данных
$self->{AGE} = 0;
$self->{EXTRA} = { @_ }; # Прочее
}
И SUPER: : new и _init вызываются со всеми остальными аргументами, что позволяет передавать другие инициализаторы полей:
$obj = widget->new( haircolor => red, freckles => 121 ); Стоит ли сохранять пользовательские параметры в отдельном хэше - решайте сами. Обратите внимание: SUPER работает только для первого переопределенного метода. Если в массиве @ISA перечислено несколько классов, будет обработан только первый. Ручной перебор @ISA возможен, но, вероятно, не оправдывает затраченных усилий.
my $self = bless {}, $class;
for my $class (@ISA) {
my $meth = $class . "::_init";
$self->$meth(@_) if $class->can("_init");
} В этом ненадежном фрагменте предполагается, что все суперклассы инициализируют свои объекты не в конструкторе, а в _init. Кроме того, предполагается, что объект реализуется через ссылку на хэш.
> Смотри также -------------------------------
Класс SUPER рассматривается в perltoot( 1) nperlobj(i).
13.11. Генерация методов доступа с помощью AUTOLOAD
Проблема
Для работы с полями данных объекта нужны методы доступа, а вам не хочется писать повторяющийся код.Решение
Воспользуйтесь механизмом AUTOLOAD для автоматического построения методов доступа - это позволит обойтись без самостоятельного написания методов при добавлении новых полей данных.Комментарий
Механизм AUTOLOAD перехватывает вызовы неопределенных методов. Чтобы ограничиться обращениями к полям данных, мы сохраним список допустимых полей в хэше. Метод AUTOLOAD будет проверять, присутствует ли в хэше запрашиваемое поле.package Person;
use strict;
use Carp;
use vars qw($AUTOLOAD %ok_field);
# Проверка четырех атрибутов
for my $attr ( qw(name age peers parent))
sub AUTOLOAD {
my $self = shift;
my $attr = $autoload;
$attr =~ s/.*:://;
return unless $attr =~ /["a-z]/;
# Пропустить DESTROY и другие
# методы, имена которых
# записаны в верхнем регистре
croak "invalid attribute method:->$attr()" unless $ok_field{$attr}; br>$self->{uc $attr} = shift if @_;
return $self->{uc $attr};
}
sub new{
my $proto=shift;
my $class =ref($proto) || $proto;
my $parent =ref($proto) && $proto;
my $self = {}
bless($self, $class);
$self->parent($parent)
return $self;
}
Класс содержит конструктор new и четыре метода атрибутов: name, age, peers и parent. Модуль используется следующим образом:
use Person;
my ($dad, $kid);
$dad = person->new;
$dad->name("Jason");
$dad->age(23);
Skid = $dad->new;
$kid->name("Rachel");
$kid->age(2);
printf "Kid's parent is %s\n", $kid->parent->name;
Jason
В иерархиях наследования это решение вызывает некоторые затруднения, Предположим, вам понадобился класс Employee, который содержит все атрибуты данных класса Person и еще два атрибута (например, salary и boss). Класс Employee не может определять методы своих атрибутов с помощью унаследова ного варианта Person: : AUTOLOAD - следовательно, каждому классу нужна собстве| ная функция AUTOLOAD. Она проверяет атрибуты данного класса, но вместо вызов croak при отсутствии атрибута вызывает переопределенную версию суперкла С учетом этого 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 @i_;
return $self->{uc $attr};
} else {
my $superlor = "super::$attr";
$self->$superlor(@_);
}
}
Если атрибут отсутствует в списке, мы передаем его суперклассу, надеясь, что он справится с его обработкой. Однако такой вариант AUTOLOAD наследовать нельзя; каждый класс должен иметь собственную версию, поскольку работа с данными осуществляется напрямую, а не через объект.
Еще худшая ситуация возникает, если класс А наследует от классов В и С, каждый из которых определяет собственную версию AUTOLOAD - в этом случае при вызове неопределенного метода А будет вызвана функция AUTOLOAD лишь одного из двух родительских классов. С этими ограничениями можно было бы справиться, но всевозможные заплатки, исправления и обходные пути вскоре начинают громоздиться друг на друге. Для сложных ситуаций существуют более удачные решения.
> Смотри также ------------------------------
Рецепты 10.15; 13.12. Пример использования AUTOLOAD приведен vperltoot{\).
13.12. Решение проблемы наследования данных
Проблема
Вы хотите унаследовать от существующего класса и дополнить его несколькими новыми методами, но не знаете, какие поля данных используются родительским классом. Как безопасно дополнить хэш объекта новым пространством имен и не ювредить данные предков?Решение
Снабдите каждое имя поля префиксом, состоящим из имени класса и разделителя, - например, одного или двух подчеркиваний.Комментарий
В недрах стандартной объектно-ориентированной стратегии Perl спрятана одна неприятная проблема: знание точного представления класса нарушает иллюзию абстракции. Субкласс должен находиться в чрезвычайно близких отношениях со своими базовыми классами. Давайте сделаем вид, что все мы входим в одну счастливую объектно-ориентированную семью и объекты всегда реализуются с помощью хэшей - мы попросту игнорируем классы, в чьих представлениях используются массивы, и наследуем лишь от классов на основе модели хэша (как показано в perlbot(1), эта проблема решается с помощью агрегирования и делегирования). Но даже с таким предположением наследующий класс не может с абсолютной уверенностью работать с ключами хэша. Даже если мы согласимся ограничиваться методами доступа для работы с атрибутами, значения которых задавались не нами, как узнать, что устанавливаемый нами ключ не используется родительским классом? Представьте себе, что в вашем классе используется поле count, но поле с таким же именем встречается в одном из пра-пра-правнуков. Имя "count (подчеркивание обозначает номинальную закрытость) не поможет, поскольку потомки могут сделать то же самое.Одно из возможных решений - использовать для атрибутов префиксы, совпадающие с именем пакета. Следовательно, если вы хотите создать поле аде в классе Employee, для обеспечения безопасности можно воспользоваться Employee_age. Метод доступа может выглядеть так:
sub Employee::age {
my $self = 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;
use strict;
use Carp;
use Exporter ();
use vars qw(@ISA EXPORT);
@ISA = qw(exporter);
@EXPORT = qw(mkattr);
sub mkattr {
my $hispack = caller();
for my $attr ((a>_) {
my($field, $method);
$method = "${hispack}::$attr";
($field = $method) =~ s/:/_/g;
no strict 'refs';
*$method = sub {
my $self = shift;
confess "too many arguments" if @_ > 1 $self->{$field} = shift if @_;
return $self->{$field};
};
}
}
1;
В этом случае $self->{Person_age} и $self->{Employee_age} остаются раздельными. Единственная странность заключается в том, что $obj->age даст лишь первый из двух атрибутов. В принципе атрибуты можно было бы различать с помощью формулировок $obj->Person: :age и $obj->Employee:: age, но грамотно написанный код Perl не должен ссылаться на конкретный пакет с помощью : :, за исключением крайних случаев. Если это оказывается неизбежным, вероятно, ваша библиотека спроектирована не лучшим образом. Если вам не нравится подобная запись, то внутри класса Person достаточно использовать age($self), и вы всегда получите age класса Person, тогда как в классе Employee age($self) дает версию age класса Employee. Это объясняется тем, что мы вызываем функцию, а не метода.
[> Смотри также -------------------------------
Документация по директивам use fields и use base для Perl версии 5.005; рецепт 10.14.
13.13. Использование циклических структур данных
Проблема
Имеется структура данных, построенная на циклических ссылках. Система сборки мусора Perl, использующая подсчет ссылок, не заметит, когда данная структура перестает использоваться. Вы хотите предотвратить утечки памяти в программе.Решение
Создайте не-циклический объект-контейнер, содержащий указатель на структуру данных с циклическими ссылками. Определите для объекта-контейнера метод DESTROY, который вручную уничтожает циклические ссылки.Комментарий
Многие интересные структуры данных содержат ссылки на самих себя. Например, это может происходить в простейшем коде:$node->{NEXT-} = $node;
Как только в вашей программе встречается такая команда, возникает цикличность, которая скрывает структуру данных от системы сборки мусора Perl с подсчетом ссылок. В итоге деструкторы будут вызваны при выходе из программы, но иногда ждать долго не хочется. Связанный список также обладает циклической структурой: каждый узел со держит указатель на следующий узел, указатель на предыдущий узел и значение текущего узла. Если реализовать его на Perl с применением ссылок, появится циклический набор ссылок, которые также не будут автоматически уничтожаться с исчезновением внешних ссылок на узлы. Проблема не решается и созданием узлов, представляющих собой экземпляры специального класса Ring. На самом деле мы хотим, чтобы данная структура уничтожалась Perl по общим правилам - а это произойдет в том случае, если объект реализуется в виде структуры, содержащей ссылку на цикл. В следующем примере ссылка хранится в поле "DUMMY":
package Ring;
# Вернуть пустую циклическую структуру
sub new {
my $class = shift;
my $node = { };
$node->{NEXT} = $node->{PREV} = $node;
my $self = { dummy => $node, COUNT => 0 };
bless $self, $class;
return $self;
}
Цикличностью обладают узлы кольца, но не сам возвращаемый объект-кольцо Следовательно, следующий фрагмент не вызовет утечек памяти:
use Ring;
$COUNT = 1000;
for (1 ., 20) {
my $r = ring->new();
for ($i =0; $i < $COUNT; $i++) { $r->insert($i) } }
Даже если мы создадим двадцать колец по тысяче узлов, то перед созданием нового кольца старое будет уничтожено. Пользователю класса не придется o"oсс- покоиться об освобождении памяти в большей степени, чем для простых строк. Иначе говоря, все происходит автоматически, как и должно происходить. Однако при реализации класса необходимо написать деструктор, который вручную уничтожает узлы:
# При уничтожении Ring уничтожить содержащуюся в нем кольцевую структуру
sub DESTROY {
my $ring = shift;
my $node;
for ( $node = $nng->{DUMMY}->{NEXT};
$node != $ring->{DUMMY}:
$node = $node->{NEXT} ) {
$ring->delete_node($node);
} $node->{PREV} = $node->{NEXT} = undef:
}
# Удалить узел из циклической структуры
sub delete_node {
my ($ring, $node) = @_;
$node->{PREV}->{NEXT} = $node->{NEXT};
$node->{NEXT}->{PREV} = $node->{PREV};
--$ring->{COUNT};
}
Ниже приведено еще несколько методов, которые следовало бы включить в класс. Обратите внимание на то, что вся реальная работа выполняется с помощью циклических ссылок, скрытых внутри объекта:
# $node = $ring->search( $value ) : найти $value в структуре $ring
sub search {
my ($ring, $value) = @_;
my $node = $ring->{DUMMY}->{NEXT};
while ($node != $ring->{DUMMY} && $node->{VALUE} != $value)
{ $node = $node->{NEXT};
}
return $node;
}
# $ring->insert( $value ) : вставить $value в структуру $ring
sub insert_value {
my ($ring, $value) = @_;
my $node = { value => $value };
$node->{NEXT} = $ring->{DUMMY}->{NEXT}:
$ring->{DUMMY}->{NEXT}->{PREV} = $node;
$ring->{DUMMY}->{NEXT} = $node;
$node->{PREV} = $ring->{DUMMY},
++$ring->{COUNT};
}
# $ring->delete_value( $value ) : удалить узел по значению
sub delete_value {
my ($ring, $value) = @_;
my $node = $ring->search($value);
return if $node == $ring->{DUMMY};
$ring->delete_node($node);
}
1;
> Смотри также
Раздел "Garbage Collection" perlobj(1).
|
|
|