Koha/misc/cronjobs/longoverdue.pl

#!/usr/bin/perl
#-----------------------------------
# Copyright 2008 LibLime
#
# 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 3 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, see <http://www.gnu.org/licenses>.
#-----------------------------------

=head1 NAME

longoverdue.pl  cron script to set lost statuses on overdue materials.
                Execute without options for help.

=cut

use strict;
use warnings;
BEGIN {
    # find Koha's Perl modules
    # test carefully before changing this
    use FindBin ();
    eval { require "$FindBin::Bin/../kohalib.pl" };
}

use Getopt::Long qw( GetOptions );
use Pod::Usage qw( pod2usage );

use C4::Circulation qw( LostItem MarkIssueReturned );
use C4::Context;
use C4::Log qw( cronlogaction );
use Koha::ItemTypes;
use Koha::Patron::Categories;
use Koha::Patrons;
use Koha::Script -cron;

my  $lost;  #  key=lost value,  value=num days.
my ($charge, $verbose, $confirm, $quiet);
my $endrange = 366;
my $mark_returned;
my $borrower_category = [];
my $skip_borrower_category = [];
my $itemtype = [];
my $skip_itemtype = [];
my $help=0;
my $man=0;
my $list_categories = 0;
my $list_itemtypes = 0;
my @skip_lost_values;

GetOptions(
    'l|lost=s%'         => \$lost,
    'c|charge=s'        => \$charge,
    'confirm'           => \$confirm,
    'v|verbose'         => \$verbose,
    'quiet'             => \$quiet,
    'maxdays=s'         => \$endrange,
    'mark-returned'     => \$mark_returned,
    'h|help'            => \$help,
    'man|manual'        => \$man,
    'category=s'        => $borrower_category,
    'skip-category=s'   => $skip_borrower_category,
    'list-categories'   => \$list_categories,
    'itemtype=s'        => $itemtype,
    'skip-itemtype=s'   => $skip_itemtype,
    'list-itemtypes'    => \$list_itemtypes,
    'skip-lost-value=s' => \@skip_lost_values,
);

if ( $man ) {
    pod2usage( -verbose => 2
               -exitval => 0
            );
}

if ( $help ) {
    pod2usage( -verbose => 1,
               -exitval => 0
            );
}

if ( scalar @$borrower_category && scalar @$skip_borrower_category) {
    pod2usage( -verbose => 1,
               -message => "The options --category and --skip-category are mutually exclusive.\n"
                           . "Use one or the other.",
               -exitval => 1
            );
}

if ( scalar @$itemtype && scalar @$skip_itemtype) {
    pod2usage( -verbose => 1,
               -message => "The options --itemtype and --skip-itemtype are mutually exclusive.\n"
                           . "Use one or the other.",
               -exitval => 1
            );
}

if ( $list_categories ) {

    my @categories = Koha::Patron::Categories->search()->get_column('categorycode');
    print "\nBorrower Categories: " . join( " ", @categories ) . "\n\n";
    exit 0;
}

if ( $list_itemtypes ) {
    my @itemtypes = Koha::ItemTypes->search()->get_column('itemtype');
    print "\nItemtypes: " . join( " ", @itemtypes ) . "\n\n";
    exit 0;
}

=head1 SYNOPSIS

   longoverdue.pl [ --help | -h | --man | --list-categories ]
   longoverdue.pl --lost | -l DAYS=LOST_CODE [ --charge | -c CHARGE_CODE ] [ --verbose | -v ] [ --quiet ]
                  [ --maxdays MAX_DAYS ] [ --mark-returned ] [ --category BORROWER_CATEGORY ] ...
                  [ --skip-category BORROWER_CATEGORY ] ...
                  [ --skip-lost-value LOST_VALUE [ --skip-lost-value LOST_VALUE ] ]
                  [ --commit ]


WARNING:  Flippant use of this script could set all or most of the items in your catalog to Lost and charge your
          patrons for them!

WARNING:  This script is known to be faulty.  It is NOT recommended to use multiple --lost options.
          See http://bugs.koha-community.org/bugzilla3/show_bug.cgi?id=2883

=cut

=head1 OPTIONS

This script takes the following parameters :

=over 8

=item B<--lost | -l>

This option takes the form of n=lv, where n is num days overdue, and lv is the lost value.  See warning above.

=item B<--charge | -c>

This specifies what lost value triggers Koha to charge the account for the lost item.  Replacement costs are not charged if this is not specified.

=item B<--verbose | -v>

verbose.

=item B<--confirm>

confirm.  without this option, the script will report the number of affected items and return without modifying any records.

=item B<--quiet>

suppress summary output.

=item B<--maxdays>

Specifies the end of the range of overdue days to deal with (defaults to 366).  This value is universal to all lost num days overdue passed.

=item B<--mark-returned>

When an item is marked lost, remove it from the borrowers issued items.
If not provided, the value of the system preference 'MarkLostItemsAsReturned' will be used.

=item B<--category>

Act on the listed borrower category code (borrowers.categorycode).
Exclude all others. This may be specified multiple times to include multiple categories.
May not be used with B<--skip-category>

=item B<--skip-category>

Act on all available borrower category codes, except those listed.
This may be specified multiple times, to exclude multiple categories.
May not be used with B<--category>

=item B<--list-categories>

List borrower categories available for use by B<--category> or
B<--skip-category>, and exit.

=item B<--itemtype>

Act on the listed itemtype code.
Exclude all others. This may be specified multiple times to include multiple itemtypes.
May not be used with B<--skip-itemtype>

=item B<--skip-itemtype>

Act on all available itemtype codes, except those listed.
This may be specified multiple times, to exclude multiple itemtypes.
May not be used with B<--itemtype>

=item B<--skip-lost-value>

Act on all available lost values, except those listed.
This may be specified multiple times, to exclude multiple lost values.

=item B<--list-itemtypes>

List itemtypes available for use by B<--itemtype> or
B<--skip-itemtype>, and exit.

=item B<--help | -h>

Display short help message an exit.

=item B<--man | --manual >

Display entire manual and exit.

=back

=cut

=head1 Description

This cron script set lost values on overdue items and optionally sets charges the patron's account
for the item's replacement price.  It is designed to be run as a nightly job.  The command line options that globally
define this behavior for this script  will likely be moved into Koha's core circulation / issuing rules code in a
near-term release, so this script is not intended to have a long lifetime.


=cut

=head1 Examples

  $PERL5LIB/misc/cronjobs/longoverdue.pl --lost 30=1
    Would set LOST=1 after 30 days (up to one year), but not charge the account.
    This would be suitable for the Koha default LOST authorized value of 1 -> 'Lost'.

  $PERL5LIB/misc/cronjobs/longoverdue.pl --lost 60=2 --charge 2
    Would set LOST=2 after 60 days (up to one year), and charge the account when setting LOST=2.
    This would be suitable for the Koha default LOST authorized value of 2 -> 'Long Overdue'

=cut

# FIXME: We need three pieces of data to operate:
#         ~ lower bound (number of days),
#         ~ upper bound (number of days),
#         ~ new lost value.
#        Right now we get only two, causing the endrange hack.  This is a design-level failure.
# FIXME: do checks on --lost ranges to make sure they are exclusive.
# FIXME: do checks on --lost ranges to make sure the authorized values exist.
# FIXME: do checks on --lost ranges to make sure don't go past endrange.
#

unless ( scalar @skip_lost_values ) {
    my $preference = C4::Context->preference( 'DefaultLongOverdueSkipLostStatuses' );
    @skip_lost_values = split( ',', $preference );
}

if ( ! defined($lost) ) {
    my $longoverdue_value = C4::Context->preference('DefaultLongOverdueLostValue');
    my $longoverdue_days = C4::Context->preference('DefaultLongOverdueDays');
    if(defined($longoverdue_value) and defined($longoverdue_days) and $longoverdue_value ne '' and $longoverdue_days ne '' and $longoverdue_days >= 0) {
        $lost->{$longoverdue_days} = $longoverdue_value;
    }
    else {
        pod2usage( {
                -exitval => 1,
                -msg => q|ERROR: No --lost (-l) option or system preferences DefaultLongOverdueLostValue/DefaultLongOverdueDays defined|,
        } );
    }
}
if ( ! defined($charge) ) {
    my $charge_value = C4::Context->preference('DefaultLongOverdueChargeValue');
    if(defined($charge_value) and $charge_value ne '') {
        $charge = $charge_value;
    }
}
unless ($confirm) {
    $verbose = 1;     # If you're not running it for real, then the whole point is the print output.
    print "### TEST MODE -- NO ACTIONS TAKEN ###\n";
}

cronlogaction();

# In my opinion, this line is safe SQL to have outside the API. --atz
our $bounds_sth = C4::Context->dbh->prepare("SELECT DATE_SUB(CURDATE(), INTERVAL ? DAY)");

sub bounds {
    $bounds_sth->execute(shift);
    return $bounds_sth->fetchrow;
}

# FIXME - This sql should be inside the API.
sub longoverdue_sth {
    my ( $params ) = @_;
    my $skip_lost_values = $params->{skip_lost_values};

    my $skip_lost_values_sql = q{};
    if ( @$skip_lost_values ) {
        my $values = join( ',', map { qq{'$_'} } @$skip_lost_values );
        $skip_lost_values_sql = "AND itemlost NOT IN ( $values )"
    }

    my $query = "
    SELECT items.itemnumber, borrowernumber, date_due, itemlost
      FROM issues, items
     WHERE items.itemnumber = issues.itemnumber
      AND  DATE_SUB(CURDATE(), INTERVAL ? DAY)  > date_due
      AND  DATE_SUB(CURDATE(), INTERVAL ? DAY) <= date_due
      AND  itemlost <> ?
      $skip_lost_values_sql
     ORDER BY date_due
    ";
    return C4::Context->dbh->prepare($query);
}

my $dbh = C4::Context->dbh;

my @available_categories = Koha::Patron::Categories->search()->get_column('categorycode');
$borrower_category = [ map { uc $_ } @$borrower_category ];
$skip_borrower_category = [ map { uc $_} @$skip_borrower_category ];
my %category_to_process;
for my $cat ( @$borrower_category ) {
    unless ( grep { $_ eq $cat } @available_categories ) {
        pod2usage(
            '-exitval' => 1,
            '-message' => "The category $cat does not exist in the database",
        );
    }
    $category_to_process{$cat} = 1;
}
if ( @$skip_borrower_category ) {
    for my $cat ( @$skip_borrower_category ) {
        unless ( grep { $_ eq $cat } @available_categories ) {
            pod2usage(
                '-exitval' => 1,
                '-message' => "The category $cat does not exist in the database",
            );
        }
    }
    %category_to_process = map { $_ => 1 } @available_categories;
    %category_to_process = ( %category_to_process, map { $_ => 0 } @$skip_borrower_category );
}

my $filter_borrower_categories = ( scalar @$borrower_category || scalar @$skip_borrower_category );

my @available_itemtypes = Koha::ItemTypes->search()->get_column('itemtype');
$itemtype = [ map { uc $_ } @$itemtype ];
$skip_itemtype = [ map { uc $_} @$skip_itemtype ];
my %itemtype_to_process;
for my $it ( @$itemtype ) {
    unless ( grep { $_ eq $it } @available_itemtypes ) {
        pod2usage(
            '-exitval' => 1,
            '-message' => "The itemtype $it does not exist in the database",
        );
    }
    $itemtype_to_process{$it} = 1;
}
if ( @$skip_itemtype ) {
    for my $it ( @$skip_itemtype ) {
        unless ( grep { $_ eq $it } @available_itemtypes ) {
            pod2usage(
                '-exitval' => 1,
                '-message' => "The itemtype $it does not exist in the database",
            );
        }
    }
    %itemtype_to_process = map { $_ => 1 } @available_itemtypes;
    %itemtype_to_process = ( %itemtype_to_process, map { $_ => 0 } @$skip_itemtype );
}

my $filter_itemtypes = ( scalar @$itemtype || scalar @$skip_itemtype );

my $count;
my @report;
my $total = 0;
my $i = 0;

# FIXME - The item is only marked returned if you supply --charge .
#         We need a better way to handle this.
#
my $sth_items = longoverdue_sth({ skip_lost_values => \@skip_lost_values });

foreach my $startrange (sort keys %$lost) {
    if( my $lostvalue = $lost->{$startrange} ) {
        my ($date1) = bounds($startrange);
        my ($date2) = bounds(  $endrange);
        # print "\nRange ", ++$i, "\nDue $startrange - $endrange days ago ($date2 to $date1), lost => $lostvalue\n" if($verbose);
        $verbose and
            printf "\nRange %s\nDue %3s - %3s days ago (%s to %s), lost => %s\n", ++$i,
            $startrange, $endrange, $date2, $date1, $lostvalue;
        $sth_items->execute($startrange, $endrange, $lostvalue);
        $count=0;
        ITEM: while (my $row=$sth_items->fetchrow_hashref) {
            if( $filter_borrower_categories ) {
                my $category = uc Koha::Patrons->find( $row->{borrowernumber} )->categorycode();
                next ITEM unless ( $category_to_process{ $category } );
            }
            if ($filter_itemtypes) {
                my $it = uc Koha::Items->find( $row->{itemnumber} )->effective_itemtype();
                next ITEM unless ( $itemtype_to_process{$it} );
            }
            printf ("Due %s: item %5s from borrower %5s to lost: %s\n", $row->{date_due}, $row->{itemnumber}, $row->{borrowernumber}, $lostvalue) if($verbose);
            if($confirm) {
                Koha::Items->find( $row->{itemnumber} )->itemlost($lostvalue)
                  ->store;
                if ( $charge && $charge eq $lostvalue ) {
                    LostItem( $row->{'itemnumber'}, 'cronjob', $mark_returned );
                } elsif ( $mark_returned ) {
                    my $patron = Koha::Patrons->find( $row->{borrowernumber} );
                    MarkIssueReturned($row->{borrowernumber},$row->{itemnumber},undef,$patron->privacy)
                }
            }
            $count++;
        }
        push @report, {
           startrange => $startrange,
             endrange => $endrange,
                range => "$startrange - $endrange",
                date1 => $date1,
                date2 => $date2,
            lostvalue => $lostvalue,
                count => $count,
        };
        $total += $count;
    }
    $endrange = $startrange;
}

sub summarize {
    my $arg = shift;    # ref to array
    my $got_items = shift || 0;     # print "count" line for items
    my @report = @$arg or return;
    my $i = 0;
    for my $range (@report) {
        printf "\nRange %s\nDue %3s - %3s days ago (%s to %s), lost => %s\n", ++$i,
            map {$range->{$_}} qw(startrange endrange date2 date1 lostvalue);
        $got_items and printf "  %4s items\n", $range->{count};
    }
}

if (!$quiet){
    print "\n### LONGOVERDUE SUMMARY ###";
    summarize (\@report, 1);
    print "\nTOTAL: $total items\n";
}