Commit | Line | Data |
792f7518 |
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 | |