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