Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

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

___________
Eric Hodges


Comment on Re: OO Inheritence
Select or Download Code

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://356567]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others perusing the Monastery: (9)
As of 2014-12-27 14:16 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (177 votes), past polls