Why am I not able to call testmethod of parent using child object in the following code?
use strict;
use Data::Dumper;
my $a = C::Main->new('Email');
$a->testmethod();
package C::Main;
sub new {
my $class = shift;
my $type = shift;
$class .= "::" . $type;
my $fmgr = bless {}, $class;
$fmgr->init(#_);
return $fmgr;
}
sub init {
my $fmgr = shift;
$fmgr;
}
sub testmethod {
print "SSS";
}
package C::Main::Email;
use Net::FTP;
#C::Main::Email::ISA = qw( C::Main );
sub init {
my $fmgr = shift;
my $ftp = $fmgr->{ftp} = Net::FTP->new( $_[0] );
$fmgr;
}
package C::Main::FTP;
use strict;
use Net::FTP;
#C::Main::Email::FTP = qw( C::Main );
sub init {
my $fmgr = shift;
$fmgr;
}
It is because assignment into #ISA is done at runtime, thus after you try to call the method.
You can make it work by surrounding by BEGIN, moving it to compile time:
BEGIN { our #ISA = qw( C::Main ) }
or you can do
use base qw( C::Main );
which is also done in compile time. Both variants do fix your problem.
If you're writing new OO code in Perl, use Moose!
Returning to 'use base' after having used Moose is like going back to the 1950s.
Related
I want to create a hash reference with code references mapped to scalars (strings) as its members.
So far I have a map reference that looks something like this:
my $object;
$object = {
'code1' => sub {
print $_[0];
},
'code2' => sub {
return 'Hello, World!';
},
'code3' => sub {
$object->{code1}->($object->{code2}->());
}
};
$object->{code3}->();
I would like to be able to "bless" the 'code3' reference in $object with $object, so I can do something like:
my $object;
$object = {
'code1' => sub {
print $_[0];
},
'code2' => sub {
return 'Hello, World!';
},
'code3' => sub {
$self = shift;
$self->{code1}->($self->{code2}->());
}
};
$object->{code3}->();
However, bless only works with packages, rather than hash tables.
Is there a way to do this in Perl 5 version 22?
Note: now that I think of it, it's better to pass $object to the method explicitly, as it solves JavaScript's "this" problem. I am just too used to Java's "this" which makes sense in Java where everything is a class and therefore all methods have a "this", but in scripting, it really helps to know if the "this" is actually passed, or is it just called as a function(and you end up accidentally polluting global scope or triggering strict warning) passing $self explicitly makes it clear that you are not calling it as a function, but as a method.
You are doing sub calls (not method calls), so you simply forgot to pass $self as a parameter.
my $object = {
code1 => sub {
print $_[0];
},
code2 => sub {
return 'Hello, World!';
},
code3 => sub {
my $self = shift;
$self->{code1}->( $self, $self->{code2}->($self) );
}
};
$object->{code3}->($object);
But I think you're trying to create JavaScript-like objects. You can start with the following:
package PrototypeObject;
sub new {
my $class = shift;
my $self = bless({}, $class);
%$self = #_;
return $self;
}
sub AUTOLOAD {
my $self = shift;
( my $method = our $AUTOLOAD ) =~ s/^.*:://s;
return $self->{$method}->($self, #_);
}
1;
use PrototypeObject qw( );
my $object = PrototypeObject->new(
code1 => sub {
print $_[1];
},
code2 => sub {
return 'Hello, World!';
},
code3 => sub {
my $self = shift;
$self->code1( $self->code2() );
}
);
$object->code3();
Note that this will slow down your method calls as it must call AUTOLOAD before calling your method. This could be addressed by overloading the method call operator.
Check on CPAN. Someone might already have a more complete implementation.
This is not the exact syntax you want, but Perl 5 supports many ways of making method calls, including method calls via strings. So you could say:
#!/usr/bin/perl
{ package Foo;
use strict;
use warnings;
sub new { bless {}, shift }
sub code1 { my $self = shift; print "$_[0]\n" };
sub code2 { "Hello, World!" }
sub code3 {
my $self = shift;
my $method1 = "code1";
my $method2 = "code2";
$self->$method1($self->$method2);
}
}
use strict;
use warnings;
my $o = Foo->new;
print "normal call\n";
$o->code3;
print "via string\n";
my $method = "code3";
$o->$method;
Also, remember that a package's symbol table is a hash: %Foo::, so you can always go spelunking in there yourself:
#!/usr/bin/perl
{ package Foo;
use strict;
use warnings;
sub new { bless {}, shift }
sub code1 { my $self = shift; print "$_[0]\n" };
sub code2 { "Hello, World!" }
sub code3 {
my $self = shift;
my $method1 = "code1";
my $method2 = "code2";
$self->$method1($self->$method2);
}
}
use strict;
use warnings;
print $Foo::{code2}->(), "\n";
However, I would suggest having a really code reason for these techniques as it can make maintenance a nightmare (eg imaging trying to find all of the code calling Foo::approved, you can't just grep for "->approved" because the actual call is ->$state()).
I just read the comments and noticed you said
my concern with packages is that I can't seem to create packages at runtime, but I can create hash tables at runtime
Perl 5 does allow you to create packages at runtime. In fact, depending on how you define runtime, you can do anything at runtime with string eval as it reenters compile time when it is called. But there is also a pure-runtime method of manipulating the symbol tables with typeglobs:
#!/usr/bin/perl
{ package Foo;
use strict;
use warnings;
sub new { bless {}, shift }
}
use strict;
use warnings;
my $o = Foo->new;
# here we add functions at runtime to the package Foo
{
no warnings "once";
*Foo::code1 = sub { my $self = shift; print "$_[0]\n" };
*Foo::code2 = sub { "Hello, World!" };
*Foo::code3 = sub {
my $self = shift;
my $method1 = "code1";
my $method2 = "code2";
$self->$method1($self->$method2);
};
}
$o->code3;
Because Perl 5 is object oriented (and not object based like JavaScript) these methods are attached to all Foo objects. If you want individual objects have their own symbol tables, then I am there are certainly ways to do that. Off the top of my head, AUTOLOAD comes to mind:
#!/usr/bin/perl
{ package Foo;
use strict;
use Carp;
use warnings;
sub new {
bless {
symtab => {}
}, shift
}
sub AUTOLOAD {
my $self = shift;
our $AUTOLOAD;
my $method = $AUTOLOAD =~ s/.*:://r;
my (undef, $file, $line) = caller();
die "$method does not exist at $file line $line"
unless exists $self->{symtab}{$method};
$self->{symtab}{$method}->($self, #_);
}
sub DESTROY {} # prevent DESTROY method from being hijacked by AUTOLOAD
}
use v5.22;
use warnings;
my $o1 = Foo->new;
my $o2 = Foo->new;
$o1->{symtab}{inc} = sub { my $self = shift; $self->{i}++; };
$o1->inc;
$o1->inc;
$o1->inc;
say "inc called on o1 $o1->{i} times";
$o2->inc; #dies because we haven't defined inc for $o2 yet
Perl 5 is very flexible and will let you do just about anything you want (after all the motto is TIMTOWTDI), but you should always keep in mind the future programmer tasked with maintaining your code who may want to hunt you down and wear your skin for doing some of these tricks.
This question has a definite XY problem feel. It seems like you are trying to solve a problem in Perl 5 the same way you would have solved it in JavaScript. While Perl 5 will let you do that (as I have demonstrated), there may be a more idiomatic way of achieving the same effect. Can you describe what you are trying to do (not how you want to do it) in a different question and we can suggest the ways in which we would solve your problem.
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().
In the example below, I have 3 different syntax/mechanisms for defining inheritance. All of them work. Can someone tell me which one is preferred and why (yes, I know "there is more than ..."). Also, why do I need "use WB" in 1 case and not the other 2. TIA
The main -
#!/usr/local/bin/perl -w
#######################
use strict;
use River;
use Ocean;
use Lake;
my $pName = $0; $pName =~ s/.*\///; $pName =~ s/\.\w+$//;
my #sources = (Ocean->new ('Pacific', 1),
River->new ('Brazos', 0),
Lake->new ('Tahoe', 0) );
foreach (#sources) {
$_->printIfSaline ($pName);
}
The modules (Lake, River and Ocean inherit from WaterBody):
######################
# File: Lake.pm
######################
package Lake;
use strict;
use WaterBody;
our #ISA = ('WaterBody');
sub new {
my $class = shift;
$class->SUPER::new(#_)
}
sub printIfSaline {
my ($self, $prompt) = #_;
my $name = $self->getName();
my $taste = $self->isSaline() ? "salty" : "sweet";
print "$prompt: Lake $name has $taste water\n";
}
1
######################
# File: Ocean.pm
######################
package Ocean;
use strict;
use parent 'WaterBody';
sub new {
my $class = shift;
$class->SUPER::new(#_);
}
sub printIfSaline {
my ($self, $prompt) = #_;
my $name = $self->getName;
my $taste = $self->SUPER::isSaline() ? "salty" : "sweet";
print "$prompt: $name Ocean has $taste water\n";
}
1
######################
# File: River.pm
######################
package River;
use strict;
use base 'WaterBody';
sub new {
my $class = shift;
$class->SUPER::new(#_);
}
sub printIfSaline {
my ($self, $prompt) = #_;
my $name = $self->getName;
my $taste = $self->isSaline ? "salty" : "sweet";
print "$prompt: $name river has $taste water\n";
}
1
######################
# File: WaterBody.pm
######################
package WaterBody;
sub new {
my $class = shift;
my $self = {};
$self->{name} = shift;
$self->{saline} = shift;
bless $self, $class;
return $self;
}
sub getName {
my ($self) = #_;
$self->{name}
}
sub isSaline {
my ($self) = #_;
$self->{saline}
}
1
The use parent pragma sets up the #ISA at compile time. From parent
Establish an ISA relationship with base classes at compile time
When you use ParentClass; and then manually set up #ISA that happens at run time. In this case code in BEGIN, CHECK, or INIT blocks won't be able to use the inheritance hierarchy without extra work.
The use base pragma is older and parent is recommended in docs. From base
Unless you are using the fields pragma, consider this module discouraged in favor of the lighter-weight parent
Thus I'd say go with use parent.
Manipulating #ISA is the oldest way. base was the second way, and parent is even newer. So, I'd recommend parent for new projects.
use parent 'Foo::Bar';
is cleanest, although the repetitious
use Foo::Bar qw( );
our #ISA = 'Foo::Bar';
is still commonly used. The former also has the advantage of happening sooner (when the file is compiled) than the latter (when the file is executed), though that rarely matters.
base is discouraged because it silences errors that occur when a module is loaded.
I have a base class which calls a method which is overridden in a child class, in Perl. Currently, it still calls the base class version of the method, but I want it to call the base if there is one. Here is a simplified rendition of my code:
package Test;
use strict;
use warnings;
sub Main
{
my $self = shift;
return $self->SomeFunc();
}
sub SomeFunc
{
my $self = shift;
#...
return 1;
}
package Test2;
use strict;
use warnings;
use base qw(Test);
sub SomeFunc
{
my $self = shift;
#...
return 0;
}
package main;
use Test2;
my $test = new Test2();
print $test->Main();
and I am getting a 1 when I run this!
PS my apologies, I'm not used to creating examples in working perl code, please forgive the obvious errors.
The problem would be in your constructor, but you don't have one so your code doesn't even do what you say it does
You have probably written something like
sub new {
bless {};
}
which blesses an empty hash into the current package. Instead you need to take the class name from the first parameter passed to the constructor, like this
You should also avoid using capital letters in your lexical identifiers as they are reserved for global identifiers like package names. If you must use CamelCase then at least makeSureTheFirstLetterIsLowerCase. The standard for both Perl and Python is to use the much_clearer_snake_case
Test.pm
package Test;
use strict;
use warnings;
sub new {
my $class = shift;
bless {}, $class;
}
sub main {
my $self = shift;
$self->some_func();
}
sub some_func {
my $self = shift;
'Test::some_func';
}
Test2.pm
package Test2;
use strict;
use warnings;
use parent 'Test';
sub some_func {
my $self = shift;
'Test2::some_func';
}
main.pl
use strict;
use warnings;
my $test = Test->new;
print $test->main, "\n";
$test = Test2->new;
print $test->main, "\n";
output
Test::some_func
Test2::some_func
new doesn't mean anything in perl unless you make a function with that method name.
You need to bless an object
You can either directly bless an object
my $test = { };
bless $test, "Test2";
or make a new method that does the blessing for you:
sub new{
my $class = shift;
my $test = { };
bless $test, $class;
}
Currently I am making a new module and I was wondering how could I implement in my module 2 things.
We often see the use like:
use My::Module qw(something);
for example:
use CGI::Carp qw(fatalsToBrowser);
So the first question is, how do i
retrieve this, i mean wether the
user has specified anything and what
he specified ?
Second question is, How do i pass and read the args
directly on the constructor like
this:
my $my_module = My::Module->new(arg1,arg2,arg3);
AS requested on the comment the simple module test code:
package My::Module;
# $Id$
use strict;
use Carp;
sub new {
my $class = shift;
my $self = {};
$self->{ARG1} = undef;
$self->{ARG2} = undef;
$self->{ARG3} = undef;
$self->{ARG4} = undef;
bless($self,$class);
return $self;
}
sub arg1 {
my $self = shift;
if (#_) { $self->{ARG1} = shift }
return $self->{ARG1};
}
sub arg2 {
my $self = shift;
if (#_) { $self->{ARG2} = shift }
return $self->{ARG2};
}
sub arg3 {
my $self = shift;
if (#_) { $self->{ARG3} = shift }
return $self->{ARG3};
}
sub arg4 {
my $self = shift;
if (#_) { $self->{ARG4} = shift }
return $self->{ARG4};
}
sub dump {
my $self = shift;
require Data::Dumper;
my $d = Data::Dumper->new([$self], [ref $self]);
$d->Deepcopy(1);
return $d->Dump();
}
1; # so the require or use succeeds
perldoc -f use explains that the use keyword is simply loading a module during compile-time, and then calling ->import on it. The arguments a caller gave to the use statement will be passed to the import method call.
As for your second question: constructors are just methods. Getting their arguments works like it does for any other method or function, using the #_ variable.
import subroutine gets the arguments passed in a use. The following code samples should help you.
File: My/Module.pm
package My::Module;
use warnings;
use strict;
use Data::Dumper;
sub import {
my ( $package, #args ) = #_;
print Dumper \#args;
}
1;
File: module.pl
#!/usr/bin/env perl
use warnings;
use strict;
use My::Module qw(something);
If you are programming an object oriented module, you may try Moose which will save you lots of time.