t/001_mouse/049-coercion-application-order.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use Test::More tests => 3;
   5
   6 # this tests that multiple type coercions on a given attribute get
   7 # applied in the expected order.
   8
   9 {
  10     package Date;
  11     use Mouse;
  12     # This is just a simple class representing a date - in real life we'd use DateTime.
  13
  14     has 'year' =>
  15         (is => 'rw',
  16          isa => 'Int');
  17     has 'month' =>
  18         (is => 'rw',
  19          isa => 'Int');
  20     has 'day' =>
  21         (is => 'rw',
  22          isa => 'Int');
  23
  24     sub from_epoch
  25     {
  26         my $class = shift;
  27         my %d; @d{qw(year month day)} = (gmtime shift)[5,4,3];
  28         $d{year} += 1900;
  29         $d{month} += 1;
  30         Date->new(%d);
  31     }
  32
  33     sub from_string
  34     {
  35         my $class = shift;
  36         my %d; @d{qw(year month day)} = split /\W/, shift;
  37         Date->new(%d);
  38     }
  39
  40
  41     sub to_string
  42     {
  43         my $self = shift;
  44         sprintf "%4d-%02d-%02d",
  45             $self->year,
  46             $self->month,
  47             $self->day
  48     }
  49
  50     package Event;
  51     use Mouse;
  52     use Mouse::Util::TypeConstraints;
  53
  54     # These coercions must be applied in the right order - since a
  55     # number can be interpreted as a string, but not vice-versa, the
  56     # Int coercion should be applied first to get a correct answer.
  57     coerce 'Date'
  58         => from 'Int' # a timestamp
  59             => via { Date->from_epoch($_) }
  60
  61         => from 'Str' # <YYYY>-<MM>-<DD>
  62             => via { Date->from_string($_) };
  63
  64
  65
  66     has date =>
  67         (is => 'rw',
  68          isa => 'Date',
  69          coerce => 1);
  70
  71 }
  72
  73 my $date = Date->new(year => 2001, month => 1, day => 1);
  74 my $str = $date->to_string;
  75 is $str, "2001-01-01", "initial date is correct: $str";
  76
  77 my $event = Event->new(date => $date);
  78
  79 $str = $event->date->to_string;
  80 is $str, "2001-01-01", "initial date field correct: $str";
  81
  82 # check the order is applied correctly when given an Int
  83 my $timestamp = 1238778317; # Fri Apr  3 17:05:17 2009
  84 $event->date($timestamp);
  85
  86 $str = $event->date->to_string;
  87 is $str, "2009-04-03", "coerced timestamp $timestamp to date field $str correctly";
  88