View | Details | Raw Unified | Return to bug 14870
Collapse All | Expand All

(-)a/C4/Dates.pm (-378 lines)
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
- 

Return to bug 14870