package dogandcat; use warnings; use strict; use Carp; # Class data and methods { # A list of all attributes with default values my %_attributes = ( _data => [], # anonymous array _hash => {}, # anonymous Hash ); # 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 =~ /^_(.*)/ ); # Initilize to defaults $self->{$attribute} = $self->_attribute_default($attribute); # Override defaults with arguments if ( exists $arg{$argument} ) { $self->{$attribute} = $arg{$argument}; } } # Empty the hash loci %{$self->{_hash}} = (); # Getting the data from the array # and storing the information in the hash $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; #### #!/usr/bin/perl use strict; use warnings; use dogandcat; my @cat = ("cat:a,b,c,d,e,f","cat2:g,h,i,j,k,l,m"); my @dog = ("dog1:1,2,3,4,5,6,7","dog2:21,22,23,24,25"); my $object1 = dogandcat->new (data =>\@cat); print "this is cat data \n", @{$object1->{_data}}, "\n"; print "this is cat keys \n", keys %{$object1->{_hash}}, "\n"; my $object2 = dogandcat->new (data => \@dog); print "this is dog data \n", @{$object2->{_data}}, "\n"; print "this is dog keys \n", keys %{$object2->{_hash}}, "\n"; print "\nbut....after creates the second object\n"; print "this is cat data \n", @{$object1->{_data}}, "\n"; print "this should be cat keys \n", keys %{$object1->{_hash}}, "\n"; print "this is dog data \n", @{$object2->{_data}}, "\n"; print "this is dog keys \n", keys %{$object2->{_hash}}, "\n"; exit;