C4/Dates.pm

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