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
  24 use vars qw(@ISA @EXPORT_OK);
  25 BEGIN {
  26     require Exporter;
  27     @ISA = qw(Exporter);
  28
  29     @EXPORT_OK = qw(
  30         dt_from_string
  31         output_pref
  32         format_sqldatetime
  33     );
  34 }
  35
  36 =head1 DateUtils
  37
  38 Koha::DateUtils - Transitional wrappers to ease use of DateTime
  39
  40 =head1 DESCRIPTION
  41
  42 Koha has historically only used dates not datetimes and been content to
  43 handle these as strings. It also has confused formatting with actual dates
  44 this is a temporary module for wrappers to hide the complexity of switch to DateTime
  45
  46 =cut
  47
  48 =head2 dt_ftom_string
  49
  50 $dt = dt_from_string($date_string, [$format, $timezone ]);
  51
  52 Passed a date string returns a DateTime object format and timezone default
  53 to the system preferences. If the date string is empty DateTime->now is returned
  54
  55 =cut
  56
  57 sub dt_from_string {
  58     my ( $date_string, $date_format, $tz ) = @_;
  59
  60     return if $date_string and $date_string =~ m|^0000-0|;
  61
  62     $tz = C4::Context->tz unless $tz;;
  63
  64     return DateTime->now( time_zone => $tz ) unless $date_string;
  65
  66     $date_format = C4::Context->preference('dateformat') unless $date_format;
  67
  68     if ( ref($date_string) eq 'DateTime' ) {    # already a dt return it
  69         return $date_string;
  70     }
  71
  72     my $regex;
  73
  74     # The fallback format is sql/iso
  75     my $fallback_re = qr|
  76         (?<year>\d{4})
  77         -
  78         (?<month>\d{2})
  79         -
  80         (?<day>\d{2})
  81     |xms;
  82
  83     if ( $date_format eq 'metric' ) {
  84         # metric format is "dd/mm/yyyy[ hh:mm:ss]"
  85         $regex = qr|
  86             (?<day>\d{2})
  87             /
  88             (?<month>\d{2})
  89             /
  90             (?<year>\d{4})
  91         |xms;
  92     }
  93     elsif ( $date_format eq 'dmydot' ) {
  94         # dmydot format is "dd.mm.yyyy[ hh:mm:ss]"
  95         $regex = qr|
  96             (?<day>\d{2})
  97             .
  98             (?<month>\d{2})
  99             .
 100             (?<year>\d{4})
 101         |xms;
 102     }
 103     elsif ( $date_format eq 'us' ) {
 104         # us format is "mm/dd/yyyy[ hh:mm:ss]"
 105         $regex = qr|
 106             (?<month>\d{2})
 107             /
 108             (?<day>\d{2})
 109             /
 110             (?<year>\d{4})
 111         |xms;
 112     }
 113     elsif ( $date_format eq 'rfc3339' ) {
 114         $regex = qr/
 115             (?<year>\d{4})
 116             -
 117             (?<month>\d{2})
 118             -
 119             (?<day>\d{2})
 120             ([Tt\s])
 121             (?<hour>\d{2})
 122             :
 123             (?<minute>\d{2})
 124             :
 125             (?<second>\d{2})
 126             (\.\d{1,3})?(([Zz])|((?<offset>[\+|\-])(?<hours>[01][0-9]|2[0-3]):(?<minutes>[0-5][0-9])))
 127         /xms;
 128     }
 129     elsif ( $date_format eq 'iso' or $date_format eq 'sql' ) {
 130         # iso or sql format are yyyy-dd-mm[ hh:mm:ss]"
 131         $regex = $fallback_re;
 132     }
 133     else {
 134         die "Invalid dateformat parameter ($date_format)";
 135     }
 136
 137     # Add the faculative time part [hh:mm[:ss]]
 138     my $time_re .= qr|
 139             (
 140                 \s*
 141                 (?<hour>\d{2})
 142                 :
 143                 (?<minute>\d{2})
 144                 (
 145                     :
 146                     (?<second>\d{2})
 147                 )?
 148                 (
 149                     \s
 150                     (?<ampm>\w{2})
 151                 )?
 152             )?
 153     |xms;
 154     $regex .= $time_re;
 155     $fallback_re .= $time_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 ( $+{offset} ) {
 170             $tz = DateTime::TimeZone->new( name => $+{offset} . $+{hours} . $+{minutes} );
 171         }
 172     } elsif ( $date_string =~ $fallback_re ) {
 173         %dt_params = (
 174             year   => $+{year},
 175             month  => $+{month},
 176             day    => $+{day},
 177             hour   => $+{hour},
 178             minute => $+{minute},
 179             second => $+{second},
 180         );
 181         $ampm = $+{ampm};
 182     }
 183     else {
 184         die "The given date ($date_string) does not match the date format ($date_format)";
 185     }
 186
 187     # system allows the 0th of the month
 188     $dt_params{day} = '01' if $dt_params{day} eq '00';
 189
 190     # Set default hh:mm:ss to 00:00:00
 191     $dt_params{hour}   = 00 unless defined $dt_params{hour};
 192     $dt_params{minute} = 00 unless defined $dt_params{minute};
 193     $dt_params{second} = 00 unless defined $dt_params{second};
 194
 195     if ( $ampm ) {
 196         if ( $ampm eq 'AM' ) {
 197             $dt_params{hour} = 00 if $dt_params{hour} == 12;
 198         } elsif ( $dt_params{hour} != 12 ) { # PM
 199             $dt_params{hour} += 12;
 200             $dt_params{hour} = 00 if $dt_params{hour} == 24;
 201         }
 202     }
 203
 204     my $dt = eval {
 205         DateTime->new(
 206             %dt_params,
 207             # No TZ for dates 'infinite' => see bug 13242
 208             ( $dt_params{year} < 9999 ? ( time_zone => $tz ) : () ),
 209         );
 210     };
 211     if ($@) {
 212         $tz = DateTime::TimeZone->new( name => 'floating' );
 213         $dt = 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     return $dt;
 220 }
 221
 222 =head2 output_pref
 223
 224 $date_string = output_pref({ dt => $dt [, dateformat => $date_format, timeformat => $time_format, dateonly => 0|1, as_due_date => 0|1 ] });
 225 $date_string = output_pref( $dt );
 226
 227 Returns a string containing the time & date formatted as per the C4::Context setting,
 228 or C<undef> if C<undef> was provided.
 229
 230 This routine can either be passed a DateTime object or or a hashref.  If it is
 231 passed a hashref, the expected keys are a mandatory 'dt' for the DateTime,
 232 an optional 'dateformat' to override the dateformat system preference, an
 233 optional 'timeformat' to override the TimeFormat system preference value,
 234 and an optional 'dateonly' to specify that only the formatted date string
 235 should be returned without the time.
 236
 237 =cut
 238
 239 sub output_pref {
 240     my $params = shift;
 241     my ( $dt, $str, $force_pref, $force_time, $dateonly, $as_due_date );
 242     if ( ref $params eq 'HASH' ) {
 243         $dt         = $params->{dt};
 244         $str        = $params->{str};
 245         $force_pref = $params->{dateformat};         # if testing we want to override Context
 246         $force_time = $params->{timeformat};
 247         $dateonly   = $params->{dateonly} || 0;    # if you don't want the hours and minutes
 248         $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)
 249     } else {
 250         $dt = $params;
 251     }
 252
 253     Koha::Exceptions::WrongParameter->throw( 'output_pref should not be called with both dt and str parameter' ) if $dt and $str;
 254
 255     if ( $str ) {
 256         local $@;
 257         $dt = eval { dt_from_string( $str ) };
 258         Koha::Exceptions::WrongParameter->throw("Invalid date '$str' passed to output_pref" ) if $@;
 259     }
 260
 261     return if !defined $dt; # NULL date
 262     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';
 263
 264     # FIXME: see bug 13242 => no TZ for dates 'infinite'
 265     if ( $dt->ymd !~ /^9999/ ) {
 266         my $tz = $dateonly ? DateTime::TimeZone->new(name => 'floating') : C4::Context->tz;
 267         $dt->set_time_zone( $tz );
 268     }
 269
 270     my $pref =
 271       defined $force_pref ? $force_pref : C4::Context->preference('dateformat');
 272
 273     my $time_format = $force_time || C4::Context->preference('TimeFormat') || q{};
 274     my $time = ( $time_format eq '12hr' ) ? '%I:%M %p' : '%H:%M';
 275     my $date;
 276     if ( $pref =~ m/^iso/ ) {
 277         $date = $dateonly
 278           ? $dt->strftime("%Y-%m-%d")
 279           : $dt->strftime("%Y-%m-%d $time");
 280     }
 281     elsif ( $pref =~ m/^rfc3339/ ) {
 282         if (!$dateonly) {
 283             $date = $dt->strftime('%FT%T%z');
 284             substr($date, -2, 0, ':'); # timezone "HHmm" => "HH:mm"
 285         }
 286         else {
 287             $date = $dt->strftime("%Y-%m-%d");
 288         }
 289     }
 290     elsif ( $pref =~ m/^metric/ ) {
 291         $date = $dateonly
 292           ? $dt->strftime("%d/%m/%Y")
 293           : $dt->strftime("%d/%m/%Y $time");
 294     }
 295     elsif ( $pref =~ m/^dmydot/ ) {
 296         $date = $dateonly
 297           ? $dt->strftime("%d.%m.%Y")
 298           : $dt->strftime("%d.%m.%Y $time");
 299     }
 300
 301     elsif ( $pref =~ m/^us/ ) {
 302         $date = $dateonly
 303           ? $dt->strftime("%m/%d/%Y")
 304           : $dt->strftime("%m/%d/%Y $time");
 305     }
 306     else {
 307         $date = $dateonly
 308           ? $dt->strftime("%Y-%m-%d")
 309           : $dt->strftime("%Y-%m-%d $time");
 310     }
 311
 312     if ( $as_due_date ) {
 313         $time_format eq '12hr'
 314             ? $date =~ s| 11:59 PM$||
 315             : $date =~ s| 23:59$||;
 316     }
 317
 318     return $date;
 319 }
 320
 321 =head2 format_sqldatetime
 322
 323 $string = format_sqldatetime( $string_as_returned_from_db );
 324
 325 a convenience routine for calling dt_from_string and formatting the result
 326 with output_pref as it is a frequent activity in scripts
 327
 328 =cut
 329
 330 sub format_sqldatetime {
 331     my $str        = shift;
 332     my $force_pref = shift;    # if testing we want to override Context
 333     my $force_time = shift;
 334     my $dateonly   = shift;
 335
 336     if ( defined $str && $str =~ m/^\d{4}-\d{2}-\d{2}/ ) {
 337         my $dt = dt_from_string( $str, 'sql' );
 338         return q{} unless $dt;
 339         $dt->truncate( to => 'minute' );
 340         return output_pref({
 341             dt => $dt,
 342             dateformat => $force_pref,
 343             timeformat => $force_time,
 344             dateonly => $dateonly
 345         });
 346     }
 347     return q{};
 348 }
 349
 350 1;