C4/Dates.pm

   1 package C4::Dates;
   2
   3 # Copyright 2007 Liblime
   4 # Parts Copyright ACPL 2011
   5 # Parts Copyright Catalyst IT 2012
   6 #
   7 # This file is part of Koha.
   8 #
   9 # Koha is free software; you can redistribute it and/or modify it under the
  10 # terms of the GNU General Public License as published by the Free Software
  11 # Foundation; either version 2 of the License, or (at your option) any later
  12 # version.
  13 #
  14 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  15 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  16 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU General Public License along
  19 # with Koha; if not, write to the Free Software Foundation, Inc.,
  20 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  21
  22 use strict;
  23 use warnings;
  24 use Carp;
  25 use C4::Context;
  26 use C4::Debug;
  27 use Exporter;
  28 use POSIX qw(strftime);
  29 use Date::Calc qw(check_date check_time);
  30 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  31 use vars qw($debug $cgi_debug);
  32
  33 BEGIN {
  34     $VERSION   = 0.04;
  35     @ISA       = qw(Exporter);
  36     @EXPORT_OK = qw(format_date_in_iso format_date);
  37 }
  38
  39 use vars qw($prefformat);
  40
  41 sub _prefformat {
  42     unless ( defined $prefformat ) {
  43         $prefformat = C4::Context->preference('dateformat');
  44     }
  45     return $prefformat;
  46 }
  47
  48 sub reset_prefformat {  # subroutine to clear the prefformat, called when we change it
  49     if (defined $prefformat){
  50         $prefformat = C4::Context->preference('dateformat');
  51     }
  52 }
  53
  54 our %format_map = (
  55     iso    => 'yyyy-mm-dd',           # plus " HH:MM:SS"
  56     metric => 'dd/mm/yyyy',           # plus " HH:MM:SS"
  57     us     => 'mm/dd/yyyy',           # plus " HH:MM:SS"
  58     sql    => 'yyyymmdd    HHMMSS',
  59     rfc822 => 'a, dd b y HH:MM:SS z ',
  60 );
  61 our %posix_map = (
  62     iso    => '%Y-%m-%d',             # or %F, "Full Date"
  63     metric => '%d/%m/%Y',
  64     us     => '%m/%d/%Y',
  65     sql    => '%Y%m%d    %H%M%S',
  66     rfc822 => '%a, %d %b %Y %H:%M:%S %z',
  67 );
  68
  69 our %dmy_subs = (                     # strings to eval  (after using regular expression returned by regexp below)
  70                                       # make arrays for POSIX::strftime()
  71     iso    => '[(($6||0),($5||0),($4||0),$3, $2 - 1, $1 - 1900)]',
  72     metric => '[(($6||0),($5||0),($4||0),$1, $2 - 1, $3 - 1900)]',
  73     us     => '[(($6||0),($5||0),($4||0),$2, $1 - 1, $3 - 1900)]',
  74     sql    => '[(($6||0),($5||0),($4||0),$3, $2 - 1, $1 - 1900)]',
  75     rfc822 => '[($7, $6, $5, $2, $3, $4 - 1900, $8)]',
  76 );
  77
  78 our @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
  79
  80 our @days = qw(Sun Mon Tue Wed Thu Fri Sat);
  81
  82 sub regexp ($;$) {
  83     my $self   = shift;
  84     my $delim  = qr/:?\:|\/|-/;                                                                  # "non memory" cluster: no backreference
  85     my $format = (@_) ? _recognize_format(shift) : ( $self->{'dateformat'} || _prefformat() );
  86
  87     # Extra layer of checking $self->{'dateformat'}.
  88     # Why?  Because it is assumed you might want to check regexp against an *instantiated* Dates object as a
  89     # way of saying "does this string match *whatever* format that Dates object is?"
  90
  91     ( $format eq 'sql' )
  92       and return qr/^(\d{4})(\d{1,2})(\d{1,2})(?:\s{4}(\d{2})(\d{2})(\d{2}))?/;
  93     ( $format eq 'iso' )
  94       and return qr/^(\d{4})$delim(\d{1,2})$delim(\d{1,2})(?:(?:\s{1}|T)(\d{2})\:?(\d{2})\:?(\d{2}))?Z?/;
  95     ( $format eq 'rfc822' )
  96       and return qr/^([a-zA-Z]{3}),\s{1}(\d{1,2})\s{1}([a-zA-Z]{3})\s{1}(\d{4})\s{1}(\d{1,2})\:(\d{1,2})\:(\d{1,2})\s{1}(([\-|\+]\d{4})|([A-Z]{3}))/;
  97     return qr/^(\d{1,2})$delim(\d{1,2})$delim(\d{4})(?:\s{1}(\d{1,2})\:?(\d{1,2})\:?(\d{1,2}))?/;    # everything else
  98 }
  99
 100 sub dmy_map ($$) {
 101     my $self    = shift;
 102     my $val     = shift or return undef;
 103     my $dformat = $self->{'dateformat'} or return undef;
 104     my $re      = $self->regexp();
 105     my $xsub    = $dmy_subs{$dformat};
 106     $debug and print STDERR "xsub: $xsub \n";
 107     if ( $val =~ /$re/ ) {
 108         my $aref = eval $xsub;
 109         if ($dformat eq 'rfc822') {
 110             $aref = _abbr_to_numeric($aref, $dformat);
 111             pop(@{$aref}); #pop off tz offset because we are not setup to handle tz conversions just yet
 112         }
 113         _check_date_and_time($aref);
 114         push @{$aref}, (-1,-1,1); # for some reason unknown to me, setting isdst to -1 or undef causes strftime to fail to return the tz offset which is required in RFC822 format -chris_n
 115         return @{$aref};
 116     }
 117
 118     # $debug and
 119     carp "Illegal Date '$val' does not match '$dformat' format: " . $self->visual();
 120     return 0;
 121 }
 122
 123 sub _abbr_to_numeric {
 124     my $aref    = shift;
 125     my $dformat = shift;
 126     my ($month_abbr, $day_abbr) = ($aref->[4], $aref->[3]) if $dformat eq 'rfc822';
 127
 128     for( my $i = 0; $i < scalar(@months); $i++ ) {
 129         if ( $months[$i] =~ /$month_abbr/ ) {
 130             $aref->[4] = $i-1;
 131             last;
 132         }
 133     };
 134
 135     for( my $i = 0; $i < scalar(@days); $i++ ) {
 136         if ( $days[$i] =~ /$day_abbr/ ) {
 137             $aref->[3] = $i;
 138             last;
 139         }
 140     };
 141     return $aref;
 142 }
 143
 144 sub _check_date_and_time {
 145     my $chron_ref = shift;
 146     my ( $year, $month, $day ) = _chron_to_ymd($chron_ref);
 147     unless ( check_date( $year, $month, $day ) ) {
 148         carp "Illegal date specified (year = $year, month = $month, day = $day)";
 149     }
 150     my ( $hour, $minute, $second ) = _chron_to_hms($chron_ref);
 151     unless ( check_time( $hour, $minute, $second ) ) {
 152         carp "Illegal time specified (hour = $hour, minute = $minute, second = $second)";
 153     }
 154 }
 155
 156 sub _chron_to_ymd {
 157     my $chron_ref = shift;
 158     return ( $chron_ref->[5] + 1900, $chron_ref->[4] + 1, $chron_ref->[3] );
 159 }
 160
 161 sub _chron_to_hms {
 162     my $chron_ref = shift;
 163     return ( $chron_ref->[2], $chron_ref->[1], $chron_ref->[0] );
 164 }
 165
 166 sub new {
 167     my $this  = shift;
 168     my $class = ref($this) || $this;
 169     my $self  = {};
 170     bless $self, $class;
 171     return $self->init(@_);
 172 }
 173
 174 sub init ($;$$) {
 175     my $self = shift;
 176     my $dformat;
 177     $self->{'dateformat'} = $dformat = ( scalar(@_) >= 2 ) ? $_[1] : _prefformat();
 178     ( $format_map{$dformat} ) or croak "Invalid date format '$dformat' from " . ( ( scalar(@_) >= 2 ) ? 'argument' : 'system preferences' );
 179     $self->{'dmy_arrayref'} = [ ( (@_) ? $self->dmy_map(shift) : localtime ) ];
 180     if ($debug && $debug > 1) { warn "(during init) \@\$self->{'dmy_arrayref'}: " . join( ' ', @{ $self->{'dmy_arrayref'} } ) . "\n"; }
 181     return $self;
 182 }
 183
 184 sub output ($;$) {
 185     my $self = shift;
 186     my $newformat = (@_) ? _recognize_format(shift) : _prefformat();
 187     return ( eval { POSIX::strftime( $posix_map{$newformat}, @{ $self->{'dmy_arrayref'} } ) } || undef );
 188 }
 189
 190 sub today ($;$) {    # NOTE: sets date value to today (and returns it in the requested or current format)
 191     my $class = shift;
 192     $class = ref($class) || $class;
 193     my $format = (@_) ? _recognize_format(shift) : _prefformat();
 194     return $class->new()->output($format);
 195 }
 196
 197 sub _recognize_format($) {
 198     my $incoming = shift;
 199     ( $incoming eq 'syspref' ) and return _prefformat();
 200     ( scalar grep ( /^$incoming$/, keys %format_map ) == 1 ) or croak "The format you asked for ('$incoming') is unrecognized.";
 201     return $incoming;
 202 }
 203
 204 sub DHTMLcalendar ($;$) {    # interface to posix_map
 205     my $class = shift;
 206     my $format = (@_) ? shift : _prefformat();
 207     return $posix_map{$format};
 208 }
 209
 210 sub format {                 # get or set dateformat: iso, metric, us, etc.
 211     my $self = shift;
 212     (@_) or return $self->{'dateformat'};
 213     $self->{'dateformat'} = _recognize_format(shift);
 214 }
 215
 216 sub visual {
 217     my $self = shift;
 218     if (@_) {
 219         return $format_map{ _recognize_format(shift) };
 220     }
 221     $self eq __PACKAGE__ and return $format_map{ _prefformat() };
 222     return $format_map{ eval { $self->{'dateformat'} } || _prefformat() };
 223 }
 224
 225 # like the functions from the old C4::Date.pm
 226 sub format_date {
 227     return __PACKAGE__->new( shift, 'iso' )->output( (@_) ? shift : _prefformat() );
 228 }
 229
 230 sub format_date_in_iso {
 231     return __PACKAGE__->new( shift, _prefformat() )->output('iso');
 232 }
 233
 234 1;
 235 __END__
 236
 237 =head1 C4::Dates.pm - a more object-oriented replacement for Date.pm.
 238
 239 The core problem to address is the multiplicity of formats used by different Koha
 240 installations around the world.  We needed to move away from any hard-coded values at
 241 the script level, for example in initial form values or checks for min/max date. The
 242 reason is clear when you consider string '07/01/2004'.  Depending on the format, it
 243 represents July 1st (us), or January 7th (metric), or an invalid value (iso).
 244
 245 The formats supported by Koha are:
 246     iso - ISO 8601 (extended)
 247     us - U.S. standard
 248     metric - European standard (slight misnomer, not really decimalized metric)
 249     sql - log format, not really for human consumption
 250     rfc822 - Standard for using with RSS feeds, etc.
 251
 252 =head2 ->new([string_date,][date_format])
 253
 254 Arguments to new() are optional.  If string_date is not supplied, the present system date is
 255 used.  If date_format is not supplied, the system preference from C4::Context is used.
 256
 257 Examples:
 258
 259         my $now   = C4::Dates->new();
 260         my $date1 = C4::Dates->new("09-21-1989","us");
 261         my $date2 = C4::Dates->new("19890921    143907","sql");
 262
 263 =head2 ->output([date_format])
 264
 265 The date value is stored independent of any specific format.  Therefore any format can be
 266 invoked when displaying it.
 267
 268         my $date = C4::Dates->new();    # say today is July 12th, 2010
 269         print $date->output("iso");     # prints "2010-07-12"
 270         print "\n";
 271         print $date->output("metric");  # prints "12-07-2010"
 272
 273 However, it is still necessary to know the format of any incoming date value (e.g.,
 274 setting the value of an object with new()).  Like new(), output() assumes the system preference
 275 date format unless otherwise instructed.
 276
 277 =head2 ->format([date_format])
 278
 279 With no argument, format returns the object's current date_format.  Otherwise it attempts to
 280 set the object format to the supplied value.
 281
 282 Some previously desireable functions are now unnecessary.  For example, you might want a
 283 method/function to tell you whether or not a Dates.pm object is of the 'iso' type.  But you
 284 can see by this example that such a test is trivial to accomplish, and not necessary to
 285 include in the module:
 286
 287         sub is_iso {
 288             my $self = shift;
 289             return ($self->format() eq "iso");
 290         }
 291
 292 Note: A similar function would need to be included for each format.
 293
 294 Instead a dependent script can retrieve the format of the object directly and decide what to
 295 do with it from there:
 296
 297         my $date = C4::Dates->new();
 298         my $format = $date->format();
 299         ($format eq "iso") or do_something($date);
 300
 301 Or if you just want to print a given value and format, no problem:
 302
 303         my $date = C4::Dates->new("1989-09-21", "iso");
 304         print $date->output;
 305
 306 Alternatively:
 307
 308         print C4::Dates->new("1989-09-21", "iso")->output;
 309
 310 Or even:
 311
 312         print C4::Dates->new("21-09-1989", "metric")->output("iso");
 313
 314 =head2 "syspref" -- System Preference(s)
 315
 316 Perhaps you want to force data obtained in a known format to display according to the user's system
 317 preference, without necessarily knowing what that preference is.  For this purpose, you can use the
 318 psuedo-format argument "syspref".
 319
 320 For example, to print an ISO date (from the database) in the <systempreference> format:
 321
 322         my $date = C4::Dates->new($date_from_database,"iso");
 323         my $datestring_for_display = $date->output("syspref");
 324         print $datestring_for_display;
 325
 326 Or even:
 327
 328         print C4::Dates->new($date_from_database,"iso")->output("syspref");
 329
 330 If you just want to know what the <systempreferece> is, a default Dates object can tell you:
 331
 332         C4::Dates->new()->format();
 333
 334 =head2 ->DHMTLcalendar([date_format])
 335
 336 Returns the format string for DHTML Calendar Display based on date_format.
 337 If date_format is not supplied, the return is based on system preference.
 338
 339         C4::Dates->DHTMLcalendar(); #  e.g., returns "%m/%d/%Y" for 'us' system preference
 340
 341 =head3 Error Handling
 342
 343 Some error handling is provided in this module, but not all.  Requesting an unknown format is a
 344 fatal error (because it is programmer error, not user error, typically).
 345
 346 Scripts must still perform validation of user input.  Attempting to set an invalid value will
 347 return 0 or undefined, so a script might check as follows:
 348
 349         my $date = C4::Dates->new($input) or deal_with_it("$input didn't work");
 350
 351 To validate before creating a new object, use the regexp method of the class:
 352
 353         $input =~ C4::Dates->regexp("iso") or deal_with_it("input ($input) invalid as iso format");
 354         my $date = C4::Dates->new($input,"iso");
 355
 356 More verbose debugging messages are sent in the presence of non-zero $ENV{"DEBUG"}.
 357
 358 Notes: if the date in the db is null or empty, interpret null expiration to mean "never expires".
 359
 360 =head3 _prefformat()
 361
 362 This internal function is used to read the preferred date format
 363 from the system preference table.  It reads the preference once,
 364 then caches it.
 365
 366 This replaces using the package variable $prefformat directly, and
 367 specifically, doing a call to C4::Context->preference() during
 368 module initialization.  That way, C4::Dates no longer has a
 369 compile-time dependency on having a valid $dbh.
 370
 371 =head3 TO DO
 372
 373 If the date format is not in <systempreference>, we should send an error back to the user.
 374 This kind of check should be centralized somewhere.  Probably not here, though.
 375
 376 =cut
 377