bug 8215: (followup) make sure C4::CourseReserves doesn't export anything
[koha.git] / C4 / Dates.pm
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 under the
10 # terms of the GNU General Public License as published by the Free Software
11 # Foundation; either version 2 of the License, or (at your option) any later
12 # version.
13 #
14 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
15 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
16 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
17 #
18 # You should have received a copy of the GNU General Public License along
19 # with Koha; if not, write to the Free Software Foundation, Inc.,
20 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
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 desireable 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 psuedo-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