|
Lines 1-147
Link Here
|
| 1 |
#!/usr/bin/perl |
|
|
| 2 |
|
| 3 |
use strict; |
| 4 |
use warnings; |
| 5 |
|
| 6 |
use Test::More tests => 327; |
| 7 |
use Test::Warn; |
| 8 |
|
| 9 |
BEGIN { |
| 10 |
use FindBin; |
| 11 |
use lib $FindBin::Bin; |
| 12 |
use_ok( 'C4::Dates', qw(format_date format_date_in_iso) ); |
| 13 |
} |
| 14 |
|
| 15 |
sub isBadDate { |
| 16 |
my ($tdate,$tformat) = @_; |
| 17 |
my $retval = 0; |
| 18 |
if (index('iso,us,metric',$tformat)>=0) { |
| 19 |
if ($tdate =~ /^00*-/ || $tdate =~ /-00*-/ || |
| 20 |
$tdate =~ /-00*$/ || $tdate =~ /-00* /) { |
| 21 |
|
| 22 |
$retval = 1; |
| 23 |
} |
| 24 |
} |
| 25 |
elsif ($tformat eq 'sql') { |
| 26 |
if ($tdate =~ /^0000/ || $tdate =~ /^....00/ || |
| 27 |
$tdate =~ /^......00/) { |
| 28 |
|
| 29 |
$retval = 1; |
| 30 |
} |
| 31 |
} |
| 32 |
return $retval; |
| 33 |
} |
| 34 |
|
| 35 |
sub describe ($$) { |
| 36 |
my $front = sprintf( "%-25s", shift ); |
| 37 |
my $tail = shift || 'FAILED'; |
| 38 |
return "$front : $tail"; |
| 39 |
} |
| 40 |
|
| 41 |
# Keep the number of test elements per [array] equal or the predicted number of tests |
| 42 |
# needs to be different for different (fake) sysprefs. |
| 43 |
my %thash = ( |
| 44 |
iso => [ '2001-1-1', '1989-9-21', '1952-1-0', '1989-9-21 13:46:02', '2001-01-01', '1989-09-21', '1952-01-00', '1989-09-21 13:46:02' ], |
| 45 |
metric => [ "1-1-2001", '21-9-1989', '00-1-1952', '21-9-1989 13:46:02', "01-01-2001", '21-09-1989', '00-01-1952', '21-09-1989 13:46:02' ], |
| 46 |
us => [ "01-01-2001", '09-21-1989', '01-00-1952', '09-21-1989 13:46:02' ], |
| 47 |
sql => [ '20010101 010101', '19890921 143907', '19520100 000000', '19890921 134602' ], |
| 48 |
rfc822 => [ 'Wed, 02 Oct 2002 15:00:00 +0200', 'Fri, 10 Sep 2010 08:00:00 +0500' ], |
| 49 |
); |
| 50 |
|
| 51 |
my ( $date, $format, $today, $today0, $val, $re, $syspref ); |
| 52 |
my @formats = sort keys %thash; |
| 53 |
my $fake_syspref_default = 'us'; |
| 54 |
my $fake_syspref = (@ARGV) ? shift : $ENV{KOHA_TEST_DATE_FORMAT}; |
| 55 |
if ($fake_syspref) { |
| 56 |
diag "You asked for date format '$fake_syspref'."; |
| 57 |
unless ( scalar grep { /^$fake_syspref$/ } @formats ) { |
| 58 |
diag "Warning: Unkown date format '$fake_syspref', reverting to default '$fake_syspref_default'."; |
| 59 |
$fake_syspref = $fake_syspref_default; |
| 60 |
} |
| 61 |
} |
| 62 |
$fake_syspref or $fake_syspref = $fake_syspref_default; |
| 63 |
$C4::Dates::prefformat = $fake_syspref; # So Dates doesn't have to ask the DB anything. |
| 64 |
|
| 65 |
print <<EndOfDiag; |
| 66 |
|
| 67 |
In order to run without DB access, this test will substitute |
| 68 |
'$fake_syspref' as your default date format. Export |
| 69 |
environmental variable KOHA_TEST_DATE_FORMAT to override this |
| 70 |
default, or pass the value as an argument to this test script. |
| 71 |
|
| 72 |
NOTE: we test for the system handling dd=00 and 00 for TIME |
| 73 |
values, but you should not see any warnings. |
| 74 |
|
| 75 |
EndOfDiag |
| 76 |
|
| 77 |
# Testing Legacy Functions: format_date and format_date_in_iso |
| 78 |
ok( $syspref = C4::Dates->new->format(), "Your system preference is: $syspref" ); |
| 79 |
foreach ( @{ $thash{'iso'} } ) { |
| 80 |
if (isBadDate($_,'iso')==1) { |
| 81 |
warning_like { $val = format_date($_); } qr/Illegal date/, |
| 82 |
"format_date('$_'): Warning as expected"; |
| 83 |
} |
| 84 |
else { |
| 85 |
ok( $val = format_date($_), "format_date('$_'): $val" ); |
| 86 |
} |
| 87 |
} |
| 88 |
foreach ( @{ $thash{$syspref} } ) { |
| 89 |
if (isBadDate($_,$syspref)==1) { |
| 90 |
warning_like { $val = format_date_in_iso($_); } qr/Illegal date/, |
| 91 |
"format_date_in_iso('$_'): Warning as expected"; |
| 92 |
} |
| 93 |
else { |
| 94 |
ok( $val = format_date_in_iso($_), "format_date_in_iso('$_'): $val" ); |
| 95 |
} |
| 96 |
} |
| 97 |
ok( $today0 = C4::Dates->today(), "(default) CLASS ->today : $today0" ); |
| 98 |
#diag "Testing " . scalar(@formats) . " formats.\nTesting no input (defaults):"; |
| 99 |
foreach (@formats) { |
| 100 |
my $pre = sprintf '(%-6s)', $_; |
| 101 |
ok( $date = C4::Dates->new(), "$pre Date Creation : new()" ); |
| 102 |
ok( $_ eq ( $format = $date->format($_) ), "$pre format($_) : " . ( $format || 'FAILED' ) ); |
| 103 |
ok( $format = $date->visual(), "$pre visual() : " . ( $format || 'FAILED' ) ); |
| 104 |
ok( $today = $date->output(), "$pre output() : " . ( $today || 'FAILED' ) ); |
| 105 |
ok( $today = $date->today(), "$pre object->today : " . ( $today || 'FAILED' ) ); |
| 106 |
} |
| 107 |
|
| 108 |
#diag "Testing with valid inputs:"; |
| 109 |
foreach $format (@formats) { |
| 110 |
my $pre = sprintf '(%-6s)', $format; |
| 111 |
foreach my $testval ( @{ $thash{$format} } ) { |
| 112 |
if (isBadDate($testval,$format)==1) { |
| 113 |
warning_like { $date = C4::Dates->new( $testval, $format ) } |
| 114 |
qr/Illegal date/, |
| 115 |
"$pre Date Creation : new('$testval','$format') -- Warning as expected."; |
| 116 |
} |
| 117 |
else { |
| 118 |
ok( $date = C4::Dates->new( $testval, $format ), "$pre Date Creation : new('$testval','$format')" ); |
| 119 |
} |
| 120 |
ok( $re = $date->regexp, "$pre has regexp()" ); |
| 121 |
ok( $testval =~ /^$re$/, "$pre has regexp() match $testval" ); |
| 122 |
ok( $val = $date->output(), describe( "$pre output()", $val ) ); |
| 123 |
SKIP: { |
| 124 |
skip( "special case with explicit regexp('syspref') because $format isn't $syspref", 1 ) unless ( $format eq $syspref ); |
| 125 |
my $re_syspref = C4::Dates->regexp('syspref'); |
| 126 |
ok( $testval =~ /^$re_syspref$/, "$pre has regexp('syspref') match $testval" ); |
| 127 |
} |
| 128 |
foreach ( grep { !/$format/ } @formats ) { |
| 129 |
ok( $today = $date->output($_), describe( sprintf( "$pre output(%8s)", "'$_'" ), $today ) ); |
| 130 |
} |
| 131 |
ok( $today = $date->today(), describe( "$pre object->today", $today ) ); |
| 132 |
|
| 133 |
# ok($today == ($today = C4::Dates->today()), "$pre CLASS ->today : $today" ); |
| 134 |
ok( $val = $date->output(), describe( "$pre output()", $val ) ); |
| 135 |
|
| 136 |
# ok($format eq ($format = $date->format()), "$pre format() : $format" ); |
| 137 |
} |
| 138 |
} |
| 139 |
|
| 140 |
#diag "Testing object independence from class"; |
| 141 |
my $in1 = '12/25/1952'; # us |
| 142 |
my $in2 = '13/01/2001'; # metric |
| 143 |
my $d1 = C4::Dates->new( $in1, 'us' ); |
| 144 |
my $d2 = C4::Dates->new( $in2, 'metric' ); |
| 145 |
my $out1 = $d1->output('iso'); |
| 146 |
my $out2 = $d2->output('iso'); |
| 147 |
ok( $out1 ne $out2, "subsequent constructors get different dataspace ($out1 != $out2)" ); |
| 148 |
- |