perltie

СОДЕРЖАНИЕ

• ИМЯ
• СИНОПСИС
• ОПИСАНИЕ
  • Связывание скаляров
  • Связывание массивов
  • Связывание хешей
  • Связывание дескрипторов файлов
  • UNTIE 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 от Jarkko Hietaniemi <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 против 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 элементов. Может использоваться для оптимизации выделения. Этот метод ничего не должен делать.

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

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

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

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

чей доменные файлы представляет этот объект

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 $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 — это униксийская концепция, нас это не так беспокоит.

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