← Index
Performance Profile   « block view • line view • sub view »
For opac/opac-main.pl
  Run on Thu Jul 17 22:22:09 2008
Reported on Thu Jul 17 22:22:22 2008

FileC4/Dates.pm
Statements Executed48
Total Time0.00039 seconds

Subroutines — ordered by inclusive time then name
CallsInclusive
Time		Subroutine
10.00077C4::Dates::format_date
10.00032C4::Dates::_prefformat
10.00031C4::Dates::new
10.00028C4::Dates::init
10.00026C4::Dates::dmy_map
10.00011C4::Dates::output
10.00008C4::Dates::_check_date_and_time
10.00007C4::Dates::regexp
10.00003C4::Dates::_recognize_format
10.00001C4::Dates::_chron_to_ymd
10.00001C4::Dates::_chron_to_hms
00C4::Dates::BEGIN
00C4::Dates::DHTMLcalendar
00C4::Dates::format
00C4::Dates::format_date_in_iso
00C4::Dates::today
00C4::Dates::visual

LineStmts.Exclusive
Time		Avg.Code
1package C4::Dates;
2# This file is part of Koha.
3#
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
7# version.
8#
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.
12#
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
16
17use strict;
18use warnings;
19use Carp;
20use C4::Context;
21use C4::Debug;
22use Exporter;
23use POSIX qw(strftime);
24use Date::Calc qw(check_date check_time);
25use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
26use vars qw($debug $cgi_debug);
27
28BEGIN {
29 $VERSION = 0.03;
30 @ISA = qw(Exporter);
31 @EXPORT_OK = qw(DHTMLcalendar format_date_in_iso format_date);
32}
33
34my $prefformat;
35
# spent 0.00032s within C4::Dates::_prefformat which was called: # 1 times (0.00032s) by C4::Dates::format_date at line 171 of C4/Dates.pm
sub _prefformat {
3628e-064e-06 unless (defined $prefformat) {
# spent 0.00031s making 1 calls to C4::Context::preference
37 $prefformat = C4::Context->preference('dateformat');
38 }
39 return $prefformat;
40}
41
42# print STDERR " Dates : \$debug is '$debug'\n";
43# print STDERR " Dates : \$cgi_debug is '$cgi_debug'\n";
44
45our %format_map = (
46 iso => 'yyyy-mm-dd',
47 metric => 'dd/mm/yyyy',
48 us => 'mm/dd/yyyy',
49 sql => 'yyyymmdd HHMMSS',
50);
51our %posix_map = (
52 iso => '%Y-%m-%d', # or %F, "Full Date"
53 metric => '%d/%m/%Y',
54 us => '%m/%d/%Y',
55 sql => '%Y%m%d %H%M%S',
56);
57
58our %dmy_subs = ( # strings to eval (after using regular expression returned by regexp below)
59 # make arrays for POSIX::strftime()
60 iso => '[(0,0,0,$3, $2 - 1, $1 - 1900)]',
61 metric => '[(0,0,0,$1, $2 - 1, $3 - 1900)]',
62 us => '[(0,0,0,$2, $1 - 1, $3 - 1900)]',
63 sql => '[(($6||0),($5||0),($4||0),$3, $2 - 1, $1 - 1900)]',
64);
65
66
# spent 0.00007s within C4::Dates::regexp which was called: # 1 times (0.00007s) by C4::Dates::dmy_map at line 81 of C4/Dates.pm
sub regexp ($;$) {
6750.000060.00001 my $self = shift;
68 my $delim = qr/:?\:|\/|-/; # "non memory" cluster: no backreference
69 my $format = (@_) ? shift : $self->{'dateformat'}; # w/o arg. relies on dateformat being defined
70 ($format eq 'sql') and
71 return qr/^(\d{4})(\d{2})(\d{2})(?:\s{4}(\d{2})(\d{2})(\d{2}))?/;
72 ($format eq 'iso') and
73 return qr/^(\d{4})$delim(\d{2})$delim(\d{2})(?:\s{1}(\d{2})\:?(\d{2})\:?(\d{2}))?/;
74 return qr/^(\d{2})$delim(\d{2})$delim(\d{4})(?:\s{1}(\d{2})\:?(\d{2})\:?(\d{2}))?/; # everything else
75}
76
77
# spent 0.00026s within C4::Dates::dmy_map which was called: # 1 times (0.00026s) by C4::Dates::init at line 129 of C4/Dates.pm
sub dmy_map ($$) {
78100.000099e-06 my $self = shift;
79 my $val = shift or return undef;
80 my $dformat = $self->{'dateformat'} or return undef;
81 my $re = $self->regexp();
# spent 0.00007s making 1 calls to C4::Dates::regexp
82 my $xsub = $dmy_subs{$dformat};
83 $debug and print STDERR "xsub: $xsub \n";
84 if ($val =~ /$re/) {
85100 my $aref = eval $xsub;
86 _check_date_and_time($aref);
# spent 0.00008s making 1 calls to C4::Dates::_check_date_and_time
87 return @{$aref};
88 }
89 # $debug and
90 carp "Illegal Date '$val' does not match '$dformat' format: " . $self->visual();
91 return 0;
92}
93
94
# spent 0.00008s within C4::Dates::_check_date_and_time which was called: # 1 times (0.00008s) by C4::Dates::dmy_map at line 86 of C4/Dates.pm
sub _check_date_and_time {
9550.000060.00001 my $chron_ref = shift;
96 my ($year, $month, $day) = _chron_to_ymd($chron_ref);
# spent 0.00001s making 1 calls to C4::Dates::_chron_to_ymd
97 unless (check_date($year, $month, $day)) {
# spent 0.00003s making 1 calls to Date::Calc::check_date
98 carp "Illegal date specified (year = $year, month = $month, day = $day)";
99 }
100 my ($hour, $minute, $second) = _chron_to_hms($chron_ref);
# spent 0.00001s making 1 calls to C4::Dates::_chron_to_hms
101 unless (check_time($hour, $minute, $second)) {
# spent 0.00001s making 1 calls to Date::Calc::check_time
102 carp "Illegal time specified (hour = $hour, minute = $minute, second = $second)";
103 }
104}
105
106
# spent 0.00001s within C4::Dates::_chron_to_ymd which was called: # 1 times (0.00001s) by C4::Dates::_check_date_and_time at line 96 of C4/Dates.pm
sub _chron_to_ymd {
10726e-063e-06 my $chron_ref = shift;
108 return ($chron_ref->[5] + 1900, $chron_ref->[4] + 1, $chron_ref->[3]);
109}
110
111
# spent 0.00001s within C4::Dates::_chron_to_hms which was called: # 1 times (0.00001s) by C4::Dates::_check_date_and_time at line 100 of C4/Dates.pm
sub _chron_to_hms {
11222e-061e-06 my $chron_ref = shift;
113 return ($chron_ref->[2], $chron_ref->[1], $chron_ref->[0]);
114}
115
116
# spent 0.00031s within C4::Dates::new which was called: # 1 times (0.00031s) by C4::Dates::format_date at line 171 of C4/Dates.pm
sub new {
11750.000035e-06 my $this = shift;
118 my $class = ref($this) || $this;
119 my $self = {};
120 bless $self, $class;
121 return $self->init(@_);
# spent 0.00028s making 1 calls to C4::Dates::init
122}
123
# spent 0.00028s within C4::Dates::init which was called: # 1 times (0.00028s) by C4::Dates::new at line 121 of C4/Dates.pm
sub init ($;$$) {
12470.000022e-06 my $self = shift;
125 my $dformat;
126 $self->{'dateformat'} = $dformat = (scalar(@_) >= 2) ? $_[1] : _prefformat();
127 ($format_map{$dformat}) or croak
128 "Invalid date format '$dformat' from " . ((scalar(@_) >= 2) ? 'argument' : 'system preferences');
129 $self->{'dmy_arrayref'} = [((@_) ? $self->dmy_map(shift) : localtime )] ;
# spent 0.00026s making 1 calls to C4::Dates::dmy_map
130 $debug and warn "(during init) \@\$self->{'dmy_arrayref'}: " . join(' ',@{$self->{'dmy_arrayref'}}) . "\n";
131 return $self;
132}
133
# spent 0.00011s within C4::Dates::output which was called: # 1 times (0.00011s) by C4::Dates::format_date at line 171 of C4/Dates.pm
sub output ($;$) {
13440.000070.00002 my $self = shift;
135 my $newformat = (@_) ? _recognize_format(shift) : _prefformat();
# spent 0.00003s making 1 calls to C4::Dates::_recognize_format
136 return (eval {POSIX::strftime($posix_map{$newformat}, @{$self->{'dmy_arrayref'}})} || undef);
# spent 0.00006s making 1 calls to POSIX::strftime
137}
138sub today ($;$) { # NOTE: sets date value to today (and returns it in the requested or current format)
139 my $class = shift;
140 $class = ref($class) || $class;
141 my $format = (@_) ? _recognize_format(shift) : _prefformat();
142 return $class->new()->output($format);
143}
144
# spent 0.00003s within C4::Dates::_recognize_format which was called: # 1 times (0.00003s) by C4::Dates::output at line 135 of C4/Dates.pm
sub _recognize_format($) {
14540.000026e-06 my $incoming = shift;
146 ($incoming eq 'syspref') and return _prefformat();
147 (scalar grep (/^$incoming$/, keys %format_map) == 1) or croak "The format you asked for ('$incoming') is unrecognized.";
148 return $incoming;
149}
150sub DHTMLcalendar ($;$) { # interface to posix_map
151 my $class = shift;
152 my $format = (@_) ? shift : _prefformat();
153 return $posix_map{$format};
154}
155sub format { # get or set dateformat: iso, metric, us, etc.
156 my $self = shift;
157 (@_) or return $self->{'dateformat'};
158 $self->{'dateformat'} = _recognize_format(shift);
159}
160sub visual {
161 my $self = shift;
162 if (@_) {
163 return $format_map{ _recognize_format(shift) };
164 }
165 $self eq __PACKAGE__ and return $format_map{_prefformat()};
166 return $format_map{ eval { $self->{'dateformat'} } || _prefformat()} ;
167}
168
169# like the functions from the old C4::Date.pm
170
# spent 0.00077s within C4::Dates::format_date which was called: # 1 times (0.00077s) by C4::NewsChannels::GetNewsToDisplay at line 340 of C4/NewsChannels.pm
sub format_date {
17110.000030.00003 return __PACKAGE__ -> new(shift,'iso')->output((@_) ? shift : _prefformat());
# spent 0.00032s making 1 calls to C4::Dates::_prefformat # spent 0.00031s making 1 calls to C4::Dates::new # spent 0.00011s making 1 calls to C4::Dates::output
172}
173sub format_date_in_iso {
174 return __PACKAGE__ -> new(shift,_prefformat())->output('iso');
175}
176
1771;
178__END__
179
180=head1 C4::Dates.pm - a more object-oriented replacement for Date.pm.
181
182The core problem to address is the multiplicity of formats used by different Koha
183installations around the world. We needed to move away from any hard-coded values at
184the script level, for example in initial form values or checks for min/max date. The
185reason is clear when you consider string '07/01/2004'. Depending on the format, it
186represents July 1st (us), or January 7th (metric), or an invalid value (iso).
187
188=head2 ->new([string_date,][date_format])
189
190Arguments to new() are optional. If string_date is not supplied, the present system date is
191used. If date_format is not supplied, the system preference from C4::Context is used.
192
193Examples:
194
195 my $now = C4::Dates->new();
196 my $date1 = C4::Dates->new("09-21-1989","us");
197 my $date2 = C4::Dates->new("19890921 143907","sql");
198
199=head2 ->output([date_format])
200
201The date value is stored independent of any specific format. Therefore any format can be
202invoked when displaying it.
203
204 my $date = C4::Dates->new(); # say today is July 12th, 2010
205 print $date->output("iso"); # prints "2010-07-12"
206 print "\n";
207 print $date->output("metric"); # prints "12-07-2007"
208
209However, it is still necessary to know the format of any incoming date value (e.g.,
210setting the value of an object with new()). Like new(), output() assumes the system preference
211date format unless otherwise instructed.
212
213=head2 ->format([date_format])
214
215With no argument, format returns the object's current date_format. Otherwise it attempts to
216set the object format to the supplied value.
217
218Some previously desireable functions are now unnecessary. For example, you might want a
219method/function to tell you whether or not a Dates.pm object is of the 'iso' type. But you
220can see by this example that such a test is trivial to accomplish, and not necessary to
221include in the module:
222
223 sub is_iso {
224 my $self = shift;
225 return ($self->format() eq "iso");
226 }
227
228Note: A similar function would need to be included for each format.
229
230Instead a dependent script can retrieve the format of the object directly and decide what to
231do with it from there:
232
233 my $date = C4::Dates->new();
234 my $format = $date->format();
235 ($format eq "iso") or do_something($date);
236
237Or if you just want to print a given value and format, no problem:
238
239 my $date = C4::Dates->new("1989-09-21", "iso");
240 print $date->output;
241
242Alternatively:
243
244 print C4::Dates->new("1989-09-21", "iso")->output;
245
246Or even:
247
248 print C4::Dates->new("21-09-1989", "metric")->output("iso");
249
250=head2 "syspref" -- System Preference(s)
251
252Perhaps you want to force data obtained in a known format to display according to the user's system
253preference, without necessarily knowing what that preference is. For this purpose, you can use the
254psuedo-format argument "syspref".
255
256For example, to print an ISO date (from the database) in the <systempreference> format:
257
258 my $date = C4::Dates->new($date_from_database,"iso");
259 my $datestring_for_display = $date->output("syspref");
260 print $datestring_for_display;
261
262Or even:
263
264 print C4::Dates->new($date_from_database,"iso")->output("syspref");
265
266If you just want to know what the <systempreferece> is, a default Dates object can tell you:
267
268 C4::Dates->new()->format();
269
270=head2 ->DHMTLcalendar([date_format])
271
272Returns the format string for DHTML Calendar Display based on date_format.
273If date_format is not supplied, the return is based on system preference.
274
275 C4::Dates->DHTMLcalendar(); # e.g., returns "%m/%d/%Y" for 'us' system preference
276
277=head3 Error Handling
278
279Some error handling is provided in this module, but not all. Requesting an unknown format is a
280fatal error (because it is programmer error, not user error, typically).
281
282Scripts must still perform validation of user input. Attempting to set an invalid value will
283return 0 or undefined, so a script might check as follows:
284
285 my $date = C4::Dates->new($input) or deal_with_it("$input didn't work");
286
287To validate before creating a new object, use the regexp method of the class:
288
289 $input =~ C4::Dates->regexp("iso") or deal_with_it("input ($input) invalid as iso format");
290 my $date = C4::Dates->new($input,"iso");
291
292More verbose debugging messages are sent in the presence of non-zero $ENV{"DEBUG"}.
293
294=head3 TO DO
295
296If the date format is not in <systempreference>, we should send an error back to the user.
297This kind of check should be centralized somewhere. Probably not here, though.
298
299Notes: if the date in the db is null or empty, interpret null expiration to mean "never expires".
300
301=head3 _prefformat()
302
303This internal function is used to read the preferred date format
304from the system preference table. It reads the preference once,
305then caches it.
306
307This replaces using the package variable $prefformat directly, and
308specifically, doing a call to C4::Context->preference() during
309module initialization. That way, C4::Dates no longer has a
310compile-time dependency on having a valid $dbh.
311
312=cut
313
Report produced by the NYTProf 2.01 Perl profiler, developed by Tim Bunce and Adam Kaplan.