Исходный текст модуля Underscore приведен в примере 13.4. Обратите внимание, каким маленьким он получился. Функция tie вызывается модулем в инициализирующем коде.

Пример 13.4. Underscore

package Underscore;

use Carp;

sub TIESCALAR {

my Sclass = 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 $ ;

Чередование вызовов use и no для этого класса в программе не принесет никакой пользы, поскольку они обрабатываются во время компиляции, а не во время выполнения. Чтобы снова воспользоваться переменной $ , локализуйте ее.

Пример связывания. Хэш с автоматическим дополнением

Следующий класс создает хэш, который автоматически накапливает повторяющиеся ключи в массиве вместо их замены.

«! /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 => [f$v]\n";

Результат выглядит так:

food -> [potatoes peas] beer *> [guinness]

Простоты ради мы воспользовались шаблоном модуля для связывания хэша, входящим в стандартную поставку (см. пример 13.5). Для этого мы загружаем модуль Tie::Hash и затем наследуем от класса Tie::StdHash (да, это действительно разные имена - файл Tie/Hash.pm содержит классы Tie::Hash и Tie::StdHash, несколько отличающиеся друг от друга).

492 Глава 13 • Классы, объекты и связи Пример 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 (Sself, Skey, Svalue) = @ ;

push @i{$self->{key}}, Svalue;

Пример связывания. Хэш без учета регистра символов

Ниже приведен другой, более хитроумный пример связываемого хэша. На этот раз хэш автоматически преобразует ключи к нижнему регистру.

#!/usr/bin/perl

tt folded derao - хэш с автоматическим преобразованием регистра

use Tie::Folded;

tie %tab, Tie:iFolded;

$tab{VILLAIN} = big ; $tab{herOine} = red riding hood; $tab{villain} = bad wolf;

while ( my($k, $v) = each %tab ) { print Sk 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 (Sself, Skey, Svalue) = @ ;

return $self->{lc $key> = Svalue;

sub FETCH {

my (Sself, Skey) = © ;

return $self->{lc $кеу};

sub EXISTS {

my ($self, $key) = @ ;

return exists $self->{lc $key};

sub DEFINED {

my ($self, $key) = @ ;

return defined $self->{lc $key};

Пример. Хэш с возможностью поиска по ключу и по значению

Следующий хэщ позволяет искать элементы как по ключу, так и по значению. Для этого метод STORE заносит в хэщ не только значение но ключу, но и обратную пару - ключ по значению.

Если сохраняемое значение представляет собой ссылку, возникают затруднения, поскольку обычно ссылка не может использоваться в качестве ключа хэща. Проблема решается классом Tiei.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 wayl Way!!] = EVIL> EVIL => [No way! Way!!] Blue => Azul Green => Verde Rojo => Red Red => RoJo Azul => Blue Verde => Green

Исходный текст модуля приведен в примере 13.7. Оцените размеры!