How do I best make triggered accessors with defaults in Moose? - perl

I have a situation where I'd like to cache some calculations for use
later. Let's say I have a list of allowed values. Since I'm going to
be checking to see if anything is in that list I'm going to want it as
a hash for efficiency and convenience. Otherwise I'd have to grep.
If I'm using Moose it would be nice if the cache was recalculated each
time the list of allowed values is changed. I can do that with a
trigger easy enough...
has allowed_values => (
is => 'rw',
isa => 'ArrayRef',
trigger => sub {
my %hash = map { $_ => 1 } #{$_[1]};
$_[0]->allowed_values_cache(\%hash);
}
);
has allowed_values_cache => (
is => 'rw',
isa => 'HashRef',
);
And the two will stay in sync...
$obj->allowed_values([qw(up down left right)]);
print keys %{ $obj->allowed_values_cache }; # up down left right
Now let's say I want a default for allowed_values, simple enough
change...
has allowed_values => (
is => 'rw',
isa => 'ArrayRef',
trigger => sub {
my %hash = map { $_ => 1 } #{$_[1]};
$_[0]->allowed_values_cache(\%hash);
},
default => sub {
return [qw(this that whatever)]
},
);
...except setting the default doesn't call the trigger. To get it to
DWIM I need to duplicate the caching.
has allowed_values => (
is => 'rw',
isa => 'ArrayRef',
trigger => sub {
$_[0]->cache_allowed_values($_[1]);
},
default => sub {
my $default = [qw(this that whatever)];
$_[0]->cache_allowed_values($default);
return $default;
},
);
sub cache_allowed_values {
my $self = shift;
my $values = shift;
my %hash = map { $_ => 1 } #$values;
$self->allowed_values_cache(\%hash);
return;
}
The Moose docs are explicit about trigger not getting called when
the default is set, but it gets in the way. I don't like the
duplication there.
Is there a better way to do it?

I was recently faced with this, and after asking on the #moose channel, was told to handle it this way:
Mark cache_allowed_values as a lazy_build, have _build_cache_allowed_values reference the current allowed_values, and put a write-trigger on allowed_values that clears cache_allowed_values.
That way, no matter what order the values are asked for or saved, they'll always be right with the least amount of work.
Example:
has cache_allowed_values => (is => 'ro', lazy_build => 1);
sub _build_cache_allowed_values {
return { map { $_ => 1 } #{shift->allowed_values} };
}
has allowed_values => (
is => 'rw',
trigger => sub { shift->clear_cache_allowed_values },
default => ...,
);

I think you really want allowed_values to be a separate data structure with the efficiency and ordering properties you desire. Since it doesn't look like you care about the ordering, why not:
has 'allowed_values' => (
traits => ['Hash'],
isa => HashRef[Bool],
default => sub { +{} },
handles => {
_add_allowed_value => 'set',
remove_allowed_value => 'delete',
value_is_allowed => 'exists',
allowed_values => 'keys',
},
);
method add_allowed_value(Str $value){
$self->_add_allowed_value( $value, 1 );
}
In general, anything not specific to the class being implemented should probably be implemented elsewhere. Making arrays have faster lookup times is not really the job of whatever class you are writing, so it should be implemented elsewhere, and this class should use that class. (In the simple case, like the hash above, maybe it's OK to ignore this rule. But if it were any more complicated, you would definitely want to factor it out.)
Edit:
If you want the user to think this is a list, how about:
use MooseX::Types::Moose qw(Bool ArrayRef HashRef);
use MooseX::Types -declare => ['ListHash'];
subtype ListHash, as HashRef[Bool];
coerce ListHash, from ArrayRef, via { +{ map { $_ => 1 } #$_ } };
has 'allowed_values' => (
# <same as above>
isa => ListHash,
writer => 'set_allowed_values',
coerce => 1,
);
Now you can set allowed_values like:
my $instance = Class->new( allowed_values => [qw/foo bar/] );
$instance->set_allowed_values([qw/foo bar baz/]);
And access them like:
my #allowed_values = $instance->allowed_values;
... if $instance->value_is_allowed('foo');
And modify them:
$instance->remove_allowed_value('foo');
$instance->add_allowed_value('gorch');
This hides any underlying implementation details from the user.
BTW, is building the hash actually and using it significantly faster than a linear scan over 3 elements?

Related

How to prevent infinite recursion (with Moose)?

In the following code fragment (Perl with Moose) there seems to be an infinite recursion:
has 'ORM' => ( is => 'ro',
isa => 'Model::LazySQLModel',
lazy => 1,
builder => 'ORM_builder' );
has 'id' => ( is => 'ro',
isa => 'Int',
lazy => 1,
builder => 'id_builder',
predicate => 'has_id',
);
sub id_builder { $_[0]->ORM->id }
sub ORM_builder {
my ($self) = #_;
# FIXME: looks like infinite recursion
if ($self->id) {
return $self->ORM_find();
} else {
return $self->ORM_insert();
}
}
Remark: Model::LazySQLModel is a tied hash which holds ID and other DB fields.
What is the right way to do this (to be sure that we prevent infinite recursion)?
Replacing if ($self->id) with if ($self->has_id) is a solution.

Creating attribute defaults by calling a wrapped object

I have WrapperClass object that has an InnerClass object as an attribute. The InnerClass object has a weight attribute. My WrapperClass object also has a weight attribute and I want its default value to be whatever the value of the InnerClass object's weight attribute is.
#!/usr/bin/perl
package InnerClass;
use Moose;
has 'weight' => (
is => 'rw',
);
package WrapperClass;
use Moose;
has 'wrapped' => (
is => 'rw',
lazy => 1,
default => sub {InnerClass->new(weight => 1)},
);
has 'weight' => (
is => 'rw',
default => sub {
my $self = shift;
$self->wrapped->weight()
},
lazy => 1,
);
The code above works, but in reality InnerClass has many attributes which WrapperClass needs to do the same thing for. Ideally I would do something like this when I'm writing WrapperClass:
use Moose;
has 'wrapped' => (
is => 'rw',
);
my #getDefaultsFromWrappers
= qw(weight height mass x y z label); # etc ...
foreach my $attr (#getDefaultsFromWrappers) {
has $attr => (
is => 'rw',
default => sub {
# Somehow tell the default which attribute
# it needs to call from wrapped object?
my $self = shift;
$self->wrapped->???()
},
lazy => 1,
);
}
However, there is no way of passing an argument to a default or builder to tell it which attribute it is building. I've considered using caller but this seems like a hack.
Does anyone know how I could accomplish this style of attribute declaration or is it a case of declaring each attribute and its default separately?
You can use $attr where your question marks are because it is still in scope when you declare the attributes.
foreach my $attr (#getDefaultsFromWrappers) {
has $attr => (
is => 'rw',
default => sub { shift->wrapped->$attr() },
lazy => 1,
);
}
The following is a possible alternative, which you might want to use if your attribute declarations are not uniform:
has weight => (
is => 'rw',
isa => 'Num',
default => _build_default_sub('weight'),
lazy => 1,
);
has label => (
is => 'rw',
isa => 'Str',
default => _build_default_sub('label'),
lazy => 1,
);
sub _build_default_sub {
my ($attr) = #_;
return sub { shift->wrapped->$attr };
}
This may be better handled by method delegation and default values in the inner object.
With these, the example you gave can be better written as:
#!/usr/bin/perl
use strict;
use warnings;
package InnerClass;
use Moose;
has weight => (
is => 'rw',
default => 1,
);
package WrapperClass;
use Moose;
has wrapped => (
is => 'rw',
isa => 'InnerClass',
lazy => 1,
default => sub { InnerClass->new },
handles => [ 'weight' ],
);
package main;
my $foo = WrapperClass->new;
print $foo->weight;
Any additional defaults would be added as default on the InnerClass, and within the WrapperClass, add to wrapped 'handles' array ref to indicate that it should be delegated to that object.
If don't want the defaults to be applied to all instances of InnerClass, then you can remove the default from there, specify all attributes required (to give better error detection), and specify all attributes in the default constructor.

How to store Hash of Hashes in Moose?

i was wondering, what is the best way to store Hash of Hashes in Moose. Lets take for example a Hash like this:
my %hash = ('step1' => {'extraction' => \$object1,
'analysis' => \$object2},
'step2' => {'extraction' => \$object3,
'analysis' => \$object4});
but i want to save this one in a moose attribute. How should i organize the access (reading, writing) on this. Examples on the net are mostly for "flat" hashes. But then you can use helpers like Moose::Meta::Attribute::Native::Trait::Hash. Is there something similar for hash of hashes?
Reason for this is, that i want to iterate over the step-keys and access the object-instances in that. Or is there a better, more Moose-like way to do this?
Thanks in advance!!!
You can store a hash of hashes in a Moose object in pretty much the same way as you would store any other hash:
has steps => ( is => 'ro', isa => 'HashRef' );
You can, however, be more specific to declare it as the specific kind of hash you need to store as a way to verify that anything stored in that slot is the right kind of thing:
has steps => ( is => 'ro', isa => 'HashRef[HashRef[Object]]' );
Depending on the data, I might also change Object here to the class name. You can get even fancier and use MooseX::Types and MooseX::Types::Structured to specify an even more exacting structure.
As for helpers to to step over your structure, I don't know of anything in Moose or MooseX to do that. If you know the structure of your data, it's probably best to just implement a subroutine to do what you need yourself. Your code will likely perform better and do what you need better than any generic traversal.
Edit/Additional Info: Each Moose attribute creates an accessor method no your class which returns the stored value, so accessing the data is:
# Assuming we put the attribute in a package named StepTool
my $step_tool = StepTool->new(
steps => { 'step1' => {'extraction' => \$object1,
'analysis' => \$object2},
'step2' => {'extraction' => \$object3,
'analysis' => \$object4} },
);
# To do something one of the values
do_something($step_tool->steps->{step1}{extraction});
# To iterate over the structure, could be done in a method on StepTool
for my $step_name (keys %{ $step_tool->steps }) {
my $step = $step_tool->steps->{ $step_name };
for my $action_name (keys %$step) {
my $object = $step->{ $action_name };
do_something($object);
}
}
# If doing the above as a method, $self is the Moose object, so...
sub traverse_steps {
my ($self) = #_;
for my $step_name (keys %{ $self->steps }) {
... # just like above
}
}
And one other note, you could still use traits => [ 'Hash' ] and add some handles to give yourself some additional helpers, if you want.
If the data structure is more free form than that, you might want to look into something like Data::Visitor to iterate over your structure in your subroutine. (I have had some difficult to debug, weird problems with Data::Visitor, so I try to avoid it when I can.)
There is also a type-safe approach inspired by Moose: How to get an array of objects? Traits?
There is a class to hold the outer hash (StepTool::Steps) that has traits => ['Hash']. This approach can be nested infinitely deep using e.g. Arrays and Hashes:
package StepTool;
use Moose;
has 'steps' => (
'is' => 'rw',
'isa' => 'StepTool::Steps',
'default' => sub { StepTool::Steps->new() },
);
package StepTool::Steps;
use Mouse;
has '_steps' => (
is => 'ro',
isa => 'HashRef[StepTool::Step]',
traits => ['Hash'],
default => sub { {} },
handles => {
# You'll probably want a fuller set here...
get => 'get',
set => 'set',
keys => 'keys',
}
);
package StepTool::Step;
use Mouse;
has 'extraction' => (
is => 'rw',
);
has 'analysis' => (
is => 'rw',
);
package main;
my $object1 = bless {}, 'Foobar1';
my $object2 = bless {}, 'Foobar2';
my $object3 = bless {}, 'Foobar3';
my $object4 = bless {}, 'Foobar4';
my $stepTool = StepTool->new();
# set up step1 one field at a time.
$stepTool->steps->set('step1', StepTool::Step->new());
# I have no idea why the OP wants references to objects
# everywhere but he does...
$stepTool->steps->get('step1')->extraction(\$object1);
$stepTool->steps->get('step1')->analysis(\$object2);
# set up step2 all at once
$stepTool->steps->set('step2', StepTool::Step->new(
extraction => \$object3,
analysis => \$object4
));
# or, less elegantly, initialize an entire StepTool:
my $stepTool2 = StepTool->new(
steps => StepTool::Steps->new(
_steps => {
step1 => StepTool::Step->new(
extraction => \$object1,
analysis => \$object2
),
step2 => StepTool::Step->new(
extraction => \$object3,
analysis => \$object4
),
}
),
);
printf "step1->analysis is a ref to an instance of class: %s\n",
ref(${$stepTool->steps->get('step1')->analysis});

How can I implement a new handle for a Moose type trait?

Lets's say I wanted to add say functionality to String ( note: this is a more simple example than reality ). So I could have
has foo => (
isa => 'Str',
traits => [ 'String' ],
handles => {
say_foo => 'say',
}
);
which I then of course would be able to use to do.
$self->foo( 'bar' );
$self->say_foo;
which would print literally
'bar\n'
I imagine the subroutine would be something like this
sub _say_attr {
my ( $self, $attr ) = #_;
say $attr;
}
Can anyone help me fill in the gaps on how I might actually implement this? I don't really see much in the way of documentation on how to write your own handles.
I don't really need to know how to modify the String traits. So much as I want to be able to have a generic handler, where I don't need to know the name of the current attribute in order to make it work.
has foo => (
isa => 'Str',
traits => [ 'PrintString' ],
handles => {
say_foo => 'say',
}
);
has bar => (
isa => 'Str',
traits => [ 'PrintString' ],
handles => {
say_bar => 'say',
}
);
so say here is probably an identifier for a function which does not need a hardcoded name of an attribute which is calling it.
Do you really want to add say to String, or would you be content with adding say_foo to foo?
The latter is easy:
has foo => (
isa => 'Str',
traits => [ 'String' ],
handles => {
say_foo => sub { say $_[0]->foo; },
}
);
If you wanted to a more general solution, You should look at Moose::Meta::Attribute::Native::Trait::String and copy/wrap/subclass it rather than trying to change it.

Rewriting object attributes - best way to do it using Moose?

Let's see whether the SO question entry robot prediction, apparently issued based on just the question title, will come true:
The question you're asking appears subjective and is likely to be closed.
Using Perl/Moose, I'd like to bridge a mismatch between two ways merchant articles are represented. Let an article have name, quantity and price. The first way this is represented is with quantity set to any numeric value, including decimal values, so you can have 3.5 meters of rope or cable. The second one, which I have to interface with, is, alas, inflexible, and requires quantity to be an integer. Hence I have to rewrite my object to set quantity to 1 and include the actual quantity in the name. (Yes, this is a hack, but I wanted to keep the example simple.)
So the story here is that one property's value affects other properties' values.
Here's working code:
#!perl
package Article;
use Moose;
has name => is => 'rw', isa => 'Str', required => 1;
has quantity => is => 'rw', isa => 'Num', required => 1;
has price => is => 'rw', isa => 'Num', required => 1;
around BUILDARGS => sub {
my $orig = shift;
my $class = shift;
my %args = #_ == 1 ? %{$_[0]} : #_;
my $q = $args{quantity};
if ( $q != int $q ) {
$args{name} .= " ($q)";
$args{price} *= $q;
$args{quantity} = 1;
}
return $class->$orig( %args );
};
sub itemprice { $_[0]->quantity * $_[0]->price }
sub as_string {
return sprintf '%2u * %-40s (%7.2f) %8.2f', map $_[0]->$_,
qw/quantity name price itemprice/;
}
package main;
use Test::More;
my $table = Article->new({ name => 'Table', quantity => 1, price => 199 });
is $table->itemprice, 199, $table->as_string;
my $chairs = Article->new( name => 'Chair', quantity => 4, price => 45.50 );
is $chairs->itemprice, 182, $chairs->as_string;
my $rope = Article->new( name => 'Rope', quantity => 3.5, price => 2.80 );
is $rope->itemprice, 9.80, $rope->as_string;
is $rope->quantity, 1, 'quantity set to 1';
is $rope->name, 'Rope (3.5)', 'name includes original quantity';
done_testing;
I'm wondering, however, whether there's a better idiom to do this in Moose. But maybe my question is all subjective and deserves swift closing. :-)
UPDATE based on perigrin's answer
I've adapted perigrin's code sample (minor errors, and 5.10 syntax) and tagged my tests onto the end of it:
package Article::Interface;
use Moose::Role;
requires qw(name quantity price);
sub itemprice { $_[0]->quantity * $_[0]->price }
sub as_string {
return sprintf '%2u * %-40s (%7.2f) %8.2f', map $_[0]->$_,
qw/quantity name price itemprice/;
}
package Article::Types;
use Moose::Util::TypeConstraints;
class_type 'Article::Internal';
class_type 'Article::External';
coerce 'Article::External' =>
from 'Article::Internal' => via
{
Article::External->new(
name => sprintf( '%s (%s)', $_->name, $_->quantity ),
quantity => 1,
price => $_->quantity * $_->price
);
};
package Article::Internal;
use Moose;
use Moose::Util::TypeConstraints;
has name => isa => 'Str', is => 'rw', required => 1;
has quantity => isa => 'Num', is => 'rw', required => 1;
has price => isa => 'Num', is => 'rw', required => 1;
my $constraint = find_type_constraint('Article::External');
=useless for this case
# Moose::Manual::Construction - "You should never call $self->SUPER::BUILD,
# nor"should you ever apply a method modifier to BUILD."
sub BUILD {
my $self = shift;
my $q = $self->quantity;
# BUILD does not return the object to the caller,
# so it CANNOT BE USED to trigger the coercion.
return $q == int $q ? $self : $constraint->coerce( $self );
}
=cut
with qw(Article::Interface); # need to put this at the end
package Article::External;
use Moose;
has name => isa => 'Str', is => 'ro', required => 1;
has quantity => isa => 'Int', is => 'ro', required => 1;
has price => isa => 'Num', is => 'ro', required => 1;
sub itemprice { $_[0]->price } # override
with qw(Article::Interface); # need to put this at the end
package main;
use Test::More;
my $table = Article::Internal->new(
{ name => 'Table', quantity => 1, price => 199 });
is $table->itemprice, 199, $table->as_string;
is $table->quantity, 1;
is $table->name, 'Table';
my $chairs = Article::Internal->new(
name => 'Chair', quantity => 4, price => 45.50 );
is $chairs->itemprice, 182, $chairs->as_string;
is $chairs->quantity, 4;
is $chairs->name, 'Chair';
my $rope = Article::Internal->new(
name => 'Rope', quantity => 3.5, price => 2.80 );
# I can trigger the conversion manually.
$rope = $constraint->coerce( $rope );
# I'd like the conversion to be automatic, though.
# But I cannot use BUILD for doing that. - XXX
# Looks like I'd have to add a factory method that inspects the
# parameters and does the conversion if needed, and it is always
# needed when the `quantity` isn't an integer.
isa_ok $rope, 'Article::External';
is $rope->itemprice, 9.80, $rope->as_string;
is $rope->quantity, 1, 'quantity set to 1';
is $rope->name, 'Rope (3.5)', 'name includes original quantity';
done_testing;
I agree it provides a better separation of concerns. On the other hand, I'm not convinced this is a better solution for my purpose, as it adds complexity and does not provide for an automatic conversion (for which I would have to add more code).
Based on the information you provided in the comments, you're actually modeling two different but related things. You've encountered the ugliness of trying to keep these two things as a single Class. You end up not properly separating your concerns and have ugly dispatch logic.
You need to have two classes with a common API (a Role will enforce this) and a set of coercions to easily translate between the two.
First the API is really straight forward.
package Article::Interface {
use Moose::Role;
requires qw(name quantity price);
sub itemprice { $_[0]->quantity * $_[0]->price }
sub as_string {
    return sprintf '%2u * %-40s (%7.2f) %8.2f', map $_[0]->$_,
    qw/quantity name price itemprice/;
}
}
Then you have a Class to represent your internal Articles, again this is pretty trivial.
package Article::Internal {
use Moose;
has name => ( isa 'Str', is => 'rw', required => 1);
has [qw(quantity price)] => ( isa => 'Num', is => 'rw', required => 1);
# because of timing issues we need to put this at the end
with qw(Article::Interface);
}
Finally you have a class to represent your external articles. In this one you have to override some methods from the interface to deal with the fact that your attributes are going to be specialized[^1].
package Article::External {
use Moose;
has name => ( isa 'Str', is => 'ro', required => 1);
has quantity => ( isa => 'Int', is => 'ro', required => 1);
has price => (isa => 'Num', is => 'ro', required => 1);
sub itemprice { $_[0]->price }
# because of timing issues we need to put this at the end
with qw(Article::Interface);
}
Finally you define a simple coercion routine to translate between the two.
package Article::Types {
use Moose::Util::TypeConstraints;
class_type 'Article::Internal';
class_type 'Article::External';
coerce 'Article::Exteral' => from 'Article::Internal' => via {
Article::External->new(
name => $_->name,
quantity => int $_->quantity,
price => $_->quantity * $_->price
);
}
}
You can trigger this coercion manually with:
find_type_constraint('Article::External')->coerce($internal_article);
Additionally MooseX::Types can be used for this last part to provide cleaner sugar, but I chose to stick with pure Moose here.
[^1]: You may have noticed that I've made the attributes in the External article read-only. From what you've said these objects should be "consume only" but if you need the attributes to be writeable you'll need to define a coercion on quantity to deal with making sure that only Integers are stored. I'll leave that as an exercise to the reader.