Object oriented Perl: SUPER

Base.pm

package Base;
use warnings;
use strict;

sub new { #_{
  my $class = shift;
  my $self  = {};
  bless $self, $class;

  $self->p("Base::new");
  return $self;
} #_}

sub p { #_{

  my $self = shift;
  my $text = shift;
  printf("%-30s: [ref(\$self)=%s]\n", $text, ref $self);

} #_}

1;

Derived_1.pm

package Derived_1;
use warnings;
use strict;

use Base;

our @ISA = qw(Base);

sub new { #_{
  my $class = shift;
  my $self  = $class->SUPER::new();
  $self->p("Derived_1::new");
  return $self;
} #_}

sub m_d1 { #_{
  my $self = shift;
  $self->p("Derived_1::m_d1");
} #_}

1;

Derived_2.pm

package Derived_2;
use warnings;
use strict;

our @ISA = qw(Base);

sub new { #_{
  my $class = shift;
  my $self = $class->SUPER::new();
  $self->p("Derived_2::p");
  return $self;
} #_}

sub m_d2 { #_{
  my $self = shift;
  $self->p("Derived_2::m_d2");
} #_}

1;

TwoParents.pm

package TwoParents;
use warnings;
use strict;

our @ISA = qw(Derived_1 Derived_2);

sub new { #_{
  my $class = shift;

# TwoParents has to classes it derives from: Derived_1
# and Derived_2.
# SUPER will only call Derived_1:
  my $self=$class->SUPER::new();
  return $self;
} #_}

1;

main.pl

#!/usr/bin/perl
use warnings;
use strict;

use Base;
use Derived_1;
use Derived_2;
use TwoParents;

print "----- Base\n";
my $base = Base->new;

print "----- Derived_1\n";
my $der1 = Derived_1->new;
$der1->m_d1();

print "----- Derived_2\n";
my $der2 = Derived_2->new;
$der2->m_d2();

print "----- TwoParents->new\n";
my $twop = TwoParents->new;
$twop->m_d1();
$twop->m_d2();

See also