|
Lines 1-6
Link Here
|
| 1 |
#!/usr/bin/perl |
1 |
#!/usr/bin/perl |
| 2 |
|
2 |
|
| 3 |
# Copyright 2008 Liblime |
3 |
# Copyright 2008 Liblime |
|
|
4 |
# Parts Copyright Biblibre 2010 |
| 4 |
# |
5 |
# |
| 5 |
# This file is part of Koha. |
6 |
# This file is part of Koha. |
| 6 |
# |
7 |
# |
|
Lines 39-44
use C4::Dates qw/format_date/;
Link Here
|
| 39 |
use C4::Debug; |
40 |
use C4::Debug; |
| 40 |
use C4::Letters; |
41 |
use C4::Letters; |
| 41 |
use C4::Overdues qw(GetFine); |
42 |
use C4::Overdues qw(GetFine); |
|
|
43 |
use C4::Reports::Guided; #_get_column_defs |
| 44 |
use open qw(:std :utf8); |
| 45 |
use YAML; |
| 42 |
|
46 |
|
| 43 |
=head1 NAME |
47 |
=head1 NAME |
| 44 |
|
48 |
|
|
Lines 255-261
my $csvfilename;
Link Here
|
| 255 |
my $htmlfilename; |
259 |
my $htmlfilename; |
| 256 |
my $triggered = 0; |
260 |
my $triggered = 0; |
| 257 |
my $listall = 0; |
261 |
my $listall = 0; |
| 258 |
my $itemscontent = join( ',', qw( date_due title barcode author itemnumber ) ); |
262 |
my $itemscontent = join( ',', qw( issuedate title barcode author biblionumber date_due) ); |
| 259 |
my @myborcat; |
263 |
my @myborcat; |
| 260 |
my @myborcatout; |
264 |
my @myborcatout; |
| 261 |
|
265 |
|
|
Lines 266-282
GetOptions(
Link Here
|
| 266 |
'n' => \$nomail, |
270 |
'n' => \$nomail, |
| 267 |
'max=s' => \$MAX, |
271 |
'max=s' => \$MAX, |
| 268 |
'library=s' => \@branchcodes, |
272 |
'library=s' => \@branchcodes, |
| 269 |
'csv:s' => \$csvfilename, # this optional argument gets '' if not supplied. |
273 |
'csv:s' => \$csvfilename, # this optional argument gets '' if not supplied. |
| 270 |
'html:s' => \$htmlfilename, # this optional argument gets '' if not supplied. |
274 |
'html:s' => \$htmlfilename, # this optional argument gets '' if not supplied. |
| 271 |
'itemscontent=s' => \$itemscontent, |
275 |
'itemscontent=s' => \$itemscontent, |
| 272 |
'list-all' => \$listall, |
276 |
'list-all' => \$listall, |
| 273 |
't|triggered' => \$triggered, |
277 |
't|triggered' => \$triggered, |
| 274 |
'borcat=s' => \@myborcat, |
278 |
'borcat=s' => \@myborcat, |
| 275 |
'borcatout=s' => \@myborcatout, |
279 |
'borcatout=s' => \@myborcatout, |
| 276 |
) or pod2usage(2); |
280 |
) or pod2usage(2); |
| 277 |
pod2usage(1) if $help; |
281 |
pod2usage(1) if $help; |
| 278 |
pod2usage( -verbose => 2 ) if $man; |
282 |
pod2usage( -verbose => 2 ) if $man; |
| 279 |
|
283 |
|
|
|
284 |
my $columns_def_hashref = C4::Reports::Guided::_get_column_defs(); |
| 285 |
|
| 286 |
foreach my $key ( keys %$columns_def_hashref ) { |
| 287 |
my $initkey = $key; |
| 288 |
$key =~ s/[^\.]*\.//; |
| 289 |
$columns_def_hashref->{$key} = $columns_def_hashref->{$initkey}; |
| 290 |
} |
| 291 |
print Dump($columns_def_hashref); |
| 280 |
if ( defined $csvfilename && $csvfilename =~ /^-/ ) { |
292 |
if ( defined $csvfilename && $csvfilename =~ /^-/ ) { |
| 281 |
warn qq(using "$csvfilename" as filename, that seems odd); |
293 |
warn qq(using "$csvfilename" as filename, that seems odd); |
| 282 |
} |
294 |
} |
|
Lines 312-318
if (@branchcodes) {
Link Here
|
| 312 |
} else { |
324 |
} else { |
| 313 |
|
325 |
|
| 314 |
$verbose and warn "No active overduerules for $branchcodes_word '@branchcodes'\n"; |
326 |
$verbose and warn "No active overduerules for $branchcodes_word '@branchcodes'\n"; |
| 315 |
( scalar grep { '' eq $_ } @branches ) |
327 |
( scalar grep { $_ eq ""} @overduebranches ) |
| 316 |
or die "No active overduerules for DEFAULT either!"; |
328 |
or die "No active overduerules for DEFAULT either!"; |
| 317 |
$verbose and warn "Falling back on default rules for @branchcodes\n"; |
329 |
$verbose and warn "Falling back on default rules for @branchcodes\n"; |
| 318 |
@branches = (''); |
330 |
@branches = (''); |
|
Lines 352-373
if ( defined $htmlfilename ) {
Link Here
|
| 352 |
open $html_fh, ">",File::Spec->catdir ($htmlfilename,"notices-".$today->output('iso').".html"); |
364 |
open $html_fh, ">",File::Spec->catdir ($htmlfilename,"notices-".$today->output('iso').".html"); |
| 353 |
} |
365 |
} |
| 354 |
|
366 |
|
| 355 |
print $html_fh "<html>\n"; |
367 |
print $html_fh <<HEAD; |
| 356 |
print $html_fh "<head>\n"; |
368 |
<?xml version="1.0" encoding="UTF-8"?> |
| 357 |
print $html_fh "<style type='text/css'>\n"; |
369 |
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> |
| 358 |
print $html_fh "pre {page-break-after: always;}\n"; |
370 |
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en"> |
| 359 |
print $html_fh "pre {white-space: pre-wrap;}\n"; |
371 |
<head> |
| 360 |
print $html_fh "pre {white-space: -moz-pre-wrap;}\n"; |
372 |
<style type='text/css'> |
| 361 |
print $html_fh "pre {white-space: -o-pre-wrap;}\n"; |
373 |
pre {page-break-after: always;} |
| 362 |
print $html_fh "pre {word-wrap: break-work;}\n"; |
374 |
pre {white-space: pre-wrap;} |
| 363 |
print $html_fh "</style>\n"; |
375 |
pre {white-space: -moz-pre-wrap;} |
| 364 |
print $html_fh "</head>\n"; |
376 |
pre {white-space: -o-pre-wrap;} |
| 365 |
print $html_fh "<body>\n"; |
377 |
pre {word-wrap: break-work;} |
|
|
378 |
</style> |
| 379 |
</head> |
| 380 |
<body> |
| 381 |
HEAD |
| 366 |
} |
382 |
} |
| 367 |
|
383 |
|
| 368 |
foreach my $branchcode (@branches) { |
384 |
foreach my $branchcode (@branches) { |
| 369 |
|
385 |
|
| 370 |
my $branch_details = C4::Branch::GetBranchDetail($branchcode); |
386 |
my $branch_details = C4::Branch::GetBranchDetail($branchcode) unless ($branchcode eq ""); |
| 371 |
my $admin_email_address = $branch_details->{'branchemail'} || C4::Context->preference('KohaAdminEmailAddress'); |
387 |
my $admin_email_address = $branch_details->{'branchemail'} || C4::Context->preference('KohaAdminEmailAddress'); |
| 372 |
my @output_chunks; # may be sent to mail or stdout or csv file. |
388 |
my @output_chunks; # may be sent to mail or stdout or csv file. |
| 373 |
|
389 |
|
|
Lines 429-435
WHERE issues.borrowernumber=borrowers.borrowernumber
Link Here
|
| 429 |
AND borrowers.categorycode=categories.categorycode |
445 |
AND borrowers.categorycode=categories.categorycode |
| 430 |
END_SQL |
446 |
END_SQL |
| 431 |
my @borrower_parameters; |
447 |
my @borrower_parameters; |
| 432 |
if ($branchcode) { |
448 |
if ($branchcode && $branchcode ne "") { |
| 433 |
$borrower_sql .= ' AND issues.branchcode=? '; |
449 |
$borrower_sql .= ' AND issues.branchcode=? '; |
| 434 |
push @borrower_parameters, $branchcode; |
450 |
push @borrower_parameters, $branchcode; |
| 435 |
} |
451 |
} |
|
Lines 456-461
END_SQL
Link Here
|
| 456 |
$address1, $address2, $city, $postcode, $country, $email, |
472 |
$address1, $address2, $city, $postcode, $country, $email, |
| 457 |
$longest_issue ) = $sth->fetchrow ) |
473 |
$longest_issue ) = $sth->fetchrow ) |
| 458 |
{ |
474 |
{ |
|
|
475 |
$email=C4::Members::GetFirstValidEmailAddress($borrowernumber); |
| 459 |
$verbose and warn "borrower $firstname, $lastname ($borrowernumber) has $itemcount items triggering level $i."; |
476 |
$verbose and warn "borrower $firstname, $lastname ($borrowernumber) has $itemcount items triggering level $i."; |
| 460 |
|
477 |
|
| 461 |
my $letter = C4::Letters::getletter( 'circulation', $overdue_rules->{"letter$i"} ); |
478 |
my $letter = C4::Letters::getletter( 'circulation', $overdue_rules->{"letter$i"} ); |
|
Lines 471-499
END_SQL
Link Here
|
| 471 |
if ( $overdue_rules->{"debarred$i"} ) { |
488 |
if ( $overdue_rules->{"debarred$i"} ) { |
| 472 |
|
489 |
|
| 473 |
#action taken is debarring |
490 |
#action taken is debarring |
| 474 |
C4::Members::DebarMember($borrowernumber); |
491 |
C4::Members::DebarMember($borrowernumber, '9999-12-31'); |
| 475 |
$verbose and warn "debarring $borrowernumber $firstname $lastname\n"; |
492 |
$verbose and warn "debarring $borrowernumber $firstname $lastname\n"; |
| 476 |
} |
493 |
} |
| 477 |
my @params = ($listall ? ( $borrowernumber , 1 , $MAX ) : ( $borrowernumber, $mindays, $maxdays )); |
494 |
my @params = ($listall ? ( $borrowernumber , 1 , $MAX ) : ( $borrowernumber, $mindays, $maxdays )); |
| 478 |
$verbose and warn "STH2 PARAMS: borrowernumber = $borrowernumber, mindays = $mindays, maxdays = $maxdays"; |
495 |
$verbose and warn "STH2 PARAMS: borrowernumber = $borrowernumber, mindays = $mindays, maxdays = $maxdays"; |
| 479 |
$sth2->execute(@params); |
496 |
$sth2->execute(@params); |
| 480 |
my $itemcount = 0; |
497 |
my $itemcount = 0; |
| 481 |
my $titles = ""; |
498 |
|
|
|
499 |
my $titles; |
| 500 |
if ($htmlfilename) { |
| 501 |
$titles = "<table id='itemscontent$borrowernumber'>"; |
| 502 |
$titles .= "<thead><tr><th>" . join( "</th><th>", @$columns_def_hashref{@item_content_fields} ); |
| 503 |
warn @item_content_fields; |
| 504 |
warn map { "$columns_def_hashref->{$_};" } @item_content_fields; |
| 505 |
$titles .= "</th></tr></thead><tbody>"; |
| 506 |
} |
| 482 |
my @items = (); |
507 |
my @items = (); |
| 483 |
|
508 |
|
| 484 |
my $i = 0; |
509 |
my $i = 0; |
| 485 |
my $exceededPrintNoticesMaxLines = 0; |
510 |
my $exceededPrintNoticesMaxLines = 0; |
| 486 |
while ( my $item_info = $sth2->fetchrow_hashref() ) { |
511 |
while ( my $item_info = $sth2->fetchrow_hashref() ) { |
| 487 |
if ( ( !$email || $nomail ) && $PrintNoticesMaxLines && $i >= $PrintNoticesMaxLines ) { |
512 |
if ( ( !$email || $nomail ) && $PrintNoticesMaxLines && $i >= $PrintNoticesMaxLines ) { |
| 488 |
$exceededPrintNoticesMaxLines = 1; |
513 |
$exceededPrintNoticesMaxLines = 1; |
| 489 |
last; |
514 |
last; |
| 490 |
} |
515 |
} |
| 491 |
$i++; |
516 |
$i++; |
| 492 |
my @item_info = map { $_ =~ /^date|date$/ ? format_date( $item_info->{$_} ) : $item_info->{$_} || '' } @item_content_fields; |
517 |
my @item_info = map { $_ =~ /^date|date$/ ? format_date( $item_info->{$_} ) : $item_info->{$_} || '' } @item_content_fields; |
| 493 |
$titles .= join("\t", @item_info) . "\n"; |
518 |
if ($htmlfilename) { |
|
|
519 |
$titles .= "<tr><td>" . join( "</td><td>", @item_info ) . "</td></tr>"; |
| 520 |
} else { |
| 521 |
$titles .= join( "\t", @item_info ) . "\n"; |
| 522 |
} |
| 494 |
$itemcount++; |
523 |
$itemcount++; |
| 495 |
push @items, { itemnumber => $item_info->{'itemnumber'}, biblionumber => $item_info->{'biblionumber'} }; |
524 |
push @items, { itemnumber => $item_info->{'itemnumber'}, biblionumber => $item_info->{'biblionumber'} }; |
| 496 |
} |
525 |
} |
|
|
526 |
$titles .= "</tbody></table>" if ($htmlfilename); |
| 527 |
$debug && warn $titles; |
| 497 |
$sth2->finish; |
528 |
$sth2->finish; |
| 498 |
$letter = parse_letter( |
529 |
$letter = parse_letter( |
| 499 |
{ letter => $letter, |
530 |
{ letter => $letter, |
|
Lines 506-525
END_SQL
Link Here
|
| 506 |
} |
537 |
} |
| 507 |
} |
538 |
} |
| 508 |
); |
539 |
); |
| 509 |
|
540 |
|
| 510 |
if ( $exceededPrintNoticesMaxLines ) { |
541 |
if ($exceededPrintNoticesMaxLines) { |
| 511 |
$letter->{'content'} .= "List too long for form; please check your account online for a complete list of your overdue items."; |
542 |
$letter->{'content'} .= "List too long for form; please check your account online for a complete list of your overdue items."; |
| 512 |
} |
543 |
} |
| 513 |
|
544 |
|
| 514 |
my @misses = grep { /./ } map { /^([^>]*)[>]+/; ( $1 || '' ); } split /\</, $letter->{'content'}; |
545 |
my @misses = grep { /./ } map { /^([^>]*)[>]{2,}/; ( $1 || '' ); } split /\<\</, $letter->{'content'}; |
| 515 |
if (@misses) { |
546 |
if (@misses) { |
| 516 |
$verbose and warn "The following terms were not matched and replaced: \n\t" . join "\n\t", @misses; |
547 |
$verbose and warn "The following terms were not matched and replaced: \n\t" . join "\n\t", @misses; |
| 517 |
} |
548 |
} |
| 518 |
$letter->{'content'} =~ s/\<[^<>]*?\>//g; # Now that we've warned about them, remove them. |
549 |
$letter->{'content'} =~ s/\<\<[^<>]*?\>\>//g; # Now that we've warned about them, remove them. |
| 519 |
$letter->{'content'} =~ s/\<[^<>]*?\>//g; # 2nd pass for the double nesting. |
550 |
|
| 520 |
|
551 |
# $letter->{'content'} =~ s/\<[^<>]*?\>//g; # 2nd pass for the double nesting. |
|
|
552 |
|
| 521 |
if ($nomail) { |
553 |
if ($nomail) { |
| 522 |
|
554 |
|
| 523 |
push @output_chunks, |
555 |
push @output_chunks, |
| 524 |
prepare_letter_for_printing( |
556 |
prepare_letter_for_printing( |
| 525 |
{ letter => $letter, |
557 |
{ letter => $letter, |
|
Lines 529-534
END_SQL
Link Here
|
| 529 |
address1 => $address1, |
561 |
address1 => $address1, |
| 530 |
address2 => $address2, |
562 |
address2 => $address2, |
| 531 |
city => $city, |
563 |
city => $city, |
|
|
564 |
country => $country, |
| 532 |
postcode => $postcode, |
565 |
postcode => $postcode, |
| 533 |
email => $email, |
566 |
email => $email, |
| 534 |
itemcount => $itemcount, |
567 |
itemcount => $itemcount, |
|
Lines 546-552
END_SQL
Link Here
|
| 546 |
} |
579 |
} |
| 547 |
); |
580 |
); |
| 548 |
} else { |
581 |
} else { |
| 549 |
|
582 |
|
| 550 |
# If we don't have an email address for this patron, send it to the admin to deal with. |
583 |
# If we don't have an email address for this patron, send it to the admin to deal with. |
| 551 |
push @output_chunks, |
584 |
push @output_chunks, |
| 552 |
prepare_letter_for_printing( |
585 |
prepare_letter_for_printing( |
|
Lines 557-562
END_SQL
Link Here
|
| 557 |
address1 => $address1, |
590 |
address1 => $address1, |
| 558 |
address2 => $address2, |
591 |
address2 => $address2, |
| 559 |
city => $city, |
592 |
city => $city, |
|
|
593 |
country => $country, |
| 560 |
postcode => $postcode, |
594 |
postcode => $postcode, |
| 561 |
email => $email, |
595 |
email => $email, |
| 562 |
itemcount => $itemcount, |
596 |
itemcount => $itemcount, |
|
Lines 573-587
END_SQL
Link Here
|
| 573 |
|
607 |
|
| 574 |
if (@output_chunks) { |
608 |
if (@output_chunks) { |
| 575 |
if ( defined $csvfilename ) { |
609 |
if ( defined $csvfilename ) { |
| 576 |
print $csv_fh @output_chunks; |
610 |
print $csv_fh @output_chunks; |
| 577 |
} |
611 |
} elsif ( defined $htmlfilename ) { |
| 578 |
elsif ( defined $htmlfilename ) { |
612 |
print $html_fh @output_chunks; |
| 579 |
print $html_fh @output_chunks; |
613 |
} elsif ($nomail) { |
| 580 |
} |
614 |
local $, = "\f"; # pagebreak |
| 581 |
elsif ($nomail){ |
615 |
print @output_chunks; |
| 582 |
local $, = "\f"; # pagebreak |
|
|
| 583 |
print @output_chunks; |
| 584 |
} |
616 |
} |
|
|
617 |
my $content = join(";", qw(title name surname address1 address2 zipcode city email itemcount itemsinfo due_date issue_date)) . "\n"; |
| 618 |
$content .= join( "\n", @output_chunks ); |
| 619 |
|
| 585 |
my $attachment = { |
620 |
my $attachment = { |
| 586 |
filename => defined $csvfilename ? 'attachment.csv' : 'attachment.txt', |
621 |
filename => defined $csvfilename ? 'attachment.csv' : 'attachment.txt', |
| 587 |
type => 'text/plain', |
622 |
type => 'text/plain', |
|
Lines 610-618
if ($csvfilename) {
Link Here
|
| 610 |
} |
645 |
} |
| 611 |
|
646 |
|
| 612 |
if ( defined $htmlfilename ) { |
647 |
if ( defined $htmlfilename ) { |
| 613 |
print $html_fh "</body>\n"; |
648 |
print $html_fh "</body>\n"; |
| 614 |
print $html_fh "</html>\n"; |
649 |
print $html_fh "</html>\n"; |
| 615 |
close $html_fh; |
650 |
close $html_fh; |
| 616 |
} |
651 |
} |
| 617 |
|
652 |
|
| 618 |
=head1 INTERNAL METHODS |
653 |
=head1 INTERNAL METHODS |
|
Lines 711-717
sub prepare_letter_for_printing {
Link Here
|
| 711 |
if ( exists $params->{'outputformat'} && $params->{'outputformat'} eq 'csv' ) { |
746 |
if ( exists $params->{'outputformat'} && $params->{'outputformat'} eq 'csv' ) { |
| 712 |
if ($csv->combine( |
747 |
if ($csv->combine( |
| 713 |
$params->{'firstname'}, $params->{'lastname'}, $params->{'address1'}, $params->{'address2'}, $params->{'postcode'}, |
748 |
$params->{'firstname'}, $params->{'lastname'}, $params->{'address1'}, $params->{'address2'}, $params->{'postcode'}, |
| 714 |
$params->{'city'}, $params->{'email'}, $params->{'itemcount'}, $params->{'titles'} |
749 |
$params->{'city'}, $params->{'country'}, $params->{'email'}, $params->{'itemcount'}, $params->{'titles'} |
| 715 |
) |
750 |
) |
| 716 |
) { |
751 |
) { |
| 717 |
return $csv->string, "\n"; |
752 |
return $csv->string, "\n"; |
|
Lines 720-725
sub prepare_letter_for_printing {
Link Here
|
| 720 |
} |
755 |
} |
| 721 |
} elsif ( exists $params->{'outputformat'} && $params->{'outputformat'} eq 'html' ) { |
756 |
} elsif ( exists $params->{'outputformat'} && $params->{'outputformat'} eq 'html' ) { |
| 722 |
$return = "<pre>\n"; |
757 |
$return = "<pre>\n"; |
|
|
758 |
$params->{'letter'}->{'content'}=~s#
#<br/>#g; |
| 723 |
$return .= "$params->{'letter'}->{'content'}\n"; |
759 |
$return .= "$params->{'letter'}->{'content'}\n"; |
| 724 |
$return .= "\n</pre>\n"; |
760 |
$return .= "\n</pre>\n"; |
| 725 |
} else { |
761 |
} else { |