View | Details | Raw Unified | Return to bug 13135
Collapse All | Expand All

(-)a/C4/Reserves.pm (-3 / +63 lines)
Lines 936-948 sub CheckReserves { Link Here
936
936
937
=head2 CancelExpiredReserves
937
=head2 CancelExpiredReserves
938
938
939
  CancelExpiredReserves();
939
  CancelExpiredReserves(); #Brief
940
  my $verboseLog = CancelExpiredReserves(2); #Verbose level 2
940
941
941
Cancels all reserves with an expiration date from before today.
942
Cancels all reserves with an expiration date from before today.
942
943
944
@PARAM1 Integer, to define the verbosity level. 0 or undef to be brief.
945
                 Supported values, 0,1,2,3.
946
RETURNS String, the verbose output. Returns the output instead of printing it to
947
                make it possible to run this module from a CGI-script.
948
943
=cut
949
=cut
944
950
945
sub CancelExpiredReserves {
951
sub CancelExpiredReserves {
952
    my $verbose = shift;
953
    my @sb; #Efficiently collect verbose output here.
954
    my %usedCalendars; #Collect all used calendars here so they can be logged if verbose enough
946
955
947
    # Cancel reserves that have passed their expiration date.
956
    # Cancel reserves that have passed their expiration date.
948
    my $dbh = C4::Context->dbh;
957
    my $dbh = C4::Context->dbh;
Lines 953-962 sub CancelExpiredReserves { Link Here
953
    " );
962
    " );
954
    $sth->execute();
963
    $sth->execute();
955
964
965
    push @sb, "##Checking reserve expirationdates\n".
966
          "reserve_id|borrowernumber|expirationdate|\n" if $verbose;
967
956
    while ( my $res = $sth->fetchrow_hashref() ) {
968
    while ( my $res = $sth->fetchrow_hashref() ) {
957
        CancelReserve({ reserve_id => $res->{'reserve_id'} });
969
        CancelReserve({ reserve_id => $res->{'reserve_id'} });
970
        push @sb, printReserve($res,'tab',['reserve_id','borrowernumber','expirationdate'])." expired.\n" if $verbose;
958
    }
971
    }
959
  
972
960
    # Cancel reserves that have been waiting too long
973
    # Cancel reserves that have been waiting too long
961
    if ( C4::Context->preference("ExpireReservesMaxPickUpDelay") ) {
974
    if ( C4::Context->preference("ExpireReservesMaxPickUpDelay") ) {
962
        my $max_pickup_delay = C4::Context->preference("ReservesMaxPickUpDelay");
975
        my $max_pickup_delay = C4::Context->preference("ReservesMaxPickUpDelay");
Lines 968-973 sub CancelExpiredReserves { Link Here
968
981
969
        my $today = DateTime->now( time_zone => C4::Context->tz() );
982
        my $today = DateTime->now( time_zone => C4::Context->tz() );
970
983
984
        push @sb, "##Removing holds waiting too long\n##using today=$today, ReservesMaxPickUpDelay=$max_pickup_delay, ExpireReservesMaxPickUpDelayCharge=$charge\n".
985
              "reserve_id|borrowernumber|branchcode|waitingdate|lastpickupdate|resolution\n" if $verbose;
986
971
        while (my $res = $sth->fetchrow_hashref ) {
987
        while (my $res = $sth->fetchrow_hashref ) {
972
            my $expiration = _reserve_last_pickup_date( $res );
988
            my $expiration = _reserve_last_pickup_date( $res );
973
            if ( $today > $expiration ) {
989
            if ( $today > $expiration ) {
Lines 975-984 sub CancelExpiredReserves { Link Here
975
                    manualinvoice($res->{'borrowernumber'}, $res->{'itemnumber'}, 'Hold waiting too long', 'F', $charge);
991
                    manualinvoice($res->{'borrowernumber'}, $res->{'itemnumber'}, 'Hold waiting too long', 'F', $charge);
976
                }
992
                }
977
                CancelReserve({ reserve_id => $res->{'reserve_id'} });
993
                CancelReserve({ reserve_id => $res->{'reserve_id'} });
994
                push @sb, printReserve($res,'tab',['reserve_id','borrowernumber','branchcode','waitingdate']).sprintf("% 14s",substr($expiration,0,10))."| past lastpickupdate.\n" if $verbose;
995
            }
996
            elsif($verbose > 1) {
997
                push @sb, printReserve($res,'tab',['reserve_id','borrowernumber','branchcode','waitingdate']).sprintf("% 14s",substr($expiration,0,10))."| still waiting.\n" if $verbose > 1;
978
            }
998
            }
999
            $usedCalendars{  $res->{branchcode}  } = Koha::Calendar->new( branchcode => $res->{branchcode} ) if (  $verbose > 2 && not(exists($usedCalendars{$res->{branchcode}}))  );
979
        }
1000
        }
980
    }
981
1001
1002
        #Log the used calendars.
1003
        if ($verbose > 2) {
1004
            push @sb, "##Dumping used Calendars\n";
1005
            foreach my $branchcode (sort keys %usedCalendars) {
1006
                my $calendar = $usedCalendars{$branchcode};
1007
                push @sb, "<<  $branchcode >>\n";
1008
                push @sb, $calendar->printMe()."\n";
1009
            }
1010
        }
1011
        
1012
    }
1013
    return join('',@sb) if $verbose;
982
}
1014
}
983
1015
984
=head2 AutoUnsuspendReserves
1016
=head2 AutoUnsuspendReserves
Lines 2346-2351 sub CalculatePriority { Link Here
2346
    return @row ? $row[0]+1 : 1;
2378
    return @row ? $row[0]+1 : 1;
2347
}
2379
}
2348
2380
2381
=head printReserve
2382
2383
    my $text = C4::Reserves::printReserve( $reserve, 'tab', ['reserve_id','borrowernumber','waitingdate', ...] );
2384
    assert($text, "         1|       1017466| 2014-11-06| ...");
2385
2386
Gets a textual representation of a koha.reserves -row.
2387
2388
@PARAM1 koha.reserves-row
2389
@PARAM2 String, type of formatting, currently supported are 'tab' to print tabular output.
2390
        Defaults the column width to the key length.
2391
@PARAM3 Array of columns, the desired reserves-columns to output in the given order.
2392
RETURNS String, depending on the type of formatting.
2393
2394
=cut
2395
2396
sub printReserve {
2397
    my ($reserve, $format, $keys) = @_;
2398
    my @sb;
2399
2400
    if ($format eq 'tab') {
2401
        foreach my $key (@$keys) {
2402
            my $l = length $key;
2403
            push @sb, sprintf('% '.$l.'s', $reserve->{$key}).'|';
2404
        }
2405
        return join('',@sb);
2406
    }
2407
}
2408
2349
=head1 AUTHOR
2409
=head1 AUTHOR
2350
2410
2351
Koha Development Team <http://koha-community.org/>
2411
Koha Development Team <http://koha-community.org/>
(-)a/Koha/Calendar.pm (+34 lines)
Lines 363-368 sub add_holiday { Link Here
363
    return;
363
    return;
364
}
364
}
365
365
366
sub printMe {
367
    my $self = shift;
368
    my @sb; #String buffer to collect self output.
369
    
370
    my $exception_holidays = $self->exception_holidays();
371
    my $single_holidays = $self->single_holidays();
372
    my $weekly_closed_days = $self->{weekly_closed_days};
373
    my $month_day_closed_days = $self->{day_month_closed_days}; #Get the annually recurring holidays.
374
    
375
    push @sb, "< Weekly days => ";
376
    for (my $i=0 ; $i<@$weekly_closed_days ; $i++) {
377
        push @sb, "$i," if $weekly_closed_days->[$i] > 0;
378
    }
379
    push @sb, "\n";
380
    push @sb, "< Recurring month->days => ";
381
    foreach my $month (sort {$a <=> $b} keys %$month_day_closed_days) {
382
        push @sb, "$month->";
383
        push @sb, join(',', (sort {$a <=> $b} keys %{ $month_day_closed_days->{$month} })  );
384
        push @sb, ' & ';
385
    }
386
    push @sb, "\n";
387
    push @sb, "< Single days => ";
388
    my @single_holidays = sort {$a->ymd() cmp $b->ymd()} $single_holidays->as_list();
389
    foreach my $dt (@single_holidays) {
390
        push @sb, $dt->ymd().',';
391
    }
392
    push @sb, "\n";
393
    return join('', @sb);
394
}
395
366
1;
396
1;
367
__END__
397
__END__
368
398
Lines 486-491 Passed a datetime object this will add it to the calendar's list of Link Here
486
closed days. This is for testing so that we can alter the Calenfar object's
516
closed days. This is for testing so that we can alter the Calenfar object's
487
list of specified dates
517
list of specified dates
488
518
519
=head2 printMe
520
521
Prints a textual representation of the Calendar object, useful for logging.
522
489
=head1 DIAGNOSTICS
523
=head1 DIAGNOSTICS
490
524
491
Will croak if not passed a branchcode in new
525
Will croak if not passed a branchcode in new
(-)a/misc/cronjobs/holds/cancel_expired_holds.pl (-6 / +23 lines)
Lines 17-24 Link Here
17
# with Koha; if not, write to the Free Software Foundation, Inc.,
17
# with Koha; if not, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
19
20
#use strict;
20
use Modern::Perl;
21
#use warnings; FIXME - Bug 2505
21
22
use Getopt::Long;
23
use C4::Reserves qw(CancelExpiredReserves);
22
24
23
BEGIN {
25
BEGIN {
24
    # find Koha's Perl modules
26
    # find Koha's Perl modules
Lines 27-34 BEGIN { Link Here
27
    eval { require "$FindBin::Bin/../kohalib.pl" };
29
    eval { require "$FindBin::Bin/../kohalib.pl" };
28
}
30
}
29
31
30
# cancel all expired hold requests
32
# These are defaults for command line options.
33
my $verbose = 0;
34
my $help    = 0;
35
36
37
GetOptions(
38
    'h|help|?'                     => \$help,
39
    'v|verbose:i'                    => \$verbose,
40
);
31
41
32
use C4::Reserves;
42
if ($help) {
43
    die <<HEAD;
44
This scripts cancels all expired hold requests and all holds that have expired
45
their last pickup date.
46
47
    -v --verbose <level>    Prints more verbose information.
48
                            Supported levels, 0,1,2,3
49
HEAD
50
}
33
51
34
CancelExpiredReserves();
52
print CancelExpiredReserves($verbose);
35
- 

Return to bug 13135