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 format_date_in_iso format_date);
+BEGIN {
+ $VERSION = 0.03;
+ @ISA = qw(Exporter);
+ @EXPORT_OK = qw(DHTMLcalendar format_date_in_iso format_date);
+}
my $prefformat = C4::Context->preference('dateformat');
-my $debug = $ENV{'DEBUG'} || 0;
-
-our @dmy_array = ();
+# print STDERR " Dates : \$debug is '$debug'\n";
+# print STDERR " Dates : \$cgi_debug is '$cgi_debug'\n";
our %format_map = (
iso => 'yyyy-mm-dd',
$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;
$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 print STDERR "(during init) \@\$self->{'dmy_arrayref'}: " . join(' ',@{$self->{'dmy_arrayref'}}) . "\n";
return $self;
}
sub output ($;$) {
my $self = shift;
my $newformat = (@_) ? _recognize_format(shift) : $prefformat;
- return (eval {POSIX::strftime($posix_map{$newformat}, @self::dmy_array)} || undef);
+ 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;