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