Keep looking for a small sample with all the bells and whistles that I can shelf for all my object structures in perl. Loads of docs, but I could not find a nice complete one that I could stamp as usable. So here we go.
Example is the object relationships between Vehicle, Vehicle::Car and Vehicle::Car::RaceCar
all vehicles have a maxspeed (number),
car all has wheels (number),
racecar has doortype (winged, standard),
So here we go
run.pl
#!/usr/bin/perl
use strict;
use lib("../lib");
use Vehicle;
use Vehicle::Car;
use Vehicle::Car::RaceCar;
my $v = Vehicle->new(name=>'Ferarri');
printf "The default max speed of any vehicle is %d, %s\n",$v->maxspeed, $v->name;
$v->print;
$v->name('Volvo');
$v->print;
print "----------------------\n";
$v = Vehicle::Car->new(name=>'Beetle', wheels=>4, maxspeed=>100, andre=>43);
$v->print;
$v->wheels(10);
$v->print;
print "----------------------\n";
$v = Vehicle::Car::RaceCar->new(name=>'Ferrari', wheels=>4, maxspeed=>200, doortype=>'Winged');
$v->print;
The following package structure is recommended
Vehicle.pm
package Vehicle;
use strict;
use Carp;
use Data::Dumper;
use vars (qw($VERSION @ISA @EXPORT @EXPORT_OK ));
BEGIN {
# initializer for static variables and methods
use Exporter;
use vars qw ( $VERSION @ISA @EXPORT);
$VERSION = 1.0;
@ISA = qw ( Exporter );
@EXPORT = qw (static_method_string);
}
#constructor
sub new {
my ($class) = shift;
my %x = @_;
my @override = ();
foreach my $var (keys %x) {
my $var_name = $var =~ /^_/ ? $var : sprintf "_%s", $var;
push @override, ($var_name, $x{$var});
}
#print Dumper(\@override, @_);
my $self = {
_maxspeed => 0,
_name => 'N/A',
@override, #override
};
bless $self, $class;
return $self;
}
#accessor method for name
sub name {
my ( $self, $name ) = @_;
$self->{'_name'} = $name if defined($name);
return ( $self->{'_name'} );
}
#accessor method for maxspeed
sub maxspeed {
my ( $self, $maxspeed ) = @_;
$self->{'_maxspeed'} = $maxspeed if defined($maxspeed);
return ( $self->{'_maxspeed'} );
}
sub print {
my ($self) = @_;
printf( "Name:'%-50s' Maxspeed:%s\n", $self->name, $self->maxspeed);
}
sub methodonlyinvehicles {
print static_method_string("in all vehicles");
}
sub static_method_string {
sprintf "%s %s\n", 'method call in ', shift;
}
$|=1;
1;
Vehicle/Car.pm
package Vehicle::Car;
use Vehicle;
use strict 'vars';
our @ISA = qw(Vehicle);
our @EXPORT = qw(wheel);
#constructor
sub new {
my ($class) = shift;
my %x = @_;
my @override = ();
foreach my $var (keys %x) {
my $var_name = $var =~ /^_/ ? $var : sprintf "_%s", $var;
push @override, ($var_name, $x{$var});
}
#call the constructor of the parent class, Car.
my $self = $class->SUPER::new(@override);
bless $self, $class;
return $self;
}
#accessor method for wheels
sub wheels {
my ( $self, $wheels ) = @_;
$self->{'_wheels'} = $wheels if defined($wheels);
return ( $self->{'_wheels'} );
}
sub print {
my ($self) = @_;
# we will call the print method of the parent class
$self->SUPER::print;
printf " has %d wheels\n", $self->wheels;
}
sub methodonlyincars {
print static_method_string('only in vehicles and cars');
}
1;
Vehicle/Car/RaceCar.pm
package Vehicle::Car::RaceCar;
use strict 'vars';
use Vehicle; # to import the static method in the parent class
use vars qw($VERSION @ISA @EXPORT);
our @ISA = qw(Vehicle::Car);
our @EXPORT = qw(doortype);
my $CLASS = __PACKAGE__;
sub new {
my ($class) = shift;
my %x = @_;
my @override = ();
foreach my $var (keys %x) {
my $var_name = $var =~ /^_/ ? $var : sprintf "_%s", $var;
push @override, ($var_name, $x{$var});
}
#call the constructor of the parent class, Car.
my $self = $class->SUPER::new(@override);
bless $self, $class;
return $self;
}
#accessor method for doortype
sub doortype {
my ( $self, $doortype ) = @_;
$self->{'_doortype'} = $doortype if defined($doortype);
return ( $self->{'_doortype'} );
}
sub print {
my ($self) = @_;
# we will call the print method of the parent class
$self->SUPER::print;
printf " has %s doors\n", $self->doortype;
}
sub methodonlyinracecar {
print static_method_string('only in racecar');
}
1;
No comments:
Post a Comment