2 # This file is part of Koha.
4 # Koha is free software; you can redistribute it and/or modify it under the
5 # terms of the GNU General Public License as published by the Free Software
6 # Foundation; either version 2 of the License, or (at your option) any later
9 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
10 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
11 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
13 # You should have received a copy of the GNU General Public License along with
14 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
15 # Suite 330, Boston, MA 02111-1307 USA
23 use POSIX qw(strftime);
24 use Date::Calc qw(check_date check_time);
25 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
26 use vars qw($debug $cgi_debug);
31 @EXPORT_OK = qw(format_date_in_iso format_date);
34 use vars qw($prefformat);
36 unless (defined $prefformat) {
37 $prefformat = C4::Context->preference('dateformat');
43 iso => 'yyyy-mm-dd', # plus " HH:MM:SS"
44 metric => 'dd/mm/yyyy', # plus " HH:MM:SS"
45 us => 'mm/dd/yyyy', # plus " HH:MM:SS"
46 sql => 'yyyymmdd HHMMSS',
49 iso => '%Y-%m-%d', # or %F, "Full Date"
52 sql => '%Y%m%d %H%M%S',
55 our %dmy_subs = ( # strings to eval (after using regular expression returned by regexp below)
56 # make arrays for POSIX::strftime()
57 iso => '[(($6||0),($5||0),($4||0),$3, $2 - 1, $1 - 1900)]',
58 metric => '[(($6||0),($5||0),($4||0),$1, $2 - 1, $3 - 1900)]',
59 us => '[(($6||0),($5||0),($4||0),$2, $1 - 1, $3 - 1900)]',
60 sql => '[(($6||0),($5||0),($4||0),$3, $2 - 1, $1 - 1900)]',
65 my $delim = qr/:?\:|\/|-/; # "non memory" cluster: no backreference
66 my $format = (@_) ? shift : $self->{'dateformat'}; # w/o arg. relies on dateformat being defined
67 ($format eq 'sql') and
68 return qr/^(\d{4})(\d{2})(\d{2})(?:\s{4}(\d{2})(\d{2})(\d{2}))?/;
69 ($format eq 'iso') and
70 return qr/^(\d{4})$delim(\d{2})$delim(\d{2})(?:(?:\s{1}|T)(\d{2})\:?(\d{2})\:?(\d{2}))?Z?/;
71 return qr/^(\d{2})$delim(\d{2})$delim(\d{4})(?:\s{1}(\d{2})\:?(\d{2})\:?(\d{2}))?/; # everything else
76 my $val = shift or return undef;
77 my $dformat = $self->{'dateformat'} or return undef;
78 my $re = $self->regexp();
79 my $xsub = $dmy_subs{$dformat};
80 $debug and print STDERR "xsub: $xsub \n";
82 my $aref = eval $xsub;
83 _check_date_and_time($aref);
87 carp "Illegal Date '$val' does not match '$dformat' format: " . $self->visual();
91 sub _check_date_and_time {
92 my $chron_ref = shift;
93 my ($year, $month, $day) = _chron_to_ymd($chron_ref);
94 unless (check_date($year, $month, $day)) {
95 carp "Illegal date specified (year = $year, month = $month, day = $day)";
97 my ($hour, $minute, $second) = _chron_to_hms($chron_ref);
98 unless (check_time($hour, $minute, $second)) {
99 carp "Illegal time specified (hour = $hour, minute = $minute, second = $second)";
104 my $chron_ref = shift;
105 return ($chron_ref->[5] + 1900, $chron_ref->[4] + 1, $chron_ref->[3]);
109 my $chron_ref = shift;
110 return ($chron_ref->[2], $chron_ref->[1], $chron_ref->[0]);
115 my $class = ref($this) || $this;
118 return $self->init(@_);
123 $self->{'dateformat'} = $dformat = (scalar(@_) >= 2) ? $_[1] : _prefformat();
124 ($format_map{$dformat}) or croak
125 "Invalid date format '$dformat' from " . ((scalar(@_) >= 2) ? 'argument' : 'system preferences');
126 $self->{'dmy_arrayref'} = [((@_) ? $self->dmy_map(shift) : localtime )] ;
127 $debug and warn "(during init) \@\$self->{'dmy_arrayref'}: " . join(' ',@{$self->{'dmy_arrayref'}}) . "\n";
132 my $newformat = (@_) ? _recognize_format(shift) : _prefformat();
133 return (eval {POSIX::strftime($posix_map{$newformat}, @{$self->{'dmy_arrayref'}})} || undef);
135 sub today ($;$) { # NOTE: sets date value to today (and returns it in the requested or current format)
137 $class = ref($class) || $class;
138 my $format = (@_) ? _recognize_format(shift) : _prefformat();
139 return $class->new()->output($format);
141 sub _recognize_format($) {
142 my $incoming = shift;
143 ($incoming eq 'syspref') and return _prefformat();
144 (scalar grep (/^$incoming$/, keys %format_map) == 1) or croak "The format you asked for ('$incoming') is unrecognized.";
147 sub DHTMLcalendar ($;$) { # interface to posix_map
149 my $format = (@_) ? shift : _prefformat();
150 return $posix_map{$format};
152 sub format { # get or set dateformat: iso, metric, us, etc.
154 (@_) or return $self->{'dateformat'};
155 $self->{'dateformat'} = _recognize_format(shift);
160 return $format_map{ _recognize_format(shift) };
162 $self eq __PACKAGE__ and return $format_map{_prefformat()};
163 return $format_map{ eval { $self->{'dateformat'} } || _prefformat()} ;
166 # like the functions from the old C4::Date.pm
168 return __PACKAGE__ -> new(shift,'iso')->output((@_) ? shift : _prefformat());
170 sub format_date_in_iso {
171 return __PACKAGE__ -> new(shift,_prefformat())->output('iso');
177 =head1 C4::Dates.pm - a more object-oriented replacement for Date.pm.
179 The core problem to address is the multiplicity of formats used by different Koha
180 installations around the world. We needed to move away from any hard-coded values at
181 the script level, for example in initial form values or checks for min/max date. The
182 reason is clear when you consider string '07/01/2004'. Depending on the format, it
183 represents July 1st (us), or January 7th (metric), or an invalid value (iso).
185 The formats supported by Koha are:
186 iso - ISO 8601 (extended)
188 metric - European standard (slight misnomer, not really decimalized metric)
189 sql - log format, not really for human consumption
191 =head2 ->new([string_date,][date_format])
193 Arguments to new() are optional. If string_date is not supplied, the present system date is
194 used. If date_format is not supplied, the system preference from C4::Context is used.
198 my $now = C4::Dates->new();
199 my $date1 = C4::Dates->new("09-21-1989","us");
200 my $date2 = C4::Dates->new("19890921 143907","sql");
202 =head2 ->output([date_format])
204 The date value is stored independent of any specific format. Therefore any format can be
205 invoked when displaying it.
207 my $date = C4::Dates->new(); # say today is July 12th, 2010
208 print $date->output("iso"); # prints "2010-07-12"
210 print $date->output("metric"); # prints "12-07-2010"
212 However, it is still necessary to know the format of any incoming date value (e.g.,
213 setting the value of an object with new()). Like new(), output() assumes the system preference
214 date format unless otherwise instructed.
216 =head2 ->format([date_format])
218 With no argument, format returns the object's current date_format. Otherwise it attempts to
219 set the object format to the supplied value.
221 Some previously desireable functions are now unnecessary. For example, you might want a
222 method/function to tell you whether or not a Dates.pm object is of the 'iso' type. But you
223 can see by this example that such a test is trivial to accomplish, and not necessary to
224 include in the module:
228 return ($self->format() eq "iso");
231 Note: A similar function would need to be included for each format.
233 Instead a dependent script can retrieve the format of the object directly and decide what to
234 do with it from there:
236 my $date = C4::Dates->new();
237 my $format = $date->format();
238 ($format eq "iso") or do_something($date);
240 Or if you just want to print a given value and format, no problem:
242 my $date = C4::Dates->new("1989-09-21", "iso");
247 print C4::Dates->new("1989-09-21", "iso")->output;
251 print C4::Dates->new("21-09-1989", "metric")->output("iso");
253 =head2 "syspref" -- System Preference(s)
255 Perhaps you want to force data obtained in a known format to display according to the user's system
256 preference, without necessarily knowing what that preference is. For this purpose, you can use the
257 psuedo-format argument "syspref".
259 For example, to print an ISO date (from the database) in the <systempreference> format:
261 my $date = C4::Dates->new($date_from_database,"iso");
262 my $datestring_for_display = $date->output("syspref");
263 print $datestring_for_display;
267 print C4::Dates->new($date_from_database,"iso")->output("syspref");
269 If you just want to know what the <systempreferece> is, a default Dates object can tell you:
271 C4::Dates->new()->format();
273 =head2 ->DHMTLcalendar([date_format])
275 Returns the format string for DHTML Calendar Display based on date_format.
276 If date_format is not supplied, the return is based on system preference.
278 C4::Dates->DHTMLcalendar(); # e.g., returns "%m/%d/%Y" for 'us' system preference
280 =head3 Error Handling
282 Some error handling is provided in this module, but not all. Requesting an unknown format is a
283 fatal error (because it is programmer error, not user error, typically).
285 Scripts must still perform validation of user input. Attempting to set an invalid value will
286 return 0 or undefined, so a script might check as follows:
288 my $date = C4::Dates->new($input) or deal_with_it("$input didn't work");
290 To validate before creating a new object, use the regexp method of the class:
292 $input =~ C4::Dates->regexp("iso") or deal_with_it("input ($input) invalid as iso format");
293 my $date = C4::Dates->new($input,"iso");
295 More verbose debugging messages are sent in the presence of non-zero $ENV{"DEBUG"}.
297 Notes: if the date in the db is null or empty, interpret null expiration to mean "never expires".
301 This internal function is used to read the preferred date format
302 from the system preference table. It reads the preference once,
305 This replaces using the package variable $prefformat directly, and
306 specifically, doing a call to C4::Context->preference() during
307 module initialization. That way, C4::Dates no longer has a
308 compile-time dependency on having a valid $dbh.
312 If the date format is not in <systempreference>, we should send an error back to the user.
313 This kind of check should be centralized somewhere. Probably not here, though.