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