1# $Id: create.t,v 1.5 2003/11/25 14:14:22 koschei Exp $ 2use strict; 3use lib 'inc'; 4use blib; 5use Test::More tests => 47; 6use vars qw( $class ); 7 8BEGIN { 9 $class = 'DateTime::Format::Builder'; 10 use_ok $class; 11} 12 13my $should_fail; 14 15my @parsers = ( 16 { 17 params => [ qw( year month day hour minute second ) ], 18 regex => qr/^(\d\d\d\d)(\d\d)(\d\d)T(\d\d)(\d\d)(\d\d)$/, 19 on_fail => sub { ok( $should_fail, "on_fail called for $_[0]" ) }, 20 on_match => sub { ok( !$should_fail, "on_match called for $_[0]" ) }, 21 }, 22 { 23 length => 8, 24 params => [ qw( year month day ) ], 25 regex => qr/^(\d\d\d\d)(\d\d)(\d\d)$/, 26 on_fail => sub { ok( $should_fail, "on_fail called for $_[0]" ) }, 27 on_match => sub { ok( !$should_fail, "on_match called for $_[0]" ) }, 28 }, 29 { 30 length => 13, 31 params => [ qw( year month day hour minute ) ], 32 regex => qr/^(\d\d\d\d)(\d\d)(\d\d)T(\d\d)(\d\d)$/, 33 on_fail => sub { ok( $should_fail, "on_fail called for $_[0]" ) }, 34 on_match => sub { ok( !$should_fail, "on_match called for $_[0]" ) }, 35 }, 36 { 37 length => 11, 38 params => [ qw( year month day hour ) ], 39 regex => qr/^(\d\d\d\d)(\d\d)(\d\d)T(\d\d)$/, 40 on_fail => sub { ok( $should_fail, "on_fail called for $_[0]" ) }, 41 on_match => sub { ok( !$should_fail, "on_match called for $_[0]" ) }, 42 }, 43); 44 45{ 46 my $parser = $class->parser( %{ $parsers[0] } ); 47 isa_ok( $parser => $class ); 48 { 49 $should_fail = 0; 50 my $dt = $parser->parse_datetime( "20030716T163245" ); 51 52 isa_ok( $dt => "DateTime" ); 53 54 my %methods = qw( hour 16 minute 32 second 45 year 2003 month 7 day 16 ); 55 while (my ($method, $expected) = each %methods) 56 { 57 is( $dt->$method() => $expected, "\$dt->$method() == $expected" ); 58 } 59 } 60 { 61 $should_fail = 1; 62 my $dt = eval { $parser->parse_datetime( "20030716T1632456" ) }; 63 ok($@, "Shouldn't've passed or rescued." ); 64 } 65} 66 67{ 68 my $parser = $class->parser( @parsers ); 69 isa_ok( $parser => $class ); 70 my %times = ( 71 '20030716T163245' => {qw( 72 hour 16 minute 32 second 45 year 2003 month 7 day 16 )}, 73 '20030716T1632' => {qw( hour 16 minute 32 year 2003 month 7 day 16 )}, 74 '20030716T16' => {qw( hour 16 year 2003 month 7 day 16 )}, 75 '20030716' => {qw( year 2003 month 7 day 16 )}, 76 ); 77 for my $time (sort keys %times) 78 { 79 $should_fail = 0; 80 my $dt = $parser->parse_datetime( $time ); 81 82 isa_ok( $dt => "DateTime" ); 83 84 while (my ($method, $expected) = each %{ $times{$time} }) 85 { 86 is( $dt->$method() => $expected, "\$dt->$method() == $expected" ); 87 } 88 } 89} 90 91# A class that already has a new 92{ 93 sub ClassHasNew::new { return 'new' } 94 95 eval q[ 96 package ClassHasNew; 97 use DateTime::Format::Builder 98 parsers => { 99 parse_datetime => [ 100 { 101 regex => qr/^(\d{4})(\d\d)(d\d)(\d\d)(\d\d)(\d\d)$/, 102 params => [qw( year month day hour minute second )], 103 }, 104 { 105 regex => qr/^(\d{4})(\d\d)(\d\d)$/, 106 params => [qw( year month day )], 107 }, 108 ], 109 }; 110 ]; 111 ok( !$@, "No errors when creating the class." ); 112 is( ClassHasNew->new, 'new', "Don't overwrite existing new() method" ); 113} 114 115# A class that tries to make a parser called 'new' 116{ 117 sub ClassHasNewMethod::new { return 'new' } 118 119 eval q[ 120 package ClassHasNewMethod; 121 use DateTime::Format::Builder 122 parsers => { 123 new => 124 { 125 regex => qr/^(\d{4})(\d\d)(d\d)(\d\d)(\d\d)(\d\d)$/, 126 params => [qw( year month day hour minute second )], 127 }, 128 }; 129 ]; 130 ok( $@, "Should have errors when creating class." ); 131 like( $@, qr{Will not override a preexisting method}, "No overriding new with parser" ); 132 is( ClassHasNewMethod->new, 'new', "Don't overwrite existing new() method" ); 133} 134 135# A class that tries to override an existing 'new' 136{ 137 sub ClassHasNewOver::new { return 'new' } 138 139 eval q[ 140 package ClassHasNewOver; 141 use DateTime::Format::Builder 142 constructor => 1, 143 parsers => { 144 parse_datetime => 145 { 146 regex => qr/^(\d{4})(\d\d)(d\d)(\d\d)(\d\d)(\d\d)$/, 147 params => [qw( year month day hour minute second )], 148 }, 149 }; 150 ]; 151 ok( $@, "Should have errors when creating class." ); 152 like( $@, qr{Will not override a preexisting constructor}, "No override new by intention" ); 153 is( ClassHasNewOver->new, 'new', "Don't overwrite existing new() method" ); 154} 155