← Index
NYTProf Performance Profile   « block view • line view • sub view »
For /usr/share/koha/opac/cgi-bin/opac/opac-search.pl
  Run on Tue Oct 15 11:58:52 2013
Reported on Tue Oct 15 12:01:03 2013

Filename/usr/share/koha/lib/C4/Dates.pm
StatementsExecuted 42 statements in 1.94ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1112.19ms3.00msC4::Dates::::BEGIN@29C4::Dates::BEGIN@29
11119µs24µsC4::Dates::::BEGIN@22C4::Dates::BEGIN@22
11115µs38µsC4::Dates::::BEGIN@23C4::Dates::BEGIN@23
11115µs142µsC4::Dates::::BEGIN@26C4::Dates::BEGIN@26
11114µs14µsC4::Dates::::BEGIN@33C4::Dates::BEGIN@33
11113µs3.20msC4::Dates::::BEGIN@28C4::Dates::BEGIN@28
11111µs31µsC4::Dates::::BEGIN@27C4::Dates::BEGIN@27
11111µs59µsC4::Dates::::BEGIN@24C4::Dates::BEGIN@24
11110µs87µsC4::Dates::::BEGIN@30C4::Dates::BEGIN@30
11110µs11µsC4::Dates::::BEGIN@25C4::Dates::BEGIN@25
1119µs37µsC4::Dates::::BEGIN@31C4::Dates::BEGIN@31
1118µs34µsC4::Dates::::BEGIN@39C4::Dates::BEGIN@39
0000s0sC4::Dates::::DHTMLcalendarC4::Dates::DHTMLcalendar
0000s0sC4::Dates::::_abbr_to_numericC4::Dates::_abbr_to_numeric
0000s0sC4::Dates::::_check_date_and_timeC4::Dates::_check_date_and_time
0000s0sC4::Dates::::_chron_to_hmsC4::Dates::_chron_to_hms
0000s0sC4::Dates::::_chron_to_ymdC4::Dates::_chron_to_ymd
0000s0sC4::Dates::::_prefformatC4::Dates::_prefformat
0000s0sC4::Dates::::_recognize_formatC4::Dates::_recognize_format
0000s0sC4::Dates::::dmy_mapC4::Dates::dmy_map
0000s0sC4::Dates::::formatC4::Dates::format
0000s0sC4::Dates::::format_dateC4::Dates::format_date
0000s0sC4::Dates::::format_date_in_isoC4::Dates::format_date_in_iso
0000s0sC4::Dates::::initC4::Dates::init
0000s0sC4::Dates::::newC4::Dates::new
0000s0sC4::Dates::::outputC4::Dates::output
0000s0sC4::Dates::::regexpC4::Dates::regexp
0000s0sC4::Dates::::reset_prefformatC4::Dates::reset_prefformat
0000s0sC4::Dates::::todayC4::Dates::today
0000s0sC4::Dates::::visualC4::Dates::visual
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package 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
22332µs229µs
# spent 24µs (19+5) within C4::Dates::BEGIN@22 which was called: # once (19µs+5µs) by C4::Output::BEGIN@34 at line 22
use strict;
# spent 24µs making 1 call to C4::Dates::BEGIN@22 # spent 5µs making 1 call to strict::import
23334µs261µs
# spent 38µs (15+23) within C4::Dates::BEGIN@23 which was called: # once (15µs+23µs) by C4::Output::BEGIN@34 at line 23
use warnings;
# spent 38µs making 1 call to C4::Dates::BEGIN@23 # spent 23µs making 1 call to warnings::import
24329µs2107µs
# spent 59µs (11+48) within C4::Dates::BEGIN@24 which was called: # once (11µs+48µs) by C4::Output::BEGIN@34 at line 24
use Carp;
# spent 59µs making 1 call to C4::Dates::BEGIN@24 # spent 48µs making 1 call to Exporter::import
25325µs213µs
# spent 11µs (10+2) within C4::Dates::BEGIN@25 which was called: # once (10µs+2µs) by C4::Output::BEGIN@34 at line 25
use C4::Context;
# spent 11µs making 1 call to C4::Dates::BEGIN@25 # spent 2µs making 1 call to C4::Context::import
26336µs2270µs
# spent 142µs (15+127) within C4::Dates::BEGIN@26 which was called: # once (15µs+127µs) by C4::Output::BEGIN@34 at line 26
use C4::Debug;
# spent 142µs making 1 call to C4::Dates::BEGIN@26 # spent 127µs making 1 call to Exporter::import
27331µs250µs
# spent 31µs (11+19) within C4::Dates::BEGIN@27 which was called: # once (11µs+19µs) by C4::Output::BEGIN@34 at line 27
use Exporter;
# spent 31µs making 1 call to C4::Dates::BEGIN@27 # spent 19µs making 1 call to Exporter::import
28360µs26.38ms
# spent 3.20ms (13µs+3.18) within C4::Dates::BEGIN@28 which was called: # once (13µs+3.18ms) by C4::Output::BEGIN@34 at line 28
use POSIX qw(strftime);
# spent 3.20ms making 1 call to C4::Dates::BEGIN@28 # spent 3.18ms making 1 call to POSIX::import
293166µs23.24ms
# spent 3.00ms (2.19+810µs) within C4::Dates::BEGIN@29 which was called: # once (2.19ms+810µs) by C4::Output::BEGIN@34 at line 29
use Date::Calc qw(check_date check_time);
# spent 3.00ms making 1 call to C4::Dates::BEGIN@29 # spent 247µs making 1 call to Exporter::import
30337µs2164µs
# spent 87µs (10+77) within C4::Dates::BEGIN@30 which was called: # once (10µs+77µs) by C4::Output::BEGIN@34 at line 30
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
# spent 87µs making 1 call to C4::Dates::BEGIN@30 # spent 77µs making 1 call to vars::import
31351µs266µs
# spent 37µs (9+28) within C4::Dates::BEGIN@31 which was called: # once (9µs+28µs) by C4::Output::BEGIN@34 at line 31
use vars qw($debug $cgi_debug);
# spent 37µs making 1 call to C4::Dates::BEGIN@31 # spent 28µs making 1 call to vars::import
32
33
# spent 14µs within C4::Dates::BEGIN@33 which was called: # once (14µs+0s) by C4::Output::BEGIN@34 at line 37
BEGIN {
34314µs $VERSION = 3.07.00.049;
35 @ISA = qw(Exporter);
36 @EXPORT_OK = qw(format_date_in_iso format_date);
37123µs114µs}
# spent 14µs making 1 call to C4::Dates::BEGIN@33
38
3931.38ms259µs
# spent 34µs (8+26) within C4::Dates::BEGIN@39 which was called: # once (8µs+26µs) by C4::Output::BEGIN@34 at line 39
use vars qw($prefformat);
# spent 34µs making 1 call to C4::Dates::BEGIN@39 # spent 26µs making 1 call to vars::import
40
41sub _prefformat {
42 unless ( defined $prefformat ) {
43 $prefformat = C4::Context->preference('dateformat');
44 }
45 return $prefformat;
46}
47
48sub 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
5415µsour %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);
6112µsour %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
6912µsour %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
7812µsour @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
79
8011µsour @days = qw(Sun Mon Tue Wed Thu Fri Sat);
81
82sub 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
100sub 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
123sub _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
144sub _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
156sub _chron_to_ymd {
157 my $chron_ref = shift;
158 return ( $chron_ref->[5] + 1900, $chron_ref->[4] + 1, $chron_ref->[3] );
159}
160
161sub _chron_to_hms {
162 my $chron_ref = shift;
163 return ( $chron_ref->[2], $chron_ref->[1], $chron_ref->[0] );
164}
165
166sub new {
167 my $this = shift;
168 my $class = ref($this) || $this;
169 my $self = {};
170 bless $self, $class;
171 return $self->init(@_);
172}
173
174sub 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
184sub 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
190sub 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
197sub _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
204sub DHTMLcalendar ($;$) { # interface to posix_map
205 my $class = shift;
206 my $format = (@_) ? shift : _prefformat();
207 return $posix_map{$format};
208}
209
210sub 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
216sub 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
226sub format_date {
227 return __PACKAGE__->new( shift, 'iso' )->output( (@_) ? shift : _prefformat() );
228}
229
230sub format_date_in_iso {
231 return __PACKAGE__->new( shift, _prefformat() )->output('iso');
232}
233
234110µs1;
235__END__
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.