Why does perl object instance overwrite each other

问题:

I've written some Perl code which compose two classes inherent from a base one. I suppose it would print something like this

Mik: Meow! Meow!
Sat: Woof! Woof!

But it actually print this way:

Sat: Woof! Woof!
Sat: Woof! Woof!

,

package Animal;
sub new {

    my $obj = shift;
    my $name = shift;
    our %pkg = ( 'name' => $name );
    bless \%pkg, $obj;
    return \%pkg;
}

package Cat;
@ISA = ("Animal");

sub new {
    my $obj = shift;
    my $name = shift;
    my $self =  $obj->SUPER::new($name);
    return $self;
}

sub get_name {
    my $obj = shift;
    return $obj->{'name'};
}


sub talk {
    my $obj = shift;
    return "Meow! Meow!";
}

package Dog;
@ISA = ("Animal");

sub new {
    my $obj = shift;
    my $name = shift;
    my $self = $obj->SUPER::new( $name );
    return $self;
}

sub get_name {
    my $obj = shift;
    return $obj->{'name'};
}

sub talk {
    my $obj = shift;
    return "Woof! Woof!";
}

package Main;

my $cat = new Cat('Mike');
my $dog = new Dog('Sat');

print $cat->get_name() . ": " . $cat->talk() , "\n"; 
print $dog->get_name() . ": " . $dog->talk() , "\n";

But if I change the caller in this way, it prints what I suppose to be. So it is quite strange why the $cat object was overwritten after the $dog was instantiated?

package Main;

my $cat = new Cat('Mily');
print $cat->get_name() . ": " . $cat->talk() , "\n"; 

my $dog = new Dog('Sat');
print $dog->get_name() . ": " . $dog->talk() , "\n";

回答1:

Why do you bless into a global variable? Change your constructor to:

sub new {
    my $obj = shift;
    my $name = shift;
    my %pkg = ( 'name' => $name );
    bless \%pkg, $obj;
    return \%pkg;
}

Better yet, change it to something more idiomatic:

sub new {
    my $class = shift;
    my $name  = shift;
    my $self  = { name => $name };
    return bless $self, $class;
}

Moving on:

Why implement new and get_name in each kind of animal? Both methods can be inherited. While we're at it, we might as well get rid off the messing around with @ISA:

package Animal;
sub new {
    my $class = shift;
    my $name  = shift;
    my $self  = { name => $name };
    return bless $self, $class;
}

sub get_name {
    my $self = shift;
    return $self->{'name'};
}

package Cat;
use base qw/ Animal /;

sub talk {
    my $self = shift;
    return "Meow! Meow!";
}

package Dog;
use base qw/ Animal /;

sub talk {
    my $self = shift;
    return "Woof! Woof!";
}

package Main;

my $cat = Cat->new('Mike');
my $dog = Dog->new('Sat');

print $cat->get_name() . ": " . $cat->talk() , "\n"; 
print $dog->get_name() . ": " . $dog->talk() , "\n";

May I ask which tutorial or book you are following?

While the above is perfectly fine, you might as well do it the Modern Perl way:

package Animal;
use Moose;
has name => ( required => 1, is => 'rw', isa => 'Str' );

package Cat;
use Moose;
extends 'Animal';

has talk => ( default => "Meow! Meow!", is => 'ro' );

package Dog;
use Moose;
extends 'Animal';

has talk => ( default => "Woof! Woof!", is => 'ro' );

package Main;
my $cat = Cat->new( name => 'Mike');
my $dog = Dog->new( name => 'Sat');

print $cat->name . ": " . $cat->talk , "\n"; 
print $dog->name . ": " . $dog->talk , "\n";

回答2:

You have declared the variable to store the instance data using

our %pkg

This is an alias for a single data structure (%Animal::pkg), so all your objects are using the same hash. Change our to my in order to create a new hash each time.

---

It might be worth noting that "inside-out" objects in Perl can and do use a shared data structure in the package to store instance data, but there is an additional level of abstraction required to make that work, and I wouldn't recommend starting OO Perl with them, they are an acquired taste.

回答3:

In a nutshell: our declares package variables, so every time our %pkg = (...) is executed, you assign a new value to the same variable. As all \%pkg references point to the same var, all return values of new are the same object. A reference can only be blessed into one class, so the last one wins.

Just change the our to my, and it should work as expected.