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