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
  59     SKIP: {
  60         skip "DateTimeX::Easy couldn't parse '$date'", $canon ? 2 : 1 unless DateTimeX::Easy->new($date);
  61         ok( $class->date($date), "coerced a DateTime from '$date'" );
  62         is( $class->date, $canon, 'got correct date' ) if $canon;
  63     }
  64 }
  65
  66 coerce_ok ('2/13/1969 noon', '1969-02-13T12:00:00' );
  67
  68
  69 coerce_ok( '2/13/1969', '1969-02-13T00:00:00' );
  70
  71 coerce_ok( '2/13/1969 America/New_York', '1969-02-13T00:00:00' );
  72
  73 SKIP: {
  74     skip "couldn't parse", 1 unless $class->date;
  75     isa_ok $class->date->time_zone => 'DateTime::TimeZone::America::New_York'
  76         => 'Got Correct America/New_York TimeZone';
  77 }
  78
  79 coerce_ok( 'jan 1 2006', '2006-01-01T00:00:00' );
  80
  81 =head2 relative dates
  82
  83 Stuff like "yesterday".  We can make sure they returned something but we have
  84 no way to make sure the values are really correct.  Manual testing suggests
  85 they work well enough, given the inherent ambiguity we are dealing with.
  86
  87 =cut
  88
  89 coerce_ok("now");
  90
  91 coerce_ok("yesterday");
  92
  93 coerce_ok("tomorrow");
  94
  95 coerce_ok("last week");
  96
  97 =head2 check inherited constraints
  98
  99 Just a few tests to make sure the object, hash, etc coercions and type checks
 100 still work.
 101
 102 =cut
 103
 104 ok my $datetime = DateTime->now()
 105 => 'Create a datetime object for testing';
 106
 107 ok my $anyobject = bless({}, 'Bogus::Does::Not::Exist')
 108 => 'Created a random object for proving the object constraint';
 109
 110 ok $class->date($datetime)
 111 => 'Passed Object type constraint test.';
 112
 113         isa_ok $class->date => 'DateTime'
 114         => 'Got a good DateTime Object';
 115
 116 dies_ok { $class->date($anyobject) } 'Does not allow the bad object';
 117
 118 ok $class->date(1000)
 119 => 'Passed Num coercion test.';
 120
 121         isa_ok $class->date => 'DateTime'
 122         => 'Got a good DateTime Object';
 123
 124         is $class->date => '1970-01-01T00:16:40'
 125         => 'Got correct DateTime';
 126
 127 ok $class->date({year=>2000,month=>1,day=>10})
 128 => 'Passed HashRef coercion test.';
 129
 130         isa_ok $class->date => 'DateTime'
 131         => 'Got a good DateTime Object';
 132
 133         is $class->date => '2000-01-10T00:00:00'
 134         => 'Got correct DateTime';
 135
 136 =head2 check duration
 137
 138 make sure the Duration type constraint works as expected
 139
 140 =cut
 141
 142 ok $class->duration(100)
 143 => 'got duration from integer';
 144
 145         is $class->duration->seconds, 100
 146         => 'got correct duration from integer';
 147
 148
 149 ok $class->duration('1 minute')
 150 => 'got duration from string';
 151
 152         is $class->duration->seconds, 60
 153         => 'got correct duration string';
 154
 155
 156 =head1 AUTHOR
 157
 158 John Napiorkowski E<lt>jjn1056 at yahoo.comE<gt>
 159
 160 =head1 COPYRIGHT
 161
 162         Copyright (c) 2008 John Napiorkowski. All rights reserved
 163         This program is free software; you can redistribute
 164         it and/or modify it under the same terms as Perl itself.
 165
 166 =cut
 167
 168 1;
 169