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->_valid( $key ); return undef if ! defined $_[0]; $self->{$key} = $_[0]; } }; $AUTOLOAD->( @_ ); } 1; #### 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; #### 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; #### #!/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";