C4/XSLT Removing unconditionnal comment

[koha.git] / C4 / Dates.pm

diff --git a/C4/Dates.pm b/C4/Dates.pm
index 67430c9..451e2d3 100644 (file)
--- a/C4/Dates.pm
+++ b/C4/Dates.pm
@@ -18,23 +18,31 @@ use strict;
 use warnings;
 use Carp;
 use C4::Context;
 use warnings;
 use Carp;
 use C4::Context;

+use C4::Debug;

 use Exporter;
 use POSIX qw(strftime);
 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($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 = ( 
 
 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 = (
          sql  => 'yyyymmdd    HHMMSS',
 );
 our %posix_map = (


@@ -45,22 +53,27 @@ our %posix_map = (
 );
 
 our %dmy_subs = (                      # strings to eval  (after using regular expression returned by regexp below)
 );
 
 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
          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 
        ($format eq 'sql') and 

-       return qr/^(\d{4})(\d{2})(\d{2})(?:\s{4}(\d{2})(\d{2})(\d{2}))?/;
+       return qr/^(\d{4})(\d{1,2})(\d{1,2})(?:\s{4}(\d{2})(\d{2})(\d{2}))?/;

        ($format eq 'iso') and 
        ($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{2})$delim(\d{2})$delim(\d{4})(?:\s{1}(\d{2})\:?(\d{2})\:?(\d{2}))?/;  # everything else
+       return qr/^(\d{4})$delim(\d{1,2})$delim(\d{1,2})(?:(?:\s{1}|T)(\d{2})\:?(\d{2})\:?(\d{2}))?Z?/;
+       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

 }
 
 sub dmy_map ($$) {
 }
 
 sub dmy_map ($$) {


@@ -72,12 +85,36 @@ sub dmy_map ($$) {
        $debug and print STDERR "xsub: $xsub \n";
        if ($val =~ /$re/) {
                my $aref = eval $xsub;
        $debug and print STDERR "xsub: $xsub \n";
        if ($val =~ /$re/) {
                my $aref = eval $xsub;

+        _check_date_and_time($aref);

                return  @{$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;
 }
 
        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 new {
        my $this = shift;
        my $class = ref($this) || $this;


@@ -88,34 +125,33 @@ sub new {
 sub init ($;$$) {
        my $self = shift;
        my $dformat;
 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');
        ($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;
        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;
 }
 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;
        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;
        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.
        return $posix_map{$format};     
 }
 sub format {   # get or set dateformat: iso, metric, us, etc.


@@ -126,9 +162,18 @@ sub format {       # get or set dateformat: iso, metric, us, etc.
 sub visual {
        my $self = shift;
        if (@_) {
 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;
 }
 
 1;


@@ -142,6 +187,12 @@ the script level, for example in initial form values or checks for min/max date.
 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).
 
 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
 =head2 ->new([string_date,][date_format])
 
 Arguments to new() are optional.  If string_date is not supplied, the present system date is


@@ -161,7 +212,7 @@ invoked when displaying it.
                my $date = C4::Dates->new();    # say today is July 12th, 2010
                print $date->output("iso");     # prints "2010-07-12"
                print "\n";
                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
 
 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


@@ -204,17 +255,32 @@ Or even:
 
                print C4::Dates->new("21-09-1989", "metric")->output("iso");
 
 
                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 $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
 
 
 =head3 Error Handling
 


@@ -231,14 +297,25 @@ To validate before creating a new object, use the regexp method of the class:
                $input =~ C4::Dates->regexp("iso") or deal_with_it("input ($input) invalid as iso format");
                my $date = C4::Dates->new($input,"iso");
 
                $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.
 
 
 =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
 
 =cut