← Index
NYTProf Performance Profile   « line view »
For svc/members/upsert
  Run on Tue Jan 13 11:50:22 2015
Reported on Tue Jan 13 12:09:47 2015

Filename/mnt/catalyst/koha/C4/Dates.pm
StatementsExecuted 31 statements in 2.14ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
111890µs6.59msC4::Dates::::BEGIN@29C4::Dates::BEGIN@29
111416µs427µsC4::Dates::::BEGIN@22C4::Dates::BEGIN@22
1119µs17µsC4::Dates::::BEGIN@23C4::Dates::BEGIN@23
1118µs8µsC4::Dates::::BEGIN@33C4::Dates::BEGIN@33
1118µs84µsC4::Dates::::BEGIN@26C4::Dates::BEGIN@26
1118µs19µsC4::Dates::::BEGIN@27C4::Dates::BEGIN@27
1117µs1.05msC4::Dates::::BEGIN@28C4::Dates::BEGIN@28
1117µs41µsC4::Dates::::BEGIN@24C4::Dates::BEGIN@24
1117µs50µsC4::Dates::::BEGIN@30C4::Dates::BEGIN@30
1116µs8µsC4::Dates::::BEGIN@25C4::Dates::BEGIN@25
1116µs19µsC4::Dates::::BEGIN@39C4::Dates::BEGIN@39
1115µs22µsC4::Dates::::BEGIN@31C4::Dates::BEGIN@31
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
22227µs2439µs
# spent 427µs (416+12) within C4::Dates::BEGIN@22 which was called: # once (416µs+12µs) by C4::Members::BEGIN@26 at line 22
use strict;
# spent 427µs making 1 call to C4::Dates::BEGIN@22 # spent 12µs making 1 call to strict::import
23221µs225µs
# spent 17µs (9+8) within C4::Dates::BEGIN@23 which was called: # once (9µs+8µs) by C4::Members::BEGIN@26 at line 23
use warnings;
# spent 17µs making 1 call to C4::Dates::BEGIN@23 # spent 8µs making 1 call to warnings::import
24222µs274µs
# spent 41µs (7+34) within C4::Dates::BEGIN@24 which was called: # once (7µs+34µs) by C4::Members::BEGIN@26 at line 24
use Carp;
# spent 41µs making 1 call to C4::Dates::BEGIN@24 # spent 34µs making 1 call to Exporter::import
25217µs29µs
# spent 8µs (6+1) within C4::Dates::BEGIN@25 which was called: # once (6µs+1µs) by C4::Members::BEGIN@26 at line 25
use C4::Context;
# spent 8µs making 1 call to C4::Dates::BEGIN@25 # spent 1µs making 1 call to C4::Context::import
26224µs2159µs
# spent 84µs (8+75) within C4::Dates::BEGIN@26 which was called: # once (8µs+75µs) by C4::Members::BEGIN@26 at line 26
use C4::Debug;
# spent 84µs making 1 call to C4::Dates::BEGIN@26 # spent 76µs making 1 call to Exporter::import
27223µs230µs
# spent 19µs (8+11) within C4::Dates::BEGIN@27 which was called: # once (8µs+11µs) by C4::Members::BEGIN@26 at line 27
use Exporter;
# spent 19µs making 1 call to C4::Dates::BEGIN@27 # spent 11µs making 1 call to Exporter::import
28228µs22.08ms
# spent 1.05ms (7µs+1.04) within C4::Dates::BEGIN@28 which was called: # once (7µs+1.04ms) by C4::Members::BEGIN@26 at line 28
use POSIX qw(strftime);
# spent 1.05ms making 1 call to C4::Dates::BEGIN@28 # spent 1.04ms making 1 call to POSIX::import
292677µs26.69ms
# spent 6.59ms (890µs+5.70) within C4::Dates::BEGIN@29 which was called: # once (890µs+5.70ms) by C4::Members::BEGIN@26 at line 29
use Date::Calc qw(check_date check_time);
# spent 6.59ms making 1 call to C4::Dates::BEGIN@29 # spent 94µs making 1 call to Exporter::import
30223µs294µs
# spent 50µs (7+44) within C4::Dates::BEGIN@30 which was called: # once (7µs+44µs) by C4::Members::BEGIN@26 at line 30
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
# spent 50µs making 1 call to C4::Dates::BEGIN@30 # spent 44µs making 1 call to vars::import
31236µs239µs
# spent 22µs (5+17) within C4::Dates::BEGIN@31 which was called: # once (5µs+17µs) by C4::Members::BEGIN@26 at line 31
use vars qw($debug $cgi_debug);
# spent 22µs making 1 call to C4::Dates::BEGIN@31 # spent 17µs making 1 call to vars::import
32
33
# spent 8µs within C4::Dates::BEGIN@33 which was called: # once (8µs+0s) by C4::Members::BEGIN@26 at line 37
BEGIN {
341700ns $VERSION = 3.07.00.049;
3515µs @ISA = qw(Exporter);
3614µs @EXPORT_OK = qw(format_date_in_iso format_date);
37119µs18µs}
# spent 8µs making 1 call to C4::Dates::BEGIN@33
38
3921.20ms232µs
# spent 19µs (6+13) within C4::Dates::BEGIN@39 which was called: # once (6µs+13µs) by C4::Members::BEGIN@26 at line 39
use vars qw($prefformat);
# spent 19µs making 1 call to C4::Dates::BEGIN@39 # spent 13µ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
5414µ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);
6111µ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
691700nsour %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
7811µsour @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
79
801600nsour @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
23415µs1;
235__END__
Report produced by the NYTProf 5.06 Perl profiler, developed by Tim Bunce and Adam Kaplan.