Browse Source
This patch adds the misc/cronjobs/overdue_notices.pl script that is intended to replace overduenotices.pl, overduenotices-30.pl and overduenotices-csv.pl. It adds messages to the message_queue to be sent later (by process_message_queue.pl). It also marks borrowers as debarred if their issues become too overdue. It is intended to be run from cron nightly with usage something like: 0 2 * * * misc/cronjobs/overdue_notices.pl C4::Members: - improved documentation on ModMember - made ModMember return a useful value (the return value of the database call) - added a DebarMember method - adding t/lib/KohaTest/Members/DebarMember.pm to test ModMember misc/cronjobs/overdue_notices.pl - designed to replace overduenotices.pl, overduenotices-30.pl, and overduenotice-csv Changes to C4::Letters: - EnqueueLetter now lets you pass in to_address and from_address which can override defaults - _send_message_by_email pays attention to these defaults. - now handles attachments with MIME::Lite C4::Overdues - added GetBranchcodesWithOverdueRules - added t/lib/KohaTest/Overdues/GerBranchcodesWithOverdueRules.pm to test that. circ/overdue.pl - replaced call to obsolete overduenotices-csv.pl with call to overdue_notices.pl KohaTest: - added three helper methods: random_phone, random_email, random_ip - these can be used to populate example records - you can now pass an optional lengh to random_string Signed-off-by: Joshua Ferraro <jmf@liblime.com>3.0.x
Andrew Moore
16 years ago
committed by
Joshua Ferraro
Joshua Ferraro
8 changed files with 892 additions and 26 deletions
@ -0,0 +1,573 @@ |
|||
#!/usr/bin/perl -w |
|||
|
|||
# Copyright 2008 Liblime |
|||
# |
|||
# This file is part of Koha. |
|||
# |
|||
# Koha is free software; you can redistribute it and/or modify it under the |
|||
# terms of the GNU General Public License as published by the Free Software |
|||
# Foundation; either version 2 of the License, or (at your option) any later |
|||
# version. |
|||
# |
|||
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY |
|||
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR |
|||
# A PARTICULAR PURPOSE. See the GNU General Public License for more details. |
|||
# |
|||
# You should have received a copy of the GNU General Public License along with |
|||
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, |
|||
# Suite 330, Boston, MA 02111-1307 USA |
|||
|
|||
use strict; |
|||
use warnings; |
|||
|
|||
BEGIN { |
|||
|
|||
# find Koha's Perl modules |
|||
# test carefully before changing this |
|||
use FindBin; |
|||
eval { require "$FindBin::Bin/../kohalib.pl" }; |
|||
} |
|||
|
|||
use C4::Context; |
|||
use C4::Dates qw/format_date/; |
|||
use C4::Debug; |
|||
use C4::Letters; |
|||
|
|||
use Getopt::Long; |
|||
use Pod::Usage; |
|||
use Text::CSV_XS; |
|||
|
|||
=head1 NAME |
|||
|
|||
overdue_notices.pl - prepare messages to be sent to patrons for overdue items |
|||
|
|||
=head1 SYNOPSIS |
|||
|
|||
overdue_notices.pl [ -n ] [ -library <branchcode> ] [ -max <number of days> ] [ -csv [ <filename> ] ] [ -itemscontent <field list> ] |
|||
|
|||
Options: |
|||
-help brief help message |
|||
-man full documentation |
|||
-n No email will be sent |
|||
-max <days> maximum days overdue to deal with |
|||
-library <branchname> only deal with overdues from this library |
|||
-csv <filename> populate CSV file |
|||
-itemscontent <list of fields> item information in templates |
|||
|
|||
=head1 OPTIONS |
|||
|
|||
=over 8 |
|||
|
|||
=item B<-help> |
|||
|
|||
Print a brief help message and exits. |
|||
|
|||
=item B<-man> |
|||
|
|||
Prints the manual page and exits. |
|||
|
|||
=item B<-v> |
|||
|
|||
Verbose. Without this flag set, only fatal errors are reported. |
|||
|
|||
=item B<-n> |
|||
|
|||
Do not send any email. Overdue notices that would have been sent to |
|||
the patrons or to the admin are printed to standard out. CSV data (if |
|||
the -csv flag is set) is written to standard out or to any csv |
|||
filename given. |
|||
|
|||
=item B<-max> |
|||
|
|||
Items older than max days are assumed to be handled somewhere else, |
|||
probably the F<longoverdues.pl> script. They are therefore ignored by |
|||
this program. No notices are sent for them, and they are not added to |
|||
any CSV files. Defaults to 90 to match F<longoverdues.pl>. |
|||
|
|||
=item B<-library> |
|||
|
|||
select overdues for one specific library. Use the value in the |
|||
branches.branchcode table. |
|||
|
|||
=item B<-csv> |
|||
|
|||
Produces CSV data. if -n (no mail) flag is set, then this CSV data is |
|||
sent to standard out or to a filename if provided. Otherwise, only |
|||
overdues that could not be emailed are sent in CSV format to the admin. |
|||
|
|||
=item B<-itemscontent> |
|||
|
|||
comma separated list of fields that get substituted into templates in |
|||
places of the E<lt>E<lt>items.contentE<gt>E<gt> placeholder. This |
|||
defaults to issuedate,title,barcode,author |
|||
|
|||
Other possible values come from fields in the biblios, items, and |
|||
issues tables. |
|||
|
|||
=back |
|||
|
|||
=head1 DESCRIPTION |
|||
|
|||
This script is designed to alert patrons and administrators of overdue |
|||
items. |
|||
|
|||
=head2 Configuration |
|||
|
|||
This script pays attention to the overdue notice configuration |
|||
performed in the "Overdue notice/status triggers" section of the |
|||
"Tools" area of the staff interface to Koha. There, you can choose |
|||
which letter templates are sent out after a configurable number of |
|||
days to patrons of each library. More information about the use of this |
|||
section of Koha is available in the Koha manual. |
|||
|
|||
The templates used to craft the emails are defined in the "Tools: |
|||
Notices" section of the staff interface to Koha. |
|||
|
|||
=head2 Outgoing emails |
|||
|
|||
Typically, messages are prepared for each patron with overdue |
|||
items. Messages for whom there is no email address on file are |
|||
collected and sent as attachments in a single email to each library |
|||
administrator, or if that is not set, then to the email address in the |
|||
C<KohaAdminEmailAddress> system preference. |
|||
|
|||
These emails are staged in the outgoing message queue, as are messages |
|||
produced by other features of Koha. This message queue must be |
|||
processed regularly by the |
|||
F<misc/cronjobs/process_message_queue.pl> program. |
|||
|
|||
In the event that the C<-n> flag is passed to this program, no emails |
|||
are sent. Instead, messages are sent on standard output from this |
|||
program. They may be redirected to a file if desired. |
|||
|
|||
=head2 Templates |
|||
|
|||
Templates can contain variables enclosed in double angle brackets like |
|||
E<lt>E<lt>thisE<gt>E<gt>. Those variables will be replaced with values |
|||
specific to the overdue items or relevant patron. Available variables |
|||
are: |
|||
|
|||
=over |
|||
|
|||
=item E<lt>E<lt>bibE<gt>E<gt> |
|||
|
|||
the name of the library |
|||
|
|||
=item E<lt>E<lt>items.contentE<gt>E<gt> |
|||
|
|||
one line for each item, each line containing a tab separated list of |
|||
title, author, barcode, issuedate |
|||
|
|||
=item E<lt>E<lt>borrowers.*E<gt>E<gt> |
|||
|
|||
any field from the borrowers table |
|||
|
|||
=item E<lt>E<lt>branches.*E<gt>E<gt> |
|||
|
|||
any field from the branches table |
|||
|
|||
=back |
|||
|
|||
=head2 CSV output |
|||
|
|||
The C<-csv> command line option lets you specify a file to which |
|||
overdues data should be output in CSV format. |
|||
|
|||
With the C<-n> flag set, data about all overdues is written to the |
|||
file. Without that flag, only information about overdues that were |
|||
unable to be sent directly to the patrons will be written. In other |
|||
words, this CSV file replaces the data that is typically sent to the |
|||
administrator email address. |
|||
|
|||
=head1 USAGE EXAMPLES |
|||
|
|||
C<overdue_notices.pl> - In this most basic usage, with no command line |
|||
arguments, all libraries are procesed individually, and notices are |
|||
prepared for all patrons with overdue items for whom we have email |
|||
addresses. Messages for those patrons for whom we have no email |
|||
address are sent in a single attachment to the library administrator's |
|||
email address, or to the address in the KohaAdminEmailAddress system |
|||
preference. |
|||
|
|||
C<overdue_notices.pl -n -csv /tmp/overdues.csv> - sends no email and |
|||
populates F</tmp/overdues.csv> with information about all overdue |
|||
items. |
|||
|
|||
C<overdue_notices.pl -library MAIN max 14> - prepare notices of |
|||
overdues in the last 2 weeks for the MAIN library. |
|||
|
|||
=head1 SEE ALSO |
|||
|
|||
The F<misc/cronjobs/advance_notices.pl> program allows you to send |
|||
messages to patrons in advance of thier items becoming due, or to |
|||
alert them of items that have just become due. |
|||
|
|||
=cut |
|||
|
|||
# These variables are set by command line options. |
|||
# They are initially set to default values. |
|||
my $help = 0; |
|||
my $man = 0; |
|||
my $verbose = 0; |
|||
my $nomail = 0; |
|||
my $MAX = 90; |
|||
my $mybranch; |
|||
my $csvfilename; |
|||
my $itemscontent = join( ',', qw( issuedate title barcode author ) ); |
|||
|
|||
GetOptions( |
|||
'help|?' => \$help, |
|||
'man' => \$man, |
|||
'v' => \$verbose, |
|||
'n' => \$nomail, |
|||
'max=s' => \$MAX, |
|||
'library=s' => \$mybranch, |
|||
'csv:s' => \$csvfilename, # this optional argument gets '' if not supplied. |
|||
'itemscontent=s' => \$itemscontent, |
|||
) or pod2usage(2); |
|||
pod2usage(1) if $help; |
|||
pod2usage( -verbose => 2 ) if $man; |
|||
|
|||
if ( defined $csvfilename && $csvfilename =~ /^-/ ) { |
|||
warn qq(using "$csvfilename" as filename, that seems odd); |
|||
} |
|||
|
|||
my @branches = C4::Overdues::GetBranchcodesWithOverdueRules(); |
|||
my $branchcount = scalar(@branches); |
|||
if ($branchcount) { |
|||
my $branch_word = scalar @branches > 1 ? 'branches' : 'branch'; |
|||
$verbose and warn "Found $branchcount $branch_word with first message enabled: " . join( ', ', map { "'$_'" } @branches ), "\n"; |
|||
} else { |
|||
die 'No branches with active overduerules'; |
|||
} |
|||
|
|||
if ($mybranch) { |
|||
$verbose and warn "Branch $mybranch selected\n"; |
|||
if ( scalar grep { $mybranch eq $_ } @branches ) { |
|||
@branches = ($mybranch); |
|||
} else { |
|||
$verbose and warn "No active overduerules for branch '$mybranch'\n"; |
|||
( scalar grep { '' eq $_ } @branches ) |
|||
or die "No active overduerules for DEFAULT either!"; |
|||
$verbose and warn "Falling back on default rules for $mybranch\n"; |
|||
@branches = (''); |
|||
} |
|||
} |
|||
|
|||
# these are the fields that will be substituted into <<item.content>> |
|||
my @item_content_fields = split( /,/, $itemscontent ); |
|||
|
|||
my $dbh = C4::Context->dbh(); |
|||
|
|||
our $csv; # the Text::CSV_XS object |
|||
our $csv_fh; # the filehandle to the CSV file. |
|||
if ( defined $csvfilename ) { |
|||
$csv = Text::CSV_XS->new( { binary => 1 } ); |
|||
if ( $csvfilename eq '' ) { |
|||
$csv_fh = *STDOUT; |
|||
} else { |
|||
open $csv_fh, ">", $csvfilename or die "unable to open $csvfilename: $!"; |
|||
} |
|||
if ( $csv->combine(qw(name surname address1 address2 zipcode city email itemcount itemsinfo)) ) { |
|||
print $csv_fh $csv->string, "\n"; |
|||
} else { |
|||
$verbose and warn 'combine failed on argument: ' . $csv->error_input; |
|||
} |
|||
} |
|||
|
|||
foreach my $branchcode (@branches) { |
|||
|
|||
my $branch_details = C4::Branch::GetBranchDetail($branchcode); |
|||
my $admin_email_address = $branch_details->{'branchemail'} || C4::Context->preference('KohaAdminEmailAddress'); |
|||
my @output_chunks; # may be sent to mail or stdout or csv file. |
|||
|
|||
$verbose and warn sprintf "branchcode : '%s' using %s\n", $branchcode, $admin_email_address; |
|||
|
|||
my $sth2 = $dbh->prepare( <<'END_SQL' ); |
|||
SELECT biblio.*, items.*, issues.* |
|||
FROM issues,items,biblio |
|||
WHERE items.itemnumber=issues.itemnumber |
|||
AND biblio.biblionumber = items.biblionumber |
|||
AND issues.borrowernumber = ? |
|||
AND TO_DAYS(NOW())-TO_DAYS(date_due) BETWEEN ? and ? |
|||
END_SQL |
|||
|
|||
my $rqoverduerules = $dbh->prepare("SELECT * FROM overduerules WHERE delay1 IS NOT NULL AND branchcode = ? "); |
|||
$rqoverduerules->execute($branchcode); |
|||
my $outfile = 'overdues_' . ( $mybranch || $branchcode || 'default' ); |
|||
while ( my $overdue_rules = $rqoverduerules->fetchrow_hashref ) { |
|||
PERIOD: foreach my $i ( 1 .. 3 ) { |
|||
|
|||
$verbose and warn "branch '$branchcode', pass $i\n"; |
|||
my $mindays = $overdue_rules->{"delay$i"}; # the notice will be sent after mindays days (grace period) |
|||
my $maxdays = ( |
|||
$overdue_rules->{ "delay" . ( $i + 1 ) } |
|||
? $overdue_rules->{ "delay" . ( $i + 1 ) } |
|||
: ($MAX) |
|||
); # issues being more than maxdays late are managed somewhere else. (borrower probably suspended) |
|||
|
|||
if ( !$overdue_rules->{"letter$i"} ) { |
|||
$verbose and warn "No letter$i code for branch '$branchcode'"; |
|||
next PERIOD; |
|||
} |
|||
|
|||
# $letter->{'content'} is the text of the mail that is sent. |
|||
# this text contains fields that are replaced by their value. Those fields must be written between brackets |
|||
# The following fields are available : |
|||
# <date> <itemcount> <firstname> <lastname> <address1> <address2> <address3> <city> <postcode> |
|||
|
|||
my $borrower_sql = <<'END_SQL'; |
|||
SELECT COUNT(*), issues.borrowernumber, firstname, surname, address, address2, city, zipcode, email, MIN(date_due) as longest_issue |
|||
FROM issues,borrowers,categories |
|||
WHERE issues.borrowernumber=borrowers.borrowernumber |
|||
AND borrowers.categorycode=categories.categorycode |
|||
END_SQL |
|||
my @borrower_parameters; |
|||
if ($branchcode) { |
|||
$borrower_sql .= ' AND issues.branchcode=? '; |
|||
push @borrower_parameters, $branchcode; |
|||
} |
|||
if ( $overdue_rules->{categorycode} ) { |
|||
$borrower_sql .= ' AND borrowers.categorycode=? '; |
|||
push @borrower_parameters, $overdue_rules->{categorycode}; |
|||
} |
|||
$borrower_sql .= <<'END_SQL'; |
|||
AND categories.overduenoticerequired=1 |
|||
GROUP BY issues.borrowernumber |
|||
HAVING TO_DAYS(NOW())-TO_DAYS(longest_issue) BETWEEN ? and ? |
|||
END_SQL |
|||
push @borrower_parameters, $mindays, $maxdays; |
|||
my $sth = $dbh->prepare($borrower_sql); |
|||
$sth->execute(@borrower_parameters); |
|||
$verbose and warn $borrower_sql . "\n\n ($mindays, $maxdays)\nreturns " . $sth->rows . " rows"; |
|||
|
|||
while ( my ( $itemcount, $borrowernumber, $firstname, $lastname, $address1, $address2, $city, $postcode, $email ) = $sth->fetchrow ) { |
|||
warn "borrower $firstname, $lastname ($borrowernumber) has $itemcount items overdue." if $verbose; |
|||
|
|||
my $letter = C4::Letters::getletter( 'circulation', $overdue_rules->{"letter$i"} ); |
|||
unless ($letter) { |
|||
$verbose and warn "Message '$overdue_rules->{letter$i}' content not found"; |
|||
|
|||
# might as well skip while PERIOD, no other borrowers are going to work. |
|||
next PERIOD; |
|||
} |
|||
|
|||
if ( $overdue_rules->{"debarred$i"} ) { |
|||
|
|||
#action taken is debarring |
|||
C4::Members::DebarMember($borrowernumber); |
|||
$verbose and warn "debarring $borrowernumber $firstname $lastname\n"; |
|||
} |
|||
|
|||
$sth2->execute( $borrowernumber, $mindays, $maxdays ); |
|||
my $titles = ""; |
|||
while ( my $item_info = $sth2->fetchrow_hashref() ) { |
|||
my @item_info = map { $_ =~ /date$/ ? format_date( $item_info->{$_} ) : $item_info->{$_} || '' } @item_content_fields; |
|||
$titles .= join "\t", @item_info; |
|||
} |
|||
$sth2->finish; |
|||
|
|||
$letter = parse_letter( |
|||
{ letter => $letter, |
|||
borrowernumber => $borrowernumber, |
|||
branchcode => $branchcode, |
|||
substitute => { |
|||
bib => $branch_details->{'branchname'}, |
|||
'items.content' => $titles |
|||
} |
|||
} |
|||
); |
|||
|
|||
my @misses = grep { /./ } map { /^([^>]*)[>]+/; ( $1 || '' ); } split /\</, $letter->{'content'}; |
|||
if (@misses) { |
|||
$verbose and warn "The following terms were not matched and replaced: \n\t" . join "\n\t", @misses; |
|||
} |
|||
$letter->{'content'} =~ s/\<[^<>]*?\>//g; # Now that we've warned about them, remove them. |
|||
$letter->{'content'} =~ s/\<[^<>]*?\>//g; # 2nd pass for the double nesting. |
|||
|
|||
if ($nomail) { |
|||
|
|||
push @output_chunks, |
|||
prepare_letter_for_printing( |
|||
{ letter => $letter, |
|||
borrowernumber => $borrowernumber, |
|||
firstname => $firstname, |
|||
lastname => $lastname, |
|||
address1 => $address1, |
|||
address2 => $address2, |
|||
city => $city, |
|||
postcode => $postcode, |
|||
email => $email, |
|||
itemcount => $itemcount, |
|||
titles => $titles, |
|||
outputformat => defined $csvfilename ? 'csv' : '', |
|||
} |
|||
); |
|||
} else { |
|||
if ($email) { |
|||
C4::Letters::EnqueueLetter( |
|||
{ letter => $letter, |
|||
borrowernumber => $borrowernumber, |
|||
message_transport_type => 'email', |
|||
from_address => $admin_email_address, |
|||
} |
|||
); |
|||
} else { |
|||
|
|||
# If we don't have an email address for this patron, send it to the admin to deal with. |
|||
push @output_chunks, |
|||
prepare_letter_for_printing( |
|||
{ letter => $letter, |
|||
borrowernumber => $borrowernumber, |
|||
firstname => $firstname, |
|||
lastname => $lastname, |
|||
address1 => $address1, |
|||
address2 => $address2, |
|||
city => $city, |
|||
postcode => $postcode, |
|||
email => $email, |
|||
itemcount => $itemcount, |
|||
titles => $titles, |
|||
outputformat => defined $csvfilename ? 'csv' : '', |
|||
} |
|||
); |
|||
} |
|||
} |
|||
|
|||
} |
|||
$sth->finish; |
|||
} |
|||
} |
|||
|
|||
if (@output_chunks) { |
|||
if ($nomail) { |
|||
if ( defined $csvfilename ) { |
|||
print $csv_fh @output_chunks; |
|||
} else { |
|||
local $, = "\f"; # pagebreak |
|||
print @output_chunks; |
|||
} |
|||
} else { |
|||
my $attachment = { |
|||
filename => defined $csvfilename ? 'attachment.csv' : 'attachment.txt', |
|||
type => 'text/plain', |
|||
content => join( "\n", @output_chunks ) |
|||
}; |
|||
|
|||
my $letter = { |
|||
title => 'Overdue Notices', |
|||
content => 'These messages were not sent directly to the patrons.', |
|||
}; |
|||
C4::Letters::EnqueueLetter( |
|||
{ letter => $letter, |
|||
borrowernumber => undef, |
|||
message_transport_type => 'email', |
|||
attachments => [$attachment], |
|||
to_address => $admin_email_address, |
|||
} |
|||
); |
|||
} |
|||
} |
|||
|
|||
} |
|||
if ($csvfilename) { |
|||
|
|||
# note that we're not testing on $csv_fh to prevent closing |
|||
# STDOUT. |
|||
close $csv_fh; |
|||
} |
|||
|
|||
=head1 INTERNAL METHODS |
|||
|
|||
These methods are internal to the operation of overdue_notices.pl. |
|||
|
|||
=head2 parse_letter |
|||
|
|||
parses the letter template, replacing the placeholders with data |
|||
specific to this patron, biblio, or item |
|||
|
|||
named parameters: |
|||
letter - required hashref |
|||
borrowernumber - required integer |
|||
substitute - optional hashref of other key/value pairs that should |
|||
be substituted in the letter content |
|||
|
|||
returns the C<letter> hashref, with the content updated to reflect the |
|||
substituted keys and values. |
|||
|
|||
|
|||
=cut |
|||
|
|||
sub parse_letter { |
|||
my $params = shift; |
|||
foreach my $required (qw( letter borrowernumber )) { |
|||
return unless exists $params->{$required}; |
|||
} |
|||
|
|||
if ( $params->{'substitute'} ) { |
|||
while ( my ( $key, $replacedby ) = each %{ $params->{'substitute'} } ) { |
|||
my $replacefield = "<<$key>>"; |
|||
|
|||
$params->{'letter'}->{title} =~ s/$replacefield/$replacedby/g; |
|||
$params->{'letter'}->{content} =~ s/$replacefield/$replacedby/g; |
|||
} |
|||
} |
|||
|
|||
C4::Letters::parseletter( $params->{'letter'}, 'borrowers', $params->{'borrowernumber'} ); |
|||
|
|||
if ( $params->{'branchcode'} ) { |
|||
C4::Letters::parseletter( $params->{'letter'}, 'branches', $params->{'branchcode'} ); |
|||
} |
|||
|
|||
if ( $params->{'biblionumber'} ) { |
|||
C4::Letters::parseletter( $params->{'letter'}, 'biblio', $params->{'biblionumber'} ); |
|||
C4::Letters::parseletter( $params->{'letter'}, 'biblioitems', $params->{'biblionumber'} ); |
|||
} |
|||
|
|||
return $params->{'letter'}; |
|||
} |
|||
|
|||
=head2 prepare_letter_for_printing |
|||
|
|||
returns a string of text appropriate for printing in the event that an |
|||
overdue notice will not be sent to the patron's email |
|||
address. Depending on the desired output format, this may be a CSV |
|||
string, or a human-readable representation of the notice. |
|||
|
|||
required parameters: |
|||
letter |
|||
borrowernumber |
|||
|
|||
optional parameters: |
|||
outputformat |
|||
|
|||
=cut |
|||
|
|||
sub prepare_letter_for_printing { |
|||
my $params = shift; |
|||
|
|||
return unless ref $params eq 'HASH'; |
|||
|
|||
foreach my $required_parameter (qw( letter borrowernumber )) { |
|||
return unless defined $params->{$required_parameter}; |
|||
} |
|||
|
|||
my $return; |
|||
if ( exists $params->{'outputformat'} && $params->{'outputformat'} eq 'csv' ) { |
|||
if ($csv->combine( |
|||
$params->{'firstname'}, $params->{'lastname'}, $params->{'address1'}, $params->{'address2'}, $params->{'postcode'}, |
|||
$params->{'city'}, $params->{'email'}, $params->{'itemcount'}, $params->{'items.content'} |
|||
) |
|||
) { |
|||
return $csv->string, "\n"; |
|||
} else { |
|||
$verbose and warn 'combine failed on argument: ' . $csv->error_input; |
|||
} |
|||
} else { |
|||
$return .= "$params->{'letter'}->{'content'}\n"; |
|||
|
|||
# $return .= Data::Dumper->Dump( [ $params->{'borrowernumber'}, $params->{'letter'} ], [qw( borrowernumber letter )] ); |
|||
} |
|||
return $return; |
|||
} |
|||
|
|||
@ -0,0 +1,44 @@ |
|||
package KohaTest::Members::DebarMember; |
|||
use base qw( KohaTest::Members ); |
|||
|
|||
use strict; |
|||
use warnings; |
|||
|
|||
use Test::More; |
|||
|
|||
use C4::Members; |
|||
sub testing_class { 'C4::Members' }; |
|||
|
|||
|
|||
sub simple_usage : Test( 6 ) { |
|||
my $self = shift; |
|||
|
|||
ok( $self->{'memberid'}, 'we have a valid memberid to test with' ); |
|||
|
|||
my $details = C4::Members::GetMemberDetails( $self->{'memberid'} ); |
|||
ok( exists $details->{'flags'}, 'member details has a "flags" attribute'); |
|||
isa_ok( $details->{'flags'}, 'HASH', 'the "flags" attribute is a hashref'); |
|||
ok( ! $details->{'flags'}->{'DBARRED'}, 'this member is NOT debarred' ); |
|||
|
|||
# Now, let's debar this member and see what happens |
|||
my $success = C4::Members::DebarMember( $self->{'memberid'} ); |
|||
|
|||
ok( $success, 'we were able to debar the member' ); |
|||
|
|||
$details = C4::Members::GetMemberDetails( $self->{'memberid'} ); |
|||
ok( $details->{'flags'}->{'DBARRED'}, 'this member is debarred now' ) |
|||
or diag( Data::Dumper->Dump( [ $details->{'flags'} ], [ 'flags' ] ) ); |
|||
} |
|||
|
|||
sub incorrect_usage : Test( 2 ) { |
|||
my $self = shift; |
|||
|
|||
my $result = C4::Members::DebarMember(); |
|||
ok( ! defined $result, 'DebarMember returns undef when passed no parameters' ); |
|||
|
|||
$result = C4::Members::DebarMember( 'this is not a borrowernumber' ); |
|||
ok( ! defined $result, 'DebarMember returns undef when not passed a numeric argument' ); |
|||
|
|||
} |
|||
|
|||
1; |
|||
@ -0,0 +1,59 @@ |
|||
package KohaTest::Overdues::GetBranchcodesWithOverdueRules; |
|||
use base qw( KohaTest::Overdues ); |
|||
|
|||
use strict; |
|||
use warnings; |
|||
|
|||
use C4::Overdues; |
|||
use Test::More; |
|||
|
|||
sub my_branch_has_no_rules : Tests( 2 ) { |
|||
my $self = shift; |
|||
|
|||
ok( $self->{'branchcode'}, "we're looking for branch $self->{'branchcode'}" ); |
|||
|
|||
my @branches = C4::Overdues::GetBranchcodesWithOverdueRules; |
|||
my @found_branches = grep { $_ eq $self->{'branchcode'} } @branches; |
|||
is( scalar @found_branches, 0, '...and it is not in the list of branches') |
|||
|
|||
} |
|||
|
|||
sub my_branch_has_overdue_rules : Tests( 3 ) { |
|||
my $self = shift; |
|||
|
|||
ok( $self->{'branchcode'}, "we're looking for branch $self->{'branchcode'}" ); |
|||
|
|||
my $dbh = C4::Context->dbh(); |
|||
my $sql = <<'END_SQL'; |
|||
INSERT INTO overduerules |
|||
(branchcode, categorycode, |
|||
delay1, letter1, debarred1, |
|||
delay2, letter2, debarred2, |
|||
delay3, letter3, debarred3) |
|||
VALUES |
|||
( ?, ?, |
|||
?, ?, ?, |
|||
?, ?, ?, |
|||
?, ?, ?) |
|||
END_SQL |
|||
|
|||
my $sth = $dbh->prepare($sql); |
|||
my $success = $sth->execute( $self->{'branchcode'}, $self->random_string(2), |
|||
1, $self->random_string(), 0, |
|||
5, $self->random_string(), 0, |
|||
9, $self->random_string(), 1, ); |
|||
ok( $success, '...and we have successfully given it an overdue rule' ); |
|||
|
|||
my @branches = C4::Overdues::GetBranchcodesWithOverdueRules; |
|||
my @found_branches = grep { $_ eq $self->{'branchcode'} } @branches; |
|||
is( scalar @found_branches, 1, '...and it IS in the list of branches.') |
|||
|
|||
} |
|||
|
|||
1; |
|||
|
|||
|
|||
|
|||
|
|||
|
|||
|
|||
Loading…
Reference in new issue