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(DHTMLcalendar format_date_in_iso format_date);
34 my $prefformat = C4::Context->preference('dateformat');
35 # print STDERR " Dates : \$debug is '$debug'\n";
36 # print STDERR " Dates : \$cgi_debug is '$cgi_debug'\n";
40 metric => 'dd/mm/yyyy',
42 sql => 'yyyymmdd HHMMSS',
45 iso => '%Y-%m-%d', # or %F, "Full Date"
48 sql => '%Y%m%d %H%M%S',
51 our %dmy_subs = ( # strings to eval (after using regular expression returned by regexp below)
52 # make arrays for POSIX::strftime()
53 iso => '[(0,0,0,$3, $2 - 1, $1 - 1900)]',
54 metric => '[(0,0,0,$1, $2 - 1, $3 - 1900)]',
55 us => '[(0,0,0,$2, $1 - 1, $3 - 1900)]',
56 sql => '[(($6||0),($5||0),($4||0),$3, $2 - 1, $1 - 1900)]',
61 my $delim = qr/:?\:|\/|-/; # "non memory" cluster: no backreference
62 my $format = (@_) ? shift : $self->{'dateformat'}; # w/o arg. relies on dateformat being defined
63 ($format eq 'sql') and
64 return qr/^(\d{4})(\d{2})(\d{2})(?:\s{4}(\d{2})(\d{2})(\d{2}))?/;
65 ($format eq 'iso') and
66 return qr/^(\d{4})$delim(\d{2})$delim(\d{2})(?:\s{1}(\d{2})\:?(\d{2})\:?(\d{2}))?/;
67 return qr/^(\d{2})$delim(\d{2})$delim(\d{4})(?:\s{1}(\d{2})\:?(\d{2})\:?(\d{2}))?/; # everything else
72 my $val = shift or return undef;
73 my $dformat = $self->{'dateformat'} or return undef;
74 my $re = $self->regexp();
75 my $xsub = $dmy_subs{$dformat};
76 $debug and print STDERR "xsub: $xsub \n";
78 my $aref = eval $xsub;
79 _check_date_and_time($aref);
83 carp "Illegal Date '$val' does not match '$dformat' format: " . $self->visual();
87 sub _check_date_and_time {
88 my $chron_ref = shift;
89 my ($year, $month, $day) = _chron_to_ymd($chron_ref);
90 unless (check_date($year, $month, $day)) {
91 carp "Illegal date specified (year = $year, month = $month, day = $day)";
93 my ($hour, $minute, $second) = _chron_to_hms($chron_ref);
94 unless (check_time($hour, $minute, $second)) {
95 carp "Illegal time specified (hour = $hour, minute = $minute, second = $second)";
100 my $chron_ref = shift;
101 return ($chron_ref->[5] + 1900, $chron_ref->[4] + 1, $chron_ref->[3]);
105 my $chron_ref = shift;
106 return ($chron_ref->[2], $chron_ref->[1], $chron_ref->[0]);
111 my $class = ref($this) || $this;
114 return $self->init(@_);
119 $self->{'dateformat'} = $dformat = (scalar(@_) >= 2) ? $_[1] : $prefformat;
120 ($format_map{$dformat}) or croak
121 "Invalid date format '$dformat' from " . ((scalar(@_) >= 2) ? 'argument' : 'system preferences');
122 $self->{'dmy_arrayref'} = [((@_) ? $self->dmy_map(shift) : localtime )] ;
123 $debug and print STDERR "(during init) \@\$self->{'dmy_arrayref'}: " . join(' ',@{$self->{'dmy_arrayref'}}) . "\n";
128 my $newformat = (@_) ? _recognize_format(shift) : $prefformat;
129 return (eval {POSIX::strftime($posix_map{$newformat}, @{$self->{'dmy_arrayref'}})} || undef);
131 sub today ($;$) { # NOTE: sets date value to today (and returns it in the requested or current format)
133 $class = ref($class) || $class;
134 my $format = (@_) ? _recognize_format(shift) : $prefformat;
135 return $class->new()->output($format);
137 sub _recognize_format($) {
138 my $incoming = shift;
139 ($incoming eq 'syspref') and return $prefformat;
140 (scalar grep (/^$incoming$/, keys %format_map) == 1) or croak "The format you asked for ('$incoming') is unrecognized.";
143 sub DHTMLcalendar ($;$) { # interface to posix_map
145 my $format = (@_) ? shift : $prefformat;
146 return $posix_map{$format};
148 sub format { # get or set dateformat: iso, metric, us, etc.
150 (@_) or return $self->{'dateformat'};
151 $self->{'dateformat'} = _recognize_format(shift);
156 return $format_map{ _recognize_format(shift) };
158 $self eq __PACKAGE__ and return $format_map{$prefformat};
159 return $format_map{ eval { $self->{'dateformat'} } || $prefformat} ;
162 # like the functions from the old C4::Date.pm
164 return __PACKAGE__ -> new(shift,'iso')->output((@_) ? shift : $prefformat);
166 sub format_date_in_iso {
167 return __PACKAGE__ -> new(shift,$prefformat)->output('iso');
173 =head1 C4::Dates.pm - a more object-oriented replacement for Date.pm.
175 The core problem to address is the multiplicity of formats used by different Koha
176 installations around the world. We needed to move away from any hard-coded values at
177 the script level, for example in initial form values or checks for min/max date. The
178 reason is clear when you consider string '07/01/2004'. Depending on the format, it
179 represents July 1st (us), or January 7th (metric), or an invalid value (iso).
181 =head2 ->new([string_date,][date_format])
183 Arguments to new() are optional. If string_date is not supplied, the present system date is
184 used. If date_format is not supplied, the system preference from C4::Context is used.
188 my $now = C4::Dates->new();
189 my $date1 = C4::Dates->new("09-21-1989","us");
190 my $date2 = C4::Dates->new("19890921 143907","sql");
192 =head2 ->output([date_format])
194 The date value is stored independent of any specific format. Therefore any format can be
195 invoked when displaying it.
197 my $date = C4::Dates->new(); # say today is July 12th, 2010
198 print $date->output("iso"); # prints "2010-07-12"
200 print $date->output("metric"); # prints "12-07-2007"
202 However, it is still necessary to know the format of any incoming date value (e.g.,
203 setting the value of an object with new()). Like new(), output() assumes the system preference
204 date format unless otherwise instructed.
206 =head2 ->format([date_format])
208 With no argument, format returns the object's current date_format. Otherwise it attempts to
209 set the object format to the supplied value.
211 Some previously desireable functions are now unnecessary. For example, you might want a
212 method/function to tell you whether or not a Dates.pm object is of the 'iso' type. But you
213 can see by this example that such a test is trivial to accomplish, and not necessary to
214 include in the module:
218 return ($self->format() eq "iso");
221 Note: A similar function would need to be included for each format.
223 Instead a dependent script can retrieve the format of the object directly and decide what to
224 do with it from there:
226 my $date = C4::Dates->new();
227 my $format = $date->format();
228 ($format eq "iso") or do_something($date);
230 Or if you just want to print a given value and format, no problem:
232 my $date = C4::Dates->new("1989-09-21", "iso");
237 print C4::Dates->new("1989-09-21", "iso")->output;
241 print C4::Dates->new("21-09-1989", "metric")->output("iso");
243 =head2 "syspref" -- System Preference(s)
245 Perhaps you want to force data obtained in a known format to display according to the user's system
246 preference, without necessarily knowing what that preference is. For this purpose, you can use the
247 psuedo-format argument "syspref".
249 For example, to print an ISO date (from the database) in the <systempreference> format:
251 my $date = C4::Dates->new($date_from_database,"iso");
252 my $datestring_for_display = $date->output("syspref");
253 print $datestring_for_display;
257 print C4::Dates->new($date_from_database,"iso")->output("syspref");
259 If you just want to know what the <systempreferece> is, you can use:
263 =head2 ->DHMTLcalendar([date_format])
265 Returns the format string for DHTML Calendar Display based on date_format.
266 If date_format is not supplied, the return is based on system preference.
268 C4::Dates->DHTMLcalendar(); # e.g., returns "%m/%d/%Y" for 'us' system preference
270 =head3 Error Handling
272 Some error handling is provided in this module, but not all. Requesting an unknown format is a
273 fatal error (because it is programmer error, not user error, typically).
275 Scripts must still perform validation of user input. Attempting to set an invalid value will
276 return 0 or undefined, so a script might check as follows:
278 my $date = C4::Dates->new($input) or deal_with_it("$input didn't work");
280 To validate before creating a new object, use the regexp method of the class:
282 $input =~ C4::Dates->regexp("iso") or deal_with_it("input ($input) invalid as iso format");
283 my $date = C4::Dates->new($input,"iso");
285 More verose debugging messages are sent in the presence of non-zero $ENV{"DEBUG"}.
289 If the date format is not in <systempreference>, we should send an error back to the user.
290 This kind of check should be centralized somewhere. Probably not here, though.
292 Notes: if the date in the db is null or empty, interpret null expiration to mean "never expires".