ordinamento Perl; si occupa di globulare di pacchetti $ a, $ b in tutti i namespace

Question

Supponiamo di avere una libreria di utilità (other) contenente una subroutine (sort_it) che voglio utilizzare per restituire dati ordinati in modo arbitrario. E 'probabilmente più complicato di questo, ma questo illustra i concetti chiave:

#!/usr/local/bin/perl 

use strict; 

package other; 

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

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

Ora cerchiamo di utilizzarlo in un altro pacchetto.

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

Questo non funziona, a causa di un problema sottile. $a e $b sono pacchetti globali . Si riferiscono a $main::a e $main::b quando sono chiusi nella chiusura .

Potremmo risolvere questo problema dicendo, invece:

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

Questo funziona, ma ci costringe a codificare il nome del nostro pacchetto di utilità ovunque. Se dovessimo cambiare, dovremmo ricordare di cambiare il codice , non solo la dichiarazione use other qw(sort_it); che probabilmente sarebbe presente nel mondo reale con .

Si potrebbe pensare immediatamente di provare a utilizzare __PACKAGE__. Ciò rafforza la valutazione di in "main". Così fa eval("__PACKAGE__");.

C'è un trucco usando caller che funziona:

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

Ma questo è piuttosto nero-magica. Sembra che ci dovrebbe essere una soluzione migliore a questo. Ma non l'ho ancora trovato o non l'ho ancora immaginato .

Answer 1

Utilizzare il prototipo (soluzione originariamente proposta in Usenet posting per ysth).

Funziona su Perl> = 5.10.1 (non sono sicuro di prima).

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

ottengo come risultato:

$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

Ecco come fare:

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 è necessario qui perché package richiede solo un nome di pacchetto a nudo, non è una variabile .

Answer 3

Prova questo:

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

E non si paga in testa in ogni chiamata.

Ma io preferirei

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