En (raras) ocasiones queremos eliminar completamente una subrutina.
Las ocasiones en las que he visto en la necesidad de hacerlo son aquellas en las
que la existencia de una subrutina afecta de forma no deseada
al comportamiento de otra
(recuerde que en Perl una subrutina puede saber dinámicamente
si cierta subrutina existe mediante el uso de can
).
La distribución Parse::Eyapp provee el módulo Parse::Eyapp::Base el cual provee las funciones delete_method e insert_method para suprimir y bautizar subrutinas. Vea un ejemplo de uso:
pl@nereida:~/LEyapp/examples$ cat -n localwithinsert.pl 1 #!/usr/local/bin/perl -w 2 use strict; 3 4 package Tutu; 5 use Parse::Eyapp::Base qw(:all); 6 7 my $tutu = sub { 8 "inside tutu\n" 9 }; 10 11 sub plim { 12 insert_method(_tutu => $tutu); 13 14 print _tutu(); 15 16 delete_method('_tutu'); 17 } 18 19 package main; 20 21 Tutu::plim(); 22 print(main->can('Tutu::_tutu')? (Tutu::_tutu()."\n") : "Can't do tutu\n"); 23 Tutu::plim();Cuando se ejecuta el código anterior produce la salida:
pl@nereida:~/LEyapp/examples$ localwithinsert.pl inside tutu Can't do tutu inside tutu
La subrutina delete_method('subname', qw{class1 class2 class3})
elimina la subrutina subname
en los paquetes Class1
,
Class2
y Class1
:
pl@nereida:~/LEyapp/lib/Parse/Eyapp$ sed -ne '144,172p' Base.pm | cat -n 1 sub delete_method { 2 my $name = pop; 3 $name = '' unless defined($name); 4 croak "Error in delete_method: Illegal method name <$name>\n" unless $name =~/^\w+$/; 5 my @classes = @_; 6 7 @classes = scalar(caller) unless @classes; 8 no strict 'refs'; 9 for (@classes) { 10 croak "Error in delete_method: Illegal class name <$_>\n" unless /^[\w:]+$/; 11 unless ($_->can($name)) { 12 print STDERR "Warning in delete_method: No sub <$name> to delete in package <$_>\n"; 13 next; 14 } 15 my $fullname = $_."::".$name; 16 17 # Temporarily save the other entries 18 my @refs = map { *{$fullname}{$_} } qw{HASH SCALAR ARRAY GLOB}; 19 20 # Delete typeglob 21 *{$fullname} = do { local *{$fullname} }; 22 23 # Restore HASH SCALAR ARRAY GLOB entries 24 for (@refs) { 25 next unless defined($_); 26 *{$fullname} = $_; 27 } 28 } 29 }Se salvan las referencias a los viejos valores de los diversos tipos con un typeglob selectivo:
my @refs = map { *{$fullname}{$_} } qw{HASH SCALAR ARRAY GLOB}Después se elimina la entrada del typeglob usando
local
:
*{$fullname} = do { local *{$fullname} }La expresión
local *{$fullname}
elimina temporalmente
el typeglob (lo deja undef
) y retorna el typeglob. Como queremos hacer permanente
la eliminación del typeglob. Véase el siguiente ejemplo
ilustrativo con el depurador:
lhp@nereida:~/Lperl/src/perl_networking/ch2$ perl -wde 0 main::(-e:1): 0 DB<1> @x = 1..5; $x = 'hola' DB<2> $c = 'x' DB<3> x local *{$c} 0 *main::x DB<4> p $x hola DB<6> x *{$c} = { local *{$c} } Odd number of elements in anonymous hash at (eval 10)[/usr/share/perl/5.8/perl5db.pl:628] line 2. DB<7> x *{$c} = do { local *{$c} } 0 *main::x DB<8> print $x Use of uninitialized value in print at (eval 12)[/usr/share/perl/5.8/perl5db.pl:628] line 2.
y por último se restauran los viejos valores excepto el de código.
Casiano Rodríguez León