Attachment #597 for bug #2274

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




    my $dbh = C4::Context->dbh();
    my $statement = << 'ENDSQL';
INSERT INTO message_queue
( borrowernumber, subject, content, message_transport_type, status, time_queued, to_address, from_address )
VALUES
( ?,              ?,       ?,       ?,                      ?,      NOW(),       ?,          ? )
ENDSQL

    my $sth = $dbh->prepare( $statement );
    my $result = $sth->execute(
        $params->{'borrowernumber'},            # borrowernumber
        $params->{'letter'}->{'title'},         # subject
        $params->{'letter'}->{'content'},       # content
        $params->{'message_transport_type'},    # message_transport_type
        'pending',                              # status
        $params->{'to_address'},                # to_address
        $params->{'from_address'},              # from_address
    );
    return $result;
}


    my $member = C4::Members::GetMember( $message->{'borrowernumber'} );
    return unless $member->{'email'};

    my $success = sendmail(
        To   => $message->{'to_address'}   || $member->{'email'},
        From => $message->{'from_address'} || C4::Context->preference('KohaAdminEmailAddress'),
        Subject => $message->{'subject'},
        Message => $message->{'content'},
    );
    if ( $success ) {
        # warn "OK. Log says:\n", $Mail::Sendmail::log;
        _set_message_status( { message_id => $message->{'message_id'},

Lines 594-603 sub GetMemberIssuesAndFines { Link Here

(-)a/C4/Members.pm (-2 / +42 lines)
594		594
595	=head2 ModMember	595	=head2 ModMember
596		596
597	&ModMember($borrowernumber);	597	=over 4
		598
		599	my $success = ModMember(borrowernumber => $borrowernumber, [ field => value ]... );
598		600
599	Modify borrower's data. All date fields should ALREADY be in ISO format.	601	Modify borrower's data. All date fields should ALREADY be in ISO format.
600		602
		603	return :
		604	true on success, or false on failure
		605
		606	=back
		607
601	=cut	608	=cut
602		609
603	#'	610	#'
Lines 647-653 sub ModMember { Link Here
647	push @parameters, $data{'borrowernumber'};	654	push @parameters, $data{'borrowernumber'};
648	$debug and print STDERR "$query (executed w/ arg: $data{'borrowernumber'})";	655	$debug and print STDERR "$query (executed w/ arg: $data{'borrowernumber'})";
649	$sth = $dbh->prepare($query);	656	$sth = $dbh->prepare($query);
650	$sth->execute(@parameters);	657	my $execute_success = $sth->execute(@parameters);
651	$sth->finish;	658	$sth->finish;
652		659
653	# ok if its an adult (type) it may have borrowers that depend on it as a guarantor	660	# ok if its an adult (type) it may have borrowers that depend on it as a guarantor
Lines 660-665 sub ModMember { Link Here
660	}	667	}
661	logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "$query (executed w/ arg: $data{'borrowernumber'})")	668	logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "$query (executed w/ arg: $data{'borrowernumber'})")
662	if C4::Context->preference("BorrowersLog");	669	if C4::Context->preference("BorrowersLog");
		670
		671	return $execute_success;
663	}	672	}
664		673
665		674
Lines 2018-2023 sub GetBorrowersNamesAndLatestIssue { Link Here
2018	my $results = $sth->fetchall_arrayref({});	2027	my $results = $sth->fetchall_arrayref({});
2019	return $results;	2028	return $results;
2020	}	2029	}
		2030
		2031	=head2 DebarMember
		2032
		2033	=over 4
		2034
		2035	my $success = DebarMember( { borrowernumber => $borrowernumber } );
		2036
		2037	marks a Member as debarred, and therefore unable to checkout any more
		2038	items.
		2039
		2040	return :
		2041	true on success, false on failure
		2042
		2043	=back
		2044
		2045	=cut
		2046
		2047	sub DebarMember {
		2048	my $params = shift;
		2049
		2050	return unless ref $params eq 'HASH';
		2051
		2052	foreach my $required_parameter ( qw( borrowernumber ) ) {
		2053	return unless defined $params->{ $required_parameter };
		2054	}
		2055
		2056	return ModMember( borrowernumber => $params->{'borrowernumber'},
		2057	debarred => 1 );
		2058
		2059	}
		2060
2021	END { } # module clean-up code here (global destructor)	2061	END { } # module clean-up code here (global destructor)
2022		2062
2023	1;	2063	1;




#!/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 -c [ -n ] [ -branch MAIN ] [ -max 31 ]

 Options:
   -help                  brief help message
   -man                   full documentation
   -c                     Confirm that you have read the documentation
   -n                     No email will be sent
   -max    <days>         maximum days overdue to deal with
   -branch <branchname>   only deal with overdues from this branch.
   -csv    <filename>     populate CSV file

=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<-c>

Confirms that you have read the documentation and want the script to actually do something

=item B<-n>

Do not send any email. The overdue notices are printed to standard out in this case.

=item B<-max>

Items older than max days are handled somewhere else, probably borrower suspended. Defaults to 365.

=item B<-branch>

select overdues for one specific branch

=item B<-csv>

populate CSV file with overdues information. If -n (no mail) is
selected, all overdues are put in file, otherwise, only overdues that
could not be emailed are sent.

=back

=head1 DESCRIPTION

This script will send overdue notices by e-mail and prepare a file of
notices for printing if the borrower does not have e-mail.

=cut

# These variables are set by command line options.
# They are initially set to default values.
my $help    = 0;
my $man     = 0;
my $confirm = 0;     # set to 1 to avoid the warning
my $nomail  = 0;
my $MAX     = 365;
my $mybranch;
my $csvfilename;

GetOptions(
    'help|?'   => \$help,
    'man'      => \$man,
    'c'        => \$confirm,
    'n'        => \$nomail,
    'max=s'    => \$MAX,
    'branch=s' => \$mybranch,
    'csv=s'    => \$csvfilename,
) or pod2usage(2);
pod2usage(1) if $help;
pod2usage( -verbose => 2 ) if $man;

unless ($confirm) {
    print <<'END_WARNING';
WARNING: You MUST edit this script for your library BEFORE you run it for the first time!
See the comments in the script for directions on changing the script.

Do you wish to continue? (y/[n])
END_WARNING

    chomp( $_ = <STDIN> );
    unless (/^\s*[yo]/i) {
        print "Exiting.\n";
        exit;
    }
}

my @branches    = get_branches_with_overdue_rules();
my $branchcount = scalar(@branches);
if ($branchcount) {
    my $branch_word = scalar @branches > 1 ? 'branches' : 'branch';
    print "Found $branchcount $branch_word with first message enabled: " . join( ', ', map { "'$_'" } @branches ), "\n";
} else {
    die 'No branches with active overduerules';
}

if ($mybranch) {
    warn "Branch $mybranch selected\n";
    if ( scalar grep { $mybranch eq $_ } @branches ) {
        @branches = ($mybranch);
    } else {
        warn "No active overduerules for branch '$mybranch'\n";
        ( scalar grep { '' eq $_ } @branches )
          or die "No active overduerules for DEFAULT either!";
        warn "Falling back on default rules for $mybranch\n";
        @branches = ('');
    }
}

my $dbh = C4::Context->dbh();

our $csv;       # the Text::CSV_XS object
our $csv_fh;    # the filehandle to the CSV file.
if ($csvfilename) {
    $csv = Text::CSV_XS->new( { binary => 1 } );
    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 {
        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');

    warn sprintf "branchcode : '%s' using %s\n", $branchcode, $admin_email_address;

    my $sth2 = $dbh->prepare( <<'END_SQL' );
SELECT biblio.title, biblio.author, items.barcode, issues.timestamp
  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 ) {

            $debug 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)

            my $letter;
            if ( $overdue_rules->{"letter$i"} ) {
                $letter = C4::Letters::getletter( 'circulation', $overdue_rules->{"letter$i"} );
                unless ($letter) {
                    warn "Message '$overdue_rules->{letter$i}' content not found";
                    next PERIOD;
                }
            } else {
                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);
            $debug and warn $borrower_sql . "\n\n ($mindays, $maxdays)\nreturns " . $sth->rows . " rows";
            my $count   = 0;                          # to keep track of how many notices are printed
            my $e_count = 0;                          # and e-mailed
            my $date    = C4::Dates->new()->output;

            while ( my ( $itemcount, $borrowernumber, $firstname, $lastname, $address1, $address2, $city, $postcode, $email ) = $sth->fetchrow ) {
                if ( $overdue_rules->{"debarred$i"} ) {

                    #action taken is debarring
                    C4::Members::DebarMember( { borrowernumber => $borrowernumber } );
                    warn "debarring $borrowernumber $firstname $lastname\n";
                }

                $sth2->execute( $borrowernumber, $mindays, $maxdays );
                my $titles = "";
                while ( my ( $title, $author, $barcode, $issuedate ) = $sth2->fetchrow ) {
                    $titles .= join "\t", format_date($issuedate), ( $barcode ? $barcode : "" ), ( $title ? $title : "" ), ( $author ? $author : "" ) . "\n";
                }
                $sth2->finish;

                $letter = parse_letter(
                    {   letter         => $letter,
                        borrowernumber => $borrowernumber,
                        branchcode     => $branchcode,
                        substitute     => {
                            date   => $date,
                            bib    => $branch_details->{'branchname'},
                            titles => $titles
                        }
                    }
                );

                my @misses = grep { /./ } map { /^([^>]*)[>]+/; ( $1 || '' ); } split /\</, $letter->{'content'};
                if (@misses) {
                    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) {

                    # print the mail to stdout
                    print_letter(
                        {   letter         => $letter,
                            borrowernumber => $borrowernumber,
                            firstname      => $firstname,
                            lastname       => $lastname,
                            address1       => $address1,
                            address2       => $address2,
                            city           => $city,
                            postcode       => $postcode,
                            email          => $email,
                            itemcount      => $itemcount,
                            titles         => $titles,
                            outputformat   => $csvfilename ? 'csv' : '',
                        }
                    );
                } else {
                    my $enqueue_parameters = {
                        letter                 => $letter,
                        borrowernumber         => $borrowernumber,
                        message_transport_type => 'email',
                        from_address           => $admin_email_address,
                    };

                    # If we don't have an email address for this patron, send it to the admin to deal with.
                    if ( !$email ) {
                        $enqueue_parameters->{'to_address'} = $admin_email_address;
                    }
                    C4::Letters::EnqueueLetter($enqueue_parameters);
                }
            }
            $sth->finish;
        }
    }
}

if ($csvfilename) {
    close $csv_fh;
}

=head1 INTERNAL METHODS

=head2 get_branches_with_overdue_rules

=cut

sub get_branches_with_overdue_rules {
    my $dbh               = C4::Context->dbh;
    my $rqoverduebranches = $dbh->prepare("SELECT DISTINCT branchcode FROM overduerules WHERE delay1 IS NOT NULL");
    $rqoverduebranches->execute;
    my @branches = map { shift @$_ } @{ $rqoverduebranches->fetchall_arrayref };
    $rqoverduebranches->finish;
    return @branches;
}

=head2 parse_letter



=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 print_letter

required parameters:
  letter
  borrowernumber

optional parameters:
  outputformat

=cut

sub print_letter {
    my $params = shift;

    return unless ref $params eq 'HASH';

    foreach my $required_parameter (qw( letter borrowernumber )) {
        return unless defined $params->{$required_parameter};
    }

    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->{'titles'}
            )
          ) {
            print $csv_fh $csv->string, "\n";
        } else {
            warn 'combine failed on argument: ' . $csv->error_input;
        }
    } else {
        print sprintf( 'To: "%s %s" <%s>', $params->{'firstname'}, $params->{'lastname'}, $params->{'email'} ), "\n";
        print "Subject: $params->{'letter'}->{'title'}\n\n";
        print "$params->{'letter'}->{'content'}\n";

        # print Data::Dumper->Dump( [ $params->{'borrowernumber'}, $params->{'letter'} ], [qw( borrowernumber letter )] );
    }

}





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( { borrowernumber => $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( $self->{'memberid'} );
    ok( ! defined $result, 'DebarMember returns undef when not passed a hashref' );

}

1;

Return to bug 2274

Lines 532-549 sub EnqueueLetter { Link Here

(-)a/C4/Letters.pm (-13 / +17 lines)
532	my $dbh = C4::Context->dbh();	532	my $dbh = C4::Context->dbh();
533	my $statement = << 'ENDSQL';	533	my $statement = << 'ENDSQL';
534	INSERT INTO message_queue	534	INSERT INTO message_queue
535	( borrowernumber, subject, content, message_transport_type, status, time_queued )	535	( borrowernumber, subject, content, message_transport_type, status, time_queued, to_address, from_address )
536	VALUES	536	VALUES
537	( ?, ?, ?, ?, ?, NOW() )	537	( ?, ?, ?, ?, ?, NOW(), ?, ? )
538	ENDSQL	538	ENDSQL
539		539
540	my $sth = $dbh->prepare( $statement );	540	my $sth = $dbh->prepare( $statement );
541	my $result = $sth->execute( $params->{'borrowernumber'}, # borrowernumber	541	my $result = $sth->execute(
542	$params->{'letter'}->{'title'}, # subject	542	$params->{'borrowernumber'}, # borrowernumber
543	$params->{'letter'}->{'content'}, # content	543	$params->{'letter'}->{'title'}, # subject
544	$params->{'message_transport_type'}, # message_transport_type	544	$params->{'letter'}->{'content'}, # content
545	'pending', # status	545	$params->{'message_transport_type'}, # message_transport_type
546	);	546	'pending', # status
		547	$params->{'to_address'}, # to_address
		548	$params->{'from_address'}, # from_address
		549	);
547	return $result;	550	return $result;
548	}	551	}
549		552
Lines 690-700 sub _send_message_by_email { Link Here
690	my $member = C4::Members::GetMember( $message->{'borrowernumber'} );	693	my $member = C4::Members::GetMember( $message->{'borrowernumber'} );
691	return unless $member->{'email'};	694	return unless $member->{'email'};
692		695
693	my $success = sendmail( To => $member->{'email'},	696	my $success = sendmail(
694	From => C4::Context->preference('KohaAdminEmailAddress'),	697	To => $message->{'to_address'} \|\| $member->{'email'},
695	Subject => $message->{'subject'},	698	From => $message->{'from_address'} \|\| C4::Context->preference('KohaAdminEmailAddress'),
696	Message => $message->{'content'},	699	Subject => $message->{'subject'},
697	);	700	Message => $message->{'content'},
		701	);
698	if ( $success ) {	702	if ( $success ) {
699	# warn "OK. Log says:\n", $Mail::Sendmail::log;	703	# warn "OK. Log says:\n", $Mail::Sendmail::log;
700	_set_message_status( { message_id => $message->{'message_id'},	704	_set_message_status( { message_id => $message->{'message_id'},

Line 0 Link Here

(-)a/misc/cronjobs/overdue_notices.pl (+414 lines)
		1	#!/usr/bin/perl -w
		2
		3	# Copyright 2008 Liblime
		4	#
		5	# This file is part of Koha.
		6	#
		7	# Koha is free software; you can redistribute it and/or modify it under the
		8	# terms of the GNU General Public License as published by the Free Software
		9	# Foundation; either version 2 of the License, or (at your option) any later
		10	# version.
		11	#
		12	# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
		13	# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
		14	# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
		15	#
		16	# You should have received a copy of the GNU General Public License along with
		17	# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
		18	# Suite 330, Boston, MA 02111-1307 USA
		19
		20	use strict;
		21	use warnings;
		22
		23	BEGIN {
		24
		25	# find Koha's Perl modules
		26	# test carefully before changing this
		27	use FindBin;
		28	eval { require "$FindBin::Bin/../kohalib.pl" };
		29	}
		30
		31	use C4::Context;
		32	use C4::Dates qw/format_date/;
		33	use C4::Debug;
		34	use C4::Letters;
		35
		36	use Getopt::Long;
		37	use Pod::Usage;
		38	use Text::CSV_XS;
		39
		40	=head1 NAME
		41
		42	overdue_notices.pl - prepare messages to be sent to patrons for overdue items
		43
		44	=head1 SYNOPSIS
		45
		46	overdue_notices.pl -c [ -n ] [ -branch MAIN ] [ -max 31 ]
		47
		48	Options:
		49	-help brief help message
		50	-man full documentation
		51	-c Confirm that you have read the documentation
		52	-n No email will be sent
		53	-max <days> maximum days overdue to deal with
		54	-branch <branchname> only deal with overdues from this branch.
		55	-csv <filename> populate CSV file
		56
		57	=head1 OPTIONS
		58
		59	=over 8
		60
		61	=item B<-help>
		62
		63	Print a brief help message and exits.
		64
65	=item B<-man>
66
67	Prints the manual page and exits.
68
69	=item B<-c>
70
71	Confirms that you have read the documentation and want the script to actually do something
72
73	=item B<-n>
74
75	Do not send any email. The overdue notices are printed to standard out in this case.
76
77	=item B<-max>
78
79	Items older than max days are handled somewhere else, probably borrower suspended. Defaults to 365.
80
81	=item B<-branch>
82
83	select overdues for one specific branch
84
85	=item B<-csv>
86
87	populate CSV file with overdues information. If -n (no mail) is
88	selected, all overdues are put in file, otherwise, only overdues that
89	could not be emailed are sent.
90
91	=back
92
93	=head1 DESCRIPTION
94
95	This script will send overdue notices by e-mail and prepare a file of
96	notices for printing if the borrower does not have e-mail.
97
98	=cut
99
100	# These variables are set by command line options.
101	# They are initially set to default values.
102	my $help = 0;
103	my $man = 0;
104	my $confirm = 0; # set to 1 to avoid the warning
105	my $nomail = 0;
106	my $MAX = 365;
107	my $mybranch;
108	my $csvfilename;
109
110	GetOptions(
111	'help\|?' => \$help,
112	'man' => \$man,
113	'c' => \$confirm,
114	'n' => \$nomail,
115	'max=s' => \$MAX,
116	'branch=s' => \$mybranch,
117	'csv=s' => \$csvfilename,
118	) or pod2usage(2);
119	pod2usage(1) if $help;
120	pod2usage( -verbose => 2 ) if $man;
121
122	unless ($confirm) {
123	print <<'END_WARNING';
124	WARNING: You MUST edit this script for your library BEFORE you run it for the first time!
125	See the comments in the script for directions on changing the script.
126
127	Do you wish to continue? (y/[n])
128	END_WARNING
129
130	chomp( $_ = <STDIN> );
131	unless (/^\s*[yo]/i) {
132	print "Exiting.\n";
133	exit;
134	}
135	}
136
137	my @branches = get_branches_with_overdue_rules();
138	my $branchcount = scalar(@branches);
139	if ($branchcount) {
140	my $branch_word = scalar @branches > 1 ? 'branches' : 'branch';
141	print "Found $branchcount $branch_word with first message enabled: " . join( ', ', map { "'$_'" } @branches ), "\n";
142	} else {
143	die 'No branches with active overduerules';
144	}
145
146	if ($mybranch) {
147	warn "Branch $mybranch selected\n";
148	if ( scalar grep { $mybranch eq $_ } @branches ) {
149	@branches = ($mybranch);
150	} else {
151	warn "No active overduerules for branch '$mybranch'\n";
152	( scalar grep { '' eq $_ } @branches )
153	or die "No active overduerules for DEFAULT either!";
154	warn "Falling back on default rules for $mybranch\n";
155	@branches = ('');
156	}
157	}
158
159	my $dbh = C4::Context->dbh();
160
161	our $csv; # the Text::CSV_XS object
162	our $csv_fh; # the filehandle to the CSV file.
163	if ($csvfilename) {
164	$csv = Text::CSV_XS->new( { binary => 1 } );
165	open $csv_fh, ">", $csvfilename or die "unable to open $csvfilename: $!";
166	if ( $csv->combine(qw(name surname address1 address2 zipcode city email itemcount itemsinfo)) ) {
167	print $csv_fh $csv->string, "\n";
168	} else {
169	warn 'combine failed on argument: ' . $csv->error_input;
170	}
171
172	}
173
174	foreach my $branchcode (@branches) {
175
176	my $branch_details = C4::Branch::GetBranchDetail($branchcode);
177	my $admin_email_address = $branch_details->{'branchemail'} \|\| C4::Context->preference('KohaAdminEmailAddress');
178
179	warn sprintf "branchcode : '%s' using %s\n", $branchcode, $admin_email_address;
180
181	my $sth2 = $dbh->prepare( <<'END_SQL' );
182	SELECT biblio.title, biblio.author, items.barcode, issues.timestamp
183	FROM issues,items,biblio
184	WHERE items.itemnumber=issues.itemnumber
185	AND biblio.biblionumber = items.biblionumber
186	AND issues.borrowernumber = ?
187	AND TO_DAYS(NOW())-TO_DAYS(date_due) BETWEEN ? and ?
188	END_SQL
189
190	my $rqoverduerules = $dbh->prepare("SELECT * FROM overduerules WHERE delay1 IS NOT NULL AND branchcode = ? ");
191	$rqoverduerules->execute($branchcode);
192	my $outfile = 'overdues_' . ( $mybranch \|\| $branchcode \|\| 'default' );
193	while ( my $overdue_rules = $rqoverduerules->fetchrow_hashref ) {
194	PERIOD: foreach my $i ( 1 .. 3 ) {
195
196	$debug and warn "branch '$branchcode', pass $i\n";
197	my $mindays = $overdue_rules->{"delay$i"}; # the notice will be sent after mindays days (grace period)
198	my $maxdays = (
199	$overdue_rules->{ "delay" . ( $i + 1 ) }
200	? $overdue_rules->{ "delay" . ( $i + 1 ) }
201	: ($MAX)
202	); # issues being more than maxdays late are managed somewhere else. (borrower probably suspended)
203
204	my $letter;
205	if ( $overdue_rules->{"letter$i"} ) {
206	$letter = C4::Letters::getletter( 'circulation', $overdue_rules->{"letter$i"} );
207	unless ($letter) {
208	warn "Message '$overdue_rules->{letter$i}' content not found";
209	next PERIOD;
210	}
211	} else {
212	warn "No letter$i code for branch '$branchcode'";
213	next PERIOD;
214	}
215
216	# $letter->{'content'} is the text of the mail that is sent.
217	# this text contains fields that are replaced by their value. Those fields must be written between brackets
218	# The following fields are available :
219	# <date> <itemcount> <firstname> <lastname> <address1> <address2> <address3> <city> <postcode>
220
221	my $borrower_sql = <<'END_SQL';
222	SELECT COUNT(*), issues.borrowernumber, firstname, surname, address, address2, city, zipcode, email, MIN(date_due) as longest_issue
223	FROM issues,borrowers,categories
224	WHERE issues.borrowernumber=borrowers.borrowernumber
225	AND borrowers.categorycode=categories.categorycode
226	END_SQL
227	my @borrower_parameters;
228	if ($branchcode) {
229	$borrower_sql .= ' AND issues.branchcode=? ';
230	push @borrower_parameters, $branchcode;
231	}
232	if ( $overdue_rules->{categorycode} ) {
233	$borrower_sql .= ' AND borrowers.categorycode=? ';
234	push @borrower_parameters, $overdue_rules->{categorycode};
235	}
236	$borrower_sql .= <<'END_SQL';
237	AND categories.overduenoticerequired=1
238	GROUP BY issues.borrowernumber
239	HAVING TO_DAYS(NOW())-TO_DAYS(longest_issue) BETWEEN ? and ?
240	END_SQL
241	push @borrower_parameters, $mindays, $maxdays;
242	my $sth = $dbh->prepare($borrower_sql);
243	$sth->execute(@borrower_parameters);
244	$debug and warn $borrower_sql . "\n\n ($mindays, $maxdays)\nreturns " . $sth->rows . " rows";
245	my $count = 0; # to keep track of how many notices are printed
246	my $e_count = 0; # and e-mailed
247	my $date = C4::Dates->new()->output;
248
249	while ( my ( $itemcount, $borrowernumber, $firstname, $lastname, $address1, $address2, $city, $postcode, $email ) = $sth->fetchrow ) {
250	if ( $overdue_rules->{"debarred$i"} ) {
251
252	#action taken is debarring
253	C4::Members::DebarMember( { borrowernumber => $borrowernumber } );
254	warn "debarring $borrowernumber $firstname $lastname\n";
255	}
256
257	$sth2->execute( $borrowernumber, $mindays, $maxdays );
258	my $titles = "";
259	while ( my ( $title, $author, $barcode, $issuedate ) = $sth2->fetchrow ) {
260	$titles .= join "\t", format_date($issuedate), ( $barcode ? $barcode : "" ), ( $title ? $title : "" ), ( $author ? $author : "" ) . "\n";
261	}
262	$sth2->finish;
263
264	$letter = parse_letter(
265	{ letter => $letter,
266	borrowernumber => $borrowernumber,
267	branchcode => $branchcode,
268	substitute => {
269	date => $date,
270	bib => $branch_details->{'branchname'},
271	titles => $titles
272	}
273	}
274	);
275
276	my @misses = grep { /./ } map { /^([^>]*)[>]+/; ( $1 \|\| '' ); } split /\</, $letter->{'content'};
277	if (@misses) {
278	warn "The following terms were not matched and replaced: \n\t" . join "\n\t", @misses;
279	}
280	$letter->{'content'} =~ s/\<[^<>]*?\>//g; # Now that we've warned about them, remove them.
281	$letter->{'content'} =~ s/\<[^<>]*?\>//g; # 2nd pass for the double nesting.
282
283	if ($nomail) {
284
285	# print the mail to stdout
286	print_letter(
287	{ letter => $letter,
288	borrowernumber => $borrowernumber,
289	firstname => $firstname,
290	lastname => $lastname,
291	address1 => $address1,
292	address2 => $address2,
293	city => $city,
294	postcode => $postcode,
295	email => $email,
296	itemcount => $itemcount,
297	titles => $titles,
298	outputformat => $csvfilename ? 'csv' : '',
299	}
300	);
301	} else {
302	my $enqueue_parameters = {
303	letter => $letter,
304	borrowernumber => $borrowernumber,
305	message_transport_type => 'email',
306	from_address => $admin_email_address,
307	};
308
309	# If we don't have an email address for this patron, send it to the admin to deal with.
310	if ( !$email ) {
311	$enqueue_parameters->{'to_address'} = $admin_email_address;
312	}
313	C4::Letters::EnqueueLetter($enqueue_parameters);
314	}
315	}
316	$sth->finish;
317	}
318	}
319	}
320
321	if ($csvfilename) {
322	close $csv_fh;
323	}
324
325	=head1 INTERNAL METHODS
326
327	=head2 get_branches_with_overdue_rules
328
329	=cut
330
331	sub get_branches_with_overdue_rules {
332	my $dbh = C4::Context->dbh;
333	my $rqoverduebranches = $dbh->prepare("SELECT DISTINCT branchcode FROM overduerules WHERE delay1 IS NOT NULL");
334	$rqoverduebranches->execute;
335	my @branches = map { shift @$_ } @{ $rqoverduebranches->fetchall_arrayref };
336	$rqoverduebranches->finish;
337	return @branches;
338	}
339
340	=head2 parse_letter
341
342
343
344	=cut
345
346	sub parse_letter {
347	my $params = shift;
348	foreach my $required (qw( letter borrowernumber )) {
349	return unless exists $params->{$required};
350	}
351
352	if ( $params->{'substitute'} ) {
353	while ( my ( $key, $replacedby ) = each %{ $params->{'substitute'} } ) {
354	my $replacefield = "<<$key>>";
355
356	$params->{'letter'}->{title} =~ s/$replacefield/$replacedby/g;
357	$params->{'letter'}->{content} =~ s/$replacefield/$replacedby/g;
358	}
359	}
360
361	C4::Letters::parseletter( $params->{'letter'}, 'borrowers', $params->{'borrowernumber'} );
362
363	if ( $params->{'branchcode'} ) {
364	C4::Letters::parseletter( $params->{'letter'}, 'branches', $params->{'branchcode'} );
365	}
366
367	if ( $params->{'biblionumber'} ) {
368	C4::Letters::parseletter( $params->{'letter'}, 'biblio', $params->{'biblionumber'} );
369	C4::Letters::parseletter( $params->{'letter'}, 'biblioitems', $params->{'biblionumber'} );
370	}
371
372	return $params->{'letter'};
373	}
374
375	=head2 print_letter
376
377	required parameters:
378	letter
379	borrowernumber
380
381	optional parameters:
382	outputformat
383
384	=cut
385
386	sub print_letter {
387	my $params = shift;
388
389	return unless ref $params eq 'HASH';
390
391	foreach my $required_parameter (qw( letter borrowernumber )) {
392	return unless defined $params->{$required_parameter};
393	}
394
395	if ( exists $params->{'outputformat'} && $params->{'outputformat'} eq 'csv' ) {
396	if ($csv->combine(
397	$params->{'firstname'}, $params->{'lastname'}, $params->{'address1'}, $params->{'address2'}, $params->{'postcode'},
398	$params->{'city'}, $params->{'email'}, $params->{'itemcount'}, $params->{'titles'}
399	)
400	) {
401	print $csv_fh $csv->string, "\n";
402	} else {
403	warn 'combine failed on argument: ' . $csv->error_input;
404	}
405	} else {
406	print sprintf( 'To: "%s %s" <%s>', $params->{'firstname'}, $params->{'lastname'}, $params->{'email'} ), "\n";
407	print "Subject: $params->{'letter'}->{'title'}\n\n";
408	print "$params->{'letter'}->{'content'}\n";
409
410	# print Data::Dumper->Dump( [ $params->{'borrowernumber'}, $params->{'letter'} ], [qw( borrowernumber letter )] );
411	}
412
413	}
414

Line 0 Link Here

(-)a/t/lib/KohaTest/Members/DebarMember.pm (-1 / +44 lines)
0	-	1	package KohaTest::Members::DebarMember;
		2	use base qw( KohaTest::Members );
		3
		4	use strict;
		5	use warnings;
		6
		7	use Test::More;
		8
		9	use C4::Members;
		10	sub testing_class { 'C4::Members' };
		11
		12
		13	sub simple_usage : Test( 6 ) {
		14	my $self = shift;
		15
		16	ok( $self->{'memberid'}, 'we have a valid memberid to test with' );
		17
		18	my $details = C4::Members::GetMemberDetails( $self->{'memberid'} );
		19	ok( exists $details->{'flags'}, 'member details has a "flags" attribute');
		20	isa_ok( $details->{'flags'}, 'HASH', 'the "flags" attribute is a hashref');
		21	ok( ! $details->{'flags'}->{'DBARRED'}, 'this member is NOT debarred' );
		22
		23	# Now, let's debar this member and see what happens
		24	my $success = C4::Members::DebarMember( { borrowernumber => $self->{'memberid'} } );
		25
		26	ok( $success, 'we were able to debar the member' );
		27
		28	$details = C4::Members::GetMemberDetails( $self->{'memberid'} );
		29	ok( $details->{'flags'}->{'DBARRED'}, 'this member is debarred now' )
		30	or diag( Data::Dumper->Dump( [ $details->{'flags'} ], [ 'flags' ] ) );
		31	}
		32
		33	sub incorrect_usage : Test( 2 ) {
		34	my $self = shift;
		35
		36	my $result = C4::Members::DebarMember();
		37	ok( ! defined $result, 'DebarMember returns undef when passed no parameters' );
		38
		39	$result = C4::Members::DebarMember( $self->{'memberid'} );
		40	ok( ! defined $result, 'DebarMember returns undef when not passed a hashref' );
		41
		42	}
		43
		44	1;