I am working on a MooX module that needs to add a wrapper around the constructor.
I've tried method modifies or having the import method directly change *{"${target}::new"} with no effect.
So how can I do this?
Apparently, around does work:
package MyRole;
use Moo::Role
around new => sub { ... };
but the role that has the around needs to be consumed after attributes are added, e.g.
package MyClass;
use Moo;
has attr1 => (... );
with 'MyRole';
Related
In my class hierarchy, I need a common attribute where each subclass needs to provide a different value that is constant for all objects of that class. (This attribute serves as a key to an existing hierarchy that I'm mirroring -- not the best OO design, but I need to preserve this link.)
One way to implement this is with attributes, like this:
package TypeBase;
use Moose::Role;
has type => (
is => 'ro',
isa => enum([qw(A B)]),
builder => '_type',
init_arg => nil,
required => 1,
);
1;
#####
package TypeA;
use Moose;
with 'TypeBase';
sub _type { 'A' };
1;
#####
package TypeB;
use Moose;
with 'TypeBase';
sub _type { 'B' };
1;
Is there a better way to do this? I could just have requires 'type' in the base class, which each concrete class would have to provide, except that this loses me the type constraint that I had with the attribute route.
My solution is equivalent to yours in terms of the external interface. The main difference is the use of constant to better reflect what you are doing. (Note that TYPE can still be called like a method.) Because if is using requires it should also give you a compile-time rather than runtime error if you haven't implemented TYPE in one of your classes.
package TypeBase;
use Moose::Role;
requires 'TYPE';
package TypeA;
use Moose;
with 'TypeBase';
use constant TYPE => 'A';
package TypeB;
use Moose;
with 'TypeBase';
use constant TYPE => 'B';
This question is about the SUPER class.
When would an "overridden method" happens?
So say when I instantiate a class:
$object = Classname -> new (some => 'values');
Is that what you call an overridden method? the new method's overridden values?
If so then, why would I want to use that SUPER class?
I can just say:
$object = Classname -> new ();
I have the original method again. Can someone clarify this for me?
Inheritance describes a parent-child relationship. Everything the parents can do, the child class can too. E.g.
ParentA ParentB
======= =======
foo() foo()
------- bar()
| -------
| /
Child
=====
This UML diagram shows that Child inherits from ParentA and ParentB, e.g. via the code
package Child;
use parent "ParentA";
use parent "ParentB"
Now, Child has inherited the method foo from ParentA and bar from ParentB.
If Child defines a foo method itself, Child->foo would call this method, and not one of the methods of the parent classes. It is then said that the foo method is overridden.
Example
When subclassing, it is often useful to re-use the constructor of the parent. But sometimes, additional processing has to be done. In this case, a subclass wants to provide a different default argument:
Horse.pm
package Horse;
use strict; use warnings;
sub new {
my ($class, %args) = #_;
return bless {
legs => 4,
saddled => 0,
%args,
} => $class;
}
1;
SaddledHorse.pm
package SaddledHorse;
use strict; use warnings;
use parent 'Horse';
# This override the inherited “new”
sub new {
my ($class, %args) = #_;
# the “SUPER” pseudo-package points to the parent
return $class->SUPER::new(%args, saddled => 1);
}
1;
Note how the $class is propagated to bless the reference into the correct class. The SUPER package is only available inside a package that defines an inheritance relationship, and is arguably broken. If you need SUPER, you usually want to use Moose, where a method that is explicitly said to override can call the super method with the super function.
Edit: A note on fully qualifed method names
If you call a method on a package/object, the correct method is resolved at runtime. If you look at the top of this answer to the inheritance diagram, you can see that ParentB defines bar. If we invoke the bar method on a Child, that method is looked for
in Child,
in ParentA, and
in ParentB, where it is found.
This is called “method resolution”, and is a tricky issue in itself.
If we pass a fully qualifed subroutine name as the method, no resolving happens, and the sub is called directly. E.g. Child->foo would resolve the method to ParentA::foo, so that call would be roughly equal to ParentA::foo("Child"). If hower we do
Child->ParentB::foo();
we get the effect of ParentB::foo("Child"). The syntax with the -> is superfluous, but reminds us that we are kind of using a method on an object. Therefore, I preferred to write
$class->SUPER::new(%args, saddled => 1)
in the SaddledHorse example, even if this is only elaborate syntax for
# SUPER::new($class, %args, saddled => 1) # pseudocode, won't actually run
which resolves to
Horse::new($class, %args, saddled => 1)
Do you have more context? It's probably referring to a method overridden in a subclass.
e.g.
use feature 'say';
package A;
sub foo {
say "A";
}
package B;
use base 'A';
# this is overriding 'foo' in A.
sub foo {
my $class = shift;
$class->SUPER::foo(); # calls A->foo(), but this is optional
say "B";
}
B->foo(); # prints "A" then "B"
The calling of SUPER::foo is optional - the method can just override foo and replace it's behaviour or augment it, either by doing work before SUPER::foo or after.
More modern OO perl, (e.g. using Moose, Moo, etc) makes this more readable - with calls to features such as 'override', 'before', 'after', 'around' etc to alter inherited methods
I have a Moose BaseDBModel which has different subclasses mapping to my tables in the database. All the methods in the subclasses are like "get_xxx" or "update_xxx" which refers to the different DB operations.
Now i want to implement a cache system for all these methods, so my idea is "before" all methods named like "get_xxx", I will search the name of the method as key in my memcache pool for value. If i found the value, then I will return the value directly instead of method.
ideally, my code is like this
BaseDBModel
package Speed::Module::BaseDBModel;
use Moose;
sub BUILD {
my $self = shift;
for my $method ($self->meta->get_method_list()){
if($method =~ /^get_/){
$self->meta->add_before_method_modifier($method,sub {
warn $method;
find_value_by_method_name($method);
[return_value_if_found_value]
});
}
}
}
SubClasses Example 1
package Speed::Module::Character;
use Moose;
extends 'Speed::Module::BaseDBModel';
method get_character_by_id {
xxxx
}
Now my problem is that when my program is running, it's repeatedly modify the methods, for example:
restart apache
visit the page which will call get_character_by_id, so I can see one warning message
Codes:
my $db_character = Speed::Module::Character->new(glr => $self->glr);
$character_state = $db_character->get_character_by_id($cid);
Warnings:
get_character_by_id at /Users/dyk/Sites/speed/lib/Speed/Module/BaseDBModel.pm line 60.
but if I refresh the page, I saw 2 warning messages
Warnings:
get_character_by_id at /Users/dyk/Sites/speed/lib/Speed/Module/BaseDBModel.pm line 60.
get_character_by_id at /Users/dyk/Sites/speed/lib/Speed/Module/BaseDBModel.pm line 60.
I am using mod_perl 2.0 with apache, every time i refresh the page, my get_character_by_id method will be modified which I don't want
Isn't your BUILD doing the add_before every time you construct a new instance? I'm not sure that's what you want.
Well, the simple/clunky way would be to set some package-level flag so you only do it once.
Otherwise, I think you want to hook into Moose's own attribute building. Have a look at this: http://www.perlmonks.org/?node_id=948231
The problem is BUILD runs every time your create an object (i.e. after every ->new() call), but add_before_method_modifier adds modifier to class, i.e. to all objects.
Simple solution
Mind, that use calls import function from used package every time. That is the place where you want to add modifiers.
Parent:
package Parent;
use Moose;
sub import {
my ($class) = #_;
foreach my $method ($class->meta->get_method_list) {
if ($method =~ /^get_/) {
$class->meta->add_before_method_modifier($method, sub {
warn $method
});
}
}
}
1;
Child1:
package Child1;
use Moose;
extends 'Parent';
sub get_a { 'a' }
1;
Child2:
package Child2;
use Moose;
extends 'Parent';
sub get_b { 'b' }
1;
So now it works as expected:
$ perl -e 'use Child1; use Child2; Child1->new->get_a; Child2->new->get_b; Child1->new->get_a;'
get_a at Parent.pm line 11.
get_b at Parent.pm line 11.
get_a at Parent.pm line 11.
Cleaner solution
Since you can't be 100% sure import will be called (since you can't be sure use will be used) the more cleaner and straightforward solution is just add something like use My::Getter::Cacher in every derived class.
package My::Getter::Cacher;
sub import {
my $class = [caller]->[0];
# ...
}
In this case every derived class should contain both extends 'Parent' and use My::Getter::Cacher since the first line is about inheritance while the second is about adding before modifier. You may count it a bit redundant, but as I said I believe it's more cleaner and straightforward.
P. S.
Maybe you should give a glance at Memoize module.
I'm trying to inherit and extend a base class with a more specific child class that removes the required attribute from an accessor and specifies a lazily built default. However, when doing so, the derived class no longer wraps the around subroutine around calls to the accessor.
What am I doing wrong in my definition?
Edit: I should state that I can simply inherit the accessor without modifying it and the around modifier still works, and I'm aware I can do something like set the accessor to have a getter, then define a getter method with the name of the accessor (i.e. sub attr { my $self = shift; my $value = $self->_get_attr; return "The value of attr is '$value'"; }). I'm simply surprised the around modifier gets dumped so easily.
use strict;
use warnings;
use 5.010;
package My::Base;
use Moose;
has 'attr' => (is => 'ro', isa => 'Str', required => 1);
around 'attr' => sub {
my $orig = shift;
my $self = shift;
my $response = $self->$orig(#_);
return "The value of attr is '$response'"
};
package My::Derived;
use Moose;
extends 'My::Base';
has '+attr' => (required => 0, lazy_build => 1);
sub _build_attr {
return "default value";
}
package main;
my $base = My::Base->new(attr => 'constructor value');
say $base->attr; # "The value of attr is 'constructor value'"
my $derived = My::Derived->new();
say $derived->attr; # "default value"
Per a response from stvn for the same question on perlmonks, the issue is:
Actually, it is not removing the 'around' modifier, you are simply
creating a new accessor in your derived class, which itself is not
around-ed. Allow me to explain ...
When you create an attribute, Moose compiles the accessor methods for
you and installs them in the package in which they are defined. These
accessor methods are nothing magical (in fact, nothing in Moose is
very magical, complex yes, but magical no), and so they are inherited
by subclasses just as any other method would be.
When you "around" a method (as you are doing here) Moose will extract
the sub from the package, wrap it and replace the original with the
wrapped version. This all happens in the local package only, the
method modifiers do not know (or care) anything about inheritance.
When you change an attributes definition using the +attr form, Moose
looks up the attribute meta-object in the superclass list and then
clones that attribute meta-object, applying the changes you requested
and then installs that attributes into the local class. The result is
that all accessor methods are re-compiled into the local class,
therefore overriding the ones defined in the superclass.
It doesn't go the other way around, where the accessor is built from the bottommost class in the ISA, then the around modifiers up the ISA stack are applied in turn.
I've made a "bundle" module which does a bunch of things: imports Moose, imports true, namespace::autoclean, makes the caller's class immutable (taken from MooseX::AutoImmute). The one thing I haven't been able to figure out is how to include MooseX::Method::Signatures.
Here's what I've got so far:
package My::OO;
use Moose::Exporter;
use Hook::AfterRuntime;
use Moose ();
use true ();
use namespace::autoclean ();
my ($import, $unimport, $init_meta) = Moose::Exporter->build_import_methods(
also => ['Moose'],
);
sub import {
true->import();
my $caller = scalar caller;
after_runtime { $caller->meta->make_immutable };
namespace::autoclean->import(-cleanee => $caller);
goto &$import;
}
sub unimport {
goto &$unimport;
}
1;
The idea is that in my code, I can now do things like this:
package My::Class; {
use My::OO;
extends 'My::Parent';
method foo() { ... }
}
but right now I still have to include an extra use MooseX::Method::Signatures;. How can I include that into my OO module?
First off, please note that the implementation of Hook::AfterRuntime is quite fragile. While it works for many simple things, it's extremely easy to end up with very hard to debug errors. I'd recommend just writing the ->meta->make_immutable yourself, or using other approaches to get around writing it, like MooseX::Declare, for example.
To answer your actual question:
MooseX::Method::Signatures->setup_for($your_caller);