From 9bd2c1a142148a6f13627884d5eb7ef066913557 Mon Sep 17 00:00:00 2001 From: Chris Cormack Date: Tue, 31 May 2011 13:46:28 +1200 Subject: [PATCH] Bug 6431 - Copying C4::Dates and C4::Calenda to Koha:: and removing calls to C4:: modules Part of the work for 5549 Hourly circulation --- Koha/Calendar.pm | 650 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ Koha/Dates.pm | 367 ++++++++++++++++++++++++++++++ 2 files changed, 1017 insertions(+), 0 deletions(-) create mode 100644 Koha/Calendar.pm create mode 100644 Koha/Dates.pm diff --git a/Koha/Calendar.pm b/Koha/Calendar.pm new file mode 100644 index 0000000..45e7120 --- /dev/null +++ b/Koha/Calendar.pm @@ -0,0 +1,650 @@ +package Koha::Calendar; + +# Copyright Koha Physics Library UNLP +# Parts Copyright Catalyst IT 2011 +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 2 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along with +# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, +# Suite 330, Boston, MA 02111-1307 USA + +use strict; +use warnings; +use vars qw($VERSION @EXPORT); + +use Carp; +use Date::Calc qw( Date_to_Days ); + +BEGIN { + # set the version for version checking + $VERSION = 3.01; + require Exporter; + @EXPORT = qw( + &get_week_days_holidays + &get_day_month_holidays + &get_exception_holidays + &get_single_holidays + &insert_week_day_holiday + &insert_day_month_holiday + &insert_single_holiday + &insert_exception_holiday + &ModWeekdayholiday + &ModDaymonthholiday + &ModSingleholiday + &ModExceptionholiday + &delete_holiday + &isHoliday + &addDate + &daysBetween + ); +} + +=head1 NAME + +Koha::Calendar - Koha module dealing with holidays. + +=head1 SYNOPSIS + + use Koha::Calendar; + +=head1 DESCRIPTION + +This package is used to deal with holidays. Through this package, you can set +all kind of holidays for the library. + +=head1 FUNCTIONS + +=head2 new + + $calendar = Koha::Calender->new(branchcode => $branchcode, context => $context); + +Each library branch has its own Calendar. +C<$branchcode> specifies which Calendar you want. + +=cut + +sub new { + my $classname = shift @_; + my %options = @_; + my $self = bless({}, $classname); + foreach my $optionName (keys %options) { + $self->{lc($optionName)} = $options{$optionName}; + } + defined($self->{branchcode}) or croak "No branchcode argument to new. Should be Koha::Calender->new(branchcode => \$branchcode)"; + $self->_init($self->{branchcode}); + return $self; +} + +sub _init { + my $self = shift @_; + my $branch = shift; + defined($branch) or die "No branchcode sent to _init"; # must test for defined here and above to allow "" + my $dbh = $self->{context}->dbh(); + my $repeatable = $dbh->prepare( 'SELECT * + FROM repeatable_holidays + WHERE ( branchcode = ? ) + AND (ISNULL(weekday) = ?)' ); + $repeatable->execute($branch,0); + my %week_days_holidays; + while (my $row = $repeatable->fetchrow_hashref) { + my $key = $row->{weekday}; + $week_days_holidays{$key}{title} = $row->{title}; + $week_days_holidays{$key}{description} = $row->{description}; + } + $self->{'week_days_holidays'} = \%week_days_holidays; + + $repeatable->execute($branch,1); + my %day_month_holidays; + while (my $row = $repeatable->fetchrow_hashref) { + my $key = $row->{month} . "/" . $row->{day}; + $day_month_holidays{$key}{title} = $row->{title}; + $day_month_holidays{$key}{description} = $row->{description}; + $day_month_holidays{$key}{day} = sprintf("%02d", $row->{day}); + $day_month_holidays{$key}{month} = sprintf("%02d", $row->{month}); + } + $self->{'day_month_holidays'} = \%day_month_holidays; + + my $special = $dbh->prepare( 'SELECT day, month, year, title, description + FROM special_holidays + WHERE ( branchcode = ? ) + AND (isexception = ?)' ); + $special->execute($branch,1); + my %exception_holidays; + while (my ($day, $month, $year, $title, $description) = $special->fetchrow) { + $exception_holidays{"$year/$month/$day"}{title} = $title; + $exception_holidays{"$year/$month/$day"}{description} = $description; + $exception_holidays{"$year/$month/$day"}{date} = + sprintf("%04d-%02d-%02d", $year, $month, $day); + } + $self->{'exception_holidays'} = \%exception_holidays; + + $special->execute($branch,0); + my %single_holidays; + while (my ($day, $month, $year, $title, $description) = $special->fetchrow) { + $single_holidays{"$year/$month/$day"}{title} = $title; + $single_holidays{"$year/$month/$day"}{description} = $description; + $single_holidays{"$year/$month/$day"}{date} = + sprintf("%04d-%02d-%02d", $year, $month, $day); + } + $self->{'single_holidays'} = \%single_holidays; + return $self; +} + +=head2 get_week_days_holidays + + $week_days_holidays = $calendar->get_week_days_holidays(); + +Returns a hash reference to week days holidays. + +=cut + +sub get_week_days_holidays { + my $self = shift @_; + my $week_days_holidays = $self->{'week_days_holidays'}; + return $week_days_holidays; +} + +=head2 get_day_month_holidays + + $day_month_holidays = $calendar->get_day_month_holidays(); + +Returns a hash reference to day month holidays. + +=cut + +sub get_day_month_holidays { + my $self = shift @_; + my $day_month_holidays = $self->{'day_month_holidays'}; + return $day_month_holidays; +} + +=head2 get_exception_holidays + + $exception_holidays = $calendar->exception_holidays(); + +Returns a hash reference to exception holidays. This kind of days are those +which stands for a holiday, but you wanted to make an exception for this particular +date. + +=cut + +sub get_exception_holidays { + my $self = shift @_; + my $exception_holidays = $self->{'exception_holidays'}; + return $exception_holidays; +} + +=head2 get_single_holidays + + $single_holidays = $calendar->get_single_holidays(); + +Returns a hash reference to single holidays. This kind of holidays are those which +happend just one time. + +=cut + +sub get_single_holidays { + my $self = shift @_; + my $single_holidays = $self->{'single_holidays'}; + return $single_holidays; +} + +=head2 insert_week_day_holiday + + insert_week_day_holiday(weekday => $weekday, + title => $title, + description => $description); + +Inserts a new week day for $self->{branchcode}. + +C<$day> Is the week day to make holiday. + +C<$title> Is the title to store for the holiday formed by $year/$month/$day. + +C<$description> Is the description to store for the holiday formed by $year/$month/$day. + +=cut + +sub insert_week_day_holiday { + my $self = shift @_; + my %options = @_; + + my $dbh = $self->{context}->dbh(); + my $insertHoliday = $dbh->prepare("insert into repeatable_holidays (id,branchcode,weekday,day,month,title,description) values ( '',?,?,NULL,NULL,?,? )"); + $insertHoliday->execute( $self->{branchcode}, $options{weekday},$options{title}, $options{description}); + $self->{'week_days_holidays'}->{$options{weekday}}{title} = $options{title}; + $self->{'week_days_holidays'}->{$options{weekday}}{description} = $options{description}; + return $self; +} + +=head2 insert_day_month_holiday + + insert_day_month_holiday(day => $day, + month => $month, + title => $title, + description => $description); + +Inserts a new day month holiday for $self->{branchcode}. + +C<$day> Is the day month to make the date to insert. + +C<$month> Is month to make the date to insert. + +C<$title> Is the title to store for the holiday formed by $year/$month/$day. + +C<$description> Is the description to store for the holiday formed by $year/$month/$day. + +=cut + +sub insert_day_month_holiday { + my $self = shift @_; + my %options = @_; + + my $dbh = $self->{context}->dbh(); + my $insertHoliday = $dbh->prepare("insert into repeatable_holidays (id,branchcode,weekday,day,month,title,description) values ('', ?, NULL, ?, ?, ?,? )"); + $insertHoliday->execute( $self->{branchcode}, $options{day},$options{month},$options{title}, $options{description}); + $self->{'day_month_holidays'}->{"$options{month}/$options{day}"}{title} = $options{title}; + $self->{'day_month_holidays'}->{"$options{month}/$options{day}"}{description} = $options{description}; + return $self; +} + +=head2 insert_single_holiday + + insert_single_holiday(day => $day, + month => $month, + year => $year, + title => $title, + description => $description); + +Inserts a new single holiday for $self->{branchcode}. + +C<$day> Is the day month to make the date to insert. + +C<$month> Is month to make the date to insert. + +C<$year> Is year to make the date to insert. + +C<$title> Is the title to store for the holiday formed by $year/$month/$day. + +C<$description> Is the description to store for the holiday formed by $year/$month/$day. + +=cut + +sub insert_single_holiday { + my $self = shift @_; + my %options = @_; + + my $dbh = $self->{context}->dbh(); + my $isexception = 0; + my $insertHoliday = $dbh->prepare("insert into special_holidays (id,branchcode,day,month,year,isexception,title,description) values ('', ?,?,?,?,?,?,?)"); + $insertHoliday->execute( $self->{branchcode}, $options{day},$options{month},$options{year}, $isexception, $options{title}, $options{description}); + $self->{'single_holidays'}->{"$options{year}/$options{month}/$options{day}"}{title} = $options{title}; + $self->{'single_holidays'}->{"$options{year}/$options{month}/$options{day}"}{description} = $options{description}; + return $self; +} + +=head2 insert_exception_holiday + + insert_exception_holiday(day => $day, + month => $month, + year => $year, + title => $title, + description => $description); + +Inserts a new exception holiday for $self->{branchcode}. + +C<$day> Is the day month to make the date to insert. + +C<$month> Is month to make the date to insert. + +C<$year> Is year to make the date to insert. + +C<$title> Is the title to store for the holiday formed by $year/$month/$day. + +C<$description> Is the description to store for the holiday formed by $year/$month/$day. + +=cut + +sub insert_exception_holiday { + my $self = shift @_; + my %options = @_; + + my $dbh = $self->{context}->dbh(); + my $isexception = 1; + my $insertException = $dbh->prepare("insert into special_holidays (id,branchcode,day,month,year,isexception,title,description) values ('', ?,?,?,?,?,?,?)"); + $insertException->execute( $self->{branchcode}, $options{day},$options{month},$options{year}, $isexception, $options{title}, $options{description}); + $self->{'exception_holidays'}->{"$options{year}/$options{month}/$options{day}"}{title} = $options{title}; + $self->{'exception_holidays'}->{"$options{year}/$options{month}/$options{day}"}{description} = $options{description}; + return $self; +} + +=head2 ModWeekdayholiday + + ModWeekdayholiday(weekday =>$weekday, + title => $title, + description => $description) + +Modifies the title and description of a weekday for $self->{branchcode}. + +C<$weekday> Is the title to update for the holiday. + +C<$description> Is the description to update for the holiday. + +=cut + +sub ModWeekdayholiday { + my $self = shift @_; + my %options = @_; + + my $dbh = $self->{context}->dbh(); + my $updateHoliday = $dbh->prepare("UPDATE repeatable_holidays SET title = ?, description = ? WHERE branchcode = ? AND weekday = ?"); + $updateHoliday->execute( $options{title},$options{description},$self->{branchcode},$options{weekday}); + $self->{'week_days_holidays'}->{$options{weekday}}{title} = $options{title}; + $self->{'week_days_holidays'}->{$options{weekday}}{description} = $options{description}; + return $self; +} + +=head2 ModDaymonthholiday + + ModDaymonthholiday(day => $day, + month => $month, + title => $title, + description => $description); + +Modifies the title and description for a day/month holiday for $self->{branchcode}. + +C<$day> The day of the month for the update. + +C<$month> The month to be used for the update. + +C<$title> The title to be updated for the holiday. + +C<$description> The description to be update for the holiday. + +=cut + +sub ModDaymonthholiday { + my $self = shift @_; + my %options = @_; + + my $dbh = $self->{context}->dbh(); + my $updateHoliday = $dbh->prepare("UPDATE repeatable_holidays SET title = ?, description = ? WHERE month = ? AND day = ? AND branchcode = ?"); + $updateHoliday->execute( $options{title},$options{description},$options{month},$options{day},$self->{branchcode}); + $self->{'day_month_holidays'}->{"$options{month}/$options{day}"}{title} = $options{title}; + $self->{'day_month_holidays'}->{"$options{month}/$options{day}"}{description} = $options{description}; + return $self; +} + +=head2 ModSingleholiday + + ModSingleholiday(day => $day, + month => $month, + year => $year, + title => $title, + description => $description); + +Modifies the title and description for a single holiday for $self->{branchcode}. + +C<$day> Is the day of the month to make the update. + +C<$month> Is the month to make the update. + +C<$year> Is the year to make the update. + +C<$title> Is the title to update for the holiday formed by $year/$month/$day. + +C<$description> Is the description to update for the holiday formed by $year/$month/$day. + +=cut + +sub ModSingleholiday { + my $self = shift @_; + my %options = @_; + + my $dbh = $self->{context}->dbh(); + my $isexception = 0; + my $updateHoliday = $dbh->prepare("UPDATE special_holidays SET title = ?, description = ? WHERE day = ? AND month = ? AND year = ? AND branchcode = ? AND isexception = ?"); + $updateHoliday->execute($options{title},$options{description},$options{day},$options{month},$options{year},$self->{branchcode},$isexception); + $self->{'single_holidays'}->{"$options{year}/$options{month}/$options{day}"}{title} = $options{title}; + $self->{'single_holidays'}->{"$options{year}/$options{month}/$options{day}"}{description} = $options{description}; + return $self; +} + +=head2 ModExceptionholiday + + ModExceptionholiday(day => $day, + month => $month, + year => $year, + title => $title, + description => $description); + +Modifies the title and description for an exception holiday for $self->{branchcode}. + +C<$day> Is the day of the month for the holiday. + +C<$month> Is the month for the holiday. + +C<$year> Is the year for the holiday. + +C<$title> Is the title to be modified for the holiday formed by $year/$month/$day. + +C<$description> Is the description to be modified for the holiday formed by $year/$month/$day. + +=cut + +sub ModExceptionholiday { + my $self = shift @_; + my %options = @_; + + my $dbh = $self->{context}->dbh(); + my $isexception = 1; + my $updateHoliday = $dbh->prepare("UPDATE special_holidays SET title = ?, description = ? WHERE day = ? AND month = ? AND year = ? AND branchcode = ? AND isexception = ?"); + $updateHoliday->execute($options{title},$options{description},$options{day},$options{month},$options{year},$self->{branchcode},$isexception); + $self->{'exception_holidays'}->{"$options{year}/$options{month}/$options{day}"}{title} = $options{title}; + $self->{'exception_holidays'}->{"$options{year}/$options{month}/$options{day}"}{description} = $options{description}; + return $self; +} + +=head2 delete_holiday + + delete_holiday(weekday => $weekday + day => $day, + month => $month, + year => $year); + +Delete a holiday for $self->{branchcode}. + +C<$weekday> Is the week day to delete. + +C<$day> Is the day month to make the date to delete. + +C<$month> Is month to make the date to delete. + +C<$year> Is year to make the date to delete. + +=cut + +sub delete_holiday { + my $self = shift @_; + my %options = @_; + + # Verify what kind of holiday that day is. For example, if it is + # a repeatable holiday, this should check if there are some exception + # for that holiday rule. Otherwise, if it is a regular holiday, it´s + # ok just deleting it. + + my $dbh = $self->context->dbh(); + my $isSingleHoliday = $dbh->prepare("SELECT id FROM special_holidays WHERE (branchcode = ?) AND (day = ?) AND (month = ?) AND (year = ?)"); + $isSingleHoliday->execute($self->{branchcode}, $options{day}, $options{month}, $options{year}); + if ($isSingleHoliday->rows) { + my $id = $isSingleHoliday->fetchrow; + $isSingleHoliday->finish; # Close the last query + + my $deleteHoliday = $dbh->prepare("DELETE FROM special_holidays WHERE id = ?"); + $deleteHoliday->execute($id); + delete($self->{'single_holidays'}->{"$options{year}/$options{month}/$options{day}"}); + } else { + $isSingleHoliday->finish; # Close the last query + + my $isWeekdayHoliday = $dbh->prepare("SELECT id FROM repeatable_holidays WHERE branchcode = ? AND weekday = ?"); + $isWeekdayHoliday->execute($self->{branchcode}, $options{weekday}); + if ($isWeekdayHoliday->rows) { + my $id = $isWeekdayHoliday->fetchrow; + $isWeekdayHoliday->finish; # Close the last query + + my $updateExceptions = $dbh->prepare("UPDATE special_holidays SET isexception = 0 WHERE (WEEKDAY(CONCAT(special_holidays.year,'-',special_holidays.month,'-',special_holidays.day)) = ?) AND (branchcode = ?)"); + $updateExceptions->execute($options{weekday}, $self->{branchcode}); + $updateExceptions->finish; # Close the last query + + my $deleteHoliday = $dbh->prepare("DELETE FROM repeatable_holidays WHERE id = ?"); + $deleteHoliday->execute($id); + delete($self->{'week_days_holidays'}->{$options{weekday}}); + } else { + $isWeekdayHoliday->finish; # Close the last query + + my $isDayMonthHoliday = $dbh->prepare("SELECT id FROM repeatable_holidays WHERE (branchcode = ?) AND (day = ?) AND (month = ?)"); + $isDayMonthHoliday->execute($self->{branchcode}, $options{day}, $options{month}); + if ($isDayMonthHoliday->rows) { + my $id = $isDayMonthHoliday->fetchrow; + $isDayMonthHoliday->finish; + my $updateExceptions = $dbh->prepare("UPDATE special_holidays SET isexception = 0 WHERE (special_holidays.branchcode = ?) AND (special_holidays.day = ?) and (special_holidays.month = ?)"); + $updateExceptions->execute($self->{branchcode}, $options{day}, $options{month}); + $updateExceptions->finish; # Close the last query + + my $deleteHoliday = $dbh->prepare("DELETE FROM repeatable_holidays WHERE (id = ?)"); + $deleteHoliday->execute($id); + delete($self->{'day_month_holidays'}->{"$options{month}/$options{day}"}); + } + } + } + return $self; +} + +=head2 isHoliday + + $isHoliday = isHoliday($day, $month $year); + +C<$day> Is the day to check whether if is a holiday or not. + +C<$month> Is the month to check whether if is a holiday or not. + +C<$year> Is the year to check whether if is a holiday or not. + +=cut + +sub isHoliday { + my ($self, $day, $month, $year) = @_; + # FIXME - date strings are stored in non-padded metric format. should change to iso. + # FIXME - should change arguments to accept C4::Dates object + $month=$month+0; + $year=$year+0; + $day=$day+0; + my $weekday = &Date::Calc::Day_of_Week($year, $month, $day) % 7; + my $weekDays = $self->get_week_days_holidays(); + my $dayMonths = $self->get_day_month_holidays(); + my $exceptions = $self->get_exception_holidays(); + my $singles = $self->get_single_holidays(); + if (defined($exceptions->{"$year/$month/$day"})) { + return 0; + } else { + if ((exists($weekDays->{$weekday})) || + (exists($dayMonths->{"$month/$day"})) || + (exists($singles->{"$year/$month/$day"}))) { + return 1; + } else { + return 0; + } + } + +} + +=head2 addDate + + my ($day, $month, $year, $hour, $minute, $seconds) = $calendar->addDate($date, $offset) + +C<$date> is a Koha::Dates object representing the starting date of the interval. + +C<$offset> Is the number of minutes that this function has to count from $date. + +=cut + +sub addDate { + my ($self, $startdate, $offset) = @_; + my ($date,$time) = split (" ", $startdate->output('iso')); + my ($year,$month,$day) = split("-",$date); + my ($hour,$min,$sec) = split(":",$time); + my $daystep = 1; + if ($offset < 0) { # In case $offset is negative + # $offset = $offset*(-1); + $daystep = -1; + } + my $daysMode = C4::Context->preference('useDaysMode'); + if ($daysMode eq 'Datedue') { +# Offset is minutes + ($year, $month, $day, $hour, $min, $sec) = &Date::Calc::Add_Delta_DHMS($year, $month, $day, 0,0,$offset,0 ); + while ($self->isHoliday($day, $month, $year)) { + ($year, $month, $day, $hour, $min, $sec) = &Date::Calc::Add_Delta_DHMS($year, $month, $day, $daystep, 0, 0, 0); # add 1 day + } + } elsif($daysMode eq 'Calendar') { + while ($offset != 0) { + ($year, $month, $day, $hour, $min, $sec) = &Date::Calc::Add_Delta_Days($year, $month, $day, $daystep); + if (!($self->isHoliday($day, $month, $year))) { + $offset = $offset - $daystep; + } + } + } else { ## ($daysMode eq 'Days') + ($year, $month, $day) = &Date::Calc::Add_Delta_Days($year, $month, $day, $offset ); + } + return(Koha::Dates->new( sprintf("%04d-%02d-%02d",$year,$month,$day),'iso')); +} + +=head2 daysBetween + + my $daysBetween = $calendar->daysBetween($startdate, $enddate) + +C<$startdate> and C<$enddate> are C4::Dates objects that define the interval. + +Returns the number of non-holiday days in the interval. +useDaysMode syspref has no effect here. +=cut + +sub daysBetween ($$$) { + my $self = shift or return undef; + my $startdate = shift or return undef; + my $enddate = shift or return undef; + my ($yearFrom,$monthFrom,$dayFrom) = split("-",$startdate->output('iso')); + my ($yearTo, $monthTo, $dayTo ) = split("-", $enddate->output('iso')); + if (Date_to_Days($yearFrom,$monthFrom,$dayFrom) > Date_to_Days($yearTo,$monthTo,$dayTo)) { + return 0; + # we don't go backwards ( FIXME - handle this error better ) + } + my $count = 0; + while (1) { + ($yearFrom != $yearTo or $monthFrom != $monthTo or $dayFrom != $dayTo) or last; # if they all match, it's the last day + unless ($self->isHoliday($dayFrom, $monthFrom, $yearFrom)) { + $count++; + } + ($yearFrom, $monthFrom, $dayFrom) = &Date::Calc::Add_Delta_Days($yearFrom, $monthFrom, $dayFrom, 1); + } + return($count); +} + +1; + +__END__ + +=head1 AUTHOR + +Koha Physics Library UNLP + +=cut diff --git a/Koha/Dates.pm b/Koha/Dates.pm new file mode 100644 index 0000000..f5f74d4 --- /dev/null +++ b/Koha/Dates.pm @@ -0,0 +1,367 @@ +package Koha::Dates; + +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 2 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along with +# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, +# Suite 330, Boston, MA 02111-1307 USA + +use strict; +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); + +BEGIN { + $VERSION = 0.04; + @ISA = qw(Exporter); + @EXPORT_OK = qw(format_date_in_iso format_date); +} + +use vars qw($prefformat); + +sub _prefformat { + unless ( defined $prefformat ) { + $prefformat = C4::Context->preference('dateformat'); # FIXME + } + return $prefformat; +} + +our %format_map = ( + iso => 'yyyy-mm-dd HH:MM:SS', + metric => 'dd/mm/yyyy HH:MM:SS', + us => 'mm/dd/yyyy HH:MM:SS', + sql => 'yyyymmdd HHMMSS', + rfc822 => 'a, dd b y HH:MM:SS z ', +); +our %posix_map = ( + iso => '%F %H:%M:%S', # or %F, "Full Date" + metric => '%d/%m/%Y', + us => '%m/%d/%Y', + sql => '%Y%m%d %H%M%S', + rfc822 => '%a, %d %b %Y %H:%M:%S %z', +); + +our %dmy_subs = ( # strings to eval (after using regular expression returned by regexp below) + # 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)]', + rfc822 => '[($7, $6, $5, $2, $3, $4 - 1900, $8)]', +); + +our @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); + +our @days = qw(Sun Mon Tue Wed Thu Fri Sat); + +sub regexp ($;$) { + my $self = shift; + my $delim = qr/:?\:|\/|-/; # "non memory" cluster: no backreference + 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{1,2})(\d{1,2})(?:\s{4}(\d{2})(\d{2})(\d{2}))?/; + ( $format eq 'iso' ) + and return qr/^(\d{4})$delim(\d{1,2})$delim(\d{1,2})(?:(?:\s{1}|T)(\d{2})\:?(\d{2})\:?(\d{2}))?Z?/; + ( $format eq 'rfc822' ) + 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}))/; + 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 ($$) { + my $self = shift; + my $val = shift or return undef; + my $dformat = $self->{'dateformat'} or return undef; + my $re = $self->regexp(); + my $xsub = $dmy_subs{$dformat}; + $debug and print STDERR "xsub: $xsub \n"; + if ( $val =~ /$re/ ) { + my $aref = eval $xsub; + if ($dformat eq 'rfc822') { + $aref = _abbr_to_numeric($aref, $dformat); + pop(@{$aref}); #pop off tz offset because we are not setup to handle tz conversions just yet + } + _check_date_and_time($aref); + 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 + return @{$aref}; + } + + # $debug and + carp "Illegal Date '$val' does not match '$dformat' format: " . $self->visual(); + return 0; +} + +sub _abbr_to_numeric { + my $aref = shift; + my $dformat = shift; + my ($month_abbr, $day_abbr) = ($aref->[4], $aref->[3]) if $dformat eq 'rfc822'; + + for( my $i = 0; $i < scalar(@months); $i++ ) { + if ( $months[$i] =~ /$month_abbr/ ) { + $aref->[4] = $i-1; + last; + } + }; + + for( my $i = 0; $i < scalar(@days); $i++ ) { + if ( $days[$i] =~ /$day_abbr/ ) { + $aref->[3] = $i; + last; + } + }; + return $aref; +} + +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; + my $self = {}; + bless $self, $class; + return $self->init(@_); +} + +sub init ($;$$) { + my $self = shift; + my $dformat; + $self->{'dateformat'} = $dformat = ( scalar(@_) >= 2 ) ? $_[1] : _prefformat(); + ( $format_map{$dformat} ) or croak "Invalid date format '$dformat' from " . ( ( scalar(@_) >= 2 ) ? 'argument' : 'system preferences' ); + $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) : _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(); + 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') is unrecognized."; + return $incoming; +} + +sub DHTMLcalendar ($;$) { # interface to posix_map + my $class = shift; + my $format = (@_) ? shift : _prefformat(); + return $posix_map{$format}; +} + +sub format { # get or set dateformat: iso, metric, us, etc. + my $self = shift; + (@_) or return $self->{'dateformat'}; + $self->{'dateformat'} = _recognize_format(shift); +} + +sub visual { + my $self = shift; + if (@_) { + return $format_map{ _recognize_format(shift) }; + } + $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; +__END__ + +=head1 C4::Dates.pm - a more object-oriented replacement for Date.pm. + +The core problem to address is the multiplicity of formats used by different Koha +installations around the world. We needed to move away from any hard-coded values at +the script level, for example in initial form values or checks for min/max date. The +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 + rfc822 - Standard for using with RSS feeds, etc. + +=head2 ->new([string_date,][date_format]) + +Arguments to new() are optional. If string_date is not supplied, the present system date is +used. If date_format is not supplied, the system preference from C4::Context is used. + +Examples: + + my $now = C4::Dates->new(); + my $date1 = C4::Dates->new("09-21-1989","us"); + my $date2 = C4::Dates->new("19890921 143907","sql"); + +=head2 ->output([date_format]) + +The date value is stored independent of any specific format. Therefore any format can be +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"; + 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 +date format unless otherwise instructed. + +=head2 ->format([date_format]) + +With no argument, format returns the object's current date_format. Otherwise it attempts to +set the object format to the supplied value. + +Some previously desireable functions are now unnecessary. For example, you might want a +method/function to tell you whether or not a Dates.pm object is of the 'iso' type. But you +can see by this example that such a test is trivial to accomplish, and not necessary to +include in the module: + + sub is_iso { + my $self = shift; + return ($self->format() eq "iso"); + } + +Note: A similar function would need to be included for each format. + +Instead a dependent script can retrieve the format of the object directly and decide what to +do with it from there: + + my $date = C4::Dates->new(); + my $format = $date->format(); + ($format eq "iso") or do_something($date); + +Or if you just want to print a given value and format, no problem: + + my $date = C4::Dates->new("1989-09-21", "iso"); + print $date->output; + +Alternatively: + + print C4::Dates->new("1989-09-21", "iso")->output; + +Or even: + + print C4::Dates->new("21-09-1989", "metric")->output("iso"); + +=head2 "syspref" -- System Preference(s) + +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". + +For example, to print an ISO date (from the database) in the format: + + my $date = C4::Dates->new($date_from_database,"iso"); + 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 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 + +Some error handling is provided in this module, but not all. Requesting an unknown format is a +fatal error (because it is programmer error, not user error, typically). + +Scripts must still perform validation of user input. Attempting to set an invalid value will +return 0 or undefined, so a script might check as follows: + + my $date = C4::Dates->new($input) or deal_with_it("$input didn't work"); + +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"); + +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 , we should send an error back to the user. +This kind of check should be centralized somewhere. Probably not here, though. + +=cut + -- 1.7.4.1