Perl排序；干净地处理跨命名空间的 $a、$b 包全局变量

Question

假设我有一个包含子例程的实用程序库 (other) (sort_it) 我想用它来返回任意排序的数据。 它可能比这更复杂，但这说明了 关键概念：

#!/usr/local/bin/perl

use strict;

package other;

sub sort_it {
  my($data, $sort_function) = @_;

  return([sort $sort_function @$data]);
}

现在让我们在另一个包中使用它。

package main;
use Data::Dumper;

my($data) = [
        {'animal' => 'bird',            'legs' => 2},
        {'animal' => 'black widow',     'legs' => 8},
        {'animal' => 'dog',             'legs' => 4},
        {'animal' => 'grasshopper',     'legs' => 6},
        {'animal' => 'human',           'legs' => 2},
        {'animal' => 'mosquito',        'legs' => 6},
        {'animal' => 'rhino',           'legs' => 4},
        {'animal' => 'tarantula',       'legs' => 8},
        {'animal' => 'tiger',           'legs' => 4},
        ],

my($sort_by_legs_then_name) = sub {
    return ($a->{'legs'}   <=> $b->{'legs'} ||
            $a->{'animal'} cmp $b->{'animal'});
};

print Dumper(other::sort_it($data, $sort_by_legs_then_name));

由于一个微妙的问题，这不起作用。 $a 和 $b 是包 全局变量。他们指的是$main::a 和$main::b 关闭。

我们可以通过以下方式解决这个问题：

my($sort_by_legs_then_name) = sub {
    return ($other::a->{'legs'}   <=> $other::b->{'legs'} ||
            $other::a->{'animal'} cmp $other::b->{'animal'});
};

这可行，但会迫使我们硬编码实用程序包的名称 到处。如果要改变，我们需要记住改变 代码，而不仅仅是use other qw(sort_it); 可能的语句 出现在现实世界中。

您可能会立即考虑尝试使用__PACKAGE__。那风 向上评估为“主要”。 eval("__PACKAGE__");也是如此。

有一个使用caller 的技巧有效：

my($sort_by_legs_then_name) = sub {
  my($context) = [caller(0)]->[0];
  my($a) = eval("\$$context" . "::a");
  my($b) = eval("\$$context" . "::b");

  return ($a->{'legs'}   <=> $b->{'legs'} ||
          $a->{'animal'} cmp $b->{'animal'});
};

但这是相当黑魔法的。好像应该有 一些更好的解决方案。但我还没有找到或想通 还没出来。

Answer 1

使用原型（由ysth 最初在Usenet posting 中提出的解决方案）。

适用于 Perl >= 5.10.1（之前不确定）。

my($sort_by_legs_then_name) = sub ($$) {
    my ($a1,$b1) = @_;
    return ( $a1->{'legs'} <=> $b1->{'legs'} ||
            $a1->{'animal'} cmp $b1->{'animal'});
};

我得到了结果：

$VAR1 = [
      {
        'legs' => 2,
        'animal' => 'bird'
      },
      {
        'legs' => 2,
        'animal' => 'human'
      },
      {
        'legs' => 4,
        'animal' => 'dog'
      },
      {
        'legs' => 4,
        'animal' => 'rhino'
      },
      {
        'legs' => 4,
        'animal' => 'tiger'
      },
      {
        'legs' => 6,
        'animal' => 'grasshopper'
      },
      {
        'legs' => 6,
        'animal' => 'mosquito'
      },
      {
        'legs' => 8,
        'animal' => 'black widow'
      },
      {
        'legs' => 8,
        'animal' => 'tarantula'
      }
    ];

Answer 2

试试这个：

sub sort_it {
  my($data, $sort_function) = @_;
  my($context) = [caller(0)]->[0];
  no strict 'refs';
  local *a = "${context}::a";
  local *b = "${context}::b";
  return([sort $sort_function @$data]);
}

而且您不会在每次通话中支付间接费用。

但我更喜欢

sub sort_it (&@) {
  my $sort_function = shift;
  my($context) = [caller(0)]->[0];
  no strict 'refs';
  local *a = "${context}::a";
  local *b = "${context}::b";
  return([sort $sort_function @_]);
}

Answer 3

这是怎么做的：

sub sort_it {
    my ($data, $sort) = @_;
    my $caller = caller;
    eval "package $caller;"    # enter caller's package
       . '[sort $sort @$data]' # sort at full speed
      or die $@                # rethrow any errors
}

这里需要eval，因为package 只接受一个裸包名，而不是一个变量。