问题 Perl排序;干净地处理命名空间中的$ a，$ b包全局变量

假设我有一个实用程序库（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'});
};

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

1982

2017-09-30 00:55

起源

如果你使用这样的调用者，如果定义sub的包和调用other :: sort_it的包不同，它会不会破坏它？ - aschepler

答案:

使用原型（最初提出的解决方案 Usenet发布通过 YSTH）。

适用于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'
      }
    ];

2017-09-30 01:28

我想知道Perl6 ::占位符是否也能正常工作？（search.cpan.org/~lpalmer/Perl6-Placeholders-0.07/lib/Perl6/...） - DVK

改变是在 Perl 5.6。有一个记录性能损失虽然这样做。 - Chas. Owens

与使用匿名子例程相比，性能损失并不是那么糟糕，但两者都明显慢于使用块： gist.github.com/603932 这是一个抽象可能不是你的朋友。 - Chas. Owens

尝试这个：

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 @_]);
}

2017-09-30 11:53

这是怎么做的：

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 只采用裸包名称，而不是变量。

2017-09-30 02:58

问题 Perl排序;干净地处理命名空间中的$ a，$ b包全局变量

答案:

热门问题