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