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

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>

diff --git a/C4/Dates.pm b/C4/Dates.pm
index b70b59e..1064fa4 100644 (file)
--- a/C4/Dates.pm
+++ b/C4/Dates.pm
@@ -26,12 +26,12 @@ use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
 use vars qw($debug $cgi_debug);
 
 BEGIN {
 use vars qw($debug $cgi_debug);
 
 BEGIN {

-       $VERSION = 0.03;
+       $VERSION = 0.04;

        @ISA = qw(Exporter);
        @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');
 sub _prefformat {
     unless (defined $prefformat) {
         $prefformat = C4::Context->preference('dateformat');


@@ -39,13 +39,10 @@ sub _prefformat {
     return $prefformat;
 }
 
     return $prefformat;
 }
 

-# print STDERR " Dates :      \$debug is '$debug'\n";
-# print STDERR " Dates :  \$cgi_debug is '$cgi_debug'\n";
-

 our %format_map = ( 
 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 = (
          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()
 
 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)]',
 );
 
          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 
        ($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
 }
 
        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).
 
 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
 =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";
                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
 
 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"}.
 
 
 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()
 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.
 
 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
 
 =cut
 

diff --git a/t/Dates.t b/t/Dates.t
new file mode 100644 (file)
index 0000000..7bb6788
--- /dev/null
+++ b/t/Dates.t
@@ -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";