Beefy Boxes and Bandwidth Generously Provided by pair Networks kudra
Keep It Simple, Stupid
 
PerlMonks  

OO Inheritence

by Limbic~Region (Chancellor)
on May 25, 2004 at 17:51 UTC ( #356319=perlmeditation: print w/ replies, xml ) Need Help??

All:
I was looking at Sprad's question and thinking this was a good excuse to try inheritence out for the first time. Since most problems here at the Monastery do not involve "how should I implement inheritence", I figured Meditations was the appropriate place. Here is how I did it:

The parent class Vehicle

package Vehicle; use strict; use warnings; use Carp; use vars '$AUTOLOAD'; sub new { my $class = shift; croak "Incorrect number of parameters" if @_ % 2; my $self = bless {}, $class; $self->_init( @_ ); return $self; } sub AUTOLOAD { return if $AUTOLOAD =~ /::DESTROY$/; no strict 'refs'; my ($key) = $AUTOLOAD =~ /::(\w+)$/; *{$AUTOLOAD} = sub { my $self = shift; if ( exists $self->{$key} ) { if ( defined $_[0] ) { croak "$key is read only" if $self->_read_only( $key ) +; $self->{$key} = $_[0]; } else { return $self->{$key}; } } else { croak "$key is not valid for this class" if ! $self->_vali +d( $key ); return undef if ! defined $_[0]; $self->{$key} = $_[0]; } }; $AUTOLOAD->( @_ ); } 1;

The Bike class

package Bike; use base Vehicle; @ISA = 'Vehicle'; use strict; use warnings; use Carp; my %valid = map { $_ => 1 } qw( Wheels Doors Color Passengers ); my %ro = map { $_ => 1 } qw( Wheels Passengers ); sub _init { my ($self, %arg) = @_; for my $option ( keys %arg ) { croak "$option is not valid" if ! $self->_valid( $option ); $self->{$option} = $arg{$option}; } $self->{Wheels} = 2; $self->{Passengers} = 1; # More than 1 is dangerous afterall return; } sub _read_only { my ($self, $option) = @_; return defined $ro{$option} ? 1 : 0; } sub _valid { my ($self, $option) = @_; return defined $valid{$option} ? 1 : 0; } 1;

The Car class

package Car; use base Vehicle; @ISA = 'Vehicle'; use strict; use warnings; use Carp; my %valid = map { $_ => 1 } qw( Wheels Doors Color Passengers ); my %ro = map { $_ => 1 } qw( Wheels ); sub _init { my ($self, %arg) = @_; for my $option ( keys %arg ) { croak "$option is not valid" if ! $self->_valid( $option ); $self->{$option} = $arg{$option}; } $self->{Wheels} = 4; return; } sub _read_only { my ($self, $option) = @_; return defined $ro{$option} ? 1 : 0; } sub _valid { my ($self, $option) = @_; return defined $valid{$option} ? 1 : 0; } 1;

And finally a script that uses some of the functionality.

#!/usr/bin/perl use strict; use warnings; use Bike; use Car; my $bike_1 = Bike->new(); # Shows setting default values; print "My first bike had ", $bike_1->Wheels, " wheels\n"; # Automatically create an accessor/mutator method $bike_1->Color('red'); print "My first bike was ", $bike_1->Color, "\n"; # Going to croak - unicycles aren't allowed $bike_1->Wheels(1); print "My first bike had ", $bike_1->Wheels, " wheels\n"; # Going to croak - Price is not valid for this class print "My first bike was ", $bike_1->Price(), " dollars\n"; my $car_1 = Car->new( 'Wheels' => 7, 'Color' => 'blue', 'Passengers' => 2, ); # We don't allow Frankestein cars print "My first car had ", $car_1->Wheels, " wheels\n";
So here is the meditation:
  • What have I done right?
  • What have I done wrong?
  • What have I left out?
  • What would you have done differently (syntax and implementation)?
  • If you think it is all wrong - how would you do it?
  • If I have done anything you think is particularly clever, what and why?
Looking forward to a better understanding of inheritence!

Cheers - L~R

Comment on OO Inheritence
Select or Download Code
Re: OO Inheritence
by chromatic (Archbishop) on May 25, 2004 at 19:03 UTC
    use base Vehicle; @ISA = 'Vehicle';

    Pick one or the other, not both. I prefer base.

    croak "$option is not valid" if ! $self->_valid( $option );

    Use unless.

    my %valid = map { $_ => 1 } qw( Wheels Doors Color Passengers ); my %ro = map { $_ => 1 } qw( Wheels ); sub _read_only { my ($self, $option) = @_; return defined $ro{$option} ? 1 : 0; }

    If you elided the lexicals in favor of class methods, you wouldn't have to repeat this code in both subclasses:

    sub _attributes { return { map { $_ => 1 } qw( Wheels Doors Color Passengers ) }; } sub _valid { my ($self, $attribute) = @_; return exists $self->_attributes()->{ $attribute }; }

    Finally, aside from inheriting a constructor and an AUTOLOAD, I don't see any reason why you need to inherit here. You'd probably be better off using a module that autogenerated your accessors. It's not wrong, but I don't see any real benefits to this approach.

    I did it this way when I was first learning, though. It won't cause you any real trouble; it's just a bit more complication that doesn't add very much. ~shrug~

      Croaking in your constructor is a bit harsh. How about undef? As chromatic said, if you dont' read documentation about something, like this, you get what you deserve. I don't agree with that, because if someone carelessly creates something great that ignores croak, and then you use that, you may find yourself with a bug 'cause of some odd situation.

      At least w/ undef, you can be more forgiving.

        At least w/ undef, you can be more forgiving.

        But it also requires that it be checked for. I think returning undef has its place, but so does throwing an exception (a.k.a. - croaking). I see the logic in allowing the user of your object/class/module to choose to die or not, after all, this...

        my $o = Class->new(@arg) || die "cannot create new Class";
        is a common enough idiom. But I can also see the logic in throwing an exception and just requiring the user to catch that exception. For me, it really comes down to how you plan to structure the error handling in the rest of your code.

        -stvn
        And you never mistype a parameter name?

        When I've done something wrong, I like informative error messages. Think of error checks like that as being kind of like strict.pm in effect. It saves me time in development. That someone who shoots themselves in the foot deliberately won't see the benefit is not a problem for me.

Re: OO Inheritence
by mstone (Deacon) on May 26, 2004 at 07:39 UTC

    Inheri-tance, actually.. you had a typo. ;-)

    By my standards, there's exactly one reason to use inheritance: to define the shared interface and default behavior for a family of similar classes.

    The code you gave doesn't quite do that. The default interface for Vehicle is 'pretty much anything'. You've tried to roll your own way of making the interfaces stable, but it doesn't work as well as it could. There's no guarantee Bike and Car will share the same data members (and, by extension, the same access methods), for instance. You've forced the interfaces to be the same by defining the '%valid' hash redundantly, but you'd be better off sinking that information down to the Vehicle class.

    In fact, I'd suggest getting rid of AUTOLOAD entirely, defining the methods you want explicitly in Vehicle, then scrapping the '%ro' hash and overriding the subclass methods to get the behavior you want:

    package Vehicle; sub new { my ($type, $data) = @_; my $O = bless $type->_defaults(), $type; # [1] for $k (keys %$O) { $O->{$k} = $data->{$k} if defined ($data->{$k}); # [2] } $O->_sanity_check(); # [3] return $O; } =item new (hash-ref: data) : Vehicle-ref [1] We start from a prototype data structure known to be good. [2] Now we override any values defined by the arguments. We only override values that are already in the prototype, though. We don't want to add anomalous data members by just copying everything straight over. [3] Now we run the new values through a hygiene filter to make sure everything's still good. =cut sub _defaults { return ({ 'wheels' => 0, 'doors' => 0, 'color' => 'none', 'passengers' => 0, }); } =item _defaults (nil) : hash-ref This method takes no input, and returns a pre-filled hash of valid attributes for a given vehicle type. Technically, this is a lobotomized version of the Factory Method design pattern. =cut sub _sanity_check { my $O = shift; if ($O->{'wheels'}) { print STDERR "I ran into a problem.. " . "a generic vehicle shouldn't have " . $O->{'wheels'} . ' ' . "wheels.\n" ; } if ($O->{'doors'}) { print STDERR "I ran into a problem.. " . "a generic vehicle shouldn't have " . $O->{'doors'} . ' ' . "doors.\n" ; } if ('none' ne $O->{'color'}) { print STDERR "I ran into a problem.. " . "a generic vehicle shouldn't be colored " . $O->{'color'} . ".\n" ; } if ($O->{'passengers'}) { print STDERR "I ran into a problem.. " . "a generic vehicle doesn't carry " . $O->{'passengers'} . ' ' . "passengers.\n" ; } return; } =item _sanity_check (nil) : nil This method doesn't take any input or return any value as output, but it does print any errors it sees to STDERR. In a real program, we'd use some kind of trace to see when and where the error occured. =cut sub _access { my ($O, $item, $value) = @_; if (defined ($value)) { $O->{$item} = $value; $O->_sanity_check(); } return ($O->{$item}); } =item _access (item, value) : value This is a generic back-end for the accessor functions. It takes the attribute name and an optional value as input, and returns the item's value as output. I've thrown in a sanity check every time an item's value is changed, just for the sake of paranoia. =cut sub Wheels { return ($_[0]->_access ('wheels', $_[1])); } sub Doors { return ($_[0]->_access ('doors', $_[1])); } sub Color { return ($_[0]->_access ('color', $_[1])); } sub Passengers { return ($_[0]->_access ('passengers', $_[1])); } =item accessor methods These are trivial methods that handle get-and-set operations for the attributes. The fact that _access() does an automatic sanity check after setting any new value means we don't have to put sanity checks in each of these methods.. though we probably would do individual sanity checks in a real application. This is one of those cases where 'lazy' means 'doing lots of work now so we won't have to do even more work later'. =cut package Bike; @ISA = qw( Vehicle ); =item Class Bike This class will override _defaults(), _sanity_check(), and possibly some of the access methods if we want to make 'wheels' always equal 2, for instance: sub Wheels { if ((defined $_[1]) && (2 != $_[1])) { print "You can't do that. I won't let you. So there.\n"; } } =cut package Car; @ISA = qw( Vehicle ); =item Class Car Again, this class will override _defaults(), _sanity_check(), and any access methods we want to harden against changes. =cut
Re: OO Inheritence
by eric256 (Parson) on May 26, 2004 at 13:33 UTC

    I was recently playing with inheritance and built an object.pm because i was tired of haveing to remake those bits everytime. Here is my object.pm followed by your modified Car and Bike objects. I wish that inherited modules also used the same modules that there parent used....if that makes since. So that i wouldn't need strict, warnings,and Carp because they are all part of the parent object. Anyway here it is.

    package Car; use base object; use strict; use warnings; use Carp; sub defaults {{ Wheels => 4, Doors => undef, Color => undef, Passengers => undef }}; sub readonly { qw/Wheels/ }; 1;
    package Bike; use base object; use strict; use warnings; use Carp; sub defaults {{ Wheels => 2, Doors => undef, Color => undef, Passengers => 2, }}; sub readonly { qw/Wheels Passengers/ }; 1;

    ___________
    Eric Hodges
Re: OO Inheritence
by EdwardG (Vicar) on May 26, 2004 at 15:23 UTC

    Learning in public++

     

AUTOLOAD does not scale
by rir (Vicar) on May 26, 2004 at 20:39 UTC
    It is not suitable to use AUTOLOAD in a module for general use. Two AUTOLOADs cannot coexist amicably in the same inheritance tree. Try it, one masks the other.
      Two AUTOLOADs cannot coexist amicably in the same inheritance tree. Try it, one masks the other.

      The OP only has one AUTOLOAD, in the base class. IMHO, this is fine, as long as all derived classes play nicely.

        Agreed, but I say playing nicely is a practice that does not scale. If you won't distribute the code there is nothing wrong with using AUTOLOAD.

        I am saying that AUTOLOAD does not scale well. Every use of AUTOLOAD in a program should be under the control of one party. If two separate authors use AUTOLOAD in the same program breakage is likely.

        Being conservative, I would be suspicious of any program with more than one AUTOLOAD. If two AUTOLOAD routines exist in a hierarchy there is a problem. (Don't forget UNIVERSAL.)

        This is a known problem. Consider:

        #!/usr/bin/perl use strict; use warnings; # I decide to use a module package Vehicle; use vars '$AUTOLOAD'; sub new { return bless {}, $_[0]; } # handle all "V*" calls sub AUTOLOAD { my ($key) = $AUTOLOAD =~/::(\w+)/; return if $key =~ /^[A-Z]+$/; die "Vehicle::AUTOLOAD can't cope as $key" unless $key =~ /^[vV]/; print "Leaving Vehicle::AUTOLOAD as $key$/"; } # with my program below package Animal; use vars '$AUTOLOAD'; sub new { return bless {}, $_[0]; } # handle all "A*" calls sub AUTOLOAD { my ($key) = $AUTOLOAD =~/::(\w+)/; return if $key =~ /^[A-Z]+$/; die "Animal::AUTOLOAD can't cope as $key" unless $key =~ /^[aA]/; print "Leaving Animal::AUTOLOAD as $key$/"; } package Horse; use vars qw/ @ISA /; @ISA = qw/ Vehicle Animal /; package main; # the two usages cannot work together, I needed to # know that Vehicle used AUTOLOAD so I could avoid it # or rewrite my code to eliminate AUTOLOAD. my $h = Horse->new; $h->Veh(); $h->Ani(); # call intercepted by Vehicle AUTOLOAD
        Be well.
      Two AUTOLOADs cannot coexist amicably in the same inheritance tree. Try it, one masks the other

      While I am not a fan of AUTOLOAD it is perfectly possibly to have multiple AUTOLOADs coexisting amicably in the same inheritance tree. (using SUPER and NEXT).

        --! Bad saint, no cookie.

        Yes, it's perfectly possible to have AUTOLOADs in the same inheritance tree. You can even have them dispatch to one another. And, this would be a very obfuscated version of spaghetti programming. (Yes, spaghetti that's further obfu'ed!)

        Think for a second about how you would go about maintaining that kind of programming. I know which one I'd prefer to maintain!

        (By maintain, I mean that there was a wizard who wrote the software, N normal humans who extended it, and now I am handed the mess.)

        ------
        We are the carpenters and bricklayers of the Information Age.

        Then there are Damian modules.... *sigh* ... that's not about being less-lazy -- that's about being on some really good drugs -- you know, there is no spoon. - flyingmoose

        I shouldn't have to say this, but any code, unless otherwise stated, is untested

        it is perfectly possibly

        Remove "perfectly" from that sentence and I'll agree with you. From NEXT's documentation:

        Because it's a module, not an integral part of the interpreter, NEXT.pm has to guess where the surrounding call was found in the method look-up sequence. In the presence of diamond inheritance patterns it occasionally guesses wrong.

        It's also too slow (despite caching).

        I repeat what I've said earlier, that using AUTOLOAD may very well cause you a bigger problem than the one you tried to solve. (Re: is autoload bad style?)

        ihb

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlmeditation [id://356319]
Approved by gjb
Front-paged by TStanley
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others musing on the Monastery: (13)
As of 2014-04-16 19:55 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    April first is:







    Results (433 votes), past polls