trAvis - MANAGER
Edit File: hash_coerce.t
use strict; use warnings; use Test::More; { package Foo; use Moose; use Moose::Util::TypeConstraints; subtype 'UCHash', as 'HashRef[Str]', where { !grep {/[a-z]/} values %{$_}; }; coerce 'UCHash', from 'HashRef[Str]', via { $_ = uc $_ for values %{$_}; $_; }; has hash => ( traits => ['Hash'], is => 'rw', isa => 'UCHash', coerce => 1, handles => { set_key => 'set', }, ); our @TriggerArgs; has lazy => ( traits => ['Hash'], is => 'rw', isa => 'UCHash', coerce => 1, lazy => 1, default => sub { { x => 'a' } }, handles => { set_lazy => 'set', }, trigger => sub { @TriggerArgs = @_ }, clearer => 'clear_lazy', ); } my $foo = Foo->new; { $foo->hash( { x => 'A', y => 'B' } ); $foo->set_key( z => 'c' ); is_deeply( $foo->hash, { x => 'A', y => 'B', z => 'C' }, 'set coerces the hash' ); } { $foo->set_lazy( y => 'b' ); is_deeply( $foo->lazy, { x => 'A', y => 'B' }, 'set coerces the hash - lazy' ); is_deeply( \@Foo::TriggerArgs, [ $foo, { x => 'A', y => 'B' }, { x => 'A' } ], 'trigger receives expected arguments' ); } { package Thing; use Moose; has thing => ( is => 'ro', isa => 'Str', ); } { package Bar; use Moose; use Moose::Util::TypeConstraints; class_type 'Thing'; coerce 'Thing' => from 'Str' => via { Thing->new( thing => $_ ) }; subtype 'HashRefOfThings' => as 'HashRef[Thing]'; coerce 'HashRefOfThings' => from 'HashRef[Str]' => via { my %new; for my $k ( keys %{$_} ) { $new{$k} = Thing->new( thing => $_->{$k} ); } return \%new; }; coerce 'HashRefOfThings' => from 'Str' => via { [ Thing->new( thing => $_ ) ] }; has hash => ( traits => ['Hash'], is => 'rw', isa => 'HashRefOfThings', coerce => 1, handles => { set_hash => 'set', get_hash => 'get', }, ); } { my $bar = Bar->new( hash => { foo => 1, bar => 2 } ); is( $bar->get_hash('foo')->thing, 1, 'constructor coerces hash reference' ); $bar->set_hash( baz => 3, quux => 4 ); is( $bar->get_hash('baz')->thing, 3, 'set coerces new hash values' ); is( $bar->get_hash('quux')->thing, 4, 'set coerces new hash values' ); } done_testing;