509d673f10
Signed-off-by: Kyle M Hall <kyle@bywatersolutions.com> Signed-off-by: Paul Poulain <paul.poulain@biblibre.com>
377 lines
13 KiB
Perl
377 lines
13 KiB
Perl
package C4::Dates;
|
|
|
|
# Copyright 2007 Liblime
|
|
# Parts Copyright ACPL 2011
|
|
# Parts Copyright Catalyst IT 2012
|
|
#
|
|
# 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.,
|
|
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
|
|
use strict;
|
|
use warnings;
|
|
use Carp;
|
|
use C4::Context;
|
|
use C4::Debug;
|
|
use Exporter;
|
|
use POSIX qw(strftime);
|
|
use Date::Calc qw(check_date check_time);
|
|
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
|
|
use vars qw($debug $cgi_debug);
|
|
|
|
BEGIN {
|
|
$VERSION = 3.07.00.049;
|
|
@ISA = qw(Exporter);
|
|
@EXPORT_OK = qw(format_date_in_iso format_date);
|
|
}
|
|
|
|
use vars qw($prefformat);
|
|
|
|
sub _prefformat {
|
|
unless ( defined $prefformat ) {
|
|
$prefformat = C4::Context->preference('dateformat');
|
|
}
|
|
return $prefformat;
|
|
}
|
|
|
|
sub reset_prefformat { # subroutine to clear the prefformat, called when we change it
|
|
if (defined $prefformat){
|
|
$prefformat = C4::Context->preference('dateformat');
|
|
}
|
|
}
|
|
|
|
our %format_map = (
|
|
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',
|
|
rfc822 => 'a, dd b y HH:MM:SS z ',
|
|
);
|
|
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',
|
|
rfc822 => '%a, %d %b %Y %H:%M:%S %z',
|
|
);
|
|
|
|
our %dmy_subs = ( # strings to eval (after using regular expression returned by regexp below)
|
|
# make arrays for POSIX::strftime()
|
|
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)]',
|
|
rfc822 => '[($7, $6, $5, $2, $3, $4 - 1900, $8)]',
|
|
);
|
|
|
|
our @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
|
|
|
|
our @days = qw(Sun Mon Tue Wed Thu Fri Sat);
|
|
|
|
sub regexp ($;$) {
|
|
my $self = shift;
|
|
my $delim = qr/:?\:|\/|-/; # "non memory" cluster: no backreference
|
|
my $format = (@_) ? _recognize_format(shift) : ( $self->{'dateformat'} || _prefformat() );
|
|
|
|
# Extra layer of checking $self->{'dateformat'}.
|
|
# Why? Because it is assumed you might want to check regexp against an *instantiated* Dates object as a
|
|
# way of saying "does this string match *whatever* format that Dates object is?"
|
|
|
|
( $format eq 'sql' )
|
|
and return qr/^(\d{4})(\d{1,2})(\d{1,2})(?:\s{4}(\d{2})(\d{2})(\d{2}))?/;
|
|
( $format eq 'iso' )
|
|
and return qr/^(\d{4})$delim(\d{1,2})$delim(\d{1,2})(?:(?:\s{1}|T)(\d{2})\:?(\d{2})\:?(\d{2}))?Z?/;
|
|
( $format eq 'rfc822' )
|
|
and return qr/^([a-zA-Z]{3}),\s{1}(\d{1,2})\s{1}([a-zA-Z]{3})\s{1}(\d{4})\s{1}(\d{1,2})\:(\d{1,2})\:(\d{1,2})\s{1}(([\-|\+]\d{4})|([A-Z]{3}))/;
|
|
return qr/^(\d{1,2})$delim(\d{1,2})$delim(\d{4})(?:\s{1}(\d{1,2})\:?(\d{1,2})\:?(\d{1,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;
|
|
if ($dformat eq 'rfc822') {
|
|
$aref = _abbr_to_numeric($aref, $dformat);
|
|
pop(@{$aref}); #pop off tz offset because we are not setup to handle tz conversions just yet
|
|
}
|
|
_check_date_and_time($aref);
|
|
push @{$aref}, (-1,-1,1); # for some reason unknown to me, setting isdst to -1 or undef causes strftime to fail to return the tz offset which is required in RFC822 format -chris_n
|
|
return @{$aref};
|
|
}
|
|
|
|
# $debug and
|
|
carp "Illegal Date '$val' does not match '$dformat' format: " . $self->visual();
|
|
return 0;
|
|
}
|
|
|
|
sub _abbr_to_numeric {
|
|
my $aref = shift;
|
|
my $dformat = shift;
|
|
my ($month_abbr, $day_abbr) = ($aref->[4], $aref->[3]) if $dformat eq 'rfc822';
|
|
|
|
for( my $i = 0; $i < scalar(@months); $i++ ) {
|
|
if ( $months[$i] =~ /$month_abbr/ ) {
|
|
$aref->[4] = $i-1;
|
|
last;
|
|
}
|
|
};
|
|
|
|
for( my $i = 0; $i < scalar(@days); $i++ ) {
|
|
if ( $days[$i] =~ /$day_abbr/ ) {
|
|
$aref->[3] = $i;
|
|
last;
|
|
}
|
|
};
|
|
return $aref;
|
|
}
|
|
|
|
sub _check_date_and_time {
|
|
my $chron_ref = shift;
|
|
my ( $year, $month, $day ) = _chron_to_ymd($chron_ref);
|
|
unless ( check_date( $year, $month, $day ) ) {
|
|
carp "Illegal date specified (year = $year, month = $month, day = $day)";
|
|
}
|
|
my ( $hour, $minute, $second ) = _chron_to_hms($chron_ref);
|
|
unless ( check_time( $hour, $minute, $second ) ) {
|
|
carp "Illegal time specified (hour = $hour, minute = $minute, second = $second)";
|
|
}
|
|
}
|
|
|
|
sub _chron_to_ymd {
|
|
my $chron_ref = shift;
|
|
return ( $chron_ref->[5] + 1900, $chron_ref->[4] + 1, $chron_ref->[3] );
|
|
}
|
|
|
|
sub _chron_to_hms {
|
|
my $chron_ref = shift;
|
|
return ( $chron_ref->[2], $chron_ref->[1], $chron_ref->[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' );
|
|
$self->{'dmy_arrayref'} = [ ( (@_) ? $self->dmy_map(shift) : localtime ) ];
|
|
if ($debug && $debug > 1) { warn "(during init) \@\$self->{'dmy_arrayref'}: " . join( ' ', @{ $self->{'dmy_arrayref'} } ) . "\n"; }
|
|
return $self;
|
|
}
|
|
|
|
sub output ($;$) {
|
|
my $self = shift;
|
|
my $newformat = (@_) ? _recognize_format(shift) : _prefformat();
|
|
return ( eval { POSIX::strftime( $posix_map{$newformat}, @{ $self->{'dmy_arrayref'} } ) } || undef );
|
|
}
|
|
|
|
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') is 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{ _recognize_format(shift) };
|
|
}
|
|
$self eq __PACKAGE__ and return $format_map{ _prefformat() };
|
|
return $format_map{ eval { $self->{'dateformat'} } || _prefformat() };
|
|
}
|
|
|
|
# like the functions from the old C4::Date.pm
|
|
sub format_date {
|
|
return __PACKAGE__->new( shift, 'iso' )->output( (@_) ? shift : _prefformat() );
|
|
}
|
|
|
|
sub format_date_in_iso {
|
|
return __PACKAGE__->new( shift, _prefformat() )->output('iso');
|
|
}
|
|
|
|
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).
|
|
|
|
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
|
|
rfc822 - Standard for using with RSS feeds, etc.
|
|
|
|
=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-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
|
|
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 "syspref" -- System Preference(s)
|
|
|
|
Perhaps you want to force data obtained in a known format to display according to the user's system
|
|
preference, without necessarily knowing what that preference is. For this purpose, you can use the
|
|
psuedo-format argument "syspref".
|
|
|
|
For example, to print an ISO date (from the database) in the <systempreference> format:
|
|
|
|
my $date = C4::Dates->new($date_from_database,"iso");
|
|
my $datestring_for_display = $date->output("syspref");
|
|
print $datestring_for_display;
|
|
|
|
Or even:
|
|
|
|
print C4::Dates->new($date_from_database,"iso")->output("syspref");
|
|
|
|
If you just want to know what the <systempreferece> is, a default Dates object can tell you:
|
|
|
|
C4::Dates->new()->format();
|
|
|
|
=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->DHTMLcalendar(); # e.g., returns "%m/%d/%Y" for 'us' system preference
|
|
|
|
=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 verbose debugging messages are sent in the presence of non-zero $ENV{"DEBUG"}.
|
|
|
|
Notes: if the date in the db is null or empty, interpret null expiration to mean "never expires".
|
|
|
|
=head3 _prefformat()
|
|
|
|
This internal function is used to read the preferred date format
|
|
from the system preference table. It reads the preference once,
|
|
then caches it.
|
|
|
|
This replaces using the package variable $prefformat directly, and
|
|
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
|
|
|