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 today ($;$) {               # NOTE: sets date value to today (and returns it in the requested or current format)
 148         my $class = shift;
 149         $class = ref($class) || $class;
 150         my $format = (@_) ? _recognize_format(shift) : _prefformat();
 151         return $class->new()->output($format);
 152 }
 153 sub _recognize_format($) {
 154         my $incoming = shift;
 155         ($incoming eq 'syspref') and return _prefformat();
 156         (scalar grep (/^$incoming$/, keys %format_map) == 1) or croak "The format you asked for ('$incoming') is unrecognized.";
 157         return $incoming;
 158 }
 159 sub DHTMLcalendar ($;$) {       # interface to posix_map
 160         my $class = shift;
 161         my $format = (@_) ? shift : _prefformat();
 162         return $posix_map{$format};
 163 }
 164 sub format {    # get or set dateformat: iso, metric, us, etc.
 165         my $self = shift;
 166         (@_) or return $self->{'dateformat'};
 167         $self->{'dateformat'} = _recognize_format(shift);
 168 }
 169 sub visual {
 170         my $self = shift;
 171         if (@_) {
 172                 return $format_map{ _recognize_format(shift) };
 173         }
 174         $self eq __PACKAGE__ and return $format_map{_prefformat()};
 175         return $format_map{ eval { $self->{'dateformat'} } || _prefformat()} ;
 176 }
 177
 178 # like the functions from the old C4::Date.pm
 179 sub format_date {
 180         return __PACKAGE__ -> new(shift,'iso')->output((@_) ? shift : _prefformat());
 181 }
 182 sub format_date_in_iso {
 183         return __PACKAGE__ -> new(shift,_prefformat())->output('iso');
 184 }
 185
 186 1;
 187 __END__
 188
 189 =head1 C4::Dates.pm - a more object-oriented replacement for Date.pm.
 190
 191 The core problem to address is the multiplicity of formats used by different Koha
 192 installations around the world.  We needed to move away from any hard-coded values at
 193 the script level, for example in initial form values or checks for min/max date. The
 194 reason is clear when you consider string '07/01/2004'.  Depending on the format, it
 195 represents July 1st (us), or January 7th (metric), or an invalid value (iso).
 196
 197 The formats supported by Koha are:
 198     iso - ISO 8601 (extended)
 199     us - U.S. standard
 200     metric - European standard (slight misnomer, not really decimalized metric)
 201     sql - log format, not really for human consumption
 202
 203 =head2 ->new([string_date,][date_format])
 204
 205 Arguments to new() are optional.  If string_date is not supplied, the present system date is
 206 used.  If date_format is not supplied, the system preference from C4::Context is used.
 207
 208 Examples:
 209
 210                 my $now   = C4::Dates->new();
 211                 my $date1 = C4::Dates->new("09-21-1989","us");
 212                 my $date2 = C4::Dates->new("19890921    143907","sql");
 213
 214 =head2 ->output([date_format])
 215
 216 The date value is stored independent of any specific format.  Therefore any format can be
 217 invoked when displaying it.
 218
 219                 my $date = C4::Dates->new();    # say today is July 12th, 2010
 220                 print $date->output("iso");     # prints "2010-07-12"
 221                 print "\n";
 222                 print $date->output("metric");  # prints "12-07-2010"
 223
 224 However, it is still necessary to know the format of any incoming date value (e.g.,
 225 setting the value of an object with new()).  Like new(), output() assumes the system preference
 226 date format unless otherwise instructed.
 227
 228 =head2 ->format([date_format])
 229
 230 With no argument, format returns the object's current date_format.  Otherwise it attempts to
 231 set the object format to the supplied value.
 232
 233 Some previously desireable functions are now unnecessary.  For example, you might want a
 234 method/function to tell you whether or not a Dates.pm object is of the 'iso' type.  But you
 235 can see by this example that such a test is trivial to accomplish, and not necessary to
 236 include in the module:
 237
 238                 sub is_iso {
 239                         my $self = shift;
 240                         return ($self->format() eq "iso");
 241                 }
 242
 243 Note: A similar function would need to be included for each format.
 244
 245 Instead a dependent script can retrieve the format of the object directly and decide what to
 246 do with it from there:
 247
 248                 my $date = C4::Dates->new();
 249                 my $format = $date->format();
 250                 ($format eq "iso") or do_something($date);
 251
 252 Or if you just want to print a given value and format, no problem:
 253
 254                 my $date = C4::Dates->new("1989-09-21", "iso");
 255                 print $date->output;
 256
 257 Alternatively:
 258
 259                 print C4::Dates->new("1989-09-21", "iso")->output;
 260
 261 Or even:
 262
 263                 print C4::Dates->new("21-09-1989", "metric")->output("iso");
 264
 265 =head2 "syspref" -- System Preference(s)
 266
 267 Perhaps you want to force data obtained in a known format to display according to the user's system
 268 preference, without necessarily knowing what that preference is.  For this purpose, you can use the
 269 psuedo-format argument "syspref".
 270
 271 For example, to print an ISO date (from the database) in the <systempreference> format:
 272
 273                 my $date = C4::Dates->new($date_from_database,"iso");
 274                 my $datestring_for_display = $date->output("syspref");
 275                 print $datestring_for_display;
 276
 277 Or even:
 278
 279                 print C4::Dates->new($date_from_database,"iso")->output("syspref");
 280
 281 If you just want to know what the <systempreferece> is, a default Dates object can tell you:
 282
 283                 C4::Dates->new()->format();
 284
 285 =head2 ->DHMTLcalendar([date_format])
 286
 287 Returns the format string for DHTML Calendar Display based on date_format.
 288 If date_format is not supplied, the return is based on system preference.
 289
 290                 C4::Dates->DHTMLcalendar();     #  e.g., returns "%m/%d/%Y" for 'us' system preference
 291
 292 =head3 Error Handling
 293
 294 Some error handling is provided in this module, but not all.  Requesting an unknown format is a
 295 fatal error (because it is programmer error, not user error, typically).
 296
 297 Scripts must still perform validation of user input.  Attempting to set an invalid value will
 298 return 0 or undefined, so a script might check as follows:
 299
 300                 my $date = C4::Dates->new($input) or deal_with_it("$input didn't work");
 301
 302 To validate before creating a new object, use the regexp method of the class:
 303
 304                 $input =~ C4::Dates->regexp("iso") or deal_with_it("input ($input) invalid as iso format");
 305                 my $date = C4::Dates->new($input,"iso");
 306
 307 More verbose debugging messages are sent in the presence of non-zero $ENV{"DEBUG"}.
 308
 309 Notes: if the date in the db is null or empty, interpret null expiration to mean "never expires".
 310
 311 =head3 _prefformat()
 312
 313 This internal function is used to read the preferred date format
 314 from the system preference table.  It reads the preference once,
 315 then caches it.
 316
 317 This replaces using the package variable $prefformat directly, and
 318 specifically, doing a call to C4::Context->preference() during
 319 module initialization.  That way, C4::Dates no longer has a
 320 compile-time dependency on having a valid $dbh.
 321
 322 =head3 TO DO
 323
 324 If the date format is not in <systempreference>, we should send an error back to the user.
 325 This kind of check should be centralized somewhere.  Probably not here, though.
 326
 327 =cut
 328