Monday, June 4, 2012

Perl Object Creation, Inheritance, overloading.... in one page?

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