Moose around method modifier, setter and constructor (new): intercept all updates to an attribute - perl

Question

Update
The code I posted in my original question was illustrative of the way method modifier do or don't work.
It was not necessarily illustrative of the problem description I gave.
This code should be. It works, but contains a hack in the trigger I used to code the requirement of tracking all updates and acting upon them based on the value supplied to the setter.
package Article;
use Moose;
use Moose::Util::TypeConstraints;
has 'name', is => 'rw', isa => 'Str', required => 1;
has 'price', is => 'rw', isa => 'Num', required => 1;
has 'quantity', is => 'rw', isa => 'Num', required => 1,
trigger => \&update_quantity;
has 'quantity_original', is => 'rw', isa => 'Num',
predicate => 'quantity_fix',
clearer => 'quantity_back_to_normal';
# https://metacpan.org/module/Moose::Cookbook::Basics::Recipe3
# A trigger accepts a subroutine reference, which will be called as a method
# whenever the attribute is set. This can happen both during object
# construction or later by passing a new object to the attribute's accessor
# method. However, it is not called when a value is provided by a default or
# builder.
sub update_quantity {
my( $self, $val ) = #_;
# print STDERR $val, "\n";
if ( $val == int $val ) {
$self->quantity_back_to_normal;
} else {
$self->quantity_original( $val );
# Updating quantity via setter would retrigger this code.
# Which would defeat its purpose. The following won't:
$self->{quantity} = 1; # hack, yes; but it does work
}
}
around name => sub {
my $orig = shift;
my $self = shift;
return $self->$orig( #_ ) if #_; # setter
return $self->$orig unless $self->quantity_fix;
return sprintf '%s (%s)', $self->$orig, $self->quantity_original;
};
around price => sub {
my $orig = shift;
my $self = shift;
return $self->$orig( #_ ) if #_; # setter
return $self->$orig unless $self->quantity_fix;
return int( 100 * $self->$orig * $self->quantity_original + 0.5 ) / 100;
};
__PACKAGE__->meta->make_immutable; no Moose;
package main;
use Test::More;
{ my $art = Article->new( name => 'Apfel', price => 33, quantity => 4 );
is $art->price, 33, 'supplied price';
is $art->quantity, 4, 'supplied quantity';
is $art->name, 'Apfel', 'supplied name';
}
{ my $art = Article->new( name => 'Mehl', price => 33, quantity => 4.44 );
# diag explain $art;
is $art->quantity, 1, 'has quantity fixed';
is $art->price, 33 * 4.44, 'has price fixed';
is $art->name, 'Mehl (4.44)', 'has name fixed';
# tougher testing ...
$art->quantity(3);
is $art->quantity, 3, 'supplied quantity again';
is $art->price, 33, 'supplied price again';
is $art->name, 'Mehl', 'supplied name again';
}
done_testing;
Still not sure what Moose facility to employ to do the job.
An abundance of features and facilities does not always make things easier.
At least not when you try not to reinvent any wheels and reuse what can be reused.
Original question
It appears the around method modifier isn't called as part of building the object (when calling new). Test case here:
package Bla;
use Moose;
has 'eins', is => 'rw', isa => 'Int';
has 'zwei', is => 'rw', isa => 'Num';
around [qw/ eins zwei /] => sub {
my $orig = shift;
my $self = shift;
return $self->$orig unless #_;
my $val = shift;
if ( $val == int $val ) {
return $self->$orig( $val );
}
else {
return $self->$orig( 1 );
warn "replaced $val by 1";
}
};
package main;
use Test::More;
use Test::Exception;
dies_ok { Bla->new( eins => 33.33 ) } 'dies because of Int type constraint';
my $bla = Bla->new( zwei => 22.22 );
is $bla->zwei, 22.22, 'around has not been called';
done_testing;
Let me explain what I want to achieve. There's a class that has quantity and price (and some more state). When quantity comes in (via new or the setter, I don't care), I want to make sure it ends up as an integer (hence the constraint). If it's not an integer, I want to replace it by just 1 and make some other updates to the object, like saving the original quantity and multiplying the price by the original quantity. Both for the constructor and the setter.
What should I do? Provide a subroutine that does the job and call it from both around BUILDARGS and around quantity?

Answer 1

How about this?
package Bla;
use Moose;
use Moose::Util::TypeConstraints;
subtype 'MyInt',
as 'Int';
coerce 'MyInt',
from 'Num',
via { 1 };
has 'eins', is => 'rw', isa => 'Int';
has 'zwei', is => 'rw', isa => 'MyInt', coerce => 1;
package main;
use Test::More;
use Test::Exception;
dies_ok { Bla->new( eins => 33.33 ) } 'dies because of Int type constraint';
my $bla = Bla->new( zwei => 22.22 );
is $bla->zwei, 1, '22.22 -> 1';
my $bla2 = Bla->new( zwei => 41 );
is $bla2->zwei, 41, '41 -> 41';
done_testing;

Answer 2

When I keep running against walls, I know I did something wrong, and I'm running against walls. The design sucks. I think the key problem is that you have one field serving two purposes.
If the only purpose of orig_quantity is to normalize the price, I suggested that you normalize quantity and price after they are set. This could be done explicitly, or it could be done implicitly when you try to fetch them as shown below.
has price => (
accessor => '_price',
isa => 'Num',
handles => {
price => sub {
my $self = shift;
return $self->_price(#_) if #_;
$self->normalize();
return $self->_price();
},
},
);
has quantity => (
accessor => '_quantity',
isa => 'Num',
handles => {
quantity => sub {
my $self = shift;
return $self->_quantity(#_) if #_;
$self->normalize();
return $self->_quantity();
},
},
);
sub normalize {
my ($self) = #_;
my $quantity = $self->_quantity();
return if is_an_int($quantity);
$self->_quantity(1);
$self->_price($self->_price() / $quantity);
}
If you actually do need orig_quantity, then you probably want the constructor to set this directly and make quantity a derived value.