Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

Re: Object Inheritance in Perl

by baku (Scribe)
on Feb 13, 2001 at 22:38 UTC ( #58187=note: print w/ replies, xml ) Need Help??


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>

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!


Comment on Re: Object Inheritance in Perl
Select or Download Code
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";

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://58187]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others scrutinizing the Monastery: (9)
As of 2014-09-19 08:15 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    How do you remember the number of days in each month?











    Results (133 votes), past polls