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