Вы хотите использовать знакомые операторы (например, == или +) с объектами написанного вами класса или определить интерполированное значение для вывода объектов.
Решение
Воспользуйтесь директивой 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) = my $answer = $left->new();
$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 откроет перед вами некоторые нетривиальные возможности - например, методы строковых и числовых преобразований, автоматическая генерация отсутствующих методов
Пример. Перегруженный класс StrNum
Ниже приведен класс StrNum, в котором числовые операторы используются для работы со строками. Да, мы действительно собираемся сделать то, против чего настраивали вас, то есть применить числовые операторы к нечисловым объектам, однако программисты по опыту
#!/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.
Требуется организовать специальную обработку переменной или манипулятора.
Решение
Воспользуйтесь функций tie, чтобы создать объектные связи для обычной перс менной.
Комментарий
Каждый, кому приходилось работать с DBM-файлами в Perl, уже использовп/i связанные объекты. Возможно, самый идеальный вариант работы с объектами тот, при котором пользователь их вообще не замечает. Функция tie связывает 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.
