C4/Dates.pm

   1 package C4::Dates;
   2 # This file is part of Koha.
   3 #
   4 # Koha is free software; you can redistribute it and/or modify it under the
   5 # terms of the GNU General Public License as published by the Free Software
   6 # Foundation; either version 2 of the License, or (at your option) any later
   7 # version.
   8 #
   9 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  10 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  11 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  12 #
  13 # You should have received a copy of the GNU General Public License along with
  14 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  15 # Suite 330, Boston, MA  02111-1307 USA
  16
  17 use strict;
  18 use warnings;
  19 use Carp;
  20 use C4::Context;
  21 use C4::Debug;
  22 use Exporter;
  23 use POSIX qw(strftime);
  24 use Date::Calc qw(check_date check_time);
  25 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  26 use vars qw($debug $cgi_debug);
  27
  28 BEGIN {
  29         $VERSION = 0.04;
  30         @ISA = qw(Exporter);
  31         @EXPORT_OK = qw(format_date_in_iso format_date);
  32 }
  33
  34 use vars qw($prefformat);
  35 sub _prefformat {
  36     unless (defined $prefformat) {
  37         $prefformat = C4::Context->preference('dateformat');
  38     }
  39     return $prefformat;
  40 }
  41
  42 our %format_map = (
  43           iso  => 'yyyy-mm-dd', # plus " HH:MM:SS"
  44         metric => 'dd/mm/yyyy', # plus " HH:MM:SS"
  45           us   => 'mm/dd/yyyy', # plus " HH:MM:SS"
  46           sql  => 'yyyymmdd    HHMMSS',
  47 );
  48 our %posix_map = (
  49           iso  => '%Y-%m-%d',   # or %F, "Full Date"
  50         metric => '%d/%m/%Y',
  51           us   => '%m/%d/%Y',
  52           sql  => '%Y%m%d    %H%M%S',
  53 );
  54
  55 our %dmy_subs = (                       # strings to eval  (after using regular expression returned by regexp below)
  56                                                         # make arrays for POSIX::strftime()
  57           iso  => '[(($6||0),($5||0),($4||0),$3, $2 - 1, $1 - 1900)]',
  58         metric => '[(($6||0),($5||0),($4||0),$1, $2 - 1, $3 - 1900)]',
  59           us   => '[(($6||0),($5||0),($4||0),$2, $1 - 1, $3 - 1900)]',
  60           sql  => '[(($6||0),($5||0),($4||0),$3, $2 - 1, $1 - 1900)]',
  61 );
  62
  63 sub regexp ($;$) {
  64         my $self = shift;
  65         my $delim = qr/:?\:|\/|-/;      # "non memory" cluster: no backreference
  66         my $format = (@_) ? _recognize_format(shift) : ($self->{'dateformat'} || _prefformat());
  67
  68     # Extra layer of checking $self->{'dateformat'}.
  69     # Why?  Because it is assumed you might want to check regexp against an *instantiated* Dates object as a
  70     # way of saying "does this string match *whatever* format that Dates object is?"
  71
  72         ($format eq 'sql') and
  73         return qr/^(\d{4})(\d{1,2})(\d{1,2})(?:\s{4}(\d{2})(\d{2})(\d{2}))?/;
  74         ($format eq 'iso') and
  75         return qr/^(\d{4})$delim(\d{1,2})$delim(\d{1,2})(?:(?:\s{1}|T)(\d{2})\:?(\d{2})\:?(\d{2}))?Z?/;
  76         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
  77 }
  78
  79 sub dmy_map ($$) {
  80         my $self = shift;
  81         my $val  = shift                                        or return undef;
  82         my $dformat = $self->{'dateformat'} or return undef;
  83         my $re = $self->regexp();
  84         my $xsub = $dmy_subs{$dformat};
  85         $debug and print STDERR "xsub: $xsub \n";
  86         if ($val =~ /$re/) {
  87                 my $aref = eval $xsub;
  88         _check_date_and_time($aref);
  89                 return  @{$aref};
  90         }
  91         # $debug and
  92         carp "Illegal Date '$val' does not match '$dformat' format: " . $self->visual();
  93         return 0;
  94 }
  95
  96 sub _check_date_and_time {
  97     my $chron_ref = shift;
  98     my ($year, $month, $day) = _chron_to_ymd($chron_ref);
  99     unless (check_date($year, $month, $day)) {
 100         carp "Illegal date specified (year = $year, month = $month, day = $day)";
 101     }
 102     my ($hour, $minute, $second) = _chron_to_hms($chron_ref);
 103     unless (check_time($hour, $minute, $second)) {
 104         carp "Illegal time specified (hour = $hour, minute = $minute, second = $second)";
 105     }
 106 }
 107
 108 sub _chron_to_ymd {
 109     my $chron_ref = shift;
 110     return ($chron_ref->[5] + 1900, $chron_ref->[4] + 1, $chron_ref->[3]);
 111 }
 112
 113 sub _chron_to_hms {
 114     my $chron_ref = shift;
 115     return ($chron_ref->[2], $chron_ref->[1], $chron_ref->[0]);
 116 }
 117
 118 sub new {
 119         my $this = shift;
 120         my $class = ref($this) || $this;
 121         my $self = {};
 122         bless $self, $class;
 123         return $self->init(@_);
 124 }
 125 sub init ($;$$) {
 126         my $self = shift;
 127         my $dformat;
 128         $self->{'dateformat'} = $dformat = (scalar(@_) >= 2) ? $_[1] : _prefformat();
 129         ($format_map{$dformat}) or croak
 130                 "Invalid date format '$dformat' from " . ((scalar(@_) >= 2) ? 'argument' : 'system preferences');
 131         $self->{'dmy_arrayref'} = [((@_) ? $self->dmy_map(shift) : localtime )] ;
 132         $debug and warn "(during init) \@\$self->{'dmy_arrayref'}: " . join(' ',@{$self->{'dmy_arrayref'}}) . "\n";
 133         return $self;
 134 }
 135 sub output ($;$) {
 136         my $self = shift;
 137         my $newformat = (@_) ? _recognize_format(shift) : _prefformat();
 138         return (eval {POSIX::strftime($posix_map{$newformat}, @{$self->{'dmy_arrayref'}})} || undef);
 139 }
 140 sub today ($;$) {               # NOTE: sets date value to today (and returns it in the requested or current format)
 141         my $class = shift;
 142         $class = ref($class) || $class;
 143         my $format = (@_) ? _recognize_format(shift) : _prefformat();
 144         return $class->new()->output($format);
 145 }
 146 sub _recognize_format($) {
 147         my $incoming = shift;
 148         ($incoming eq 'syspref') and return _prefformat();
 149         (scalar grep (/^$incoming$/, keys %format_map) == 1) or croak "The format you asked for ('$incoming') is unrecognized.";
 150         return $incoming;
 151 }
 152 sub DHTMLcalendar ($;$) {       # interface to posix_map
 153         my $class = shift;
 154         my $format = (@_) ? shift : _prefformat();
 155         return $posix_map{$format};
 156 }
 157 sub format {    # get or set dateformat: iso, metric, us, etc.
 158         my $self = shift;
 159         (@_) or return $self->{'dateformat'};
 160         $self->{'dateformat'} = _recognize_format(shift);
 161 }
 162 sub visual {
 163         my $self = shift;
 164         if (@_) {
 165                 return $format_map{ _recognize_format(shift) };
 166         }
 167         $self eq __PACKAGE__ and return $format_map{_prefformat()};
 168         return $format_map{ eval { $self->{'dateformat'} } || _prefformat()} ;
 169 }
 170
 171 # like the functions from the old C4::Date.pm
 172 sub format_date {
 173         return __PACKAGE__ -> new(shift,'iso')->output((@_) ? shift : _prefformat());
 174 }
 175 sub format_date_in_iso {
 176         return __PACKAGE__ -> new(shift,_prefformat())->output('iso');
 177 }
 178
 179 1;
 180 __END__
 181
 182 =head1 C4::Dates.pm - a more object-oriented replacement for Date.pm.
 183
 184 The core problem to address is the multiplicity of formats used by different Koha
 185 installations around the world.  We needed to move away from any hard-coded values at
 186 the script level, for example in initial form values or checks for min/max date. The
 187 reason is clear when you consider string '07/01/2004'.  Depending on the format, it
 188 represents July 1st (us), or January 7th (metric), or an invalid value (iso).
 189
 190 The formats supported by Koha are:
 191     iso - ISO 8601 (extended)
 192     us - U.S. standard
 193     metric - European standard (slight misnomer, not really decimalized metric)
 194     sql - log format, not really for human consumption
 195
 196 =head2 ->new([string_date,][date_format])
 197
 198 Arguments to new() are optional.  If string_date is not supplied, the present system date is
 199 used.  If date_format is not supplied, the system preference from C4::Context is used.
 200
 201 Examples:
 202
 203                 my $now   = C4::Dates->new();
 204                 my $date1 = C4::Dates->new("09-21-1989","us");
 205                 my $date2 = C4::Dates->new("19890921    143907","sql");
 206
 207 =head2 ->output([date_format])
 208
 209 The date value is stored independent of any specific format.  Therefore any format can be
 210 invoked when displaying it.
 211
 212                 my $date = C4::Dates->new();    # say today is July 12th, 2010
 213                 print $date->output("iso");     # prints "2010-07-12"
 214                 print "\n";
 215                 print $date->output("metric");  # prints "12-07-2010"
 216
 217 However, it is still necessary to know the format of any incoming date value (e.g.,
 218 setting the value of an object with new()).  Like new(), output() assumes the system preference
 219 date format unless otherwise instructed.
 220
 221 =head2 ->format([date_format])
 222
 223 With no argument, format returns the object's current date_format.  Otherwise it attempts to
 224 set the object format to the supplied value.
 225
 226 Some previously desireable functions are now unnecessary.  For example, you might want a
 227 method/function to tell you whether or not a Dates.pm object is of the 'iso' type.  But you
 228 can see by this example that such a test is trivial to accomplish, and not necessary to
 229 include in the module:
 230
 231                 sub is_iso {
 232                         my $self = shift;
 233                         return ($self->format() eq "iso");
 234                 }
 235
 236 Note: A similar function would need to be included for each format.
 237
 238 Instead a dependent script can retrieve the format of the object directly and decide what to
 239 do with it from there:
 240
 241                 my $date = C4::Dates->new();
 242                 my $format = $date->format();
 243                 ($format eq "iso") or do_something($date);
 244
 245 Or if you just want to print a given value and format, no problem:
 246
 247                 my $date = C4::Dates->new("1989-09-21", "iso");
 248                 print $date->output;
 249
 250 Alternatively:
 251
 252                 print C4::Dates->new("1989-09-21", "iso")->output;
 253
 254 Or even:
 255
 256                 print C4::Dates->new("21-09-1989", "metric")->output("iso");
 257
 258 =head2 "syspref" -- System Preference(s)
 259
 260 Perhaps you want to force data obtained in a known format to display according to the user's system
 261 preference, without necessarily knowing what that preference is.  For this purpose, you can use the
 262 psuedo-format argument "syspref".
 263
 264 For example, to print an ISO date (from the database) in the <systempreference> format:
 265
 266                 my $date = C4::Dates->new($date_from_database,"iso");
 267                 my $datestring_for_display = $date->output("syspref");
 268                 print $datestring_for_display;
 269
 270 Or even:
 271
 272                 print C4::Dates->new($date_from_database,"iso")->output("syspref");
 273
 274 If you just want to know what the <systempreferece> is, a default Dates object can tell you:
 275
 276                 C4::Dates->new()->format();
 277
 278 =head2 ->DHMTLcalendar([date_format])
 279
 280 Returns the format string for DHTML Calendar Display based on date_format.
 281 If date_format is not supplied, the return is based on system preference.
 282
 283                 C4::Dates->DHTMLcalendar();     #  e.g., returns "%m/%d/%Y" for 'us' system preference
 284
 285 =head3 Error Handling
 286
 287 Some error handling is provided in this module, but not all.  Requesting an unknown format is a
 288 fatal error (because it is programmer error, not user error, typically).
 289
 290 Scripts must still perform validation of user input.  Attempting to set an invalid value will
 291 return 0 or undefined, so a script might check as follows:
 292
 293                 my $date = C4::Dates->new($input) or deal_with_it("$input didn't work");
 294
 295 To validate before creating a new object, use the regexp method of the class:
 296
 297                 $input =~ C4::Dates->regexp("iso") or deal_with_it("input ($input) invalid as iso format");
 298                 my $date = C4::Dates->new($input,"iso");
 299
 300 More verbose debugging messages are sent in the presence of non-zero $ENV{"DEBUG"}.
 301
 302 Notes: if the date in the db is null or empty, interpret null expiration to mean "never expires".
 303
 304 =head3 _prefformat()
 305
 306 This internal function is used to read the preferred date format
 307 from the system preference table.  It reads the preference once,
 308 then caches it.
 309
 310 This replaces using the package variable $prefformat directly, and
 311 specifically, doing a call to C4::Context->preference() during
 312 module initialization.  That way, C4::Dates no longer has a
 313 compile-time dependency on having a valid $dbh.
 314
 315 =head3 TO DO
 316
 317 If the date format is not in <systempreference>, we should send an error back to the user.
 318 This kind of check should be centralized somewhere.  Probably not here, though.
 319
 320 =cut
 321