I have a package in perl , which uses two other package as its base.
Parent1:
package Parent1;
use strict;
use warnings;
sub foo
{
my $self = shift;
print ("\n Foo from Parent 1 ");
$self->baz();
}
sub baz
{
my $self = shift;
print ("\n Baz from Parent 1 ");
}
1;
Parent 2:
package Parent2;
use strict;
use warnings;
sub foo
{
my $self = shift;
print ("\n Foo from Parent 2 ");
$self->baz();
}
sub baz
{
my $self = shift;
print ("\n Baz from Parent 2 ");
}
1;
Child: This uses the above two parent packages.
package Child;
use strict;
use warnings;
use base qw(Parent1);
use base qw(Parent2);
sub new
{
my $class = shift;
my $object = {};
bless $object,$class;
return $object;
}
1;
Main:
use strict;
use warnings;
use Child;
my $childObj = new Child;
$childObj->Parent2::foo();
Output:
Foo from Parent 2
Baz from Parent 1
My analysis:
From the output, it is clear that child object is passed to parent2's foo method and from that foo method, It is making a call to baz method. It checks for baz method in Child package first because, I am calling it with child object. Since, baz method is not in child package, It checks for the method in the base class. Parent1 is the first base class for Child. So, it finds the method in Parent1 and calls baz method of Parent1.
My question:
Is it possible to call the baz method of Parent2 without changing the order of base class in child ?
My Expected output:
Foo from Parent 2
Baz from Parent 2
The above example is just a analogy of my actual problem. I don't have access to modify the Base classes. I have only access to modify the Child class. So, Is it possible to change child class in such a way that it picks up both the methods from Parent2 without changing the order of base classes ?
Thanks!
If you had access to modify the base classes, you could do this by changing $self->baz()
to Parent2::baz($self)
, but you said you aren't able to do that.
Since that isn't an option, how do you feel about temporarily changing the order of base classes? In Perl, the list of base classes is actually just an array named @ISA
within each package, so you can use local
to create a localized copy of that array within a block:
#!/usr/bin/env perl
use strict;
use warnings;
use 5.010;
package Parent1;
sub foo { say 'foo1'; $_[0]->baz; }
sub baz { say 'baz1'; }
package Parent2;
sub foo { say 'foo2'; $_[0]->baz; }
sub baz { say 'baz2'; }
package Child;
use base qw( Parent1 Parent2 );
sub new { return bless {} }
package main;
my $childobj = Child->new;
{
local @Child::ISA = qw( Parent2 Parent1 );
say 'In localized block';
$childobj->Parent2::foo;
}
say 'Block has exited';
$childobj->Parent2::foo;
Output:
In localized block
foo2
baz2
Block has exited
foo2
baz1
So you can see that this provides your desired output within the block with the localized @ISA
and then the original behavior is restored when the block exits.
Also, a side note in closing: Using new Child
in Perl is called "indirect object notation" and it is generally considered a Bad Thing. I recommend using Child->new
instead.
You can override the needed methods in the Child
class, dispatching to fully qualified calls
package Child;
...
sub baz
{
shift;
Parent2::baz(@_);
}
...
With this added to your code it prints as desired, with Baz from Parent2
.
This is a rather manual way to "augment" the interface of these classes, which clearly have not been designed for multiple inheritance. But the situation you describe is indeed unpleasant and one has to do something like this, or to hard-code specific @ISA
manipulations.
For more complex needs see mro, expressly related to all this. It supports some introspection so you may be able to make decisions at runtime. You'd still have to have Child::baz()
for it.
Can you by any chance change the design and not use multiple inheritance?
You can create an alias to your preferred method. Generally this is a bad idea unless you know what you are doing. Have a look at perldoc perlmod #Symbol Tables.
Update your main file to:
use strict;
use warnings;
use Child;
my $childObj = new Child;
$childObj->Parent2::foo();
print "------\n";
no warnings; # Otherwise will complain about 'Name "Child::baz" used only once: possible typo'
# Create an alias
*Child::baz = *Parent2::baz;
use warnings;
$childObj->Parent2::foo();
Output
Foo from Parent 2
Baz from Parent 1
------
Foo from Parent 2
Baz from Parent 2
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With