| Filename | /home/vagrant/kohaclone/Koha/DateUtils.pm |
| Statements | Executed 0 statements in 0s |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 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 under the | ||||
| 7 | # terms of the GNU General Public License as published by the Free Software | ||||
| 8 | # Foundation; either version 2 of the License, or (at your option) any later | ||||
| 9 | # version. | ||||
| 10 | # | ||||
| 11 | # Koha is distributed in the hope that it will be useful, but WITHOUT ANY | ||||
| 12 | # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR | ||||
| 13 | # A PARTICULAR PURPOSE. See the GNU General Public License for more details. | ||||
| 14 | # | ||||
| 15 | # You should have received a copy of the GNU General Public License along with | ||||
| 16 | # Koha; if not, write to the Free Software Foundation, Inc., | ||||
| 17 | # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. | ||||
| 18 | |||||
| 19 | use Modern::Perl; | ||||
| 20 | use DateTime; | ||||
| 21 | use C4::Context; | ||||
| 22 | use Carp; | ||||
| 23 | |||||
| 24 | use base 'Exporter'; | ||||
| 25 | use version; our $VERSION = qv('1.0.0'); | ||||
| 26 | |||||
| 27 | our @EXPORT = ( | ||||
| 28 | qw( dt_from_string output_pref format_sqldatetime ) | ||||
| 29 | ); | ||||
| 30 | |||||
| 31 | =head1 DateUtils | ||||
| 32 | |||||
| 33 | Koha::DateUtils - Transitional wrappers to ease use of DateTime | ||||
| 34 | |||||
| 35 | =head1 DESCRIPTION | ||||
| 36 | |||||
| 37 | Koha has historically only used dates not datetimes and been content to | ||||
| 38 | handle these as strings. It also has confused formatting with actual dates | ||||
| 39 | this is a temporary module for wrappers to hide the complexity of switch to DateTime | ||||
| 40 | |||||
| 41 | =cut | ||||
| 42 | |||||
| 43 | =head2 dt_ftom_string | ||||
| 44 | |||||
| 45 | $dt = dt_from_string($date_string, [$format, $timezone ]); | ||||
| 46 | |||||
| 47 | Passed a date string returns a DateTime object format and timezone default | ||||
| 48 | to the system preferences. If the date string is empty DateTime->now is returned | ||||
| 49 | |||||
| 50 | =cut | ||||
| 51 | |||||
| 52 | sub dt_from_string { | ||||
| 53 | my ( $date_string, $date_format, $tz ) = @_; | ||||
| 54 | |||||
| 55 | return if $date_string and $date_string =~ m|^0000-0|; | ||||
| 56 | |||||
| 57 | $tz = C4::Context->tz unless $tz;; | ||||
| 58 | |||||
| 59 | return DateTime->now( time_zone => $tz ) unless $date_string; | ||||
| 60 | |||||
| 61 | $date_format = C4::Context->preference('dateformat') unless $date_format; | ||||
| 62 | |||||
| 63 | if ( ref($date_string) eq 'DateTime' ) { # already a dt return it | ||||
| 64 | return $date_string; | ||||
| 65 | } | ||||
| 66 | |||||
| 67 | my $regex; | ||||
| 68 | |||||
| 69 | # The fallback format is sql/iso | ||||
| 70 | my $fallback_re = qr| | ||||
| 71 | (?<year>\d{4}) | ||||
| 72 | - | ||||
| 73 | (?<month>\d{2}) | ||||
| 74 | - | ||||
| 75 | (?<day>\d{2}) | ||||
| 76 | |xms; | ||||
| 77 | |||||
| 78 | if ( $date_format eq 'metric' ) { | ||||
| 79 | # metric format is "dd/mm/yyyy[ hh:mm:ss]" | ||||
| 80 | $regex = qr| | ||||
| 81 | (?<day>\d{2}) | ||||
| 82 | / | ||||
| 83 | (?<month>\d{2}) | ||||
| 84 | / | ||||
| 85 | (?<year>\d{4}) | ||||
| 86 | |xms; | ||||
| 87 | } | ||||
| 88 | elsif ( $date_format eq 'dmydot' ) { | ||||
| 89 | # dmydot format is "dd.mm.yyyy[ hh:mm:ss]" | ||||
| 90 | $regex = qr| | ||||
| 91 | (?<day>\d{2}) | ||||
| 92 | . | ||||
| 93 | (?<month>\d{2}) | ||||
| 94 | . | ||||
| 95 | (?<year>\d{4}) | ||||
| 96 | |xms; | ||||
| 97 | } | ||||
| 98 | elsif ( $date_format eq 'us' ) { | ||||
| 99 | # us format is "mm/dd/yyyy[ hh:mm:ss]" | ||||
| 100 | $regex = qr| | ||||
| 101 | (?<month>\d{2}) | ||||
| 102 | / | ||||
| 103 | (?<day>\d{2}) | ||||
| 104 | / | ||||
| 105 | (?<year>\d{4}) | ||||
| 106 | |xms; | ||||
| 107 | } | ||||
| 108 | elsif ( $date_format eq 'iso' or $date_format eq 'sql' ) { | ||||
| 109 | # iso or sql format are yyyy-dd-mm[ hh:mm:ss]" | ||||
| 110 | $regex = $fallback_re; | ||||
| 111 | } | ||||
| 112 | else { | ||||
| 113 | die "Invalid dateformat parameter ($date_format)"; | ||||
| 114 | } | ||||
| 115 | |||||
| 116 | # Add the faculative time part [hh:mm[:ss]] | ||||
| 117 | my $time_re .= qr| | ||||
| 118 | ( | ||||
| 119 | \s* | ||||
| 120 | (?<hour>\d{2}) | ||||
| 121 | : | ||||
| 122 | (?<minute>\d{2}) | ||||
| 123 | ( | ||||
| 124 | : | ||||
| 125 | (?<second>\d{2}) | ||||
| 126 | )? | ||||
| 127 | )? | ||||
| 128 | |xms; | ||||
| 129 | $regex .= $time_re; | ||||
| 130 | $fallback_re .= $time_re; | ||||
| 131 | |||||
| 132 | my %dt_params; | ||||
| 133 | 12 | 52µs | if ( $date_string =~ $regex ) { # spent 52µs making 12 calls to Tie::Hash::NamedCapture::FETCH, avg 4µs/call | ||
| 134 | %dt_params = ( | ||||
| 135 | year => $+{year}, | ||||
| 136 | month => $+{month}, | ||||
| 137 | day => $+{day}, | ||||
| 138 | hour => $+{hour}, | ||||
| 139 | minute => $+{minute}, | ||||
| 140 | second => $+{second}, | ||||
| 141 | ); | ||||
| 142 | } elsif ( $date_string =~ $fallback_re ) { | ||||
| 143 | %dt_params = ( | ||||
| 144 | year => $+{year}, | ||||
| 145 | month => $+{month}, | ||||
| 146 | day => $+{day}, | ||||
| 147 | hour => $+{hour}, | ||||
| 148 | minute => $+{minute}, | ||||
| 149 | second => $+{second}, | ||||
| 150 | ); | ||||
| 151 | } | ||||
| 152 | else { | ||||
| 153 | die "The given date ($date_string) does not match the date format ($date_format)"; | ||||
| 154 | } | ||||
| 155 | |||||
| 156 | # system allows the 0th of the month | ||||
| 157 | $dt_params{day} = '01' if $dt_params{day} eq '00'; | ||||
| 158 | |||||
| 159 | # Set default hh:mm:ss to 00:00:00 | ||||
| 160 | $dt_params{hour} = 00 unless defined $dt_params{hour}; | ||||
| 161 | $dt_params{minute} = 00 unless defined $dt_params{minute}; | ||||
| 162 | $dt_params{second} = 00 unless defined $dt_params{second}; | ||||
| 163 | |||||
| 164 | my $dt = eval { | ||||
| 165 | DateTime->new( | ||||
| 166 | %dt_params, | ||||
| 167 | # No TZ for dates 'infinite' => see bug 13242 | ||||
| 168 | ( $dt_params{year} < 9999 ? ( time_zone => $tz->name ) : () ), | ||||
| 169 | ); | ||||
| 170 | }; | ||||
| 171 | if ($@) { | ||||
| 172 | $tz = DateTime::TimeZone->new( name => 'floating' ); | ||||
| 173 | $dt = DateTime->new( | ||||
| 174 | %dt_params, | ||||
| 175 | # No TZ for dates 'infinite' => see bug 13242 | ||||
| 176 | ( $dt_params{year} < 9999 ? ( time_zone => $tz->name ) : () ), | ||||
| 177 | ); | ||||
| 178 | } | ||||
| 179 | return $dt; | ||||
| 180 | } | ||||
| 181 | |||||
| 182 | =head2 output_pref | ||||
| 183 | |||||
| 184 | $date_string = output_pref({ dt => $dt [, dateformat => $date_format, timeformat => $time_format, dateonly => 0|1, as_due_date => 0|1 ] }); | ||||
| 185 | $date_string = output_pref( $dt ); | ||||
| 186 | |||||
| 187 | Returns a string containing the time & date formatted as per the C4::Context setting, | ||||
| 188 | or C<undef> if C<undef> was provided. | ||||
| 189 | |||||
| 190 | This routine can either be passed a DateTime object or or a hashref. If it is | ||||
| 191 | passed a hashref, the expected keys are a mandatory 'dt' for the DateTime, | ||||
| 192 | an optional 'dateformat' to override the dateformat system preference, an | ||||
| 193 | optional 'timeformat' to override the TimeFormat system preference value, | ||||
| 194 | and an optional 'dateonly' to specify that only the formatted date string | ||||
| 195 | should be returned without the time. | ||||
| 196 | |||||
| 197 | =cut | ||||
| 198 | |||||
| 199 | sub output_pref { | ||||
| 200 | my $params = shift; | ||||
| 201 | my ( $dt, $str, $force_pref, $force_time, $dateonly, $as_due_date ); | ||||
| 202 | if ( ref $params eq 'HASH' ) { | ||||
| 203 | $dt = $params->{dt}; | ||||
| 204 | $str = $params->{str}; | ||||
| 205 | $force_pref = $params->{dateformat}; # if testing we want to override Context | ||||
| 206 | $force_time = $params->{timeformat}; | ||||
| 207 | $dateonly = $params->{dateonly} || 0; # if you don't want the hours and minutes | ||||
| 208 | $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) | ||||
| 209 | } else { | ||||
| 210 | $dt = $params; | ||||
| 211 | } | ||||
| 212 | |||||
| 213 | 2 | 45µs | carp "output_pref should not be called with both dt and str parameters" # spent 45µs making 2 calls to DateTime::_stringify, avg 23µs/call | ||
| 214 | and return | ||||
| 215 | if $dt and $str; | ||||
| 216 | |||||
| 217 | $dt = eval { dt_from_string( $str ) } if $str; | ||||
| 218 | carp "Invalid date '$str' passed to output_pref\n" if $@; | ||||
| 219 | |||||
| 220 | return unless defined $dt; | ||||
| 221 | |||||
| 222 | # FIXME: see bug 13242 => no TZ for dates 'infinite' | ||||
| 223 | if ( $dt->ymd !~ /^9999/ ) { | ||||
| 224 | my $tz = $dateonly ? DateTime::TimeZone->new(name => 'floating') : C4::Context->tz; | ||||
| 225 | $dt->set_time_zone( $tz ); | ||||
| 226 | } | ||||
| 227 | |||||
| 228 | my $pref = | ||||
| 229 | defined $force_pref ? $force_pref : C4::Context->preference('dateformat'); | ||||
| 230 | |||||
| 231 | my $time_format = $force_time || C4::Context->preference('TimeFormat') || q{}; | ||||
| 232 | my $time = ( $time_format eq '12hr' ) ? '%I:%M %p' : '%H:%M'; | ||||
| 233 | my $date; | ||||
| 234 | if ( $pref =~ m/^iso/ ) { | ||||
| 235 | $date = $dateonly | ||||
| 236 | ? $dt->strftime("%Y-%m-%d") | ||||
| 237 | : $dt->strftime("%Y-%m-%d $time"); | ||||
| 238 | } | ||||
| 239 | elsif ( $pref =~ m/^metric/ ) { | ||||
| 240 | $date = $dateonly | ||||
| 241 | ? $dt->strftime("%d/%m/%Y") | ||||
| 242 | : $dt->strftime("%d/%m/%Y $time"); | ||||
| 243 | } | ||||
| 244 | elsif ( $pref =~ m/^dmydot/ ) { | ||||
| 245 | $date = $dateonly | ||||
| 246 | ? $dt->strftime("%d.%m.%Y") | ||||
| 247 | : $dt->strftime("%d.%m.%Y $time"); | ||||
| 248 | } | ||||
| 249 | |||||
| 250 | elsif ( $pref =~ m/^us/ ) { | ||||
| 251 | $date = $dateonly | ||||
| 252 | ? $dt->strftime("%m/%d/%Y") | ||||
| 253 | : $dt->strftime("%m/%d/%Y $time"); | ||||
| 254 | } | ||||
| 255 | else { | ||||
| 256 | $date = $dateonly | ||||
| 257 | ? $dt->strftime("%Y-%m-%d") | ||||
| 258 | : $dt->strftime("%Y-%m-%d $time"); | ||||
| 259 | } | ||||
| 260 | |||||
| 261 | if ( $as_due_date ) { | ||||
| 262 | $time_format eq '12hr' | ||||
| 263 | ? $date =~ s| 11:59 PM$|| | ||||
| 264 | : $date =~ s| 23:59$||; | ||||
| 265 | } | ||||
| 266 | |||||
| 267 | return $date; | ||||
| 268 | } | ||||
| 269 | |||||
| 270 | =head2 format_sqldatetime | ||||
| 271 | |||||
| 272 | $string = format_sqldatetime( $string_as_returned_from_db ); | ||||
| 273 | |||||
| 274 | a convenience routine for calling dt_from_string and formatting the result | ||||
| 275 | with output_pref as it is a frequent activity in scripts | ||||
| 276 | |||||
| 277 | =cut | ||||
| 278 | |||||
| 279 | sub format_sqldatetime { | ||||
| 280 | my $str = shift; | ||||
| 281 | my $force_pref = shift; # if testing we want to override Context | ||||
| 282 | my $force_time = shift; | ||||
| 283 | my $dateonly = shift; | ||||
| 284 | |||||
| 285 | if ( defined $str && $str =~ m/^\d{4}-\d{2}-\d{2}/ ) { | ||||
| 286 | my $dt = dt_from_string( $str, 'sql' ); | ||||
| 287 | return q{} unless $dt; | ||||
| 288 | $dt->truncate( to => 'minute' ); | ||||
| 289 | return output_pref({ | ||||
| 290 | dt => $dt, | ||||
| 291 | dateformat => $force_pref, | ||||
| 292 | timeformat => $force_time, | ||||
| 293 | dateonly => $dateonly | ||||
| 294 | }); | ||||
| 295 | } | ||||
| 296 | return q{}; | ||||
| 297 | } | ||||
| 298 | |||||
| 299 | 1; |