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

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

В нашем примере мы хотим убедиться, что нет пустых (undef) элементов, поэтому EXTEND воспользуется STORESIZE для заполнения элементов по мере необходимости:

sub EXTEND {   
  my $self  = shift;
  my $count = shift;
  $self->STORESIZE( $count );
}

EXISTS this, ключ

Проверить, существует ли элемент с индексом ключ в связанном массиве 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, ключ

Удалить элемент с индексом ключ из связанного массива 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 для массива.

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

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

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

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

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

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

чьему представлению файлов принадлежат эти файлы

HOME

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

CLOBBER

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

LIST

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

Вот начало 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 этот, ключ

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

Вот получение для нашего примера 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 — это униксийская концепция, нас это не сильно волнует.

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} }
}

SCALAR этот

Вызывается, когда хэш оценивается в скалярном контексте, а начиная с версии 5.28 и далее, в булевом контексте функцией keys. Чтобы имитировать поведение несвязанных хэшей, этот метод должен возвращать значение, которое в булевом контексте указывает, считается ли связанный хэш пустым. Если этот метод не существует, 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 поведение скаляра %хэш для несвязанного хэша изменилось, чтобы возвращать количество ключей. До этого возвращалась строка, содержащая информацию о настройке корзины хэша. См. "bucket_ratio" в Hash::Util для пути обратной совместимости.

UNTIE этот

Вызывается, когда untie происходит. См. "Ошибка untie" ниже.

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. Может быть уместно «автоматически закрыть» при этом. См. "Ошибка untie" ниже.

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(). См. «Особенности untie» ниже.

Особенности untie

Если вы собираетесь использовать объект, возвращаемый функцией 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;
}

СМОТРИТЕ ТАКЖЕ

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

ОШИБКИ

Стандартное значение, возвращаемое 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 в настоящее время нельзя перехватить.

АВТОР

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>