
30/08/2007, 15:55
|
| | Fecha de Ingreso: enero-2007
Mensajes: 22
Antigüedad: 18 años Puntos: 0 | |
OO Perl: problema con atributo q es ref a hash Hola a todos,
Mi duda no esta relacionada con temas web si no con programcion orientada a objetos en perl... aunque mi programacion es siempre para web.
Lo siento si no es un lugar adequado para estas dudas,.....
Mi problema con un ejemplo sencillo:
objeto (hash) con 2 attributos: uno de ellos es una referencia a un array y el segundo una referencia a un hash. El segundo se inicializa a partir del primero.
Desde "main" creo dos objetos con el metodo "new" y le doy como atributos dos referencias arrays diferentes. El problema esta en que el segundo objeto sobreescribe el hash del primero. Como puedo evitar esto?
Mejor q les ponga el ejemplo:
Código:
package pedoycaca;
use warnings;
use strict;
use Carp;
# Class data and methods
{
# A list of all attributes with default values
my %_attributes = (
_data => [], # array ref
_hash => {}, # Hash ref
);
# Return list of all attributes
sub _all_attributes {
keys %_attributes;
}
# Return the default value
sub _attribute_default {
my ( $self, $attribute ) = @_;
$_attributes{$attribute};
}
# Check if a given argument exists
sub _arg_exist {
my ( $self, %arg ) = @_;
foreach my $arg ( keys %arg ) {
unless ( grep /$arg/, keys %_attributes ) {
croak("ERROR::: '$arg' is not a valid argument");
}
}
}
}
# Constructor
sub new {
my ( $class, %arg ) = @_;
my $self = bless {}, $class;
$self->_arg_exist(%arg); # Check if all given args are ok
# Set the attributes for the provided arguments
foreach my $attribute ( $self->_all_attributes() ) {
my ($argument) = ( $attribute =~ /^_(.*)/ );
$self->{$attribute} =
$self->_attribute_default($attribute); # Initilize to defaults
# Override defaults with arguments
if ( exists $arg{$argument} ) {
$self->{$attribute} = $arg{$argument};
}
}
# Empty the hash loci
%{$self->{_hash}} = ();
# Getting and storing locus and rates as attribute of the object
$self->_get_hash ();
return $self;
}
# Accessors and Mutators
sub DESTROY {
my ($self) = @_;
}
sub _get_hash {
my ($self) = @_;
foreach my $locus (@{$self->{_data}}) {
my @elements = split (/:/, $locus);
if ( $elements[0] ne '' or scalar @elements < 3 ) {
${$self->{_hash}}{ $elements[0] } = $elements[1];
} else {
croak ("ERROR");
}
}
}
1;
Programa para probarlo:
Código:
#!/usr/bin/perl
use strict;
use warnings;
use pedoycaca;
my @caca = ("caca:a,b,c,d,e,f","caca2:g,h,i,j,k,l,m");
my @pedo = ("pedo1:1,2,3,4,5,6,7","pedo2:21,22,23,24,25");
my $object1 = pedoycaca->new (data =>\@caca);
print "esto es caca data \n", @{$object1->{_data}}, "\n";
print "esto es caca keys \n", keys %{$object1->{_hash}}, "\n";
my $object2 = pedoycaca->new (data => \@pedo);
print "esto es pedo data \n", @{$object2->{_data}}, "\n";
print "esto es pedo keys \n", keys %{$object2->{_hash}}, "\n";
print "\npero....segundo print\n";
print "esto es caca data \n", @{$object1->{_data}}, "\n";
print "esto es caca keys \n", keys %{$object1->{_hash}}, "\n";
print "esto es pedo data \n", @{$object2->{_data}}, "\n";
print "esto es pedo keys \n", keys %{$object2->{_hash}}, "\n";
exit;
|