La escritura de los métodos get/set es monótona y pesada. Si el objeto tiene 20 atributos habrá que escribir un buen número de métodos.
Podemos usar AUTOLOAD para que, cada vez que se llama a un método de acceso se instale en la tabla de símbolos. Para ello usaremos un ''typeglob'' y una subrutina anónima.
Sigue el código:
1 sub AUTOLOAD { 2 no strict "refs"; 3 4 my $self = shift; 5 if ($AUTOLOAD =~ /\w+::\w+::get(_.*)/) { 6 my $n = $1; 7 die "Error in $AUTOLOAD: Illegal attribute\n" unless exists $self->{$n}; 8 9 # Declarar el metodo get_***** 10 *{$AUTOLOAD} = sub { return $_[0]->{$n}; }; 11 12 return $self->{$n}; 13 } elsif ($AUTOLOAD =~ /\w+::\w+::set(_.*)/) { 14 my $n = $1; 15 die "Error in $AUTOLOAD: Illegal attribute\n" unless exists $self->{$n}; 16 $self->{$n} = shift; 17 18 # Declarar el metodo set_***** 19 *{$AUTOLOAD} = sub { $_[0]->{$n} = $_[1]; }; 20 } else { 21 die "Error: Function $AUTOLOAD not found\n"; 22 } 23 }En la línea 5 obtenemos el nombre del atributo y lo guardamos (línea 6) en
$n
. En la línea 7 comprobamos que tal atributo existe.
La subrutina anónima que crea AUTOLOAD
en la línea 10 es una clausura con respecto a $n
:
el valor se recuerda, incluso después que se haya
salido del ámbito.
Obsérvese la asignación de la línea 10:
*{$AUTOLOAD} = sub { return $_[0]->{$n}; };Esto hace que se instale una entrada con el nombre del método deseado en la tabla de símbolos.
El use strict
hace que el compilador se queje, ya que el
lado derecho es una referencia a subrutina y el lado izquierdo un ''typeglob'':
~/perl/src> use_Biblio_Doc.1.pl Can't use string ("get_author") as a symbol ref while "strict refs" in use at Biblio/Doc1.pm line 36. Has llamado a Biblio::Doc1::DESTROY() y no existe!Podemos hacer que la queja desaparezca, escribiendo al comienzo de
AUTOLOAD
la
directiva:
no strict "refs";hace que
strict
deje de controlar el uso de referenciado
simbólico en el ámbito en el que se ubique.
El método DESTROY es llamado cada vez que el contador
de referencias del objeto alcanza cero.
Como hemos escrito un AUTOLOAD
la llamada automática
a DESTROY
que produce la salida de contexto del objeto
provoca una llamada a AUTOLOAD
. Dado que el AUTOLOAD
que hemos escrito no contempla este caso deberemos evitar que la
llamada DESTROY
sea captada por AUTOLOAD
. Para lograrlo
basta con definir un método DESTROY
vacío:
sub DESTROY {}
Sigue un ejemplo de programa cliente:
#!/usr/bin/perl -w -I. use Biblio::Doc1; $obj = Biblio::Doc1->new(1, "Asimov", "Bruguera", "Los propios dioses", "unknown"); print ("El nombre del autor es: ", $obj->get_author(), "\n"); print ("La URL es: ", $obj->get_url(), "\n"); $obj->set_author("El buen doctor"); print ("El nuevo nombre del autor es: ", $obj->get_author(), "\n"); $obj->set_author("Isaac Asimov"); print ("El nombre del autor definitivo es: ", $obj->get_author(), "\n");
get_issue($url, $year)
? (Suponemos
que issue
no es un atributo de la clase).
¿Que ocurriría en tu programa si ya existiera un método con tal nombre?
Una alternativa simple es disponer de una función que reciba el nombre de la clase y la lista de los nombres de atributo y cree los correspondientes métodos de acceso:
sub make_accessors { # Install getter-setters my $package = caller; no strict 'refs'; for my $sub (@_) { *{$package."::$sub"} = sub { my $self = shift; $self->{$sub} = shift() if @_; return $self->{$sub}; }; } }
Un buen número de módulos en CPAN proveen mecanismos similares a los explicados en esta sección para la construcción automática de métodos get/set y constructores. Estudie los siguientes módulos:
El siguiente fragmento de un módulo ilustra
el modo de uso de Class::Accessor. El módulo provee
un servicio de llamadas a procedimientos remotos desde un cliente
Perl a un servidor Perl situado en otra máquina. Los resultados
de la llamada son objetos de la clase GRID::Machine::Result
.
La línea 3 (use base qw(Class::Accessor)
)
indica que no sólo se usa el módulo Class::Accessor
sino que se hereda del mismo.
En la línea 5 definimos una lista con los atributos públicos del objeto.
En la línea 6 se construyen getter/setters para esos atributos.
pp2@nereida:~/LGRID_Machine/examples$ sed -ne '353,370p' Machine.pm | cat -n 1 package GRID::Machine::Result; 2 use List::Util qw(first); 3 use base qw(Class::Accessor); 4 5 my @legal = qw(type rstdout rstderr results); 6 GRID::Machine::Result->mk_accessors(@legal); 7 my %legal = map { $_ => 1 } @legal; 8 9 sub new { 10 my $class = shift || die "Error: Provide a class\n"; 11 my %args = @_; 12 13 my $a = ""; 14 die "Illegal arg $a\n" if $a = first { !exists $legal{$_} } keys(%args); 15 16 bless \%args, $class; 17 }
El constructor del ejemplo comprueba que todos los nombres de los argumentos son legales en la línea 14.
El siguiente código muestra un ejemplo de llamada:
$r = GRID::Machine::Result->new(%result); print $r->rstdout;