Is there a way to override sub a in class_1_1 and class_2_1 with a new behavior(same for both classes) without adding the overridden method to both class_1_1 and class_2_1?
package class_0
sub a
sub b
1;
package class_1
use parent 'class_0'
sub b
1;
package class_2
use parent 'class_0'
sub b
1;
package class_1_1
use parent 'class_1'
1;
package class_2_1
use parent 'class_2'
1;
One tailor-made solution is to add a role for the wanted behavior.
Here is an example with native OO code, using stand-alone Role::Tiny for roles
use warnings;
use strict;
use SomeClass;
my $obj = SomeClass->new;
$obj->a_method;
The class SomeClass.pm
package SomeClass;
use warnings;
use strict;
use feature 'say';
use Role::Tiny::With; # To "consume" a role. Comes with Role::Tiny
# Consume roles from "AddedRoles.pm"
# That may add or require methods, or override the ones here
with 'AddedRoles';
sub new { bless { }, $_[0]] }
sub a_method { say "From ", __PACKAGE__ }
1;
This role can be added to other classes as well, by adding the use statement and the line with 'AddedRoles'; to them, regardless of their inheritance relationships. See the docs for ways to fine tune the process.
The package with the roles, AddedRoles.pm
package AddedRoles;
use feature 'say'; # we get strict and warnings from the package but not this
use Role::Tiny;
# Require that consumers implement methods; Add a method
#require method_1, method_2;
#sub added_method { say "Adding functionality to consumers" }
# Replace "a_method" in a consumer
around a_method => sub { say "From an overriding role ", __PACKAGE__ }
1;
The Role::Tiny need be installed (which has no dependencies).
To replace a method that is defined in the class that consumes the role we need a method modifier around,†</sup> provided by Class::Method::Modifiers, so that is an additional dependency.
Roles are often compared to inheritance, and claimed to provide a nicer and lighter alternative since inheritance is normally "baked" into the whole class hierarchy etc. However, inheritance generally specializes behavior while roles are clearly more flexible; they add or modify behavior (or can specialize for that matter). I rather see roles fitting nicely somewhere between inheritance and composition.
Note that with roles we can have a near equivalent of multiple inheritance, with almost none of its formidable (and forbidding) headaches.
The bare-bones example above demonstrates the use of Role::Tiny on its own. But roles are better utilized along with Moose or Moo frameworks, using Moose::Role or Moo:Role.
I would absolutely recommend to look into these frameworks. I strongly believe in the value of learning well how to use the Perl's native OO system, but once one has that under their belt it'd be a shame to not try Moose or Moo.
†</sup> In this particular question though the method to override is inherited from another class and in that case there is no need for a modifier. From "Role Composition" in docs
If a method is already defined on a class, that method will not be composed in from the role. A method inherited by a class gets overridden by the role's method of the same name, though.
So in the case of this question it is enough to normally define a sub in the roles package
# In the package that defines roles (like 'AddedRoles' above)
sub a_method { say "From an overriding role ", __PACKAGE__ }
and when this role is consumed by a class which inherits a_method, like class_1_1 in the question, the method does get overridden by this one.
Note that if a method is defined in the class itself (not inherited) then a role defined as a normal sub is quietly ignored (it won't override the method and it won't warn or such).
On the other hand, around overrides a method in either case (inherited or defined in the class), but cannot add a method that isn't there at all (and throws an exception if that is attempted).
You can do it with multiple inheritance:
#!/usr/bin/perl
use strict;
use warnings;
package class_0;
sub new {
my ($class, $foo) = @_;
return bless{foo=>$foo}, $class;
}
sub a {
my $self=shift;
print 'a class_0 foo=' . $self->{foo} . "\n";
}
sub b {
my $self=shift;
print 'b class_0 foo=' . $self->{foo} . "\n";
}
package new_a;
sub a {
my $self=shift;
print 'a new_a foo=' . $self->{foo} . "\n";
}
package class_1;
use parent -norequire, 'class_0';
sub b {
my $self=shift;
print 'b class_1 foo=' . $self->{foo} . "\n";
}
package class_1_1;
use parent -norequire, 'new_a', 'class_1';
package class_2;
use parent -norequire, 'class_0';
sub b {
my $self=shift;
print 'b class_2 foo=' . $self->{foo} . "\n";
}
package class_2_1;
use parent -norequire, 'new_a', 'class_2';
package main;
# example usage
my $c0 = class_0->new(1);
my $c1 = class_1->new(2);
my $c2 = class_2->new(3);
my $c11 = class_1_1->new(4);
my $c21 = class_2_1->new(5);
print "-- a class_0 b class_0\n";
$c0->a; $c0->b;
print "-- a class_0 b class_1\n";
$c1->a; $c1->b;
print "-- a class_0 b class_2\n";
$c2->a; $c2->b;
print "-- a new_a b class_1\n";
$c11->a; $c11->b;
print "-- a new_a b class_2\n";
$c21->a; $c21->b;
Output:
-- a class_0 b class_0
a class_0 foo=1
b class_0 foo=1
-- a class_0 b class_1
a class_0 foo=2
b class_1 foo=2
-- a class_0 b class_2
a class_0 foo=3
b class_2 foo=3
-- a new_a b class_1
a new_a foo=4
b class_1 foo=4
-- a new_a b class_2
a new_a foo=5
b class_2 foo=5