Moose attributes: separating data and behaviour - perl

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.

Related

Moo/Moose attributes - how “keys %$self” works?

In my last question I asked many unrelated things, and can't accept multiple answers what answers only some questions, so here is clearly (i hope) defined question about the (Moo) attributes.
use 5.010;
use strict;
use warnings;
package SomeMoo;
use Moo;
has $_ => ( is => 'rw', predicate => 1) for (qw(a1 a2 nn xx));
package SomeMoose;
use Moose;
has $_ => ( is => 'rw', predicate => "has_".$_) for (qw(a1 a2 nn xx));
package main;
use Data::Dumper;
my $omoo = SomeMoo->new(a1 => "a1val", a2 => "a2val", xx=>"xxval");
say Dumper $omoo;
# $VAR1 = bless( {
# 'a2' => 'a2val',
# 'a1' => 'a1val',
# 'xx' => 'xxval'
# }, 'SomeMoo' );
#for Moose:
my $omoose = SomeMoose->new(a1 => "a1val", a2 => "a2val", xx=>"xxval");
say Dumper $omoose;
#as above, only blessed to package 'SomeMoose'.
#in both cases can do the next, for getting an (partial) list "attributes"
say $_ for keys (%$omoose); #or %$omoo
#anyway, in Moose i can
say "all attributes";
say $_->name for $omoose->meta->get_all_attributes();
#what prints
# all attributes
# nn
# a2
# a1
# xx
So the blessed object refences an object what contains only attributes what are set.
Question:
why the $self references, (so the %$self conatains) only the
attributes what are set, and not all, e.g the nn too from the example
code? (When the bless only associates the reference with an package why the $omoo isn't contains all package variables?) And from where the Moose knows it?)
how to get all_attributes in case of Moo?
Clearly I missing some basic knowledge.. :(
why the $self references, (so the %$self conatains) only the attributes what are set, and not all, e.g the nn too from the example code? (When the bless only associates the reference with an package why the $omoo isn't contains all package variables?) And from where the Moose knows it?)
Each time you create a new object, such as SomeMoo->new, you create a new reference which is made of two parts, the first is the data, which is usually a hashref, that hashref is blessed by the second part, which is the class, SomeMoo. The hash is used to store data associated with this instance of the new object, while SomeMoo is the class which provides the methods associated with with accessing/manipulating/doing stuff with the data.
Inside your class definitions you call a function called has. This function extends the class with new methods. In the case of Moo, you could make a poor man's version, by writing something like:
package SimpleMoo;
no strict 'refs';
sub new {bless {}, $_[0]} # very very simple constructor (oldskool)
*{__PACKAGE__."::$_"} = sub { # fyi: __PACKAGE__ eq "SimpleMoo"
$_[0]->{$_} = $_[1] if exists $_[1];
return $_[0]->{$_};
} for qw(a1 a2 nn xx);
The above add all our methods to the SimpleMoo class, it does so via manipulating the symbol table, and is probably quite close to what Moo does (except Moo/Moose extends a meta class which your class inherits from), an even simpler example would be to define the accessors manually:
package SimpleMoo;
sub new {bless {}, $_[0]} # very very simple constructor (oldskool)
sub a1 {
my ($self) = shift;
$self->{a1} = $_[0] if exists $_[0]; # set value if provided
return $self->{a1}; # return the value
}
sub a2 {
my ($self) = shift;
$self->{a2} = $_[0] if exists $_[0]; # set value if provided
return $self->{a2}; # return the value
}
# ... copy and paste the for nn and xx ...
As you can see from the examples above, I am extending the class with methods that allow you to set and get values from the hash, but not implicitly setting up the hash structure as part of the object's constructor (which should take place inside new if you want to do this) - just like Moo and Moose.
This means that inspecting the object via something like keys %$omoo doesn't show any keys until they've been set (either via the call to ->new or by setting them with $omoo->a1("someValue").
As mentioned by ikegami, adding something like: default => undef to your has statements will cause Moo/Moose to instantiate the value when the object is first constructed.
I hope this explains how $self contains the object data, which contains only keys previously set by methods or constructors.
how to get all_attributes in case of Moo?
Unfortunately the Moo api provides no method to list all defined attributes so I cannot offer a supported solution, but may I offer one of many (non-perfect highly un-recommended) solutions:
package SimpleMoo;
use Moo;
our #attr_list;
sub my_has {push #attr_list, $_[0]; has #_}
sub get_all_attributes {#attr_list}
my_has $_ => ( is => 'rw', predicate => 1) for (qw(a1 a2 nn xx));
package main;
my $omoo = SimpleMoo->new();
say $_ for $omoo->get_all_attributes;
I'm sure someone from Moo, will be able to provide a better way of accessing the meta class used in Moo to get this list. But I'm sure either solution is not recommended.
Ultimately, you are using Moose and Moo, you shouldn't be inspecting the underlying object, both modules use magic (symbol table modification and class inheritance, and all sorts) and you cannot rely on the underlying object nor the class itself to have the attributes and methods you expect them to have. if you have a use case where you want to list every attribute defined on a class, use Moose and inspect the meta class, or take control of you class by defining it yourself by hand.
You should also consider why you need a list of attributes from an object, perhaps you could list them yourself? what if someone inherits from your class? or you decide to mixin a role? would this break whatever code was trying to utilise a list of attributes on your object?

Perl / Moose - How can I dynamically choose a specific implementation of a method?

I've written a simple Moose based class called Document. This class has two attributes: name and homepage.
The class also needs to provide a method called do_something() which retrieves and returns text from different sources (like a website or different databases) based on the homepage attribute.
Since there will be a lot of totally different implementations for do_something(), I'd like to have them in different packages/classes and each of these classes should know if it is responsible for the homepage attribute or if it isn't.
My approach so far involves two roles:
package Role::Fetcher;
use Moose::Role;
requires 'do_something';
has url => (
is => 'ro',
isa => 'Str'
);
package Role::Implementation;
use Moose::Role;
with 'Role::Fetcher';
requires 'responsible';
A class called Document::Fetcher which provides a default implmenentation for do_something() and commonly used methods (like a HTTP GET request):
package Document::Fetcher;
use Moose;
use LWP::UserAgent;
with 'Role::Fetcher';
has ua => (
is => 'ro',
isa => 'Object',
required => 1,
default => sub { LWP::UserAgent->new }
);
sub do_something {'called from default implementation'}
sub get {
my $r = shift->ua->get(shift);
return $r->content if $r->is_success;
# ...
}
And specific implementations which determine their responsibility via a method called responsible():
package Document::Fetcher::ImplA;
use Moose;
extends 'Document::Fetcher';
with 'Role::Implementation';
sub do_something {'called from implementation A'}
sub responsible { return 1 if shift->url =~ m#foo#; }
package Document::Fetcher::ImplB;
use Moose;
extends 'Document::Fetcher';
with 'Role::Implementation';
sub do_something {'called from implementation B'}
sub responsible { return 1 if shift->url =~ m#bar#; }
My Document class looks like this:
package Document;
use Moose;
has [qw/name homepage/] => (
is => 'rw',
isa => 'Str'
);
has fetcher => (
is => 'ro',
isa => 'Document::Fetcher',
required => 1,
lazy => 1,
builder => '_build_fetcher',
handles => [qw/do_something/]
);
sub _build_fetcher {
my $self = shift;
my #implementations = qw/ImplA ImplB/;
foreach my $i (#implementations) {
my $fetcher = "Document::Fetcher::$i"->new(url => $self->homepage);
return $fetcher if $fetcher->responsible();
}
return Document::Fetcher->new(url => $self->homepage);
}
Right now this works as it should. If I call the following code:
foreach my $i (qw/foo bar baz/) {
my $doc = Document->new(name => $i, homepage => "http://$i.tld/");
say $doc->name . ": " . $doc->do_something;
}
I get the expected output:
foo: called from implementation A
bar: called from implementation B
baz: called from default implementation
But there are at least two issues with this code:
I need to keep a list of all known implementations in _build_fetcher. I'd prefer a way where the code would automatically choose from every loaded module/class beneath the namespace Document::Fetcher::. Or maybe there's a better way to "register" these kind of plugins?
At the moment the whole code looks a bit too bloated. I am sure people have written this kind of plugin system before. Isn't there something in MooseX which provides the desired behaviour?
What you're looking for is a Factory, specifically an Abstract Factory. The constructor for your Factory class would determine which implementation to return based on its arguments.
# Returns Document::Fetcher::ImplA or Document::Fetcher::ImplB or ...
my $fetcher = Document::Fetcher::Factory->new( url => $url );
The logic in _build_fetcher would go into Document::Fetcher::Factory->new. This separates the Fetchers from your Documents. Instead of Document knowing how to figure out which Fetcher implementation it needs, Fetchers can do that themselves.
Your basic pattern of having the Fetcher role able to inform the Factory if its able to deal with it is good if your priority is to allow people to add new Fetchers without having to alter the Factory. On the down side, the Fetcher::Factory cannot know that multiple Fetchers might be valid for a given URL and that one might be better than the other.
To avoid having a big list of Fetcher implementations hard coded in your Fetcher::Factory, have each Fetcher role register itself with the Fetcher::Factory when its loaded.
my %Registered_Classes;
sub register_class {
my $class = shift;
my $registeree = shift;
$Registered_Classes{$registeree}++;
return;
}
sub registered_classes {
return \%Registered_Classes;
}
You can have something, probably Document, pre-load a bunch of common Fetchers if you want your cake and eat it too.

Composing Roles into a Moose class not working

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.

programmatically creating a Moose class at run time

I've been playing around with this code:
package Foo;
use Moose;
package main;
my $PACKAGE = "Foo";
{
no strict 'refs';
my $has = *{"${PACKAGE}::has"}{CODE};
my $with = *{"${PACKAGE}::with"}{CODE};
# Add a instance member to class $PACKAGE
$has->("bar", is => "rw", required => 1);
# Add a role to class $PACKAGE
$with->("some::role");
}
# Create an instance of $PACKAGE:
$PACKAGE->new(); # error: attribute 'bar' is required means we were successful
This allows me to create a Moose class at run-time, i.e. add instance members to a class, add roles, etc.
My question is: how can I import Moose into package $PACKAGE?
I know I can do this with eval: eval "package $PACKAGE; use Moose"; but I'm wondering if there is a solution along the lines of Moose->import(... $PACKAGE ...).
i.e., a way without using eval. Or is there a completely different way of creating and modifying Moose classes at run time?
You probably want to take a look at Moose::Meta::Class and its create method:
my $class = Moose::Meta::Class->create('Foo',
attributes => [attr => Moose::Meta::Attribute->new(is => 'ro'), ...],
roles => [...],
methods => {...},
superclasses => [...],
);
# Edit: Adding an attribute and method modifiers:
$class->add_attribute(otherattr => (is => 'ro'));
$class->add_around_method_modifier(methodname => sub { ... });
Moose::Meta::Class is a subclass of Class::MOP::Class, so you might want to peek into that one as well. With the above, you can specify roles, superclasses, attributes and methods, or you can first create and then add them via the MOP; whatever fits best.
For the attributes you'll want the Moose kind, which means Moose::Meta::Attribute objects. The constructor to that object is basically the same as using has.
You may want to use Class::MOP, see for example https://metacpan.org/module/Moose::Manual::MOP#ALTERING-CLASSES-WITH-THE-MOP
or
https://metacpan.org/module/Class::MOP::Class#SYNOPSIS
Call extends, with, has, before, after, around, override and augment in the Moose package instead of the ones exported by Moose, and pass the meta object of the class you are creating as an additional first argument.
use strict;
use warnings;
use feature qw( say );
use Moose qw( );
{ # Create MyClass on the fly.
my $meta = Moose->init_meta( for_class => 'MyClass' );
# Moose::with( $meta, 'MyRole' );
Moose::has( $meta, foo => (
is => 'ro',
));
}
say MyClass->new( foo => "Foo" )->foo; # Foo

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