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
22 use POSIX qw(strftime);
23 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
27 @EXPORT_OK = qw(DHTMLcalendar);
29 my $prefformat = C4::Context->preference('dateformat');
30 my $debug = $ENV{'DEBUG'} || 0;
36 metric => 'dd/mm/yyyy',
38 sql => 'yyyymmdd HHMMSS',
41 iso => '%Y-%m-%d', # or %F, "Full Date"
44 sql => '%Y%m%d %H%M%S',
47 our %dmy_subs = ( # strings to eval (after using regular expression returned by regexp below)
48 # make arrayrs for POSIX::strftime()
49 iso => '[(0,0,0,$3, $2 - 1, $1 - 1900)]',
50 metric => '[(0,0,0,$1, $2 - 1, $3 - 1900)]',
51 us => '[(0,0,0,$2, $1 - 1, $3 - 1900)]',
52 sql => '[(($6||0),($5||0),($4||0),$3, $2 - 1, $1 - 1900)]',
57 my $delim = qr/:?\:|\/|-/; # "non memory" cluster: no backreference
58 my $format = (@_) ? shift : $self->{'dateformat'}; # w/o arg. relies on dateformat being defined
59 ($format eq 'sql') and
60 return qr/^(\d{4})(\d{2})(\d{2})(?:\s{4}(\d{2})(\d{2})(\d{2}))?/;
61 ($format eq 'iso') and
62 return qr/^(\d{4})$delim(\d{2})$delim(\d{2})(?:\s{1}(\d{2})\:?(\d{2})\:?(\d{2}))?/;
63 return qr/^(\d{2})$delim(\d{2})$delim(\d{4})(?:\s{1}(\d{2})\:?(\d{2})\:?(\d{2}))?/; # everything else
68 my $val = shift or return undef;
69 my $dformat = $self->{'dateformat'} or return undef;
70 my $re = $self->regexp();
71 my $xsub = $dmy_subs{$dformat};
72 $debug and print STDERR "xsub: $xsub \n";
74 my $aref = eval $xsub;
77 $debug and carp "Illegal Date '$val' does not match $dformat format: $re\n";
83 my $class = ref($this) || $this;
86 return $self->init(@_);
91 $self->{'dateformat'} = $dformat = (scalar(@_) >= 2) ? $_[1] : $prefformat;
92 ($format_map{$dformat}) or croak
93 "Invalid date format '$dformat' from " . ((scalar(@_) >= 2) ? 'argument' : 'system preferences');
94 # scalar(@self::dmy_array) and croak "\$self is " . ref($self) . "\n\@self::dmy_array already populated: @self::dmy_array";
95 @self::dmy_array = ((@_) ? $self->dmy_map(shift) : localtime);
96 $debug and print STDERR "(during init) \@self::dmy_array = (@self::dmy_array)\n"; #debug
101 my $newformat = (@_) ? _recognize_format(shift) : $self->{'dateformat'} ;
102 return POSIX::strftime($posix_map{$newformat}, @self::dmy_array);
104 sub today ($;$) { # NOTE: sets date value to today (and returns it in the requested or current format)
106 $class = ref($class) || $class;
107 my $format = (@_) ? _recognize_format(shift) : $prefformat;
108 return $class->new()->output($format);
110 sub _recognize_format($) {
111 my $incoming = shift;
112 ($incoming eq 'syspref') and return $prefformat;
113 (scalar grep (/^$incoming$/, keys %format_map) == 1) or croak "The format you asked for ('$incoming') in unrecognized.";
116 sub DHTMLcalendar ($;$) { # interface to posix_map
118 my $format = (@_) ? shift : $prefformat;
119 return $posix_map{$format};
121 sub format { # get or set dateformat: iso, metric, us, etc.
123 (@_) or return $self->{'dateformat'};
124 $self->{'dateformat'} = _recognize_format(shift);
129 return $format_map{ shift };
131 return $format_map{$self->{'dateformat'} || $prefformat} ;
137 =head1 C4::Dates.pm - a more object-oriented replacement for Date.pm.
139 The core problem to address is the multiplicity of formats used by different Koha
140 installations around the world. We needed to move away from any hard-coded values at
141 the script level, for example in initial form values or checks for min/max date. The
142 reason is clear when you consider string '07/01/2004'. Depending on the format, it
143 represents July 1st (us), or January 7th (metric), or an invalid value (iso).
145 =head2 ->new([string_date,][date_format])
147 Arguments to new() are optional. If string_date is not supplied, the present system date is
148 used. If date_format is not supplied, the system preference from C4::Context is used.
152 my $now = C4::Dates->new();
153 my $date1 = C4::Dates->new("09-21-1989","us");
154 my $date2 = C4::Dates->new("19890921 143907","sql");
156 =head2 ->output([date_format])
158 The date value is stored independent of any specific format. Therefore any format can be
159 invoked when displaying it.
161 my $date = C4::Dates->new(); # say today is July 12th, 2010
162 print $date->output("iso"); # prints "2010-07-12"
164 print $date->output("metric"); # prints "12-07-2007"
166 However, it is still necessary to know the format of any incoming date value (e.g.,
167 setting the value of an object with new()). Like new(), output() assumes the system preference
168 date format unless otherwise instructed.
170 =head2 ->format([date_format])
172 With no argument, format returns the object's current date_format. Otherwise it attempts to
173 set the object format to the supplied value.
175 Some previously desireable functions are now unnecessary. For example, you might want a
176 method/function to tell you whether or not a Dates.pm object is of the 'iso' type. But you
177 can see by this example that such a test is trivial to accomplish, and not necessary to
178 include in the module:
182 return ($self->format() eq "iso");
185 Note: A similar function would need to be included for each format.
187 Instead a dependent script can retrieve the format of the object directly and decide what to
188 do with it from there:
190 my $date = C4::Dates->new();
191 my $format = $date->format();
192 ($format eq "iso") or do_something($date);
194 Or if you just want to print a given value and format, no problem:
196 my $date = C4::Dates->new("1989-09-21", "iso");
201 print C4::Dates->new("1989-09-21", "iso")->output;
205 print C4::Dates->new("21-09-1989", "metric")->output("iso");
207 =head2 ->DHMTLCalendar([date_format])
209 Returns the format string for DHTML Calendar Display based on date_format.
210 If date_format is not supplied, the return is based on system preference.
212 C4::Dates->new()->DHTMLCalendar(); # e.g., returns "%m/%d/%Y" for 'us' system preference
214 Format dates from database in ISO format into the <systempreference> format for display to user:
216 my $date = C4::Dates->new($date_from_database,"iso");
217 my $datestring_for_display = $date->display("syspref");
219 =head3 Error Handling
221 Some error handling is provided in this module, but not all. Requesting an unknown format is a
222 fatal error (because it is programmer error, not user error, typically).
224 Scripts must still perform validation of user input. Attempting to set an invalid value will
225 return 0 or undefined, so a script might check as follows:
227 my $date = C4::Dates->new($input) or deal_with_it("$input didn't work");
229 To validate before creating a new object, use the regexp method of the class:
231 $input =~ C4::Dates->regexp("iso") or deal_with_it("input ($input) invalid as iso format");
232 my $date = C4::Dates->new($input,"iso");
234 More verose debugging messages are sent in the presence of non-zero $ENV{"DEBUG"}.
238 If the date format is not in <systempreference>, we should send an error back to the user.
239 This kind of check should be centralized somewhere. Probably not here, though.
241 Notes: if the date in the db is null or empty, interpret null expiration to mean "never expires".