| 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 | -  |