I have the following packages and files:
Child.pm
package Child;
use Father; # this should automatically extends Father also
has 'name' => (is => 'rw', default => "Harry");
1;
Father.pm
package Father;
use Moose;
sub import {
my ($class, #args) = #_;
my ($caller, $script) = caller;
my $package = __PACKAGE__;
{
no strict 'refs';
#{"${caller}::ISA"} = ($package, #{"${caller}::ISA"});
# tried this also
#eval {"package $caller; use Moose; extends qw($package);1;"}
}
}
1;
test.cgi
#!/usr/bin/perl
use Child;
my $child = Child->new;
print "child name: " . $child->name;
I want the package Child extends package Father automatically.
I put a code in the import function of Father to push to Child module ISA but did not work.
How to make this work, let Father module extends Child module during the import process.
Use the Moose keyword extends rather than use:
package Child;
use Moose;
extends 'Father';
You're only importing the package with use, not inheriting from it. What you are trying to do here is a hack, and while you may be able to get it to work, you're making it harder to understand. Particularly for other people who may have to deal with the code as well.
Looking at some exporting modules, I found Import::Into, it is very useful and solved the problem.
Here is how I solved the problem:
Child.pm
package Child;
use Father; # automatically extends Father also
has 'name' => (is => 'rw', lazy=>1, default => "Harry");
1;
Father.pm
package Father;
use Moose;
use utf8;
use Import::Into;
use Module::Runtime qw(use_module);
our #EXPORT_MODULES = (
Moose => [],
);
sub import {
my ($class, #args) = #_;
my ($caller, $script) = caller;
my $package = __PACKAGE__;
# ignore calling from child import
return if ($class ne $package);
my #modules = #EXPORT_MODULES;
while (#modules) {
my $module = shift #modules;
my $imports = ref($modules[0]) eq 'ARRAY' ? shift #modules : [];
use_module($module)->import::into($caller, #{$imports});
}
{
no strict 'refs';
#{"${caller}::ISA"} = ($package, #{"${caller}::ISA"});
}
}
sub father {
my $self = shift;
return "Potter";
}
1;
test.cgi
#!/usr/bin/perl
use Child;
my $child = Child->new;
print "child name: " . $child->name, "\n";
print "father name: " . $child->father, "\n";
output of test.cgi:
child name: Harry
father name: Potter
Try something like this:
#Father.pm
use Moose;
extends 'Father';
package Father;
...;
1;
__END__
to get rid of all the "extra code".
Related
I am using Perl with Moose, and have to prevent instantiation of an abstract class.
The project is in a quite advanced stage - too late for Moose::Role or MooseX::*.
I am thinking about checking a package name against a class name in BUILDARGS,
and calling die if there's a match.
Is there any problems with this approach?
package Foo::Abstract {
use Moose;
has 'test' => ( isa => 'Int', is => 'rw', default => '0' );
around BUILDARGS => sub {
die if $_[1] eq __PACKAGE__;
$orig = shift;
$class = shift;
$class->$orig( #_ );
};
no Moose;
}
package Foo::Concrete {
use Moose;
extends 'Foo::Abstract';
no Moose;
}
use Test::More;
use Test::Exception;
dies_ok { Foo::Abstract->new() } "cannot instantiate. OK";
my $c;
lives_ok { $c = Foo::Concrete->new() } "instantiated Foo::Concrete. OK";
ok( 0 == $c->test );
done_testing();
As several people have pointed out in comments you probably should be using a Role and making the change in every "subclass" to do composition. However you make a compelling argument for laziness (one change in one place during a refactor).
My suggestion would be "do both". Refactor the existing class you want to be abstract out into a role:
mv lib/Foo/Abstract.pm lib/Foo/Role/Interface.pm;
perl -pie's/\bFoo::Abstract\b/Foo::Role::Interface/g' !$
Then in a new Foo::Abstract simply do:
package Foo::Abstract;
use Moose;
with qw(Foo::Role::Interface);
around BUILDARGS => sub {
$_[1] ne __PACKAGE__ ? shift->(#_) : die __PACKAGE__ . 'is ABSTRACT';
}
1;
This way you can slowly replace the extends qw(Foo::Abstract) over time with the more appropriate with qw(Foo::Role::Interface) but don't have to bite that cost all up front. You can even document that this is the plan in Foo::Abstract so that other developers who come along help with the conversion.
How is it too late to use Roles? Just replace:
use Moose;
with
use Moose::Role;
And in Foo::Concrete, replace
extends 'Foo::Abstract';
with
with 'Foo::Abstract';
I have a class X with a subclass Y. X has a method calculate() that I'd like to override in Y with some additional behaviour, an if statement that, if it fails, call X.calculate(). In Python this would be accomplished with:
class X(object):
def calculate(self, my_arg):
return "Hello!"
class Y(X):
def calculate(self, my_arg):
if type(my_arg) is int and my_arg > 5:
return "Goodbye!"
return super(Y, self).calculate(my_arg)
How can I do this in Perl using the Moo module?
As the docs point out:
No support for super, override, inner, or augment - the author considers augment to be a bad idea, and override can be translated:
around foo => sub {
my ($orig, $self) = (shift, shift);
...
$self->$orig(#_);
...
};
(emphasis mine)
#!/usr/bin/env perl
use strict;
use warnings;
package X;
use Moo;
sub calculate {
return 'Hello!'
}
package Y;
use Moo;
extends 'X';
around calculate => sub {
my $orig = shift;
my $self = shift;
if ( $_[0] > 5 ) {
return $self->$orig(#_);
}
return 'Goodbye!';
};
package main;
my $y = Y->new;
print $y->calculate(3), "\n";
print $y->calculate(11), "\n";
This can be done in Perl via the SUPER:: pseudo-class, which is part of Perl's method resolution system. You just put it in front of the method-call. It does not work for class methods or function calls.
use strict;
use warnings;
use feature 'say';
package Foo;
use Moo;
sub frobnicate {
my $self = shift;
say "foo";
}
package Bar;
use Moo;
extends 'Foo';
sub frobnicate {
my $self = shift;
say "bar";
$self->SUPER::frobnicate;
}
package main;
Bar->new->frobnicate;
You can even use this to call each parent's method if you have multi-level inheritance.
package Grandparent;
sub foo { ... }
package Parent;
use parent 'Grandparent';
sub foo { $_[0]->SUPER::foo }
package Child;
use parent 'Parent';
sub foo { $_[0]->SUPER::foo }
This will subsequently call foo in Child, Parent and Grandparent.
I recently learned about Moose. When I create a new attribute in a subclass, it seems to somehow override other functions that should be working...
use strict; use warnings;
################################### VEHICLE ####################################
package Vehicle;
sub new{
my $classname = shift;
bless { wheels=>'unknown', color=>'unknown', #_ } => $classname
}
sub wheels{
my $vehicle = shift;
return $$vehicle{wheels}
}
sub setWheels{
my $vehicle = shift;
$$vehicle{wheels} = $_[0];
}
##################################### CAR ######################################
package Car;
use Moo; extends 'Vehicle';
sub new{
my $classname = shift;
my $vehicle = vehicle->new( #_ );
$vehicle->setWheels(4);
bless $vehicle => $classname
}
has 'spoiler' => ( is=>'rw', reader=>'rspoil', writer=>'setSpoiler' );
1
The issue is that when I create a Car object, it does not have 4 wheels. It has 'unknown' wheels. If I comment out the "has 'spoiler' => ..." statement at the bottom, it works just fine.
What is causing the issue?
What is the recommended way to do what I am doing?
Firstly, if you're writing a class using Moose, you should never define your own method called new. See Moose best practices.
Secondly, if you're using Moose to extend a non-Moose class, you probably want to use MooseX::NonMoose which is able to make that all work pretty smoothly.
Moo bakes in the extending non-Moo classes. Assuming that for your example you're working with a Vehicle class that isn't yours, but trying to write the child class in Moo, here's how to do it.
In Moo*, you don't declare a new. It handles that for you. You can mutate state by declaring a BUILD subroutine - this will get run after instantiation on the instantiated object from parent to child. Thus:
use strict; use warnings;
################################### VEHICLE ####################################
package Vehicle;
sub new{
my $classname = shift;
bless { wheels=>'unknown', color=>'unknown', #_ } => $classname
}
sub wheels{
my $vehicle = shift;
return $$vehicle{wheels}
}
sub setWheels{
my $vehicle = shift;
$$vehicle{wheels} = $_[0];
}
##################################### CAR ######################################
package Car;
use Moo; extends 'Vehicle';
sub BUILD {
my $self = shift;
if ($self->wheels eq 'unknown') {
$self->setWheels(4);
}
}
has 'spoiler' => ( is=>'rw', reader=>'rspoil', writer=>'setSpoiler' );
package Main;
use strict;
use warnings;
use Data::Printer;
p(Car->new(spoiler => 'big', color => 'bright red'));
my $strangecar = Car->new(spoiler => 'piddly', color => 'yellow', wheels => 3);
p($strangecar);
$strangecar->setWheels(6);
$strangecar->setSpoiler('not so piddly');
p($strangecar);
Output
Car {
Parents Vehicle
public methods (4) : BUILD, new, rspoil, setSpoiler
private methods (0)
internals: {
color "bright red",
spoiler "big",
wheels 4
}
}
Car {
Parents Vehicle
public methods (4) : BUILD, new, rspoil, setSpoiler
private methods (0)
internals: {
color "yellow",
spoiler "piddly",
wheels 3
}
}
Car {
Parents Vehicle
public methods (4) : BUILD, new, rspoil, setSpoiler
private methods (0)
internals: {
color "yellow",
spoiler "not so piddly",
wheels 6
}
}
To use Moo for both parent and child, you would do:
use strict; use warnings;
################################### VEHICLE ####################################
package Vehicle;
use Moo;
has 'wheels' => ( is=>'rw', writer=>'setWheels', default => sub { 'unknown' });
has 'color' => (is => 'rw', default => sub { 'unknown' });
##################################### CAR ######################################
package Car;
use Moo; extends 'Vehicle';
has 'spoiler' => ( is=>'rw', reader=>'rspoil', writer=>'setSpoiler' );
has '+wheels' => ( default => sub {4} );
package Main;
use strict;
use warnings;
use Data::Printer;
p(Car->new(spoiler => 'big', color => 'bright red'));
my $strangecar = Car->new(spoiler => 'piddly', color => 'yellow', wheels => 3);
p($strangecar);
$strangecar->setWheels(6);
$strangecar->setSpoiler('not so piddly');
p($strangecar);
Which yields similar output to the above code.
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 { ... }
I want to define a "registry" hash in the base class that all subclasses can read and write to, how do I accomplish this with Moose/Perl?
Here is an implementation with plain Perl OO-style.
You have two classes, BaseClass with global variable $REGISTRY, and DerivedClass which inherits from BaseClass.
$REGISTRY is readable and writable from any class instance via registry() method.
#!/usr/bin/env perl
use 5.012;
use strict;
package BaseClass;
our $REGISTRY = {};
sub new {
my $class = shift;
my $self = {};
bless $self, $class;
return $self;
}
sub registry {
my $self = shift;
return $REGISTRY;
}
package DerivedClass;
push our #ISA, 'BaseClass';
package main;
my $base = BaseClass->new;
$base->registry->{ alpha } = 1;
my $derived = DerivedClass->new;
$derived->registry->{ beta } = 2;
say $_, ' -> ', $base->registry->{ $_ } foreach keys %{ $base->registry };
If you run this program you get:
alpha -> 1
beta -> 2
If you prefer an all-Moose solution you should try this one:
#!/usr/bin/env perl
use 5.012;
use strict;
package BaseClass;
use Moose;
our $_REGISTRY = {};
has '_REGISTRY' => (
is => 'rw',
isa => 'HashRef',
default => sub { return $_REGISTRY }
);
sub registry {
my $self = shift;
return $self->_REGISTRY;
}
__PACKAGE__->meta->make_immutable;
no Moose;
package DerivedClass;
use Moose;
use base 'BaseClass';
__PACKAGE__->meta->make_immutable;
no Moose;
package main;
my $base = BaseClass->new;
$base->registry->{ alpha } = 1;
my $derived = DerivedClass->new;
$derived->registry->{ beta } = 2;
say $_, ' -> ', $base->registry->{ $_ } foreach keys %{ $base->registry };
It yields the same result of the OO Perl program.
Note how the _REGISTRY attribute is defined. Moose doesn't like refs as default values: default => {} is forbidden, you have to wrap any reference as a return value in an anonymous subroutine.
How about just implement it as a method:
package BaseClass;
my $hash = {};
sub registry { $hash };
Sub-classes just use $self->registry->{$key} to access values and $self->registry->{$key} = $value to set them.
MooseX::ClassAttribute