t/01_basic.t

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