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