perltie

СОДЕРЖАНИЕ

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

НАЗВАНИЕ

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

СИНОПСИС

tie VARIABLE, CLASSNAME, LIST

$object = tied VARIABLE

untie VARIABLE

ОПИСАНИЕ

До версии 5.0 Perl программист мог использовать 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: $!";
    }
}

ОТКЛЮЧЕНИЕ 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 имя_класса, СПИСОК

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

В нашем примере, чтобы показать, что вам не обязательно возвращать ссылку на массив, мы выберем ссылку на хеш для представления нашего объекта. Хеш хорошо подходит в качестве обобщённого типа записи: поле {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, индекс

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

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

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

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

STORE this, индекс, значение

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

В нашем примере, 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, счёт

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

В нашем примере, '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 элементов. Может использоваться для оптимизации выделения. Этот метод не должен делать ничего.

В нашем примере нет причин реализовывать этот метод, поэтому мы оставляем его как 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 в связанном массиве 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 из связанного массива 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, СПИСОК

Добавить элементы из СПИСОКА в массив. Например:

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, СПИСОК

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

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, смещение, длина, СПИСОК

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

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

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

СПИСОК может быть пустым.

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

В нашем примере, мы будем использовать небольшой сокращение, если есть СПИСОК:

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 происходит. (См. "Проблема untie" ниже.)

DESTROY this

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

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

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

ПОЛЬЗОВАТЕЛЬ

чей файлы dot он представляет

ДОМ

где находятся эти файлы dot

ПЕРЕЗАПИСАТЬ

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

СПИСОК

хеш сопоставлений имён файлов 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 $self = 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, $self;
}

Вероятно, стоит упомянуть, что если вы собираетесь проверять возвращаемые значения из 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), но было бы, вероятно, более портативно открыть файл вручную (и несколько эффективнее). Конечно, поскольку файлы с префиксом точка — это концепция 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 этот

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

В нашем примере это удалит все файлы пользователя с префиксом точка! Это настолько опасная операция, что им придётся установить 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} }
}

SCALAR этот

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

Однако, вы не должны слепо полагаться на то, что 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 Gotcha

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

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

package Remember;

use strict;
use warnings;
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;
}

SEE ALSO

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

BUGS

Обычное возвращаемое значение scalar(%hash) недоступно. Это означает, что использование %tied_hash в контексте булевых выражений не работает правильно (в настоящее время всегда возвращает ложь, независимо от того, пуст ли хэш или элементы в хэше). [Этот абзац требует пересмотра в свете изменений в 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 в настоящее время не могут быть перехвачены.

AUTHOR

Tom Christiansen

TIEHANDLE by Sven Verdoolaege <skimo@dns.ufsia.ac.be> and Doug MacEachern <dougm@osf.org>

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

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

Tying Arrays by Casey West <casey@geeknest.com>