A la hora de escribir un constructor es conveniente tener en cuenta los siguientes puntos:
new
.
A continuación veamos un código que, siguiendo las recomendaciones establecidas, separa el proceso de iniciación, organiza los parámetros del constructor según un ''hash'' y provee valores por defecto.
1 package Biblio::Doc; 2 use strict; 3 use vars('$AUTOLOAD'); 4 5 # Separamos inicialización de construcción 6 7 { 8 my $_count = 0; 9 sub get_count { $_count } 10 sub _incr_count { $_count++ } 11 sub _decr_count { $_count-- } 12 } 13
14 { 15 my %_defaults = ( # Default Access 16 _identifier => ["unknown",'read'], 17 _author => ["unknown",'read/write'], 18 _publisher => ["unknown",'read'], 19 _title => ["unknown",'read'], 20 _year => ["unknown",'read'], 21 _url => ["unknown",'read/write'] 22 );Se ha introducido un hash que contiene los valores por defecto y el tipo de acceso permitido (lectura/escritura) para cada clave.
24 sub _standard_keys { 25 return keys %_defaults; 26 }Queremos además disponer de un método que nos diga que claves forman el objeto. Esa es la función del método privado
_standard_keys
.
El método _default_for
permite acceder al valor por defecto.
28 sub _default_for { 29 my ($self, $attr) = @_; 30 31 return $_defaults{$attr}[0]; 32 }
34 sub _accesible { 35 my ($self, $attr, $access) = @_; 36 return $_defaults{$attr}[1] =~ /$access/; 37 }El método
_accesible
nos dice si una clave esta accesible
para el tipo de acceso requerido.
El método privado _init
inicializa el hash referenciado
por $self
según lo indicado en el hash %args
.
39 sub _init { 40 my ($self, %args) = @_; 41 my %inits; 42 my ($i, $j); 43 44 for $i ($self->_standard_keys) { 45 $j = $i; 46 $j =~ s/_//; 47 $inits{$i} = $args{$j} || $self->_default_for($i); 48 } 49 %$self = %inits; 50 } 51 }
Las claves en %args
no van precedidas de guión bajo
(se supone que la llamada desde el programa cliente usará
los nombres de los atributos sin guión bajo). Si la clave
no figura en %args
se inicializa al valor por defecto.
Observe que el uso de $self->_standard_keys
en el
bucle de la línea 44 nos protege contra errores
de inicializaciones con claves inexistentes en el objeto,
posiblemente como consecuencia de un
error en la llamada desde el cliente (quizá
debidos a un error tipográfico).
Habría además que comprobar que todas las claves en %args
están en el conjunto de claves legales.
En la línea 57 se bendice el objeto aún sin inicializar.
53 sub new { 54 my $class = shift; 55 my $self = {}; 56 57 bless $self, ref($class) || $class; 58 59 $self->_incr_count(); 60 $self->_init(@_); 61 62 return $self; 63 }Cuando el constructor es llamado mediante
Biblio::Doc->new()
la variable $class
contendrá la cadena 'Biblio::Doc'
por lo que ref($class)
devuelve undef
y $self
será bendecido en 'Biblio::Doc'
.
La línea 57 esta escrita pensando que el constructor pueda
ser llamado de la forma $x->new
donde $x
es un objeto de la clase Biblio::Doc
. Como sabemos,
en tal caso ref($x)
contendrá la cadena 'Biblio::Doc'
.
Asi pues, $self
será, también en este caso,
bendecido en 'Biblio::Doc'
.
Observe como hemos desacoplado la inicialización de la creación
y bendición de la estructura. Es posible que durante el periodo
de desarrollo del módulo la estructura del hash cambie, introduciendo
nuevos atributos o suprimiendo algunos existentes. Con
el desacoplado conseguimos que estos cambios no afecten
a new
(aunque si a _init
).
Perl elimina automáticamente la memoria de un objeto cuando es claro que ya no va a ser utilizado. Un método con el nombre especial DESTROY se dispara cuando la memoria asociada con un objeto debe ser eliminada (normalmente por que salimos de su ámbito de existencia).
65 sub DESTROY { 66 my $self = shift; 67 68 $self->_decr_count(); 69 }
También hemos extendido la subrutina AUTOLOAD
para que
compruebe (líneas 74 y 82) que el método de acceso requerido
está permitido.
71 sub AUTOLOAD { 72 no strict "refs"; 73 my $self = shift; 74 if (($AUTOLOAD =~ /\w+::\w+::get(_.*)/) && ($self->_accesible($1,'read'))) { 75 my $n = $1; 76 die "Error in $AUTOLOAD: Illegal attribute\n" unless exists $self->{$n}; 77 78 # Declarar el metodo get_***** 79 *{$AUTOLOAD} = sub { return $_[0]->{$n}; }; 80 81 return $self->{$n}; 82 } elsif (($AUTOLOAD =~ /\w+::\w+::set(_.*)/) && ($self->_accesible($1,'write'))) { 83 my $n = $1; 84 die "Error in $AUTOLOAD: Illegal attribute\n" unless exists $self->{$n}; 85 $self->{$n} = shift; 86 87 # Declarar el metodo set_***** 88 *{$AUTOLOAD} = sub { $_[0]->{$n} = $_[1]; }; 89 } else { 90 die "Error: Function $AUTOLOAD not found\n"; 91 }