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 |
- |