OO Perl: problema con atributo q es ref a hash

[flope]

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;

[jferrero]

¿Estás usando la técnica Inside-Out?

[flope]

Hola,

No estoy muy seguro a lo que te refieres con inside-out...
La tecnica se refiere a definir los atributos del objeto en un hash fuera del metodo "new" i del blessed hash?
Cambiaria algo si defino los atributos en bless {}, $class?

Mi problema esta en que al crear el segundo objeto me modifica el atributo _hash (hash anonimo) del primero y no entiendo pq. En cambio el atributo _data (array anonimo) no se modifica.

Soy bastante novato en programacion OO.

Muchas gracias

nota: Malas practicas: En este ejemplo tambien estoy accediendo directamente a los atributos sin metodos del estilo "get".

[flope]

Cambiando esta linia %{$self->{_hash}} = (); por esta $self->{_hash} = {}; funciona.
Ahora tengo q ver es pq uno funciona y el otro no.