1

アップデート

元の質問に投稿したコードは、メソッド修飾子が機能する方法と機能しない方法を示しています。それは必ずしも私が与えた問題の説明を説明するものではありませんでした。このコードはそうあるべきです。それは機能しますが、すべての更新を追跡し、セッターに提供された値に基づいてそれらに基づいて動作するという要件をコーディングするために使用したトリガーにハックが含まれています。

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;

仕事をするためにどのムース施設を採用すべきかまだわからない。豊富な機能と設備が必ずしも物事を容易にするわけではありません。少なくとも、ホイールを再発明せず、再利用できるものを再利用しようとするときはそうではありません。

元の質問

メソッド修飾子はaround、オブジェクトの構築の一部として呼び出されていないようです（を呼び出す場合new）。ここでのテストケース：

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;

私が達成したいことを説明しましょう。quantityおよびprice（およびさらにいくつかの状態）を持つクラスがあります。数量が入ってくるとき（newまたはセッターを介して、私は気にしません）、それが整数になることを確認したいと思います（したがって制約）。整数でない場合は、それを単に置き換えて1、元の数量を保存したり、価格に元の数量を掛けたりするなど、オブジェクトに他の更新を加えたいと思います。コンストラクターとセッターの両方。

私は何をすべきか？ジョブを実行するサブルーチンを提供し、との両方から呼び出しaround BUILDARGSますaround quantityか？

4

2 に答える 2

2

私が壁に向かって走り続けるとき、私は何か間違ったことをしたことを知っています、そして私は壁に向かって走っています。デザインは最悪だ。重要な問題は、1つのフィールドが2つの目的を果たしていることだと思います。

orig_quantity価格を正規化することが唯一の目的である場合は、正規quantity化priceして設定した後で行うことをお勧めします。これは、明示的に実行することも、以下に示すようにフェッチしようとしたときに暗黙的に実行することもできます。

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);
}

実際にが必要な場合はorig_quantity、コンストラクターでこれを直接設定しquantity、派生値を作成する必要があります。

于 2012-01-31T11:00:10.750 に答える
2

これはどう？

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;
于 2012-01-30T21:46:55.830 に答える