1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
|
use strict;
use warnings;
use Test::More;
BEGIN {
plan skip_all => "DateTime::Format::DateManip required" unless eval { require DateTime::Format::DateManip };
plan tests => 28;
}
use Test::Exception;
use DateTime;
use ok 'MooseX::Types::DateTime::MoreCoercions';
=head1 NAME
t/02_datetimex.t - Check that we can properly coerce a string.
=head1 DESCRIPTION
Run some tests to make sure the the Duration and DateTime types continue to
work exactly as from the L<MooseX::Types::DateTime> class, as well as perform
the correct string to object coercions.
=head1 TESTS
This module defines the following tests.
=head2 Test Class
Create a L<Moose> class that is using the L<MooseX::Types::DateTime::MoreCoercions> types.
=cut
{
package MooseX::Types::DateTime::MoreCoercions::CoercionTest;
use Moose;
use MooseX::Types::DateTime::MoreCoercions qw(DateTime Duration);
has 'date' => (is=>'rw', isa=>DateTime, coerce=>1);
has 'duration' => (is=>'rw', isa=>Duration, coerce=>1);
}
ok my $class = MooseX::Types::DateTime::MoreCoercions::CoercionTest->new
=> 'Created a good class';
=head2 ParseDateTime Capabilities
parse some dates and make sure the system can actually find something.
=cut
sub coerce_ok ($;$) {
my ( $date, $canon ) = @_;
local $Test::Builder::Level = $Test::Builder::Level + 1;
SKIP: {
skip "DateTimeX::Easy couldn't parse '$date'", $canon ? 2 : 1 unless DateTimeX::Easy->new($date);
ok( $class->date($date), "coerced a DateTime from '$date'" );
is( $class->date, $canon, 'got correct date' ) if $canon;
}
}
## Skip this test until I can figure out better timezone handling
#coerce_ok ('2/13/1969 noon', '1969-02-13T11:00:00' );
coerce_ok( '2/13/1969', '1969-02-13T00:00:00' );
coerce_ok( '2/13/1969 America/New_York', '1969-02-13T00:00:00' );
SKIP: {
skip "couldn't parse", 1 unless $class->date;
isa_ok $class->date->time_zone => 'DateTime::TimeZone::America::New_York'
=> 'Got Correct America/New_York TimeZone';
}
coerce_ok( 'jan 1 2006', '2006-01-01T00:00:00' );
=head2 relative dates
Stuff like "yesterday". We can make sure they returned something but we have
no way to make sure the values are really correct. Manual testing suggests
they work well enough, given the inherent ambiguity we are dealing with.
=cut
coerce_ok("now");
coerce_ok("yesterday");
coerce_ok("tomorrow");
coerce_ok("last week");
=head2 check inherited constraints
Just a few tests to make sure the object, hash, etc coercions and type checks
still work.
=cut
ok my $datetime = DateTime->now()
=> 'Create a datetime object for testing';
ok my $anyobject = bless({}, 'Bogus::Does::Not::Exist')
=> 'Created a random object for proving the object constraint';
ok $class->date($datetime)
=> 'Passed Object type constraint test.';
isa_ok $class->date => 'DateTime'
=> 'Got a good DateTime Object';
dies_ok { $class->date($anyobject) } 'Does not allow the bad object';
ok $class->date(1000)
=> 'Passed Num coercion test.';
isa_ok $class->date => 'DateTime'
=> 'Got a good DateTime Object';
is $class->date => '1970-01-01T00:16:40'
=> 'Got correct DateTime';
ok $class->date({year=>2000,month=>1,day=>10})
=> 'Passed HashRef coercion test.';
isa_ok $class->date => 'DateTime'
=> 'Got a good DateTime Object';
is $class->date => '2000-01-10T00:00:00'
=> 'Got correct DateTime';
=head2 check duration
make sure the Duration type constraint works as expected
=cut
ok $class->duration(100)
=> 'got duration from integer';
is $class->duration->seconds, 100
=> 'got correct duration from integer';
ok $class->duration('1 minute')
=> 'got duration from string';
is $class->duration->seconds, 60
=> 'got correct duration string';
=head1 AUTHOR
John Napiorkowski E<lt>jjn1056 at yahoo.comE<gt>
=head1 COPYRIGHT
Copyright (c) 2008 John Napiorkowski. All rights reserved
This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.
=cut
1;
|
