The Perl motto still holds: There's more than one way to do it.
package Foo;
sub new {
my $type = shift;
my %params = @_;
my $self = {};
$self->{'High'} = $params{'High'};
$self->{'Low'} = $params{'Low'};
bless $self;
}
package Bar;
sub new {
my $type = shift;
my %params = @_;
my $self = [];
$self->[0] = $params{'Left'};
$self->[1] = $params{'Right'};
bless $self;
}
package main;
$a = new Foo ( 'High' => 42, 'Low' => 11 );
print "High=$a->{'High'}\n";
print "Low=$a->{'Low'}\n";
$b = new Bar ( 'Left' => 78, 'Right' => 40 );
print "Left=$b->[0]\n";
print "Right=$b->[1]\n";
package Foo;
sub new {
my $type = shift;
my $self;
$self = shift;
bless \$self;
}
package main;
$a = new Foo 42;
print "a=$$a\n";
package Bar;
sub new {
my $self = {};
$self->{'buz'} = 42;
bless $self;
}
package Foo;
@ISA = qw( Bar );
sub new {
my $self = new Bar;
$self->{'biz'} = 11;
bless $self;
}
package main;
$a = new Foo;
print "buz = ", $a->{'buz'}, "\n";
print "biz = ", $a->{'biz'}, "\n";
package Bar;
sub new {
my $self = {};
$self->{'buz'} = 42;
bless $self;
}
package Foo;
sub new {
my $self = {};
$self->{'Bar'} = new Bar ();
$self->{'biz'} = 11;
bless $self;
}
package main;
$a = new Foo;
print "buz = ", $a->{'Bar'}->{'buz'}, "\n";
print "biz = ", $a->{'biz'}, "\n";
package Buz;
sub goo { print "here's the goo\n" }
package Bar; @ISA = qw( Buz );
sub google { print "google here\n" }
package Baz;
sub mumble { print "mumbling\n" }
package Foo;
@ISA = qw( Bar Baz );
@Foo::Inherit::ISA = @ISA; # Access to overridden methods.
sub new { bless [] }
sub grr { print "grumble\n" }
sub goo {
my $self = shift;
$self->Foo::Inherit::goo();
}
sub mumble {
my $self = shift;
$self->Foo::Inherit::mumble();
}
sub google {
my $self = shift;
$self->Foo::Inherit::google();
}
package main;
$foo = new Foo;
$foo->mumble;
$foo->grr;
$foo->goo;
$foo->google;
use SDBM_File;
use POSIX;
package Mydbm;
sub TIEHASH {
my $self = shift;
my $ref = SDBM_File->new(@_);
bless {'dbm' => $ref};
}
sub FETCH {
my $self = shift;
my $ref = $self->{'dbm'};
$ref->FETCH(@_);
}
sub STORE {
my $self = shift;
if (defined $_[0]){
my $ref = $self->{'dbm'};
$ref->STORE(@_);
} else {
die "Cannot STORE an undefined key in Mydbm\n";
}
}
package main;
tie %foo, Mydbm, "Sdbm", O_RDWR|O_CREAT, 0640;
$foo{'bar'} = 123;
print "foo-bar = $foo{'bar'}\n";
tie %bar, Mydbm, "Sdbm2", O_RDWR|O_CREAT, 0640;
$bar{'Cathy'} = 456;
print "bar-Cathy = $bar{'Cathy'}\n";
This first example illustrates a class which uses a fully-qualified method call to access the "private" method BAZ(). The second example will show that it is impossible to override the BAZ() method.
package FOO;
sub new { bless {} }
sub bar {
my $self = shift;
$self->FOO::private::BAZ;
}
package FOO::private;
sub BAZ {
print "in BAZ\n";
}
package main;
$a = FOO->new;
$a->bar;
Now we try to override the BAZ() method. We would like FOO::bar() to call
GOOP::BAZ(), but this cannot happen since FOO::bar() explicitly calls
FOO::private::BAZ().
package FOO;
sub new { bless {} }
sub bar {
my $self = shift;
$self->FOO::private::BAZ;
}
package FOO::private;
sub BAZ {
print "in BAZ\n";
}
package GOOP;
@ISA = qw( FOO );
sub new { bless {} }
sub BAZ {
print "in GOOP::BAZ\n";
}
package main;
$a = GOOP->new;
$a->bar;
To create reusable code we must modify class FOO, flattening class
FOO::private. The next example shows a reusable class FOO which allows the
method GOOP::BAZ() to be used in place of FOO::BAZ().
package FOO;
sub new { bless {} }
sub bar {
my $self = shift;
$self->BAZ;
}
sub BAZ {
print "in BAZ\n";
}
package GOOP;
@ISA = qw( FOO );
sub new { bless {} }
sub BAZ {
print "in GOOP::BAZ\n";
}
package main;
$a = GOOP->new;
$a->bar;