魔法关联标量
Perl的tie机制允许我创建看起来像标量但可以做任何我想让它做的事情。我可以改变熟悉的标量接口（简单访问和赋值）的实际工作方式。我有时发现这个功能非常有用，以至于我在精通Perl中为此专门写了一章。
我想我是爱上这项技术了，因为它让我能够手动创建一些HTML，解决了看似无法解决的问题（所以你知道这一定是很久以前的事情了）。有人创建了一个库来创建HTML表格，允许我通过传递标量值给tr的bgcolor属性来设置表格行的颜色。幸运的是，我已经忘记了那是谁或代码看起来像什么，但大概是这个样子
sub print_table_and_stuff {
my( $color, @lots_of_other_arguments ) = @_;
... lots of code ...
print "<table>";
foreach my $item ( @items ) {
print qq(<tr bgcolor="$color">);
... fill in the cells ...
print "</tr>";
}
... lots of code ...
}除了代码中发生的所有愚蠢的事情，比如直接打印而不使用模板，写这个代码的人没有考虑到有人想要有交替（甚至是旋转）的行颜色。在那之前，这还不是一件事情，代码甚至在那之前。我的任务是以尽可能少的干扰来实现交替行颜色。
我可以使用我在精通Perl中展示的技术之一替换子程序，但有一个更简单的方法。如果我能让$color自己改变，我就不必修改代码。
因此，我发明了Tie::Cycle。tie接口允许我决定当访问或存储标量时它应该做什么。我通过定义特殊子程序为这两个操作提供代码。以下是显示这些特殊方法的代码片段
package Tie::Cycle;
use strict;
sub TIESCALAR {
my( $class, $list_ref ) = @_;
my $self = bless [], $class;
unless( $self->STORE( $list_ref ) ) {
carp "Argument must be an array reference";
return;
}
return $self;
}
sub FETCH {
my( $self ) = @_;
my $index = $self->[CURSOR_COL]++;
$self->[CURSOR_COL] %= $self->_count;
return $self->_item( $index );
}
sub STORE {
my( $self, $list_ref ) = @_;
return unless ref $list_ref eq ref [];
my @shallow_copy = map { $_ } @$list_ref;
$self->[CURSOR_COL] = 0;
$self->[COUNT_COL] = scalar @shallow_copy;
$self->[ITEM_COL] = \@shallow_copy;
}tie接口包括创建tied对象的TIESCALAR方法，决定如何返回值的FETCH方法，以及决定如何存储值的STORE方法。在这种情况下，我想存储一个值数组并循环遍历它们。每次我访问标量时，Perl都会调用FETCH。每次它调用FETCH时，我都会增加一个计数器，这样我就会得到下一个值。当我到达数组末尾时，我会自动回到数组的开头。
在这段简短的代码中，我通过调用带有目标标量、定义接口的模块名称和传递给TIESCALAR的参数的tie来创建关联标量。之后，我像使用正常标量一样使用$scalar。
use v5.10;
use Tie::Cycle;
tie my $scalar, 'Tie::Cycle', [ qw(red green blue) ];
my $count;
while( $count++ < 10 ) {
say $scalar;
}每次通过while循环时，我都会输出$scalar的值。看起来我并没有做什么复杂的事情，但我每次都隐式地调用Tie::Cycle::FETCH。现在颜色在旋转。
当通过彩色框循环时，这会更加有趣
use v5.10;
use open qw(:std :utf8);
use Tie::Cycle;
use Term::ANSIColor;
tie my $scalar, 'Tie::Cycle', [
map { colored( [ $_ ], "\x{25AE}" ) }
qw(red green blue)
];
my $count;
while( $count++ < 10 ) {
print $scalar;
}
print "\n";在合适的终端上，我看到一串圣诞灯
最近，David Farrell遇到了一个类似的问题。他可以将一个值传递给一个方法，该方法在失败时会有一个延迟时间来重试。这是一个很好的特性，但他只能传递标量。他不想传递两秒的值，然后每两秒重试一次。相反，他想要退避。第一次等待两秒，然后是四次，然后是八次。如果你因为太频繁地撞击它而使某物跌倒，你想要减轻压力。
然而，使用与HTML行颜色相同的技巧，他能够创建一个看起来像简单的标量变量，但实际上是一个每次增加值的函数调用
use strict;
use warnings;
package Tie::Scalar::Ratio;
use parent 'Tie::Scalar';
sub TIESCALAR {
my ($class, $ratio, $value) = @_;
die 'Must provide ratio argument, a number to multiply the scalar value by'
unless $ratio && $ratio =~ /^[\d.]+$/;
bless {
ratio => $ratio,
value => $value,
}, $class;
}
sub STORE {
my ($self, $value) = @_;
$self->{value} = $value;
}
sub FETCH {
my ($self) = @_;
my $old_value = $self->{value};
$self->{value} *= $self->{ratio} if $self->{value};
return $old_value;
}
1;我演示这个程序的部分几乎和我先前的程序一样。我使用$scalar的部分是相同的。
use v5.10;
use Tie::Scalar::Ratio;
tie my $scalar, 'Tie::Scalar::Ratio', 2, 37;
my $count;
while( $count++ < 10 ) {
say $scalar;
}每次我访问标量时，都会返回上一次值乘以比率。在这种情况下，我每次都把上一次的值乘以2。
这是一个整洁的解决方案，因为它可以很好地融入现有的代码。期望得到单个值的现有代码现在得到了一个每次都改变值的标量。
我不想直接提供
use strict;
use warnings;
package Tie::Scalar::Callback;
use parent 'Tie::Scalar';
use Carp qw(carp);
sub TIESCALAR {
my ($class, $sub ) = @_;
die 'Must provide subroutine reference argument'
unless $sub && ref $sub eq ref sub {};
bless $sub, $class;
}
sub STORE {
carp "You can't assign to this tied scalar";
}
sub FETCH {
my ($self) = @_;
return $self->();
}
1;这是一个子程序，它执行与上一个示例相同的功能，但它将状态存储在子程序中，而不是在绑定的对象中
my $coderef = sub {
state $value = 1/2;
state $factor = 2;
$value *= $factor;
}
tie my $scalar, 'Tie::Scalar::Callback', $sub;
my $count;
while( $count++ < 10 ) {
say $scalar;
}这是一个简单的回调，但我可以做一些更奇特的事情。比如基于正弦函数的函数？
use v5.10;
use Tie::Scalar::Callback;
my $coderef = sub {
state $pi = 3.14152926;
state $eighth = $pi / 8;
state $value = 0;
sprintf '%.3f', abs sin( $value += $eighth );
};
tie my $scalar, 'Tie::Scalar::Callback', $coderef;
my $count;
while( $count++ < 10 ) {
say $scalar;
}现在输出减慢并加速。可能有些东西更有用。也许我想使用平均负载来决定数字
use Sys::LoadAvg qw(loadavg);
use Tie::Scalar::Callback;
my $coderef = sub {
state $factor = 5;
my @loads = loadavg();
$factor * $loads[-1];
};
tie my $scalar, 'Tie::Scalar::Callback', $coderef;最后，为了好玩，这里有一个绑定的标量，它使用v5.14中引入的inline package NAMESPACE BLOCK语法创建斐波那契数列
use v5.14;
package Tie::Scalar::Fibonacci {
use parent 'Tie::Scalar';
use Carp qw(croak);
use List::Util qw(sum);
sub TIESCALAR {
my( $class, $count ) = @_;
$count = 2 unless defined $count;
die "count must be a counting number" if $count =~ /[^0-9]/;
die "count must be greater than 1" if $count <= 1;
my $array = [ ( 1 ) x ( $count ) ];
bless $array, $class
}
sub STORE { croak "You can't assign to this scalar!" }
sub FETCH {
my ($self) = @_;
push @$self, sum( @$self );
shift @$self;
}
}
tie my $scalar, 'Tie::Scalar::Fibonacci';
my $count;
while( $count++ < 10 ) {
print $scalar, ' ';
}
print "\n";每次我访问它时，我都会得到斐波那契数列中的下一个数字。奇怪的是，这样计算时，我通过将其推到末尾来计算将来会使用的数字，并通过将其移到前端来返回最老的价值。这与互联网上几乎所有示例中的递归不同。
但是，它可以生成其他数列。我不需要查看前两个值，而是可以给TIESCALAR一个不同的数字来指定要累加多少个前面的数字
tie my $scalar, 'Tie::Scalar::Fibonacci', 5;
my $count;
while( $count++ < 10 ) {
print $scalar, ' ';
}
print "\n";这个想法是相同的，但求和不同。如果你以有趣的方式使用了绑定的变量，请告诉我们！
这篇文章最初发布在PerlTricks.com上。
标签
brian d foy
brian d foy是一位Perl培训师和作家，也是Perl.com的高级编辑。他是Mastering Perl、Mojolicious Web Clients、Learning Perl Exercises的作者，以及Programming Perl、Learning Perl、Intermediate Perl和Effective Perl Programming的合著者。
查看他们的文章
反馈
这篇文章有什么问题吗？通过在GitHub上打开一个问题或pull请求来帮助我们。
