t/02_datetimex.t

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