Trying to understand Moose:
use Modern::Perl;
package FOO {
use Moose;
sub rep { say " <report></report>"; }
sub doc {
say "<document>";
inner();
say "</document>";
}
}
package BAR {
use Moose;
extends 'FOO';
around 'rep' => sub {
my $orig = shift;
my $self = shift;
say "<document>";
$self->$orig(#_);
say "</document>";
};
augment 'doc' => sub {
say " <report></report>";
};
}
package main {
BAR->new->rep;
say "===";
BAR->new->doc;
}
Produces...
<document>
<report></report>
</document>
===
<document>
<report></report>
</document>
... the same result. When desinging the "model (object hierarchy)" - based on what I should decide when to use around and when augment?
Here are probably other (deeper) things what i currently didn't understand yet.
Can please someone provide an "more deep" explanation, because reading tru the Moose/Manual/MethodModifiers obviously not helped enough...
augment and around do rather different things. augment is designed to make this sort of pattern easier:
package Document {
use Moose;
sub make_document {
my $self = shift;
return "<doc>" . $self->_document_innards . "</doc>"
}
# stub; override in child class
sub _document_innards {
my $self = shift;
return "";
}
}
package Invoice {
use Moose;
extends 'Document';
sub _document_innards {
my $self = shift;
return "Give me money!";
}
}
With augment it becomes:
package Document {
use Moose;
sub make_document {
my $self = shift;
return "<doc>" . inner() . "</doc>"
}
}
package Invoice {
use Moose;
extends 'Document';
augment make_document => sub {
my $self = shift;
return "Give me money!";
};
}
On the other hand, around is used as a replacement for doing $self->SUPER::method(#args) because SUPER can't work in roles (the notion of which package to check superclasses for is bound at compile-time, so $self->SUPER::method(#args) would check superclasses of the role (i.e. none) instead of superclasses of the class that consumed the role. If you're not using roles, then SUPER can still be used in Moose classes just fine. TLDR: SUPER is broken by roles, so Moose gives you around as an alternative.
Another thing to compare is override which is a bit like around, but gives you this super() function which is perhaps slightly cleaner than $self->$orig(#_). It also has an "there can be only one" feature. If two roles try to provide an around modifier for the same method, that's fine: they both get to wrap the method (though the order in which they are applied is undefined). If two roles try to provide an override modifier, that's an error.
The implementation of augment is somewhat fragile in my experience, so that in my book is a reason to avoid it. Don't try to replace it with around, because they do rather different things. Instead, replace it with the pattern used in my first example above.
Using around should always be your first instinct. As (Moose creator) Stevan Little says about augment:
Thankfully, only a small percentage of people actually grok this
feature and of those people only a handful of them are crazy enough to
try and use it.
Related
Basic Architecture
I built a information retrieval tool in perl, using Moose as framework.
I have a class hiearchy for plugins with Base as a common base class for plugins, from which access method specific plugins inherit (methods being HTTP, FTP, IMAP, ...).
From these child classes, the actual worker classes inherit (one plugin per data source).
I use Moose roles to compose source specific behaviour into the actual worker classes (like enabling support for SSL client certificates in HTTP sources).
Problem
One of the method specific classes (Base::A) requires a role R. The same role R is also used by role S, which then is used by a work class X, inheriting from Base::A.
My problem is that the method modifiers in R are applied twice to X. Is there a way to prevent Moose from applying method modifiers to class that are already applied to one of the parent classes?
Example
#!/usr/bin/env perl
use strict;
use warnings;
use utf8;
use v5.14;
{
package R;
use Moose::Role;
before 'bar' => sub { say "R::before'bar'()" }
}
{
package S;
use Moose::Role;
with 'R';
before 'bar' => sub { say "S::before'bar'()" }
}
{
package Base;
use Moose;
sub foo { say "Hello foo()"; }
}
{
package Base::A;
use Moose;
extends 'Base';
with 'R';
sub bar { $_[0]->foo(); say "Hello bar()"; }
}
{
package X;
use Moose;
extends 'Base::A';
with 'S';
}
package main;
my $a = X->new();
$a->bar();
Actual Output
S::before'bar'()
R::before'bar'()
R::before'bar'()
Hello bar()
Expected Output
The line R::before'bar'() should appear only once.
First of all, your example can be much simpler:
{
package R;
use Moose::Role;
before 'bar' => sub { say "R::before'bar'()" }
}
{
package Base;
use Moose;
with 'R';
sub foo { say "Hello foo()"; }
sub bar { $_[0]->foo(); say "Hello bar()"; }
}
{
package X;
use Moose;
extends 'Base';
with 'R';
}
package main;
X->new()->bar();
The output is:
R::before'bar'()
R::before'bar'()
Hello foo()
Hello bar()
Why
I agree that this is kinda unexpected, but it all makes sense if you think about it. Roles are not base classes, roles are not interfaces with implementation (see Java), roles are not even “mixins” in a Python sense of this word (in Python we actually do inherit from mixins, but this is just language limitations). Roles are just bunches of features (attributes, methods, modifiers etc) you apply to your class. This is one-time action. The class that has a role doesn't “remember” it, it's just being applied as the class is created. You don't inherit from roles, so you shouldn't expect Moose to implement some diamond to merge multiple applyings of the same role.
On the other hand, if you try to do with qw(R S); then R is surprisingly (or maybe not really) is applied only once.
What to do
Now to the actual question. Since you want your "befores" to override each other, you can just forgo using before at all and refactor it to a simple method (like you do in any other languages that don't support such modifiers):
sub bar {
my ($self) = #_;
$self->_before_bar_hook();
# ...
}
sub _before_bar_hook {}
Conclusion
Both before/after modifiers and roles are pretty advanced Moose features, and I'm not really surprised of some bizarre side effect (such that you've discovered). And though I believe my explanation is mostly correct I would not recommend to use something that requires such explanations.
Me personally avoid using before/after modifiers at all, since I prefer an explicit call of the hooks (as shown above).
You can use a parameterized role to prevent wrapping a sub:
#! /usr/bin/perl
use warnings;
use strict;
use feature qw{ say };
{ package R;
use MooseX::Role::Parameterized;
parameter should_wrap_bar => (
isa => 'Bool',
default => 1,
);
role {
my ($param) = #_;
before 'bar' => sub { say "R::before'bar'()" }
if $param->{should_wrap_bar};
};
}
{ package Base;
use Moose;
with 'R';
sub foo { say "Hello foo()"; }
sub bar { $_[0]->foo(); say "Hello bar()"; }
}
{ package X;
use Moose;
extends 'Base';
with R => { should_wrap_bar => 0 };
}
package main;
X->new->bar;
There seem to be a number of ways to do polymorphism in Perl but they all feel "hacky" to me. I'm somewhat new to Perl so I could just be interpreting it wrong but I find most examples make your code too illegible and are controversial.
Say you have a widget class that contains some data and methods that all widgets need. There are also a handful of widget types (i.e. calender, schedule, etc). And they need to communicate with each other (via a parent container class).
Would playing with the namespace and making widget a prototype be worth it?
Should I give each widget a reference to an object (one of the types) at instantiation?
Just forget about types being objects and make widget a large class where only a few methods get used per instance based on what type is set.
Something else?
I come from a C/C++ background and I'm finding it difficult to decide on a Perl programming model.
Also, I'm don't have strong type safety or private member requirements. The project is a mid sized web app with a couple developers and portability to other projects isn't a priority. Easy extensibilty without needing to decipher Perl hacks would be useful though.
The "Modern Perl" approach is probably to define Widget as a role. A role can be thought of as similar to a mixin, an interface, or an abstract base class. Do this with Moose::Role or one of its more light-weight alternatives (Moo::Role, Role::Tiny).
{
package Widget;
use Moo::Role;
sub some_common_method {
my $self = shift;
...;
}
sub another_common_method {
my $self = shift;
...;
}
# Here we're indicating that all Widgets must
# have a method called yet_another_common_method,
# but we're not defining how that method should
# be implemented.
requires "yet_another_common_method";
}
Now you can create a class that composes that role:
{
package Calendar;
use Moo;
with "Widget";
# Here's a member variable.
has year => (is => "ro", required => 1);
# Widget requires us to implement this.
sub yet_another_common_method {
my $self = shift;
...;
}
# We can override Widget's implementation
# of this method.
sub some_common_method {
my $self = shift;
...;
}
# We can install hooks ("method modifiers")
# to Widget's methods.
before another_common_method => sub {
my $self = shift;
print STDERR "Calendar ", $self->year, ": another_common_method() was called.\n";
};
}
And another:
{
package Schedule;
use Moo;
with "Widget", "Editable";
sub yet_another_common_method {
my $self = shift;
...;
}
}
And use the classes:
my $calendar = Calendar->new( year => 2014 );
my $schedule = Schedule->new;
my #widgets = ($calendar, $schedule);
for (#widgets) {
$_->some_common_method if $_->does('Widget');
}
package a::b::c:d
my $res = a::b::c:e->new(); # i am doing like this
# is there any othere to do this
sub new {
...
my $self = {
#result = a::b::c:e->new();
}
}
sub test {
}
sub test2 {
}
1;
package a::b::c:e
sub new {
...
}
sub testresult {
}
1;
My question is:
how to initalize the e module in d in new itself rather creating every function and
how to use that to store some results into e:testresult
There are two strategies -- either examine the symbol table to initialize on creation, or make use of AUTOLOAD and test with can. AUTOLOAD can be messier as you have to deal with the case where the method isn't there:
sub AUTOLOAD {
my $self = shift;
my $method = $AUTOLOAD;
$method =~ s/.*://; # strip package name
if ( $self->{'result'}->can($method) ) {
return $self->{'result'}->$method(#_);
} else {
croak "Unknown method : $method";
}
}
But the symbol table trick is brittle, as if they're using inheritance, you won't see the inherited methods without walking up #ISA, too. (and even if they're not -- they might start using inheritance in the future, which results in things breaking)
...
Typically, when you're trying to copy another module's interface, you've got a case of inheritance, so you might want to ask yourself what the relationship is between ::d and ::e :
a::b::c::d is an a::b::c::e
a::b::c::d uses a::b::c::e
If it's an is-a relationship, it's typically better suited to inheritance (although you might have wrappers around each of the methods, and still need to go through this whole exercise anyway). If it's a uses relationship, odds are you don't want to inherit from every last method they have, and can just hard code a list (although, the list might change if the used class is updated)
foreach my $method ( #list_of_methods_to_copy ) {
*{$method} = sub {
my $self = shift;
return $self->{'results'}->$method(#_);
}
}
Provided that you're not looking for inheritance between the two classes, it looks to me that you might want to use Class::Delegator for composing your class. That way, you can create the delegation routines by putting the following in a::b::c::d.
use Class::Delegator send => 'testresult', to => '{result}';
But you'd need to fix your constructor anyway:
my $self
= bless {
result => a::b::c::e->new()
}, $class_name
;
return $self;
Having done that, you'd have a field '{result}' to delegate to.
I have a subclass that calls a method from a superclass. The method in the superclass uses a method that is defined in the superclass as abstract (not really abstract) but implemented in the subclass.
For example:
package BaseClass;
sub new
{
}
sub method1 {
return someAbstractMethod();
}
sub someAbtsractMethod
{
die "oops, this is an abstract method that should " .
"be implemented in a subclass" ;
}
1;
package SubClass;
sub new
{
}
sub someAbtsractMethod
{
print "now we implement the asbtract method";
}
1;
Now when I do:
$sub = new SubClass();
$sub->method1();
...it calls the abstract message and I get the specified error message. If I took off the abstract method from the super class and just leave the implementation in the subclass, It does not recognize the method and I get subroutine abstract method not found error.
You haven't set up an IS_A relationship between the parent and child classes.
You can do this with the base pragma as Ivan suggests, or you can manipulate the #ISA array. Or you can use the parent pragma.
#ISA:
package SubClass;
our #ISA = qw( BaseClass );
parent:
package SubClass;
use parent qw( BaseClass );
By the way, don't use the indirect object syntax ever. To call your constructor do:
my $foo = SubClass->new();
Also, it looks like you aren't using the strict and warnings pragmas. Do so. Always.
Finally, if you have multiple packages in one file, it is helpful to enclose each package in a block.
Check out perlboot and perltoot, they are handy OOP tutorials in the perldoc.
Update:
I just noticed that your method calls are broken. You need to find the invoking class or instance in each method.
package BaseClass;
sub new { bless {}, shift; } # horrible constructor - do not reuse.
sub abstract { die "The present situation is abstract"; }
sub method { my $self = shift; $self->abstract; }
package SubClass;
our #ISA = qw( BaseClass );
sub abstract { print "It's alive\n" );
In the script:
my $obj = SubClass->new;
$obj->method;
my $base = BaseClass->new;
$base->method;
Definitely read the tutorials I linked to. They will help you.
There are some problems with your code, you need to tell the subclass what its parent class is. You also probably need to setup your constructors to pass through to the parent class. There were also a few misspellings in there.
package BaseClass;
sub new {
bless {} => shift;
}
sub method1 {
my $self = shift;
return $self->someAbstractMethod();
}
sub someAbstractMethod
{
die "oops, this is an abstract method that should " .
"be implemented in a subclass";
}
package SubClass;
use base 'BaseClass';
sub new {
shift->SUPER::new
}
sub someAbstractMethod
{
print "now we implement the asbtract method\n";
}
package main;
my $obj = BaseClass->new;
eval {$obj->method1(); 1} or warn $#;
my $subobj = SubClass->new;
$subobj->method1();
Your fundamental problem is that you're not using method calls at all. Had you done
sub method1 {
my $self = shift;
$self->someAbstractMethod();
}
in the base class (and assuming inheritance was set up properly) then things would work. But when you write someAbstractMethod() that's not a method call, it's a function call, so it's resolved immediately at compile-time, without any regard for polymorphism (what the type of the object is).
If you are just starting out with Perl OO dont forget to check out Moose. See also Moose::Manual::Unsweetened for a comparison of Moose with regular Perl 5 OOP style.
Is it possible to replace a method of a Moose object at runtime ?
By looking at the source code of Class::MOP::Method (which Moose::Meta::Method inherits from) I concluded that by doing
$method->{body} = sub{ my stuff }
I would be able to replace at runtime a method of an object.
I can get the method using
$object->meta->find_method_by_name(<method_name>);
However, this didn't quite work out.
Is it conceivable to modify methods at run time? And, what is the way to do it with Moose?
Moose or not, that does not sound like a good idea.
Instead, design your object to have an accessor for the method. For example, users of your class can use My::Frobnicator->frobnicator->() to get and invoke the frobnicator method and use My::Frobnicator->frobnicator(sub { } ) to set it.
Sinan's idea is a great start.
But with an little extra tweak, you can make using your method accessor just like using a normal method.
#!/usr/bin/perl
use strict;
use warnings;
use Carp;
my $f = Frob->new;
$f->frob(
sub {
my $self = shift;
print "$self was frobbed\n";
print Carp::longmess('frob')
}
);
print "\nCall frob as normal sub\n";
$f->frobit;
print "\nGoto frob\n";
$f->goto_frob;
BEGIN {
package Frob;
use Moose;
has 'frob' => (
is => 'rw',
isa => 'CodeRef',
);
sub frobit {
&{$_[0]->frob};
}
sub goto_frob {
goto $_[0]->frob;
}
}
The two methods in Frob are very similar.
frobit passes all arguments, including the invocant to the code ref.
goto_frob passes all arguments, including the invocant to the code ref, and replaces goto_frob's stack frame with the code refs.
Which to use depends on what you want in the stack.
Regarding munging the body storage of a Class::MOP::Method object, like so $method->{body} = sub { 'foo' }:
It's never a good idea to violate encapsulation when you are doing OOP. Especially not when you are working with complex object systems like Moose and Class::MOP. It's asking for trouble. Sometimes, there is no other way to get what you want, but even then, violating encapsulation is still a bad idea.
Using the previously mentioned MooseX::SingletonMethod you can replace an objects method.
For example:
{
package Foo;
use MooseX::SingletonMethod;
sub foo { say 'bar' };
}
my $bar = Foo->new;
my $baz = Foo->new;
# replace foo method just in $baz object
$baz->add_singleton_method( foo => sub { say 'baz' } );
$bar->foo; # => bar
$baz->foo; # => baz
Also see this SO answer to What should I do with an object that should no longer be used in Perl?, which shows how this can be achieved using Moose roles.
/I3az/