内容


功能丰富的 Perl

绑定的变量

通过 CPAN 模块绑定标量、数组及散列变量的示例

Comments

系列内容:

此内容是该系列 # 部分中的第 # 部分: 功能丰富的 Perl

敬请期待该系列的后续内容。

此内容是该系列的一部分:功能丰富的 Perl

敬请期待该系列的后续内容。

在开始之前,您必须在您的系统上安装 Perl 5.005 或更新的版本(请参阅 参考资料中的链接,通过这些链接获取该版本)。您的系统最好安装了较新的(2000 年或之后的)主流 UNIX(Linux、Solaris 和 BSD 等等),但其它操作系统或许也行。对于较早版本的 Perl 和 UNIX 或者其它操作系统,本文所提供的示例或许可以使用 — 不过在这样的条件下出现无法使用的情况,就作为练习由读者自行解决。

绑定的变量对于所有 Perl 程序员都是一个重要的工具。重用使用 Tie::ScalarTie::ArrayTie::Hash 接口的现有代码确实是再简单不过了,但是不管您是想就此主题编写您自己的程序,还是只想优化对绑定变量的使用,理解内部工作原理都是非常有用的。

让我们来研究三类主要的绑定变量:标量、数组和散列。因为绑定文件句柄比较复杂,所以它们属于比较高级的主题。

对于本文中所提及的每个 CPAN 模块,您都可以使用 CPAN 界面来查看其实现。在 UNIX 提示符下输入“cpan”或“perl -MCPAN -eshell”,您将看到一个二级提示符。例如,输入“look Tie::Scalar::Timeout”来查看 Tie::Scalar::Timeout 模块,您将能够看到该模块的内容。

“绑定(tie)”变量是什么意思?这里,动词“tie(绑定)”是作为“bind(绑定)”的同义词来使用的。绑定变量基本上就是将函数绑定到内部触发器上以读写该变量。这意味着,作为一名程序员,在使用变量时您可以让 Perl 做额外的事情。如果从这个简单的前提出发,那么绑定接口已经演变为 Perl 中的面向对象方法了,它将 OOP 的复杂性隐藏在过程接口后面。

绑定标量

标量变量简单而又不可缺少。它只保存一段数据:一个字符串、一个数字、未定义的值以及对另一个变量的引用。变量前面的“$”告诉 Perl 将该变量作为标量处理。使用标量变量是一件非常容易的事情:

清单 1. 普通标量

my $a = 'Hello';
$a = 'there';
$a = 89.2;

使用绑定标量变量同样简单。例如,让我们以极佳的 Tie::Scalar::Timeout 模块为例:

清单 2. 绑定的标量

use Tie::Scalar::Timeout;
tie my $k, 'Tie::Scalar::Timeout', EXPIRES => '+2s';
$k = 123;
sleep(3);
# $k is now undef

第一部分,其中调用了 tie() 函数,演示了如何告诉 Perl 变量 $k 实际上绑定到了 Tie::Scalar::Timeout 包。在幕后,Perl 运行 Tie::Scalar::Timeout 模块的 TIESCALAR() 函数(这实质上有些象对一个常规对象调用 new() )。 TIESCALAR() 返回一个 Tie::Scalar::Timeout 类型的对象,该对象被赋给 $k

示例中传递给 Tie::Scalar::Timeout 的特定参数确保了它会在两秒钟之后超时。该模块还提供了其它选项,如在读了确定次数之后就超时。每次读取上个示例中创建的 $k 变量时,都会调用 Tie::Scalar::Timeout 模块中的 FETCH() 方法:

清单 3. Tie::Scalar::Timeout 在内部是如何运行的

sub FETCH {
        my $self = shift;
        # if num_uses isn't set or set to a negative value, it won't
        # influence the expiry process
        if (($self->{NUM_USES} == 0) ||
           (time >= $self->{EXPIRY_TIME})) {
                # policy can be a coderef or a plain value
                return &{ $self->{POLICY} } if ref($self->{POLICY}) eq 'CODE';
                return $self->{POLICY};
        }
        $self->{NUM_USES}-- if $self->{NUM_USES} > 0;
        return $self->{VALUE};
}

每次写绑定标量变量时,都会调用它的 STORE() 方法。标量也有 UNTIE()DESTROY() 方法,但通常不会用到。

注:绑定标量变量以及在此问题上的 任何绑定变量都需要将其实际数据存储在某个地方。对于 Tie::Scalar::Timeout ,数据存储在 $self->{VALUE} 中,因为标量变量 $k 实际上只是一个散列。Perl 通过创建一种封装向我们隐藏了这层复杂性,这种封装十分类似于 OOP 中的封装。

上面的代码意味着每次请求 $k 变量的值时,该值都 可能改变。因此,如果希望拥有自己的 Schroedinger 盒,那么只需使用 Tie::Scalar::Timeout 模块和一个 0 到 100 之间的随机超时,并在 50 秒时读取 $k 变量值。假定有一个好的随机数生成器,您将根据超时获得 1 或未定义值。我们假定程序中指令执行所花费的时间是可以忽略的,但实际上它还是会引入一些偏差。的确,我们只用确定 rand(100) 是否大于 50 就行了,但这又有什么乐趣呢?

清单 4. Schroedinger 的超时

      use Tie::Scalar::Timeout;
# the timeout will be between 0 and 99
my $random_timeout = rand 100; 
tie my $k, 'Tie::Scalar::Timeout', VALUE => 1, EXPIRES => "+${random_timeout}s";
sleep(50);
print 'The timeout ', 
      ($k) ? 'did not happen' : 'happened', 
      "\n";

如果超时发生了,那么逮住一只猫并对它射击的任务就留给了读者作为练习来完成。

绑定数组

数组比标量要复杂一些。它是标量的有序集合,因此需要额外的功能来处理它。数组有 TIEARRAY() (构造函数,类似于绑定数组的 new() )、 FETCH() / STORE() (含意和绑定标量中的相同,但有一些额外的参数)、 FETCHSIZE() / STORESIZE() (用于数组大小管理)以及 UNTIE()DESTROY() ,最后两个(例如)可以用于关闭文件或刷新输出。

同绑定标量中等同的函数比起来,绑定数组的 FETCH()STORE() 需要额外的参数。这个额外的参数就是数组中的下标。 FETCHSIZE()STORESIZE() 是调用 scalar( @ARRAY ) 和 $#ARRAY = x 时分别要用到的。

如果要用到对应的 Perl delete()exists() 函数,那么就需要实现 DELETE()EXISTS() 函数。

还有 POP()PUSH()SHIFT()UNSHIFT()SPLICE()EXTEND() 函数(其中的头五个函数对应于同名但名字是小写形式的 Perl 函数),但模块编写者通常都会继承 Tie::StdArray 并使用那些已经实现的方法。

例如,可以这样实现 POP() :对最后一个元素使用 FETCH() ,然后使用 STORESIZE(FETCHSIZE()-1) (将数组的大小减去 1,实际除去了最后一个元素)。当然,如果自己实现 POP() ,那么您要么完全知道您在做什么,要么完全不知道。

如果您想编写自己的绑定数组,那么请确保继承了 Tie::StdArray (请参阅“perldoc Tie::Array”)。所有的函数都已为您做了定义,并且您只需覆盖您想修改的函数 — 没必要另起炉灶。顺便说一下,绑定的数组正好是最复杂的绑定变量类型,而且根据我的统计在 CPAN 上也实现得最少。散列则没这么复杂。(如果您对实现细节感兴趣,那么请看 Tie::CharArray 源代码。)

作为绑定数组的示例,我们将研究 CPAN Tie::CharArray 模块。该模块允许程序员将字符串当作字符数组对待,或者作为数字代码或者作为单字符字符串。下面是该文档的一个示例:

清单 5. 作为数组的字符串

use Tie::CharArray;
my $foobar = 'a string';
tie my @foo, 'Tie::CharArray', $foobar;
$foo[0] = 'A';    # $foobar = 'A string'
push @foo, '!';   # $foobar = 'A string!'

对于这,C/C++/Java 程序员应该是“刻骨铭心”了。

注:如果将上面例子中的第 3 行写成

tie my @foo, 'Tie::CharArray', 'a string';

那么它将无法工作,并给出消息“Modification of a read-only value attempted”。事实上,‘a string’是一个不能修改的常量字符串。 @foo 数组直接使用传递给它的字符串,如果给它赋值就直接修改 原始字符串。

Tie::CharArray 实际上是不考虑有关 Perl 中 substr()pack() / unpack() 或者 split() 函数的细节的极佳办法。如果需要修改字符串中第 5 位到第 28 位的字符,那么您可以使用 substr()pack() / unpack() 或者 split() 。您也可以只写:

清单 6. 处理个别字母

use Tie::CharArray qw/chars/; 
$f = "jello is yellow"; 
my $chars = chars $f; 
foreach (5..28) 
{
 $chars->[$_] = "!";
};

您愿意使用哪一种方法(内置字符串操作或 Tie::CharArray )属于个人喜好,但清单 6 的可读性却是无庸置疑的。

绑定散列

现在我们要研究好东西了。绑定的散列比绑定的数组更易于编写,而且更有用。

绑定的散列实现 TIEHASH() 构造函数、 FETCH() / STORE() 访问方法、 EXISTS() / DELETE() 方法(二者所起的作用和 Perl 中的 exists()delete() 完全相象)、清除散列的 CLEAR() 以及用于遍历数组的 FIRSTKEY() / NEXTKEY() 。您完全可以继承 Tie::StdHash 包(位于 Tie::Hash perldoc 中),它定义了您需要的全部方法,这样您只需覆盖您想要的方法。

我们将在我的 Tie::Hash::TwoWay 模块中看到绑定散列的确切实现。该模块在内部维护两个散列,并在第一个散列获得数据时自动在第二个散列中创建反向映射。例如,如果您将键为“dog”的值 ["Fido"] 和键为“friend”的值 ["Fido"] 赋给 Tie::Hash::TwoWay 绑定散列(值必须在数组引用中),那么在同一个 Tie::Hash::TwoWay 绑定散列中将突然会出现一个带有值“dog”和“friend”的键“Fido”。请参阅该文档的示例:

清单 7. Tie::Hash::TwoWay 用法

use Tie::Hash::TwoWay;
tie %hash, 'Tie::Hash::TwoWay';
my %list = (
            Asimov => ['novelist', 'scientist'],
            King => ['novelist', 'horror'],
           );
foreach (keys %list)                  # these are the primary keys of the hash
{
 $hash{$_} = $list{$_};
}
# these will all print 'yes'
print 'yes' if exists $hash{scientist};
print 'yes' if exists $hash{novelist}->{Asimov};
print 'yes' if exists $hash{novelist}->{King};
print 'yes' if exists $hash{King}->{novelist};

Tie::Hash::TwoWay 继承了 Tie::StdHash 模块并覆盖了 STORE()FETCH()EXISTS()DELETE()CLEAR()FIRSTKEY()NEXTKEY() 方法。除此以外,它还定义了一个 secondary_keys() 方法来获取反向映射键。主键存储在 $self->{1} 中而辅键存储在 $self->{0} 中;数字常量具有符号名称 PRIMARY 和 SECONDARY,我个人以为这使它们可读性更好。

以下是 Tie::Hash::TwoWay 的代码,除了没有绑定/继承/初始化导言以及文档以外,其它都和模块中的一样。清单是按函数划分的。因为我们继承了 Tie::StdHash ,所以我们无需为实例定义 TIEHASH() 方法。我们仅仅重新定义需要修改其行为的方法。

清单 8. STORE() 函数

sub STORE
{
 my ($self, $key, $value) = @_;
 my $val_array_ref;
 if (ref $value eq 'ARRAY')		# array refs can be recognized
 {
  $val_array_ref = $value;
 }
 else			# everything else gets converted to array refs
 {
  $val_array_ref = [ $value ];
 }
 # add the values in the passed array to the primary and secondary hashes
 foreach my $value (@$val_array_ref)
 {
  $self->{SECONDARY}->{$value}->{$key} = 1;
  $self->{PRIMARY}->{$key}->{$value} = 1;
 }
 return 1;
}

STORE() 函数同时在主数组和辅数组(常规和反向映射)中创建一个项。数组被直接处理,其它任何东西都作为标量处理(并被插入数组引用中)。

清单 9. FETCH() 函数

# return the primary or secondary key, in that order (duplicate keys
# are not detected here)
sub FETCH
{
 my ($self, $key) = @_;
 
 exists $self->{PRIMARY}->{$key} &&
  return $self->{PRIMARY}->{$key};
 
 exists $self->{SECONDARY}->{$key} &&
  return $self->{SECONDARY}->{$key};
 
 return undef;
}

FETCH() 函数从主散列或辅散列检索键,这里优先检索主散列。(语句 1)&&(语句 2)这种逻辑快捷表示是一种常见的 Perl 习惯语法。

清单 10. EXISTS() 函数

# return the primary or secondary key existence, in that order
# (duplicate keys are not detected here)
sub EXISTS
{
 my ($self, $key) = @_;
 
 return undef unless (exists $self->{PRIMARY} &&
                      exists $self->{SECONDARY});
 
 return (exists $self->{PRIMARY}->{$key} ||
         exists $self->{SECONDARY}->{$key});
}

EXISTS() 函数依次检查正向和反向映射中是否存在某个键。

清单 11. DELETE() 函数

# delete the primary or secondary key, in that order (duplicate keys
# are not detected here)
sub DELETE
{
 my ($self, $key) = @_;
 
 return undef unless (exists $self->{PRIMARY} &&
                      exists $self->{SECONDARY});
 
 # make sure to delete reverse associations as well
 if (exists $self->{PRIMARY}->{$key})
 {
  
  foreach (keys %{$self->{SECONDARY}})
  {
   delete $self->{SECONDARY}->{$_}->{$key};
   delete $self->{SECONDARY}->{$_}
    unless scalar keys %{$self->{SECONDARY}->{$_}};
  }
  
  return delete $self->{PRIMARY}->{$key};
 }
 if (exists $self->{SECONDARY}->{$key})
 {
  foreach (keys %{$self->{PRIMARY}})
  {
   delete $self->{PRIMARY}->{$_}->{$key};
   delete $self->{PRIMARY}->{$_}
    unless scalar keys %{$self->{PRIMARY}->{$_}};
  }
  return delete $self->{SECONDARY}->{$key};
 }
}

删除函数略微有些复杂,因为我们还想删除正在删除的键的反向映射。因此,如果我们删除 a->b,那么我们也要除去 b->a(辅)映射,如果映射为空,还要除去映射的数组值。

清单 12. CLEAR() 函数

sub CLEAR
{
 my ($self, $key) = @_;
 %$self = ();                           # clear the whole hash
 return 1;
}

清除内部散列十分简单,而且我们可以继续使用该对象,因为 STORE() 中具有自动复活能力。

清单 13. FIRSTKEY() 和 NEXTKEY() 函数

sub FIRSTKEY
{
 my ($self) = @_;
 return undef unless (exists $self->{PRIMARY} &&
                      exists $self->{SECONDARY});
 return each %{$self->{PRIMARY}};
}
sub NEXTKEY
{
 my ($self, $lastkey) = @_;
 return undef unless (exists $self->{PRIMARY} &&
                      exists $self->{SECONDARY});
 return each %{$self->{PRIMARY}};
}

迭代器 FIRSTKEY()NEXTKEY() 看似复杂,但实际上它们只是让 each() 这一 Perl 函数来完成所有的工作而已。

清单 14. secondary_keys() 函数

sub secondary_keys
{
 my ($self) = @_;
 
 return undef unless (exists $self->{PRIMARY} &&
                      exists $self->{SECONDARY});
 
 return keys %{$self->{SECONDARY}};
}

由于 FIRSTKEY()NEXTKEY() 的常规 keys() 迭代只是对主键进行,因此 secondary_keys() 函数是为第二个映射提供的。

结束语

遗憾的是,由于绑定的文件句柄过于复杂,所以无法在本文中介绍。但它确实能够让人神往,例如,通过写/读文件句柄,可以直接写/读数据库,或者在关闭文件时发送一封电子邮件。

将磁盘(文件)数据库绑定到散列是一个得到了深入讨论的主题。您可以阅读“perldoc DB_File”文档、查看 Programming Perl Third Edition一书中的相关章节,或者在线阅读众多教程中的某一篇(请参阅 参考资料一节以获取一些资料的链接)。

即便如此,从我们这里所做的来看,您会发现绑定的变量十分有用,而且我鼓励您去深入了解众多处理绑定的变量的 CPAN 模块。您几乎肯定能够找到一个满足您需要的模块。


相关主题


评论

添加或订阅评论,请先登录注册

static.content.url=http://www.ibm.com/developerworks/js/artrating/
SITE_ID=10
Zone=Linux
ArticleID=21826
ArticleTitle=功能丰富的 Perl: 绑定的变量
publish-date=01092003