How to get reference to parent class subroutine perl - perl

I have a situation where in child class, I need a reference of subroutines defined in parent class which I need to pass to some other class which would execute them.
So I was wrote following sample modules for testing the same.
Parent1.pm
package Parent1;
sub new {
my ($class, $arg_hash) = #_;
my $self = bless $arg_hash, $class;
return $self;
}
sub printHello{
print "Hello\n";
}
sub printNasty{
print "Nasty\n";
}
1;
Child1.pm
package Child1;
use base Parent1;
sub new {
my ($class, $arg_hash) = #_;
my $self = bless $arg_hash, $class;
return $self;
}
sub testFunctionReferences{
my ($self) = #_;
# Case 1: Below 2 lines of code doesn't work and produces error message "Not a CODE reference at Child1.pm line 18."
#my $parent_hello_reference = \&$self->SUPER::printHello;
#&$parent_hello_reference();
# Case 2: Out of below 2 lines of code, 1st line executes the function and produces output of "Hello\n" but 2nd line doesn't work and produces error message "Not a CODE reference at Child1.pm line 23."
#my $parent_hello_reference2 = \$self->SUPER::printHello;
#&$parent_hello_reference2();
# Case 3: does not work either. Says "Undefined subroutine &Child1::printNasty called at Child1.pm line 27"
#my $parent_nasty_reference = \&printNasty;
#&$parent_nasty_reference();
# Case 4: works. prints "World\n" as expected
#my $my_own_function_reference = \&printWorld;
#&$my_own_function_reference();
# Case 5: works. prints "Hello\n" and "Nasty\n" as expected
#$self->printHello();
#$self->SUPER::printNasty();
# Case 6: does not work produces error "Undefined subroutine &Child1::printHello called at Child1.pm line 38"
#printHello();
return;
}
sub printWorld{
print "World\n";
}
test.pl
#!/usr/bin/perl
use Child1;
my $child = Child1->new({});
$child->testFunctionReferences();
So my questions are:
As in case 1, what is the correct syntax to get a reference to parent subroutine?
When I use inheritance, how can I call the parent function directly as in case 6? Is it even possible in perl?
When case 5 works then why not case 6?
Any insights are appreciated. Thanks

If printHello is a subroutine, use
my $sub = \&Parent::printHello;
If printHello is a method, use
# This line must appear inside of the Child package.
my $sub = sub { $self->SUPER::method(#_) };
If you want a code reference, you need a subroutine to reference, and this creates one.
In both cases, you can call the sub using
&$sub();
or
$sub->();
(I find the latter cleaner, but they are otherwise equivalent.)

I figured out another method to get a reference to a parent class subroutine using 'UNIVERSAL' module 'can' method.
#Parent.pm
package Parent;
sub new {
my ($class, $arg_hash) = #_;
my $self = bless $arg_hash, $class;
return $self;
}
sub printHello{
print "Parent Hello Called\n";
}
1;
#Child.pm
package Child;
use base Parent;
sub new {
my ($class, $arg_hash) = #_;
my $self = bless $arg_hash, $class;
return $self;
}
sub getParentSubReference{
my ($self) = #_;
return $self->can('printHello');
}
1;
#test.pl
#!/usr/bin/perl
use Child;
my $obj = Child->new({});
my $ref = $obj->getParentSubReference();
&$ref();
#Output
Parent Hello Called

Related

Not a code reference in Perl class

I'm stumped. I'm new to Perl and after reading some articles, I still can't figure this one out. It's a very small class.
package Haha;
sub new {
$class = shift;
$self = {
path => shift
};
bless $self, $class;
return $self;
}
sub setPath {
my ($self, $new_path) = shift;
$self->(path) = $new_path if defined $new_path;
return $self->(path);
}
sub getPath {
my $self = shift;
return $self->(path);
}
1;
And I used it like this:
use lib 'lib';
use Haha;
my $new_excel = new Haha("sample path");
print $new_excel->getPath() ;
<>;
Class Haha line 23 raises the "Not a code reference" error.
The line that says return $self->(path);
Your class (like most Perl classes) is implemented on top of hashes. When you create a new object in your constructor, you do it like this:
sub new {
$class = shift;
$self = {
path => shift
};
bless $self, $class;
return $self;
}
The line $self = { ... } creates an anonymous hash and stores a reference to that hash in $self. So, $self is a hash reference. Which means that you should access its contents using hash syntax. So your accessor and mutator methods are wrong.
sub setPath {
my ($self, $new_path) = shift;
$self->(path) = $new_path if defined $new_path;
return $self->(path);
}
You are using parentheses, not braces, to access the path value in your hash. The line:
$self->(path) = $new_path if defined $new_path;
Should be:
# Note: braces, not parentheses
$self->{path} = $new_path if defined $new_path;
And the line:
return $self->(path);
Should be:
# Note: braces, not parentheses
return $self->{path};
You need to make a similar fix to getPath().
Unfortunately, the syntax $reference->($value) is completely valid. It means "call the subroutine that you have a reference to in $reference, passing it $value". But, of course, this requires $reference to contain a subroutine reference, not a hash reference.
A few other suggestions.
Always use strict and use warnings.
Indirect object notation ($new_excel = new Haha("sample path")) is likely to burn you at some point. Please use $new_excel = Haha->new("sample path") instead.
Your line my ($self, $new_path) = shift doesn't do what you think it does. You want my ($self, $new_path) = #_.
path is an attribute of the object, use curly brackets:
sub getPath {
my $self = shift;
return $self->{path};
}
In the sub setPath, the variable $new_path is never assigned, use instead:
sub setPath {
my ($self, $new_path) = #_;
$self->{path} = $new_path if defined $new_path;
return $self->{path};
}

Perl - Can't locate object method via "Module::SUPER"

This is my first time using OOP with perl. I am in the processes of refactoring a 4k line procedural program at work. It seems pretty straight forward but I am having an issue with inheritance and SUPER.
Error message:
"Can't locate object method "New" via package "Module::SUPER" at Module.pm line 10"
I have tried, use base, parent and setting #ISA but they all get the same error. I'm sure I have to be overlooking something.
(This is not code from the program I am working on. Just an example that produces the same error)
All .pm and .pl files are in the same directory in this example. In the program I am working on the main program is in bin and the modules will be in ../modules(relative to bin).
I would assume this would be all I need to make that work:
use lib "../modules";
If I am wrong in thinking that please let me know.
Parent Module
package BaseModule;
use strict;
use warnings;
sub new {
my $class = shift;
my $self = {
ARRAY => shift,
DIVIDER => ","
};
bless ($self, $class);
return $self;
}
sub array {
my $self = shift;
if(#_) { $self->{ARRAY} = shift };
return $self->{ARRAY};
}
sub divider {
my $self = shift;
if(#_) { $self->{DIVIDER} = shift };
return $self->{DIVIDER};
}
sub testSub {
my $self = shift;
print join($self->{DIVIDER}, #{ $self->{ARRAY} } );
return 1;
}
1;
Child Module
package Module;
use strict;
use warnings;
#use base qw(BaseModule);
#require BaseModule;
#our #ISA = qw(BaseModule);
use parent qw(BaseModule);
sub new {
my $class = shift;
my $self = $class->SUPER::New(#_);
$self->{STRING} = shift;
bless ($self, $class);
return $self;
}
sub string {
my $self = shift;
if(#_) { $self->{STRING} = shift };
return $self->{STRING};
}
sub testSub {
my $self = shift;
print "$self->{STRING}:\n";
$self->SUPER::testSub();
return 1;
}
1;
Do I need to bless the child class if the parent class returns an already blessed $self?
Main Script
#!/usr/bin/perl
use strict;
use warnings;
use Module;
my $module = Module->new([1, 2, 3, 4, 5], "Example");
$module->divider(" | "); # Test Changing divider;
$module->testSub();
Any help is greatly appreciated.
"Can't locate object method "New" via package "Module::SUPER" at Module.pm line 10"
You try to call BaseModule::New whis hasn't been defined (did you mean BaseModule::new? Perl is case sensitive).
Do I need to bless the child class if the parent class returns an
already blessed $self?
No, $self at that point is already blesses (you could check that by means of Scalar::Util::blessed().

Converting types in OOP Perl program

I am experimenting with something I like to do in Perl but I am getting a strange output and I can't figure out why.
Basically I have 2 classes. A is the base and B inherits from A.
I issue prints to the screen to track the program and result. On the last stage I am trying to cast A Type to B Type and to use a function declared in B.
For some reason this whole program runs twice - the output is duplicated - though i run the program once.
Is this a real issue? and why does it happen?
I am pasting here my code and output.
The file name is A.pm;
Running command: 'perl A.pm'
package A;
sub new
{
my ($class) = shift;
my $self = {};
bless $self, $class;
}
sub P
{
my $self = shift;
print "P:A\n";
}
sub PA
{
my $self=shift;
print "PA:A\n";
}
1;
###############################
package B;
use base 'A';
sub new
{
my ($class) = shift;
my $self = {};
bless $self, $class;
}
sub P
{
my $self=shift;
print "P:B\n";
}
sub PB
{
my $self=shift;
print "PB:B\n";
}
1;
###############################
package main;
$o = B->new;
$o->P();
$o->PA();
$o->PB();
$o = A->new;
$o->P();
$o->PA();
print "Casting\n";
bless $o , 'B';
$o->PB();
print "End\n";
Output:
[#~]perl A.pm
P:B
PA:A
PB:B
P:A
PA:A
Casting
PB:B
End
P:B
PA:A
PB:B
P:A
PA:A
Casting
PB:B
End
Instead of the deprecated base, do use parent -norequire => 'A';
One of the defects of base that caused it to be superseded by parent is that there's no good way to tell it not to try loading the base class module.

Perl inheritance through ISA

Question regarding inheritance in Perl using #ISA:
Input - 3 files: one is a main script, two containing parent & child packages, correspondingly:
main:
#!/usr/bin/perl
use child qw(parent_or_child_function srictly_parent_function);
parent_or_child_function();
srictly_parent_function();
parent.pm:
package parent;
sub srictly_parent_function
{
print "this is strictly parent function\n";
}
sub parent_or_child_function
{
print "this is parent function which can be inherited\n";
}
1;
child.pm:
package child;
our #ISA = 'parent';
use Exporter qw(import);
#EXPORT_OK = qw(parent_or_child_function srictly_parent_function);
sub parent_or_child_function
{
print "this is child function that replaced parent's\n";
}
1;
Output is:
$main
this is child function that replaced parent's
Undefined subroutine &child::srictly_parent_function called at main line 6.
What am I doing wrong? I understand that child package doesn't have strictly_parent_function , but shouldn't child's #ISA package be searched for it?
Firstly, make parent actually an object.
package parent;
use strict;
use warnings;
# Constructor
sub new {
my ($proto) = #_;
my $class = ref($proto) || $proto;
my $self = {};
# Bless is what casts $self (instance of this class) as an object
return bless($self, $class);
}
sub srictly_parent_function {
my ($self) = #_;
print "this is strictly parent function\n";
}
sub parent_or_child_function {
my ($self) = #_;
print "this is parent function which can be inherited\n";
}
1;
Then with parent as an object, child can inherit
package child;
use strict;
use warnings;
# I prefer use base, as it's safer than pushing classes into #ISA
# See http://docstore.mik.ua/orelly/perl2/prog/ch31_03.htm)
use base qw(parent);
sub parent_or_child_function {
my ($self) = #_;
print "this is child function that replaced parent's\n";
}
# To give an example for accessing variables from a class.
my $variable = "WHATEVER";
sub get_variable { return $variable;}
1;
Then to test your code:
perl -e "use child; $object = child->new(); $object->parent_or_child_function();"
or to script it up properly;
# Load up child class
use child qw();
# Invoke constructor to create an instance of the class
my $object = child->new();
# Invoke function from child class
$object->parent_or_child_function();
# Get Variable
$object->get_variable();

Getting issues in object oriented perl

I am new to OO perl. I am trying to write one simple program but getting the error.
Created a package Employee.pm as
package Employee;
sub new {
my $class = shift;
my $self = {};
bless $self, $class;
return $self;
}
sub get_names {
my $self = #_;
print " getting the names \n";
return $self;
}
sub set_names {
my ($self, $last_name) = #_;
$self->{last_name} = $last_name;
return $self->{$last_name};
}
1;
And created a .pl file as
use strict;
use warnings;
use Employee;
my $obj = new Employee("name" => "nitesh", "last_name" => "Goyal");
my $val = $obj->get_names();
print %$val;
my $setName = $obj->set_names("kumar");
print "$setName \n";
I am getting error as
"Can't use string ("1") as a HASH ref while "strict refs" in use at class1.txt line 10."
The error
"Can't use string ("1") as a HASH ref ..
Comes from this part:
sub get_names {
my $self = #_;
When an array is put in scalar context, it returns its size. Since you call the sub with
$obj->get_names();
Only one argument is passed, which is the object, so #_ contains 1 argument, and its size is 1, therefore in the sub get_names, the variable $self is set to 1. Hence the error. What you probably should do is
my $self = shift;
But then, that will not do anything, because you never stored the names in your constructor. As mpapec said, you should do
my $self = { #_ };
in the constructor sub new.
Also, in get_names, you simply return the object, which is not very useful. You should perhaps return $self->{name} and $self->{last_name}.