X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FDates.pm;h=451e2d34b7bf56f6b7d479c14bae73a23f714f00;hb=51fcfe4a1ebd5b5c1ef70c1e62d2bf2bdc24bb4b;hp=320d04d62b688fb3f1967a383ed592938b181f6d;hpb=b73e4e924ee79ba97b46bd2293180bcacb496e66;p=koha.git diff --git a/C4/Dates.pm b/C4/Dates.pm index 320d04d62b..451e2d34b7 100644 --- a/C4/Dates.pm +++ b/C4/Dates.pm @@ -18,23 +18,31 @@ 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); -$VERSION = 0.03; -@ISA = qw(Exporter); -@EXPORT_OK = qw(DHTMLcalendar format_date_in_iso format_date); - -my $prefformat = C4::Context->preference('dateformat'); -my $debug = $ENV{'DEBUG'} || 0; +BEGIN { + $VERSION = 0.04; + @ISA = qw(Exporter); + @EXPORT_OK = qw(format_date_in_iso format_date); +} -our @dmy_array = (); +use vars qw($prefformat); +sub _prefformat { + unless (defined $prefformat) { + $prefformat = C4::Context->preference('dateformat'); + } + return $prefformat; +} 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 = ( @@ -46,21 +54,26 @@ 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)]', ); 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 + 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{2})(\d{2})(?:\s{4}(\d{2})(\d{2})(\d{2}))?/; + 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{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 + return qr/^(\d{4})$delim(\d{1,2})$delim(\d{1,2})(?:(?:\s{1}|T)(\d{2})\:?(\d{2})\:?(\d{2}))?Z?/; + 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 ($$) { @@ -72,12 +85,36 @@ sub dmy_map ($$) { $debug and print STDERR "xsub: $xsub \n"; if ($val =~ /$re/) { my $aref = eval $xsub; + _check_date_and_time($aref); return @{$aref}; } - $debug and carp "Illegal Date '$val' does not match $dformat format: $re\n"; + # $debug and + carp "Illegal Date '$val' does not match '$dformat' format: " . $self->visual(); return 0; } +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; @@ -88,34 +125,33 @@ sub new { sub init ($;$$) { my $self = shift; my $dformat; - $self->{'dateformat'} = $dformat = (scalar(@_) >= 2) ? $_[1] : $prefformat; + $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 + $self->{'dmy_arrayref'} = [((@_) ? $self->dmy_map(shift) : localtime )] ; + $debug and warn "(during init) \@\$self->{'dmy_arrayref'}: " . join(' ',@{$self->{'dmy_arrayref'}}) . "\n"; return $self; } sub output ($;$) { my $self = shift; - my $newformat = (@_) ? _recognize_format(shift) : $self->{'dateformat'} ; - return (eval {POSIX::strftime($posix_map{$newformat}, @self::dmy_array)} || undef); + 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; + 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."; + ($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; + my $format = (@_) ? shift : _prefformat(); return $posix_map{$format}; } sub format { # get or set dateformat: iso, metric, us, etc. @@ -128,16 +164,16 @@ sub visual { if (@_) { return $format_map{ _recognize_format(shift) }; } - $self eq __PACKAGE__ and return $format_map{$prefformat}; - return $format_map{ eval { $self->{'dateformat'} } || $prefformat} ; + $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; @@ -151,6 +187,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). +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 @@ -170,7 +212,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"; - 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 @@ -222,16 +264,16 @@ 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->display("syspref"); + my $datestring_for_display = $date->output("syspref"); print $datestring_for_display; Or even: - print C4::Dates->new($date_from_database,"iso")->display("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]) @@ -255,14 +297,25 @@ 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"}. +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