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