Re: OO Inheritence

[eric256]

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