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 }