nims has asked for the wisdom of the Perl Monks concerning the following question:

Hello,
I am busy working with objects in perl, but I have something
weird.
I want to create an attribute in a class that is an array of perons.
When I add a new element to the array, all elements of that array
change to that single element.
When you execute my code I expect to see the two persons
"Julien" and "Leon"
But sorry to say, that I see "Leon" twice.
I hope someone can tell me what I am doing wrong.
Julien@nims.nl <- Please send your reply there too :)

The code is a bit long, that's only because I want to programm
a little structured. Sorry for that, but don't we all wish
everybody does this?
------Code follows-----------------
#!/usr/bin/perl -T ################################################# # Class example, and testing in Perl made by # Julien Moorrees , 2001 Ni-Frith Media Systems # # Situation (UML) # # _________________ ____________________ # | Person | | Adres | # |-----------------| |--------------------| # |(pr) count:Int | |(pr) street:String | # |(pr) name:string | 1 |--------------------| # |(pr) age:Int |-------------|(pu) getStreet() | # |-----------------| 0..* |(pu) setStreet() | # |(pu) new() | |(pu) addPerson() | # |(pu) setCount() | |(pu) removePerson() | # |(pu) getCount() | |____________________| # |(pu) getName() | # |(pu) setName() | # |(pu) getAge() | # |(pu) setAge() | # |_________________| ##################################################### ## Class definition : Person ##################################################### package Person; sub new { my($class) = shift; #Arguments #Property definition bless { "count" => int(0), "name" => "", "age" => int(0) }, $class; #Implementation } ##################################################### ## Class Constructor ##################################################### sub create { my($self) = shift; #Arguments my($aName) = shift; my($aAge) = shift; #Implementation $self->setName($aName); $self->setAge($aAge); } ##################################################### ## Incapsulation Methods (Get & Set) ##################################################### ################################################ ##Person::Count sub getCount { my($self) = shift; #Arguments #Implementation return $self->{count}; } sub setCount { my($self) = shift; #Arguments my($aCount) = shift; #Implementation $self->{count}= $aCount; } ################################################ ##Person::Name sub getName { my($self) = shift; #Arguments #Implementation return $self->{name}; } sub setName { my($self) = shift; #Arguments my($aName) = shift; #Implementation $self->{name}= $aName; } ################################################ ##Person::Age sub getAge { my($self) = shift; #Arguments #Implementation return $self->{age}; } sub setAge { my($self) = shift; #Arguments my($aAge) = shift; #Implementation $self->{age}= $aAge; } ##################################################### ## Class Methods ##################################################### ################################################ ## printProperties ## print all the properties of this instance. sub printProperties { my($self) = shift; #Arguments my(@keys) = @_ ? @_ : sort(keys(%{$self})); #Implementation print("CLASS: $self\n"); foreach $key (@keys) { printf("\t%10.10s => $self->{$key}\n", $key); } } ## End of Class definition : Person ##################################################### ##################################################### ##################################################### ## Class definition : Adres ##################################################### package Adres; sub new { my($class) = shift; #Arguments #Property definition #Property definition bless { @persons => {}, "personCount" => int(0), "street" => "" }, $class; #Implementation } ##################################################### ## Class Constructor ##################################################### sub create { my($self) = shift; #Arguments my($aStreet) = shift; #Implementation $self->setStreet($aStreet); } ##################################################### ## Incapsulation Methods (Get & Set) ##################################################### ################################################ ##Adres::street sub getStreet { my($self) = shift; #Arguments #Implementation return $self->{street}; } sub setStreet { my($self) = shift; #Arguments my($aStreet) = shift; #Implementation $self->{street}= $aStreet; } ################################################ ##Adres::personCount sub getPersonCount { my($self) = shift; #Arguments #Implementation return $self->{personCount}; } sub setPersonCount { my($self) = shift; #Arguments my($aPersonCount) = shift; #Implementation $self->{personCount}= $aPersonCount; } ##################################################### ## Class Methods ##################################################### ################################################ ## addPerson ## Add the person to this adres. sub addPerson { my($self) = shift; #Arguments my($aPerson) = shift; if ( ref($aPerson) ne "Person" ){ #Error, this argument is not a person! print "Error! Adres::addPerson, Argument is not of class type Per +son"; exit; } #Implementation #print "\r\nadres:addPerson->"; #$aPerson->printProperties(); $self->{@persons[$self->getPersonCount()]}=$aPerson; $self->setPersonCount($self->getPersonCount()+1); } ################################################ ## printProperties ## print all the properties of this instance. sub printProperties { my($self) = shift; printf("\t%18.18s <= street\n", $self->getStreet() ); printf("\t%18.18s <= personCount\n", $self->getPersonCount() ); for ( $counter=0;$counter<$self->{personCount};$counter++ ) { printf("\t%18.18s => $counter\n", "person number"); $self->{@persons[$counter]}->printProperties(); } } ################################################ ## printPropertiesDebug ## print all the properties of this instance. sub printPropertiesDebug { my($self) = shift; #Arguments my(@keys) = @_ ? @_ : sort(keys(%{$self})); #Implementation print("CLASS: $self\n"); foreach $key (@keys) { printf("\t%18.18s => $self->{$key}\n", $key); } } ## End of Class definition : Adres ##################################################### ##################################################### ##################################################### ## Application Start ##################################################### package main; #html start $htmlstart = <<'eindeHTML' Content-type: text/html Pragma: no-cache Cache-control: no-cache Expires: Mon, 28 Apr 1997 00:01:00 -0500 eindeHTML ; print $htmlstart; print "<pre>\r\n"; #print "Julien: \r\n:"; $julien = Person->new(); $julien->create("Julien",22); #$julien->printProperties(); #print "Leon: \r\n:"; $leon = Person->new(); $leon->create("Leon",19); #$leon->printProperties(); $promenade = Adres->new(); $promenade->create("Promenade 21"); $promenade->addPerson($julien); $promenade->addPerson($leon); #$promenade->printPropertiesDebug(); $promenade->printProperties(); print "</pre>\r\n";

Replies are listed 'Best First'.
Re: Object Inheritance in Perl
by baku (Scribe) on Feb 13, 2001 at 22:38 UTC

    Running this, I get the following output (after uncommenting the prints and fixing the eindeHTML reference):

    $ perl -Mdiagnostics -Mwarnings x Scalar value @persons[$counter] better written as $persons[$counter] a +t x line 263 (#1) (W syntax) You've used an array slice (indicated by @) to select a + single el ement of an array. Generally it's better to ask for a scalar value (indica +ted by $). The difference is that $foo[&bar] always behaves like a scalar, bo +th when assigning to it and when evaluating its argument, while @foo[&bar] + behaves like a list when you assign to it, and provides a list context to +its subscript, which can do weird things if you're expecting only one +subscript. On the other hand, if you were actually hoping to treat the array element as a list, you need to look into how references work, beca +use Perl will not magically convert between scalars and lists for you. + See perlref. Content-type: text/html Pragma: no-cache Cache-control: no-cache Expires: Mon, 28 Apr 1997 00:01:00 -0500 <pre> Julien: :CLASS: Person=HASH(0x1b9efbc) age => 22 count => 0 name => Julien Leon: :CLASS: Person=HASH(0x1b9510c) age => 19 count => 0 name => Leon Odd number of elements in hash assignment at x line 162 (#2) (W misc) You specified an odd number of elements to initialize a h +ash, which is odd, because hashes come in key/value pairs. Use of uninitialized value in array slice at x line 248 (#3) (W uninitialized) An undefined value was used as if it were alread +y defined. It was interpreted as a "" or a 0, but maybe it was a mistake. To suppre +ss this warning assign a defined value to your variables. Use of uninitialized value in hash element at x line 248 (#3) Use of uninitialized value in addition (+) at x line 249 (#3) CLASS: Adres=HASH(0x1b9519c) => Person=HASH(0x1b9510c) 0 => street HASH(0x1b95124) => personCount personCount => 2 street => Promenade 21 Promenade 21 <= street 2 <= personCount person number => 0 Use of uninitialized value in hash element at x line 263 (#3) CLASS: Person=HASH(0x1b9510c) age => 19 count => 0 name => Leon person number => 1 CLASS: Person=HASH(0x1b9510c) age => 19 count => 0 name => Leon </pre>

    The warnings came from my use of "diagnostics" and "warnings" modules. It's generally good form to at least use warnings and strict, and diagnostics can be very useful in tracing down problems as well. To enable these modules in your scripts, add lines like these to the top:

    use warnings; use strict; # use diagnostics; # verbose but helpful for learning.

    As you can see, the two Person objects are created, but only one is stored in 'Adres.'

    The probable reason for this is the use of @persons. It is important to remember that a hash key is just a string. Even though you placed an @ in the name, perl does not turn it into a list. What you likely wanted to do is keep a list reference. Also, unlike 'name,' you must use quotes, or perl will likely replace '@persons' with '0' (that is, the scalar value of the list variable @persons, which is the length of the list, which is 0). A replacement for your addPerson routine might be:

    package Adres; sub new { my $prototype = shift; my $class = ref $prototype || shift; my $self = { '@persons' => [], # [] = arrayref; {} = hashref; () = list # a list like this must be an arrayref # (reference to an array) because a list () cannot # be held in an hash directly. street => '', }; bless $self, $class; return $self; } sub get_person_count { my $self = shift; return (scalar @{ $self->{'@persons'} }); } sub add_person { my $self = shift; while (@_) # allow adding multiple people { die "Error! $_ is not a Person object." unless (ref $_ && $_->isa('Person')); # note the magic clause "ref $x && $x->isa('Class')" # this catches child classes as well # and is similar in effect to the Java # expression "instanceof Class" push @{ $self->{'@persons'} }, $_; } }

    These changes will impact on the rest of your code as well, but I'll leave that to you :-) ...

    It appears that you are migrating from a Java background. Been there, done that :-) Welcome to Perl... things are much easier here. I've thrown in a few other suggestions:

    There are several subroutines here which should likely be combined into one: for example, new and create should probably read more like:

    ##################################################### ## Class Constructor ##################################################### sub new { my $prototype = shift; my $class = ref $prototype || shift; # This will handle both types of constructor. my $self = { count => 0, name => '', age => 0 }; # No need to use int() in Perl. # Also, quotes are not needed to the left of => # (so long as it's alphanumeric) # Note that the quotes are required above, so that # perl can distinguish between '@persons' (a string) and # @persons (a nonexistant variable) # No need to use temporary variables here in Perl. # In fact, very rarely need to use them at all. if (@_) # are there more parameters? { $self->name(shift); } if (@_) # yet more? { $self->age(shift); } }

    Also, note that you do not need to create separate get and set methods. For an example:

    sub age { my $self = shift; if (@_) # more parameters? { $self->{age} = shift; } return $self->{age}; }

    This can be called as  $self->age() to "get" the value, or  $self->age($age) to "set" the value.

    You may wish to see perltoot for an in-depth tutorial of Perl's OO capabilities.

    One more: while parentheses can add clarity to complex situations, overuse can be very confusing (at least to me :-) ) -- for example, I'd prefer to read  sort keys %{ $self } over  sort (keys ( %{ self } ) ) -- and also not have to worry about lining up all the  )'s :-)


    Good luck in your endeavour!

      Here is the working code...
      #!/usr/bin/perl ################################################# # Class example, and testing in Perl made by # Julien Moorrees , 2001 Ni-Frith Media Systems # # Situation (UML) # # _________________ ____________________ # | Person | | Adres | # |-----------------| |--------------------| # |(pr) count:Int | |(pr) street:String | # |(pr) name:string | 1 |--------------------| # |(pr) age:Int |-------------|(pu) getStreet() | # |-----------------| 0..* |(pu) setStreet() | # |(pu) new() | |(pu) addPerson() | # |(pu) setCount() | |(pu) removePerson() | # |(pu) getCount() | |____________________| # |(pu) getName() | # |(pu) setName() | # |(pu) getAge() | # |(pu) setAge() | # |_________________| ##################################################### ## Class definition : Person ##################################################### package Person; sub new { my($class) = shift; #Arguments #Property definition bless { "count" => int(0), "name" => "", "age" => int(0) }, $class; #Implementation } ##################################################### ## Class Constructor ##################################################### sub create { my($self) = shift; #Arguments my($aName) = shift; my($aAge) = shift; #Implementation $self->setName($aName); $self->setAge($aAge); } ##################################################### ## Incapsulation Methods (Get & Set) ##################################################### ################################################ ##Person::Count sub getCount { my($self) = shift; #Arguments #Implementation return $self->{count}; } sub setCount { my($self) = shift; #Arguments my($aCount) = shift; #Implementation $self->{count}= $aCount; } ################################################ ##Person::Name sub getName { my($self) = shift; #Arguments #Implementation return $self->{name}; } sub setName { my($self) = shift; #Arguments my($aName) = shift; #Implementation $self->{name}= $aName; } ################################################ ##Person::Age sub getAge { my($self) = shift; #Arguments #Implementation return $self->{age}; } sub setAge { my($self) = shift; #Arguments my($aAge) = shift; #Implementation $self->{age}= $aAge; } ##################################################### ## Class Methods ##################################################### ################################################ ## printProperties ## print all the properties of this instance. sub printProperties { my($self) = shift; #Arguments my(@keys) = @_ ? @_ : sort(keys(%{$self})); #Implementation print("CLASS: $self\n"); foreach $key (@keys) { printf("\t%10.10s => $self->{$key}\n", $key); } } ## End of Class definition : Person ##################################################### ##################################################### ##################################################### ## Class definition : Adres ##################################################### package Adres; sub new { my($class) = shift; #Arguments #Property definition #Property definition bless { 'persons' => [], "personCount" => int(0), "street" => "" }, $class; #Implementation } ##################################################### ## Class Constructor ##################################################### sub create { my($self) = shift; #Arguments my($aStreet) = shift; #Implementation $self->setStreet($aStreet); } ##################################################### ## Incapsulation Methods (Get & Set) ##################################################### ################################################ ##Adres::street sub getStreet { my($self) = shift; #Arguments #Implementation return $self->{street}; } sub setStreet { my($self) = shift; #Arguments my($aStreet) = shift; #Implementation $self->{street}= $aStreet; } ################################################ ##Adres::personCount sub getPersonCount { my($self) = shift; #Arguments #Implementation return $self->{personCount}; } sub setPersonCount { my($self) = shift; #Arguments my($aPersonCount) = shift; #Implementation $self->{personCount}= $aPersonCount; } ##################################################### ## Class Methods ##################################################### ################################################ ## addPerson ## Add the person to this adres. sub addPerson { my($self) = shift; #Arguments my($aPerson) = shift; if ( ref($aPerson) ne "Person" ){ #Error, this argument is not a person! print "Error! Adres::addPerson, Argument is not of class type Per +son"; exit; } #Implementation #print "\r\nadres:addPerson->"; #$aPerson->printProperties(); push(@{$self->{persons}},$aPerson); $self->setPersonCount($self->getPersonCount()+1); } ################################################ ## printProperties ## print all the properties of this instance. sub printProperties { my($self) = shift; printf("\t%18.18s <= street\n", $self->getStreet() ); printf("\t%18.18s <= personCount\n", $self->getPersonCount() ); for ( $counter=0;$counter<$self->{personCount};$counter++ ) { printf("\t%18.18s => $counter\n", "person number"); @{$self->{persons}}[$counter]->printProperties(); } } ################################################ ## printPropertiesDebug ## print all the properties of this instance. sub printPropertiesDebug { my($self) = shift; #Arguments my(@keys) = @_ ? @_ : sort(keys(%{$self})); #Implementation print("CLASS: $self\n"); foreach $key (@keys) { printf("\t%18.18s => $self->{$key}\n", $key); } } ## End of Class definition : Adres ##################################################### ##################################################### ##################################################### ## Application Start ##################################################### package main; #html start $htmlstart = <<'eindeHTML' Content-type: text/html Pragma: no-cache Cache-control: no-cache Expires: Mon, 28 Apr 1997 00:01:00 -0500 eindeHTML ; print $htmlstart; print "<pre>\r\n"; #print "Julien: \r\n:"; $julien = Person->new(); $julien->create("Julien",22); #$julien->printProperties(); #print "Leon: \r\n:"; $leon = Person->new(); $leon->create("Leon",19); #$leon->printProperties(); $promenade = Adres->new(); $promenade->create("Promenade 21"); $promenade->addPerson($julien); $promenade->addPerson($leon); #$promenade->printPropertiesDebug(); $promenade->printProperties(); print "</pre>\r\n";
(jeffa) Re: Object Inheritance in Perl
by jeffa (Bishop) on Feb 13, 2001 at 22:07 UTC
    Well, I have played around with this a little bit, and I don't have ALL the answers - this a quite a chunk of code!

    I really hope that you are practicing OOP, and not using this in production - no offense, it's not very pretty.

    1. change the initialization of @persons in the Adres constuctor to
      'persons' => ();
      and likewise change all references to @persons to just persons - it's a key, not an array - the value of the key points to an array.

    2. In sub addPerson - you are trying to use Perl arrays like they were C arrays - get rid of your personCount method - you don't need to store the index of the last person added, push will do it for you :)
      # this is all you need to add someone push(@{$self->{persons}},$aPerson);
    3. In printProperties (around line 260) use this:
      my $size = @{$self->{persons}}; for(0..$size) { printf("\t%18.18s => $_\n", "person number"); @{$self->{persons}}[$_]->printProperties(); }
    Now you should not be clobbing old users when you add new ones. Disclaimer - I still get a warning that appears to be caused by an empty element in the persons array reference - I'll leave that up to you to fix. :)

    Side issues - use CGI and -w

    Jeff

    R-R-R--R-R-R--R-R-R--R-R-R--R-R-R--
    L-L--L-L--L-L--L-L--L-L--L-L--L-L--
    
Re: Object Inheritance in Perl
by davorg (Chancellor) on Feb 13, 2001 at 22:11 UTC

    Well, your immediate problems are solved by changing the line in Adres::addPerson from

    $self->{@persons[$self->getPersonCount()]}=$aPerson;

    to

    push @{$self->{persons}}, $aPerson;

    and the line in Adres::printProperties from

    $self->{@persons[$counter]}->printProperties();

    to

    $self->{persons}[$counter]->printProperties();

    But there are a number of other problems waiting to happen in this code. I recommend rereading perlreftut, perlboot and perltoot before going too much further.

    --
    <http://www.dave.org.uk>

    "Perl makes the fun jobs fun
    and the boring jobs bearable" - me