| File | C4/Dates.pm | Statements Executed | 47 | Total Time | 0.00039 seconds |
| Calls | Inclusive Time | Subroutine | |
|---|---|---|---|
| 1 | 0.00077 | C4::Dates:: | format_date |
| 1 | 0.00032 | C4::Dates:: | _prefformat |
| 1 | 0.00031 | C4::Dates:: | new |
| 1 | 0.00028 | C4::Dates:: | init |
| 1 | 0.00026 | C4::Dates:: | dmy_map |
| 1 | 0.00011 | C4::Dates:: | output |
| 1 | 0.00008 | C4::Dates:: | _check_date_and_time |
| 1 | 0.00007 | C4::Dates:: | regexp |
| 1 | 0.00003 | C4::Dates:: | _recognize_format |
| 1 | 0.00001 | C4::Dates:: | _chron_to_ymd |
| 1 | 0.00001 | C4::Dates:: | _chron_to_hms |
| 0 | 0 | C4::Dates:: | BEGIN |
| 0 | 0 | C4::Dates:: | DHTMLcalendar |
| 0 | 0 | C4::Dates:: | format |
| 0 | 0 | C4::Dates:: | format_date_in_iso |
| 0 | 0 | C4::Dates:: | today |
| 0 | 0 | C4::Dates:: | visual |
| Line | Stmts. | Exclusive Time | Avg. | Code |
|---|---|---|---|---|
| 1 | package 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 | ||||
| 17 | use strict; | |||
| 18 | use warnings; | |||
| 19 | use Carp; | |||
| 20 | use C4::Context; | |||
| 21 | use C4::Debug; | |||
| 22 | use Exporter; | |||
| 23 | use POSIX qw(strftime); | |||
| 24 | use Date::Calc qw(check_date check_time); | |||
| 25 | use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); | |||
| 26 | use vars qw($debug $cgi_debug); | |||
| 27 | ||||
| 28 | BEGIN { | |||
| 29 | $VERSION = 0.03; | |||
| 30 | @ISA = qw(Exporter); | |||
| 31 | @EXPORT_OK = qw(DHTMLcalendar format_date_in_iso format_date); | |||
| 32 | } | |||
| 33 | ||||
| 34 | my $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 { | |||
| 36 | 1 | 7e-06 | 7e-06 | unless (defined $prefformat) { # spent 0.00031s making 1 calls to C4::Context::preference |
| 37 | $prefformat = C4::Context->preference('dateformat'); | |||
| 38 | } | |||
| 39 | 1 | 1e-06 | 1e-06 | return $prefformat; |
| 40 | } | |||
| 41 | ||||
| 42 | # print STDERR " Dates : \$debug is '$debug'\n"; | |||
| 43 | # print STDERR " Dates : \$cgi_debug is '$cgi_debug'\n"; | |||
| 44 | ||||
| 45 | our %format_map = ( | |||
| 46 | iso => 'yyyy-mm-dd', | |||
| 47 | metric => 'dd/mm/yyyy', | |||
| 48 | us => 'mm/dd/yyyy', | |||
| 49 | sql => 'yyyymmdd HHMMSS', | |||
| 50 | ); | |||
| 51 | our %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 | ||||
| 58 | our %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 ($;$) { | |||
| 67 | 1 | 1e-06 | 1e-06 | my $self = shift; |
| 68 | 1 | 7e-06 | 7e-06 | my $delim = qr/:?\:|\/|-/; # "non memory" cluster: no backreference |
| 69 | 1 | 2e-06 | 2e-06 | my $format = (@_) ? shift : $self->{'dateformat'}; # w/o arg. relies on dateformat being defined |
| 70 | 1 | 2e-06 | 2e-06 | ($format eq 'sql') and |
| 71 | return qr/^(\d{4})(\d{2})(\d{2})(?:\s{4}(\d{2})(\d{2})(\d{2}))?/; | |||
| 72 | 1 | 0.00005 | 0.00005 | ($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 ($$) { | |||
| 78 | 1 | 1e-06 | 1e-06 | my $self = shift; |
| 79 | 1 | 1e-06 | 1e-06 | my $val = shift or return undef; |
| 80 | 1 | 1e-06 | 1e-06 | my $dformat = $self->{'dateformat'} or return undef; |
| 81 | 1 | 7e-06 | 7e-06 | my $re = $self->regexp(); # spent 0.00007s making 1 calls to C4::Dates::regexp |
| 82 | 1 | 2e-06 | 2e-06 | my $xsub = $dmy_subs{$dformat}; |
| 83 | 1 | 1e-06 | 1e-06 | $debug and print STDERR "xsub: $xsub \n"; |
| 84 | 1 | 0.00001 | 0.00001 | if ($val =~ /$re/) { |
| 85 | 1 | 0.00006 | 0.00006 | my $aref = eval $xsub; |
| 86 | 1 | 9e-06 | 9e-06 | _check_date_and_time($aref); # spent 0.00008s making 1 calls to C4::Dates::_check_date_and_time |
| 87 | 1 | 5e-06 | 5e-06 | 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 { | |||
| 95 | 1 | 1e-06 | 1e-06 | my $chron_ref = shift; |
| 96 | 1 | 8e-06 | 8e-06 | my ($year, $month, $day) = _chron_to_ymd($chron_ref); # spent 0.00001s making 1 calls to C4::Dates::_chron_to_ymd |
| 97 | 1 | 0.00003 | 0.00003 | 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 | 1 | 7e-06 | 7e-06 | my ($hour, $minute, $second) = _chron_to_hms($chron_ref); # spent 0.00001s making 1 calls to C4::Dates::_chron_to_hms |
| 101 | 1 | 0.00001 | 0.00001 | 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 { | |||
| 107 | 1 | 1e-06 | 1e-06 | my $chron_ref = shift; |
| 108 | 1 | 5e-06 | 5e-06 | 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 { | |||
| 112 | 1 | 0 | 0 | my $chron_ref = shift; |
| 113 | 1 | 2e-06 | 2e-06 | 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 { | |||
| 117 | 1 | 1e-06 | 1e-06 | my $this = shift; |
| 118 | 1 | 1e-06 | 1e-06 | my $class = ref($this) || $this; |
| 119 | 1 | 2e-06 | 2e-06 | my $self = {}; |
| 120 | 1 | 0.00002 | 0.00002 | bless $self, $class; |
| 121 | 1 | 8e-06 | 8e-06 | 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 ($;$$) { | |||
| 124 | 1 | 0 | 0 | my $self = shift; |
| 125 | 1 | 0 | 0 | my $dformat; |
| 126 | 1 | 3e-06 | 3e-06 | $self->{'dateformat'} = $dformat = (scalar(@_) >= 2) ? $_[1] : _prefformat(); |
| 127 | 1 | 1e-06 | 1e-06 | ($format_map{$dformat}) or croak |
| 128 | "Invalid date format '$dformat' from " . ((scalar(@_) >= 2) ? 'argument' : 'system preferences'); | |||
| 129 | 1 | 9e-06 | 9e-06 | $self->{'dmy_arrayref'} = [((@_) ? $self->dmy_map(shift) : localtime )] ; # spent 0.00026s making 1 calls to C4::Dates::dmy_map |
| 130 | 1 | 1e-06 | 1e-06 | $debug and warn "(during init) \@\$self->{'dmy_arrayref'}: " . join(' ',@{$self->{'dmy_arrayref'}}) . "\n"; |
| 131 | 1 | 1e-06 | 1e-06 | 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 ($;$) { | |||
| 134 | 1 | 1e-06 | 1e-06 | my $self = shift; |
| 135 | 1 | 6e-06 | 6e-06 | my $newformat = (@_) ? _recognize_format(shift) : _prefformat(); # spent 0.00003s making 1 calls to C4::Dates::_recognize_format |
| 136 | 2 | 0.00006 | 0.00003 | return (eval {POSIX::strftime($posix_map{$newformat}, @{$self->{'dmy_arrayref'}})} || undef); # spent 0.00006s making 1 calls to POSIX::strftime |
| 137 | } | |||
| 138 | sub 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($) { | |||
| 145 | 1 | 1e-06 | 1e-06 | my $incoming = shift; |
| 146 | 1 | 1e-06 | 1e-06 | ($incoming eq 'syspref') and return _prefformat(); |
| 147 | 1 | 0.00002 | 0.00002 | (scalar grep (/^$incoming$/, keys %format_map) == 1) or croak "The format you asked for ('$incoming') is unrecognized."; |
| 148 | 1 | 1e-06 | 1e-06 | return $incoming; |
| 149 | } | |||
| 150 | sub DHTMLcalendar ($;$) { # interface to posix_map | |||
| 151 | my $class = shift; | |||
| 152 | my $format = (@_) ? shift : _prefformat(); | |||
| 153 | return $posix_map{$format}; | |||
| 154 | } | |||
| 155 | sub 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 | } | |||
| 160 | sub 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 { | |||
| 171 | 1 | 0.00003 | 0.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 | } | |||
| 173 | sub format_date_in_iso { | |||
| 174 | return __PACKAGE__ -> new(shift,_prefformat())->output('iso'); | |||
| 175 | } | |||
| 176 | ||||
| 177 | 1; | |||
| 178 | __END__ | |||
| 179 | ||||
| 180 | =head1 C4::Dates.pm - a more object-oriented replacement for Date.pm. | |||
| 181 | ||||
| 182 | The core problem to address is the multiplicity of formats used by different Koha | |||
| 183 | installations around the world. We needed to move away from any hard-coded values at | |||
| 184 | the script level, for example in initial form values or checks for min/max date. The | |||
| 185 | reason is clear when you consider string '07/01/2004'. Depending on the format, it | |||
| 186 | represents July 1st (us), or January 7th (metric), or an invalid value (iso). | |||
| 187 | ||||
| 188 | =head2 ->new([string_date,][date_format]) | |||
| 189 | ||||
| 190 | Arguments to new() are optional. If string_date is not supplied, the present system date is | |||
| 191 | used. If date_format is not supplied, the system preference from C4::Context is used. | |||
| 192 | ||||
| 193 | Examples: | |||
| 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 | ||||
| 201 | The date value is stored independent of any specific format. Therefore any format can be | |||
| 202 | invoked 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 | ||||
| 209 | However, it is still necessary to know the format of any incoming date value (e.g., | |||
| 210 | setting the value of an object with new()). Like new(), output() assumes the system preference | |||
| 211 | date format unless otherwise instructed. | |||
| 212 | ||||
| 213 | =head2 ->format([date_format]) | |||
| 214 | ||||
| 215 | With no argument, format returns the object's current date_format. Otherwise it attempts to | |||
| 216 | set the object format to the supplied value. | |||
| 217 | ||||
| 218 | Some previously desireable functions are now unnecessary. For example, you might want a | |||
| 219 | method/function to tell you whether or not a Dates.pm object is of the 'iso' type. But you | |||
| 220 | can see by this example that such a test is trivial to accomplish, and not necessary to | |||
| 221 | include in the module: | |||
| 222 | ||||
| 223 | sub is_iso { | |||
| 224 | my $self = shift; | |||
| 225 | return ($self->format() eq "iso"); | |||
| 226 | } | |||
| 227 | ||||
| 228 | Note: A similar function would need to be included for each format. | |||
| 229 | ||||
| 230 | Instead a dependent script can retrieve the format of the object directly and decide what to | |||
| 231 | do 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 | ||||
| 237 | Or 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 | ||||
| 242 | Alternatively: | |||
| 243 | ||||
| 244 | print C4::Dates->new("1989-09-21", "iso")->output; | |||
| 245 | ||||
| 246 | Or even: | |||
| 247 | ||||
| 248 | print C4::Dates->new("21-09-1989", "metric")->output("iso"); | |||
| 249 | ||||
| 250 | =head2 "syspref" -- System Preference(s) | |||
| 251 | ||||
| 252 | Perhaps you want to force data obtained in a known format to display according to the user's system | |||
| 253 | preference, without necessarily knowing what that preference is. For this purpose, you can use the | |||
| 254 | psuedo-format argument "syspref". | |||
| 255 | ||||
| 256 | For 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 | ||||
| 262 | Or even: | |||
| 263 | ||||
| 264 | print C4::Dates->new($date_from_database,"iso")->output("syspref"); | |||
| 265 | ||||
| 266 | If 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 | ||||
| 272 | Returns the format string for DHTML Calendar Display based on date_format. | |||
| 273 | If 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 | ||||
| 279 | Some error handling is provided in this module, but not all. Requesting an unknown format is a | |||
| 280 | fatal error (because it is programmer error, not user error, typically). | |||
| 281 | ||||
| 282 | Scripts must still perform validation of user input. Attempting to set an invalid value will | |||
| 283 | return 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 | ||||
| 287 | To 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 | ||||
| 292 | More verbose debugging messages are sent in the presence of non-zero $ENV{"DEBUG"}. | |||
| 293 | ||||
| 294 | =head3 TO DO | |||
| 295 | ||||
| 296 | If the date format is not in <systempreference>, we should send an error back to the user. | |||
| 297 | This kind of check should be centralized somewhere. Probably not here, though. | |||
| 298 | ||||
| 299 | Notes: if the date in the db is null or empty, interpret null expiration to mean "never expires". | |||
| 300 | ||||
| 301 | =head3 _prefformat() | |||
| 302 | ||||
| 303 | This internal function is used to read the preferred date format | |||
| 304 | from the system preference table. It reads the preference once, | |||
| 305 | then caches it. | |||
| 306 | ||||
| 307 | This replaces using the package variable $prefformat directly, and | |||
| 308 | specifically, doing a call to C4::Context->preference() during | |||
| 309 | module initialization. That way, C4::Dates no longer has a | |||
| 310 | compile-time dependency on having a valid $dbh. | |||
| 311 | ||||
| 312 | =cut | |||
| 313 |