From cd967a2db1f4aca990756ed549f42069189296ce Mon Sep 17 00:00:00 2001 From: Joe Atzberger Date: Mon, 8 Oct 2007 15:36:11 -0500 Subject: [PATCH] New object-oriented date module to soon replace Date.pm. Also included is a traditional perl (t/Dates.t) test script. Signed-off-by: Chris Cormack Signed-off-by: Joshua Ferraro --- C4/Dates.pm | 244 ++++++++++++++++++++++++++++++++++++++++++++++++++++ t/Dates.t | 49 +++++++++++ 2 files changed, 293 insertions(+) create mode 100644 C4/Dates.pm create mode 100755 t/Dates.t diff --git a/C4/Dates.pm b/C4/Dates.pm new file mode 100644 index 0000000000..67430c9a04 --- /dev/null +++ b/C4/Dates.pm @@ -0,0 +1,244 @@ +package C4::Dates; +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 2 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along with +# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, +# Suite 330, Boston, MA 02111-1307 USA + +use strict; +use warnings; +use Carp; +use C4::Context; +use Exporter; +use POSIX qw(strftime); +use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); + +$VERSION = 0.03; +@ISA = qw(Exporter); +@EXPORT_OK = qw(DHTMLcalendar); + +my $prefformat = C4::Context->preference('dateformat'); +my $debug = $ENV{'DEBUG'} || 0; + +our @dmy_array = (); + +our %format_map = ( + iso => 'yyyy-mm-dd', + metric => 'dd/mm/yyyy', + us => 'mm/dd/yyyy', + sql => 'yyyymmdd HHMMSS', +); +our %posix_map = ( + iso => '%Y-%m-%d', # or %F, "Full Date" + metric => '%d/%m/%Y', + us => '%m/%d/%Y', + sql => '%Y%m%d %H%M%S', +); + +our %dmy_subs = ( # strings to eval (after using regular expression returned by regexp below) + # make arrayrs 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)]', + sql => '[(($6||0),($5||0),($4||0),$3, $2 - 1, $1 - 1900)]', +); + +sub regexp ($;$) { + my $self = shift; + my $delim = qr/:?\:|\/|-/; # "non memory" cluster: no backreference + my $format = (@_) ? shift : $self->{'dateformat'}; # w/o arg. relies on dateformat being defined + ($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{2})$delim(\d{2})$delim(\d{4})(?:\s{1}(\d{2})\:?(\d{2})\:?(\d{2}))?/; # everything else +} + +sub dmy_map ($$) { + my $self = shift; + my $val = shift or return undef; + my $dformat = $self->{'dateformat'} or return undef; + my $re = $self->regexp(); + my $xsub = $dmy_subs{$dformat}; + $debug and print STDERR "xsub: $xsub \n"; + if ($val =~ /$re/) { + my $aref = eval $xsub; + return @{$aref}; + } + $debug and carp "Illegal Date '$val' does not match $dformat format: $re\n"; + return 0; +} + +sub new { + my $this = shift; + my $class = ref($this) || $this; + my $self = {}; + bless $self, $class; + return $self->init(@_); +} +sub init ($;$$) { + my $self = shift; + my $dformat; + $self->{'dateformat'} = $dformat = (scalar(@_) >= 2) ? $_[1] : $prefformat; + ($format_map{$dformat}) or croak + "Invalid date format '$dformat' from " . ((scalar(@_) >= 2) ? 'argument' : 'system preferences'); + # scalar(@self::dmy_array) and croak "\$self is " . ref($self) . "\n\@self::dmy_array already populated: @self::dmy_array"; + @self::dmy_array = ((@_) ? $self->dmy_map(shift) : localtime); + $debug and print STDERR "(during init) \@self::dmy_array = (@self::dmy_array)\n"; #debug + return $self; +} +sub output ($;$) { + my $self = shift; + my $newformat = (@_) ? _recognize_format(shift) : $self->{'dateformat'} ; + return POSIX::strftime($posix_map{$newformat}, @self::dmy_array); +} +sub today ($;$) { # NOTE: sets date value to today (and returns it in the requested or current format) + my $class = shift; + $class = ref($class) || $class; + my $format = (@_) ? _recognize_format(shift) : $prefformat; + return $class->new()->output($format); +} +sub _recognize_format($) { + my $incoming = shift; + ($incoming eq 'syspref') and return $prefformat; + (scalar grep (/^$incoming$/, keys %format_map) == 1) or croak "The format you asked for ('$incoming') in unrecognized."; + return $incoming; +} +sub DHTMLcalendar ($;$) { # interface to posix_map + my $class = shift; + my $format = (@_) ? shift : $prefformat; + return $posix_map{$format}; +} +sub format { # get or set dateformat: iso, metric, us, etc. + my $self = shift; + (@_) or return $self->{'dateformat'}; + $self->{'dateformat'} = _recognize_format(shift); +} +sub visual { + my $self = shift; + if (@_) { + return $format_map{ shift }; + } + return $format_map{$self->{'dateformat'} || $prefformat} ; +} + +1; +__END__ + +=head1 C4::Dates.pm - a more object-oriented replacement for Date.pm. + +The core problem to address is the multiplicity of formats used by different Koha +installations around the world. We needed to move away from any hard-coded values at +the script level, for example in initial form values or checks for min/max date. The +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). + +=head2 ->new([string_date,][date_format]) + +Arguments to new() are optional. If string_date is not supplied, the present system date is +used. If date_format is not supplied, the system preference from C4::Context is used. + +Examples: + + my $now = C4::Dates->new(); + my $date1 = C4::Dates->new("09-21-1989","us"); + my $date2 = C4::Dates->new("19890921 143907","sql"); + +=head2 ->output([date_format]) + +The date value is stored independent of any specific format. Therefore any format can be +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" + +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 +date format unless otherwise instructed. + +=head2 ->format([date_format]) + +With no argument, format returns the object's current date_format. Otherwise it attempts to +set the object format to the supplied value. + +Some previously desireable functions are now unnecessary. For example, you might want a +method/function to tell you whether or not a Dates.pm object is of the 'iso' type. But you +can see by this example that such a test is trivial to accomplish, and not necessary to +include in the module: + + sub is_iso { + my $self = shift; + return ($self->format() eq "iso"); + } + +Note: A similar function would need to be included for each format. + +Instead a dependent script can retrieve the format of the object directly and decide what to +do with it from there: + + my $date = C4::Dates->new(); + my $format = $date->format(); + ($format eq "iso") or do_something($date); + +Or if you just want to print a given value and format, no problem: + + my $date = C4::Dates->new("1989-09-21", "iso"); + print $date->output; + +Alternatively: + + print C4::Dates->new("1989-09-21", "iso")->output; + +Or even: + + print C4::Dates->new("21-09-1989", "metric")->output("iso"); + +=head2 ->DHMTLCalendar([date_format]) + +Returns the format string for DHTML Calendar Display based on date_format. +If date_format is not supplied, the return is based on system preference. + + C4::Dates->new()->DHTMLCalendar(); # e.g., returns "%m/%d/%Y" for 'us' system preference + +Format dates from database in ISO format into the format for display to user: + + my $date = C4::Dates->new($date_from_database,"iso"); + my $datestring_for_display = $date->display("syspref"); + +=head3 Error Handling + +Some error handling is provided in this module, but not all. Requesting an unknown format is a +fatal error (because it is programmer error, not user error, typically). + +Scripts must still perform validation of user input. Attempting to set an invalid value will +return 0 or undefined, so a script might check as follows: + + my $date = C4::Dates->new($input) or deal_with_it("$input didn't work"); + +To validate before creating a new object, use the regexp method of the class: + + $input =~ C4::Dates->regexp("iso") or deal_with_it("input ($input) invalid as iso format"); + my $date = C4::Dates->new($input,"iso"); + +More verose debugging messages are sent in the presence of non-zero $ENV{"DEBUG"}. + +=head3 TO DO + +If the date format is not in , 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". + +=cut + diff --git a/t/Dates.t b/t/Dates.t new file mode 100755 index 0000000000..21e285b484 --- /dev/null +++ b/t/Dates.t @@ -0,0 +1,49 @@ +#!/bin/perl + +use Test::More tests => 83; +BEGIN { + use_ok('C4::Dates'); +} +use_ok( CGI::Carp ); +CGI::Carp->fatalsToBrowser(0); + +my %thash = ( + iso => ['2001-01-01','1989-09-21'], + metric => ["01-01-2001",'21-09-1989'], + us => ["01-01-2001",'09-21-1989'], + sql => ['20010101 010101', + '19890921 143907' ], +); + +my @formats = sort keys %thash; +diag "\nNote: CGI::Carp may throw an initial error here. Ignore that.\n"; +diag "Testing " . scalar(@formats) . " formats.\nTesting no input:\n"; +my ($today, $today0, $val, $re); +ok($today0 = C4::Dates->today(), "(default) CLASS ->today : $today0" ); +foreach (@formats) { + my $pre = sprintf '(%-6s)', $_; + ok($date = C4::Dates->new(), "$pre Date Creation : new()"); + ok($_ eq ($format = $date->format($_)), "$pre format($_) : $format" ); + ok($today = $date->output(), "$pre output() : $today" ); + ok($today = $date->today(), "$pre object->today : $today" ); + print "\n"; +} + +foreach my $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(), "$pre output() : $val" ); + foreach (grep {!/$format/} @formats) { + ok($today = $date->output($_), "$pre output(" . sprintf("%8s","'$_'") . "): $today"); + } + ok($today = $date->today(), "$pre object->today : $today" ); + # ok($today == ($today = C4::Dates->today()), "$pre CLASS ->today : $today" ); + ok($val = $date->output(), "$pre output() : $val" ); + # ok($format eq ($format = $date->format()), "$pre format() : $format" ); + print "\n"; + } +} + +diag "done.\n"; -- 2.39.5