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;
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.