【转】浅谈typeglob

原文链接：http://www.cnitblog.com/gyn/archive/2007/08/20/9094.html

本文是对《 advanced perl programming 》 edition 2 中有关 typeglob 的叙述，但不是一字一句的直译，又不能讲就是意译，因为加了一点个人浮浅的理解，所以叫浅谈。

 

 

符号表

当程序使用一个全局变量时， perl 解析器会在一个符号表中查找这个变量名。可以这么认为：符号表完成了变量的名字到实际存储区域的映射。

                           Symbol table

                           |    A     | -------- à | 3 |

                           |    B     |--------- à | 2 | 

                           |    C     |

                           |    D     |

图 1

请注意，是变量的名称而不是变量，这一点很特别，可以说符号表中 a 映射了一个到 $a 的内存区域，实际的情况更复杂。 perl 中有几种基本数据结构： $a， @a ， %a ， &a 和文件或目录句柄 a ，它们都有同样的变量名称只是前缀不一样，于是就有了 glob 的概念。 

 

         图2

正如上图所示符号表把 b 映射一个 glob 。对 glob 的描述大概可以这么讲：它是包含了各个名为 b 的变量的引用的 hash 结构，它叫做 *b 。

*b{SCALAR}=\$b;

*b{HASH}=\%b;

*b{ARRAY}=\@b;

…….

够诡异的了！

 

别名

很明显 glob 把名称与引用无情地分开了，好处大概就是可以很方便地取别名。简单地把 *b 赋值给 *c ，就是 *c=*b ，产生地结果就是这样： 

 
                                     图 3

两个名称指向了同一个 glob ，现在这个 glob 既叫 *b 又叫 *c 。

现在应该有些思路了，举个例子说： %c 地解析过程可以这么认为， perl 先在符号表中找到 c 所映射的 glob ，然后在 glob 中找到前缀为 % 的引用，最后返回存储位置。最常见体现这个思想的代码如下。

package Some::Module;

  use base ‘Exporter’;

  our @EXPORT=qw(useful);

  sub useful{42;}

Exporter 的作用就是将 useful 从包中传出到调用者那里。基本的工作原理如下。

  package Some::Module;

  sub useful{42;}

  sub import{

  no strict ‘refs’;

  *{call().”::useful”} = *useful;

  }

import 子程序在包被 use 时将自动被调用。在调用者代码中的 useful 子程序最终将被指向 Some::Module::useful 。

 
                                图 4

之所以要用 no strict ‘ref’; 是因为如果调用者的代码中使用了 use strict 的话，将产生错误。把上面的代码再简单点比喻一下就是：

  $answer =42;

  $variable = “answer”;

  print ${$variable};

一个道理。

 

分解 glob

在上面的这个例子中，我们将 useful 的名称映射到了 Some::Module::useful 的 glob （或者说为 Some::Module::useful 的 glob 取了个别名），这会带来一些影响。比如说：

  use Some::module;

  our $useful=”Some handy string”;

  print $Some::Modile::useful;

因为 useful 和 Some::Modile::useful 映射同一个 glob 的关系，输出的结果是 ”Some handy string” 。但实际的情况是，我们只希望 useful 指向子程序Some::Modile::useful ，而不是整个 glob 。 Perl 提供了映射部分引用的办法。如果是希望仅仅映射标量或数组的话，可以这样：

  ${caller(  )."::useful"} = $useful;

  @{caller(  )."::useful"} = @useful;

但是对于子程序，如果也这么做：

  &{caller(  )."::useful"} = &useful;

首先 perl 会运行 &usefule 得到 42 ，然后将 42 赋值给运行 &{caller(  )."::useful"} 所产生的结果，但 &{caller(  )."::useful"} 根本是不存在的，于是错误产生了。为了解决这个问题， glob 这个诡异的机构提供了一个重载过的“ = ”方法。像 *b=\@c 的操作可以给 *b 添加一个到 @c 的引用。 @b 和@c 任何一方的变化都将反映对方上。

 

图 5

*b 中除了又一个引用指向 @c 外，其他的引用都没有变化。正是有了“ = ”这个方法，我们可以随心所欲在 glob 中指定引用。

  *a = \"Hello";

  *a = [ 1, 2, 3 ];

  *a = { red => "rouge", blue => "bleu" };

  print $a;        # Hello

  print $a[1];     # 2

  print $a{"red"}; # rouge

后一个对 *a 的赋值并没有替换前面的赋值，只是加入了个不同类型的引用。有一个不得不讲的例外，如果 *a 被加入了一个到常量的引用，那么该变量的值将是不能改变的。

  *a=\1234;

  $a=10;  

这么做是徒劳的， perl 将返回“ modification of a ready-only value attempt ”的错误信息。

现在可以着手解决本节开始时遇到的那个问题了：

  sub useful{42}

  sub import{

no strict ‘refs’;

*{caller().”::userful”} = \&useful;

}

这已经跟 Exporter 的实际工作原理很接近了。

 

Exporter 核心代码的分析

  my $pkg = shift;

  my $callpkg = caller($ExportLevel); ＃ $ExportLevel = 0

  foreach $sym(@imports){

(*{${callpkg}::$sym}) = \&{“${pkg}::$sym”}, next)

  unless $sym =~ s/^(\W)//;

  $style = $1;

  *{${callpkg}::$sym}) =

$style eq ‘&’ ? \&{“${pkg}::$sym”} :

$style eq ‘$’ ? \${“${pkg}::$sym”} :

$style eq ‘@’ ? \@{“${pkg}::$sym”} :

$style eq ‘%’ ? \%{“${pkg}::$sym”} :

$style eq ‘*’ ? *{“${pkg}::$sym”} :

do {require Carp; Carp::croak(Can’t export symbol:$sym)};

  }

我们通过 @Export 数组传入需要输出的变量。如果变量不带前缀，那么直接在最顶层调用名称的 glob 中加入被引用模块相应子程序的引用。如果有前缀，那么将前缀去掉。

  (*{${callpkg}::$sym}) = \&{“${pkg}::$sym”}, next)

  unless $sym =~ s/^(\W)//;

去掉的前缀将被赋值给 $style ，然后检验 $style 的类型，并具此返回相应类型的引用。

  $style = $1;

  *{${callpkg}::$sym}) =

$style eq ‘&’ ? \&{“${pkg}::$sym”} :

$style eq ‘$’ ? \${“${pkg}::$sym”} :

$style eq ‘@’ ? \@{“${pkg}::$sym”} :

$style eq ‘%’ ? \%{“${pkg}::$sym”} :

$style eq ‘*’ ? *{“${pkg}::$sym”} :

do {require Carp; Carp::croak(Can’t export symbol:$sym)};

如果传入的值与以上各种情况都不匹配，那么就调用 croak 中止顶层程序。

 

使用 glob 建立子程序

给 glob 分配一个到匿名子程序的引用是别名技术在高级 perl 编程中的一个普遍应用。举个例子：有一个叫 Data::BT::PhoneBill 的模块，它被用于在英国电信公司的电话帐单服务中检索数据。这个模块将一个电话中的信息按照逗号分开，并将它们对象化。

  package Data::BT::PhoneBill::_Call;

  sub new{

  my ($Class,@data) = @_;

  bless \@data, $Class;

}

sub installation {shift->[0]}

sub line {shift->[1]}

…..

这样做的结果是不大好维护。如果我们打算在在数据的开头处添加一个新的条目，那么就需要修改大半块代码，将数组编号集体下移。为了避免这种情况的发生，应用 hash 来替换不方便的 array 。

  our @field = qw(type installation line chargecard _data time destination _number duration _rebat cost);

  sub new{

my ($class @data) = @_;

bless {map {$field[$_] => $data[$_]} 0..$#field => $class;}

  }

  sub type {shift->{type}}

  sub installation {shift->{installation}}

  ….

只需要在代码中加入重复的 3 个词，我们就可以为模块添加一个新的条目。这比上面那个方便不少，但是如果待加入的条目名称是这样的：friend_and_family_duscount ，那么重复 3 遍的工作也够麻烦的了。于是就要用到 glob 。

  Foreach my $f(@field){

    no strict ‘refs’;

*f = sub { shift->{$f}};

  }