misc/cronjobs/automatic_renewals.pl

   1 #!/usr/bin/perl
   2
   3 # This file is part of Koha.
   4 #
   5 # Copyright (C) 2014 Hochschule für Gesundheit (hsg), Germany
   6 #
   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.
  11 #
  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.
  16 #
  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
  20 =head1 NAME
  21
  22 automatic_renewals.pl - cron script to renew loans
  23
  24 =head1 SYNOPSIS
  25
  26 ./automatic_renewals.pl [-c|--confirm] [-s|--send-notices] [-d|--digest] [-b|--digest-per-branch] [-v|--verbose]
  27
  28 or, in crontab:
  29 # Once every day for digest messages
  30 0 3 * * * automatic_renewals.pl -c -d
  31 # Three times a day for non digest messages
  32 0 0,8,16 * * * automatic_renewals.pl -c
  33
  34 =head1 DESCRIPTION
  35
  36 This script searches for issues scheduled for automatic renewal
  37 (issues.auto_renew). If there are still renews left (Renewals allowed)
  38 and the renewal isn't premature (No Renewal before) the issue is renewed.
  39
  40 =head1 OPTIONS
  41
  42 =over
  43
  44 =item B<-s|--send-notices>
  45
  46 DEPRECATED: The system preference AutoRenewalNotices should be used to determine
  47 whether notices are sent or not
  48 Send AUTO_RENEWALS notices to patrons if the auto renewal has been done.
  49
  50 =item B<-v|--verbose>
  51
  52 Print report to standard out.
  53
  54 =item B<-c|--confirm>
  55
  56 Without this parameter no changes will be made
  57
  58 =item B<-b|--digest-per-branch>
  59
  60 Flag to indicate that generation of message digests should be
  61 performed separately for each branch.
  62
  63 A patron could potentially have loans at several different branches
  64 There is no natural branch to set as the sender on the aggregated
  65 message in this situation so the default behavior is to use the
  66 borrowers home branch.  This could surprise to the borrower when
  67 message sender is a library where they have not borrowed anything.
  68
  69 Enabling this flag ensures that the issuing library is the sender of
  70 the digested message.  It has no effect unless the borrower has
  71 chosen 'Digests only' on the advance messages.
  72
  73 =back
  74
  75 =cut
  76
  77 use Modern::Perl;
  78 use Pod::Usage qw( pod2usage );
  79 use Getopt::Long qw( GetOptions );
  80
  81 use Koha::Script -cron;
  82 use C4::Circulation qw( CanBookBeRenewed AddRenewal );
  83 use C4::Context;
  84 use C4::Log qw( cronlogaction );
  85 use C4::Letters;
  86 use Koha::Checkouts;
  87 use Koha::Libraries;
  88 use Koha::Patrons;
  89
  90 my ( $help, $send_notices, $verbose, $confirm, $digest_per_branch );
  91 GetOptions(
  92     'h|help' => \$help,
  93     's|send-notices' => \$send_notices,
  94     'v|verbose'    => \$verbose,
  95     'c|confirm'     => \$confirm,
  96     'b|digest-per-branch' => \$digest_per_branch,
  97 ) || pod2usage(1);
  98
  99 pod2usage(0) if $help;
 100
 101 my $send_notices_pref = C4::Context->preference('AutoRenewalNotices');
 102 if ( $send_notices_pref eq 'cron' ) {
 103     warn <<'END_WARN';
 104
 105 The "AutoRenewalNotices" syspref is set to 'Follow the cron switch'.
 106 The send_notices switch for this script is deprecated, you should either set the preference
 107 to 'Never send emails' or 'Follow patron messaging preferences'
 108
 109 END_WARN
 110 } else {
 111     # If not following cron then:
 112     # - we should not send if set to never
 113     # - we will send any notice generated according to preferences if following those
 114     $send_notices = $send_notices_pref eq 'never' ? 0 : 1;
 115 }
 116
 117 # Since advance notice options are not visible in the web-interface
 118 # unless EnhancedMessagingPreferences is on, let the user know that
 119 # this script probably isn't going to do much
 120 if ( ! C4::Context->preference('EnhancedMessagingPreferences') ) {
 121     warn <<'END_WARN';
 122
 123 The "EnhancedMessagingPreferences" syspref is off.
 124 Therefore, it is unlikely that this script will actually produce any messages to be sent.
 125 To change this, edit the "EnhancedMessagingPreferences" syspref.
 126
 127 END_WARN
 128 }
 129
 130 cronlogaction();
 131
 132 $verbose = 1 unless $verbose or $confirm;
 133 print "Test run only\n" unless $confirm;
 134
 135 print "getting auto renewals\n" if $verbose;
 136 my $auto_renews = Koha::Checkouts->search(
 137     {
 138         auto_renew                   => 1,
 139         'patron.autorenew_checkouts' => 1,
 140     },
 141     {
 142         join => ['patron','item']
 143     }
 144 );
 145 print "found " . $auto_renews->count . " auto renewals\n" if $verbose;
 146
 147 my $renew_digest = {};
 148 my %report;
 149 while ( my $auto_renew = $auto_renews->next ) {
 150     print "examining item '" . $auto_renew->itemnumber . "' to auto renew\n" if $verbose;
 151
 152     my ( $borrower_preferences, $wants_messages, $wants_digest ) = ( undef, 0, 0 );
 153     if ( $send_notices_pref eq 'preferences' ){
 154         $borrower_preferences = C4::Members::Messaging::GetMessagingPreferences(
 155             {
 156                 borrowernumber => $auto_renew->borrowernumber,
 157                 message_name   => 'auto_renewals'
 158             }
 159         );
 160         $wants_messages = 1
 161             if $borrower_preferences
 162             && $borrower_preferences->{transports};
 163         $wants_digest = 1
 164             if $wants_messages
 165             && $borrower_preferences->{wants_digest};
 166     } else { # Preference is never or cron
 167         $wants_messages = $send_notices;
 168         $wants_digest = 0;
 169     }
 170
 171     # CanBookBeRenewed returns 'auto_renew' when the renewal should be done by this script
 172     my ( $ok, $error ) = CanBookBeRenewed( $auto_renew->borrowernumber, $auto_renew->itemnumber, undef, 1 );
 173     my $updated;
 174     if ( $error eq 'auto_renew' ) {
 175         $updated = 1;
 176         if ($verbose) {
 177             say sprintf "Issue id: %s for borrower: %s and item: %s %s be renewed.",
 178               $auto_renew->issue_id, $auto_renew->borrowernumber, $auto_renew->itemnumber, $confirm ? 'will' : 'would';
 179         }
 180         if ($confirm){
 181             my $date_due = AddRenewal( $auto_renew->borrowernumber, $auto_renew->itemnumber, $auto_renew->branchcode, undef, undef, undef, 0 );
 182             $auto_renew->auto_renew_error(undef)->store;
 183         }
 184         push @{ $report{ $auto_renew->borrowernumber } }, $auto_renew
 185             if ( $wants_messages ) && !$wants_digest;
 186     } elsif ( $error eq 'too_many'
 187         or $error eq 'on_reserve'
 188         or $error eq 'restriction'
 189         or $error eq 'overdue'
 190         or $error eq 'too_unseen'
 191         or $error eq 'auto_account_expired'
 192         or $error eq 'auto_too_late'
 193         or $error eq 'auto_too_much_oweing'
 194         or $error eq 'auto_too_soon'
 195         or $error eq 'item_denied_renewal' ) {
 196         if ( $verbose ) {
 197             say sprintf "Issue id: %s for borrower: %s and item: %s %s not be renewed. (%s)",
 198               $auto_renew->issue_id, $auto_renew->borrowernumber, $auto_renew->itemnumber, $confirm ? 'will' : 'would', $error;
 199         }
 200         $updated = 1 if (!$auto_renew->auto_renew_error || $error ne $auto_renew->auto_renew_error);
 201         if ( $updated ) {
 202             $auto_renew->auto_renew_error($error)->store if $confirm;
 203             push @{ $report{ $auto_renew->borrowernumber } }, $auto_renew
 204               if $error ne 'auto_too_soon' && ( $wants_messages  && !$wants_digest );    # Do not notify if it's too soon
 205         }
 206     }
 207
 208     if ( $wants_digest ) {
 209         # cache this one to process after we've run through all of the items.
 210         if ($digest_per_branch) {
 211             $renew_digest->{ $auto_renew->branchcode }->{ $auto_renew->borrowernumber }->{success}++ if $error eq 'auto_renew';
 212             $renew_digest->{ $auto_renew->branchcode }->{ $auto_renew->borrowernumber }->{error}++ unless $error eq 'auto_renew' || $error eq 'auto_too_soon';
 213             push @{$renew_digest->{ $auto_renew->branchcode }->{ $auto_renew->borrowernumber }->{issues}}, $auto_renew->itemnumber;
 214             $renew_digest->{ $auto_renew->branchcode }->{ $auto_renew->borrowernumber }->{updated} = 1 if $updated && $error ne 'auto_too_soon';
 215         } else {
 216             $renew_digest->{ $auto_renew->borrowernumber }->{success} ++ if $error eq 'auto_renew';
 217             $renew_digest->{ $auto_renew->borrowernumber }->{error}++ unless $error eq 'auto_renew' || $error eq 'auto_too_soon';
 218             $renew_digest->{ $auto_renew->borrowernumber }->{updated} = 1 if $updated && $error ne 'auto_too_soon';
 219             push @{$renew_digest->{ $auto_renew->borrowernumber }->{issues}}, $auto_renew->itemnumber;
 220         }
 221     }
 222
 223 }
 224
 225 if ( $send_notices && $confirm ) {
 226     for my $borrowernumber ( keys %report ) {
 227         my $patron = Koha::Patrons->find($borrowernumber);
 228         my $borrower_preferences =
 229             C4::Members::Messaging::GetMessagingPreferences(
 230                 {
 231                     borrowernumber => $borrowernumber,
 232                     message_name   => 'auto_renewals'
 233                 }
 234             );
 235         for my $issue ( @{ $report{$borrowernumber} } ) {
 236             my $item = $issue->item;
 237             # Force sending of email and only email if pref is set to "cron"
 238             my @transports = $send_notices_pref eq 'preferences' ? keys %{ $borrower_preferences->{'transports'} } : 'email';
 239             foreach my $transport ( @transports ) {
 240                 my $letter = C4::Letters::GetPreparedLetter (
 241                     module      => 'circulation',
 242                     letter_code => 'AUTO_RENEWALS',
 243                     tables      => {
 244                         borrowers => $patron->borrowernumber,
 245                         issues    => $issue->itemnumber,
 246                         items     => $issue->itemnumber,
 247                         biblio    => $item->biblionumber,
 248                     },
 249                     lang => $patron->lang,
 250                     message_transport_type => $transport,
 251                 );
 252
 253                 if ($letter) {
 254                     my $library = $patron->library;
 255                     my $admin_email_address = $library->from_email_address;
 256
 257                     C4::Letters::EnqueueLetter(
 258                         {
 259                             letter                 => $letter,
 260                             borrowernumber         => $borrowernumber,
 261                             from_address           => $admin_email_address,
 262                             message_transport_type => $transport
 263                         }
 264                     );
 265                 }
 266             }
 267         }
 268     }
 269
 270     if ($digest_per_branch) {
 271         while (my ($branchcode, $digests) = each %$renew_digest) {
 272             send_digests({
 273                 digests => $digests,
 274                 branchcode => $branchcode,
 275                 letter_code => 'AUTO_RENEWALS_DGST',
 276             });
 277         }
 278     } else {
 279         send_digests({
 280             digests => $renew_digest,
 281             letter_code => 'AUTO_RENEWALS_DGST',
 282         });
 283     }
 284 }
 285
 286 =head1 METHODS
 287
 288 =head2 send_digests
 289
 290     send_digests({
 291         digests => ...,
 292         letter_code => ...,
 293     })
 294
 295 Enqueue digested letters.
 296
 297 Parameters:
 298
 299 =over 4
 300
 301 =item C<$digests>
 302
 303 Reference to the array of digested messages.
 304
 305 =item C<$letter_code>
 306
 307 String that denote the letter code.
 308
 309 =back
 310
 311 =cut
 312
 313 sub send_digests {
 314     my $params = shift;
 315
 316     PATRON: while ( my ( $borrowernumber, $digest ) = each %{$params->{digests}} ) {
 317         next unless defined $digest->{updated} && $digest->{updated} == 1;
 318         my $borrower_preferences =
 319             C4::Members::Messaging::GetMessagingPreferences(
 320                 {
 321                     borrowernumber => $borrowernumber,
 322                     message_name   => 'auto_renewals'
 323                 }
 324             );
 325
 326         next PATRON unless $borrower_preferences; # how could this happen?
 327
 328         my $patron = Koha::Patrons->find( $borrowernumber );
 329         my $branchcode;
 330         if ( defined $params->{branchcode} ) {
 331             $branchcode = $params->{branchcode};
 332         } else {
 333             $branchcode = $patron->branchcode;
 334         }
 335         my $library = Koha::Libraries->find( $branchcode );
 336         my $from_address = $library->from_email_address;
 337
 338         foreach my $transport ( keys %{ $borrower_preferences->{'transports'} } ) {
 339             my $letter = C4::Letters::GetPreparedLetter (
 340                 module => 'circulation',
 341                 letter_code => $params->{letter_code},
 342                 branchcode => $branchcode,
 343                 lang => $patron->lang,
 344                 substitute => {
 345                     error => $digest->{error}||0,
 346                     success => $digest->{success}||0,
 347                 },
 348                 loops => { issues => \@{$digest->{issues}} },
 349                 tables      => {
 350                     borrowers => $patron->borrowernumber,
 351                 },
 352                 message_transport_type => $transport,
 353             );
 354
 355             if ($letter) {
 356                 C4::Letters::EnqueueLetter(
 357                     {
 358                         letter                 => $letter,
 359                         borrowernumber         => $borrowernumber,
 360                         from_address           => $from_address,
 361                         message_transport_type => $transport
 362                     }
 363                 );
 364             }
 365             else {
 366                 warn
 367 "no letter of type '$params->{letter_code}' found for borrowernumber $borrowernumber. Please see sample_notices.sql";
 368             }
 369
 370         }
 371     }
 372 }