Вы хотите написать конструктор, который может вызываться для существующего объекта.
Решение
Начните свой конструктор примерно так:
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.
Требуется вызвать метод по имени, которое станет известно лишь во время выполнения программы.
Решение
Сохраните имя метода в строковом виде в скалярной переменной и укажите имя переменной там, где обычно указывается имя метода - справа от оператора ->:
$methname = "flicker";
$obj->$methname(10); # Вызывает
$ob->riicker(10);
# Три метода объекта вызываются по именам
foreach $m ( qw(start run stop) ) { $obj->$m();
}
Требуется узнать, является ли объект экземпляром некоторого класса или одной i из его субклассов. Например, надо выяснить, можно ли вызвать для объекта неко торый метод.
Решение
Воспользуйтесь методами специального класса UNIVERSAL:
$obj->isa("HTTP::Message"); # Как метод объекта HTTP::Response->isa("HTTP::Message"); # Как метод класса
if ($obj->can("method_name")) {....} # Проверка метода
Комментарий
Для нас было бы очень удобно, чтобы все объекты в конечном счете происходили от общего базового класса. Тогда их можно было бы наделить общими методами, не дополняя по отдельности каждый массив @>ISA. В действительности такая возможность существует. Хотя
В версии 5.003 класс UNIVERSAL не содержал ни одного стандартного метода, но вы могли занести в него все, что считали нужным. Однако в версии 5.004 UNIVERSA1 уже содержит несколько методов. Они встроены непосредственно в двоичный файл Perl и потому на
$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(\).
Вы не уверены в том, правильно ли вы спроектировали свой класс и может ли он использоваться в наследовании.
Решение
Воспользуйтесь "проверкой пустого субкласса".
Комментарий
Допустим, вы реализовали класс 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()
Person::new("Pcrson") Employee->new()
Person::new("Employee")
$him = Person::new(); # НЕВЕРНО
в программе возникнет нетривиальная проблема, поскольку функция не получит ожидаемого аргумента "Person" и не сможет привести его к переданному классу. Еще хуже, если вам захочется вызвать функцию Employee:: new(). Такой функции не существует! Это всего л
> Смотри также --------------------------------
perltoot(1),perlobj(1) и perlbot{1); рецепты 13.1; 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).
Для работы с полями данных объекта нужны методы доступа, а вам не хочется писать повторяющийся код.
Решение
Воспользуйтесь механизмом 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 не может определять метод
С учетом этого 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{\).
Вы хотите унаследовать от существующего класса и дополнить его несколькими новыми методами, но не знаете, какие поля данных используются родительским классом. Как безопасно дополнить хэш объекта новым пространством имен и не ювредить данные предков?
Решение
Снабдите каждое имя поля префиксом, состоящим из имени класса и разделителя, - например, одного или двух подчеркиваний.
Имеется структура данных, построенная на циклических ссылках. Система сборки мусора Perl, использующая подсчет ссылок, не заметит, когда данная структура перестает использоваться. Вы хотите предотвратить утечки памяти в программе.
Решение
Создайте не-циклический объект-контейнер, содержащий указатель на структуру данных с циклическими ссылками. Определите для объекта-контейнера метод DESTROY, который вручную уничтожает циклические ссылки.
Комментарий
Многие интересные структуры данных содержат ссылки на самих себя. Например, это может происходить в простейшем коде:
$node->{NEXT-} = $node;
Как только в вашей программе встречается такая команда, возникает цикличность, которая скрывает структуру данных от системы сборки мусора Perl с подсчетом ссылок. В итоге деструкторы будут вызваны при выходе из программы, но иногда ждать долго не хоче
Связанный список также обладает циклической структурой: каждый узел со держит указатель на следующий узел, указатель на предыдущий узел и значение текущего узла. Если реализовать его на Perl с применением ссылок, появится циклический набор ссылок, которые
Проблема не решается и созданием узлов, представляющих собой экземпляры специального класса Ring. На самом деле мы хотим, чтобы данная структура уничтожалась Perl по общим правилам - а это произойдет в том случае, если объект реализуется в виде структуры,
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).
