ЭЛЕКТРОННАЯ БИБЛИОТЕКА КОАПП |
Сборники Художественной, Технической, Справочной, Английской, Нормативной, Исторической, и др. литературы. |
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. Вероятно, разумнее ограничиться проверкой метода сап() в логическом условии. > Смотри также -------------------------------
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; -это позволяет проверить версию и убедиться в том, что она равна указанной или превышает ее. Помните, что версия не обязана точно совпадать с указанной, а должна быть не меньше ее. Впрочем, в настоящее время параллельная установка нескольких версий одного модуля не поддерживается. > Смотри также --------------------------------
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(). Такой функции не существует! Это всего лишь вызов унаследованного метода. Мораль: не вызывайте функции там, где нужно вызывать методы. > Смотри также --------------------------------
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. Кроме того, предполагается, что объект реализуется через ссылку на хэш. > Смотри также -------------------------------
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. Модуль используется следующим образом:
} else {
> Смотри также ------------------------------
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. Это объясняется тем, что мы вызываем функцию, а не метода. [> Смотри также -------------------------------
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).
|