Koha-community/Koha
13
7
Fork 0
Code Issues Releases Wiki Activity

Dates expanding to expose some time (HH:MM:SS) granularity.

Browse source 
t/Dates.t is essentially restored from its previous state with
the revision that it now does not use C4::Context or check syspref
for the default date format.  Instead it sets the C4::Dates default
directly, taking cue from command line argument or ENV.  ISO format
revised to accept "T" separator and "Z" (zulu) terminator. POD
expanded and corrected.

Signed-off-by: Galen Charlton <galen.charlton@liblime.com>
This commit is contained in:
Joe Atzberger 2008-09-18 19:02:48 -05:00 committed by Galen Charlton
parent e5adbdcbd1
commit 4e50585926
2 changed files with 124 additions and 19 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

41
C4/Dates.pm
View file

@ -26,12 +26,12 @@ use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
use vars qw($debug $cgi_debug);
BEGIN {
$VERSION = 0.03;
$VERSION = 0.04;
@ISA = qw(Exporter);
@EXPORT_OK = qw(DHTMLcalendar format_date_in_iso format_date);
@EXPORT_OK = qw(format_date_in_iso format_date);
}
my $prefformat;
use vars qw($prefformat);
sub _prefformat {
unless (defined $prefformat) {
$prefformat = C4::Context->preference('dateformat');
@ -39,13 +39,10 @@ sub _prefformat {
return $prefformat;
}
# print STDERR " Dates : \$debug is '$debug'\n";
# print STDERR " Dates : \$cgi_debug is '$cgi_debug'\n";
our %format_map = (
iso => 'yyyy-mm-dd',
metric => 'dd/mm/yyyy',
us => 'mm/dd/yyyy',
iso => 'yyyy-mm-dd', # plus " HH:MM:SS"
metric => 'dd/mm/yyyy', # plus " HH:MM:SS"
us => 'mm/dd/yyyy', # plus " HH:MM:SS"
sql => 'yyyymmdd HHMMSS',
);
our %posix_map = (
@ -57,9 +54,9 @@ our %posix_map = (
our %dmy_subs = ( # strings to eval (after using regular expression returned by regexp below)
# make arrays for POSIX::strftime()
iso => '[(0,0,0,$3, $2 - 1, $1 - 1900)]',
metric => '[(0,0,0,$1, $2 - 1, $3 - 1900)]',
us => '[(0,0,0,$2, $1 - 1, $3 - 1900)]',
iso => '[(($6||0),($5||0),($4||0),$3, $2 - 1, $1 - 1900)]',
metric => '[(($6||0),($5||0),($4||0),$1, $2 - 1, $3 - 1900)]',
us => '[(($6||0),($5||0),($4||0),$2, $1 - 1, $3 - 1900)]',
sql => '[(($6||0),($5||0),($4||0),$3, $2 - 1, $1 - 1900)]',
);
@ -70,7 +67,7 @@ sub regexp ($;$) {
($format eq 'sql') and
return qr/^(\d{4})(\d{2})(\d{2})(?:\s{4}(\d{2})(\d{2})(\d{2}))?/;
($format eq 'iso') and
return qr/^(\d{4})$delim(\d{2})$delim(\d{2})(?:\s{1}(\d{2})\:?(\d{2})\:?(\d{2}))?/;
return qr/^(\d{4})$delim(\d{2})$delim(\d{2})(?:(?:\s{1}|T)(\d{2})\:?(\d{2})\:?(\d{2}))?Z?/;
return qr/^(\d{2})$delim(\d{2})$delim(\d{4})(?:\s{1}(\d{2})\:?(\d{2})\:?(\d{2}))?/; # everything else
}
@ -185,6 +182,12 @@ the script level, for example in initial form values or checks for min/max date.
reason is clear when you consider string '07/01/2004'. Depending on the format, it
represents July 1st (us), or January 7th (metric), or an invalid value (iso).
The formats supported by Koha are:
iso - ISO 8601 (extended)
us - U.S. standard
metric - European standard (slight misnomer, not really decimalized metric)
sql - log format, not really for human consumption
=head2 ->new([string_date,][date_format])
Arguments to new() are optional. If string_date is not supplied, the present system date is
@ -204,7 +207,7 @@ invoked when displaying it.
my $date = C4::Dates->new(); # say today is July 12th, 2010
print $date->output("iso"); # prints "2010-07-12"
print "\n";
print $date->output("metric"); # prints "12-07-2007"
print $date->output("metric"); # prints "12-07-2010"
However, it is still necessary to know the format of any incoming date value (e.g.,
setting the value of an object with new()). Like new(), output() assumes the system preference
@ -291,11 +294,6 @@ To validate before creating a new object, use the regexp method of the class:
More verbose debugging messages are sent in the presence of non-zero $ENV{"DEBUG"}.
=head3 TO DO
If the date format is not in <systempreference>, we should send an error back to the user.
This kind of check should be centralized somewhere. Probably not here, though.
Notes: if the date in the db is null or empty, interpret null expiration to mean "never expires".
=head3 _prefformat()
@ -309,5 +307,10 @@ specifically, doing a call to C4::Context->preference() during
module initialization. That way, C4::Dates no longer has a
compile-time dependency on having a valid $dbh.
=head3 TO DO
If the date format is not in <systempreference>, we should send an error back to the user.
This kind of check should be centralized somewhere. Probably not here, though.
=cut

102
t/Dates.t Normal file
View file

@ -0,0 +1,102 @@
#!/usr/bin/perl
use strict;
use warnings;
use Test::More tests => 126;
BEGIN {
use FindBin;
use lib $FindBin::Bin;
use_ok('C4::Dates', qw(format_date format_date_in_iso));
}
sub describe ($$) {
my $front = sprintf("%-25s", shift);
my $tail = shift || 'FAILED';
return "$front : $tail";
}
my %thash = (
iso => ['2001-01-01','1989-09-21','1952-01-00', '1989-09-21 13:46:02'],
metric => ["01-01-2001",'21-09-1989','00-01-1952'],
us => ["01-01-2001",'09-21-1989','01-00-1952'],
sql => ['20010101 010101',
'19890921 143907',
'19520100 000000' ],
);
my ($date, $format, $today, $today0, $val, $re, $syspref);
my @formats = sort keys %thash;
my $fake_syspref_default = 'us';
my $fake_syspref = (@ARGV) ? shift : $ENV{KOHA_TEST_DATE_FORMAT};
if ($fake_syspref) {
diag "You asked for date format '$fake_syspref'.";
unless (scalar grep {/^$fake_syspref$/} @formats) {
diag "Warning: Unkown date format '$fake_syspref', reverting to default '$fake_syspref_default'.";
$fake_syspref = $fake_syspref_default;
}
}
$fake_syspref or $fake_syspref = $fake_syspref_default;
$C4::Dates::prefformat = $fake_syspref; # So Dates doesn't have to ask the DB anything.
diag <<EndOfDiag;
In order to run without DB access, this test will substitute '$fake_syspref'
as your default date format. Export environmental variable KOHA_TEST_DATE_FORMAT
to override this default, or pass the value as an argument to this test script.
NOTE: we test for the system handling dd=00 and 00 for TIME values,
therefore you *should* see some warnings 'Illegal date specified' related to those.
Testing Legacy Functions: format_date and format_date_in_iso
EndOfDiag
ok($syspref = C4::Dates->new->format(), "Your system preference is: $syspref");
print "\n";
foreach (@{$thash{'iso'}}) {
ok($val = format_date($_), "format_date('$_'): $val" );
}
foreach (@{$thash{$syspref}}) {
ok($val = format_date_in_iso($_), "format_date_in_iso('$_'): $val" );
}
ok($today0 = C4::Dates->today(), "(default) CLASS ->today : $today0" );
diag "\nTesting " . scalar(@formats) . " formats.\nTesting no input (defaults):\n";
print "\n";
foreach (@formats) {
my $pre = sprintf '(%-6s)', $_;
ok($date = C4::Dates->new(), "$pre Date Creation : new()");
ok($_ eq ($format = $date->format($_)), "$pre format($_) : " . ($format|| 'FAILED') );
ok($format = $date->visual(), "$pre visual() : " . ($format|| 'FAILED') );
ok($today = $date->output(), "$pre output() : " . ($today || 'FAILED') );
ok($today = $date->today(), "$pre object->today : " . ($today || 'FAILED') );
print "\n";
}
diag "\nTesting with valid inputs:\n";
foreach $format (@formats) {
my $pre = sprintf '(%-6s)', $format;
foreach my $testval (@{$thash{ $format }}) {
ok($date = C4::Dates->new($testval,$format), "$pre Date Creation : new('$testval','$format')");
ok($re = $date->regexp, "$pre has regexp()" );
ok($val = $date->output(), describe("$pre output()", $val) );
foreach (grep {!/$format/} @formats) {
ok($today = $date->output($_), describe(sprintf("$pre output(%8s)","'$_'"), $today) );
}
ok($today = $date->today(), describe("$pre object->today", $today) );
# ok($today == ($today = C4::Dates->today()), "$pre CLASS ->today : $today" );
ok($val = $date->output(), describe("$pre output()", $val) );
# ok($format eq ($format = $date->format()), "$pre format() : $format" );
print "\n";
}
}
diag "\nTesting object independence from class\n";
my $in1 = '12/25/1952'; # us
my $in2 = '13/01/2001'; # metric
my $d1 = C4::Dates->new($in1, 'us');
my $d2 = C4::Dates->new($in2, 'metric');
my $out1 = $d1->output('iso');
my $out2 = $d2->output('iso');
ok($out1 ne $out2, "subsequent constructors get different dataspace ($out1 != $out2)");
diag "done.\n";