t/07-coerce.t

   1 BEGIN {
   2     use strict;
   3     use warnings;
   4     use Test::More tests=>16;
   5     use Test::Exception;
   6 }
   7
   8 {
   9     package Test::MooseX::Meta::TypeConstraint::Structured::Coerce;
  10
  11     use Moose;
  12     use MooseX::Types::Structured qw(Dict Tuple);
  13     use MooseX::Types::Moose qw(Int Str Object ArrayRef HashRef);
  14     use MooseX::Types -declare => [qw(
  15         myDict myTuple Fullname
  16
  17     )];
  18
  19     subtype myDict,
  20      as Dict[name=>Str, age=>Int];
  21
  22     subtype Fullname,
  23      as Dict[first=>Str, last=>Str];
  24
  25     coerce Fullname,
  26      from ArrayRef,
  27      via { +{first=>$_->[0], last=>$_->[1]} };
  28
  29     subtype myTuple,
  30      as Tuple[Str, Int];
  31
  32     ## Create some coercions.  Note the dob_epoch could be a more useful convert
  33     ## from a dob datetime object, I'm just lazy.
  34
  35     coerce myDict,
  36      from Int,
  37      via { +{name=>'JohnDoe', age=>$_} },
  38      from Dict[aname=>HashRef, dob_in_years=>Int],
  39      via { +{
  40         name=> $_->{aname}->{first} .' '. $_->{aname}->{last},
  41         age=>$_->{dob_in_years},
  42         }
  43      },
  44      from Dict[bname=>HashRef, dob_in_years=>Int],
  45      via { +{
  46         name=> $_->{bname}->{first} .' '. $_->{bname}->{last},
  47         age=>$_->{dob_in_years},
  48         }
  49      },
  50      from Dict[fullname=>Fullname, dob_epoch=>Int],
  51      via { +{
  52         name=> $_->{fullname}->{first} .' '. $_->{fullname}->{last},
  53         age=>$_->{dob_epoch}}
  54      },
  55      from myTuple,
  56      via { +{name=>$_->[0], age=>$_->[1]} };
  57
  58     has 'stuff' => (is=>'rw', isa=>myDict, coerce=>1);
  59 }
  60
  61 ## Create an object to test
  62
  63 ok my $person = Test::MooseX::Meta::TypeConstraint::Structured::Coerce->new();
  64 isa_ok $person, 'Test::MooseX::Meta::TypeConstraint::Structured::Coerce';## Try out the coercions
  65
  66 ok $person->stuff({name=>"John",age=>25}), 'Set Stuff {name=>"John",age=>25}';
  67 is_deeply $person->stuff, {name=>"John",age=>25}, 'Correct set';
  68
  69 ok $person->stuff(30), 'Set Stuff 30';
  70 is_deeply $person->stuff, {name=>"JohnDoe",age=>30}, 'Correct set';
  71
  72 ok $person->stuff({aname=>{first=>"frank", last=>"herbert"},dob_in_years=>80}),
  73  '{{first=>"frank", last=>"herbert"},80}';
  74
  75 is_deeply $person->stuff, {name=>"frank herbert",age=>80}, 'Correct set';
  76
  77 ok $person->stuff({bname=>{first=>"frankbbb", last=>"herbert"},dob_in_years=>84}),
  78  '{{first=>"frankbbb", last=>"herbert"},84}';
  79
  80 is_deeply $person->stuff, {name=>"frankbbb herbert",age=>84}, 'Correct set';
  81
  82 ok $person->stuff(["mary",40]), 'Set Stuff ["mary",40]';
  83 is_deeply $person->stuff, {name=>"mary",age=>40}, 'Correct set';
  84
  85 ok $person->stuff({fullname=>{first=>"frank", last=>"herbert1"},dob_epoch=>85}),
  86  '{{first=>"frank", last=>"herbert1"},85}';
  87
  88 is_deeply $person->stuff, {name=>"frank herbert1",age=>85}, 'Correct set';
  89
  90 SKIP: {
  91     skip 'deep coercions not yet supported', 2, 1;
  92
  93     ok $person->stuff({fullname=>["frank", "herbert2"],dob_epoch=>86}),
  94      '{fullname=>["frank", "herbert2"],dob_epoch=>86}';
  95
  96     is_deeply $person->stuff, {name=>"frank herbert2",age=>86}, 'Correct set';
  97 }
  98
  99