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