Phân loại Perl; đối phó với $ a, $ b gói globals qua namespaces sạch

Question

Giả sử tôi có một thư viện tiện ích (other) có chứa một chương trình con (sort_it) mà tôi muốn sử dụng để trả về dữ liệu được sắp xếp tùy ý. Đây có thể là phức tạp hơn này, nhưng điều này minh họa khái niệm then chốt:

#!/usr/local/bin/perl 

use strict; 

package other; 

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

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

Bây giờ chúng ta hãy sử dụng nó trong một gói khác.

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)); 

Điều này không hiệu quả, do sự cố tinh tế. $a và $b là gói hình cầu. Chúng tham chiếu đến $main::a và $main::b khi được gói trong số việc đóng.

Chúng ta có thể khắc phục điều này bằng cách nói rằng, thay vì:

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

này hoạt động, nhưng buộc chúng ta phải hardcode tên của chúng tôi gói tiện ích ở khắp mọi nơi. Để thay đổi, chúng tôi cần ghi nhớ để thay đổi mã số , không chỉ là tuyên bố use other qw(sort_it); có khả năng là có mặt trong thế giới thực.

Bạn có thể nghĩ ngay để thử sử dụng __PACKAGE__. Gió đó đánh giá thành "chính". Vì vậy, không eval("__PACKAGE__");.

Có một mẹo sử dụng caller rằng hoạt động:

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'}); 
}; 

Nhưng điều này là khá đen huyền diệu. Có vẻ như phải có một số giải pháp tốt hơn cho việc này. Nhưng tôi chưa tìm thấy hoặc đã tìm thấy nó .

Answer 1

Sử dụng mẫu thử nghiệm (giải pháp ban đầu được đề xuất trong Usenet posting bởi ysth).

Hoạt động trên Perl> = 5.10.1 (không chắc chắn về trước đó).

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

tôi nhận được kết quả là:

$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

Sau đây là cách để làm điều đó:

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 là cần thiết ở đây vì package chỉ mất một tên gói trần, không phải là một biến .

Answer 3

Hãy thử điều này:

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

Và bạn sẽ không phải trả chi phí trong mỗi cuộc gọi.

Nhưng tôi muốn

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