Bug 7317: Rewrite atomicupdate file
[koha.git] / Koha / DateUtils.pm
blobaf5ce7ebbd1fd1d42699913c83335e97af0da146
1 package Koha::DateUtils;
3 # Copyright (c) 2011 PTFS-Europe Ltd.
4 # This file is part of Koha.
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.
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.
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.
19 use Modern::Perl;
20 use DateTime;
21 use C4::Context;
22 use Koha::Exceptions;
24 use base 'Exporter';
26 our @EXPORT = (
27 qw( dt_from_string output_pref format_sqldatetime )
30 =head1 DateUtils
32 Koha::DateUtils - Transitional wrappers to ease use of DateTime
34 =head1 DESCRIPTION
36 Koha has historically only used dates not datetimes and been content to
37 handle these as strings. It also has confused formatting with actual dates
38 this is a temporary module for wrappers to hide the complexity of switch to DateTime
40 =cut
42 =head2 dt_ftom_string
44 $dt = dt_from_string($date_string, [$format, $timezone ]);
46 Passed a date string returns a DateTime object format and timezone default
47 to the system preferences. If the date string is empty DateTime->now is returned
49 =cut
51 sub dt_from_string {
52 my ( $date_string, $date_format, $tz ) = @_;
54 return if $date_string and $date_string =~ m|^0000-0|;
56 $tz = C4::Context->tz unless $tz;;
58 return DateTime->now( time_zone => $tz ) unless $date_string;
60 $date_format = C4::Context->preference('dateformat') unless $date_format;
62 if ( ref($date_string) eq 'DateTime' ) { # already a dt return it
63 return $date_string;
66 my $regex;
68 # The fallback format is sql/iso
69 my $fallback_re = qr|
70 (?<year>\d{4})
72 (?<month>\d{2})
74 (?<day>\d{2})
75 |xms;
77 if ( $date_format eq 'metric' ) {
78 # metric format is "dd/mm/yyyy[ hh:mm:ss]"
79 $regex = qr|
80 (?<day>\d{2})
82 (?<month>\d{2})
84 (?<year>\d{4})
85 |xms;
87 elsif ( $date_format eq 'dmydot' ) {
88 # dmydot format is "dd.mm.yyyy[ hh:mm:ss]"
89 $regex = qr|
90 (?<day>\d{2})
92 (?<month>\d{2})
94 (?<year>\d{4})
95 |xms;
97 elsif ( $date_format eq 'us' ) {
98 # us format is "mm/dd/yyyy[ hh:mm:ss]"
99 $regex = qr|
100 (?<month>\d{2})
102 (?<day>\d{2})
104 (?<year>\d{4})
105 |xms;
107 elsif ( $date_format eq 'iso' or $date_format eq 'sql' ) {
108 # iso or sql format are yyyy-dd-mm[ hh:mm:ss]"
109 $regex = $fallback_re;
111 else {
112 die "Invalid dateformat parameter ($date_format)";
115 # Add the faculative time part [hh:mm[:ss]]
116 my $time_re .= qr|
119 (?<hour>\d{2})
121 (?<minute>\d{2})
124 (?<second>\d{2})
127 |xms;
128 $regex .= $time_re;
129 $fallback_re .= $time_re;
131 my %dt_params;
132 if ( $date_string =~ $regex ) {
133 %dt_params = (
134 year => $+{year},
135 month => $+{month},
136 day => $+{day},
137 hour => $+{hour},
138 minute => $+{minute},
139 second => $+{second},
141 } elsif ( $date_string =~ $fallback_re ) {
142 %dt_params = (
143 year => $+{year},
144 month => $+{month},
145 day => $+{day},
146 hour => $+{hour},
147 minute => $+{minute},
148 second => $+{second},
151 else {
152 die "The given date ($date_string) does not match the date format ($date_format)";
155 # system allows the 0th of the month
156 $dt_params{day} = '01' if $dt_params{day} eq '00';
158 # Set default hh:mm:ss to 00:00:00
159 $dt_params{hour} = 00 unless defined $dt_params{hour};
160 $dt_params{minute} = 00 unless defined $dt_params{minute};
161 $dt_params{second} = 00 unless defined $dt_params{second};
163 my $dt = eval {
164 DateTime->new(
165 %dt_params,
166 # No TZ for dates 'infinite' => see bug 13242
167 ( $dt_params{year} < 9999 ? ( time_zone => $tz->name ) : () ),
170 if ($@) {
171 $tz = DateTime::TimeZone->new( name => 'floating' );
172 $dt = DateTime->new(
173 %dt_params,
174 # No TZ for dates 'infinite' => see bug 13242
175 ( $dt_params{year} < 9999 ? ( time_zone => $tz->name ) : () ),
178 return $dt;
181 =head2 output_pref
183 $date_string = output_pref({ dt => $dt [, dateformat => $date_format, timeformat => $time_format, dateonly => 0|1, as_due_date => 0|1 ] });
184 $date_string = output_pref( $dt );
186 Returns a string containing the time & date formatted as per the C4::Context setting,
187 or C<undef> if C<undef> was provided.
189 This routine can either be passed a DateTime object or or a hashref. If it is
190 passed a hashref, the expected keys are a mandatory 'dt' for the DateTime,
191 an optional 'dateformat' to override the dateformat system preference, an
192 optional 'timeformat' to override the TimeFormat system preference value,
193 and an optional 'dateonly' to specify that only the formatted date string
194 should be returned without the time.
196 =cut
198 sub output_pref {
199 my $params = shift;
200 my ( $dt, $str, $force_pref, $force_time, $dateonly, $as_due_date );
201 if ( ref $params eq 'HASH' ) {
202 $dt = $params->{dt};
203 $str = $params->{str};
204 $force_pref = $params->{dateformat}; # if testing we want to override Context
205 $force_time = $params->{timeformat};
206 $dateonly = $params->{dateonly} || 0; # if you don't want the hours and minutes
207 $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)
208 } else {
209 $dt = $params;
212 Koha::Exceptions::WrongParameter->throw( 'output_pref should not be called with both dt and str parameter' ) if $dt and $str;
214 if ( $str ) {
215 local $@;
216 $dt = eval { dt_from_string( $str ) };
217 Koha::Exceptions::WrongParameter->throw("Invalid date '$str' passed to output_pref" ) if $@;
220 return if !defined $dt; # NULL date
221 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';
223 # FIXME: see bug 13242 => no TZ for dates 'infinite'
224 if ( $dt->ymd !~ /^9999/ ) {
225 my $tz = $dateonly ? DateTime::TimeZone->new(name => 'floating') : C4::Context->tz;
226 $dt->set_time_zone( $tz );
229 my $pref =
230 defined $force_pref ? $force_pref : C4::Context->preference('dateformat');
232 my $time_format = $force_time || C4::Context->preference('TimeFormat') || q{};
233 my $time = ( $time_format eq '12hr' ) ? '%I:%M %p' : '%H:%M';
234 my $date;
235 if ( $pref =~ m/^iso/ ) {
236 $date = $dateonly
237 ? $dt->strftime("%Y-%m-%d")
238 : $dt->strftime("%Y-%m-%d $time");
240 elsif ( $pref =~ m/^metric/ ) {
241 $date = $dateonly
242 ? $dt->strftime("%d/%m/%Y")
243 : $dt->strftime("%d/%m/%Y $time");
245 elsif ( $pref =~ m/^dmydot/ ) {
246 $date = $dateonly
247 ? $dt->strftime("%d.%m.%Y")
248 : $dt->strftime("%d.%m.%Y $time");
251 elsif ( $pref =~ m/^us/ ) {
252 $date = $dateonly
253 ? $dt->strftime("%m/%d/%Y")
254 : $dt->strftime("%m/%d/%Y $time");
256 else {
257 $date = $dateonly
258 ? $dt->strftime("%Y-%m-%d")
259 : $dt->strftime("%Y-%m-%d $time");
262 if ( $as_due_date ) {
263 $time_format eq '12hr'
264 ? $date =~ s| 11:59 PM$||
265 : $date =~ s| 23:59$||;
268 return $date;
271 =head2 format_sqldatetime
273 $string = format_sqldatetime( $string_as_returned_from_db );
275 a convenience routine for calling dt_from_string and formatting the result
276 with output_pref as it is a frequent activity in scripts
278 =cut
280 sub format_sqldatetime {
281 my $str = shift;
282 my $force_pref = shift; # if testing we want to override Context
283 my $force_time = shift;
284 my $dateonly = shift;
286 if ( defined $str && $str =~ m/^\d{4}-\d{2}-\d{2}/ ) {
287 my $dt = dt_from_string( $str, 'sql' );
288 return q{} unless $dt;
289 $dt->truncate( to => 'minute' );
290 return output_pref({
291 dt => $dt,
292 dateformat => $force_pref,
293 timeformat => $force_time,
294 dateonly => $dateonly
297 return q{};