@@ -, +, @@ logging improvements to catch evasive bugs in production. Catch some of those to a borrower. In the DB, set the waitingdate 2 days to the past for some of them, 4 days to the past for a portion, 6 days to past for some and 8 days past for the rest. Observe log entries of all the handled reservations and of all the used Calendars (not all Calendars, simply those that were needed). --- C4/Reserves.pm | 66 +++++++++++++++++++++++++-- Koha/Calendar.pm | 34 ++++++++++++++ misc/cronjobs/holds/cancel_expired_holds.pl | 28 ++++++++++-- 3 files changed, 120 insertions(+), 8 deletions(-) --- a/C4/Reserves.pm +++ a/C4/Reserves.pm @@ -936,13 +936,22 @@ sub CheckReserves { =head2 CancelExpiredReserves - CancelExpiredReserves(); + CancelExpiredReserves(); #Brief + my $verboseLog = CancelExpiredReserves(2); #Verbose level 2 Cancels all reserves with an expiration date from before today. +@PARAM1 Integer, to define the verbosity level. 0 or undef to be brief. + Supported values, 0,1,2,3. +RETURNS String, the verbose output. Returns the output instead of printing it to + make it possible to run this module from a CGI-script. + =cut sub CancelExpiredReserves { + my $verbose = shift; + my @sb; #Efficiently collect verbose output here. + my %usedCalendars; #Collect all used calendars here so they can be logged if verbose enough # Cancel reserves that have passed their expiration date. my $dbh = C4::Context->dbh; @@ -953,10 +962,14 @@ sub CancelExpiredReserves { " ); $sth->execute(); + push @sb, "##Checking reserve expirationdates\n". + "reserve_id|borrowernumber|expirationdate|\n" if $verbose; + while ( my $res = $sth->fetchrow_hashref() ) { CancelReserve({ reserve_id => $res->{'reserve_id'} }); + push @sb, printReserve($res,'tab',['reserve_id','borrowernumber','expirationdate'])." expired.\n" if $verbose; } - + # Cancel reserves that have been waiting too long if ( C4::Context->preference("ExpireReservesMaxPickUpDelay") ) { my $max_pickup_delay = C4::Context->preference("ReservesMaxPickUpDelay"); @@ -968,6 +981,9 @@ sub CancelExpiredReserves { my $today = DateTime->now( time_zone => C4::Context->tz() ); + push @sb, "##Removing holds waiting too long\n##using today=$today, ReservesMaxPickUpDelay=$max_pickup_delay, ExpireReservesMaxPickUpDelayCharge=$charge\n". + "reserve_id|borrowernumber|branchcode|waitingdate|lastpickupdate|resolution\n" if $verbose; + while (my $res = $sth->fetchrow_hashref ) { my $expiration = _reserve_last_pickup_date( $res ); if ( $today > $expiration ) { @@ -975,10 +991,26 @@ sub CancelExpiredReserves { manualinvoice($res->{'borrowernumber'}, $res->{'itemnumber'}, 'Hold waiting too long', 'F', $charge); } CancelReserve({ reserve_id => $res->{'reserve_id'} }); + push @sb, printReserve($res,'tab',['reserve_id','borrowernumber','branchcode','waitingdate']).sprintf("% 14s",substr($expiration,0,10))."| past lastpickupdate.\n" if $verbose; + } + elsif($verbose > 1) { + push @sb, printReserve($res,'tab',['reserve_id','borrowernumber','branchcode','waitingdate']).sprintf("% 14s",substr($expiration,0,10))."| still waiting.\n" if $verbose > 1; } + $usedCalendars{ $res->{branchcode} } = Koha::Calendar->new( branchcode => $res->{branchcode} ) if ( $verbose > 2 && not(exists($usedCalendars{$res->{branchcode}})) ); } - } + #Log the used calendars. + if ($verbose > 2) { + push @sb, "##Dumping used Calendars\n"; + foreach my $branchcode (sort keys %usedCalendars) { + my $calendar = $usedCalendars{$branchcode}; + push @sb, "<< $branchcode >>\n"; + push @sb, $calendar->printMe()."\n"; + } + } + + } + return join('',@sb) if $verbose; } =head2 AutoUnsuspendReserves @@ -2346,6 +2378,34 @@ sub CalculatePriority { return @row ? $row[0]+1 : 1; } +=head printReserve + + my $text = C4::Reserves::printReserve( $reserve, 'tab', ['reserve_id','borrowernumber','waitingdate', ...] ); + assert($text, " 1| 1017466| 2014-11-06| ..."); + +Gets a textual representation of a koha.reserves -row. + +@PARAM1 koha.reserves-row +@PARAM2 String, type of formatting, currently supported are 'tab' to print tabular output. + Defaults the column width to the key length. +@PARAM3 Array of columns, the desired reserves-columns to output in the given order. +RETURNS String, depending on the type of formatting. + +=cut + +sub printReserve { + my ($reserve, $format, $keys) = @_; + my @sb; + + if ($format eq 'tab') { + foreach my $key (@$keys) { + my $l = length $key; + push @sb, sprintf('% '.$l.'s', $reserve->{$key}).'|'; + } + return join('',@sb); + } +} + =head1 AUTHOR Koha Development Team --- a/Koha/Calendar.pm +++ a/Koha/Calendar.pm @@ -363,6 +363,36 @@ sub add_holiday { return; } +sub printMe { + my $self = shift; + my @sb; #String buffer to collect self output. + + my $exception_holidays = $self->exception_holidays(); + my $single_holidays = $self->single_holidays(); + my $weekly_closed_days = $self->{weekly_closed_days}; + my $month_day_closed_days = $self->{day_month_closed_days}; #Get the annually recurring holidays. + + push @sb, "< Weekly days => "; + for (my $i=0 ; $i<@$weekly_closed_days ; $i++) { + push @sb, "$i," if $weekly_closed_days->[$i] > 0; + } + push @sb, "\n"; + push @sb, "< Recurring month->days => "; + foreach my $month (sort {$a <=> $b} keys %$month_day_closed_days) { + push @sb, "$month->"; + push @sb, join(',', (sort {$a <=> $b} keys %{ $month_day_closed_days->{$month} }) ); + push @sb, ' & '; + } + push @sb, "\n"; + push @sb, "< Single days => "; + my @single_holidays = sort {$a->ymd() cmp $b->ymd()} $single_holidays->as_list(); + foreach my $dt (@single_holidays) { + push @sb, $dt->ymd().','; + } + push @sb, "\n"; + return join('', @sb); +} + 1; __END__ @@ -486,6 +516,10 @@ Passed a datetime object this will add it to the calendar's list of closed days. This is for testing so that we can alter the Calenfar object's list of specified dates +=head2 printMe + +Prints a textual representation of the Calendar object, useful for logging. + =head1 DIAGNOSTICS Will croak if not passed a branchcode in new --- a/misc/cronjobs/holds/cancel_expired_holds.pl +++ a/misc/cronjobs/holds/cancel_expired_holds.pl @@ -17,8 +17,10 @@ # with Koha; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. -#use strict; -#use warnings; FIXME - Bug 2505 +use Modern::Perl; + +use Getopt::Long; +use C4::Reserves qw(CancelExpiredReserves); BEGIN { # find Koha's Perl modules @@ -27,8 +29,24 @@ BEGIN { eval { require "$FindBin::Bin/../kohalib.pl" }; } -# cancel all expired hold requests +# These are defaults for command line options. +my $verbose = 0; +my $help = 0; + + +GetOptions( + 'h|help|?' => \$help, + 'v|verbose:i' => \$verbose, +); -use C4::Reserves; +if ($help) { + die < Prints more verbose information. + Supported levels, 0,1,2,3 +HEAD +} -CancelExpiredReserves(); +print CancelExpiredReserves($verbose); --