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 { |