clasificación Perl; lidiar con paquetes globales de $ a, $ b en espacios de nombres limpiamente

Question

Supongamos que tengo una biblioteca de utilidad (other) que contiene una subrutina (sort_it) que deseo utilizar para devolver datos ordenados arbitrariamente. Es probable que sea más complicado que esto, pero esto ilustra los conceptos clave:

#!/usr/local/bin/perl 

use strict; 

package other; 

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

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

Ahora vamos a utilizar en otro paquete.

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

Esto no funciona, debido a un problema sutil. $a y $b son paquete globales. Se refieren a $main::a y $main::b cuando se envuelve en el cierre.

Podríamos arreglar esto diciendo, en su lugar:

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

Esto funciona, pero nos obliga a codificar el nombre de nuestro paquete de utilidades todas partes. Si eso cambiara, tendríamos que recordar cambiar el código , no solo la declaración use other qw(sort_it); que probablemente esté presente en el mundo real.

Puede pensar inmediatamente que intente utilizar __PACKAGE__. Que vientos hasta la evaluación de "principal". Lo mismo ocurre con eval("__PACKAGE__");.

Hay un truco que funciona usando 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'}); 
}; 

pero esto es más bien negro-mágico. Parece que debería haber alguna mejor solución para esto. Pero todavía no lo encontré o lo calculé .

Answer 1

Utilice el prototipo (solución propuesta originalmente en Usenet posting por ysth).

Funciona en Perl> = 5.10.1 (no estoy seguro de antes).

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

me sale como resultado:

$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

Aquí es cómo hacerlo:

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 que se necesita aquí porque package sólo toma un nombre de paquete desnudo, no una variable .

Answer 3

Prueba esto:

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

Y usted no tendrá que pagar por encima en cada llamada.

Pero preferiría

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