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:
So here is the meditation:
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";
- 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?
Cheers - L~R
|
---|
Replies are listed 'Best First'. | |
---|---|
Re: OO Inheritence
by chromatic (Archbishop) on May 25, 2004 at 19:03 UTC | |
by exussum0 (Vicar) on May 25, 2004 at 23:15 UTC | |
by stvn (Monsignor) on May 26, 2004 at 00:15 UTC | |
by tilly (Archbishop) on May 27, 2004 at 15:07 UTC | |
Re: OO Inheritence
by mstone (Deacon) on May 26, 2004 at 07:39 UTC | |
Re: OO Inheritence
by eric256 (Parson) on May 26, 2004 at 13:33 UTC | |
AUTOLOAD does not scale
by rir (Vicar) on May 26, 2004 at 20:39 UTC | |
by adrianh (Chancellor) on May 27, 2004 at 12:21 UTC | |
by dragonchild (Archbishop) on May 27, 2004 at 15:19 UTC | |
by runrig (Abbot) on May 27, 2004 at 16:13 UTC | |
by adrianh (Chancellor) on May 28, 2004 at 11:14 UTC | |
by ihb (Deacon) on May 30, 2004 at 19:58 UTC | |
by runrig (Abbot) on May 26, 2004 at 21:16 UTC | |
by rir (Vicar) on May 26, 2004 at 21:48 UTC | |
Re: OO Inheritence
by EdwardG (Vicar) on May 26, 2004 at 15:23 UTC |
Back to
Meditations