t/07-coerce.t

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