Ver Mensaje Individual
  #1 (permalink)  
Antiguo 30/08/2007, 15:55
flope
 
Fecha de Ingreso: enero-2007
Mensajes: 22
Antigüedad: 17 años, 3 meses
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;