X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FDates.pm;h=4fd08aeb6c4e94a744652b321202d313cd531eb5;hb=08382876306cfda839637c5f72a107b304458a8e;hp=f45fd79f3ff89ca723acefdd90f4fb825f75bd6c;hpb=f6380c592da1fa5a104126c38428dc86c7d45c73;p=koha.git diff --git a/C4/Dates.pm b/C4/Dates.pm index f45fd79f3f..4fd08aeb6c 100644 --- a/C4/Dates.pm +++ b/C4/Dates.pm @@ -1,4 +1,9 @@ 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 @@ -10,158 +15,220 @@ package C4::Dates; # 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 +# 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 = 0.03; - @ISA = qw(Exporter); - @EXPORT_OK = qw(DHTMLcalendar format_date_in_iso format_date); + $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; } -my $prefformat = C4::Context->preference('dateformat'); -my $debug = $ENV{'DEBUG'} || 0; +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', - metric => 'dd/mm/yyyy', - us => 'mm/dd/yyyy', - sql => 'yyyymmdd HHMMSS', +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', + 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 => '[(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)]', +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 = (@_) ? 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 + 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; + 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); - return @{$aref}; - } - # $debug and - carp "Illegal Date '$val' does not match '$dformat' format: " . $self->visual() . "\n"; - return 0; + 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)\n"; + 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)\n"; + 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]); + 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]); + 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(@_); + 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 )] ; - $debug and print STDERR "(during init) \@\$self->{'dmy_arrayref'}: " . join(' ',@{$self->{'dmy_arrayref'}}) . "\n"; - return $self; + 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); + 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 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; + 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 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 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} ; + 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); + return __PACKAGE__->new( shift, 'iso' )->output( (@_) ? shift : _prefformat() ); } + sub format_date_in_iso { - return __PACKAGE__ -> new(shift,$prefformat)->output('iso'); + return __PACKAGE__->new( shift, _prefformat() )->output('iso'); } 1; @@ -175,6 +242,13 @@ 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 + 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 @@ -182,19 +256,19 @@ used. If date_format is not supplied, the system preference from C4::Context is Examples: - my $now = C4::Dates->new(); - my $date1 = C4::Dates->new("09-21-1989","us"); - my $date2 = C4::Dates->new("19890921 143907","sql"); + 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" + 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 @@ -210,32 +284,32 @@ method/function to tell you whether or not a Dates.pm object is of the 'iso' typ 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"); - } + 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); + 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; + my $date = C4::Dates->new("1989-09-21", "iso"); + print $date->output; Alternatively: - print C4::Dates->new("1989-09-21", "iso")->output; + print C4::Dates->new("1989-09-21", "iso")->output; Or even: - print C4::Dates->new("21-09-1989", "metric")->output("iso"); + print C4::Dates->new("21-09-1989", "metric")->output("iso"); =head2 "syspref" -- System Preference(s) @@ -245,24 +319,24 @@ psuedo-format argument "syspref". For example, to print an ISO date (from the database) in the format: - my $date = C4::Dates->new($date_from_database,"iso"); - my $datestring_for_display = $date->output("syspref"); - print $datestring_for_display; + 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"); + print C4::Dates->new($date_from_database,"iso")->output("syspref"); -If you just want to know what the is, you can use: +If you just want to know what the is, a default Dates object can tell you: -C4::Dates-> + 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 + C4::Dates->DHTMLcalendar(); # e.g., returns "%m/%d/%Y" for 'us' system preference =head3 Error Handling @@ -272,21 +346,32 @@ 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"); + 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"); + $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"}. +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 , 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