This is a basic question, I fear. Take a look at the following code. I'd like to know whether there is a way to declare the slices attribute in such a way as to avoid the boilerplate of get_slices and add_slice.
package Gurke;
use Moose;
has slices => is => 'rw', isa => 'ArrayRef[Str]', default => sub { [] };
sub get_slices { return #{ $_[0]->slices } }
sub add_slice {
my( $self, $slice ) = #_;
push #{ $self->slices }, $slice;
return;
}
no Moose;
__PACKAGE__->meta->make_immutable;
package main; # now a small test for the above package
use strict;
use warnings;
use Test::More;
my $gu = Gurke->new;
$gu->add_slice( 'eins' );
$gu->add_slice( 'zwei' );
$gu->add_slice( 'drei' );
my #sl = $gu->get_slices;
is shift #sl, 'eins';
is shift #sl, 'zwei';
is shift #sl, 'drei';
done_testing;
Thanks!
I'm a Moose beginner, but I think you need this:
has slices =>
is => 'rw',
isa => 'ArrayRef[Str]',
default => sub { [] },
traits => ['Array'],
handles => {
add_slice => 'push',
get_slices => 'elements',
},
;
Related
I of course know that I can rename the init arg for an attribute by setting init_arg (e.g)
package Test {
use Moose;
has attr => (
is => 'ro',
isa => 'Str',
init_arg => 'attribute'
);
}
which would allow me to
Test->new({ attribute => 'foo' });
but not
Test->new({ attr => 'foo' });
at the same time
MooseX::Aliases actually has this behavior, but creating an alias also creates accessors. I'm currently trying to understand the code in that module to see if I can't determine how it does it, so that I can replicate said functionality (in a way I understand). If someone could explain how to do it here with an example that'd be great.
update it appears that MX::Aliases is doing this by way of replacing what's actually passed to the constructor in an around initialize_instance_slot but I'm still not sure how that's actually getting called, because in my test code my around isn't actually getting executed.
update munging in BUILDARGS isn't really an option because what I'm trying to do allow setting of the accessor via the name of the label I'm adding to the attribute via Meta Recipe3. You might say I'm doing
has attr => (
is => 'ro',
isa => 'Str',
alt_init_arg => 'attribute'
);
update
here's what I've managed to work out with what I'm trying to do so far.
use 5.014;
use warnings;
package MooseX::Meta::Attribute::Trait::OtherName {
use Moose::Role;
use Carp;
has other_name => (
isa => 'Str',
predicate => 'has_other_name',
required => 1,
is => 'ro',
);
around initialize_instance_slot => sub {
my $orig = shift;
my $self = shift;
my ( $meta_instance, $instance, $params ) = #_;
confess 'actually calling this code';
return $self->$orig(#_)
unless $self->has_other_name && $self->has_init_arg;
if ( $self->has_other_name ) {
$params->{ $self->init_arg }
= delete $params->{ $self->other_name };
}
};
}
package Moose::Meta::Attribute::Custom::Trait::OtherName {
sub register_implementation { 'MooseX::Meta::Attribute::Trait::OtherName' }
}
package Message {
use Moose;
# use MooseX::StrictConstructor;
has attr => (
traits => [ 'OtherName' ],
is => 'ro',
isa => 'Str',
other_name => 'Attr',
);
__PACKAGE__->meta->make_immutable;
}
package Client {
use Moose;
sub serialize {
my ( $self, $message ) = #_;
confess 'no message' unless defined $message;
my %h;
foreach my $attr ( $message->meta->get_all_attributes ) {
if (
$attr->does('MooseX::Meta::Attribute::Trait::OtherName')
&& $attr->has_other_name
) {
$h{$attr->other_name} = $attr->get_value( $message );
}
}
return \%h;
}
__PACKAGE__->meta->make_immutable;
}
my $message = Message->new( Attr => 'foo' );
my $ua = Client->new;
my %h = %{ $ua->serialize( $message )};
use Data::Dumper::Concise;
say Dumper \%h
problem is that my around block is never being run and I'm not sure why, maybe I'm wrapping it in the wrong place or something.
MooseX::Aliases has several moving parts to make this functionality happen, that's because the behavior needs to be applied to several different places in the MOP. Your code here looks very close to the code in MooseX::Aliases's Trait attribute.
I suspect the reason your code isn't being called is due to something going wrong when you try to register your trait. MooseX::Aliases uses Moose::Util::meta_attribute_alias rather than the old fashioned way you're using here. Try replacing your Moose::Meta::Attribute::Custom::Trait::OtherName section with a call to Moose::Util::meta_attribute_alias 'OtherName'; inside your Role.
Second the code you have here won't work for immutable classes. You'll need to add a second trait to handle those because the immutability code is handled by the class's metaclass and not the attribute's metaclass. You'll need to add some more traits to handle attributes in Roles as well I think. Then you'll need to wire up an Moose::Exporter to make sure that all the traits are applied properly when everything is compiled.
I've gotten a simple version of this working up through immutable. This code is also on github.
First the Attribute trait:
package MooseX::AltInitArg::Meta::Trait::Attribute;
use Moose::Role;
use namespace::autoclean;
Moose::Util::meta_attribute_alias 'AltInitArg';
has alt_init_arg => (
is => 'ro',
isa => 'Str',
predicate => 'has_alt_init_arg',
);
around initialize_instance_slot => sub {
my $orig = shift;
my $self = shift;
my ($meta_instance, $instance, $params) = #_;
return $self->$orig(#_)
# don't run if we haven't set any alt_init_args
# don't run if init_arg is explicitly undef
unless $self->has_alt_init_arg && $self->has_init_arg;
if (my #alternates = grep { exists $params->{$_} } ($self->alt_init_arg)) {
if (exists $params->{ $self->init_arg }) {
push #alternates, $self->init_arg;
}
$self->associated_class->throw_error(
'Conflicting init_args: (' . join(', ', #alternates) . ')'
) if #alternates > 1;
$params->{ $self->init_arg } = delete $params->{ $alternates[0] };
}
$self->$orig(#_);
};
1;
__END__
Next the Class trait.
package MooseX::AltInitArg::Meta::Trait::Class;
use Moose::Role;
use namespace::autoclean;
around _inline_slot_initializer => sub {
my $orig = shift;
my $self = shift;
my ($attr, $index) = #_;
my #orig_source = $self->$orig(#_);
return #orig_source
# only run on aliased attributes
unless $attr->meta->can('does_role')
&& $attr->meta->does_role('MooseX::AltInitArg::Meta::Trait::Attribute');
return #orig_source
# don't run if we haven't set any aliases
# don't run if init_arg is explicitly undef
unless $attr->has_alt_init_arg && $attr->has_init_arg;
my $init_arg = $attr->init_arg;
return (
'if (my #aliases = grep { exists $params->{$_} } (qw('
. $attr->alt_init_arg . '))) {',
'if (exists $params->{' . $init_arg . '}) {',
'push #aliases, \'' . $init_arg . '\';',
'}',
'if (#aliases > 1) {',
$self->_inline_throw_error(
'"Conflicting init_args: (" . join(", ", #aliases) . ")"',
) . ';',
'}',
'$params->{' . $init_arg . '} = delete $params->{$aliases[0]};',
'}',
#orig_source,
);
};
1;
__END__
Finally the Moose::Exporter glue.
package MooseX::AltInitArg;
use Moose();
use Moose::Exporter;
use MooseX::AltInitArg::Meta::Trait::Attribute;
Moose::Exporter->setup_import_methods(
class_metaroles => { class => ['MooseX::AltInitArg::Meta::Trait::Class'] }
);
1;
__END__
An example of how this is used then:
package MyApp;
use 5.10.1;
use Moose;
use MooseX::AltInitArg;
has foo => (
is => 'ro',
traits => ['AltInitArg'],
alt_init_arg => 'bar',
);
my $obj = MyApp->new( bar => 'bar' );
say $obj->foo; # prints bar
Meta-Programming in Moose is incredibly powerful, but because there are a lot of moving parts (many of which have solely to do with maximizing performance) you bite off a lot of work when you dive in.
Good luck.
I could be wrong but I think you might be able to accomplish what I think you are trying to do using the BUILDARGS method. This lets you munge the contructor arguments before they are used to create the object.
#!/usr/bin/env perl
use strict;
use warnings;
{
package MyClass;
use Moose;
has attr => (
is => 'ro',
isa => 'Str',
required => 1,
);
around BUILDARGS => sub {
my $orig = shift;
my $self = shift;
my %args = ref $_[0] ? %{shift()} : #_;
if (exists $args{attribute}) {
$args{attr} = delete $args{attribute};
}
$self->$orig(%args);
};
}
my $one = MyClass->new(attribute => "Hi");
my $two = MyClass->new(attr => "Bye");
print $one->attr, "\n";
print $two->attr, "\n";
So what I'm hearing is that:
At construction time, an attribute should be able to be set by its init_arg and any alternate init_args defined on the attribute.
An attribute should not be able to be manipulated by its alternate init_args except at instance construction; that is, aside from the above, the attribute should behave "normally".
Based on that, this seems like a good match for the MooseX::MultiInitArg attribute trait. Yes? :)
I've received a lot of exceptions from QA due to incomplete data being fed to my Moose constructors. The attribute name is present in the constructor arguments, but the value is undef.
It's a fact of life with many scripting applications that things are just undef. And oftentimes this is perfectly fine. You don't want an annoying warning from the warnings pragma (so you do no warnings 'uninitialized'), and you certainly don't want your code to die because one little value, say the housenumber, is undef.
So without further ado, I want my Moose constructors to behave like straight Perl (i.e. without use warnings 'uninitialized'), which is to convert undef to 0 or the empty string as required. The attempt shown in this sample does not work for the case where the attribute name is present but the value is undef. I could think of using BUILDARGS to achieve what I want. But is there a declarative way in plain Moose without resorting to MooseX::UndefTolerant (which unfortunately I cannot use as it is not installed)?
package AAA;
use Moose;
has 'hu', is => 'ro', isa => 'Str';
has 'ba', is => 'ro', isa => 'Int';
no Moose; __PACKAGE__->meta->make_immutable;
package BBB;
use Moose; extends 'AAA';
has '+hu', default => ''; # don't want to die on undef
has '+ba', default => 0; # idem
no Moose; __PACKAGE__->meta->make_immutable;
package main;
use Test::More;
use Test::Exception;
# Those AAAs should die ...
throws_ok { AAA->new( hu => undef ) }
qr/Validation failed for 'Str' with value undef/;
throws_ok { AAA->new( ba => undef ) }
qr/Validation failed for 'Int' with value undef/;
# .. but these BBBs should live:
lives_ok { BBB->new( hu => undef ) } 'hu supplied as undef';
lives_ok { BBB->new( ba => undef ) } 'ba supplied as undef';
done_testing;
In Moose::Manual::Types is a way documented to deal with exactly this kind of problem.
Use the Maybe[a] type.
package AAA;
use Moose;
has 'hu', is => 'ro', isa => 'Str';
has 'ba', is => 'ro', isa => 'Int';
no Moose; __PACKAGE__->meta->make_immutable;
package BBB;
use Moose; extends 'AAA';
has 'hu', is => 'rw', isa => 'Maybe[Str]', default => ''; # will not die on undef
has 'ba', is => 'rw', isa => 'Maybe[Int]', default => 0; # idem
sub BUILD {
my $self = shift;
$self->hu('') unless defined $self->hu;
$self->ba(0) unless defined $self->ba;
}
no Moose; __PACKAGE__->meta->make_immutable;
package main;
use Test::More;
use Test::Exception;
# Those AAAs should die ...
throws_ok { AAA->new( hu => undef ) }
qr/Validation failed for 'Str' with value undef/;
throws_ok { AAA->new( ba => undef ) }
qr/Validation failed for 'Int' with value undef/;
# .. but these BBBs should live:
lives_ok { BBB->new( hu => undef ) } 'hu supplied as undef';
lives_ok { BBB->new( ba => undef ) } 'ba supplied as undef';
my $bbb = BBB->new( hu => undef, ba => undef );
is $bbb->hu, '', "hu is ''";
is $bbb->ba, 0, 'ba is 0';
done_testing;
Your complaint really is that Moose is doing exactly what it is supposed to be doing. If you explicitly pass undef as a value, but that value can only be an Int, then you should get an error.
So you need to make a choice. You can either change the type (via union) to allow undef as a valid value like so:
has 'hu', is => 'ro', isa => 'Str | Undef';
has 'ba', is => 'ro', isa => 'Int | Undef';
Or you can just not send in undefined values:
my %aa_params = ();
$aa_params{hu} = $foo if defined $foo;
$aa = AA->new( %aa_params );
Or finally, for some unknown reason you absolutely cannot resist sending in invalid undefined values for things which should not be explicitly set to undefined, just write a quick filter:
sub filt_undef {
my %hash = #_;
return map { $_ => $hash{$_} } grep { defined $hash{$_} } keys %hash;
}
$aa = AA->new( filt_undef( hu => undef ) );
But this seems rather awkward and awful.
Or use on-the-fly coercion:
package BBB;
use Moose;
use MooseX::AttributeShortcuts;
extends 'AAA';
has '+hu',
traits => [Shortcuts],
coerce => [ Undef => sub { '' } ],
;
I am new to Moose and doing quite well until I have hit a snag using a PDL as a property. I want to be able to write an object to a file (I have been using use MooseX::Storage; with Storage('io' => 'StorableFile');, and this object has a PDL as a attribute. PDL::IO::Storable provides the necessary methods to use Storable in this way, however I am at a loss as to how to do this in Moose.
Here is an example, it is a little long, I know, but it is as minimal as I can make it:
#!/usr/bin/perl
package LinearPDL;
use Moose;
use PDL::Lite;
use PDL::IO::Storable;
use MooseX::Storage;
with Storage('io' => 'StorableFile');
has 'length' => (is => 'ro', isa => 'Num', required => 1);
has 'divisions' => (is => 'ro', isa => 'Int', required => 1);
has 'linear_pdl' => (is => 'ro', isa => 'PDL', lazy => 1, builder => '_build_pdl');
sub _build_pdl {
my $self = shift;
my $pdl = $self->length() / ( $self->divisions() - 1 ) * PDL::Basic::xvals($self->divisions());
return $pdl;
}
no Moose;
__PACKAGE__->meta->make_immutable;
use strict;
use warnings;
my $linear_pdl = LinearPDL->new('length' => 5, 'divisions' => 10);
print $linear_pdl->linear_pdl;
$linear_pdl->store('file'); # blows up here!
my $loaded_lpdl = load('file');
print $loaded_lpdl->linear_pdl;
I think I may have to make a PDL type or perhaps even wrap PDL into something (using MooseX::NonMoose::InsideOut), but perhaps someone can save me from that (or point me down the right road if it is).
You don't say what actually goes wrong. At a guess you'll need to tell MooseX::Storage how to handle the PDL object using the PDL object's Storable hooks. The documentation for this feature in MooseX::Storage is very poor but MooseX::Storage::Engine has a add_custom_type_handler() method that takes a typename (PDL in your case) and a HashRef of handlers.
MooseX::Storage::Engine->add_custom_type_handler(
'PDL' => (
expand => sub { my ($data) = #_; ... },
collapse => sub { my ($object) = #_; ... },
)
);
Please swing past #moose on irc.perl.org or the Moose mailing list and ask.
[Edit: Update with an example based on the tests.]
The question by Joel and response from perigrin helped me solve a storage problem that had been sitting in the back of my mind for a while. I'm posting a working example here. It doesn't use PDL but it's related and may help someone in the future.
{
package MVR;
use Moose;
use MooseX::Storage;
use Math::Vector::Real;
use Data::Structure::Util qw (unbless);
with Storage('format' => 'JSON', 'io' => 'File');
MooseX::Storage::Engine->add_custom_type_handler(
'Math::Vector::Real' => (
expand => sub {my $v = shift; Math::Vector::Real->new(#{$v})},
collapse => sub {my $mvr = shift; return (unbless($mvr)) },
)
);
has 'mvr' => (is => 'rw', isa => 'Math::Vector::Real');
1;
}
use Math::Vector::Real;
my $p = MVR->new(mvr => V(0,1,3));
print $p->dump;
$p->store('my_point.json');
my $p1 = MVR->load('my_point.json');
print $p1->dump;
How should I define a Moose object subroutine after its initialization?
I'm writing an object module using Moose and I plan to serialize (nstore) the created objects.
Examine the following (simplified!) example:
package MyObj 0.001;
use Moose;
use namespace::autoclean;
has 'size' => (
is => 'ro',
isa => 'Int',
required => 1,
);
sub some_sub {
my ($self, #more) = #_;
if ($self->size() < 100) # do something;
elsif (($self->size() < 500)) # do something else;
elsif (($self->size() < 7500)) # do something else;
# ...
}
1;
some_sub acts differently depending on size. Since size is read-only, it remains constant after the object has been initialized.
So, assuming I call some_sub zillion times, it's a pity that I have to go through all the ifs each time.
I'd better do this once after the object has been initialized, then set some_sub to be a simpler function with noifs at all.
But... how can I do that?
UPDATE
Perhaps I should add a lazy attribute of type subref that will hold a reference to the chosen subroutine. some_sub will then simply call $self->chosen_sub->(#_). What do you think?
has calculation_method => (is => 'ro', lazy_build => 1, init_arg => undef);
sub _build_calculation_method {
my $self = shift;
return '_calculate_small' if $self->size < 100;
return '_calculate_medium' if $self->size < 500;
return '_calculate_large' if $self->size < 7500;
return '_calculate_enormous';
}
sub _calculate_small { ... }
sub _calculate_medium { ... }
# etc.
sub calculate {
my $self = shift;
my $method = $self->calculation_method;
return $self->$method(#_);
}
As a bonus, calculation_method is now serializable too.
Perhaps another case for MooseX::SingletonMethod! (Sorry I'm reading your questions in reverse order!).
For eg:
use 5.012;
use warnings;
package MyObj 0.001;
use MooseX::SingletonMethod;
use namespace::autoclean;
has 'size' => (
is => 'ro',
isa => 'Int',
required => 1,
);
sub _which_sub {
my ($self) = #_;
if ($self->size < 100) { return sub{ 'A' } }
elsif ($self->size < 500) { return sub{ 'B' } }
elsif ($self->size < 7500) { return sub{ 'C' } }
return sub { 'D' };
}
package main;
my $obj = MyObj->new( size => 200 );
$obj->add_singleton_method( some_sub => $obj->_which_sub );
say $obj->some_sub; # => B
And it should be possible to add this single method creation from inside your class. Have a look at this blog post for some guidance: Moose Singleton Method: Now without roles!. And also a hotchpotch of posts here
Regarding your update:
use 5.012;
use warnings;
package MyObj;
use Moose;
use namespace::autoclean;
has 'size' => (
is => 'ro',
isa => 'Int',
required => 1,
);
has 'chosen_sub' => (
is => 'ro',
isa => 'CodeRef',
lazy => 1,
builder => '_build_chosen_sub',
init_arg => undef, # unless want option of providing anon sub at construction?
);
sub _build_chosen_sub {
my ($self) = #_;
if ($self->size < 100) { return sub{ 'A' } }
elsif ($self->size < 500) { return sub{ 'B' } }
elsif ($self->size < 7500) { return sub{ 'C' } }
return sub { 'D' };
}
package main;
my $obj = MyObj->new( size => 200 );
say $obj->chosen_sub->(); # => B
In our classes we have a pattern where we create an attribute to represent a
calculated value. For obvious reasons we want to cache the calculated value
and then invalidate the cache when one of the underlying values change.
So we currently have this:
package FooBar;
use Moose;
has 'foo' => (
accessor => {
'foo' => sub {
my $self = shift;
if (#_ > 0) {
# writer
$self->{foo} = $_[0];
# reset fields that are dependant on me
$self->{bar} = undef;
}
# reader part;
return $self->{foo};
}
}
);
has 'bar' => (
accessor => {
'bar' => sub {
my $self = shift;
if (#_ > 0) {
# writer
$self->{bar} = $_[0];
}
# reader part;
$self->{bar} = calculate_bar($self->foo, $self->baz)
if (not defined($self->{bar}));
return $self->{bar};
}
}
);
sub calculate_bar { ... }
This long hand method is getting very tedious and error prone when calculated values
depend on other calculated values.
Is there a smarter/simpler way for 'bar' to monitor the attributes it depends on
vs having 'foo' know who is dependent on it? Also how can I avoid setting bar via hash
member access?
If I understand you correctly, you can use triggers to clear attributes when one is set. Here's an example:
has 'foo' => (
is => 'rw',
trigger => sub{
my ($self) = #_;
$self->clear_bar;
}
);
has 'bar' => (
is => 'rw',
clearer => 'clear_bar',
lazy => 1,
default => sub{
my ($self) = #_;
return calculate_bar( ... );
}
);
So, any writes to foo via $obj->foo($newvalue) will cause bar to be cleared, and recreated on next access.
I think it is quite possible that you're making this harder on yourself by using an Attributes implicit memoization with lazy, when you could just make the memoization explicit making your whole program more transparent
has [qw/foo bar baz/] => ( isa => 'Value', is => 'rw' );
use Memoize;
memoize('_memoize_this');
sub old_lazy_attr {
my $self = shift;
_memoize_this( $self->attr1, $self->attr2, $self->attr3 );
}
sub _memoize_this {
my #args = #_;
# complex stuff
return $result
}
See cpan's Memoize for information and control of the internal cache, also remember that a Memoized function can not be dependent on the state of the object. So the arguments must be passed in explicitly.
Would this work?
#!/usr/bin/perl
package Test;
use Modern::Perl;
use Moose;
has a => (is => 'rw', isa => 'Str', trigger => \&change_a);
has b => (is => 'rw', isa => 'Str', trigger => \&change_b);
has c => (is => 'rw', isa => 'Str');
sub change_a
{
my $self = shift;
say 'update b';
$self->b($self->a . ', bar');
}
sub change_b
{
my $self = shift;
say 'update c';
}
package main;
my $test = Test->new->a('Foo');
Output:
$ perl test.pl
update b
update c
I haven't done any poking around in Moose internals and the meta object protocol, but I think this is a good time to do it.
You want to patch the code generation so that when you specify an attribute as
has 'foo' => ();
has 'bar' => (
depends_on => [qw( foo )],
lazy => \&calculate_bar,
);
the code generation phase creates code for the foo and bar attributes as you specified above.
How to do this is an exercise left to the reader. If I had a clue, I'd try to give you a start. Unfortunately, all I can advise you with is "This is a job for the MOP".