t/08-examples.t

   1 BEGIN {
   2         use strict;
   3         use warnings;
   4         use Test::More;
   5
   6     eval "use MooseX::Types::DateTime";
   7     plan $@
   8         ? ( skip_all => "Tests require MooseX::Types::DateTime" )
   9         : ( tests => 10 );
  10 }
  11
  12 {
  13         ## Normalize a HashRef
  14     package Test::MooseX::Meta::TypeConstraint::Structured::Examples::Normalize;
  15
  16     use Moose;
  17         use DateTime;
  18     use MooseX::Types::Structured qw(Dict Tuple);
  19         use MooseX::Types::DateTime qw(DateTime);
  20         use MooseX::Types::Moose qw(Int Str Object ArrayRef HashRef);
  21         use MooseX::Types -declare => [qw(
  22         Name Age Person FullName
  23
  24     )];
  25
  26         ## So that our test works, we'll set Now to 2008.
  27         sub Now {
  28                 return 'DateTime'->new(year=>2008);
  29         }
  30
  31         subtype FullName,
  32          as Dict[last=>Str, first=>Str];
  33
  34     subtype Person,
  35          as Dict[name=>Str, age=>Int];
  36
  37         coerce Person,
  38          from Dict[first=>Str, last=>Str, years=>Int],
  39          via { +{
  40                 name => "$_->{first} $_->{last}",
  41                 age=>$_->{years},
  42          }},
  43          from Dict[fullname=>FullName, dob=>DateTime],
  44          via { +{
  45                 name => "$_->{fullname}{first} $_->{fullname}{last}",
  46                 age => ($_->{dob} - Now)->years,
  47          }};
  48
  49         has person => (is=>'rw', isa=>Person, coerce=>1);
  50 }
  51
  52 NORMALIZE: {
  53         ok my $normalize = Test::MooseX::Meta::TypeConstraint::Structured::Examples::Normalize->new();
  54         isa_ok $normalize, 'Test::MooseX::Meta::TypeConstraint::Structured::Examples::Normalize';
  55
  56         ok $normalize->person({name=>'John', age=>25})
  57          => 'Set value';
  58
  59         is_deeply $normalize->person, {name=>'John', age=>25}
  60          => 'Value is correct';
  61
  62         ok $normalize->person({first=>'John', last=>'Napiorkowski', years=>35})
  63          => 'Set value';
  64
  65         is_deeply $normalize->person, {name=>'John Napiorkowski', age=>35}
  66          => 'Value is correct';
  67
  68         ok $normalize->person({years=>36, last=>'Napiorkowski', first=>'John'})
  69          => 'Set value';
  70
  71         is_deeply $normalize->person, {name=>'John Napiorkowski', age=>36}
  72          => 'Value is correct';
  73
  74         ok $normalize->person({fullname=>{first=>'Vanessa', last=>'Li'}, dob=>DateTime->new(year=>1974)})
  75          => 'Set value';
  76
  77         is_deeply $normalize->person, {name=>'Vanessa Li', age=>34}
  78          => 'Value is correct';
  79 }