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