HTML page
 |
 |
13.14. Перегрузка операторов
Проблема
Вы хотите использовать знакомые операторы (например, == или +) с объектами написанного вами класса или определить интерполированное значение для вывода объектов.Решение
Воспользуйтесь директивой use overload. Ниже приведены два самых распространенных и часто перегружаемых оператора:use overload ('<=>' => \&threeway_compare);
sub threeway_compare {
my ($s1, $s2) = @_;
uc($s1->{NAME}) cmp uc($s2->{NAME});
}
use overload ( '""' => \&stringify );
sub stringify {
my $self = shift;
return sprintf "%s (%05d)",
ucfirst(lc($self->{NAME})), $self->{IDNUM};
}
Комментарий
При работе со встроенными типами используются некоторые операторы (например, оператор + выполняет сложение, а . - конкатенацию строк). Директива us overload позволяет перегрузить эти операторы так, чтобы для ваших собственных объектов они делали что-то особенное. Директиве передается список пар "оператор/функция":package TimeNumber:
use overload '+' => \&my_plus,
'-' => \&my_minus, '*' => \&my_star, '/' => \&my_slash;
Теперь эти операторы можно использовать с объектами класса TimeNumber, и при этом будут вызываться указанные функции. Функции могут делать все, что вам захочется.
Приведем простой пример перегрузки + для работы с объектом, содержащим количество часов, минут и секунд. Предполагается, что оба операнда принадлежат к классу, имеющему метод new, который может вызываться в качестве метода объекта, и что структура состоит из перечисленных ниже имен:
sub my_plus {
my($left, $right) =
$answer->{SECONDS} = $left->{SECONDS} + $right->{SECONDS};
$answer->{MINUTES} = $left->{MINUTES} + $right->{MINUTES};
$answer->{HOURS} = $left->{HOURS} + $right->{HOURS};
if ($answer->{SECONDS} >= 60) { $answer->{SECONDS} %= 60;
$answer->{MINUTES} ++;
}
if ($answer->{MINUTES} >= 60) {
$answer->{MINUTES} %= 60;
$answer->{HOURS} ++;
}
return $answer;
}
Числовые операторы рекомендуется перегружать лишь в том случае, если объекты соответствуют какой-то числовой конструкции - например, комплексным числам или числам с повышенной точностью, векторам или матрицам. В противном случае программа становится слишком сложной, а пользователи делают неверные предположения относительно работы операторов. Представьте себе класс, который моделирует страну. Если вы создадите оператор для сложения двух стран, то почему нельзя заняться вычитанием? Как видите, перегрузка операторов для нечисловых математических объектов быстро приводит к абсурду.
Объекты (а в сущности, и любые ссылки) можно сравнивать с помощью == и eq, но в этом случае вы узнаете лишь о совпадении их адресов (при этом == работает примерно в 10 раз быстрее, чем eq). Поскольку объект является всего лишь высокоуровневым представлением обычного машинного адреса, во многих ситуациях требуется определить собственный критерий того, что следует понимать под равенством двух объектов.
Даже для нечисловых классов особенно часто перегружаются два оператора: сравнения и строковой интерполяции. Допускается перегрузка как оператора <=>, так и стр, хотя преобладает второй вариант. После того как для объекта будет определен оператор <=>, вы также сможете использовать операторы ==, ! =, <, <=,: и >= для сравнения объектов. Если отношения порядка нежелательны, огра ничьтесь перегрузкой ==. Аналогично, перегруженная версия стр используется в it gt и других строковых сравнениях лишь при отсутствии их явной перегрузки.
Оператор строковой интерполяции обозначается странным именем "" (две ка вычки). Он вызывается каждый раз, когда происходит строковое преобразова ние - например, внутри кавычек или апострофов или при вызове функции print
Прочитайте документацию по директиве overload, прилагаемую к Perl. Перегрузка операторов Perl откроет перед вами некоторые нетривиальные возможности - например, методы строковых и числовых преобразований, автоматическая генерация отсутствующих методов и изменение порядка операндов при необходимости (например, в выражении 5 + $а, где $а является объектом). Пример. Перегруженный класс StrNum Ниже приведен класс StrNum, в котором числовые операторы используются для работы со строками. Да, мы действительно собираемся сделать то, против чего настраивали вас, то есть применить числовые операторы к нечисловым объектам, однако программисты по опыту работы в других языках всегда ожидают, что + и == будут работать со строками. Это всего лишь несложный пример, демонстрирующий перегрузку операторов. Подобное решение почти наверняка не будет использоваться в коммерческой версии программы из-за проблем, связанных с быстродействием. Кроме того, перед вами один из редких случаев использования конструктора, имя которого совпадает с именем класса, - наверняка это порадует программистов со знанием c++ и python.
#!/usr/bin/perl
# show_str"num - пример перегрузки операторов
use StrNum;
$x = strnum("red"); $y = strnum("black");
$z = $x + $y; $г ^ $z * 3;
print "values are $x, $y, $z, and $r\n";
print "$x is ", $x < $y ? "LT" : "GE", " $y\n";
values are Red, Black, RedBlack, and 0
Red is GE Black
Исходный текст класса приведен в примере 13.1.
Пример 13.1. StrNum
package StrNum;
use Exporter ();
@ISA = 'exporter';
@EXPORT = qw(strnum); # Необычно
use overload (
'<=>' => \&spaceship, 'cmp' => \&spaceship,
'""'=> \&stringify,
'bool' => \&boolify,
'0+' => \&numify,
'+' => \&concat,
'*' => \&repeat,
);
# Конструктор
sub StrNum($) {
my ($value) = @_; vreturn bless \$value;
}
sub stringify { ${ $_[0] } }
sub numify { ${ $_[0] } }
sub boolify { ${ $_[0] } }
# Наличие <=> дает нам <, == и т. д.
sub spaceship {
my ($s1, $s2, $inverted) = @_;
return $inverted '' $$s2 cmp $$s1 : $$s1 cmp $$s2;
}
# Использует stringify
sub concat {
my ($s1, $s2, $inverted) = @_,
return StrNum $inverted ? ($s2 . $s1) : ($s1 . $s2);
}
# Использует stringify
sub repeat {
my ($s1, $s2, $inverted) = @_;
return StrNum $inverted ? ($s2 x $s1) : ($s1 x $s2):
}
1;
Пример. Перегруженный класс FixNum В этом классе перегрузка оператора позволяет управлять количеством десятичных позиций при выводе. При этом во всех операциях используется полная точность. Метод places () вызывается для класса или конкретного объекта и задает количество выводимых позиций справа от десятичной точки.
#!/usr/bin/perl
# demo_fixnum - show operator overloading
use FixNum;
FixNum->places(5);
$x = fixnum->new(40):
$у = fixnum->new(12);
print "sum of $x and $y is ", $x + $y, "\n";
print "product of $x and $y is ", $x * $y, "\n";
$z = $x / $y;
printf "$z has %d places\n", $z->places;
$z->places(2) unless $z->places;
print "div of $x by $y is $z\n";
print "square of that is ", $z * $z, "\n";
sum of STRFixNum: 40 and STRFixNum: 12 is STRFixNum: 52 product of STRFixNum: 40 and STRFixNum: 12 is STRFixNum: 480 STRFixNum: 3 has 0 places div of STRFixNum: 40 by STRFixNum: 12 is STRFixNum: 3.33 square of that is STRFixNum: 11.11 Исходный текст класса приведен в примере 13.2. Из математических операции в нем перегружаются только операторы сложения, умножения и деления. Также перегружен оператор <=>, обеспечивающий выполнение всех сравнений, оператор строковой интерполяции и оператор числового преобразования. Оператор строковой интерполяции выглядит необычно, но это было сделано для удобства отладки. Пример. 13.2 FixNum
package FixNum;
use strict;
my $PLACES = 0;
sub new {
my $proto = shift;
my $class = ref($proto) | | $proto;
my $parent = ref($proto) && $proto;
my $v = shift;
my $self = {
VALUE => $v,
PLACES => undef, };
if ($parent && defined $parent->{PLACES}) {
$self->{PLACES} = $parent->{PLACES};
} elsif ($v =~ /(\.\d*)/) {
$self->{PLACES} = length($1) - 1;
} else {
$self->{PLACES} = 0;
} return bless $self, $class;
}
sub places {
my $proto = shift;
my $self = ref($proto) && $proto;
my $type = ref($proto) || $proto:
if (@_) {
my $places = shift;
($self ? $self->{PLACES} : $PLACES) = $places;
} return $self ? $self->{PLACES} : $PLACES:
}
sub _max { $_[0] > $_[1] 7 $_[Q] : $_[1] }
use overload '+' => \&add,
'*'=> \&multiply,
'/' => \÷,
'<=>' => \&spaceship,
'""' => \&as_string,
'0+' => \&as_number;
sub add {
my ($this, $that, $flipped) = @_;
my $result = $this->new( $this->{VALUE} + $that->{VALUE} :
$result->places( _max($this->{PLACES}, $that->{PLACES} ));
return $result;
}
sub multiply {
my ($this, $that, $flipped) = @_;
my $result = $this->new( $this->{VALUE} * $that->{VALUE} );
$result->places( _max($this->{PLACES}, $that->{PLACES} ));
return $result;
}
sub divide {
my ($this, $that, $flipped) = @>_;
my $result = $this->new( $this->{VALUE} / $that->{VALUE} );
$result->places( _max($this->{PLACES}, $that->{PLACES} ));
return $result;
}
sub as_string {
my $self = shift;
return sprintf("STR%s: %.*f", ref($self),
defined($self->{PLACES}) ? $self->{PLACES} : $PLACES, $self->{VALUE});
}
sub as_number {
my $self = shift;
return $self->{VALUE};
}
sub spaceship {
my ($this, $that, $flipped) = @>_;
$this->{VALUE} <=> $that->{VALUE};
}
1;
> Смотри также ------------------------------
Документация по стандартной директиве use overload, а также модулям Math::BigInt и Math::Complex.
13.15. Создание "магических" переменных функцией tie
Проблема
Требуется организовать специальную обработку переменной или манипулятора.Решение
Воспользуйтесь функций tie, чтобы создать объектные связи для обычной перс менной.Комментарий
Каждый, кому приходилось работать с DBM-файлами в Perl, уже использовп/i связанные объекты. Возможно, самый идеальный вариант работы с объектами тот, при котором пользователь их вообще не замечает. Функция tie связывает IK ременную или манипулятор с классом, после чего все обращения к связанной IK ременной или манипулятору перехватываются специальными методами. Наиболее важными являются следующие методы tie: FETCH (перехват чтения) STORE (перехват записи) и конструктор, которым является один из методов TIESCALA-TIEARRAY,TIEHASH или TIEHANDLE. Пользовательский код Выполняемый код tie $s, "SomeClass' SomeClass->TIESCALAR() $р = $s $р = $obj->FETCH() $s = 10 $obj->STORE(10)Откуда берется объект $obj? Вызов tie приводит к вызову конструктора TIESCALAR соответствующего класса. Perl прячет возвращенный объект и тайком использует его при последующих обращениях.
Ниже приведен простой пример класса, реализующего кольцевую структуру данных. При каждом чтении переменной выводится следующее значение из кольца, а при записи в кольцо заносится новое значение.
#! /usr/bin/perl
# demo_valuering - демонстрация связывания use ValueRing;
tie $color, 'ValueRing', qw(red blue);
print "$color $color $color $color $color $color\n";
red blue red blue red blue
$color = 'green';
print "$color $color $color $color $color $color\n";
green red blue green red blue
Простая реализация класса ValueRing приведена в примере 13.3.
Пример 13.3. ValueRing
package ValueRing;
# Конструктор для связывания скаляров
sub TIESCALAR {
my ($class, values) = @>_;
bless \@>values, $class;
return \@values;
}
# Перехватывает чтение
sub FETCH {
my $self = shift;
push(@$self, shirt(@$self));
return $self->[-1];
}
# Перехватывает запись
sub STORE {
my ($self, $value) = @>_;
unshift (S$self, $value;
return $value;
}
1;
Вероятно, такой пример кажется надуманным, но он показывает, как легко со-aTb связь произвольной сложности. Для пользователя $со1ог остается старой доб-)ii переменной, а не объектом. Все волшебство спрятано под связью. При связывании скалярной переменной совсем не обязательно использовать скалярную ссылку; мы использовали ссылку па массив, но вы можете выбрать любой другой вариант. Обычно при связывании любых переменных используется ссылка на nil, поскольку она обеспечивает наиболее гибкое представление объекта.
Для массивов и хэшей возможны и более сложные операции. Связывание манипуляторов появилось лишь в версии 5.004, а до появления версии 5.005 возможности применения связанных массивов были несколько ограничены, но связывание хэшей всегда поддерживалось на высоком уровне. Поскольку полноценная поддержка связанных хэшей требует реализации множества методов объекта, многие пользователи предпочитали наследовать от стандартного модуля Tie::Hash, в котором существуют соответствующие методы по умолчанию.
Ниже приведены некоторые интересные примеры связывания.
Пример связывания. Запрет $_
Этот любопытный связываемый класс подавляет использование неявной переменной $_. Вместо того чтобы подключать его командой use, что приведет к косвенному вызову метода import () класса, воспользуйтесь командой по для вызова редко используемого метода unimport(). Пользователь включает в программу следующую команду: no Underscore;
После этого любые попытки использования нелокализованной глобальной ж -ременной $_ приводят к инициированию исключения.
Рассмотрим применение модуля на небольшом тестовом примере:
#!/usr/bin/perl
# nounder_demo - запрет использования $_ в программе
no Underscore;
@tests = (
"Assignment" => sub { $_ = "bad" },
"Reading" => sub { print },
"Matching" => sub { $x = /badness/ },
"Chop" => sub { chop },
"Filetest" => sub { -x },
"Nesting" => sub { for (1..3) { print } },
);
while ( ($name, $code) = splice(@>tests, 0, 2) ) {
print "Testing $name: ";
eval { &$code };
print $@ ? "detected" : "missed!";
print "\n";
}
Результат выглядит так: Testing Assignment: detected Testing Reading: detected Testing Matching: detected Testing Chop: detected Testing Filetest: detected Testing Nesting: 123missed! В последнем случае обращение к переменной не было перехвачено, поскольку она была локализована в цикле for.
Исходный текст модуля Underscore приведен в примере 13.4. Обратите внимание, каким маленьким он получился. Функция tie вызывается модулем в инициализирующем коде. Пример 13.4. Underscore
package Underscore;
use Carp;
sub TIESCALAR {
my $class = shift;
my $dummy;
return bless \$dummy => $class;
}
sub FETCH { croak "Read access to \$_ forbidden" }
sub STORE { croak "Write access to \$_ forbidden" }
sub unimport { tie($_, __PACKAGE__) }
sub import { untie $_ }
tie($_, __PACKAGE__) unless tied $_;
1;
Чередование вызовов use и по для этого класса в программе не принесет никакой пользы, поскольку они обрабатываются во время компиляции, а не во время выполнения. Чтобы снова воспользоваться переменной $_, локализуйте ее. Пример связывания. Хэш с автоматическим дополнением
Следующий класс создает хэш, который автоматически накапливает повторяющиеся ключи в массиве вместо их замены. v
#!/usr/bin/perl
# appendhash_demo - хэш с автоматическим дополнением
use Tie::AppendHash;
tie %tab, 'Tie::AppendHash';
$tab{beer} = "guinness";
$tab{food} = "potatoes";
$tab{food} = "peas";
while (my($k, $v) = each %tab) { print "$k => [@$v]\n";
}
Результат выглядит так:
food => [potatoes peas] beer => [guinness]
Простоты ради мы воспользовались шаблоном модуля для связывания хэша, входящим в стандартную поставку (см. пример 13.5). Для этого мы загружаем модуль Tie::Hash и затем наследуем от класса Tie::StdHash (да, это действительно разные имена - файл Tie/Hash.pm содержит классы Tie::Hash и Tie::StdHash, несколько отличающиеся друг от друга). Пример 13.5. Tie::AppendHash
package Tie::AppendHash;
use strict;
use Tie::Hash;
use Carp;
use vars qw(@ISA);
@ISA = qw(tie::stdhash);
sub STORE {
my ($self, $key, $value) = @_;
push @){$self->{key}}, $value;
} 1;
Пример связывания. Хэш без учета регистра символов Ниже приведен другой, более хитроумный пример связываемого хэша. На этот р;и хэш автоматически преобразует ключи к нижнему регистру.
#!/usr/bin/perl
# folded_demo - хэш с автоматическим преобразованием регистра
use Tie::Folded;
tie %tab, 'Tie::Folded';
$tab{VILLAIN} = "big ";
$tab{her0ine} = "red riding hood";
$tab{villain} = "bad wolf";
while ( my($k, $v) = each %tab ) { print "$k is $v\n";
}
Результат демонстрационной программы выглядит так: heroine is red riding hood villain is big bad wolf Поскольку на этот раз перехватывается большее количество обращении, из примера 13.6 получился более сложным, чем в примере 13.5. Пример 13.6. Tie: :Folded
package Tie::Folded;
use strict;
use Tie::Hash;
use vars qw(@ISA);
@ISA = qw(tie::stdhash);
sub STORE {
my ($self, $key, $value) = @>_;
return $self->{lc $key} = $value;
} sub FETCH {
my ($self, $key) = @_;
return $self->{lc $key};
} sub EXISTS {
my ($self, $key) = @_;
return exists $self->{lc $key};
} sub DEFINED {
my ($self, $key) = @_;
return defined $self->{lc $key};
}
1;
Пример. Хэш с возможностью поиска по ключу и по значению Следующий хэш позволяет искать элементы как по ключу, так и по значению. Для этого метод STORE заносит в хэш не только значение по ключу, но и обратную пару - ключ по значению. Если сохраняемое значение представляет собой ссылку, возникают затруднения, поскольку обычно ссылка не может использоваться в качестве ключа хэша. Проблема решается классом Tie::RefHash, входящим в стандартную поставку. Мы унаследуем от него.
#!/usr/bin/perl -w
# revhash_demo - хэш с возможностью поиска по ключу *или* по значению
use strict;
use Tie::RevHash;
my %tab;
tie %tab, 'Tie::RevHash';
%tab = qw{
Red Rojo
Blue Azul
Green Verde };
$tab{EVIL} = [ "no way!", "way!!" ];
while ( my($k, $v) = each %tab ) {
print ref($k) ? "[@$k]" : $k, " => ", ref($v) ? "[@$v]" : $v, "\n":
}
При запуске программа revhash_demo выдает следующий результат:
[No way! Way! ! ] = evil>
EVIL => [No way! Way!!]
Blue => Azul
Green => Verde
Rojo => Red
Red => Rojo
Azul => Blue
Verde => Green
Исходный текст модуля приведен в примере 13.7. Оцените размеры!
package Tie::RevHash;
use Tie::RefHash;
use vars qw(@ISA);
@ISA = qw(tie::refhash);
sub STORE {
my ($self, $key, $value) = @_;
$self->SUPER::STORE($key, $value);
$self->SUPER::STORE($value, $key);
}
sub DELETE {
my ($self, $key) = @_;
my $value = $self->SUPER::FETCH($key) $self->SUPER::DELETE($key);
$self->SUPER::DELETE($value);
}
1;
Пример связывания. Манипулятор с подсчетом обращений
Пример связывания для файлового манипулятора выглядит так:
use Counter;
tie *CH, 'Counter';
while (
print "Got $_\n";
}
При запуске эта программа выводит Got 1, Got 2 и так далее - пока вы не прервете ее, не перезагрузите компьютер или не наступит конец света (все зависит от того, что случится раньше). Простейшая реализация приведена в примере 13.8. Пример 13.8. Counter
package Counter;
sub TIEHANDLE {
my $class = shift;
my $start = shift;
return bless \$start => $class;
} sub READLINE {
my $self = shift;
return ++$$self;
}
1;
Пример связывания. Дублирование вывода по нескольким манипуляторам Напоследок мы рассмотрим пример связанного манипулятора, который обладает tee-подобными возможностями - он объединяет STDOUT и STDERR:
use Tie::Tee;
tie *TEE, 'Tie::Tee', *STDOUT, *STDERR;
print TEE "This line goes both places.\n";
Или более подробно:
#!/usr/bin/perl
# demo_tietee
use Tie::Tee;
use Symbol;
(Shandies = (*stdout);
for $i ( 1 .. 10 ) {
push(@ihandles, $handle = gensym());
open($handle, ">/tmp/teetest.$i");
}
tie *TEE, 'Tie: :Tee', @>handles;
print TEE "This lines goes many places.\n";
Содержимое файла Tie/Tee.pm показано в примере 13.9.
Пример 13.9. Tie: :Tee
package Tie::Tee;
sub TIEHANDLE {
my $class = shift;
my $handles = [@_];
bless $handles, $class;
return $handles
};
SUB PRINT 1
my $nrer = smrr;
my $handle;
my $success = 0;
foreach $handle (@$href) {
$success += print $handle @_
}
return $success == @$href
}
1
> Смотри также
Функция tie описана в perlfunc(1) perltie(1).
|
|
|