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
  10 # under the terms of the GNU General Public License as published by
  11 # the Free Software Foundation; either version 3 of the License, or
  12 # (at your option) any later version.
  13 #
  14 # Koha is distributed in the hope that it will be useful, but
  15 # WITHOUT ANY WARRANTY; without even the implied warranty of
  16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  17 # GNU General Public License for more details.
  18 #
  19 # You should have received a copy of the GNU General Public License
  20 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  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   = 3.07.00.049;
  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;
 103     my $dformat = $self->{'dateformat'} or return;
 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
 127     my ($month_abbr, $day_abbr); # keep perlcritic happy ;)
 128     ($month_abbr, $day_abbr) = ($aref->[4], $aref->[3]) if $dformat eq 'rfc822';
 129
 130     for( my $i = 0; $i < scalar(@months); $i++ ) {
 131         if ( $months[$i] =~ /$month_abbr/ ) {
 132             $aref->[4] = $i-1;
 133             last;
 134         }
 135     };
 136
 137     for( my $i = 0; $i < scalar(@days); $i++ ) {
 138         if ( $days[$i] =~ /$day_abbr/ ) {
 139             $aref->[3] = $i;
 140             last;
 141         }
 142     };
 143     return $aref;
 144 }
 145
 146 sub _check_date_and_time {
 147     my $chron_ref = shift;
 148     my ( $year, $month, $day ) = _chron_to_ymd($chron_ref);
 149     unless ( check_date( $year, $month, $day ) ) {
 150         carp "Illegal date specified (year = $year, month = $month, day = $day)";
 151     }
 152     my ( $hour, $minute, $second ) = _chron_to_hms($chron_ref);
 153     unless ( check_time( $hour, $minute, $second ) ) {
 154         carp "Illegal time specified (hour = $hour, minute = $minute, second = $second)";
 155     }
 156 }
 157
 158 sub _chron_to_ymd {
 159     my $chron_ref = shift;
 160     return ( $chron_ref->[5] + 1900, $chron_ref->[4] + 1, $chron_ref->[3] );
 161 }
 162
 163 sub _chron_to_hms {
 164     my $chron_ref = shift;
 165     return ( $chron_ref->[2], $chron_ref->[1], $chron_ref->[0] );
 166 }
 167
 168 sub new {
 169     my $this  = shift;
 170     my $class = ref($this) || $this;
 171     my $self  = {};
 172     bless $self, $class;
 173     return $self->init(@_);
 174 }
 175
 176 sub init {
 177     my $self = shift;
 178     my $dformat;
 179     $self->{'dateformat'} = $dformat = ( scalar(@_) >= 2 ) ? $_[1] : _prefformat();
 180     ( $format_map{$dformat} ) or croak "Invalid date format '$dformat' from " . ( ( scalar(@_) >= 2 ) ? 'argument' : 'system preferences' );
 181     $self->{'dmy_arrayref'} = [ ( (@_) ? $self->dmy_map(shift) : localtime ) ];
 182     if ($debug && $debug > 1) { warn "(during init) \@\$self->{'dmy_arrayref'}: " . join( ' ', @{ $self->{'dmy_arrayref'} } ) . "\n"; }
 183     return $self;
 184 }
 185
 186 sub output {
 187     my $self = shift;
 188     my $newformat = (@_) ? _recognize_format(shift) : _prefformat();
 189     return ( eval { POSIX::strftime( $posix_map{$newformat}, @{ $self->{'dmy_arrayref'} } ) } || undef );
 190 }
 191
 192 sub today {    # NOTE: sets date value to today (and returns it in the requested or current format)
 193     my $class = shift;
 194     $class = ref($class) || $class;
 195     my $format = (@_) ? _recognize_format(shift) : _prefformat();
 196     return $class->new()->output($format);
 197 }
 198
 199 sub _recognize_format {
 200     my $incoming = shift;
 201     ( $incoming eq 'syspref' ) and return _prefformat();
 202     ( scalar grep ( /^$incoming$/, keys %format_map ) == 1 ) or croak "The format you asked for ('$incoming') is unrecognized.";
 203     return $incoming;
 204 }
 205
 206 sub DHTMLcalendar {    # interface to posix_map
 207     my $class = shift;
 208     my $format = (@_) ? shift : _prefformat();
 209     return $posix_map{$format};
 210 }
 211
 212 sub format {                 # get or set dateformat: iso, metric, us, etc.
 213     my $self = shift;
 214     (@_) or return $self->{'dateformat'};
 215     $self->{'dateformat'} = _recognize_format(shift);
 216 }
 217
 218 sub visual {
 219     my $self = shift;
 220     if (@_) {
 221         return $format_map{ _recognize_format(shift) };
 222     }
 223     $self eq __PACKAGE__ and return $format_map{ _prefformat() };
 224     return $format_map{ eval { $self->{'dateformat'} } || _prefformat() };
 225 }
 226
 227 # like the functions from the old C4::Date.pm
 228 sub format_date {
 229     return __PACKAGE__->new( shift, 'iso' )->output( (@_) ? shift : _prefformat() );
 230 }
 231
 232 sub format_date_in_iso {
 233     return __PACKAGE__->new( shift, _prefformat() )->output('iso');
 234 }
 235
 236 1;
 237 __END__
 238
 239 =head1 C4::Dates.pm - a more object-oriented replacement for Date.pm.
 240
 241 The core problem to address is the multiplicity of formats used by different Koha
 242 installations around the world.  We needed to move away from any hard-coded values at
 243 the script level, for example in initial form values or checks for min/max date. The
 244 reason is clear when you consider string '07/01/2004'.  Depending on the format, it
 245 represents July 1st (us), or January 7th (metric), or an invalid value (iso).
 246
 247 The formats supported by Koha are:
 248     iso - ISO 8601 (extended)
 249     us - U.S. standard
 250     metric - European standard (slight misnomer, not really decimalized metric)
 251     sql - log format, not really for human consumption
 252     rfc822 - Standard for using with RSS feeds, etc.
 253
 254 =head2 ->new([string_date,][date_format])
 255
 256 Arguments to new() are optional.  If string_date is not supplied, the present system date is
 257 used.  If date_format is not supplied, the system preference from C4::Context is used.
 258
 259 Examples:
 260
 261         my $now   = C4::Dates->new();
 262         my $date1 = C4::Dates->new("09-21-1989","us");
 263         my $date2 = C4::Dates->new("19890921    143907","sql");
 264
 265 =head2 ->output([date_format])
 266
 267 The date value is stored independent of any specific format.  Therefore any format can be
 268 invoked when displaying it.
 269
 270         my $date = C4::Dates->new();    # say today is July 12th, 2010
 271         print $date->output("iso");     # prints "2010-07-12"
 272         print "\n";
 273         print $date->output("metric");  # prints "12-07-2010"
 274
 275 However, it is still necessary to know the format of any incoming date value (e.g.,
 276 setting the value of an object with new()).  Like new(), output() assumes the system preference
 277 date format unless otherwise instructed.
 278
 279 =head2 ->format([date_format])
 280
 281 With no argument, format returns the object's current date_format.  Otherwise it attempts to
 282 set the object format to the supplied value.
 283
 284 Some previously desireable functions are now unnecessary.  For example, you might want a
 285 method/function to tell you whether or not a Dates.pm object is of the 'iso' type.  But you
 286 can see by this example that such a test is trivial to accomplish, and not necessary to
 287 include in the module:
 288
 289         sub is_iso {
 290             my $self = shift;
 291             return ($self->format() eq "iso");
 292         }
 293
 294 Note: A similar function would need to be included for each format.
 295
 296 Instead a dependent script can retrieve the format of the object directly and decide what to
 297 do with it from there:
 298
 299         my $date = C4::Dates->new();
 300         my $format = $date->format();
 301         ($format eq "iso") or do_something($date);
 302
 303 Or if you just want to print a given value and format, no problem:
 304
 305         my $date = C4::Dates->new("1989-09-21", "iso");
 306         print $date->output;
 307
 308 Alternatively:
 309
 310         print C4::Dates->new("1989-09-21", "iso")->output;
 311
 312 Or even:
 313
 314         print C4::Dates->new("21-09-1989", "metric")->output("iso");
 315
 316 =head2 "syspref" -- System Preference(s)
 317
 318 Perhaps you want to force data obtained in a known format to display according to the user's system
 319 preference, without necessarily knowing what that preference is.  For this purpose, you can use the
 320 psuedo-format argument "syspref".
 321
 322 For example, to print an ISO date (from the database) in the <systempreference> format:
 323
 324         my $date = C4::Dates->new($date_from_database,"iso");
 325         my $datestring_for_display = $date->output("syspref");
 326         print $datestring_for_display;
 327
 328 Or even:
 329
 330         print C4::Dates->new($date_from_database,"iso")->output("syspref");
 331
 332 If you just want to know what the <systempreferece> is, a default Dates object can tell you:
 333
 334         C4::Dates->new()->format();
 335
 336 =head2 ->DHMTLcalendar([date_format])
 337
 338 Returns the format string for DHTML Calendar Display based on date_format.
 339 If date_format is not supplied, the return is based on system preference.
 340
 341         C4::Dates->DHTMLcalendar(); #  e.g., returns "%m/%d/%Y" for 'us' system preference
 342
 343 =head3 Error Handling
 344
 345 Some error handling is provided in this module, but not all.  Requesting an unknown format is a
 346 fatal error (because it is programmer error, not user error, typically).
 347
 348 Scripts must still perform validation of user input.  Attempting to set an invalid value will
 349 return 0 or undefined, so a script might check as follows:
 350
 351         my $date = C4::Dates->new($input) or deal_with_it("$input didn't work");
 352
 353 To validate before creating a new object, use the regexp method of the class:
 354
 355         $input =~ C4::Dates->regexp("iso") or deal_with_it("input ($input) invalid as iso format");
 356         my $date = C4::Dates->new($input,"iso");
 357
 358 More verbose debugging messages are sent in the presence of non-zero $ENV{"DEBUG"}.
 359
 360 Notes: if the date in the db is null or empty, interpret null expiration to mean "never expires".
 361
 362 =head3 _prefformat()
 363
 364 This internal function is used to read the preferred date format
 365 from the system preference table.  It reads the preference once,
 366 then caches it.
 367
 368 This replaces using the package variable $prefformat directly, and
 369 specifically, doing a call to C4::Context->preference() during
 370 module initialization.  That way, C4::Dates no longer has a
 371 compile-time dependency on having a valid $dbh.
 372
 373 =head3 TO DO
 374
 375 If the date format is not in <systempreference>, we should send an error back to the user.
 376 This kind of check should be centralized somewhere.  Probably not here, though.
 377
 378 =cut
 379