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

(-)a/misc/cronjobs/overdue_notices.pl (-22 / +58 lines)
Lines 34-39 use Pod::Usage; Link Here
34
use Text::CSV_XS;
34
use Text::CSV_XS;
35
use Locale::Currency::Format 1.28;
35
use Locale::Currency::Format 1.28;
36
use Encode;
36
use Encode;
37
use DateTime;
38
use DateTime::Duration;
37
39
38
use C4::Context;
40
use C4::Context;
39
use C4::Dates qw/format_date/;
41
use C4::Dates qw/format_date/;
Lines 41-46 use C4::Debug; Link Here
41
use C4::Letters;
43
use C4::Letters;
42
use C4::Overdues qw(GetFine);
44
use C4::Overdues qw(GetFine);
43
use C4::Budgets qw(GetCurrency);
45
use C4::Budgets qw(GetCurrency);
46
use Koha::DateUtils;
44
47
45
=head1 NAME
48
=head1 NAME
46
49
Lines 276-282 my $listall = 0; Link Here
276
my $itemscontent = join( ',', qw( date_due title barcode author itemnumber ) );
279
my $itemscontent = join( ',', qw( date_due title barcode author itemnumber ) );
277
my @myborcat;
280
my @myborcat;
278
my @myborcatout;
281
my @myborcatout;
279
my $date;
282
my ( $date_input, $today );
280
283
281
GetOptions(
284
GetOptions(
282
    'help|?'         => \$help,
285
    'help|?'         => \$help,
Lines 290-296 GetOptions( Link Here
290
    'itemscontent=s' => \$itemscontent,
293
    'itemscontent=s' => \$itemscontent,
291
    'list-all'       => \$listall,
294
    'list-all'       => \$listall,
292
    't|triggered'    => \$triggered,
295
    't|triggered'    => \$triggered,
293
    'date'           => \$date,
296
    'date=s'         => \$date_input,
294
    'borcat=s'       => \@myborcat,
297
    'borcat=s'       => \@myborcat,
295
    'borcatout=s'    => \@myborcatout,
298
    'borcatout=s'    => \@myborcatout,
296
    'email=s'        => \@emails,
299
    'email=s'        => \@emails,
Lines 340-350 if (@branchcodes) { Link Here
340
    }
343
    }
341
}
344
}
342
345
343
if ($date){
346
if ( $date_input ){
344
    $date=$dbh->quote($date);
347
    eval {
348
        $today = dt_from_string( $date_input );
349
    };
350
    die "$date_input is not a valid date, aborting!"
351
        if $@ or not $today;
352
345
}
353
}
346
else {
354
else {
347
    $date="NOW()";
355
    $today = dt_from_string;
348
}
356
}
349
357
350
# these are the fields that will be substituted into <<item.content>>
358
# these are the fields that will be substituted into <<item.content>>
Lines 377-383 if ( defined $htmlfilename ) { Link Here
377
  if ( $htmlfilename eq '' ) {
385
  if ( $htmlfilename eq '' ) {
378
    $html_fh = *STDOUT;
386
    $html_fh = *STDOUT;
379
  } else {
387
  } else {
380
    my $today = DateTime->now(time_zone => C4::Context->tz );
381
    open $html_fh, ">",File::Spec->catdir ($htmlfilename,"notices-".$today->ymd().".html");
388
    open $html_fh, ">",File::Spec->catdir ($htmlfilename,"notices-".$today->ymd().".html");
382
  }
389
  }
383
  
390
  
Lines 403-415 foreach my $branchcode (@branches) { Link Here
403
    $verbose and warn sprintf "branchcode : '%s' using %s\n", $branchcode, $admin_email_address;
410
    $verbose and warn sprintf "branchcode : '%s' using %s\n", $branchcode, $admin_email_address;
404
411
405
    my $sth2 = $dbh->prepare( <<"END_SQL" );
412
    my $sth2 = $dbh->prepare( <<"END_SQL" );
406
SELECT biblio.*, items.*, issues.*, biblioitems.itemtype, TO_DAYS($date)-TO_DAYS(date_due) AS days_overdue
413
SELECT biblio.*, items.*, issues.*, biblioitems.itemtype
407
  FROM issues,items,biblio, biblioitems
414
  FROM issues,items,biblio, biblioitems
408
  WHERE items.itemnumber=issues.itemnumber
415
  WHERE items.itemnumber=issues.itemnumber
409
    AND biblio.biblionumber   = items.biblionumber
416
    AND biblio.biblionumber   = items.biblionumber
410
    AND biblio.biblionumber   = biblioitems.biblionumber
417
    AND biblio.biblionumber   = biblioitems.biblionumber
411
    AND issues.borrowernumber = ?
418
    AND issues.borrowernumber = ?
412
    AND TO_DAYS($date)-TO_DAYS(date_due) BETWEEN ? and ?
419
    AND CAST(date_due AS date) BETWEEN ? and ?
413
END_SQL
420
END_SQL
414
421
415
    my $query = "SELECT * FROM overduerules WHERE delay1 IS NOT NULL AND branchcode = ? ";
422
    my $query = "SELECT * FROM overduerules WHERE delay1 IS NOT NULL AND branchcode = ? ";
Lines 433-439 END_SQL Link Here
433
    while ( my $overdue_rules = $rqoverduerules->fetchrow_hashref ) {
440
    while ( my $overdue_rules = $rqoverduerules->fetchrow_hashref ) {
434
      PERIOD: foreach my $i ( 1 .. 3 ) {
441
      PERIOD: foreach my $i ( 1 .. 3 ) {
435
442
436
            $verbose and warn "branch '$branchcode', pass $i\n";
443
            $verbose and warn "branch '$branchcode', categorycode = $overdue_rules->{categorycode} pass $i\n";
444
437
            my $mindays = $overdue_rules->{"delay$i"};    # the notice will be sent after mindays days (grace period)
445
            my $mindays = $overdue_rules->{"delay$i"};    # the notice will be sent after mindays days (grace period)
438
            my $maxdays = (
446
            my $maxdays = (
439
                  $overdue_rules->{ "delay" . ( $i + 1 ) }
447
                  $overdue_rules->{ "delay" . ( $i + 1 ) }
Lines 441-446 END_SQL Link Here
441
                : ($MAX)
449
                : ($MAX)
442
            );                                            # issues being more than maxdays late are managed somewhere else. (borrower probably suspended)
450
            );                                            # issues being more than maxdays late are managed somewhere else. (borrower probably suspended)
443
451
452
            next unless defined $mindays;
453
454
            my $range_end   = output_pref({
455
                dt => $today->clone->subtract_duration( DateTime::Duration->new( days => $mindays ) ),
456
                dateformat => 'sql',
457
                dateonly => 1,
458
            });
459
            my $range_begin = $triggered
460
                            ? $range_end
461
                            : output_pref({
462
                                dt => $today->clone->subtract_duration( DateTime::Duration->new( days => $maxdays ) ),
463
                                dateformat => 'sql',
464
                                date_only => 1,
465
                            });
466
467
444
            if ( !$overdue_rules->{"letter$i"} ) {
468
            if ( !$overdue_rules->{"letter$i"} ) {
445
                $verbose and warn "No letter$i code for branch '$branchcode'";
469
                $verbose and warn "No letter$i code for branch '$branchcode'";
446
                next PERIOD;
470
                next PERIOD;
Lines 468-485 END_SQL Link Here
468
                push @borrower_parameters, $overdue_rules->{categorycode};
492
                push @borrower_parameters, $overdue_rules->{categorycode};
469
            }
493
            }
470
            $borrower_sql .= '  AND categories.overduenoticerequired=1 ';
494
            $borrower_sql .= '  AND categories.overduenoticerequired=1 ';
471
            if($triggered) {
495
472
                $borrower_sql .= " AND TO_DAYS($date)-TO_DAYS(date_due) = ?";
496
            $borrower_sql .= " AND CAST(date_due AS date) BETWEEN ? and ? " ;
473
                push @borrower_parameters, $mindays;
497
            push @borrower_parameters, $range_begin, $range_end;
474
            } else {
475
                $borrower_sql .= " AND TO_DAYS($date)-TO_DAYS(date_due) BETWEEN ? and ? " ;
476
                push @borrower_parameters, $mindays, $maxdays;
477
            }
478
498
479
            # $sth gets borrower info iff at least one overdue item has triggered the overdue action.
499
            # $sth gets borrower info iff at least one overdue item has triggered the overdue action.
480
	        my $sth = $dbh->prepare($borrower_sql);
500
	        my $sth = $dbh->prepare($borrower_sql);
481
            $sth->execute(@borrower_parameters);
501
            $sth->execute(@borrower_parameters);
482
            $verbose and warn $borrower_sql . "\n $branchcode | " . $overdue_rules->{'categorycode'} . "\n ($mindays, $maxdays)\nreturns " . $sth->rows . " rows";
502
            $verbose and warn $borrower_sql . "\n $branchcode | " . $overdue_rules->{'categorycode'} . "\n ($range_begin, $range_end)\nreturns " . $sth->rows . " rows";
483
503
484
            while ( my $data = $sth->fetchrow_hashref ) {
504
            while ( my $data = $sth->fetchrow_hashref ) {
485
                my $borrowernumber = $data->{'borrowernumber'};
505
                my $borrowernumber = $data->{'borrowernumber'};
Lines 507-513 END_SQL Link Here
507
                my $letter = C4::Letters::getletter( 'circulation', $overdue_rules->{"letter$i"}, $branchcode );
527
                my $letter = C4::Letters::getletter( 'circulation', $overdue_rules->{"letter$i"}, $branchcode );
508
528
509
                unless ($letter) {
529
                unless ($letter) {
510
                    $verbose and warn "Message '$overdue_rules->{letter$i}' content not found";
530
                    $verbose and warn qq|Message '$overdue_rules->{"letter$i"}' content not found|;
511
531
512
                    # might as well skip while PERIOD, no other borrowers are going to work.
532
                    # might as well skip while PERIOD, no other borrowers are going to work.
513
                    # FIXME : Does this mean a letter must be defined in order to trigger a debar ?
533
                    # FIXME : Does this mean a letter must be defined in order to trigger a debar ?
Lines 520-527 END_SQL Link Here
520
                    C4::Members::DebarMember($borrowernumber, '9999-12-31');
540
                    C4::Members::DebarMember($borrowernumber, '9999-12-31');
521
                    $verbose and warn "debarring $borr\n";
541
                    $verbose and warn "debarring $borr\n";
522
                }
542
                }
523
                my @params = ($listall ? ( $borrowernumber , 1 , $MAX ) : ( $borrowernumber, $mindays, $maxdays ));
543
524
                $verbose and warn "STH2 PARAMS: borrowernumber = $borrowernumber, mindays = $mindays, maxdays = $maxdays";
544
                my @params = ( $listall
545
                    ? ( $borrowernumber , output_pref({
546
                                dt => $today->clone->subtract_duration( days => 1 ),
547
                                dateformat => 'sql',
548
                                date_only => 1
549
                        }),
550
                        output_pref({
551
                                dt => $today->clone->subtract_duration( days => $maxdays ),
552
                                dateformat => 'sql',
553
                                date_only => 1
554
                        })
555
                    )
556
                    : ( $borrowernumber, $range_begin, $range_end )
557
                );
558
                $verbose and warn $listall
559
                    ? "STH2 PARAMS: borrowernumber = $borrowernumber, from = NOW - 1, to = NOW - $maxdays, maxdays = $maxdays"
560
                    : "STH2 PARAMS: borrowernumber = $borrowernumber, from = $range_begin, to = $range_end, maxdays = $maxdays";
561
525
                $sth2->execute(@params);
562
                $sth2->execute(@params);
526
                my $itemcount = 0;
563
                my $itemcount = 0;
527
                my $titles = "";
564
                my $titles = "";
Lines 555-561 END_SQL Link Here
555
                    }
592
                    }
556
                );
593
                );
557
                unless ($letter) {
594
                unless ($letter) {
558
                    $verbose and warn "Message '$overdue_rules->{letter$i}' content not found";
595
                    $verbose and warn qq|Message '$overdue_rules->{"letter$i"}' content not found|;
559
596
560
                    # might as well skip while PERIOD, no other borrowers are going to work.
597
                    # might as well skip while PERIOD, no other borrowers are going to work.
561
                    # FIXME : Does this mean a letter must be defined in order to trigger a debar ?
598
                    # FIXME : Does this mean a letter must be defined in order to trigger a debar ?
562
- 

Return to bug 11120