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.
Related
I know this may be a very simple topic but I am trying to get the best logic since I am still new to Perl.
If I do not use OO and just split the code into files, all global variables are accessed among all files.
I am trying to do the same but using OO style. Example is I want a base class say called "BaseSub" that has a hash containing the configuration for the application say called %Config. Now I have a sub class called "DB" for the database connection and I want to access the settings from %Config which lives in "BaseSub" package. How do I do that.
If you're writing OO perl in this day and age, you really should be using Moose. It makes OO code much easier, cleaner and smaller.
The proper way to inherit variables is to make object attributes. Here's a quick example:
package MyBaseClass;
use Moose;
has config => (
is => 'ro',
default => sub { {
who => 'World',
} }
);
package MyClass;
use Moose;
extends qw(MyBaseClass);
sub greet
{
my $self = shift;
printf("Hello %s!\n", $self->config->{who});
}
package main;
my $object = MyClass->new();
$object->greet();
A great starting point for learning about Moose is the Moose::Manual.
Edit:
If you want be able to modify the config, you can either just poke the hashref returned from the config accessor directly:
$object->config->{who} = 'Friends';
But a better approach might be to make a config class and make the config attribute hold an instance of that:
package Myconfig;
use Moose;
has who => (is => 'rw', default => 'World');
package MyBaseClass;
use Moose;
has config => (
is => 'ro',
isa => 'MyConfig',
default => sub { MyConfig->new },
);
# inherit, instantiate, etc as before...
$object->config->who('Friends');
Another approach could be Moose::Meta::Attribute::Native::Trait::Hash which makes it easy to setup helper methods to work with native Perl datatypes.
Use its full name.
for (keys(%BaseSub::Config)) {
print("$_: $BaseSub::Config{$_}\n");
}
You could also import it.
our %Config; *Config = \%BaseSub::Config;
for (keys(%Config)) {
print("$_: $Config{$_}\n");
}
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.
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.
I am new to Moose and am trying to use it with DBIx::Class. Basic DBIC querying and updating work find, but any trigger I attempt to write does not get executed when I modify an attribute.
use Modern::Perl;
use Data::Dumper;
my $schema = My::Schema->connect(<connect str>, <usr>, <psw>) or die $!;
my $rs = $schema->resultset('Isin')->search( sid => 3929 );
my $security_obj = $rs->first;
print $security_obj->isin, "\n";
$security_obj->isin('Test1Foo'); # <- expect to see FOO printed by trigger
print $security_obj->isin, "\n";
I expect to see the trigger for 'isin' print 'FOO', but nothing happens. If I strip out DBIx::Class from the package the trigger is executed as expected.
I suspect that DBIx::Class is setting the value in a way that prevents the trigger from firing.
Unfortunately, I haven't had much luck finding resources about using DBIx::Class with Moose. What I have written is mostly based on what I found at DBIx::Class and Moose.
Am I using DBIx::Class and/or Moose wrong? Is there a different ORM that I should be using with Moose?
The package with the trigger that won't fire:
package My::Schema::Result::Isin;
use DBIx::Class;
use Moose;
use Carp;
extends 'DBIx::Class';
has 'isin' => ( is => "rw", isa => "Str", trigger => \&_mod_isin);
has 'sid' => ( is => "ro", isa => "Int");
sub _mod_isin {
print "FOO\n";
return;
};
no Moose;
__PACKAGE__->load_components('Core');
__PACKAGE__->table('isin');
__PACKAGE__->add_columns(
isin => { data_type => 'varchar2', size => 12 },
sid => { data_type => 'integer', size => 6 },
);
__PACKAGE__->set_primary_key('isin');
First, you have the problem of extending a non-Moose class from within Moose. This is a problem because DBIx::Class doesn't inherit from Moose::Object, so you won't get the standard Moose methods like does. See Moose::Cookbook::Basics::Recipe11 for solving this problem.
Second, you have the bigger problem that you have two different sets of magic which are trying to create subroutines for you. You have Moose, whose magic creates isin and sid subroutines, and you have DBIx::Class, whose magic also creates isin and sid subroutines which replace the ones that Moose created.
You might want to compose in a Moose Role with an around modifier, as jrockway suggested.
Have you tried using writer => \&_mod_isin instead?
How do I write a clean implementation of the strategy pattern in Perl? I want to do it in a way that leverages Perl's features.
It really depends on what you mean by "clean implementation". As in any other language, you can use Perl's object system with polymorphism to do this for you. However, since Perl has first class functions, this pattern isn't normally coded explicitly. Leon Timmermans' example of
sort { lc($a) cmp lc($b) } #items
demonstrates this quite elegantly.
However, if you're looking for a "formal" implementation as you would do in C++, here's what it may look like using Perl+Moose. This is just a translation of the C++ code from Wikipedia -- Strategy pattern, except I'm using Moose's support for delegation.
package StrategyInterface;
use Moose::Role;
requires 'run';
package Context;
use Moose;
has 'strategy' => (
is => 'rw',
isa => 'StrategyInterface',
handles => [ 'run' ],
);
package SomeStrategy;
use Moose;
with 'StrategyInterface';
sub run { warn "applying SomeStrategy!\n"; }
package AnotherStrategy;
use Moose;
with 'StrategyInterface';
sub run { warn "applying AnotherStrategy!\n"; }
###############
package main;
my $contextOne = Context->new(
strategy => SomeStrategy->new()
);
my $contextTwo = Context->new(
strategy => AnotherStrategy->new()
);
$contextOne->run();
$contextTwo->run();
Use sub references, and closures. A good perlish example of this
sort { lc($a) cmp lc($b) } #items