perltie

СОДЕРЖАНИЕ

• ИМЯ
• СИНТАКСИС
• ОПИСАНИЕ
  • Связывание скаляров
  • Связывание массивов
  • Связывание хешей
  • Связывание дескрипторов файлов
  • Отвязывание this
  • Особенности отвязывания
• СМОТРИТЕ ТАКЖЕ
• ОШИБКИ
• АВТОР

ИМЯ

perltie - как скрыть класс объекта в простом переменной

СИНТАКСИС

tie VARIABLE, CLASSNAME, LIST

$object = tied VARIABLE

untie VARIABLE

ОПИСАНИЕ

До выпуска Perl 5.0 программисты могли использовать dbmopen() для подключения базы данных на диске в стандартном формате Unix dbm(3x) к %HASH в своей программе. Однако их Perl был скомпилирован либо с одной, либо с другой библиотекой dbm, но не с обеими, и вы не могли расширить эту механику на другие пакеты или типы переменных.

Теперь вы можете.

Функция tie() связывает переменную с классом (пакетом), который предоставит реализацию методов доступа для этой переменной. После выполнения этой магии доступ к привязанной переменной автоматически вызывает вызовы методов в соответствующем классе. Сложность класса скрыта за магическими вызовами методов. Имена методов указаны ЗАГЛАВНЫМИ БУКВАМИ, что является соглашением, используемым Perl, чтобы указать, что они вызываются неявно, а не явно — точно так же, как функции BEGIN() и END().

В вызове tie() VARIABLE — это имя переменной, которая должна быть «околдована». CLASSNAME — это имя класса, реализующего объекты соответствующего типа. Любые дополнительные аргументы в LIST передаются соответствующему методу-конструктору для этого класса — то есть TIESCALAR(), TIEARRAY(), TIEHASH() или TIEHANDLE(). (Обычно это аргументы, которые могут передаваться функции dbminit() языка C.) Объект, возвращаемый методом «new», также возвращается функцией tie(), что может быть полезно, если вы хотите получить доступ к другим методам в CLASSNAME. (Вам на самом деле не нужно возвращать ссылку на правильный «тип» (например, HASH или CLASSNAME), если это правильно освященный объект.) Вы также можете получить ссылку на базовый объект с помощью функции tied().

В отличие от dbmopen(), функция tie() не use или require модуль за вас — вы должны сделать это явно.

Связывание скаляров

Класс, реализующий привязанный скаляр, должен определять следующие методы: TIESCALAR, FETCH, STORE и, возможно, UNTIE и/или DESTROY.

Давайте рассмотрим каждый из них по очереди, используя в качестве примера класс привязки для скаляров, который позволяет пользователю делать что-то вроде:

tie $his_speed, 'Nice', getppid();
tie $my_speed,  'Nice', $$;

И теперь всякий раз, когда к этим переменным обращаются, извлекается и возвращается их текущий системный приоритет. Если эти переменные заданы, то приоритет процесса изменяется!

Мы будем использовать класс BSD::Resource Джарко Хьетаниеми <jhi@iki.fi> (не включён) для доступа к константам PRIO_PROCESS, PRIO_MIN и PRIO_MAX вашей системы, а также к системным вызовам getpriority() и setpriority(). Вот преамбула класса.

package Nice;
use Carp;
use BSD::Resource;
use strict;
$Nice::DEBUG = 0 unless defined $Nice::DEBUG;

TIESCALAR classname, LIST

Это конструктор для класса. Это означает, что он должен возвращать освященную ссылку на новый скаляр (вероятно, анонимный), который он создает. Например:

sub TIESCALAR {
    my $class = shift;
    my $pid = shift || $$; # 0 means me

    if ($pid !~ /^\d+$/) {
        carp "Nice::Tie::Scalar got non-numeric pid $pid" if $^W;
        return undef;
    }

    unless (kill 0, $pid) { # EPERM or ERSCH, no doubt
        carp "Nice::Tie::Scalar got bad pid $pid: $!" if $^W;
        return undef;
    }

    return bless \$pid, $class;
}

Этот класс привязки выбрал возвращать ошибку вместо повышения исключения, если его конструктор потерпит неудачу. Хотя это то, как работает dbmopen(), другие классы могут не захотеть быть столь снисходительными. Он проверяет глобальную переменную $^W для того, чтобы решить, стоит ли выдать немного шума.

FETCH this

Этот метод будет вызываться каждый раз, когда к привязанной переменной обращаются (читается). Он не принимает никаких аргументов помимо своей ссылки на себя, которая является объектом, представляющим скаляр, с которым мы работаем. Поскольку в этом случае мы используем просто ссылку SCALAR для связанного объекта скаляра, $self позволяет методу получить доступ к реальному значению, хранящемуся там. В нашем примере ниже это идентификатор процесса, к которому мы привязали нашу переменную.

sub FETCH {
    my $self = shift;
    confess "wrong type" unless ref $self;
    croak "usage error" if @_;
    my $nicety;
    local($!) = 0;
    $nicety = getpriority(PRIO_PROCESS, $$self);
    if ($!) { croak "getpriority failed: $!" }
    return $nicety;
}

На этот раз мы решили сработать (поднять исключение), если renice потерпит неудачу — нам некуда больше возвращать ошибку, и, вероятно, это правильный подход.

STORE this, value

Этот метод будет вызываться каждый раз, когда привязанная переменная устанавливается (присваивается). Помимо своей ссылки на себя, он также ожидает один (и только один) аргумент: новое значение, которое пользователь пытается присвоить. Не беспокойтесь о возврате значения от STORE; семантика присваивания, возвращающего присвоенное значение, реализуется с помощью FETCH.

sub STORE {
    my $self = shift;
    confess "wrong type" unless ref $self;
    my $new_nicety = shift;
    croak "usage error" if @_;

    if ($new_nicety < PRIO_MIN) {
        carp sprintf
          "WARNING: priority %d less than minimum system priority %d",
              $new_nicety, PRIO_MIN if $^W;
        $new_nicety = PRIO_MIN;
    }

    if ($new_nicety > PRIO_MAX) {
        carp sprintf
          "WARNING: priority %d greater than maximum system priority %d",
              $new_nicety, PRIO_MAX if $^W;
        $new_nicety = PRIO_MAX;
    }

    unless (defined setpriority(PRIO_PROCESS,
                                $$self,
                                $new_nicety))
    {
        confess "setpriority failed: $!";
    }
}

UNTIE this

Этот метод будет вызываться, когда произойдет untie. Это может быть полезно, если классу нужно знать, когда больше не будет производиться вызовы. (За исключением DESTROY, конечно.) См. «Особенности отвязывания» ниже для получения дополнительной информации.

DESTROY this

Этот метод будет вызываться, когда привязанная переменная должна быть разрушена. Как и в других классах объектов, такой метод редко необходим, потому что Perl автоматически освобождает память вашего умирающего объекта — это не C++, вы понимаете. Мы будем использовать метод DESTROY только для отладки.

sub DESTROY {
    my $self = shift;
    confess "wrong type" unless ref $self;
    carp "[ Nice::DESTROY pid $$self ]" if $Nice::DEBUG;
}

Это все, что нужно. На самом деле, это больше, чем всё, что нужно, потому что мы сделали несколько приятных вещей ради полноты, надёжности и общей эстетики. Более простые классы TIESCALAR вполне возможны.

Связывание массивов

Класс, реализующий привязанный обычный массив, должен определять следующие методы: TIEARRAY, FETCH, STORE, FETCHSIZE, STORESIZE, CLEAR и, возможно, UNTIE и/или DESTROY.

FETCHSIZE и STORESIZE используются для обеспечения $#array и эквивалентного scalar(@array) доступа.

Методы POP, PUSH, SHIFT, UNSHIFT, SPLICE, DELETE и EXISTS необходимы, если оператор perl с соответствующим (но строчным) именем должен работать с привязанным массивом. Класс Tie::Array может использоваться как базовый класс для реализации первых пяти из них в терминах базовых методов выше. По умолчанию реализации DELETE и EXISTS в Tie::Array просто croak.

Кроме того, EXTEND будет вызываться, когда perl произвёл бы предварительное расширение выделения памяти в реальном массиве.

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

use FixedElem_Array;
tie @array, 'FixedElem_Array', 3;
$array[0] = 'cat';  # ok.
$array[1] = 'dogs'; # exception, length('dogs') > 3.

Преамбула кода для класса следующая:

package FixedElem_Array;
use Carp;
use strict;

TIEARRAY classname, LIST

Это конструктор класса. Это означает, что он должен вернуть благословённую ссылку, через которую будет осуществляться доступ к новому массиву (вероятно, анонимной ссылке на массив).

В нашем примере, чтобы показать, что вам действительно не обязательно возвращать ссылку на массив, мы выберем ссылку на хеш для представления нашего объекта. Хеш хорошо подходит в качестве универсального типа записи: поле {ELEMSIZE} будет хранить максимальный размер элемента, а поле {ARRAY} — истинную ссылку на массив. Если кто-то снаружи класса попытается обратиться к объекту по ссылке (вероятно, думая, что это ссылка на массив), произойдёт ошибка. Это показывает, что вы должны уважать приватность объекта.

sub TIEARRAY {
  my $class    = shift;
  my $elemsize = shift;
  if ( @_ || $elemsize =~ /\D/ ) {
    croak "usage: tie ARRAY, '" . __PACKAGE__ . "', elem_size";
  }
  return bless {
    ELEMSIZE => $elemsize,
    ARRAY    => [],
  }, $class;
}

FETCH this, index

Этот метод будет вызываться каждый раз при доступе к отдельному элементу связанного массива (чтение). Он принимает один аргумент помимо ссылки на себя: индекс, значение которого мы пытаемся получить.

sub FETCH {
  my $self  = shift;
  my $index = shift;
  return $self->{ARRAY}->[$index];
}

Если используется отрицательный индекс массива для чтения из массива, индекс будет переведён во внутреннем представлении в положительный, вызвав FETCHSIZE перед передачей в FETCH. Вы можете отключить эту функцию, присвоив истинное значение переменной $NEGATIVE_INDICES в классе связанного массива.

Как вы могли заметить, имя метода FETCH (и т.д.) одинаково для всех обращений, хотя конструкторы отличаются по именам (TIESCALAR vs TIEARRAY). Хотя теоретически вы могли бы иметь один класс, обслуживающий несколько связанных типов, на практике это становится громоздким, и проще всего поддерживать один тип связи на класс.

STORE this, index, value

Этот метод будет вызываться каждый раз, когда элемент связанного массива устанавливается (запись). Он принимает два аргумента помимо ссылки на себя: индекс, в который мы пытаемся сохранить что-то, и значение, которое мы пытаемся туда поместить.

В нашем примере, undef фактически представляет $self->{ELEMSIZE} число пробелов, поэтому здесь нам нужно сделать немного больше работы:

sub STORE {
  my $self = shift;
  my( $index, $value ) = @_;
  if ( length $value > $self->{ELEMSIZE} ) {
    croak "length of $value is greater than $self->{ELEMSIZE}";
  }
  # fill in the blanks
  $self->STORESIZE( $index ) if $index > $self->FETCHSIZE();
  # right justify to keep element size for smaller elements
  $self->{ARRAY}->[$index] = sprintf "%$self->{ELEMSIZE}s", $value;
}

Отрицательные индексы обрабатываются так же, как и в FETCH.

FETCHSIZE this

Возвращает общее количество элементов в связанном массиве, связанном с объектом this. (Эквивалентно scalar(@array)). Например:

sub FETCHSIZE {
  my $self = shift;
  return scalar $self->{ARRAY}->@*;
}

STORESIZE this, count

Устанавливает общее количество элементов в связанном массиве, связанном с объектом this, равным count. Если массив становится больше, чем отображается в схеме класса undef, должны быть возвращены новые позиции. Если массив становится меньше, записи за пределами count должны быть удалены.

В нашем примере, 'undef' фактически представляет элемент, содержащий $self->{ELEMSIZE} пробелов. Обратите внимание:

sub STORESIZE {
  my $self  = shift;
  my $count = shift;
  if ( $count > $self->FETCHSIZE() ) {
    foreach ( $count - $self->FETCHSIZE() .. $count ) {
      $self->STORE( $_, '' );
    }
  } elsif ( $count < $self->FETCHSIZE() ) {
    foreach ( 0 .. $self->FETCHSIZE() - $count - 2 ) {
      $self->POP();
    }
  }
}

EXTEND this, count

Информационный вызов, указывающий, что массив, вероятно, увеличится до count элементов. Может использоваться для оптимизации выделения памяти. Этот метод ничего не должен делать.

В нашем примере нет причины реализовывать этот метод, поэтому мы оставляем его как no-op. Этот метод важен только для реализаций связанных массивов, где может быть размер массива, выделенного больше, чем видно программисту Perl, проверяющему размер массива. Многие реализации связанных массивов не имеют причин реализовывать его.

sub EXTEND {   
  my $self  = shift;
  my $count = shift;
  # nothing to see here, move along.
}

ПРИМЕЧАНИЕ: Обычно ошибочно делать это эквивалентным STORESIZE. Perl время от времени может вызывать EXTEND без необходимости фактически изменять размер массива напрямую. Любой связанный массив должен работать правильно, если этот метод является no-op, даже если, возможно, он не будет таким же эффективным, как если бы этот метод был реализован.

EXISTS this, key

Проверить, существует ли элемент с индексом key в связанном массиве this.

В нашем примере мы определим, что если элемент состоит только из $self->{ELEMSIZE} пробелов, он не существует:

sub EXISTS {
  my $self  = shift;
  my $index = shift;
  return 0 if ! defined $self->{ARRAY}->[$index] ||
              $self->{ARRAY}->[$index] eq ' ' x $self->{ELEMSIZE};
  return 1;
}

DELETE this, key

Удалить элемент с индексом key из связанного массива this.

В нашем примере удалённый элемент представляет собой $self->{ELEMSIZE} пробелов:

sub DELETE {
  my $self  = shift;
  my $index = shift;
  return $self->STORE( $index, '' );
}

CLEAR this

Очистить (удалить) все значения из связанного массива, связанного с объектом this. Например:

sub CLEAR {
  my $self = shift;
  return $self->{ARRAY} = [];
}

PUSH this, LIST

Добавить элементы из LIST в массив. Например:

sub PUSH {  
  my $self = shift;
  my @list = @_;
  my $last = $self->FETCHSIZE();
  $self->STORE( $last + $_, $list[$_] ) foreach 0 .. $#list;
  return $self->FETCHSIZE();
}   

POP this

Удалить последний элемент массива и вернуть его. Например:

sub POP {
  my $self = shift;
  return pop $self->{ARRAY}->@*;
}

SHIFT this

Удалить первый элемент массива (перемещая другие элементы вниз) и вернуть его. Например:

sub SHIFT {
  my $self = shift;
  return shift $self->{ARRAY}->@*;
}

UNSHIFT this, LIST

Вставить элементы LIST в начало массива, перемещая существующие элементы вверх, чтобы освободить место. Например:

sub UNSHIFT {
  my $self = shift;
  my @list = @_;
  my $size = scalar( @list );
  # make room for our list
  $self->{ARRAY}[ $size .. $self->{ARRAY}->$#* + $size ]->@*
   = $self->{ARRAY}->@*
  $self->STORE( $_, $list[$_] ) foreach 0 .. $#list;
}

SPLICE this, offset, length, LIST

Выполнить эквивалент splice для массива.

offset необязателен и по умолчанию равен нулю, отрицательные значения отсчитываются от конца массива.

length необязателен и по умолчанию равен остатку массива.

LIST может быть пустым.

Возвращает список из length оригинальных элементов в offset.

В нашем примере мы воспользуемся небольшим сокращением, если существует LIST:

sub SPLICE {
  my $self   = shift;
  my $offset = shift || 0;
  my $length = shift || $self->FETCHSIZE() - $offset;
  my @list   = (); 
  if ( @_ ) {
    tie @list, __PACKAGE__, $self->{ELEMSIZE};
    @list   = @_;
  }
  return splice $self->{ARRAY}->@*, $offset, $length, @list;
}

UNTIE this

Будет вызван, когда untie произойдёт. (См. "The untie Gotcha" ниже.)

DESTROY this

Этот метод будет вызван, когда связанная переменная должна быть уничтожена. Как и в случае со скалярным классом связи, это почти никогда не нужно в языке, который сам выполняет сборку мусора, поэтому на этот раз мы его просто опустим.

Связывание хешей

Хеши были первым типом данных Perl, который был связан (см. dbmopen()). Класс, реализующий связанный хеш, должен определить следующие методы: TIEHASH — конструктор. FETCH и STORE обращаются к парам ключ-значение. EXISTS сообщает, существует ли ключ в хеше, а DELETE удаляет его. CLEAR очищает хеш, удаляя все пары ключ-значение. FIRSTKEY и NEXTKEY реализуют функции keys() и each() для итерации по всем ключам. SCALAR срабатывает, когда связанный хеш оценивается в скалярном контексте, а в версии 5.28 и выше, и по keys в булевом контексте. UNTIE вызывается, когда untie произойдёт, а DESTROY вызывается, когда связанная переменная собирается мусором.

Если это кажется много, тогда не стесняйтесь наследовать только от стандартного модуля Tie::StdHash для большинства ваших методов, переопределяя только интересные. См. Tie::Hash для подробностей.

Помните, что Perl различает ситуацию, когда ключ не существует в хеше, и когда ключ существует в хеше, но соответствующее значение равно undef. Обе возможности можно проверить с помощью функций exists() и defined().

Вот пример несколько интересного связанного класса хешей: он даёт вам хеш, представляющий определённые файлы пользователя. Вы обращаетесь к хешу по имени файла (без точки) и получаете содержимое этого файла.

use DotFiles;
tie %dot, 'DotFiles';
if ( $dot{profile} =~ /MANPATH/ ||
     $dot{login}   =~ /MANPATH/ ||
     $dot{cshrc}   =~ /MANPATH/    )
{
    print "you seem to set your MANPATH\n";
}

Или вот другой пример использования нашего связанного класса:

tie %him, 'DotFiles', 'daemon';
foreach $f ( keys %him ) {
    printf "daemon dot file %s is size %d\n",
        $f, length $him{$f};
}

В нашем связанном примере хешей DotFiles мы используем обычный хеш для объекта, содержащего несколько важных полей, из которых только поле {LIST} будет тем, что пользователь считает реальным хешем.

USER

чьи файлы dot этот объект представляет

HOME

где эти файлы dot живут

CLOBBER

следует ли пытаться изменить или удалить эти файлы dot

LIST

хеш с именами файлов dot и сопоставлениями содержимого

Вот начало файла Dotfiles.pm:

package DotFiles;
use Carp;
sub whowasi { (caller(1))[3] . '()' }
my $DEBUG = 0;
sub debug { $DEBUG = @_ ? shift : 1 }

В нашем примере мы хотим иметь возможность выводить отладочную информацию, чтобы помочь в отслеживании при разработке. Мы также сохраняем одну удобную функцию для внутренних целей, чтобы помочь выводить предупреждения; whowasi() возвращает имя функции, которая её вызвала.

Вот методы связанного хеша DotFiles.

TIEHASH имя_класса, СПИСОК

Это конструктор для класса. Это означает, что он должен возвращать освящённую ссылку, посредством которой будет осуществляться доступ к новому объекту (вероятно, но не обязательно, анонимному хешу).

Вот конструктор:

sub TIEHASH {
    my $class = shift;
    my $user = shift || $>;
    my $dotdir = shift || '';
    croak "usage: @{[&whowasi]} [USER [DOTDIR]]" if @_;
    $user = getpwuid($user) if $user =~ /^\d+$/;
    my $dir = (getpwnam($user))[7]
            || croak "@{[&whowasi]}: no user $user";
    $dir .= "/$dotdir" if $dotdir;

    my $node = {
        USER    => $user,
        HOME    => $dir,
        LIST    => {},
        CLOBBER => 0,
    };

    opendir(DIR, $dir)
            || croak "@{[&whowasi]}: can't opendir $dir: $!";
    foreach $dot ( grep /^\./ && -f "$dir/$_", readdir(DIR)) {
        $dot =~ s/^\.//;
        $node->{LIST}{$dot} = undef;
    }
    closedir DIR;
    return bless $node, $class;
}

Вероятно, стоит упомянуть, что если вы собираетесь проверять возвращаемые значения из readdir, вам следует добавить в начало путь к каталогу. В противном случае, поскольку мы не использовали chdir(), проверка будет проводиться в неправильном каталоге.

FETCH этот, ключ

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

Вот метод fetch для нашего примера DotFiles.

sub FETCH {
    carp &whowasi if $DEBUG;
    my $self = shift;
    my $dot = shift;
    my $dir = $self->{HOME};
    my $file = "$dir/.$dot";

    unless (exists $self->{LIST}->{$dot} || -f $file) {
        carp "@{[&whowasi]}: no $dot file" if $DEBUG;
        return undef;
    }

    if (defined $self->{LIST}->{$dot}) {
        return $self->{LIST}->{$dot};
    } else {
        return $self->{LIST}->{$dot} = `cat $dir/.$dot`;
    }
}

Его было легко написать, используя команду Unix cat(1), но, вероятно, более портативно было бы открыть файл вручную (и несколько эффективнее). Конечно, поскольку файлы dot — это концепция Unix, мы не так сильно об этом беспокоимся.

STORE этот, ключ, значение

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

В нашем примере DotFiles мы будем следить за тем, чтобы они не пытались перезаписать файл, если не вызовут метод clobber() на исходной ссылке на объект, возвращённой tie().

sub STORE {
    carp &whowasi if $DEBUG;
    my $self = shift;
    my $dot = shift;
    my $value = shift;
    my $file = $self->{HOME} . "/.$dot";
    my $user = $self->{USER};

    croak "@{[&whowasi]}: $file not clobberable"
        unless $self->{CLOBBER};

    open(my $f, '>', $file) || croak "can't open $file: $!";
    print $f $value;
    close($f);
}

Если они хотят перезаписать что-то, они могут сказать:

$ob = tie %daemon_dots, 'daemon';
$ob->clobber(1);
$daemon_dots{signature} = "A true daemon\n";

Другой способ получить ссылку на базовый объект — использовать функцию tied(), поэтому они могут альтернативно установить clobber с помощью:

tie %daemon_dots, 'daemon';
tied(%daemon_dots)->clobber(1);

Метод clobber выглядит так:

sub clobber {
    my $self = shift;
    $self->{CLOBBER} = @_ ? shift : 1;
}

DELETE этот, ключ

Этот метод вызывается при удалении элемента из хеша, обычно с помощью функции delete(). Опять же, мы будем следить за тем, чтобы они действительно хотели перезаписать файлы.

sub DELETE   {
    carp &whowasi if $DEBUG;

    my $self = shift;
    my $dot = shift;
    my $file = $self->{HOME} . "/.$dot";
    croak "@{[&whowasi]}: won't remove file $file"
        unless $self->{CLOBBER};
    delete $self->{LIST}->{$dot};
    my $success = unlink($file);
    carp "@{[&whowasi]}: can't unlink $file: $!" unless $success;
    $success;
}

Значение, возвращаемое DELETE, становится значением возврата вызова delete(). Если вы хотите эмулировать обычное поведение delete(), вы должны вернуть то, что FETCH вернул бы для этого ключа. В этом примере мы решили вернуть значение, которое сообщает вызывающей стороне, был ли файл успешно удалён.

CLEAR этот

Этот метод вызывается, когда весь хеш должен быть очищен, обычно пустым списком.

В нашем примере это удалит все файлы dot пользователя! Это настолько опасная вещь, что им нужно будет установить CLOBBER на значение больше, чем 1, чтобы это произошло.

sub CLEAR    {
    carp &whowasi if $DEBUG;
    my $self = shift;
    croak "@{[&whowasi]}: won't remove all dot files for $self->{USER}"
        unless $self->{CLOBBER} > 1;
    my $dot;
    foreach $dot ( keys $self->{LIST}->%* ) {
        $self->DELETE($dot);
    }
}

EXISTS этот, ключ

Этот метод вызывается, когда пользователь использует функцию exists() для определённого хеша. В нашем примере мы будем рассматривать элемент {LIST} хеша:

sub EXISTS   {
    carp &whowasi if $DEBUG;
    my $self = shift;
    my $dot = shift;
    return exists $self->{LIST}->{$dot};
}

FIRSTKEY этот

Этот метод будет вызываться, когда пользователь собирается перебирать хеш, например, с помощью вызовов keys(), values() или each().

sub FIRSTKEY {
    carp &whowasi if $DEBUG;
    my $self = shift;
    my $a = keys $self->{LIST}->%*;  # reset each() iterator
    each $self->{LIST}->%*
}

FIRSTKEY всегда вызывается в скалярном контексте и должен просто возвращать первый ключ. values() и each() в списковом контексте вызовут FETCH для возвращённых ключей.

NEXTKEY этот, последний_ключ

Этот метод вызывается во время итерации keys(), values() или each(). У него есть второй аргумент — последний обработанный ключ. Это полезно, если вам нужно учитывать порядок или вызывать итератор из нескольких последовательностей или не хранить данные в хеше.

NEXTKEY всегда вызывается в скалярном контексте и должен просто возвращать следующий ключ. values() и each() в списковом контексте вызовут FETCH для возвращённых ключей.

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

sub NEXTKEY  {
    carp &whowasi if $DEBUG;
    my $self = shift;
    return each $self->{LIST}->%*
}

Если объект, лежащий в основе связанного хеша, не является реальным хешем, и у вас нет each доступно, вы должны вернуть undef или пустой список после достижения конца списка ключей. Смотрите each's own documentation для более подробной информации.

SCALAR этот

Этот метод вызывается, когда хеш оценивается в скалярном контексте, а в Perl 5.28 и выше — в булевом контексте с помощью keys. Для имитации поведения несвязанных хешей этот метод должен вернуть значение, которое, когда используется как булево, указывает, считается ли связанный хеш пустым. Если этот метод не существует, Perl сделает некоторые предположения и вернёт true, когда хеш находится внутри итерации. Если это не так, вызывается FIRSTKEY, и результат будет ложным, если FIRSTKEY вернёт пустой список, и истинным в противном случае.

Однако не следует слепо полагаться на то, что Perl всегда делает правильные действия. В частности, Perl ошибочно возвращает true, когда вы очищаете хеш, вызывая DELETE до тех пор, пока он не станет пустым. Поэтому рекомендуется предоставлять собственный метод SCALAR, когда вы хотите быть абсолютно уверены, что ваш хеш хорошо ведёт себя в скалярном контексте.

В нашем примере мы можем просто вызвать scalar на базовом хеше, на который ссылается $self->{LIST}.

sub SCALAR {
    carp &whowasi if $DEBUG;
    my $self = shift;
    return scalar $self->{LIST}->%*
}

ПРИМЕЧАНИЕ: В Perl 5.25 поведение скалярного %hash для несвязанного хеша изменилось на возврат количества ключей. До этого оно возвращало строку с информацией о настройке ведёр хеша. Смотрите "bucket_ratio" в Hash::Util для пути обратной совместимости.

UNTIE этот

Этот метод вызывается, когда untie происходит. Смотрите "The untie Gotcha" ниже.

DESTROY этот

Этот метод вызывается, когда связанный хеш выходит из области видимости. Вам он не нужен, если вы не пытаетесь добавить отладку или иметь вспомогательное состояние для очистки. Вот очень простая функция:

sub DESTROY  {
    carp &whowasi if $DEBUG;
}

Обратите внимание, что функции, такие как keys() и values(), могут возвращать огромные списки при использовании с большими объектами, такими как файлы DBM. В таких случаях предпочтительнее использовать функцию each(). Пример:

# print out history file offsets
use NDBM_File;
tie(%HIST, 'NDBM_File', '/usr/lib/news/history', 1, 0);
while (($key,$val) = each %HIST) {
    print $key, ' = ', unpack('L',$val), "\n";
}
untie(%HIST);

Связывание дескрипторов файлов

Это частично реализовано сейчас.

Класс, реализующий связанный дескриптор файла, должен определять следующие методы: TIEHANDLE, по крайней мере один из PRINT, PRINTF, WRITE, READLINE, GETC, READ и, возможно, CLOSE, UNTIE и DESTROY. Класс также может предоставлять: BINMODE, OPEN, EOF, FILENO, SEEK, TELL — если соответствующие операторы Perl используются с дескриптором.

Когда STDERR связан, его метод PRINT вызывается для вывода предупреждений и сообщений об ошибках. Эта функция временно отключается во время вызова, что означает, что вы можете использовать warn() внутри PRINT без запуска рекурсивного цикла. И точно так же, как __WARN__ и __DIE__ обработчики, метод PRINT STDERR может вызываться для отчётности об ошибках парсера, поэтому применимы замечания, указанные в "%SIG" в perlvar.

Всё это особенно полезно, когда Perl встраивается в другую программу, где вывод в STDOUT и STDERR может потребоваться перенаправить каким-то особым способом. Смотрите nvi и модуль Apache для примеров.

При связывании дескриптора первый аргумент для tie должен начинаться со звёздочки. Итак, если вы связываете STDOUT, используйте *STDOUT. Если вы присвоили его скалярной переменной, например, $handle, используйте *$handle. tie $handle связывает скалярную переменную $handle, а не дескриптор внутри неё.

В нашем примере мы создадим дескриптор, который кричит.

package Shout;

TIEHANDLE имя_класса, СПИСОК

Это конструктор для класса. Это означает, что он должен вернуть освящённую ссылку какого-то типа. Ссылка может использоваться для хранения некоторой внутренней информации.

sub TIEHANDLE { print "<shout>\n"; my $i; bless \$i, shift }

WRITE этот, СПИСОК

Этот метод будет вызываться, когда к дескриптору осуществляется запись через функцию syswrite.

sub WRITE {
    $r = shift;
    my($buf,$len,$offset) = @_;
    print "WRITE called, \$buf=$buf, \$len=$len, \$offset=$offset";
}

PRINT этот, СПИСОК

Этот метод вызывается каждый раз, когда связанный дескриптор печатается с помощью функций print() или say(). Помимо ссылки на себя, он также ожидает список, переданный в функцию print.

sub PRINT { $r = shift; $$r++; print join($,,map(uc($_),@_)),$\ }

say() действует так же, как print(), за исключением того, что $\ будет локализован до \n, поэтому вам ничего не нужно делать, чтобы обработать say() в PRINT().

PRINTF этот, СПИСОК

Этот метод будет вызываться каждый раз, когда связанный дескриптор печатается с помощью функции printf(). Помимо ссылки на себя, он также ожидает формат и список, переданные в функцию printf.

sub PRINTF {
    shift;
    my $fmt = shift;
    print sprintf($fmt, @_);
}

READ этот, СПИСОК

Этот метод вызывается при чтении из дескриптора с помощью функций read или sysread.

sub READ {
  my $self = shift;
  my $bufref = \$_[0];
  my(undef,$len,$offset) = @_;
  print "READ called, \$buf=$bufref, \$len=$len, \$offset=$offset";
  # add to $$bufref, set $len to number of characters read
  $len;
}

READLINE этот

Этот метод вызывается при чтении из дескриптора с помощью <HANDLE> или readline HANDLE.

В соответствии с readline, в скалярном контексте он должен возвращать следующую строку или undef при отсутствии данных. В списковом контексте он должен возвращать все оставшиеся строки или пустой список при отсутствии данных. Возвращаемые строки должны включать разделитель записей ввода $/ (см. perlvar), если он не равен undef (что означает режим «slurp»).

sub READLINE {
  my $r = shift;
  if (wantarray) {
    return ("all remaining\n",
            "lines up\n",
            "to eof\n");
  } else {
    return "READLINE called " . ++$$r . " times\n";
  }
}

GETC этот

Этот метод будет вызываться при вызове функции getc.

sub GETC { print "Don't GETC, Get Perl"; return "a"; }

EOF этот

Этот метод вызывается при вызове функции eof.

Начиная с Perl 5.12, будет передан дополнительный целочисленный параметр. Он будет равен нулю, если eof вызывается без параметра; 1, если eof получает дескриптор файла в качестве параметра, например, eof(FH); и 2, в очень специальном случае, когда связанный дескриптор файла — ARGV, и eof вызывается с пустым списком параметров, например, eof().

sub EOF { not length $stringbuf }

CLOSE этот

Этот метод вызывается при закрытии дескриптора с помощью функции close.

sub CLOSE { print "CLOSE called.\n" }

UNTIE этот

Как и с другими типами связей, этот метод вызывается при выполнении untie. Может быть целесообразно «автоматически закрыть» при этом. Смотрите "The untie Gotcha" ниже.

DESTROY этот

Как и с другими типами связей, этот метод вызывается, когда связанный дескриптор файла собирается быть уничтожен. Это полезно для отладки и, возможно, для очистки.

sub DESTROY { print "</shout>\n" }

Вот как использовать наш небольшой пример:

tie(*FOO,'Shout');
print FOO "hello\n";
$a = 4; $b = 6;
print FOO $a, " plus ", $b, " equals ", $a + $b, "\n";
print <FOO>;

UNTIE этот

Вы можете определить для всех типов связей метод UNTIE, который будет вызываться при untie(). Смотрите "The untie Gotcha" ниже.

The untie Ловушка при развязывании

Если вы намерены использовать объект, возвращённый функциями tie() или tied(), и если целевой класс связки определяет деструктор, есть тонкая ловушка, от которой необходимо защититься.

В качестве подготовки рассмотрим этот (признанный довольно искусственным) пример связки; всё, что она делает, — использует файл для ведения журнала присваиваемых скалярному значению значений.

package Remember;

use v5.36;
use IO::File;

sub TIESCALAR {
    my $class = shift;
    my $filename = shift;
    my $handle = IO::File->new( "> $filename" )
                     or die "Cannot open $filename: $!\n";

    print $handle "The Start\n";
    bless {FH => $handle, Value => 0}, $class;
}

sub FETCH {
    my $self = shift;
    return $self->{Value};
}

sub STORE {
    my $self = shift;
    my $value = shift;
    my $handle = $self->{FH};
    print $handle "$value\n";
    $self->{Value} = $value;
}

sub DESTROY {
    my $self = shift;
    my $handle = $self->{FH};
    print $handle "The End\n";
    close $handle;
}

1;

Вот пример использования этой связки:

use strict;
use Remember;

my $fred;
tie $fred, 'Remember', 'myfile.txt';
$fred = 1;
$fred = 4;
$fred = 5;
untie $fred;
system "cat myfile.txt";

Вот вывод при его выполнении:

The Start
1
4
5
The End

Пока всё хорошо. Те из вас, кто внимательно следил, заметили, что привязанный объект до сих пор не использовался. Давайте добавим в класс Remember дополнительный метод для включения комментариев в файл; например, что-то вроде этого:

sub comment {
    my $self = shift;
    my $text = shift;
    my $handle = $self->{FH};
    print $handle $text, "\n";
}

А вот предыдущий пример, изменённый для использования метода comment (который требует привязанного объекта):

use strict;
use Remember;

my ($fred, $x);
$x = tie $fred, 'Remember', 'myfile.txt';
$fred = 1;
$fred = 4;
comment $x "changing...";
$fred = 5;
untie $fred;
system "cat myfile.txt";

При выполнении этого кода вывод отсутствует. Вот почему:

Когда переменная привязана, она ассоциируется с объектом, который является результатом работы функций TIESCALAR, TIEARRAY или TIEHASH. У этого объекта обычно всего одна ссылка, а именно неявная ссылка от привязанной переменной. Когда вызывается untie(), эта ссылка уничтожается. Затем, как и в первом примере выше, вызывается деструктор объекта (DESTROY), что нормально для объектов, у которых больше нет действительных ссылок; таким образом, файл закрывается.

Однако во втором примере мы сохранили другую ссылку на привязанный объект в $x. Это означает, что при вызове untie() всё ещё будет существовать действительная ссылка на объект, поэтому деструктор не вызывается в этот момент, и, следовательно, файл не закрывается. Причина, по которой вывод отсутствует, заключается в том, что буферы файла не были выведены на диск.

Теперь, когда вы знаете, в чём проблема, что вы можете сделать, чтобы её избежать? До появления необязательного метода UNTIE единственный способ — старый добрый флаг -w. Он обнаруживает любые случаи, когда вы вызываете untie(), и ещё существуют действительные ссылки на привязанный объект. Если второй скрипт выше, около верха use warnings 'untie' или был запущен с флагом -w, Perl выводит это сообщение об ошибке:

untie attempted while 1 inner references still exist

Чтобы сценарий работал правильно и предупреждение исчезло, убедитесь, что действительных ссылок на привязанный объект нет до вызова untie():

undef $x;
untie $fred;

Теперь, когда существует UNTIE, разработчик класса может решить, какие части функциональности класса действительно связаны с untie и какие с уничтожением объекта. Что имеет смысл для данного класса, зависит от того, сохраняются ли внутренние ссылки, чтобы на объекте можно было вызывать методы, не связанные с привязкой. Но в большинстве случаев вероятно имеет смысл перенести функциональность, которая должна была находиться в DESTROY, в метод UNTIE.

Если метод UNTIE существует, то вышеупомянутое предупреждение не возникает. Вместо этого методу UNTIE передаётся счёт «дополнительных» ссылок, и он может выдать своё собственное предупреждение, если это необходимо. Например, чтобы воспроизвести случай без UNTIE, можно использовать этот метод:

sub UNTIE
{
 my ($obj,$count) = @_;
 carp "untie attempted while $count inner references still exist"
                                                             if $count;
}

См. также

См. DB_File или Config для некоторых интересных реализаций tie(). Хорошей отправной точкой для многих реализаций tie() является один из модулей Tie::Scalar, Tie::Array, Tie::Hash или Tie::Handle.

Ошибки

Обычное возвращаемое значение scalar(%hash) недоступно. Это означает, что использование %tied_hash в контексте булевых значений не работает правильно (в настоящее время оно всегда возвращает false, независимо от того, пуст ли хэш или содержит элементы). [ Этот абзац нуждается в пересмотре в свете изменений в 5.25 ]

Локализация привязанных массивов или хэшей не работает. После выхода из области видимости массивы или хэши не восстанавливаются.

Подсчёт количества записей в хэше с помощью scalar(keys(%hash)) или scalar(values(%hash) неэффективен, так как ему нужно перебирать все записи с FIRSTKEY/NEXTKEY.

Срезы привязанных хэшей/массивов вызывают несколько пар FETCH/STORE, для операций со срезами нет методов привязки.

Вы не можете легко привязать многоуровневую структуру данных (такую как хэш хэшей) к файлу dbm. Первая проблема заключается в том, что у всех, кроме GDBM и Berkeley DB, есть ограничения по размеру, но помимо этого у вас также есть проблемы с тем, как представлять ссылки на диске. Один модуль, который пытается решить эту проблему, — DBM::Deep. Проверьте ближайший сайт CPAN, как описано в perlmodlib, для исходного кода. Обратите внимание, что несмотря на своё название, DBM::Deep не использует dbm. Ещё одна более ранняя попытка решения проблемы — MLDBM, который также доступен в CPAN, но имеет некоторые довольно серьёзные ограничения.

Привязанные дескрипторы файлов всё ещё неполны. sysopen(), truncate(), flock(), fcntl(), stat() и -X в настоящее время не могут быть перехвачены.

Автор

Tom Christiansen

TIEHANDLE от Sven Verdoolaege <skimo@dns.ufsia.ac.be> и Doug MacEachern <dougm@osf.org>

UNTIE от Nick Ing-Simmons <nick@ing-simmons.net>

SCALAR от Tassilo von Parseval <tassilo.von.parseval@rwth-aachen.de>

Массивы с привязкой от Casey West <casey@geeknest.com>