Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw

Re: OO Inheritence

by eric256 (Parson)
on May 26, 2004 at 13:33 UTC ( #356567=note: print w/replies, xml ) Need Help??

in reply to OO Inheritence

I was recently playing with inheritance and built an because i was tired of haveing to remake those bits everytime. Here is my 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 object; use Carp; our $AUTOLOAD; use Data::Dumper; sub defaults { return {}; } sub readonly { return (); } sub init {}; sub params { my $self = shift; my $defaults = $self->defaults(); my %params = (%$defaults, @_); for (keys %params) { warn "unknown parameter '$_' passed to new()" unless exists $defaults->{$_}; $self->{$_} = $defaults->{$_}; $self->set($_, $params{$_}); } } sub AUTOLOAD { my $self = shift; my $type = ref($self) or croak "$self is not an object"; my $name = $AUTOLOAD; $name =~ s/.*://; # strip fully-qualified portion return if $name eq 'DESTROY'; unless (exists $self->{$name} ) { carp "Can't access `$name' field in class $type"; return; } { no strict 'refs'; *{$AUTOLOAD} = sub { $_[1] ? $_[0]->set($name, $_[1]) : $_[0]->g +et($name); } } &{$AUTOLOAD}($self,@_); } sub new { my $class = shift; my $self = {}; bless $self, $class; $self->params(@_); $self->init(); return $self; } sub _readonly { my ($self,$key) = @_; return 1 if grep {$_ eq $key} $self->readonly; return 0; } sub get { my ($self,$key) = @_; return $self->{$key} if exists $self->{$key}; warn "Accessing undefined key '$key'."; return undef; } sub set { my ($self,$key,$new) = @_; return if $self->_readonly($key); carp "Accessing undefined key '$key'." and return unless exists $se +lf->{$key}; my $old = $self->{$key}; $self->{$key} = $new; return $old; } 1;
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

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://356567]
[Corion]: A good morning to everybody ;)

How do I use this? | Other CB clients
Other Users?
Others rifling through the Monastery: (4)
As of 2018-06-24 06:26 GMT
Find Nodes?
    Voting Booth?
    Should cpanminus be part of the standard Perl release?

    Results (126 votes). Check out past polls.