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 = (@_) ? shift : $self->{'dateformat'};      # w/o arg. relies on dateformat being defined
  67         ($format eq 'sql') and
  68         return qr/^(\d{4})(\d{2})(\d{2})(?:\s{4}(\d{2})(\d{2})(\d{2}))?/;
  69         ($format eq 'iso') and
  70         return qr/^(\d{4})$delim(\d{2})$delim(\d{2})(?:(?:\s{1}|T)(\d{2})\:?(\d{2})\:?(\d{2}))?Z?/;
  71         return qr/^(\d{2})$delim(\d{2})$delim(\d{4})(?:\s{1}(\d{2})\:?(\d{2})\:?(\d{2}))?/;  # everything else
  72 }
  73
  74 sub dmy_map ($$) {
  75         my $self = shift;
  76         my $val  = shift                                        or return undef;
  77         my $dformat = $self->{'dateformat'} or return undef;
  78         my $re = $self->regexp();
  79         my $xsub = $dmy_subs{$dformat};
  80         $debug and print STDERR "xsub: $xsub \n";
  81         if ($val =~ /$re/) {
  82                 my $aref = eval $xsub;
  83         _check_date_and_time($aref);
  84                 return  @{$aref};
  85         }
  86         # $debug and
  87         carp "Illegal Date '$val' does not match '$dformat' format: " . $self->visual();
  88         return 0;
  89 }
  90
  91 sub _check_date_and_time {
  92     my $chron_ref = shift;
  93     my ($year, $month, $day) = _chron_to_ymd($chron_ref);
  94     unless (check_date($year, $month, $day)) {
  95         carp "Illegal date specified (year = $year, month = $month, day = $day)";
  96     }
  97     my ($hour, $minute, $second) = _chron_to_hms($chron_ref);
  98     unless (check_time($hour, $minute, $second)) {
  99         carp "Illegal time specified (hour = $hour, minute = $minute, second = $second)";
 100     }
 101 }
 102
 103 sub _chron_to_ymd {
 104     my $chron_ref = shift;
 105     return ($chron_ref->[5] + 1900, $chron_ref->[4] + 1, $chron_ref->[3]);
 106 }
 107
 108 sub _chron_to_hms {
 109     my $chron_ref = shift;
 110     return ($chron_ref->[2], $chron_ref->[1], $chron_ref->[0]);
 111 }
 112
 113 sub new {
 114     shift; # as clone isn't implemented, we don't carre about package name
 115     my $self = bless {}, __PACKAGE__;
 116     $self->init(@_)
 117 }
 118
 119 sub init ($;$$) {
 120     my ($self,$string_date,$dformat) = @_;
 121
 122     my $from;
 123     if ( $dformat ) {
 124         $from = 'argument';
 125     } else {
 126         $from    = 'system preferences';
 127         $dformat = _prefformat;
 128     }
 129
 130     $self->{'dateformat'} = $dformat;
 131     $format_map{$dformat} or croak "Invalid date format '$dformat' from $from";
 132
 133     $self->{'dmy_arrayref'} = $string_date
 134         ? $self->dmy_map($string_date)
 135         : localtime
 136     ;
 137
 138     $debug and warn
 139         q[(during init) @$self->{'dmy_arrayref'}:]
 140         , join(' ',@{$self->{'dmy_arrayref'}})
 141         , "\n"
 142     ;
 143
 144     return $self;
 145 }
 146
 147 sub output ($;$) {
 148        my $self = shift;
 149        my $newformat = (@_) ? _recognize_format(shift) : _prefformat();
 150        return (eval {POSIX::strftime($posix_map{$newformat}, @{$self->{'dmy_arrayref'}})} || undef);
 151 }
 152 sub today ($;$) {               # NOTE: sets date value to today (and returns it in the requested or current format)
 153         my $class = shift;
 154         $class = ref($class) || $class;
 155         my $format = (@_) ? _recognize_format(shift) : _prefformat();
 156         return $class->new()->output($format);
 157 }
 158 sub _recognize_format($) {
 159         my $incoming = shift;
 160         ($incoming eq 'syspref') and return _prefformat();
 161         (scalar grep (/^$incoming$/, keys %format_map) == 1) or croak "The format you asked for ('$incoming') is unrecognized.";
 162         return $incoming;
 163 }
 164 sub DHTMLcalendar ($;$) {       # interface to posix_map
 165         my $class = shift;
 166         my $format = (@_) ? shift : _prefformat();
 167         return $posix_map{$format};
 168 }
 169 sub format {    # get or set dateformat: iso, metric, us, etc.
 170         my $self = shift;
 171         (@_) or return $self->{'dateformat'};
 172         $self->{'dateformat'} = _recognize_format(shift);
 173 }
 174 sub visual {
 175         my $self = shift;
 176         if (@_) {
 177                 return $format_map{ _recognize_format(shift) };
 178         }
 179         $self eq __PACKAGE__ and return $format_map{_prefformat()};
 180         return $format_map{ eval { $self->{'dateformat'} } || _prefformat()} ;
 181 }
 182
 183 # like the functions from the old C4::Date.pm
 184 sub format_date {
 185         return __PACKAGE__ -> new(shift,'iso')->output((@_) ? shift : _prefformat());
 186 }
 187 sub format_date_in_iso {
 188         return __PACKAGE__ -> new(shift,_prefformat())->output('iso');
 189 }
 190
 191 1;
 192 __END__
 193
 194 =head1 C4::Dates.pm - a more object-oriented replacement for Date.pm.
 195
 196 The core problem to address is the multiplicity of formats used by different Koha
 197 installations around the world.  We needed to move away from any hard-coded values at
 198 the script level, for example in initial form values or checks for min/max date. The
 199 reason is clear when you consider string '07/01/2004'.  Depending on the format, it
 200 represents July 1st (us), or January 7th (metric), or an invalid value (iso).
 201
 202 The formats supported by Koha are:
 203     iso - ISO 8601 (extended)
 204     us - U.S. standard
 205     metric - European standard (slight misnomer, not really decimalized metric)
 206     sql - log format, not really for human consumption
 207
 208 =head2 ->new([string_date,][date_format])
 209
 210 Arguments to new() are optional.  If string_date is not supplied, the present system date is
 211 used.  If date_format is not supplied, the system preference from C4::Context is used.
 212
 213 Examples:
 214
 215                 my $now   = C4::Dates->new();
 216                 my $date1 = C4::Dates->new("09-21-1989","us");
 217                 my $date2 = C4::Dates->new("19890921    143907","sql");
 218
 219 =head2 ->output([date_format])
 220
 221 The date value is stored independent of any specific format.  Therefore any format can be
 222 invoked when displaying it.
 223
 224                 my $date = C4::Dates->new();    # say today is July 12th, 2010
 225                 print $date->output("iso");     # prints "2010-07-12"
 226                 print "\n";
 227                 print $date->output("metric");  # prints "12-07-2010"
 228
 229 However, it is still necessary to know the format of any incoming date value (e.g.,
 230 setting the value of an object with new()).  Like new(), output() assumes the system preference
 231 date format unless otherwise instructed.
 232
 233 =head2 ->format([date_format])
 234
 235 With no argument, format returns the object's current date_format.  Otherwise it attempts to
 236 set the object format to the supplied value.
 237
 238 Some previously desireable functions are now unnecessary.  For example, you might want a
 239 method/function to tell you whether or not a Dates.pm object is of the 'iso' type.  But you
 240 can see by this example that such a test is trivial to accomplish, and not necessary to
 241 include in the module:
 242
 243                 sub is_iso {
 244                         my $self = shift;
 245                         return ($self->format() eq "iso");
 246                 }
 247
 248 Note: A similar function would need to be included for each format.
 249
 250 Instead a dependent script can retrieve the format of the object directly and decide what to
 251 do with it from there:
 252
 253                 my $date = C4::Dates->new();
 254                 my $format = $date->format();
 255                 ($format eq "iso") or do_something($date);
 256
 257 Or if you just want to print a given value and format, no problem:
 258
 259                 my $date = C4::Dates->new("1989-09-21", "iso");
 260                 print $date->output;
 261
 262 Alternatively:
 263
 264                 print C4::Dates->new("1989-09-21", "iso")->output;
 265
 266 Or even:
 267
 268                 print C4::Dates->new("21-09-1989", "metric")->output("iso");
 269
 270 =head2 "syspref" -- System Preference(s)
 271
 272 Perhaps you want to force data obtained in a known format to display according to the user's system
 273 preference, without necessarily knowing what that preference is.  For this purpose, you can use the
 274 psuedo-format argument "syspref".
 275
 276 For example, to print an ISO date (from the database) in the <systempreference> format:
 277
 278                 my $date = C4::Dates->new($date_from_database,"iso");
 279                 my $datestring_for_display = $date->output("syspref");
 280                 print $datestring_for_display;
 281
 282 Or even:
 283
 284                 print C4::Dates->new($date_from_database,"iso")->output("syspref");
 285
 286 If you just want to know what the <systempreferece> is, a default Dates object can tell you:
 287
 288                 C4::Dates->new()->format();
 289
 290 =head2 ->DHMTLcalendar([date_format])
 291
 292 Returns the format string for DHTML Calendar Display based on date_format.
 293 If date_format is not supplied, the return is based on system preference.
 294
 295                 C4::Dates->DHTMLcalendar();     #  e.g., returns "%m/%d/%Y" for 'us' system preference
 296
 297 =head3 Error Handling
 298
 299 Some error handling is provided in this module, but not all.  Requesting an unknown format is a
 300 fatal error (because it is programmer error, not user error, typically).
 301
 302 Scripts must still perform validation of user input.  Attempting to set an invalid value will
 303 return 0 or undefined, so a script might check as follows:
 304
 305                 my $date = C4::Dates->new($input) or deal_with_it("$input didn't work");
 306
 307 To validate before creating a new object, use the regexp method of the class:
 308
 309                 $input =~ C4::Dates->regexp("iso") or deal_with_it("input ($input) invalid as iso format");
 310                 my $date = C4::Dates->new($input,"iso");
 311
 312 More verbose debugging messages are sent in the presence of non-zero $ENV{"DEBUG"}.
 313
 314 Notes: if the date in the db is null or empty, interpret null expiration to mean "never expires".
 315
 316 =head3 _prefformat()
 317
 318 This internal function is used to read the preferred date format
 319 from the system preference table.  It reads the preference once,
 320 then caches it.
 321
 322 This replaces using the package variable $prefformat directly, and
 323 specifically, doing a call to C4::Context->preference() during
 324 module initialization.  That way, C4::Dates no longer has a
 325 compile-time dependency on having a valid $dbh.
 326
 327 =head3 TO DO
 328
 329 If the date format is not in <systempreference>, we should send an error back to the user.
 330 This kind of check should be centralized somewhere.  Probably not here, though.
 331
 332 =cut
 333