Composing Roles into a Moose class not working - perl

Aloha!
I have a role that I'm busy defining in a Moose class called Authable that is essentially composed into any class that might potentially require some form of authentication in the future; it's a rather simple role, here's the entirety:
package Trello::API::Roles::Authable;
use Moose::Role;
#authentication information
has key => (
is => "rw",
isa => "Str",
);
has token => (
is => "rw",
isa => "Str",
);
1;
For whatever reason, when I attempt to compose it into a class using multiple different statements, i.e.,
with "Trello::API::Roles::Authable";
or
with "Roles::Authable";
I consistently get this same error message: You can only consume roles, Roles::Authable is not a Moose role.
Any idea why this might be happening?
Edit!
Just a side note, I checked the actual source for Moose::Role, and saw this bit:
unless ($meta && $meta->isa('Moose::Meta::Role') ) {
require Moose;
Moose->throw_error( "You can only consume roles, "
. $role->[0]
. " is not a Moose role" );
}
This seems to be where the error is occuring, so it almost seems that for some reason, the role I'm implementing isn't stating that it's a role in the metaclass. Though I could be mistaken! Any help would be appreciated.
Another convenient EDIT!
Bonus: Code context wherein the with routine is called.
package Trello::API::Resource;
use Moose;
use URI::Escape;
use LWP::UserAgent;
with 'Roles::Authable';
which when I do this, it intelligently knows to try and consume Roles/Authable.pm but for whatever reason, it just fails to function!

First of all, I have to agree with Piers that technically, you really should be calling it as with 'Trello::API::Roles::Authable'.
So, you're asking for something that I don't find to be implemented in basic Moose.
I have used the ideas of generic namespace pools before. They are sort of universal namespaces to which you can offer your
semi-anonymous services--without the lock-in of a fixed namespace. I refined my basic idea of the namespace pool with Moose (really MOP) support.
In the Wild West days of Perl, all you would have to do is assign one stash to the symbol for the other, like so:
{ no strict 'refs';
*{$short_pkg_name.'::'} = \*{$full_pkg_name.'::'};
};
And, those two packages were exactly the same things!
But now, we guard our data with lexicals a bit more. And because Class::MOP jealously guards its meta objects in a lexical hash, you have to add something else:
Class::MOP::store_metaclass_by_name(
$short_pkg_name
, Class::MOP::get_metaclass_by_name( $full_pkg_name )
);
Now they are the exact same thing to Perl and to MOP.
Thus you can create packages that are simply a namespace repository for other packages
-- Now with MOP support!
package Namespace::Pool;
use strict;
use warnings;
use Params::Util qw<_POSINT>;
sub import {
shift; # It's just me.
my $full_pkg_name = caller();
Carp::croak( "'$full_pkg_name' is short enough!" )
unless my $pool_name
= shift // [ split /::/, $full_pkg_name ]->[-2]
;
Carp::croak( "'::$pool_name\::' not found in '$full_pkg_name'" )
unless ( _POSINT( my $pos = rindex( $full_pkg_name, "::$pool_name\::" ))
or my $is_short = _POSINT( index( $pool_name, '::' ))
);
my $short_pkg_name
= $is_short ? $poll_name
: substr( $full_pkg_name, $pos + 2 )
;
{ no strict 'refs';
if ( %{$short_pkg_name.'::'} ) {
Carp::croak( "You have already defined $short_pkg_name!" );
}
*{$short_pkg_name.'::'} = \*{$full_pkg_name.'::'};
};
if ( my $meta = Class::MOP::get_metaclass_by_name( $full_pkg_name )) {
Class::MOP::store_metaclass_by_name( $short_pkg_name, $meta );
}
return;
}
Thus in your Role package you can do the following:
package Trello::API::Roles::Authable;
use strict;
use warnings;
use Moose::Role;
use Namespace::Pool 'Roles';
...
And know that it will be available from the namespace of 'Roles'.

In my case I'd simply accidentally named my role 'Test', but there was already an installed module on my system called 'Test' and so Moose thought I wanted to consume that module rather than the new Moose role I'd created. Once I renamed by role to 'Testable' it all worked fine.

Related

Compile-time sanity check provided by role

I have a module that refuses to load unless a compile-time sanity check is met. Something like this:
package TopSecret;
use Moose;
die "Only Joe can use this!" unless $ENV{USER} eq 'joe';
1;
Now I would like to apply a similar sanity check to multiple modules, so my thought is to put it in a role. The consuming module would provide some information to customize the check a bit. So it might look something like:
package TopSecret;
use Moose;
with 'ForAuthorizedUser';
sub authorized_user { 'joe' }
1;
The problem is: how can I exercise TopSecret::authorized_user() from within ForAuthorizedUser, at compile time? Something like 'requires "authorized_user"' - except it would have to verify not just that the method exists, but execute it and check the return value.
I think that attribute overriding would be appropriate here. You declare the attribute in your Role and mark it as required, but don't provide a definition. Then the module that consumes the Role can supply the value for that attribute. Note that validation is typically done in the BUILD() subroutine.
package ForAuthorizedUser;
use Moose::Role;
use Carp qw(croak); # so you can see the line it fails on
has 'authorized_user' => (
is => 'ro',
required => 1,
);
sub BUILD {
my ($self) = #_;
croak "Only Joe can use this!"
unless $self->authorized_user eq 'joe';
}
1;
Now in your module that consumes ForAuthorizedUser, you supply the definition for the attribute:
package TopSecret;
use Moose;
with qw(ForAuthorizedUser);
has '+authorized_user' => (
default => 'joe',
);
__PACKAGE__->meta->make_immutable;
In a separate module you do the same thing, but with a different name (mine):
package TopSecret2;
use Moose;
with qw(ForAuthorizedUser);
has '+authorized_user' => (
default => 'hunter',
);
__PACKAGE__->meta->make_immutable;
Then you could test this like so:
use TopSecret;
use TopSecret2;
TopSecret->new; # lives
TopSecret2->new # croaks Only Joe can use this! at constructor TopSecret2::new (defined at Test.pm line 35) line 36.

How to extend Class::Multimethods::Pure to recognise Moose Roles?

I need multemethod dispatch with Moose objects. I'm doing this with Class::Multimethods::Pure. I chose this instead of MooseX::MultiMethods because it depends on MooseX::Method::Signatures which can't install on my system because it fails its tests. I don't mind if you have an alternative approach to suggest.
The following works fine with types and subtypes:
package Foo::Type;
use Moose;
package Foo::SubType;
use Moose;
extends 'Foo::Type';
package main;
use Class::Multimethods::Pure;
multi hello => ('Foo::Type') => sub {
my ( $foo ) = #_;
print $foo;
};
hello( Foo::SubType->new );
But the scenario I now need to handle is where the declared type is actually a Moose Role:
package Foo::Role;
use Moose::Role;
package Foo::Type;
use Moose;
with 'Foo::Role';
package main;
use Class::Multimethods::Pure;
multi hello => ('Foo') => sub {
my ( $foo ) = #_;
print $foo;
};
hello( Foo::Type->new );
But this can't recognise the role:
No method found for args (Foo::Type=HASH(0x22ac854))
The documentation says it can be extended in various ways, including adding Perl 6-ish roles. But it's a little sketchy for me and I'm looking for a more detailed example. Has anyone tried this?
My solution was to convert the roles to abstract base classes using MooseX::ABC. In this way, they could be recognised as a class type.
On a side note, I managed to get MooseX::MultiMethods working on another system. It does work with roles, but it can't figure out which to use if we define a multimethod that takes the class and another multimethod that takes the role. Incidentally, MooseX::ABC resolved this issue also since it gave me a hierarchical structure which the roles did not really have.
package Foo::Role;
use Moose::Role;
package Foo::Type;
use Moose;
with 'Foo::Role';
package Merger;
use Moose;
use MooseX::MultiMethods;
multi method hello (Foo::Role $foo) {
print 'Foo::Role: '.$foo;
}
multi method hello (Foo::Type $foo) {
print 'Foo::Type: '.$foo;
}
package main;
my $merger = Merger->new;
my $f = Foo::Type->new;
$merger->hello( $f );
# Ambiguous match for multi method hello: (Foo::Role $foo), (Foo::Type $foo)
# with value [ Merger{ }, Foo::Type{ } ]

Moose attributes: separating data and behaviour

I have a class built with Moose that's essentially a data container for an article list. All the attributes - like name, number, price, quantity - are data. "Well, what else?", I can hear you say. So what else?
An evil conspiration of unfortunate circumstances now forces external functionality into that package: Tax calculation of the data in this class has to be performed by an external component. This external component is tightly coupled to an entire application including database and dependencies that ruin the component's testability, dragging it into the everything-coupled-together stew. (Even thinking about refactoring the tax component out of the stew is completely out of the question.)
So my idea is to have the class accept a coderef wrapping the tax calculation component. The class would then remain independent of the tax calculation implementation (and its possible nightmare of dependencies), and at the same time it would allow integration with the application environment.
has 'tax_calculator', is => 'ro', isa => 'CodeRef';
But then, I'd have added a non-data component to my class. Why is that a problem? Because I'm (ab)using $self->meta->get_attribute_list to assemble a data export for my class:
my %data; # need a plain hash, no objects
my #attrs = $self->meta->get_attribute_list;
$data{ $_ } = $self->$_ for #attrs;
return %data;
Now the coderef is part of the attribute list. I could filter it out, of course. But I'm unsure any of what I'm doing here is a sound way to proceed. So how would you handle this problem, perceived as the need to separate data attributes and behaviour attributes?
A possible half thought out solution: use inheritance. Create your class as you do today but with a calculate_tax method that dies if called (i.e. a virtual function). Then create subclass that overrides that method to call into the external system. You can test the base class and use the child class.
Alternate solution: use a role to add the calculate_tax method. You can create two roles: Calculate::Simple::Tax and Calculate::Real::Tax. When testing you add the simple role, in production you add the real role.
I whipped up this example, but I don't use Moose, so I may be crazy with respect to how to apply the role to the class. There may be some more Moosey way of doing this:
#!/usr/bin/perl
use warnings;
{
package Simple::Tax;
use Moose::Role;
requires 'price';
sub calculate_tax {
my $self = shift;
return int($self->price * 0.05);
}
}
{
package A;
use Moose;
use Moose::Util qw( apply_all_roles );
has price => ( is => "rw", isa => 'Int' ); #price in pennies
sub new_with_simple_tax {
my $class = shift;
my $obj = $class->new(#_);
apply_all_roles( $obj, "Simple::Tax" );
}
}
my $o = A->new_with_simple_tax(price => 100);
print $o->calculate_tax, " cents\n";
It appears as if the right way to do it in Moose is to use two roles. The first is applied to the class and contains the production code. The second is applied to an object you want to use in testing. It subverts the first method using an around method and never calls the original method:
#!/usr/bin/perl
use warnings;
{
package Complex::Tax;
use Moose::Role;
requires 'price';
sub calculate_tax {
my $self = shift;
print "complex was called\n";
#pretend this is more complex
return int($self->price * 0.15);
}
}
{
package Simple::Tax;
use Moose::Role;
requires 'price';
around calculate_tax => sub {
my ($orig_method, $self) = #_;
return int($self->price * 0.05);
}
}
{
package A;
use Moose;
has price => ( is => "rw", isa => 'Int' ); #price in pennies
with "Complex::Tax";
}
my $prod = A->new(price => 100);
print $prod->calculate_tax, " cents\n";
use Moose::Util qw/ apply_all_roles /;
my $test = A->new(price => 100);
apply_all_roles($test, 'Simple::Tax');
print $test->calculate_tax, " cents\n";
A couple of things come to mind:
Implement the tax calculation logic in a separate TaxCalculation class that has the article list and the tax calculator as attributes.
Use a mock object as the tax calculator when you test. The tax calculator could be stored in an attribute that by default creates the real tax calculator. The test passes in a mock object that has the same interface but doesn't do anything.
Actually that's not really an abuse of get_attribute_list since that's rather exactly how MooseX::Storage works[^1]. IF you are going to continue to use get_attribute_list to build your straight data you'll want to do what MooseX::Storage does and set up an attribute trait for "DoNotSerialize"[^2]:
package MyApp::Meta::Attribute::Trait::DoNotSerialize;
use Moose::Role;
# register this alias ...
package Moose::Meta::Attribute::Custom::Trait::DoNotSerialize;
sub register_implementation { 'MyApp::Meta::Attribute::Trait::DoNotSerialize' }
1;
__END__
You then can use this in your class like so:
has 'tax_calculator' => ( is => 'ro', isa => 'CodeRef', traits => ['DoNotSerialize'] );
and in your serialization code like so:
my %data; # need a plain hash, no objects
my #attrs = grep { !$_->does('MyApp::Meta::Attribute::Trait::DoNotSerialize') } $self->meta->get_all_attributes; # note the change from get_attribute_list
$data{ $_ } = $_->get_value($self) for #attrs; # note the inversion here too
return %data;
Ultimately though you will end up in a solution similar to the Role one that Chas proposes, and I just answered his follow up question regarding it here: How to handle mocking roles in Moose?.
Hope this helps.
[^1]: And since the most basic use-case for MooseX::Storage is doing exactly what you describe, I highly suggest looking at it to do what you're doing by hand here.
[^2]: Or simply re-use the one from MooseX::Storage creates.

Do MooseX::AttributeHelpers and MooseX::FollowPBP interact correctly?

The following code defines two classes (DeckA and DeckB) that differ only in whether they use the features that come with MooseX::AttributeHelpers. The getters generated by Moose for DeckB are not what I expected. Is this a bug or am I misunderstanding how MooseX::AttributeHelpers and MooseX::FollowPBP ought to interact?
My workaround for now has been to avoid using the is argument in such situations and instead declare a reader and writer as needed.
use strict;
use warnings;
my %moose_args = (
isa => 'ArrayRef[Str]',
is => 'ro',
default => sub {[]},
);
my %moose_attr_helper_args = (
metaclass => 'Collection::Array',
provides => {
elements => 'get_all_cards',
},
);
package DeckA;
use Moose;
use MooseX::FollowPBP;
use MooseX::AttributeHelpers;
has 'cards' => (%moose_args);
package DeckB;
use Moose;
use MooseX::FollowPBP;
use MooseX::AttributeHelpers;
has 'cards' => (%moose_args, %moose_attr_helper_args);
package main;
for my $class (qw(DeckA DeckB)){
my $deck = $class->new;
print "\n$class\n";
for my $method ( qw(cards get_cards get_all_cards) ){
print "$method: ", $deck->can($method) ? 'yes' : 'no', "\n";
}
}
Output:
DeckA
cards: no
get_cards: yes
get_all_cards: no
DeckB
cards: yes # Not what I expected.
get_cards: no # Not what I expected.
get_all_cards: yes
They don't work when you use the metaclass option for MX::AH.
However, the latest Moose has integrated support for native helpers, with a slightly tweaked API. This version uses traits (a role applied to the attribute), and it should work just fine with MX::FollowPBP.
I had the same problem, so I really appreciate FM's question and Dave Rolsky's answer.
Rephrasing part of his answer so that my simple self would have understood it the first time I read it:
Instead of using MooseX::AttributeHelpers, you can simply use "traits" in the latest version of Moose. This eliminates the conflict with MooseX::FollowPBP, while still giving you the same functionality.
For using traits, see Moose::Meta::Attribute::Native.

Moose or Meta?

I've been trying to do this a number of ways, but none of them seem graceful enough. (I'm also wondering if CPAN or Moose already has this. The dozens of searches I've done over time have shown nothing that quite matches.)
I want to create a type of class that
is a Base + Facade + Factory for other classes which load themselves as destination types.
The "factory" is just Base->new( %params ) and this creates types based on policies registered by the individual subclass.
Each subclass knows basic things about the domain of the Base class, but I'm trying to keep it minimal. See the example below: UnresolvedPath just knows that we should check for existence first.
The obvious example for this is file system directories and files:
package Path;
use Moose;
...
sub BUILD {
my ( $self, $params ) = #_;
my $path = $params->{path};
my $class_name;
foreach my $test_sub ( #tests ) {
$class_name = $test_sub->( $path );
last if $class_name;
}
croak "No valid class for $path!" unless defined $class_name;
$class_name->BUILD( $self, $params );
}
package Folder;
use Moose;
extends 'Path';
use Path register => selector => sub { -d $_[0] };
sub BUILD { ... }
package UnresolvedPath;
extends 'Path';
use Path register position => 1, selector => sub { !-e $_[0] };
Question: Does Moose provide a graceful solution to this? Or would I have to go into Class::MOP for the bulk?
Have a peek at http://code2.0beta.co.uk/moose/svn/MooseX-AbstractFactory/ and feel free to steal. (Mine.)
If you truely want to do the Builder Pattern or the Abstract Factory Pattern then you can do that, and there is nothing stopping you. But perhaps what you really need is some Inversion of Control / Dependency Injection? For that, you can checkout Bread Board