Store a Moose object that has a PDL as an attribute - perl

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;

Related

Moose how to change the attribute value only when it is $undef?

Now have:
has 'id' => (
is => 'rw',
isa => 'Str',
default => sub { "id" . int(rand(1000))+1 }
);
Works OK, the:
PKG->new(id => 'some'); #the id is "some"
PKG->new() #the id is #id<random_number>
In the next scenario:
my $value = undef;
PKG->new(id => $value);
(of course) got an error:
Attribute (id) does not pass the type constraint because: Validation failed for 'Str' with value undef at /Users/me/perl5/perlbrew/perls/perl-5.16.3/lib/site_perl/5.16.3/darwin-thread-multi-2level/Moose/Exception.pm line 37
The question is:
How to achieve changing the value after it is set to undef (and only when it is $undef)? So,
has 'id' => (
is => 'rw',
isa => 'Str|Undef', #added undef to acceptable Type
default => sub { "id" . int(rand(1000))+1 }
);
Now, it accepting the $undef, but I don't want $undef but want "id" . int(rand(1000))+1. How to change the attribute value after it is set?
The after is called only for the accessors not for constructors. Maybe some weird coercion from Undef to Str - but only for this one attribute?
Ps: using the PKG->new( id => $value // int(rand(10000)) ) is not an acceptable solution. The module should accept the $undef and should silently change it to the random number.
Type::Tiny has as one of its aims to make it easy to add coercions to individual attributes really easy. Here's an example:
use strict;
use warnings;
{
package Local::Test;
use Moose;
use Types::Standard qw( Str Undef );
my $_id_default = sub { "id" . int(rand(1000)+1) };
has id => (
is => 'rw',
isa => Str->plus_coercions(Undef, $_id_default),
default => $_id_default,
coerce => 1,
);
__PACKAGE__->meta->make_immutable;
}
print Local::Test->new(id => 'xyz123')->dump;
print Local::Test->new(id => undef)->dump;
print Local::Test->new->dump;
You could also look at MooseX::UndefTolerant which makes undef values passed to the constructor act as if they were entirely omitted. This won't cover passing undef to accessors though; just constructors.
Here is an alternative, using Moose' BUILD method, which is called after an object is created.
#!/usr/bin/perl
package Test;
use Moose;
has 'id' => (
is => 'rw',
isa => 'Str|Undef',
);
sub BUILD {
my $self = shift;
unless($self->id){
$self->id("id" . (int(rand(1000))+1));
}
}
1;
package Main;
my $test = Test->new(id => undef);
print $test->id; ###Prints random number if id=> undef
More info on BUILD here:
http://metacpan.org/pod/Moose::Manual::Construction#BUILD
#choroba in a comment mentioned about the triggers. Based on this, found a next solution. The trigger is called twice in the case id=>undef, but otherwise it works.
use Modern::Perl;
package My;
use namespace::sweep;
use Moose;
my $_id_default = sub { "id" . int(rand(100_000_000_000)+1) };
my $_check_id = sub { $_[0]->id(&$_id_default) unless $_[1] };
has id => (
is => 'rw',
isa => 'Str|Undef',
default => $_id_default,
trigger => $_check_id,
);
__PACKAGE__->meta->make_immutable;
package main;
say My->new->id;
say My->new(id=>'aaa')->id;
say My->new(id=>undef)->id;

How can I provide an alternate init arg for an attribute in Moose?

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? :)

How to use Moose to add convenience functions for array attributes?

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',
},
;

How can I modify a Moose attribute handle?

Following phaylon's answer to "How can I flexibly add data to Moose objects?", suppose I have the following Moose attribute:
has custom_fields => (
traits => [qw( Hash )],
isa => 'HashRef',
builder => '_build_custom_fields',
handles => {
custom_field => 'accessor',
has_custom_field => 'exists',
custom_fields => 'keys',
has_custom_fields => 'count',
delete_custom_field => 'delete',
},
);
sub _build_custom_fields { {} }
Now, suppose I'd like to croak if trying to read (but not write) to a non-existing custom field. I was suggested by phaylon to wrap custom_field with an around modifier. I have experimented with around modifiers following the various examples in Moose docs, but couldn't figure how to modify a handle (rather than just an object method).
Alternatively, is there another way to implement this croak-if-try-to-read-nonexisting-key?
They're still just methods generated by Moose. You can just do:
around 'custom_field' => sub {
my $orig = shift;
my $self = shift;
my $field = shift;
confess "No $field" unless #_ or $self->has_custom_field($field);
$self->$orig($field, #_);
};
(croak is not very useful in method modifiers at the moment. It will just point you at internal Moose code.)
In fact, you don't need to use around for this. Using before is simpler:
before 'custom_field' => sub {
my $self = shift;
my $field = shift;
confess "No $field" unless #_ or $self->has_custom_field($field);
};

Moose: Expiring cached results of calculations when attribute values change?

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".