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