Sortowanie Perl; radzenie sobie z globalnymi pakietami $ a, $ b w przestrzeni nazw

Question

Załóżmy, że mam bibliotekę narzędzi (other) zawierającą podprogram (sort_it), którego chcę użyć do zwrócenia dowolnie sortowanych danych. To chyba bardziej skomplikowany niż ten, ale ten ilustruje kluczowych pojęć:

#!/usr/local/bin/perl 

use strict; 

package other; 

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

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

Teraz użyjmy go w innym opakowaniu.

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

To nie działa, ze względu na subtelny problem. $a i $b są pakietami globals. Odnoszą się one do $main::a i $main::b po zamknięciu w zamknięciu w .

Możemy rozwiązać ten problem, mówiąc, zamiast:

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

To działa, ale zmusza nas do hardcode nazwę naszego pakietu użytkowego wszędzie. Gdyby to się zmieniło, musielibyśmy pamiętać, aby zmienić kod , a nie tylko oświadczenie use other qw(sort_it);, które prawdopodobnie byłby w rzeczywistości rzeczywiste w postaci .

Możesz od razu pomyśleć, aby spróbować użyć __PACKAGE__. To powoduje, że jest oceniany jako "główny". Tak samo jest z eval("__PACKAGE__");.

Jest trik, który działa za pomocą 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'}); 
}; 

Ale to raczej czarno-magiczne. Wygląda na to, że powinno być lepsze rozwiązanie tego problemu. Ale jeszcze tego nie znalazłem ani nie wymyśliłem, .

Answer 1

Użyj prototypu (rozwiązanie pierwotnie proponowane w Usenet posting przez ysth).

Działa w Perlu> = 5.10.1 (nie jestem pewien wcześniej).

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

uzyskać w wyniku:

$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

Oto jak to zrobić:

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 konieczna jest tutaj ponieważ package zajmuje tylko gołe nazwę pakietu, a nie zmienną .

Answer 3

Spróbuj tego:

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

I nie zapłaci głową w każdej rozmowie.

Ale wolałbym

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