Koha/DateUtils.pm

   1 package Koha::DateUtils;
   2
   3 # Copyright (c) 2011 PTFS-Europe Ltd.
   4 # This file is part of Koha.
   5 #
   6 # Koha is free software; you can redistribute it and/or modify it
   7 # under the terms of the GNU General Public License as published by
   8 # the Free Software Foundation; either version 3 of the License, or
   9 # (at your option) any later version.
  10 #
  11 # Koha is distributed in the hope that it will be useful, but
  12 # WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  14 # GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License
  17 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  18
  19 use Modern::Perl;
  20 use DateTime;
  21 use C4::Context;
  22 use Koha::Exceptions;
  23 use Koha::DateTime::Format::RFC3339;
  24
  25 use vars qw(@ISA @EXPORT_OK);
  26 BEGIN {
  27     require Exporter;
  28     @ISA = qw(Exporter);
  29
  30     @EXPORT_OK = qw(
  31         dt_from_string
  32         output_pref
  33         format_sqldatetime
  34         flatpickr_date_format
  35     );
  36 }
  37
  38 =head1 DateUtils
  39
  40 Koha::DateUtils - Transitional wrappers to ease use of DateTime
  41
  42 =head1 DESCRIPTION
  43
  44 Koha has historically only used dates not datetimes and been content to
  45 handle these as strings. It also has confused formatting with actual dates
  46 this is a temporary module for wrappers to hide the complexity of switch to DateTime
  47
  48 =cut
  49
  50 =head2 dt_ftom_string
  51
  52 $dt = dt_from_string($date_string, [$format, $timezone ]);
  53
  54 Passed a date string returns a DateTime object format and timezone default
  55 to the system preferences. If the date string is empty DateTime->now is returned
  56
  57 =cut
  58
  59 sub dt_from_string {
  60     my ( $date_string, $date_format, $tz ) = @_;
  61
  62     return if $date_string and $date_string =~ m|^0000-0|;
  63
  64     my $do_fallback = defined($date_format) ? 0 : 1;
  65     my $server_tz = C4::Context->tz;
  66     $tz = C4::Context->tz unless $tz;
  67
  68     return DateTime->now( time_zone => $tz ) unless $date_string;
  69
  70     $date_format = C4::Context->preference('dateformat') unless $date_format;
  71
  72     if ( ref($date_string) eq 'DateTime' ) {    # already a dt return a clone
  73         return $date_string->clone();
  74     }
  75
  76     if ($date_format eq 'rfc3339') {
  77         return Koha::DateTime::Format::RFC3339->parse_datetime($date_string);
  78     }
  79
  80     my $regex;
  81
  82     # The fallback format is sql/iso
  83     my $fallback_re = qr|
  84         (?<year>\d{4})
  85         -
  86         (?<month>\d{2})
  87         -
  88         (?<day>\d{2})
  89     |xms;
  90
  91     if ( $date_format eq 'metric' ) {
  92         # metric format is "dd/mm/yyyy[ hh:mm:ss]"
  93         $regex = qr|
  94             (?<day>\d{2})
  95             /
  96             (?<month>\d{2})
  97             /
  98             (?<year>\d{4})
  99         |xms;
 100     }
 101     elsif ( $date_format eq 'dmydot' ) {
 102         # dmydot format is "dd.mm.yyyy[ hh:mm:ss]"
 103         $regex = qr|
 104             (?<day>\d{2})
 105             .
 106             (?<month>\d{2})
 107             .
 108             (?<year>\d{4})
 109         |xms;
 110     }
 111     elsif ( $date_format eq 'us' ) {
 112         # us format is "mm/dd/yyyy[ hh:mm:ss]"
 113         $regex = qr|
 114             (?<month>\d{2})
 115             /
 116             (?<day>\d{2})
 117             /
 118             (?<year>\d{4})
 119         |xms;
 120     }
 121     elsif ( $date_format eq 'iso' or $date_format eq 'sql' ) {
 122         # iso or sql format are yyyy-dd-mm[ hh:mm:ss]"
 123         $regex = $fallback_re;
 124     }
 125     else {
 126         die "Invalid dateformat parameter ($date_format)";
 127     }
 128
 129     # Add the facultative time part including time zone offset; ISO8601 allows +02 or +0200 too
 130     my $time_re = qr{
 131             (
 132                 [Tt]?
 133                 \s*
 134                 (?<hour>\d{2})
 135                 :
 136                 (?<minute>\d{2})
 137                 (
 138                     :
 139                     (?<second>\d{2})
 140                 )?
 141                 (
 142                     \s
 143                     (?<ampm>\w{2})
 144                 )?
 145                 (
 146                     (?<utc>[Zz]$)|((?<offset>[\+|\-])(?<hours>[01][0-9]|2[0-3]):?(?<minutes>[0-5][0-9])?)
 147                 )?
 148             )?
 149     }xms;
 150     $regex .= $time_re;
 151     $fallback_re .= $time_re;
 152
 153     # Ensure we only accept date strings and not other characters.
 154     $regex = '^' . $regex . '$';
 155     $fallback_re = '^' . $fallback_re . '$';
 156
 157     my %dt_params;
 158     my $ampm;
 159     if ( $date_string =~ $regex ) {
 160         %dt_params = (
 161             year   => $+{year},
 162             month  => $+{month},
 163             day    => $+{day},
 164             hour   => $+{hour},
 165             minute => $+{minute},
 166             second => $+{second},
 167         );
 168         $ampm = $+{ampm};
 169         if ( $+{utc} ) {
 170             $tz = DateTime::TimeZone->new( name => 'UTC' );
 171         }
 172         if ( $+{offset} ) {
 173             # If offset given, set inbound timezone using it.
 174             $tz = DateTime::TimeZone->new( name => $+{offset} . $+{hours} . ( $+{minutes} || '00' ) );
 175         }
 176     } elsif ( $do_fallback && $date_string =~ $fallback_re ) {
 177         %dt_params = (
 178             year   => $+{year},
 179             month  => $+{month},
 180             day    => $+{day},
 181             hour   => $+{hour},
 182             minute => $+{minute},
 183             second => $+{second},
 184         );
 185         $ampm = $+{ampm};
 186     }
 187     else {
 188         die "The given date ($date_string) does not match the date format ($date_format)";
 189     }
 190
 191     # system allows the 0th of the month
 192     $dt_params{day} = '01' if $dt_params{day} eq '00';
 193
 194     # Set default hh:mm:ss to 00:00:00
 195     my $date_only = ( !defined( $dt_params{hour} )
 196         && !defined( $dt_params{minute} )
 197         && !defined( $dt_params{second} ) );
 198     $dt_params{hour}   = 00 unless defined $dt_params{hour};
 199     $dt_params{minute} = 00 unless defined $dt_params{minute};
 200     $dt_params{second} = 00 unless defined $dt_params{second};
 201
 202     if ( $ampm ) {
 203         if ( $ampm eq 'AM' ) {
 204             $dt_params{hour} = 00 if $dt_params{hour} == 12;
 205         } elsif ( $dt_params{hour} != 12 ) { # PM
 206             $dt_params{hour} += 12;
 207             $dt_params{hour} = 00 if $dt_params{hour} == 24;
 208         }
 209     }
 210
 211     my $floating = 0;
 212     my $dt = eval {
 213         DateTime->new(
 214             %dt_params,
 215             # No TZ for dates 'infinite' => see bug 13242
 216             ( $dt_params{year} < 9999 ? ( time_zone => $tz ) : () ),
 217         );
 218     };
 219     if ($@) {
 220         $tz = DateTime::TimeZone->new( name => 'floating' );
 221         $floating = 1;
 222         $dt = DateTime->new(
 223             %dt_params,
 224             # No TZ for dates 'infinite' => see bug 13242
 225             ( $dt_params{year} < 9999 ? ( time_zone => $tz ) : () ),
 226         );
 227     }
 228
 229     # Convert to configured timezone (unless we started with a dateonly string or had to drop to floating time)
 230     $dt->set_time_zone($server_tz) unless ( $date_only || $floating );
 231
 232     return $dt;
 233 }
 234
 235 =head2 output_pref
 236
 237 $date_string = output_pref({ dt => $dt [, dateformat => $date_format, timeformat => $time_format, dateonly => 0|1, as_due_date => 0|1 ] });
 238 $date_string = output_pref( $dt );
 239
 240 Returns a string containing the time & date formatted as per the C4::Context setting,
 241 or C<undef> if C<undef> was provided.
 242
 243 This routine can either be passed a DateTime object or or a hashref.  If it is
 244 passed a hashref, the expected keys are a mandatory 'dt' for the DateTime,
 245 an optional 'dateformat' to override the dateformat system preference, an
 246 optional 'timeformat' to override the TimeFormat system preference value,
 247 and an optional 'dateonly' to specify that only the formatted date string
 248 should be returned without the time.
 249
 250 =cut
 251
 252 sub output_pref {
 253     my $params = shift;
 254     my ( $dt, $str, $force_pref, $force_time, $dateonly, $as_due_date );
 255     if ( ref $params eq 'HASH' ) {
 256         $dt         = $params->{dt};
 257         $str        = $params->{str};
 258         $force_pref = $params->{dateformat};         # if testing we want to override Context
 259         $force_time = $params->{timeformat};
 260         $dateonly   = $params->{dateonly} || 0;    # if you don't want the hours and minutes
 261         $as_due_date = $params->{as_due_date} || 0; # don't display the hours and minutes if eq to 23:59 or 11:59 (depending the TimeFormat value)
 262     } else {
 263         $dt = $params;
 264     }
 265
 266     Koha::Exceptions::WrongParameter->throw( 'output_pref should not be called with both dt and str parameter' ) if $dt and $str;
 267
 268     if ( $str ) {
 269         local $@;
 270         $dt = eval { dt_from_string( $str ) };
 271         Koha::Exceptions::WrongParameter->throw("Invalid date '$str' passed to output_pref" ) if $@;
 272     }
 273
 274     return if !defined $dt; # NULL date
 275     Koha::Exceptions::WrongParameter->throw( "output_pref is called with '$dt' (ref ". ( ref($dt) ? ref($dt):'SCALAR')."), not a DateTime object")  if ref($dt) ne 'DateTime';
 276
 277     # FIXME: see bug 13242 => no TZ for dates 'infinite'
 278     if ( $dt->ymd !~ /^9999/ ) {
 279         my $tz = $dateonly ? DateTime::TimeZone->new(name => 'floating') : C4::Context->tz;
 280         eval { $dt->set_time_zone( $tz ); }
 281     }
 282
 283     my $pref =
 284       defined $force_pref ? $force_pref : C4::Context->preference('dateformat');
 285
 286     my $time_format = $force_time || C4::Context->preference('TimeFormat') || q{};
 287     my $time = ( $time_format eq '12hr' ) ? '%I:%M %p' : '%H:%M';
 288     my $date;
 289     if ( $pref =~ m/^iso/ ) {
 290         $date = $dateonly
 291           ? $dt->strftime("%Y-%m-%d")
 292           : $dt->strftime("%Y-%m-%d $time");
 293     }
 294     elsif ( $pref =~ m/^rfc3339/ ) {
 295         if (!$dateonly) {
 296             $date = Koha::DateTime::Format::RFC3339->format_datetime($dt);
 297         }
 298         else {
 299             $date = $dt->strftime("%Y-%m-%d");
 300         }
 301     }
 302     elsif ( $pref =~ m/^metric/ ) {
 303         $date = $dateonly
 304           ? $dt->strftime("%d/%m/%Y")
 305           : $dt->strftime("%d/%m/%Y $time");
 306     }
 307     elsif ( $pref =~ m/^dmydot/ ) {
 308         $date = $dateonly
 309           ? $dt->strftime("%d.%m.%Y")
 310           : $dt->strftime("%d.%m.%Y $time");
 311     }
 312
 313     elsif ( $pref =~ m/^us/ ) {
 314         $date = $dateonly
 315           ? $dt->strftime("%m/%d/%Y")
 316           : $dt->strftime("%m/%d/%Y $time");
 317     }
 318     else {
 319         $date = $dateonly
 320           ? $dt->strftime("%Y-%m-%d")
 321           : $dt->strftime("%Y-%m-%d $time");
 322     }
 323
 324     if ( $as_due_date ) {
 325         $time_format eq '12hr'
 326             ? $date =~ s| 11:59 PM$||
 327             : $date =~ s| 23:59$||;
 328     }
 329
 330     return $date;
 331 }
 332
 333 =head2 format_sqldatetime
 334
 335 $string = format_sqldatetime( $string_as_returned_from_db );
 336
 337 a convenience routine for calling dt_from_string and formatting the result
 338 with output_pref as it is a frequent activity in scripts
 339
 340 =cut
 341
 342 sub format_sqldatetime {
 343     my $str        = shift;
 344     my $force_pref = shift;    # if testing we want to override Context
 345     my $force_time = shift;
 346     my $dateonly   = shift;
 347
 348     if ( defined $str && $str =~ m/^\d{4}-\d{2}-\d{2}/ ) {
 349         my $dt = dt_from_string( $str, 'sql' );
 350         return q{} unless $dt;
 351         $dt->truncate( to => 'minute' );
 352         return output_pref({
 353             dt => $dt,
 354             dateformat => $force_pref,
 355             timeformat => $force_time,
 356             dateonly => $dateonly
 357         });
 358     }
 359     return q{};
 360 }
 361
 362 =head2 flatpickr_date_format
 363
 364 $date_format = flatpickr_date_format( $koha_date_format );
 365
 366 Converts Koha's date format to Flatpickr's. E.g. 'us' returns 'm/d/Y'.
 367
 368 If no argument is given, the dateformat preference is assumed.
 369
 370 Returns undef if format is unknown.
 371
 372 =cut
 373
 374 sub flatpickr_date_format {
 375     my $arg = shift // C4::Context->preference('dateformat');
 376     return {
 377         us     => 'm/d/Y',
 378         metric => 'd/m/Y',
 379         dmydot => 'd.m.Y',
 380         iso    => 'Y-m-d',
 381     }->{$arg};
 382 }
 383
 384 1;