2 #-----------------------------------
3 # Copyright 2008 LibLime
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
19 #-----------------------------------
23 longoverdue.pl cron script to set lost statuses on overdue materials.
24 Execute without options for help.
31 # find Koha's Perl modules
32 # test carefully before changing this
34 eval { require "$FindBin::Bin/../kohalib.pl" };
37 use Getopt::Long qw( GetOptions );
38 use Pod::Usage qw( pod2usage );
40 use C4::Circulation qw( LostItem MarkIssueReturned );
42 use C4::Log qw( cronlogaction );
44 use Koha::Patron::Categories;
46 use Koha::Script -cron;
48 my $lost; # key=lost value, value=num days.
49 my ($charge, $verbose, $confirm, $quiet);
52 my $borrower_category = [];
53 my $skip_borrower_category = [];
55 my $skip_itemtype = [];
58 my $list_categories = 0;
59 my $list_itemtypes = 0;
63 'l|lost=s%' => \$lost,
64 'c|charge=s' => \$charge,
65 'confirm' => \$confirm,
66 'v|verbose' => \$verbose,
68 'maxdays=s' => \$endrange,
69 'mark-returned' => \$mark_returned,
71 'man|manual' => \$man,
72 'category=s' => $borrower_category,
73 'skip-category=s' => $skip_borrower_category,
74 'list-categories' => \$list_categories,
75 'itemtype=s' => $itemtype,
76 'skip-itemtype=s' => $skip_itemtype,
77 'list-itemtypes' => \$list_itemtypes,
78 'skip-lost-value=s' => \@skip_lost_values,
82 pod2usage( -verbose => 2
88 pod2usage( -verbose => 1,
93 if ( scalar @$borrower_category && scalar @$skip_borrower_category) {
94 pod2usage( -verbose => 1,
95 -message => "The options --category and --skip-category are mutually exclusive.\n"
96 . "Use one or the other.",
101 if ( scalar @$itemtype && scalar @$skip_itemtype) {
102 pod2usage( -verbose => 1,
103 -message => "The options --itemtype and --skip-itemtype are mutually exclusive.\n"
104 . "Use one or the other.",
109 if ( $list_categories ) {
111 my @categories = Koha::Patron::Categories->search()->get_column('categorycode');
112 print "\nBorrower Categories: " . join( " ", @categories ) . "\n\n";
116 if ( $list_itemtypes ) {
117 my @itemtypes = Koha::ItemTypes->search()->get_column('itemtype');
118 print "\nItemtypes: " . join( " ", @itemtypes ) . "\n\n";
124 longoverdue.pl [ --help | -h | --man | --list-categories ]
125 longoverdue.pl --lost | -l DAYS=LOST_CODE [ --charge | -c CHARGE_CODE ] [ --verbose | -v ] [ --quiet ]
126 [ --maxdays MAX_DAYS ] [ --mark-returned ] [ --category BORROWER_CATEGORY ] ...
127 [ --skip-category BORROWER_CATEGORY ] ...
128 [ --skip-lost-value LOST_VALUE [ --skip-lost-value LOST_VALUE ] ]
132 WARNING: Flippant use of this script could set all or most of the items in your catalog to Lost and charge your
135 WARNING: This script is known to be faulty. It is NOT recommended to use multiple --lost options.
136 See http://bugs.koha-community.org/bugzilla3/show_bug.cgi?id=2883
142 This script takes the following parameters :
148 This option takes the form of n=lv, where n is num days overdue, and lv is the lost value. See warning above.
150 =item B<--charge | -c>
152 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.
154 =item B<--verbose | -v>
160 confirm. without this option, the script will report the number of affected items and return without modifying any records.
164 suppress summary output.
168 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.
170 =item B<--mark-returned>
172 When an item is marked lost, remove it from the borrowers issued items.
173 If not provided, the value of the system preference 'MarkLostItemsAsReturned' will be used.
177 Act on the listed borrower category code (borrowers.categorycode).
178 Exclude all others. This may be specified multiple times to include multiple categories.
179 May not be used with B<--skip-category>
181 =item B<--skip-category>
183 Act on all available borrower category codes, except those listed.
184 This may be specified multiple times, to exclude multiple categories.
185 May not be used with B<--category>
187 =item B<--list-categories>
189 List borrower categories available for use by B<--category> or
190 B<--skip-category>, and exit.
194 Act on the listed itemtype code.
195 Exclude all others. This may be specified multiple times to include multiple itemtypes.
196 May not be used with B<--skip-itemtype>
198 =item B<--skip-itemtype>
200 Act on all available itemtype codes, except those listed.
201 This may be specified multiple times, to exclude multiple itemtypes.
202 May not be used with B<--itemtype>
204 =item B<--skip-lost-value>
206 Act on all available lost values, except those listed.
207 This may be specified multiple times, to exclude multiple lost values.
209 =item B<--list-itemtypes>
211 List itemtypes available for use by B<--itemtype> or
212 B<--skip-itemtype>, and exit.
216 Display short help message an exit.
218 =item B<--man | --manual >
220 Display entire manual and exit.
228 This cron script set lost values on overdue items and optionally sets charges the patron's account
229 for the item's replacement price. It is designed to be run as a nightly job. The command line options that globally
230 define this behavior for this script will likely be moved into Koha's core circulation / issuing rules code in a
231 near-term release, so this script is not intended to have a long lifetime.
238 $PERL5LIB/misc/cronjobs/longoverdue.pl --lost 30=1
239 Would set LOST=1 after 30 days (up to one year), but not charge the account.
240 This would be suitable for the Koha default LOST authorized value of 1 -> 'Lost'.
242 $PERL5LIB/misc/cronjobs/longoverdue.pl --lost 60=2 --charge 2
243 Would set LOST=2 after 60 days (up to one year), and charge the account when setting LOST=2.
244 This would be suitable for the Koha default LOST authorized value of 2 -> 'Long Overdue'
248 # FIXME: We need three pieces of data to operate:
249 # ~ lower bound (number of days),
250 # ~ upper bound (number of days),
252 # Right now we get only two, causing the endrange hack. This is a design-level failure.
253 # FIXME: do checks on --lost ranges to make sure they are exclusive.
254 # FIXME: do checks on --lost ranges to make sure the authorized values exist.
255 # FIXME: do checks on --lost ranges to make sure don't go past endrange.
258 unless ( scalar @skip_lost_values ) {
259 my $preference = C4::Context->preference( 'DefaultLongOverdueSkipLostStatuses' );
260 @skip_lost_values = split( ',', $preference );
263 if ( ! defined($lost) ) {
264 my $longoverdue_value = C4::Context->preference('DefaultLongOverdueLostValue');
265 my $longoverdue_days = C4::Context->preference('DefaultLongOverdueDays');
266 if(defined($longoverdue_value) and defined($longoverdue_days) and $longoverdue_value ne '' and $longoverdue_days ne '' and $longoverdue_days >= 0) {
267 $lost->{$longoverdue_days} = $longoverdue_value;
272 -msg => q|ERROR: No --lost (-l) option or system preferences DefaultLongOverdueLostValue/DefaultLongOverdueDays defined|,
276 if ( ! defined($charge) ) {
277 my $charge_value = C4::Context->preference('DefaultLongOverdueChargeValue');
278 if(defined($charge_value) and $charge_value ne '') {
279 $charge = $charge_value;
283 $verbose = 1; # If you're not running it for real, then the whole point is the print output.
284 print "### TEST MODE -- NO ACTIONS TAKEN ###\n";
289 # In my opinion, this line is safe SQL to have outside the API. --atz
290 our $bounds_sth = C4::Context->dbh->prepare("SELECT DATE_SUB(CURDATE(), INTERVAL ? DAY)");
293 $bounds_sth->execute(shift);
294 return $bounds_sth->fetchrow;
297 # FIXME - This sql should be inside the API.
298 sub longoverdue_sth {
300 my $skip_lost_values = $params->{skip_lost_values};
302 my $skip_lost_values_sql = q{};
303 if ( @$skip_lost_values ) {
304 my $values = join( ',', map { qq{'$_'} } @$skip_lost_values );
305 $skip_lost_values_sql = "AND itemlost NOT IN ( $values )"
309 SELECT items.itemnumber, borrowernumber, date_due, itemlost
311 WHERE items.itemnumber = issues.itemnumber
312 AND DATE_SUB(CURDATE(), INTERVAL ? DAY) > date_due
313 AND DATE_SUB(CURDATE(), INTERVAL ? DAY) <= date_due
315 $skip_lost_values_sql
318 return C4::Context->dbh->prepare($query);
321 my $dbh = C4::Context->dbh;
323 my @available_categories = Koha::Patron::Categories->search()->get_column('categorycode');
324 $borrower_category = [ map { uc $_ } @$borrower_category ];
325 $skip_borrower_category = [ map { uc $_} @$skip_borrower_category ];
326 my %category_to_process;
327 for my $cat ( @$borrower_category ) {
328 unless ( grep { $_ eq $cat } @available_categories ) {
331 '-message' => "The category $cat does not exist in the database",
334 $category_to_process{$cat} = 1;
336 if ( @$skip_borrower_category ) {
337 for my $cat ( @$skip_borrower_category ) {
338 unless ( grep { $_ eq $cat } @available_categories ) {
341 '-message' => "The category $cat does not exist in the database",
345 %category_to_process = map { $_ => 1 } @available_categories;
346 %category_to_process = ( %category_to_process, map { $_ => 0 } @$skip_borrower_category );
349 my $filter_borrower_categories = ( scalar @$borrower_category || scalar @$skip_borrower_category );
351 my @available_itemtypes = Koha::ItemTypes->search()->get_column('itemtype');
352 $itemtype = [ map { uc $_ } @$itemtype ];
353 $skip_itemtype = [ map { uc $_} @$skip_itemtype ];
354 my %itemtype_to_process;
355 for my $it ( @$itemtype ) {
356 unless ( grep { $_ eq $it } @available_itemtypes ) {
359 '-message' => "The itemtype $it does not exist in the database",
362 $itemtype_to_process{$it} = 1;
364 if ( @$skip_itemtype ) {
365 for my $it ( @$skip_itemtype ) {
366 unless ( grep { $_ eq $it } @available_itemtypes ) {
369 '-message' => "The itemtype $it does not exist in the database",
373 %itemtype_to_process = map { $_ => 1 } @available_itemtypes;
374 %itemtype_to_process = ( %itemtype_to_process, map { $_ => 0 } @$skip_itemtype );
377 my $filter_itemtypes = ( scalar @$itemtype || scalar @$skip_itemtype );
384 # FIXME - The item is only marked returned if you supply --charge .
385 # We need a better way to handle this.
387 my $sth_items = longoverdue_sth({ skip_lost_values => \@skip_lost_values });
389 foreach my $startrange (sort keys %$lost) {
390 if( my $lostvalue = $lost->{$startrange} ) {
391 my ($date1) = bounds($startrange);
392 my ($date2) = bounds( $endrange);
393 # print "\nRange ", ++$i, "\nDue $startrange - $endrange days ago ($date2 to $date1), lost => $lostvalue\n" if($verbose);
395 printf "\nRange %s\nDue %3s - %3s days ago (%s to %s), lost => %s\n", ++$i,
396 $startrange, $endrange, $date2, $date1, $lostvalue;
397 $sth_items->execute($startrange, $endrange, $lostvalue);
399 ITEM: while (my $row=$sth_items->fetchrow_hashref) {
400 if( $filter_borrower_categories ) {
401 my $category = uc Koha::Patrons->find( $row->{borrowernumber} )->categorycode();
402 next ITEM unless ( $category_to_process{ $category } );
404 if ($filter_itemtypes) {
405 my $it = uc Koha::Items->find( $row->{itemnumber} )->effective_itemtype();
406 next ITEM unless ( $itemtype_to_process{$it} );
408 printf ("Due %s: item %5s from borrower %5s to lost: %s\n", $row->{date_due}, $row->{itemnumber}, $row->{borrowernumber}, $lostvalue) if($verbose);
410 Koha::Items->find( $row->{itemnumber} )->itemlost($lostvalue)
412 if ( $charge && $charge eq $lostvalue ) {
413 LostItem( $row->{'itemnumber'}, 'cronjob', $mark_returned );
414 } elsif ( $mark_returned ) {
415 my $patron = Koha::Patrons->find( $row->{borrowernumber} );
416 MarkIssueReturned($row->{borrowernumber},$row->{itemnumber},undef,$patron->privacy)
422 startrange => $startrange,
423 endrange => $endrange,
424 range => "$startrange - $endrange",
427 lostvalue => $lostvalue,
432 $endrange = $startrange;
436 my $arg = shift; # ref to array
437 my $got_items = shift || 0; # print "count" line for items
438 my @report = @$arg or return;
440 for my $range (@report) {
441 printf "\nRange %s\nDue %3s - %3s days ago (%s to %s), lost => %s\n", ++$i,
442 map {$range->{$_}} qw(startrange endrange date2 date1 lostvalue);
443 $got_items and printf " %4s items\n", $range->{count};
448 print "\n### LONGOVERDUE SUMMARY ###";
449 summarize (\@report, 1);
450 print "\nTOTAL: $total items\n";