use warnings;
use Carp;
use C4::Context;
+use C4::Debug;
use Exporter;
use POSIX qw(strftime);
+use Date::Calc qw(check_date check_time);
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+use vars qw($debug $cgi_debug);
-$VERSION = 0.03;
-@ISA = qw(Exporter);
-@EXPORT_OK = qw(DHTMLcalendar);
-
-my $prefformat = C4::Context->preference('dateformat');
-my $debug = $ENV{'DEBUG'} || 0;
+BEGIN {
+ $VERSION = 0.04;
+ @ISA = qw(Exporter);
+ @EXPORT_OK = qw(format_date_in_iso format_date);
+}
-our @dmy_array = ();
+use vars qw($prefformat);
+sub _prefformat {
+ unless (defined $prefformat) {
+ $prefformat = C4::Context->preference('dateformat');
+ }
+ return $prefformat;
+}
our %format_map = (
- iso => 'yyyy-mm-dd',
- metric => 'dd/mm/yyyy',
- us => 'mm/dd/yyyy',
+ iso => 'yyyy-mm-dd', # plus " HH:MM:SS"
+ metric => 'dd/mm/yyyy', # plus " HH:MM:SS"
+ us => 'mm/dd/yyyy', # plus " HH:MM:SS"
sql => 'yyyymmdd HHMMSS',
);
our %posix_map = (
);
our %dmy_subs = ( # strings to eval (after using regular expression returned by regexp below)
- # make arrayrs for POSIX::strftime()
- iso => '[(0,0,0,$3, $2 - 1, $1 - 1900)]',
- metric => '[(0,0,0,$1, $2 - 1, $3 - 1900)]',
- us => '[(0,0,0,$2, $1 - 1, $3 - 1900)]',
+ # make arrays for POSIX::strftime()
+ iso => '[(($6||0),($5||0),($4||0),$3, $2 - 1, $1 - 1900)]',
+ metric => '[(($6||0),($5||0),($4||0),$1, $2 - 1, $3 - 1900)]',
+ us => '[(($6||0),($5||0),($4||0),$2, $1 - 1, $3 - 1900)]',
sql => '[(($6||0),($5||0),($4||0),$3, $2 - 1, $1 - 1900)]',
);
sub regexp ($;$) {
my $self = shift;
my $delim = qr/:?\:|\/|-/; # "non memory" cluster: no backreference
- my $format = (@_) ? shift : $self->{'dateformat'}; # w/o arg. relies on dateformat being defined
+ my $format = (@_) ? _recognize_format(shift) : ($self->{'dateformat'} || _prefformat());
+
+ # Extra layer of checking $self->{'dateformat'}.
+ # Why? Because it is assumed you might want to check regexp against an *instantiated* Dates object as a
+ # way of saying "does this string match *whatever* format that Dates object is?"
+
($format eq 'sql') and
return qr/^(\d{4})(\d{2})(\d{2})(?:\s{4}(\d{2})(\d{2})(\d{2}))?/;
($format eq 'iso') and
- return qr/^(\d{4})$delim(\d{2})$delim(\d{2})(?:\s{1}(\d{2})\:?(\d{2})\:?(\d{2}))?/;
+ return qr/^(\d{4})$delim(\d{2})$delim(\d{2})(?:(?:\s{1}|T)(\d{2})\:?(\d{2})\:?(\d{2}))?Z?/;
return qr/^(\d{2})$delim(\d{2})$delim(\d{4})(?:\s{1}(\d{2})\:?(\d{2})\:?(\d{2}))?/; # everything else
}
$debug and print STDERR "xsub: $xsub \n";
if ($val =~ /$re/) {
my $aref = eval $xsub;
+ _check_date_and_time($aref);
return @{$aref};
}
- $debug and carp "Illegal Date '$val' does not match $dformat format: $re\n";
+ # $debug and
+ carp "Illegal Date '$val' does not match '$dformat' format: " . $self->visual();
return 0;
}
+sub _check_date_and_time {
+ my $chron_ref = shift;
+ my ($year, $month, $day) = _chron_to_ymd($chron_ref);
+ unless (check_date($year, $month, $day)) {
+ carp "Illegal date specified (year = $year, month = $month, day = $day)";
+ }
+ my ($hour, $minute, $second) = _chron_to_hms($chron_ref);
+ unless (check_time($hour, $minute, $second)) {
+ carp "Illegal time specified (hour = $hour, minute = $minute, second = $second)";
+ }
+}
+
+sub _chron_to_ymd {
+ my $chron_ref = shift;
+ return ($chron_ref->[5] + 1900, $chron_ref->[4] + 1, $chron_ref->[3]);
+}
+
+sub _chron_to_hms {
+ my $chron_ref = shift;
+ return ($chron_ref->[2], $chron_ref->[1], $chron_ref->[0]);
+}
+
sub new {
my $this = shift;
my $class = ref($this) || $this;
sub init ($;$$) {
my $self = shift;
my $dformat;
- $self->{'dateformat'} = $dformat = (scalar(@_) >= 2) ? $_[1] : $prefformat;
+ $self->{'dateformat'} = $dformat = (scalar(@_) >= 2) ? $_[1] : _prefformat();
($format_map{$dformat}) or croak
"Invalid date format '$dformat' from " . ((scalar(@_) >= 2) ? 'argument' : 'system preferences');
- # scalar(@self::dmy_array) and croak "\$self is " . ref($self) . "\n\@self::dmy_array already populated: @self::dmy_array";
- @self::dmy_array = ((@_) ? $self->dmy_map(shift) : localtime);
- $debug and print STDERR "(during init) \@self::dmy_array = (@self::dmy_array)\n"; #debug
+ $self->{'dmy_arrayref'} = [((@_) ? $self->dmy_map(shift) : localtime )] ;
+ $debug and warn "(during init) \@\$self->{'dmy_arrayref'}: " . join(' ',@{$self->{'dmy_arrayref'}}) . "\n";
return $self;
}
sub output ($;$) {
my $self = shift;
- my $newformat = (@_) ? _recognize_format(shift) : $self->{'dateformat'} ;
- return POSIX::strftime($posix_map{$newformat}, @self::dmy_array);
+ my $newformat = (@_) ? _recognize_format(shift) : _prefformat();
+ return (eval {POSIX::strftime($posix_map{$newformat}, @{$self->{'dmy_arrayref'}})} || undef);
}
sub today ($;$) { # NOTE: sets date value to today (and returns it in the requested or current format)
my $class = shift;
$class = ref($class) || $class;
- my $format = (@_) ? _recognize_format(shift) : $prefformat;
+ my $format = (@_) ? _recognize_format(shift) : _prefformat();
return $class->new()->output($format);
}
sub _recognize_format($) {
my $incoming = shift;
- ($incoming eq 'syspref') and return $prefformat;
- (scalar grep (/^$incoming$/, keys %format_map) == 1) or croak "The format you asked for ('$incoming') in unrecognized.";
+ ($incoming eq 'syspref') and return _prefformat();
+ (scalar grep (/^$incoming$/, keys %format_map) == 1) or croak "The format you asked for ('$incoming') is unrecognized.";
return $incoming;
}
sub DHTMLcalendar ($;$) { # interface to posix_map
my $class = shift;
- my $format = (@_) ? shift : $prefformat;
+ my $format = (@_) ? shift : _prefformat();
return $posix_map{$format};
}
sub format { # get or set dateformat: iso, metric, us, etc.
sub visual {
my $self = shift;
if (@_) {
- return $format_map{ shift };
+ return $format_map{ _recognize_format(shift) };
}
- return $format_map{$self->{'dateformat'} || $prefformat} ;
+ $self eq __PACKAGE__ and return $format_map{_prefformat()};
+ return $format_map{ eval { $self->{'dateformat'} } || _prefformat()} ;
+}
+
+# like the functions from the old C4::Date.pm
+sub format_date {
+ return __PACKAGE__ -> new(shift,'iso')->output((@_) ? shift : _prefformat());
+}
+sub format_date_in_iso {
+ return __PACKAGE__ -> new(shift,_prefformat())->output('iso');
}
1;
reason is clear when you consider string '07/01/2004'. Depending on the format, it
represents July 1st (us), or January 7th (metric), or an invalid value (iso).
+The formats supported by Koha are:
+ iso - ISO 8601 (extended)
+ us - U.S. standard
+ metric - European standard (slight misnomer, not really decimalized metric)
+ sql - log format, not really for human consumption
+
=head2 ->new([string_date,][date_format])
Arguments to new() are optional. If string_date is not supplied, the present system date is
my $date = C4::Dates->new(); # say today is July 12th, 2010
print $date->output("iso"); # prints "2010-07-12"
print "\n";
- print $date->output("metric"); # prints "12-07-2007"
+ print $date->output("metric"); # prints "12-07-2010"
However, it is still necessary to know the format of any incoming date value (e.g.,
setting the value of an object with new()). Like new(), output() assumes the system preference
print C4::Dates->new("21-09-1989", "metric")->output("iso");
-=head2 ->DHMTLCalendar([date_format])
-
-Returns the format string for DHTML Calendar Display based on date_format.
-If date_format is not supplied, the return is based on system preference.
+=head2 "syspref" -- System Preference(s)
- C4::Dates->new()->DHTMLCalendar(); # e.g., returns "%m/%d/%Y" for 'us' system preference
+Perhaps you want to force data obtained in a known format to display according to the user's system
+preference, without necessarily knowing what that preference is. For this purpose, you can use the
+psuedo-format argument "syspref".
-Format dates from database in ISO format into the <systempreference> format for display to user:
+For example, to print an ISO date (from the database) in the <systempreference> format:
my $date = C4::Dates->new($date_from_database,"iso");
- my $datestring_for_display = $date->display("syspref");
+ my $datestring_for_display = $date->output("syspref");
+ print $datestring_for_display;
+
+Or even:
+
+ print C4::Dates->new($date_from_database,"iso")->output("syspref");
+
+If you just want to know what the <systempreferece> is, a default Dates object can tell you:
+
+ C4::Dates->new()->format();
+
+=head2 ->DHMTLcalendar([date_format])
+
+Returns the format string for DHTML Calendar Display based on date_format.
+If date_format is not supplied, the return is based on system preference.
+
+ C4::Dates->DHTMLcalendar(); # e.g., returns "%m/%d/%Y" for 'us' system preference
=head3 Error Handling
$input =~ C4::Dates->regexp("iso") or deal_with_it("input ($input) invalid as iso format");
my $date = C4::Dates->new($input,"iso");
-More verose debugging messages are sent in the presence of non-zero $ENV{"DEBUG"}.
+More verbose debugging messages are sent in the presence of non-zero $ENV{"DEBUG"}.
+
+Notes: if the date in the db is null or empty, interpret null expiration to mean "never expires".
+
+=head3 _prefformat()
+
+This internal function is used to read the preferred date format
+from the system preference table. It reads the preference once,
+then caches it.
+
+This replaces using the package variable $prefformat directly, and
+specifically, doing a call to C4::Context->preference() during
+module initialization. That way, C4::Dates no longer has a
+compile-time dependency on having a valid $dbh.
=head3 TO DO
If the date format is not in <systempreference>, we should send an error back to the user.
This kind of check should be centralized somewhere. Probably not here, though.
-Notes: if the date in the db is null or empty, interpret null expiration to mean "never expires".
-
=cut