1#!/usr/bin/env perl 2use strict; 3use warnings; 4use 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 73my $date = Date->new(year => 2001, month => 1, day => 1); 74my $str = $date->to_string; 75is $str, "2001-01-01", "initial date is correct: $str"; 76 77my $event = Event->new(date => $date); 78 79$str = $event->date->to_string; 80is $str, "2001-01-01", "initial date field correct: $str"; 81 82# check the order is applied correctly when given an Int 83my $timestamp = 1238778317; # Fri Apr 3 17:05:17 2009 84$event->date($timestamp); 85 86$str = $event->date->to_string; 87is $str, "2009-04-03", "coerced timestamp $timestamp to date field $str correctly"; 88 89