in reply to Object Inheritance in Perl

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>

[download]

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.

[download]

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'} }, $_;
 }
}

[download]

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);
  }
}

[download]

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};
}

[download]

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!

Replies are listed 'Best First'.
Re^2: Object Inheritance in Perl
by ramprasadgk (Initiate) on May 12, 2009 at 11:07 UTC
    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";

    [download]
[reply]
[d/l]

In Section Seekers of Perl Wisdom