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;