Converting types in OOP Perl program - perl

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.

Related

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().

How to get reference to parent class subroutine 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

Using Perl's Method::Signatures, why can't I invoke methods on an object instance?

I followed what friedo said here.
Now, when I try to call the method testScript I get the error global symbol $obj requires explicit package name and it fails to call testScriptTwo.
use strict;
use warnings;
package Test;
use Method::Signatures;
method new {
my $obj = bless {}, $self;
return $obj;
}
method testScript {
$obj->testScriptTwo(); # Error happens here
}
method testScriptTwo { ... }
Test script:
use Test;
my $class = Test->new();
$class->testScript();
How do I make use of $obj to call methods within the package itself?
Use this instead:
method testScript {
$self->testScriptTwo();
}
The first argument is in the variable $self, not $obj
Your questions seem to indicate you do not understand the basics of scope, and how plain Perl objects work.
In Perl, when you use the ->method syntax on a package name or blessed reference, the subroutine method in that package is invoked. The first argument to the subroutine is the thing on which you invoked method.
So, if you do
My::Friend->new('Alfred');
the new subroutine in the package My::Friend receives two arguments. My::Friend and Alfred.
In a new method, it is customary to refer to the first argument as $class, but that is completely up to you. You could use $basket_case if you were so inclined:
sub new {
my $basket_case = shift;
my $basket = shift;
my $obj = bless { name => $basket } => $basket_case;
return $obj;
}
If you then invoke a method on the returned reference, that method will receive said reference as its first argument, allowing you to access data stored in that reference:
sub blurb {
my $schmorp = shift;
print $schmorp->{name}, "\n";
return;
}
Putting it all together:
#!/usr/bin/env perl
package My::Package;
use strict;
use warnings;
sub new {
my $basket_case = shift;
my $basket = shift;
my $obj = bless { name => $basket } => $basket_case;
return $obj;
}
sub blurb {
my $schmorp = shift;
print $schmorp->{name}, "\n";
return;
}
sub derp {
my $herp = shift;
printf "%s derp derp\n", $herp->{name};
return;
}
package main;
my $x = My::Package->new('Alfred');
$x->blurb;
$x->derp;
Output:
Alfred
Alfred derp derp
You need to understand these basics. Trying to put another layer of abstraction on top of the basics before understanding what is underneath will not make things any easier.
Now, if you are using Method::Signatures, it, by convention, puts that implicit first argument in a lexically scoped variable which, by default, it calls $self.
You can override that name in specific methods, and doing so in new might be a good idea to convey the fact that it doesn't expect an object instance; instead it returns a new instance.
Whatever you called that lexically scoped instance variable in one sub does not affect what it is called in another sub. For example:
#!/usr/bin/env perl
use strict;
use warnings;
sub a_number {
my $number = int(rand(10));
return $number;
}
sub square_that_number {
my $x = shift;
return $x * $x;
}
my $bzzzt = a_number();
my $trrrp = square_that_number($bzzzt);
print $trrrp, "\n";
Output:
$ ./zt.pl
36
OK, you need to backtrack a bit - you're new method is broken in the first place, which indicates that you don't really understand what's going on with OO perl.
A very simple object looks like this:
package Foo;
sub new {
#when Foo -> new is called, then 'Foo' is passed in as the class name
my ( $class ) = #_;
#create an empty hash reference - can be anything, but $self is the convention
my $self = {};
#tell perl that $self is a 'Foo' object
bless ( $self, $class );
#return the reference to your `Foo` object
return $self;
}
sub set_name {
my ( $self, $new_name ) = #_;
$self -> {name} = $new_name;
}
sub get_name {
my ( $self ) = #_;
return $self -> {name};
}
When you call this in your code:
use Foo;
my $new_instance = Foo -> new();
The class is passed into the new method, which you then use bless to create an instantiated object.
Then you can 'do stuff' with it - when you 'call' a method using -> then the first argument into the subroutine is the object reference.
So
$new_instance -> set_name ( "myname" );
print $new_instance -> get_name();
Is equivalent to:
Foo::set_name($new_instance, "myname" );
print Foo::get_name($new_instance);
You act on $new_instance which is a sort of magic hash that allows you to include code.
Method::Signatures is largely irrelevant until you understand the basics of OO. But what that does is 'simply' expand the functions within a module, such that you don't have to extract self/class etc.
By default, a method defined as method provides $self automatically. no $obj like you're using. That's a variable that's local to you new method, and simply doesn't exist outside that.

Can one pass Perl object references between modules?

Example code:
testClass1.pm
package testClass1;
{
my $testClass2Ref;
sub new
{
my($class) = shift;
$testClass2Ref= shift;
bless $self, $class;
return $self;}
}
sub testRef
{
$testClass2Ref->testRef;
}
}
testClass2.pm
package testClass2;
{
sub new
{
my($class) = shift;
bless $self, $class;
return $self;}
}
sub testRef
{
print "Test 2";
}
}
test.pl
use testClass1;
use testClass2;
my $testClass2 = testClass2->new();
my $testClass1 = testClass2->new($testClass2);
$testClass1->testRef;
When I try call $testClass1->testRef, $testClass2Ref=undef.
How can I pass reference on the object from parent?
Update
Oh, sorry, I missed string in example's constructors.
sub new
{
my($class) = shift;
$testClass2Ref = shift;
my $self = {name=>'testClass1'};
bless $self, $class;
return $self;
}
This test is working, but Eclipse debugger show this variables as 'undef'.
Thanks for your help.
Besides the syntax errors, you aren't using strict mode. Turning it on will reveal that $self isn't being declared in either package. By replacing:
bless $self, $class;
with:
my $self = bless {}, $class;
Everything goes through as expected.
When you fix the syntax errors it works.
> ./test.pl
> Test 2
You were missing
my $self = {};
in both new methods.
A useful tool is
perl -wc testClass1.pm
Can one pass Perl object references between modules?
Absolutely!
In this test script I make two classes, one that tests and one to be tested. Remember objects are just references and methods are just subroutines; use them in the same way.
#!/usr/bin/env perl
use strict;
use warnings;
package Tester;
sub new {
my $class = shift;
my ($other) = #_;
my $self = { other => $other };
bless $self, $class;
return $self;
}
sub examine {
my $self = shift;
print "I'm holding a: ", ref( $self->{other} ), "\n";
}
package Candidate;
sub new { return bless {}, shift }
package main;
my $candidate = Candidate->new();
my $tester = Tester->new( $candidate );
$tester->examine();
EDIT: Now using a more modern system, MooseX::Declare (which is based on Moose) with Method::Signatures. This saves a lot of the boilerplate and lets you focus on what you want the objects to do, rather then how they are implemented.
#!/usr/bin/env perl
#technically Moose adds strict and warnings, but ...
use strict;
use warnings;
use MooseX::Declare;
use Method::Signatures::Modifiers;
class Tester {
has 'other' => ( isa => 'Object', is => 'rw', required => 1 );
method examine () {
print "I'm holding a: ", ref( $self->other() ), "\n";
}
}
class Candidate { }
no MooseX::Declare;
package main;
my $candidate = Candidate->new();
my $tester = Tester->new( other => $candidate );
$tester->examine();
For more realistic cases, see how some larger module systems pass object representing complex concepts. Off the top of my head, HTTP::Response object get passed around all through the LWP system

Inheritance and default constructor in perl

I have the following code :-
package A;
sub new{
//constructor for A
}
sub hello{
print "Hello A";
}
1;
package B;
use base qw(A);
sub hello{
print "Hello B";
}
1;
My question is how can I instantiate B i.e. my $b = B->new(), without giving a constructor to B, what changes do I need to do in A to achieve this. Is this possible ?
Thanks.
Yes. Use this as A's new method:
sub new {
my ($cls, #args) = #_;
# ...
my $obj = ...; # populate this
bless $obj, $cls;
}
The key is that when using B->new, the first argument is B (which I bound to $cls in my example). So if you call bless using $cls, the object will be blessed with the correct package.
In line with Chris' answer, your code should now look like:
package A;
sub new{
my ( $class ) = #_;
my $self = {};
bless $self, $class;
}
sub hello{
print "Hello A";
}
package B;
use base qw(A);
sub hello{
print "Hello B";
}
package main;
my $b = B->new;
$b->hello;
B simply inherits A's constructor.