How do I inherit subroutines in Perl with 'use base'? - perl

How do I apply 'use base' in Perl to inherit subs from some base module?
I'm used to C++ inheritance mechanics, and all the sites I googled for this caused more confusion then help. I want to do something like the following:
#! /usr/bin/perl
#The base class to inherit from
use strict;
use warnings;
package 'TestBase';
#-------------------------------
sub tbSub
{
my ($self, $parm) = #_;
print "\nTestBase: $parm\n";
}
1;
.
#! /usr/bin/perl
#The descendent class
use strict;
use warnings;
use base qw(TestBase);
sub main;
sub mySub;
#-------------------------------
#Entry point...
main();
#---code------------------------
sub main
{
mySub(1);
tbSub(2);
mySub(3);
}
#-------------------------------
sub mySub
{
my $parm = shift;
print "\nTester: $parm\n";
}
Perl complains/cannot find tbSub.

The C++ mechnics aren't much different than the Perl mechanics: To use inheritance, you need two classes: the base class and the inheriting class. But you don't have any descendent class.
You are also lacking a constructor. Unlike C++, Perl will not provide a default constructor for you.
Your base class contains a bad syntax error, so I guess you didn't try the code before posting.
Finally, as tsee already observed, you will have to let Perl know whether you want a function call or a method call.
What you really want would look something like this:
my $foo = TestDescendent->new();
$foo->main();
package TestBase;
sub new {
my $class = shift;
return bless {}, $class;
}
sub tbSub
{
my ($self, $parm) = #_;
print "\nTestBase: $parm\n";
}
package TestDescendent;
use base 'TestBase';
sub main {
my $self = shift;
$self->mySub( 1 );
$self->tbSub( 2 );
$self->mySub( 3 );
}
sub mySub
{
my $self = shift;
my $parm = shift;
print "\nTester: $parm\n";
}
1;

You should have a look at using Moose which is a postmodern object system for Perl5. You will probably find it a lot easier to grasp than using standard Perl OO semantics... especially when coming from another OO language.
Here's a Moose version of your question....
package TestBase;
use Moose;
sub tbSub {
my ($self, $parm) = #_;
print "\nTestBase: $parm\n";
}
package TestDescendent;
use Moose;
extends 'TestBase';
sub main {
my $self = shift;
$self->mySub( 1 );
$self->tbSub( 2 );
$self->mySub( 3 );
}
sub mySub {
my ($self, $parm) = #_;
print "\nTester: $parm\n";
}
package main;
my $foo = TestDescendent->new();
$foo->main
The differences are....
Constructor automatically created for you &
Inheritance defined by "extends" command instead of "use base".
So this example only covers the tip of the Moose iceberg ;-)

As a sidenote, there is little good reason to use base rather than the newer use parent.

It seems to me, you are mixing up two things here: Object-Oriented and Procedural Perl. Perl OO is kind of "different" (as in not mainstream but workable).
Your TestBase.pm module seems to expect to be run as a Perl object (Perl oo-style), but your Perl script wants to access it as "normal" module. Perl doesn't work the way C++ does (as you realised) so you would have to construct your code differently. See Damian Conway's books for explanations (and smarter code than mine below).
Procedural:
#! /usr/bin/perl
#The module to inherit from
package TestBase;
use strict;
use warnings;
use Exporter ();
our #ISA = qw (Exporter);
our #EXPORT = qw (tbSub);
#-------------------------------
sub tbSub
{
my ($parm) = #_;
print "\nTestBase: $parm\n";
}
1;
.
#! /usr/bin/perl
#The descendent class
use strict;
use warnings;
use TestBase;
sub main;
sub mySub;
#-------------------------------
#Entry point...
main();
#---code------------------------
sub main
{
mySub(1);
tbSub(2);
mySub(3);
}
#-------------------------------
sub mySub
{
my $parm = shift;
print "\nTester: $parm\n";
}
Perl OO
#! /usr/bin/perl
#The base class to inherit from
package TestBase;
use strict;
use warnings;
#-------------------------------
sub new { my $s={ };
return bless $s;
}
sub tbSub
{
my ($self,$parm) = #_;
print "\nTestBase: $parm\n";
}
1;
.
#! /usr/bin/perl
#The descendent class
use strict;
use warnings;
use TestBase;
sub main;
sub mySub;
#-------------------------------
#Entry point...
main();
#---code------------------------
sub main
{
my $tb = TestBase->new();
mySub(1);
$tb->tbSub(2);
mySub(3);
}
#-------------------------------
sub mySub
{
my $parm = shift;
print "\nTester: $parm\n";
}

Perl's inheritance inherits methods, not functions. That means you will have to call
main->tbSub(2);
However, what you really want is to inherit the method into a proper class:
package Derived;
use base "TestBase";
package main;
Derived->somemethod("foo");
Calling methods in the current package as functions won't pass in the $self or "this" object nor the class name magically. Internally,
Class->somemethod("foo")
essentially ends up being called as
Class::somemethod("Class", "foo")
internally. Of course, this assumes Class has a subroutine/method named "somemethod". If not, the superclasses of Class will be checked and if those don't have a method "somemethod" either, you'll get a fatal error. (Same logic applies for $obj->method("foo").)

OO syntax uses the -> operator to separate the message and arguments from the receiver of the message. A short illustration below.
You->do_something( #params );
OR
$you->do_something( #params );
package A;
sub do_neat_thing {
my ( $class_or_instance, #args ) = #_;
my $class = ref( $class_or_instance );
if ( $class ) {
say "Instance of '$class' does a neat thing.";
}
else {
say "$class_or_instance does a neat thing.";
}
}
...
package main;
A->do_neat_thing(); # A does a neat thing.
my $a_obj = A->new();
$a_obj->do_neat_thing(); # Instance of 'A' does a neat thing.

Related

Difference between double colon and arrow in perl

If it is duplicate, say so. I Have not found it, only for PHP but for Perl. So If I can write full name of e.g. Class::sub() or $Class::scalar, I can write Class->sub or $Class->scalar(in case I have used or required the Class), what is the main difference in perl?
The problem is:
Class Animal.pm:
#!/usr/bin/perl -w
package Animal;
our $VERSION = '0.01';
sub speak {
my $class = shift;
print "a $class goes ", $class->sound;
}
sub sound{
die "You have to defined sound() in a subclass";
}
Then Class Horse.pm:
#!/usr/bin/perl -w
package Horse;
use Animal;
our #ISA = qw[Animal];
our $VERSION = '0.01';
sub sound { 'neight' }
1
And if I, in main program do this:
#!/usr/bin/perl -w
BEGIN{ unshift #INC, 'dirWithModules' }
use Horse; use Animal;use Cow;
Animal::speak('Horse');
output---->"a Horse goes neight"
BUT IF I OD
#!/usr/bin/perl -w
BEGIN{ unshift #INC, 'dirWithModules' }
use Horse; use Animal;use Cow;
Animal->speak('Horse')
output--->"You have to defined sound() in a subclass at Animal.pm"
So my question is, If I reference my method from class Horse.pm iherited sub speak from Animal.pm with ::, double colon, the NO PROBLEM - it will print the sound. However if I try to reference the sub with -> arrow, The $class is not inherited - that is, $class is Animal.pm itself, but not as parameter sent ('Horse'). So In what is :: and -> different?
Foo->bar() is a method call.
It will use inheritance if necessary.
It will pass the invocant (the left side of ->) as the first argument. As such, bar should be written as follows:
# Class method (Foo->bar)
sub bar {
my ($class, ...) = #_;
}
or
# Object method (my $foo = Foo->new; $foo->bar)
sub bar {
my ($self, ...) = #_;
}
Foo::bar() is a sub call.
It won't use inheritance.

Perl + moose: Can't call method "x" on an undefined value

I'm just trying to do this: http://modernperlbooks.com/mt/2011/08/youre-already-using-dependency-injection.html. Really not deviating too much at all from that example code.
Here's what I've got:
package M;
use Moose;
use Exporter;
use Data::Dumper;
sub new {
print "M::new!\n";
my $class = shift;
return bless {}, $class;
}
sub x {
my ($self, $stuff) = #_;
print Dumper($stuff);
}
#################################
package Foo;
use Moose;
use Exporter;
our #ISA = qw(Exporter);
our #EXPORT = ();
has 'mS', is => 'ro', default => sub { M->new };
sub new {
my $class = shift;
return bless {}, $class;
}
sub bar {
my ($self, $data) = #_;
# do stuff here...
# ...
my $foo = $self->mS;
# this...
$foo->x($data);
# ...causes "Can't call method "x" on an undefined value at Foo.pm line 45."
}
1;
It's worth noting that the M::new! message never appears, so I'm guessing that it's never reached. What's going on?
With Moose, you shouldn't write sub new. Moose provides the constructor for you.
Also, using Exporter makes no sense with object-oriented modules. The following program works for me:
#!/usr/bin/perl
{ package M;
use Moose;
use Data::Dumper;
sub x {
my ($self, $stuff) = #_;
print Dumper($stuff);
}
}
{ package Foo;
use Moose;
has mS => ( is => 'ro', default => sub { 'M'->new } );
sub bar {
my ($self, $data) = #_;
my $foo = $self->mS;
$foo->x($data);
}
}
my $foo = 'Foo'->new;
$foo->bar('test');
You have a solution - don't write your own new() method when you're using Moose. But there's one other little point that might be worth making.
The constructor that Moose will give you for your Foo class will work pretty well as a drop-in replacement for your new() method. But the one that Moose gives you for your M class will be missing a feature - it won't print your "M::new!\n" message. How do we get round that?
In Moose, you can define a BUILD() method which will be called immediately after new() has returned a new object. That's a good place to put any extra initialisation that your new object needs. It would also be be a good place for your print() call (although it happens after object construction, not before - so it's not an exact replacement).

Perl: How to make sure overridden method is called when accessed from within the base class

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;
}

Perl: Best way of making parent subroutine (not method) available to children

I have multiple classes defined in my main program. One is a parent class. The other are children classes:
# Main Program
...
package Foo; #Parent class
....
sub glob2regex {
my $glob = shift;
...here be dragons...
return $regex;
};
....
package Foo::Bar; #Child Class
base qw(Foo);
sub some_method {
my $self = shift;
my $regex = shift;
my $type = shift;
if ( $type eq "glob" ) {
$regex = glob2regex($regex); #ERROR: glob2regex is not defined.
}
...
}
I have a function in my parent class called glob2regex. It isn't really a method because it doesn't do anything with the object. Instead, it's a helper function that my child classes can use.
However, calling it in my child class as shown above won't work because it's not defined in my child class. I could prepend the full parent class name on it (i.e. call it as Foo::glob2regex instead of just glob2regex), or I could modify it into an object, and call it as $self->glob2regex. There maybe a even better way of handling this situation that I'm overlooking.
What is the best way to make a function like this that's defined in the parent class available in the child classes?
--
Test Program
#! /usr/bin/env perl
#
use strict;
use warnings;
use feature qw(say);
use utf8;
########################################################################
# MAIN PROGRAM
my $bar = Foo::Bar->new;
$bar->just_foo_it;
#
########################################################################
########################################################################
#
package Foo;
sub lets_foo_it {
say "I've done foo!";
}
#
########################################################################
########################################################################
#
package Foo::Bar;
use base qw(Foo);
*Foo::Bar::lets_foo_it = *Foo::lets_foo_it;
sub new {
my $class = shift;
my $self = {};
bless $self, $class;
return $self;
}
sub just_foo_it {
my $self = shift;
lets_foo_it();
}
#
########################################################################
Exporting is usually done using Exporter.
BEGIN {
package Foo;
use Exporter qw( import );
our #EXPORT_OK = qw( glob2regex );
sub glob2regex { ... }
...
$INC{'Foo.pm'} = 1;
}
BEGIN {
package Foo::Bar;
use Foo qw( glob2regex );
our #ISA = 'Foo';
... glob2regex(...) ...
$INC{'Foo/Bar.pm'} = 1;
}
Note that it's very unusual for a class module to export subroutines. You should consider it a red flag indicating a likely design flaw.
Seems like a bit of your problem is: "How do I use within a file?". I have a pragma I use in early development for this type of thing, but it breaks down to:
package Foo;
BEGIN { $INC{ __PACKAGE__ . '.pm'} = __FILE__ . ':' . ( __LINE__ - 1 ); }
Once it's in the %INC table, you're usually fine just using it.
Remember that a use is a require combined with an import at compile time. Once you've defined the Foo import, you can create an import function to take care of that part of use.
sub import {
my $caller = caller;
return unless $caller->isa( __PACKAGE__ );
{ no strict 'refs';
*{"$caller\::glob2regex"} = *glob2regex{CODE};
}
}
As I wrote above, I use this type of thing in early development--basically, when I want a sort of "scratchpad" with object relationships. In maintainable code, my preference would be to call Foo::glob2regex(...), or as I have at times insert it into a util package and export it from there:
package Foo::Util;
use strict;
use warnings;
use parent 'Exporter';
our #EXPORT_OK = qw<glob2regex>;
sub glob2regex { ... }

How do I create an in-memory class and then include it in Perl?

So I am toying with some black magic in Perl (eventually we all do :-) and I am a little confused as to exactly how I am supposed to be doing all of this. Here is what I'm starting with:
use strict;
use warnings;
use feature ':5.10';
my $classname = 'Frew';
my $foo = bless({ foo => 'bar' }, $classname);
no strict;
*{"$classname\::INC"} = sub {
use strict;
my $data = qq[
package $classname
warn 'test';
sub foo {
print "test?";
}
];
open my $fh, '<', \$data;
return $fh;
};
use strict;
unshift #INC, $foo;
require $foo;
use Data::Dumper;
warn Dumper(\#INC);
$classname->foo;
I get the following errors (depending on whether my require line is commented out):
With require:
Recursive call to Perl_load_module in PerlIO_find_layer at crazy.pl line 16.
BEGIN failed--compilation aborted.
without:
$VAR1 = [
bless( {
'foo' => 'bar'
}, 'Frew' ),
'C:/usr/site/lib',
'C:/usr/lib',
'.'
];
Can't locate object method "foo" via package "Frew" at crazy.pl line 24.
Any wizards who know some of this black magic already: please answer! I'd love to learn more of this arcana :-)
Also note: I know that I can do this kind of stuff with Moose and other lighter helper modules, I am mostly trying to learn, so recommendations to use such-and-such a module will not get my votes :-)
Update: Ok, I guess I wasn't quite clear originally with my question. I basically want to generate a Perl class with a string (that I will manipulate and do interpolation into) based on an external data structure. I imagine that going from what I have here (once it works) to that shouldn't be too hard.
Here is a version which works:
#!/usr/bin/perl
use strict;
use warnings;
my $class = 'Frew';
{
no strict 'refs';
*{ "${class}::INC" } = sub {
my ($self, $req) = #_;
return unless $req eq $class;
my $data = qq{
package $class;
sub foo { print "test!\n" };
1;
};
open my $fh, '<', \$data;
return $fh;
};
}
my $foo = bless { }, $class;
unshift #INC, $foo;
require $class;
$class->foo;
The #INC hook gets the name of the file (or string passed to require) as the second argument, and it gets called every time there is a require or use. So you have to check to make sure we're trying to load $classname and ignore all other cases, in which case perl continues down along #INC. Alternatively, you can put the hook at the end of #INC. This was the cause of your recursion errors.
ETA: IMHO, a much better way to achieve this would be to simply build the symbol table dynamically, rather than generating code as a string. For example:
no strict 'refs';
*{ "${class}::foo" } = sub { print "test!\n" };
*{ "${class}::new" } = sub { return bless { }, $class };
my $foo = $class->new;
$foo->foo;
No use or require is necessary, nor messing with evil #INC hooks.
I do this:
use MooseX::Declare;
my $class = class {
has 'foo' => (is => 'ro', isa => 'Str', required => 1);
method bar() {
say "Hello, world; foo is ", $self->foo;
}
};
Then you can use $class like any other metaclass:
my $instance = $class->name->new( foo => 'foo bar' );
$instance->foo; # foo-bar
$instance->bar; # Hello, world; foo is foo-bar
etc.
If you want to dynamically generate classes at runtime, you need to create the proper metaclass, instantiate it, and then use the metaclass instance to generate instances. Basic OO. Class::MOP handles all the details for you:
my $class = Class::MOP::Class->create_anon_class;
$class->add_method( foo => sub { say "Hello from foo" } );
my $instance = $class->new_object;
...
If you want to do it yourself so that you can waste your time debugging something, perhaps try:
sub generate_class_name {
state $i = 0;
return '__ANON__::'. $i++;
}
my $classname = generate_class_name();
eval qq{
package $classname;
sub new { my \$class = shift; bless {} => \$class }
...
};
my $instance = $classname->new;
For a simple example of how to do this, read the source of Class::Struct.
However, if I needed the ability to dynamically build classes for some production code, I'd look at MooseX::Declare, as suggested by jrockway.
A Perl class is little more than a data structure (usually a hashref)
that has been blessed into a package in which one or more class
methods are defined.
It is certainly possible to define multiple package namespaces in one
file; I don't see why this wouldn't be possible in an eval construct
that is compiled at run-time (see perlfunc for the two different
eval forms).
#!/usr/bin/perl
use 5.010;
use strict;
use warnings;
use Data::Dumper;
eval q[
package Foo;
sub new {
my ( $class, %args ) = #_;
my $self = bless { %args }, $class;
return $self;
}
1;
];
die $# if $#;
my $foo = Foo->new(bar => 1, baz => 2) or die;
say Dumper $foo;