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');
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 = (
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)]',
);
($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
}
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
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
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()
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
--- /dev/null
+#!/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";