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

使用原型（Usenet posting,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' 
     } 
    ]; 

Answer 2

這裏是如何做到這一點：

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只需要裸包名稱，而不是一個變量。

Answer 3

試試這個：

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