使用tie修改哈希行为

2001年9月4日，作者：Dave Cross

简介

在我的经验中，哈希是Perl中最为有用的内置数据类型之一。它们在许多事情上都很有用——从简单的查找表到复杂的数据结构。当然，大多数Perl对象都使用经过祝福的哈希作为其底层实现。

它们有如此多的用途，这意味着Larry和Perl5 Porters在设计哈希时，必须对哈希的功能性有了相当正确的理解——它简单、直观且有效。但你是否遇到过想要改变哈希工作方式的情况？也许你想要只有固定键集的哈希。面对这个需求，可能会完全放弃使用哈希接口，而使用对象。但这个决定的缺点是，你失去了易于理解的哈希接口。但使用绑定的变量，仍然可以创建一个对象，并像哈希一样使用它。

绑定的对象

在我看来，绑定的对象是Perl中未充分利用的功能之一。详细信息（以及一些非常好的示例）可以在perltie中找到，在《Programming Perl》的“绑定变量”章节中也有一些扩展示例。尽管有所有这些优秀的文档，但大多数人似乎认为tie仅用于将哈希绑定到DBM文件。事实是，任何类型的Perl数据结构都可以绑定到几乎任何东西。这只是一个编写包含某些预定义方法的对象的问题。如果你想创建一个在大多数时候模仿标准Perl对象的绑定对象，那就更容易了，因为Perl发行版包含定义模仿标准数据类型行为的对象的模块。例如，有一个名为Tie::StdHash的类（在文件Tie::Hash中），它模仿实际哈希的行为。为了改变这种行为，我们只需要将Tie::StdHash子类化并覆盖我们感兴趣的方法。

使用绑定的对象

在你的Perl程序中，你可以通过调用tie函数来使用绑定对象。tie有两个必选参数：你正在绑定的变量以及你要绑定的类的名称，后面可以跟任意数量的可选参数。例如，如果我们编写了前面提到的具有固定键的哈希（我们很快就会这样做），我们可以在程序中使用这个类，如下所示

  use Tie::Hash::FixedKey;

  my %person;

  my @keys = qw(forename surname date_of_birth gender);

  tie %person, 'Tie::Hash::FixedWidth', @keys;

运行此代码后，%person仍然可以像哈希一样使用，但其行为已经改变。任何尝试将值分配给在调用tie时使用的列表之外的键都将以某种方式失败，我们在编写模块时可以指定这种方式。

如果我们出于某种原因想要访问绑定到哈希的底层对象，则可以使用tied函数。例如，

  my $obj = tied(%person);

将返回绑定到我们的%person哈希的Tie::Hash::FixedKeys对象。这有时用于以标准哈希接口不可用的方式扩展功能。在我们的固定键示例中，我们可能希望用户能够扩展或减少有效键的列表。在标准哈希接口中没有做这件事的方法，因此我们需要添加名为，例如add_keys和del_keys的新方法，可以像这样调用

  tied(%person)->add_keys('weight', 'height');

当您完成使用绑定的对象并希望将其返回为普通哈希时，可以使用untie函数。例如，

  untie %person;

将%person返回为普通哈希。

要将对象绑定到Perl散列中，您的对象需要定义以下一组方法。请注意，它们都使用大写字母命名。这是Perl将要为您调用的函数名的标准。

TIEHASH

这是一个构造函数。当用户调用tie函数时被调用。它接受类的名称以及传递给tie的参数列表。它应该返回对新绑定的对象的引用。

FETCH

当用户从散列中访问值时调用此方法。该方法接受对绑定的对象的引用以及用户尝试访问的键。它应该返回与给定键关联的值（如果找不到键则返回undef）。

STORE

当用户尝试在绑定的散列中对键存储值时调用此方法。它接受对对象的引用，以及键和值对。

DELETE

当用户调用delete函数从绑定的散列中删除一个键/值对时调用此方法。它接受对绑定的对象的引用和用户希望删除的键。返回值成为delete调用的返回值。为了模拟“真正的”delete函数，这应该是删除前的哈希中存储的值。

CLEAR

当用户清除整个哈希（通常是通过将空列表赋值给哈希）时调用此方法。它接受对绑定的对象的引用。

EXISTS

当用户调用exists函数查看给定键是否存在于哈希中时调用此方法。它接受对绑定的对象的引用和要搜索的键。如果找到键则返回真值，否则返回假值。

FIRSTKEY

当第一次调用散列迭代函数（如each或keys）时调用此方法。它接受对绑定的对象的引用并应该返回哈希中的第一个键。

NEXTKEY

当调用迭代函数时调用此方法。它接受对绑定的对象的引用以及已处理的最后一个键的名称。它应该返回下一个键的名称或undef（如果没有更多的键）。

UNTIE

当调用untie函数时调用此方法。它接受对绑定的对象的引用。

DESTROY

当绑定的变量超出作用域时调用此方法。它接受对绑定的对象的引用。

如您所见，需要实现许多方法，但在下一节中我们将看到您如何只需实现其中的一些方法。

第一个例子：Tie::Hash::FixedKeys

让我们看看Tie::Hash::FixedKeys的实现。如果您想更深入地了解，这个模块在CPAN上可用。

由于存在名为Tie::StdHash的包，编写模块变得容易得多。这是一个绑定的哈希，其行为与标准的Perl哈希相似。此包存储在模块Tie::Hash中。这意味着如果您编写了如下示例的代码，那么您将有一个与“真正的”哈希相同的行为的绑定的哈希。

    use Tie::Hash;

    my %hash;

    tie %hash, 'Tie::StdHash';

到目前为止，一切顺利。但它并没有真正实现多少。哈希%hash现在是一个绑定的对象，但我们没有改变它的任何功能。如果将Tie::StdHash用作继承行为的基类，则它会表现得更好。例如，Tie::Hash::FixedKeys类的开头如下所示

    package Tie::Hash::FixedKeys;

    use strict;
    use Tie::Hash;
    use Carp;
    use vars qw(@ISA);

    @ISA = qw(Tie::StdHash);

这是一个Perl对象的规范，但请注意，我们已经加载了Tie::Hash模块（使用use Tie::Hash）并且通过将Tie::StdHash放入@ISA包变量中，让我们的包继承自Tie::StdHash的行为。

如果我们就此停止，我们的Tie::Hash::FixedKeys包将具有与标准Perl哈希相同的性能。这是因为每次Perl试图在我们的包中找到绑定接口方法（如FETCH或STORE）时都会失败，并且会调用父类Tie::StdHash中的版本。

到此为止，我们可以通过简单地重写要更改的方法来开始改变标准哈希的性能。我们首先从实现TIEHASH方法开始。

    sub TIEHASH {
      my $class = shift;

      my %hash;

      @hash{@_} = (undef) x @_;

      bless \%hash, $class;
    }

TIEHASH函数接受类名作为其第一个参数，所以我们将其移入$class中（在第一行）。@_中的其余参数是在tie调用中传递的任何额外参数。在本文开头如何使用我们提出类的示例中，我们传递了有效键的列表。因此，我们使用哈希切片初始化一个哈希，使其具有每个键的值为undef。最后，我们获取这个哈希的引用，将其祝福到所需的类，并返回引用。

在这里指出，关于使用Tie::StdHash的一个注意事项。为了使用默认行为，您的新的类必须基于哈希引用，并且这个哈希必须只包含真实的哈希数据。例如，我们不能发明一个名为_keys的键，该键包含有效键名的列表，因为这个键会在用户调用keys方法时显示。

到此为止，我们已经为每个允许的键创建了一个具有（undef）值的哈希。这还不能阻止我们添加新的键。为了做到这一点，我们需要重写STORE方法。

    sub STORE {
      my ($self, $key, $val) = @_;

      unless (exists $self->{$key}) {
        croak "invalid key [$key] in hash\n";
        return;
      }

      $self->{$key} = $val;
    }

传递给STORE方法的三个参数是绑定对象的引用和一个新的键值对。我们需要让STORE方法阻止向底层哈希添加新键，我们通过在设置值之前检查给定的键是否存在来实现这一点。请注意，由于我们的底层对象是一个真实的哈希，我们可以简单地使用exists函数来检查这一点。如果键不存在，我们向用户提供一个友好的警告并从方法返回而不更改哈希。

我们已经通过添加键来阻止哈希增长，但是仍然可以从哈希中删除键（并且我们的STORE实现将阻止它们被设置，一旦它们被删除），因此我们还需要重写DELETE的实现。

    sub DELETE {
      my ($self, $key) = @_;

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

      my $ret = $self->{$key};

      $self->{$key} = undef;

      return $ret;
    }

我们实际上并不想改变哈希中现有的键集，所以我们会检查键是否已经存在，如果不存在则立即返回。如果键确实存在，我们不想真正删除它，所以我们只需将值设置回undef。请注意，我们在删除之前记录值，以便我们可以从方法返回它，从而模拟真实的delete函数的行为。

影响我们哈希中的键还有另一种方式。类似这样的代码

    %hash = ();

这会导致调用 CLEAR 方法。该方法默认行为是从哈希中移除所有数据。我们需要用一个方法来代替，该方法将所有值重置为 undef 而不改变键。

    sub CLEAR {
      my $self = shift;

      $self->{$_} = undef foreach keys %$self;
    }

这就完成了所有需要做的。标准哈希的其他功能都是继承自 Tie::StdHash。您可以从我们的哈希中像平常一样获取值，无需再编写更多代码。内置的 Perl 函数如 each 和 keys 也按预期工作。

另一个示例：Tie::Hash::Regex

让我们来看另一个示例。这个模块是几个月前在 Perlmonks 的讨论中产生的。有人询问是否可以近似匹配哈希键。我建议一个可以按正则表达式匹配键的哈希可能解决这个问题，并编写了这个模块的第一个草案。我要感谢 Jeff Pinyan，他为这个模块提出了改进建议。

为了改变哈希的行为，我们需要覆盖 FETCH、EXISTS 和 DELETE 方法的功能。下面是 FETCH 方法。

  sub FETCH {
    my $self = shift;
    my $key = shift;    

    my $is_re = (ref $key eq 'Regexp');

    return $self->{$key} if !$is_re && exists $self->{$key};

    $key = qr/$key/ unless $is_re;

    /$key/ and return $self->{$_} for keys %$self;

    return;
  }

了解了关于绑定对象的知识，这很简单。我们首先获取绑定对象的引用（这将是一个哈希引用）和所需的键。然后我们检查这个键是否是一个预编译的正则表达式（这将是使用 qr// 编译的）。如果键 不是 正则表达式，我们首先检查键是否在哈希中存在。如果存在，我们返回关联的值。如果找不到键，我们假设它是一个要搜索的正则表达式。此时，我们将正则表达式编译成好像它还没有预编译（这为我们提供了性能提升，因为我们需要可能将正则表达式与哈希中的所有键进行匹配）。最后，我们逐个检查哈希中的每个键与正则表达式是否匹配，如果匹配，则返回关联的值。如果没有匹配，我们简单地 return。

此时，您可能会意识到可能存在多个键与正则表达式匹配的情况，您可能会建议 FETCH 方法在标量上下文中调用时返回所有匹配项。这是一个好主意，但在当前版本的 Perl 中，语法 $hash{$key} 总是 在标量上下文中调用 FETCH（而语法 @hash{@keys} 对 @keys 中的每个元素在标量上下文中调用一次 FETCH），所以这不会工作。为了解决这个问题，您可以使用稍微有点笨拙的语法 @vals = tied(%hash)->FETCH($pattern)，CPAN 上的模块版本支持这一点。

EXISTS 方法使用类似的处理，但在这个情况下，我们返回 1 如果找到键而不是返回关联的值。

  sub EXISTS {
    my $self = shift;
    my $key = shift;

    my $is_re = (ref $key eq 'Regexp');

    return 1 if !$is_re && exists $self->{$key};

    $key = qr/$key/ unless $is_re;

    /$key/ && return 1 for keys %$key;

    return;
  }

DELETE 方法有所不同。在这种情况下，我们可以删除所有匹配的键/值对，这可以通过以下代码完成

  sub DELETE {
    my $self = shift;
    my $key = shift;

    my $is_re = (ref $key eq 'Regexp');

    return delete $self->{$key} if !$is_re && exists $self->{$key};

    $key = qr/$key/ unless $is_re;

    for (keys %$self) {
      if (/$key/) {
        delete $self->{$_};
      }
    }
  }

我应该指出，CPAN 上还有一个类似模块，名为 Tie::RegexpHash，由 robert Rothenberg 编写。Tie::RegexpHash 实际上与 Tie::Hash::Regex 做相反的事情。当您在其中存储值时，键是一个正则表达式，每次使用键查找值时，您都会得到与第一个匹配字符串的正则表达式键关联的值。值得注意的是，Tie::RegexpHash 不是 基于 Tie::StdHash，因此它的代码比 Tie::Hash::Regex 多得多。

CPAN最近新增的一个模块是Tie::Hash::Approx，由Briac Pilpré编写。它解决了类似的问题，但不是使用正则表达式匹配，而是使用Jarkko Hietaniemi的String::Approx模块。

结论：Tie::Hash::Cannabinol

最后，这里有一个不是很实用的例子。这是一个几乎忘记你告诉它的所有内容的散列。它的exists函数也不太可信。

    package Tie::Hash::Cannabinol;

    use strict;
    use vars qw($VERSION @ISA);
    use Tie::Hash;

    $VERSION = '0.01';
    @ISA = qw(Tie::StdHash);

    sub STORE {
      my ($self, $key, $val) = @_;

      return if rand > .75;

      $self->{$key} = $val;
    }

    sub FETCH {
      my ($self, $key) = @_;

      return if rand > .75;

      return $self->{rand keys %$self};
    }

    sub EXISTS {
      return rand > .5;
    }

正如您所看到的，使用tie和Tie::StdHash基类，可以轻松地对Perl散列的行为进行重大修改。正如我在文章开头所说，这通常使您能够在程序中无需完全转向面向对象，就可以创建新的“对象”。

这不仅仅适用于散列。标准的Perl发行版还附带Tie::StdArray、Tie::StdHandle和Tie::StdScalar等包。

祝你们玩得开心。