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
Related
I want to add a new feature for Perl language, in order to type less $self->.
For example, Translate:
use Moo;
has a_attr => (is=>'rw');
sub XXX {
print $self->a_attr;
}
To:
use Moo;
use MyFeatureModule;
has a_attr => (is=>'rw');
sub XXX {
print _a_attr;
}
How-to?
This doesn't require any changes to Perl's syntax, only to its semantics. Luckily, that's not too hard.
What you want can be achieved by providing an AUTOLOAD sub for your package, which will kick in automatically whenever you call a sub that hasn't been defined yet (i.e. _a_attr in your example). This AUTOLOAD method can then use Devel::Caller to grab $_[0] (i.e. $self) from its caller, inject it onto #_ and then goto the original method.
use v5.14;
use strictures;
package Foo {
use Moo;
has xyzzy => (is => 'ro', default => 42);
sub sayit {
say _xyzzy();
}
sub AUTOLOAD {
require Devel::Caller;
my ($invocant) = Devel::Caller::caller_args(1);
unshift #_, $invocant;
my ($method) = (our $AUTOLOAD =~ /::_(\w+)\z/)
or die "Method not found!";
my $coderef = $invocant->can($method)
or die "Method not found!";
goto $coderef;
};
}
my $obj = Foo->new;
$obj->sayit;
Is this a good idea? Well, I certainly wouldn't do it. As well as introducing an unnecessary level of slow-down to your code, and breaking inheritance, it is likely to confuse anybody who has to maintain your code after you. (And that might be your future self if you take a break from the project, and come back to it in 6 months.)
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 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{ } ]
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.
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.