3 # Copyright 2000-2003 Katipo Communications
4 # Copyright 2010 BibLibre
5 # Parts Copyright 2010 Catalyst IT
7 # This file is part of Koha.
9 # Koha is free software; you can redistribute it and/or modify it under the
10 # terms of the GNU General Public License as published by the Free Software
11 # Foundation; either version 2 of the License, or (at your option) any later
14 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
15 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
16 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
18 # You should have received a copy of the GNU General Public License along
19 # with Koha; if not, write to the Free Software Foundation, Inc.,
20 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
24 #use warnings; FIXME - Bug 2505
26 use C4::Dates qw(format_date_in_iso format_date);
27 use String::Random qw( random_string );
28 use Date::Calc qw/Today Add_Delta_YM check_date Date_to_Days/;
29 use C4::Log; # logaction
35 use C4::SQLHelper qw(InsertInTable UpdateInTable SearchInTable);
36 use C4::Members::Attributes qw(SearchIdMatchingAttribute);
37 use C4::NewsChannels; #get slip news
39 use DateTime::Format::DateParse;
41 use Koha::Borrower::Debarments qw(IsDebarred);
42 use Text::Unaccent qw( unac_string );
43 use Koha::AuthUtils qw(hash_password);
46 our ($VERSION,@ISA,@EXPORT,@EXPORT_OK,$debug);
49 $VERSION = 3.07.00.049;
50 $debug = $ENV{DEBUG} || 0;
62 &GetMemberIssuesAndFines
69 &GetFirstValidEmailAddress
70 &GetNoticeEmailAddress
81 &GetHideLostItemsPreference
84 &GetMemberAccountRecords
85 &GetBorNotifyAcctRecord
89 GetBorrowerCategorycode
90 &GetBorrowercategoryList
92 &GetBorrowersToExpunge
93 &GetBorrowersWhoHaveNeverBorrowed
94 &GetBorrowersWithIssuesHistoryOlderThan
104 GetBorrowersWithEmail
126 &ExtendMemberSubscriptionTo
144 C4::Members - Perl Module containing convenience functions for member handling
152 This module contains routines for adding, modifying and deleting members/patrons/borrowers
158 $borrowers_result_array_ref = &Search($filter,$orderby, $limit,
159 $columns_out, $search_on_fields,$searchtype);
161 Looks up patrons (borrowers) on filter. A wrapper for SearchInTable('borrowers').
163 For C<$filter>, C<$orderby>, C<$limit>, C<&columns_out>, C<&search_on_fields> and C<&searchtype>
164 refer to C4::SQLHelper:SearchInTable().
166 Special C<$filter> key '' is effectively expanded to search on surname firstname othernamescw
167 and cardnumber unless C<&search_on_fields> is defined
171 $borrowers = Search('abcd', 'cardnumber');
173 $borrowers = Search({''=>'abcd', category_type=>'I'}, 'surname');
177 sub _express_member_find {
180 # this is used by circulation everytime a new borrowers cardnumber is scanned
181 # so we can check an exact match first, if that works return, otherwise do the rest
182 my $dbh = C4::Context->dbh;
183 my $query = "SELECT borrowernumber FROM borrowers WHERE cardnumber = ?";
184 if ( my $borrowernumber = $dbh->selectrow_array($query, undef, $filter) ) {
185 return( {"borrowernumber"=>$borrowernumber} );
188 my ($search_on_fields, $searchtype);
189 if ( length($filter) == 1 ) {
190 $search_on_fields = [ qw(surname) ];
191 $searchtype = 'start_with';
193 $search_on_fields = [ qw(surname firstname othernames cardnumber) ];
194 $searchtype = 'contain';
197 return (undef, $search_on_fields, $searchtype);
201 my ( $filter, $orderby, $limit, $columns_out, $search_on_fields, $searchtype ) = @_;
206 if ( my $fr = ref $filter ) {
207 if ( $fr eq "HASH" ) {
208 if ( my $search_string = $filter->{''} ) {
209 my ($member_filter, $member_search_on_fields, $member_searchtype) = _express_member_find($search_string);
210 if ($member_filter) {
211 $filter = $member_filter;
214 $search_on_fields ||= $member_search_on_fields;
215 $searchtype ||= $member_searchtype;
220 $search_string = $filter;
224 $search_string = $filter;
225 my ($member_filter, $member_search_on_fields, $member_searchtype) = _express_member_find($search_string);
226 if ($member_filter) {
227 $filter = $member_filter;
230 $search_on_fields ||= $member_search_on_fields;
231 $searchtype ||= $member_searchtype;
235 if ( !$found_borrower && C4::Context->preference('ExtendedPatronAttributes') && $search_string ) {
236 my $matching_records = C4::Members::Attributes::SearchIdMatchingAttribute($search_string);
237 if(scalar(@$matching_records)>0) {
238 if ( my $fr = ref $filter ) {
239 if ( $fr eq "HASH" ) {
241 $filter = [ $filter ];
243 push @$filter, { %f, "borrowernumber"=>$$matching_records };
246 push @$filter, {"borrowernumber"=>$matching_records};
250 $filter = [ $filter ];
251 push @$filter, {"borrowernumber"=>$matching_records};
256 # $showallbranches was not used at the time SearchMember() was mainstreamed into Search().
257 # Mentioning for the reference
259 if ( C4::Context->preference("IndependentBranches") ) { # && !$showallbranches){
260 if ( my $userenv = C4::Context->userenv ) {
261 my $branch = $userenv->{'branch'};
262 if ( !C4::Context->IsSuperLibrarian() && $branch ){
263 if (my $fr = ref $filter) {
264 if ( $fr eq "HASH" ) {
265 $filter->{branchcode} = $branch;
269 $_ = { '' => $_ } unless ref $_;
270 $_->{branchcode} = $branch;
275 $filter = { '' => $filter, branchcode => $branch };
281 if ($found_borrower) {
282 $searchtype = "exact";
284 $searchtype ||= "start_with";
286 return SearchInTable( "borrowers", $filter, $orderby, $limit, $columns_out, $search_on_fields, $searchtype );
289 =head2 GetMemberDetails
291 ($borrower) = &GetMemberDetails($borrowernumber, $cardnumber);
293 Looks up a patron and returns information about him or her. If
294 C<$borrowernumber> is true (nonzero), C<&GetMemberDetails> looks
295 up the borrower by number; otherwise, it looks up the borrower by card
298 C<$borrower> is a reference-to-hash whose keys are the fields of the
299 borrowers table in the Koha database. In addition,
300 C<$borrower-E<gt>{flags}> is a hash giving more detailed information
301 about the patron. Its keys act as flags :
303 if $borrower->{flags}->{LOST} {
304 # Patron's card was reported lost
307 If the state of a flag means that the patron should not be
308 allowed to borrow any more books, then it will have a C<noissues> key
311 See patronflags for more details.
313 C<$borrower-E<gt>{authflags}> is a hash giving more detailed information
314 about the top-level permissions flags set for the borrower. For example,
315 if a user has the "editcatalogue" permission,
316 C<$borrower-E<gt>{authflags}-E<gt>{editcatalogue}> will exist and have
321 sub GetMemberDetails {
322 my ( $borrowernumber, $cardnumber ) = @_;
323 my $dbh = C4::Context->dbh;
326 if ($borrowernumber) {
327 $sth = $dbh->prepare("
330 categories.description,
331 categories.BlockExpiredPatronOpacActions,
335 LEFT JOIN categories ON borrowers.categorycode=categories.categorycode
336 WHERE borrowernumber = ?
338 $sth->execute($borrowernumber);
340 elsif ($cardnumber) {
341 $sth = $dbh->prepare("
344 categories.description,
345 categories.BlockExpiredPatronOpacActions,
349 LEFT JOIN categories ON borrowers.categorycode = categories.categorycode
352 $sth->execute($cardnumber);
357 my $borrower = $sth->fetchrow_hashref;
358 return unless $borrower;
359 my ($amount) = GetMemberAccountRecords( $borrowernumber);
360 $borrower->{'amountoutstanding'} = $amount;
361 # FIXME - patronflags calls GetMemberAccountRecords... just have patronflags return $amount
362 my $flags = patronflags( $borrower);
365 $sth = $dbh->prepare("select bit,flag from userflags");
367 while ( my ( $bit, $flag ) = $sth->fetchrow ) {
368 if ( $borrower->{'flags'} && $borrower->{'flags'} & 2**$bit ) {
369 $accessflagshash->{$flag} = 1;
372 $borrower->{'flags'} = $flags;
373 $borrower->{'authflags'} = $accessflagshash;
375 # For the purposes of making templates easier, we'll define a
376 # 'showname' which is the alternate form the user's first name if
377 # 'other name' is defined.
378 if ($borrower->{category_type} eq 'I') {
379 $borrower->{'showname'} = $borrower->{'othernames'};
380 $borrower->{'showname'} .= " $borrower->{'firstname'}" if $borrower->{'firstname'};
382 $borrower->{'showname'} = $borrower->{'firstname'};
385 # Handle setting the true behavior for BlockExpiredPatronOpacActions
386 $borrower->{'BlockExpiredPatronOpacActions'} =
387 C4::Context->preference('BlockExpiredPatronOpacActions')
388 if ( $borrower->{'BlockExpiredPatronOpacActions'} == -1 );
390 $borrower->{'is_expired'} = 0;
391 $borrower->{'is_expired'} = 1 if
392 defined($borrower->{dateexpiry}) &&
393 $borrower->{'dateexpiry'} ne '0000-00-00' &&
394 Date_to_Days( Today() ) >
395 Date_to_Days( split /-/, $borrower->{'dateexpiry'} );
397 return ($borrower); #, $flags, $accessflagshash);
402 $flags = &patronflags($patron);
404 This function is not exported.
406 The following will be set where applicable:
407 $flags->{CHARGES}->{amount} Amount of debt
408 $flags->{CHARGES}->{noissues} Set if debt amount >$5.00 (or syspref noissuescharge)
409 $flags->{CHARGES}->{message} Message -- deprecated
411 $flags->{CREDITS}->{amount} Amount of credit
412 $flags->{CREDITS}->{message} Message -- deprecated
414 $flags->{ GNA } Patron has no valid address
415 $flags->{ GNA }->{noissues} Set for each GNA
416 $flags->{ GNA }->{message} "Borrower has no valid address" -- deprecated
418 $flags->{ LOST } Patron's card reported lost
419 $flags->{ LOST }->{noissues} Set for each LOST
420 $flags->{ LOST }->{message} Message -- deprecated
422 $flags->{DBARRED} Set if patron debarred, no access
423 $flags->{DBARRED}->{noissues} Set for each DBARRED
424 $flags->{DBARRED}->{message} Message -- deprecated
427 $flags->{ NOTES }->{message} The note itself. NOT deprecated
429 $flags->{ ODUES } Set if patron has overdue books.
430 $flags->{ ODUES }->{message} "Yes" -- deprecated
431 $flags->{ ODUES }->{itemlist} ref-to-array: list of overdue books
432 $flags->{ ODUES }->{itemlisttext} Text list of overdue items -- deprecated
434 $flags->{WAITING} Set if any of patron's reserves are available
435 $flags->{WAITING}->{message} Message -- deprecated
436 $flags->{WAITING}->{itemlist} ref-to-array: list of available items
440 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
441 overdue items. Its elements are references-to-hash, each describing an
442 overdue item. The keys are selected fields from the issues, biblio,
443 biblioitems, and items tables of the Koha database.
445 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
446 the overdue items, one per line. Deprecated.
448 =item C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
449 available items. Each element is a reference-to-hash whose keys are
450 fields from the reserves table of the Koha database.
454 All the "message" fields that include language generated in this function are deprecated,
455 because such strings belong properly in the display layer.
457 The "message" field that comes from the DB is OK.
461 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
462 # FIXME rename this function.
465 my ( $patroninformation) = @_;
466 my $dbh=C4::Context->dbh;
467 my ($balance, $owing) = GetMemberAccountBalance( $patroninformation->{'borrowernumber'});
470 my $noissuescharge = C4::Context->preference("noissuescharge") || 5;
471 $flaginfo{'message'} = sprintf 'Patron owes %.02f', $owing;
472 $flaginfo{'amount'} = sprintf "%.02f", $owing;
473 if ( $owing > $noissuescharge && !C4::Context->preference("AllowFineOverride") ) {
474 $flaginfo{'noissues'} = 1;
476 $flags{'CHARGES'} = \%flaginfo;
478 elsif ( $balance < 0 ) {
480 $flaginfo{'message'} = sprintf 'Patron has credit of %.02f', -$balance;
481 $flaginfo{'amount'} = sprintf "%.02f", $balance;
482 $flags{'CREDITS'} = \%flaginfo;
484 if ( $patroninformation->{'gonenoaddress'}
485 && $patroninformation->{'gonenoaddress'} == 1 )
488 $flaginfo{'message'} = 'Borrower has no valid address.';
489 $flaginfo{'noissues'} = 1;
490 $flags{'GNA'} = \%flaginfo;
492 if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
494 $flaginfo{'message'} = 'Borrower\'s card reported lost.';
495 $flaginfo{'noissues'} = 1;
496 $flags{'LOST'} = \%flaginfo;
498 if ( $patroninformation->{'debarred'} && check_date( split( /-/, $patroninformation->{'debarred'} ) ) ) {
499 if ( Date_to_Days(Date::Calc::Today) < Date_to_Days( split( /-/, $patroninformation->{'debarred'} ) ) ) {
501 $flaginfo{'debarredcomment'} = $patroninformation->{'debarredcomment'};
502 $flaginfo{'message'} = $patroninformation->{'debarredcomment'};
503 $flaginfo{'noissues'} = 1;
504 $flaginfo{'dateend'} = $patroninformation->{'debarred'};
505 $flags{'DBARRED'} = \%flaginfo;
508 if ( $patroninformation->{'borrowernotes'}
509 && $patroninformation->{'borrowernotes'} )
512 $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
513 $flags{'NOTES'} = \%flaginfo;
515 my ( $odues, $itemsoverdue ) = C4::Overdues::checkoverdues($patroninformation->{'borrowernumber'});
516 if ( $odues && $odues > 0 ) {
518 $flaginfo{'message'} = "Yes";
519 $flaginfo{'itemlist'} = $itemsoverdue;
520 foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
523 $flaginfo{'itemlisttext'} .=
524 "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n"; # newline is display layer
526 $flags{'ODUES'} = \%flaginfo;
528 my @itemswaiting = C4::Reserves::GetReservesFromBorrowernumber( $patroninformation->{'borrowernumber'},'W' );
529 my $nowaiting = scalar @itemswaiting;
530 if ( $nowaiting > 0 ) {
532 $flaginfo{'message'} = "Reserved items available";
533 $flaginfo{'itemlist'} = \@itemswaiting;
534 $flags{'WAITING'} = \%flaginfo;
542 $borrower = &GetMember(%information);
544 Retrieve the first patron record meeting on criteria listed in the
545 C<%information> hash, which should contain one or more
546 pairs of borrowers column names and values, e.g.,
548 $borrower = GetMember(borrowernumber => id);
550 C<&GetBorrower> returns a reference-to-hash whose keys are the fields of
551 the C<borrowers> table in the Koha database.
553 FIXME: GetMember() is used throughout the code as a lookup
554 on a unique key such as the borrowernumber, but this meaning is not
555 enforced in the routine itself.
561 my ( %information ) = @_;
562 if (exists $information{borrowernumber} && !defined $information{borrowernumber}) {
563 #passing mysql's kohaadmin?? Makes no sense as a query
566 my $dbh = C4::Context->dbh;
568 q{SELECT borrowers.*, categories.category_type, categories.description
570 LEFT JOIN categories on borrowers.categorycode=categories.categorycode WHERE };
573 for (keys %information ) {
581 if (defined $information{$_}) {
583 push @values, $information{$_};
586 $select .= "$_ IS NULL";
589 $debug && warn $select, " ",values %information;
590 my $sth = $dbh->prepare("$select");
591 $sth->execute(map{$information{$_}} keys %information);
592 my $data = $sth->fetchall_arrayref({});
593 #FIXME interface to this routine now allows generation of a result set
594 #so whole array should be returned but bowhere in the current code expects this
602 =head2 GetMemberRelatives
604 @borrowernumbers = GetMemberRelatives($borrowernumber);
606 C<GetMemberRelatives> returns a borrowersnumber's list of guarantor/guarantees of the member given in parameter
609 sub GetMemberRelatives {
610 my $borrowernumber = shift;
611 my $dbh = C4::Context->dbh;
615 my $query = "SELECT guarantorid FROM borrowers WHERE borrowernumber=?";
616 my $sth = $dbh->prepare($query);
617 $sth->execute($borrowernumber);
618 my $data = $sth->fetchrow_arrayref();
619 push @glist, $data->[0] if $data->[0];
620 my $guarantor = $data->[0] ? $data->[0] : undef;
623 $query = "SELECT borrowernumber FROM borrowers WHERE guarantorid=?";
624 $sth = $dbh->prepare($query);
625 $sth->execute($borrowernumber);
626 while ($data = $sth->fetchrow_arrayref()) {
627 push @glist, $data->[0];
630 # Getting sibling guarantees
632 $query = "SELECT borrowernumber FROM borrowers WHERE guarantorid=?";
633 $sth = $dbh->prepare($query);
634 $sth->execute($guarantor);
635 while ($data = $sth->fetchrow_arrayref()) {
636 push @glist, $data->[0] if ($data->[0] != $borrowernumber);
643 =head2 IsMemberBlocked
645 my ($block_status, $count) = IsMemberBlocked( $borrowernumber );
647 Returns whether a patron has overdue items that may result
648 in a block or whether the patron has active fine days
649 that would block circulation privileges.
651 C<$block_status> can have the following values:
653 1 if the patron has outstanding fine days, in which case C<$count> is the number of them
655 -1 if the patron has overdue items, in which case C<$count> is the number of them
657 0 if the patron has no overdue items or outstanding fine days, in which case C<$count> is 0
659 Outstanding fine days are checked before current overdue items
662 FIXME: this needs to be split into two functions; a potential block
663 based on the number of current overdue items could be orthogonal
664 to a block based on whether the patron has any fine days accrued.
668 sub IsMemberBlocked {
669 my $borrowernumber = shift;
670 my $dbh = C4::Context->dbh;
672 my $blockeddate = Koha::Borrower::Debarments::IsDebarred($borrowernumber);
674 return ( 1, $blockeddate ) if $blockeddate;
676 # if he have late issues
677 my $sth = $dbh->prepare(
678 "SELECT COUNT(*) as latedocs
680 WHERE borrowernumber = ?
681 AND date_due < now()"
683 $sth->execute($borrowernumber);
684 my $latedocs = $sth->fetchrow_hashref->{'latedocs'};
686 return ( -1, $latedocs ) if $latedocs > 0;
691 =head2 GetMemberIssuesAndFines
693 ($overdue_count, $issue_count, $total_fines) = &GetMemberIssuesAndFines($borrowernumber);
695 Returns aggregate data about items borrowed by the patron with the
696 given borrowernumber.
698 C<&GetMemberIssuesAndFines> returns a three-element array. C<$overdue_count> is the
699 number of overdue items the patron currently has borrowed. C<$issue_count> is the
700 number of books the patron currently has borrowed. C<$total_fines> is
701 the total fine currently due by the borrower.
706 sub GetMemberIssuesAndFines {
707 my ( $borrowernumber ) = @_;
708 my $dbh = C4::Context->dbh;
709 my $query = "SELECT COUNT(*) FROM issues WHERE borrowernumber = ?";
711 $debug and warn $query."\n";
712 my $sth = $dbh->prepare($query);
713 $sth->execute($borrowernumber);
714 my $issue_count = $sth->fetchrow_arrayref->[0];
716 $sth = $dbh->prepare(
717 "SELECT COUNT(*) FROM issues
718 WHERE borrowernumber = ?
719 AND date_due < now()"
721 $sth->execute($borrowernumber);
722 my $overdue_count = $sth->fetchrow_arrayref->[0];
724 $sth = $dbh->prepare("SELECT SUM(amountoutstanding) FROM accountlines WHERE borrowernumber = ?");
725 $sth->execute($borrowernumber);
726 my $total_fines = $sth->fetchrow_arrayref->[0];
728 return ($overdue_count, $issue_count, $total_fines);
734 my @columns = C4::Member::columns();
736 Returns an array of borrowers' table columns on success,
737 and an empty array on failure.
743 # Pure ANSI SQL goodness.
744 my $sql = 'SELECT * FROM borrowers WHERE 1=0;';
746 # Get the database handle.
747 my $dbh = C4::Context->dbh;
749 # Run the SQL statement to load STH's readonly properties.
750 my $sth = $dbh->prepare($sql);
751 my $rv = $sth->execute();
753 # This only fails if the table doesn't exist.
754 # This will always be called AFTER an install or upgrade,
755 # so borrowers will exist!
757 if ($sth->{NUM_OF_FIELDS}>0) {
758 @data = @{$sth->{NAME}};
769 my $success = ModMember(borrowernumber => $borrowernumber,
770 [ field => value ]... );
772 Modify borrower's data. All date fields should ALREADY be in ISO format.
775 true on success, or false on failure
781 # test to know if you must update or not the borrower password
782 if (exists $data{password}) {
783 if ($data{password} eq '****' or $data{password} eq '') {
784 delete $data{password};
786 $data{password} = hash_password($data{password});
789 my $old_categorycode = GetBorrowerCategorycode( $data{borrowernumber} );
790 my $execute_success=UpdateInTable("borrowers",\%data);
791 if ($execute_success) { # only proceed if the update was a success
792 # ok if its an adult (type) it may have borrowers that depend on it as a guarantor
793 # so when we update information for an adult we should check for guarantees and update the relevant part
794 # of their records, ie addresses and phone numbers
795 my $borrowercategory= GetBorrowercategory( $data{'category_type'} );
796 if ( exists $borrowercategory->{'category_type'} && $borrowercategory->{'category_type'} eq ('A' || 'S') ) {
797 # is adult check guarantees;
798 UpdateGuarantees(%data);
801 # If the patron changes to a category with enrollment fee, we add a fee
802 if ( $data{categorycode} and $data{categorycode} ne $old_categorycode ) {
803 AddEnrolmentFeeIfNeeded( $data{categorycode}, $data{borrowernumber} );
806 logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "UPDATE (executed w/ arg: $data{'borrowernumber'})") if C4::Context->preference("BorrowersLog");
808 return $execute_success;
813 $borrowernumber = &AddMember(%borrower);
815 insert new borrower into table
816 Returns the borrowernumber upon success
818 Returns as undef upon any db error without further processing
825 my $dbh = C4::Context->dbh;
827 # generate a proper login if none provided
828 $data{'userid'} = Generate_Userid($data{'borrowernumber'}, $data{'firstname'}, $data{'surname'}) if $data{'userid'} eq '';
830 # add expiration date if it isn't already there
831 unless ( $data{'dateexpiry'} ) {
832 $data{'dateexpiry'} = GetExpiryDate( $data{'categorycode'}, C4::Dates->new()->output("iso") );
835 # add enrollment date if it isn't already there
836 unless ( $data{'dateenrolled'} ) {
837 $data{'dateenrolled'} = C4::Dates->new()->output("iso");
840 my $patron_category =
841 Koha::Database->new()->schema()->resultset('Category')
842 ->find( $data{'categorycode'} );
844 $patron_category->default_privacy() eq 'default' ? 1
845 : $patron_category->default_privacy() eq 'never' ? 2
846 : $patron_category->default_privacy() eq 'forever' ? 0
849 # create a disabled account if no password provided
850 $data{'password'} = ($data{'password'})? hash_password($data{'password'}) : '!';
851 $data{'borrowernumber'}=InsertInTable("borrowers",\%data);
853 # mysql_insertid is probably bad. not necessarily accurate and mysql-specific at best.
854 logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
856 AddEnrolmentFeeIfNeeded( $data{categorycode}, $data{borrowernumber} );
858 return $data{'borrowernumber'};
863 my $uniqueness = Check_Userid($userid,$borrowernumber);
865 $borrowernumber is optional (i.e. it can contain a blank value). If $userid is passed with a blank $borrowernumber variable, the database will be checked for all instances of that userid (i.e. userid=? AND borrowernumber != '').
867 If $borrowernumber is provided, the database will be checked for every instance of that userid coupled with a different borrower(number) than the one provided.
870 0 for not unique (i.e. this $userid already exists)
871 1 for unique (i.e. this $userid does not exist, or this $userid/$borrowernumber combination already exists)
876 my ($uid,$member) = @_;
877 my $dbh = C4::Context->dbh;
880 "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
881 $sth->execute( $uid, $member );
882 if ( (( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref )) or
883 (( $uid ne '' ) && ( $uid eq C4::Context->config('user') )) ) {
891 =head2 Generate_Userid
893 my $newuid = Generate_Userid($borrowernumber, $firstname, $surname);
895 Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
897 $borrowernumber is optional (i.e. it can contain a blank value). A value is passed when generating a new userid for an existing borrower. When a new userid is created for a new borrower, a blank value is passed to this sub.
900 new userid ($firstname.$surname if there is a $firstname, or $surname if there is no value in $firstname) plus offset (0 if the $newuid is unique, or a higher numeric value if Check_Userid finds an existing match for the $newuid in the database).
904 sub Generate_Userid {
905 my ($borrowernumber, $firstname, $surname) = @_;
908 #The script will "do" the following code and increment the $offset until Check_Userid = 1 (i.e. until $newuid comes back as unique)
910 $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
911 $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
912 $newuid = lc(($firstname)? "$firstname.$surname" : $surname);
913 $newuid = unac_string('utf-8',$newuid);
914 $newuid .= $offset unless $offset == 0;
917 } while (!Check_Userid($newuid,$borrowernumber));
923 my ( $uid, $member, $digest ) = @_;
924 my $dbh = C4::Context->dbh;
926 #Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
927 #Then we need to tell the user and have them create a new one.
931 "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
932 $sth->execute( $uid, $member );
933 if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
937 #Everything is good so we can update the information.
940 "update borrowers set userid=?, password=? where borrowernumber=?");
941 $sth->execute( $uid, $digest, $member );
945 logaction("MEMBERS", "CHANGE PASS", $member, "") if C4::Context->preference("BorrowersLog");
951 =head2 fixup_cardnumber
953 Warning: The caller is responsible for locking the members table in write
954 mode, to avoid database corruption.
958 use vars qw( @weightings );
959 my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
961 sub fixup_cardnumber {
962 my ($cardnumber) = @_;
963 my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;
965 # Find out whether member numbers should be generated
966 # automatically. Should be either "1" or something else.
967 # Defaults to "0", which is interpreted as "no".
969 # if ($cardnumber !~ /\S/ && $autonumber_members) {
970 ($autonumber_members) or return $cardnumber;
971 my $checkdigit = C4::Context->preference('checkdigit');
972 my $dbh = C4::Context->dbh;
973 if ( $checkdigit and $checkdigit eq 'katipo' ) {
975 # if checkdigit is selected, calculate katipo-style cardnumber.
976 # otherwise, just use the max()
977 # purpose: generate checksum'd member numbers.
978 # We'll assume we just got the max value of digits 2-8 of member #'s
979 # from the database and our job is to increment that by one,
980 # determine the 1st and 9th digits and return the full string.
981 my $sth = $dbh->prepare(
982 "select max(substring(borrowers.cardnumber,2,7)) as new_num from borrowers"
985 my $data = $sth->fetchrow_hashref;
986 $cardnumber = $data->{new_num};
987 if ( !$cardnumber ) { # If DB has no values,
988 $cardnumber = 1000000; # start at 1000000
994 for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
995 # read weightings, left to right, 1 char at a time
996 my $temp1 = $weightings[$i];
998 # sequence left to right, 1 char at a time
999 my $temp2 = substr( $cardnumber, $i, 1 );
1001 # mult each char 1-7 by its corresponding weighting
1002 $sum += $temp1 * $temp2;
1005 my $rem = ( $sum % 11 );
1006 $rem = 'X' if $rem == 10;
1008 return "V$cardnumber$rem";
1011 my $sth = $dbh->prepare(
1012 'SELECT MAX( CAST( cardnumber AS SIGNED ) ) FROM borrowers WHERE cardnumber REGEXP "^-?[0-9]+$"'
1015 my ($result) = $sth->fetchrow;
1018 return $cardnumber; # just here as a fallback/reminder
1021 =head2 GetGuarantees
1023 ($num_children, $children_arrayref) = &GetGuarantees($parent_borrno);
1024 $child0_cardno = $children_arrayref->[0]{"cardnumber"};
1025 $child0_borrno = $children_arrayref->[0]{"borrowernumber"};
1027 C<&GetGuarantees> takes a borrower number (e.g., that of a patron
1028 with children) and looks up the borrowers who are guaranteed by that
1029 borrower (i.e., the patron's children).
1031 C<&GetGuarantees> returns two values: an integer giving the number of
1032 borrowers guaranteed by C<$parent_borrno>, and a reference to an array
1033 of references to hash, which gives the actual results.
1039 my ($borrowernumber) = @_;
1040 my $dbh = C4::Context->dbh;
1043 "select cardnumber,borrowernumber, firstname, surname from borrowers where guarantorid=?"
1045 $sth->execute($borrowernumber);
1048 my $data = $sth->fetchall_arrayref({});
1049 return ( scalar(@$data), $data );
1052 =head2 UpdateGuarantees
1054 &UpdateGuarantees($parent_borrno);
1057 C<&UpdateGuarantees> borrower data for an adult and updates all the guarantees
1058 with the modified information
1063 sub UpdateGuarantees {
1065 my $dbh = C4::Context->dbh;
1066 my ( $count, $guarantees ) = GetGuarantees( $data{'borrowernumber'} );
1067 foreach my $guarantee (@$guarantees){
1068 my $guaquery = qq|UPDATE borrowers
1069 SET address=?,fax=?,B_city=?,mobile=?,city=?,phone=?
1070 WHERE borrowernumber=?
1072 my $sth = $dbh->prepare($guaquery);
1073 $sth->execute($data{'address'},$data{'fax'},$data{'B_city'},$data{'mobile'},$data{'city'},$data{'phone'},$guarantee->{'borrowernumber'});
1076 =head2 GetPendingIssues
1078 my $issues = &GetPendingIssues(@borrowernumber);
1080 Looks up what the patron with the given borrowernumber has borrowed.
1082 C<&GetPendingIssues> returns a
1083 reference-to-array where each element is a reference-to-hash; the
1084 keys are the fields from the C<issues>, C<biblio>, and C<items> tables.
1085 The keys include C<biblioitems> fields except marc and marcxml.
1090 sub GetPendingIssues {
1091 my @borrowernumbers = @_;
1093 unless (@borrowernumbers ) { # return a ref_to_array
1094 return \@borrowernumbers; # to not cause surprise to caller
1097 # Borrowers part of the query
1099 for (my $i = 0; $i < @borrowernumbers; $i++) {
1100 $bquery .= ' issues.borrowernumber = ?';
1101 if ($i < $#borrowernumbers ) {
1106 # must avoid biblioitems.* to prevent large marc and marcxml fields from killing performance
1107 # FIXME: namespace collision: each table has "timestamp" fields. Which one is "timestamp" ?
1108 # FIXME: circ/ciculation.pl tries to sort by timestamp!
1109 # FIXME: namespace collision: other collisions possible.
1110 # FIXME: most of this data isn't really being used by callers.
1117 biblioitems.itemtype,
1120 biblioitems.publicationyear,
1121 biblioitems.publishercode,
1122 biblioitems.volumedate,
1123 biblioitems.volumedesc,
1126 borrowers.firstname,
1128 borrowers.cardnumber,
1129 issues.timestamp AS timestamp,
1130 issues.renewals AS renewals,
1131 issues.borrowernumber AS borrowernumber,
1132 items.renewals AS totalrenewals
1134 LEFT JOIN items ON items.itemnumber = issues.itemnumber
1135 LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
1136 LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
1137 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
1140 ORDER BY issues.issuedate"
1143 my $sth = C4::Context->dbh->prepare($query);
1144 $sth->execute(@borrowernumbers);
1145 my $data = $sth->fetchall_arrayref({});
1146 my $tz = C4::Context->tz();
1147 my $today = DateTime->now( time_zone => $tz);
1148 foreach (@{$data}) {
1149 if ($_->{issuedate}) {
1150 $_->{issuedate} = dt_from_string($_->{issuedate}, 'sql');
1152 $_->{date_due} or next;
1153 $_->{date_due} = DateTime::Format::DateParse->parse_datetime($_->{date_due}, $tz->name());
1154 if ( DateTime->compare($_->{date_due}, $today) == -1 ) {
1163 $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
1165 Looks up what the patron with the given borrowernumber has borrowed,
1166 and sorts the results.
1168 C<$sortkey> is the name of a field on which to sort the results. This
1169 should be the name of a field in the C<issues>, C<biblio>,
1170 C<biblioitems>, or C<items> table in the Koha database.
1172 C<$limit> is the maximum number of results to return.
1174 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
1175 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
1176 C<items> tables of the Koha database.
1182 my ( $borrowernumber, $order, $limit ) = @_;
1184 return unless $borrowernumber;
1185 $order = 'date_due desc' unless $order;
1187 my $dbh = C4::Context->dbh;
1189 'SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1191 LEFT JOIN items on items.itemnumber=issues.itemnumber
1192 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1193 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1194 WHERE borrowernumber=?
1196 SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1198 LEFT JOIN items on items.itemnumber=old_issues.itemnumber
1199 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1200 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1201 WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL
1202 order by ' . $order;
1204 $query .= " limit $limit";
1207 my $sth = $dbh->prepare($query);
1208 $sth->execute( $borrowernumber, $borrowernumber );
1209 return $sth->fetchall_arrayref( {} );
1213 =head2 GetMemberAccountRecords
1215 ($total, $acctlines, $count) = &GetMemberAccountRecords($borrowernumber);
1217 Looks up accounting data for the patron with the given borrowernumber.
1219 C<&GetMemberAccountRecords> returns a three-element array. C<$acctlines> is a
1220 reference-to-array, where each element is a reference-to-hash; the
1221 keys are the fields of the C<accountlines> table in the Koha database.
1222 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1223 total amount outstanding for all of the account lines.
1227 sub GetMemberAccountRecords {
1228 my ($borrowernumber) = @_;
1229 my $dbh = C4::Context->dbh;
1235 WHERE borrowernumber=?);
1236 $strsth.=" ORDER BY date desc,timestamp DESC";
1237 my $sth= $dbh->prepare( $strsth );
1238 $sth->execute( $borrowernumber );
1241 while ( my $data = $sth->fetchrow_hashref ) {
1242 if ( $data->{itemnumber} ) {
1243 my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
1244 $data->{biblionumber} = $biblio->{biblionumber};
1245 $data->{title} = $biblio->{title};
1247 $acctlines[$numlines] = $data;
1249 $total += int(1000 * $data->{'amountoutstanding'}); # convert float to integer to avoid round-off errors
1252 return ( $total, \@acctlines,$numlines);
1255 =head2 GetMemberAccountBalance
1257 ($total_balance, $non_issue_balance, $other_charges) = &GetMemberAccountBalance($borrowernumber);
1259 Calculates amount immediately owing by the patron - non-issue charges.
1260 Based on GetMemberAccountRecords.
1261 Charges exempt from non-issue are:
1263 * Rent (rental) if RentalsInNoissuesCharge syspref is set to false
1264 * Manual invoices if ManInvInNoissuesCharge syspref is set to false
1268 sub GetMemberAccountBalance {
1269 my ($borrowernumber) = @_;
1271 my $ACCOUNT_TYPE_LENGTH = 5; # this is plain ridiculous...
1274 push @not_fines, 'Res' unless C4::Context->preference('HoldsInNoissuesCharge');
1275 push @not_fines, 'Rent' unless C4::Context->preference('RentalsInNoissuesCharge');
1276 unless ( C4::Context->preference('ManInvInNoissuesCharge') ) {
1277 my $dbh = C4::Context->dbh;
1278 my $man_inv_types = $dbh->selectcol_arrayref(qq{SELECT authorised_value FROM authorised_values WHERE category = 'MANUAL_INV'});
1279 push @not_fines, map substr($_, 0, $ACCOUNT_TYPE_LENGTH), @$man_inv_types;
1281 my %not_fine = map {$_ => 1} @not_fines;
1283 my ($total, $acctlines) = GetMemberAccountRecords($borrowernumber);
1284 my $other_charges = 0;
1285 foreach (@$acctlines) {
1286 $other_charges += $_->{amountoutstanding} if $not_fine{ substr($_->{accounttype}, 0, $ACCOUNT_TYPE_LENGTH) };
1289 return ( $total, $total - $other_charges, $other_charges);
1292 =head2 GetBorNotifyAcctRecord
1294 ($total, $acctlines, $count) = &GetBorNotifyAcctRecord($params,$notifyid);
1296 Looks up accounting data for the patron with the given borrowernumber per file number.
1298 C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a
1299 reference-to-array, where each element is a reference-to-hash; the
1300 keys are the fields of the C<accountlines> table in the Koha database.
1301 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1302 total amount outstanding for all of the account lines.
1306 sub GetBorNotifyAcctRecord {
1307 my ( $borrowernumber, $notifyid ) = @_;
1308 my $dbh = C4::Context->dbh;
1311 my $sth = $dbh->prepare(
1314 WHERE borrowernumber=?
1316 AND amountoutstanding != '0'
1317 ORDER BY notify_id,accounttype
1320 $sth->execute( $borrowernumber, $notifyid );
1322 while ( my $data = $sth->fetchrow_hashref ) {
1323 if ( $data->{itemnumber} ) {
1324 my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
1325 $data->{biblionumber} = $biblio->{biblionumber};
1326 $data->{title} = $biblio->{title};
1328 $acctlines[$numlines] = $data;
1330 $total += int(100 * $data->{'amountoutstanding'});
1333 return ( $total, \@acctlines, $numlines );
1336 =head2 checkuniquemember (OUEST-PROVENCE)
1338 ($result,$categorycode) = &checkuniquemember($collectivity,$surname,$firstname,$dateofbirth);
1340 Checks that a member exists or not in the database.
1342 C<&result> is nonzero (=exist) or 0 (=does not exist)
1343 C<&categorycode> is from categorycode table
1344 C<&collectivity> is 1 (= we add a collectivity) or 0 (= we add a physical member)
1345 C<&surname> is the surname
1346 C<&firstname> is the firstname (only if collectivity=0)
1347 C<&dateofbirth> is the date of birth in ISO format (only if collectivity=0)
1351 # FIXME: This function is not legitimate. Multiple patrons might have the same first/last name and birthdate.
1352 # This is especially true since first name is not even a required field.
1354 sub checkuniquemember {
1355 my ( $collectivity, $surname, $firstname, $dateofbirth ) = @_;
1356 my $dbh = C4::Context->dbh;
1357 my $request = ($collectivity) ?
1358 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? " :
1360 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=? and dateofbirth=?" :
1361 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=?";
1362 my $sth = $dbh->prepare($request);
1363 if ($collectivity) {
1364 $sth->execute( uc($surname) );
1365 } elsif($dateofbirth){
1366 $sth->execute( uc($surname), ucfirst($firstname), $dateofbirth );
1368 $sth->execute( uc($surname), ucfirst($firstname));
1370 my @data = $sth->fetchrow;
1371 ( $data[0] ) and return $data[0], $data[1];
1375 sub checkcardnumber {
1376 my ( $cardnumber, $borrowernumber ) = @_;
1378 # If cardnumber is null, we assume they're allowed.
1379 return 0 unless defined $cardnumber;
1381 my $dbh = C4::Context->dbh;
1382 my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
1383 $query .= " AND borrowernumber <> ?" if ($borrowernumber);
1384 my $sth = $dbh->prepare($query);
1387 ( $borrowernumber ? $borrowernumber : () )
1390 return 1 if $sth->fetchrow_hashref;
1392 my ( $min_length, $max_length ) = get_cardnumber_length();
1394 if length $cardnumber > $max_length
1395 or length $cardnumber < $min_length;
1400 =head2 get_cardnumber_length
1402 my ($min, $max) = C4::Members::get_cardnumber_length()
1404 Returns the minimum and maximum length for patron cardnumbers as
1405 determined by the CardnumberLength system preference, the
1406 BorrowerMandatoryField system preference, and the width of the
1411 sub get_cardnumber_length {
1412 my ( $min, $max ) = ( 0, 16 ); # borrowers.cardnumber is a nullable varchar(16)
1413 $min = 1 if C4::Context->preference('BorrowerMandatoryField') =~ /cardnumber/;
1414 if ( my $cardnumber_length = C4::Context->preference('CardnumberLength') ) {
1415 # Is integer and length match
1416 if ( $cardnumber_length =~ m|^\d+$| ) {
1417 $min = $max = $cardnumber_length
1418 if $cardnumber_length >= $min
1419 and $cardnumber_length <= $max;
1421 # Else assuming it is a range
1422 elsif ( $cardnumber_length =~ m|(\d*),(\d*)| ) {
1423 $min = $1 if $1 and $min < $1;
1424 $max = $2 if $2 and $max > $2;
1428 return ( $min, $max );
1431 =head2 getzipnamecity (OUEST-PROVENCE)
1433 take all info from table city for the fields city and zip
1434 check for the name and the zip code of the city selected
1438 sub getzipnamecity {
1440 my $dbh = C4::Context->dbh;
1443 "select city_name,city_state,city_zipcode,city_country from cities where cityid=? ");
1444 $sth->execute($cityid);
1445 my @data = $sth->fetchrow;
1446 return $data[0], $data[1], $data[2], $data[3];
1450 =head2 getdcity (OUEST-PROVENCE)
1452 recover cityid with city_name condition
1457 my ($city_name) = @_;
1458 my $dbh = C4::Context->dbh;
1459 my $sth = $dbh->prepare("select cityid from cities where city_name=? ");
1460 $sth->execute($city_name);
1461 my $data = $sth->fetchrow;
1465 =head2 GetFirstValidEmailAddress
1467 $email = GetFirstValidEmailAddress($borrowernumber);
1469 Return the first valid email address for a borrower, given the borrowernumber. For now, the order
1470 is defined as email, emailpro, B_email. Returns the empty string if the borrower has no email
1475 sub GetFirstValidEmailAddress {
1476 my $borrowernumber = shift;
1477 my $dbh = C4::Context->dbh;
1478 my $sth = $dbh->prepare( "SELECT email, emailpro, B_email FROM borrowers where borrowernumber = ? ");
1479 $sth->execute( $borrowernumber );
1480 my $data = $sth->fetchrow_hashref;
1482 if ($data->{'email'}) {
1483 return $data->{'email'};
1484 } elsif ($data->{'emailpro'}) {
1485 return $data->{'emailpro'};
1486 } elsif ($data->{'B_email'}) {
1487 return $data->{'B_email'};
1493 =head2 GetNoticeEmailAddress
1495 $email = GetNoticeEmailAddress($borrowernumber);
1497 Return the email address of borrower used for notices, given the borrowernumber.
1498 Returns the empty string if no email address.
1502 sub GetNoticeEmailAddress {
1503 my $borrowernumber = shift;
1505 my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
1506 # if syspref is set to 'first valid' (value == OFF), look up email address
1507 if ( $which_address eq 'OFF' ) {
1508 return GetFirstValidEmailAddress($borrowernumber);
1510 # specified email address field
1511 my $dbh = C4::Context->dbh;
1512 my $sth = $dbh->prepare( qq{
1513 SELECT $which_address AS primaryemail
1515 WHERE borrowernumber=?
1517 $sth->execute($borrowernumber);
1518 my $data = $sth->fetchrow_hashref;
1519 return $data->{'primaryemail'} || '';
1522 =head2 GetExpiryDate
1524 $expirydate = GetExpiryDate($categorycode, $dateenrolled);
1526 Calculate expiry date given a categorycode and starting date. Date argument must be in ISO format.
1527 Return date is also in ISO format.
1532 my ( $categorycode, $dateenrolled ) = @_;
1534 if ($categorycode) {
1535 my $dbh = C4::Context->dbh;
1536 my $sth = $dbh->prepare("SELECT enrolmentperiod,enrolmentperioddate FROM categories WHERE categorycode=?");
1537 $sth->execute($categorycode);
1538 $enrolments = $sth->fetchrow_hashref;
1540 # die "GetExpiryDate: for enrollmentperiod $enrolmentperiod (category '$categorycode') starting $dateenrolled.\n";
1541 my @date = split (/-/,$dateenrolled);
1542 if($enrolments->{enrolmentperiod}){
1543 return sprintf("%04d-%02d-%02d", Add_Delta_YM(@date,0,$enrolments->{enrolmentperiod}));
1545 return $enrolments->{enrolmentperioddate};
1549 =head2 GetborCatFromCatType
1551 ($codes_arrayref, $labels_hashref) = &GetborCatFromCatType();
1553 Looks up the different types of borrowers in the database. Returns two
1554 elements: a reference-to-array, which lists the borrower category
1555 codes, and a reference-to-hash, which maps the borrower category codes
1556 to category descriptions.
1561 sub GetborCatFromCatType {
1562 my ( $category_type, $action, $no_branch_limit ) = @_;
1564 my $branch_limit = $no_branch_limit
1566 : C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1568 # FIXME - This API seems both limited and dangerous.
1569 my $dbh = C4::Context->dbh;
1572 SELECT categories.categorycode, categories.description
1576 LEFT JOIN categories_branches ON categories.categorycode = categories_branches.categorycode
1579 $request .= " $action ";
1580 $request .= " AND (branchcode = ? OR branchcode IS NULL) GROUP BY description" if $branch_limit;
1582 $request .= " WHERE branchcode = ? OR branchcode IS NULL GROUP BY description" if $branch_limit;
1584 $request .= " ORDER BY categorycode";
1586 my $sth = $dbh->prepare($request);
1588 $action ? $category_type : (),
1589 $branch_limit ? $branch_limit : ()
1595 while ( my $data = $sth->fetchrow_hashref ) {
1596 push @codes, $data->{'categorycode'};
1597 $labels{ $data->{'categorycode'} } = $data->{'description'};
1600 return ( \@codes, \%labels );
1603 =head2 GetBorrowercategory
1605 $hashref = &GetBorrowercategory($categorycode);
1607 Given the borrower's category code, the function returns the corresponding
1608 data hashref for a comprehensive information display.
1612 sub GetBorrowercategory {
1614 my $dbh = C4::Context->dbh;
1618 "SELECT description,dateofbirthrequired,upperagelimit,category_type
1620 WHERE categorycode = ?"
1622 $sth->execute($catcode);
1624 $sth->fetchrow_hashref;
1628 } # sub getborrowercategory
1631 =head2 GetBorrowerCategorycode
1633 $categorycode = &GetBorrowerCategoryCode( $borrowernumber );
1635 Given the borrowernumber, the function returns the corresponding categorycode
1638 sub GetBorrowerCategorycode {
1639 my ( $borrowernumber ) = @_;
1640 my $dbh = C4::Context->dbh;
1641 my $sth = $dbh->prepare( qq{
1644 WHERE borrowernumber = ?
1646 $sth->execute( $borrowernumber );
1647 return $sth->fetchrow;
1650 =head2 GetBorrowercategoryList
1652 $arrayref_hashref = &GetBorrowercategoryList;
1653 If no category code provided, the function returns all the categories.
1657 sub GetBorrowercategoryList {
1658 my $no_branch_limit = @_ ? shift : 0;
1659 my $branch_limit = $no_branch_limit
1661 : C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1662 my $dbh = C4::Context->dbh;
1663 my $query = "SELECT categories.* FROM categories";
1665 LEFT JOIN categories_branches ON categories.categorycode = categories_branches.categorycode
1666 WHERE branchcode = ? OR branchcode IS NULL GROUP BY description
1668 $query .= " ORDER BY description";
1669 my $sth = $dbh->prepare( $query );
1670 $sth->execute( $branch_limit ? $branch_limit : () );
1671 my $data = $sth->fetchall_arrayref( {} );
1674 } # sub getborrowercategory
1676 =head2 ethnicitycategories
1678 ($codes_arrayref, $labels_hashref) = ðnicitycategories();
1680 Looks up the different ethnic types in the database. Returns two
1681 elements: a reference-to-array, which lists the ethnicity codes, and a
1682 reference-to-hash, which maps the ethnicity codes to ethnicity
1689 sub ethnicitycategories {
1690 my $dbh = C4::Context->dbh;
1691 my $sth = $dbh->prepare("Select code,name from ethnicity order by name");
1695 while ( my $data = $sth->fetchrow_hashref ) {
1696 push @codes, $data->{'code'};
1697 $labels{ $data->{'code'} } = $data->{'name'};
1699 return ( \@codes, \%labels );
1704 $ethn_name = &fixEthnicity($ethn_code);
1706 Takes an ethnicity code (e.g., "european" or "pi") and returns the
1707 corresponding descriptive name from the C<ethnicity> table in the
1708 Koha database ("European" or "Pacific Islander").
1715 my $ethnicity = shift;
1716 return unless $ethnicity;
1717 my $dbh = C4::Context->dbh;
1718 my $sth = $dbh->prepare("Select name from ethnicity where code = ?");
1719 $sth->execute($ethnicity);
1720 my $data = $sth->fetchrow_hashref;
1721 return $data->{'name'};
1722 } # sub fixEthnicity
1726 $dateofbirth,$date = &GetAge($date);
1728 this function return the borrowers age with the value of dateofbirth
1734 my ( $date, $date_ref ) = @_;
1736 if ( not defined $date_ref ) {
1737 $date_ref = sprintf( '%04d-%02d-%02d', Today() );
1740 my ( $year1, $month1, $day1 ) = split /-/, $date;
1741 my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
1743 my $age = $year2 - $year1;
1744 if ( $month1 . $day1 > $month2 . $day2 ) {
1753 $cityarrayref = GetCities();
1755 Returns an array_ref of the entries in the cities table
1756 If there are entries in the table an empty row is returned
1757 This is currently only used to populate a popup in memberentry
1763 my $dbh = C4::Context->dbh;
1764 my $city_arr = $dbh->selectall_arrayref(
1765 q|SELECT cityid,city_zipcode,city_name,city_state,city_country FROM cities ORDER BY city_name|,
1767 if ( @{$city_arr} ) {
1768 unshift @{$city_arr}, {
1769 city_zipcode => q{},
1773 city_country => q{},
1780 =head2 GetSortDetails (OUEST-PROVENCE)
1782 ($lib) = &GetSortDetails($category,$sortvalue);
1784 Returns the authorized value details
1785 C<&$lib>return value of authorized value details
1786 C<&$sortvalue>this is the value of authorized value
1787 C<&$category>this is the value of authorized value category
1791 sub GetSortDetails {
1792 my ( $category, $sortvalue ) = @_;
1793 my $dbh = C4::Context->dbh;
1794 my $query = qq|SELECT lib
1795 FROM authorised_values
1797 AND authorised_value=? |;
1798 my $sth = $dbh->prepare($query);
1799 $sth->execute( $category, $sortvalue );
1800 my $lib = $sth->fetchrow;
1801 return ($lib) if ($lib);
1802 return ($sortvalue) unless ($lib);
1805 =head2 MoveMemberToDeleted
1807 $result = &MoveMemberToDeleted($borrowernumber);
1809 Copy the record from borrowers to deletedborrowers table.
1813 # FIXME: should do it in one SQL statement w/ subquery
1814 # Otherwise, we should return the @data on success
1816 sub MoveMemberToDeleted {
1817 my ($member) = shift or return;
1818 my $dbh = C4::Context->dbh;
1819 my $query = qq|SELECT *
1821 WHERE borrowernumber=?|;
1822 my $sth = $dbh->prepare($query);
1823 $sth->execute($member);
1824 my @data = $sth->fetchrow_array;
1825 (@data) or return; # if we got a bad borrowernumber, there's nothing to insert
1827 $dbh->prepare( "INSERT INTO deletedborrowers VALUES ("
1828 . ( "?," x ( scalar(@data) - 1 ) )
1830 $sth->execute(@data);
1835 DelMember($borrowernumber);
1837 This function remove directly a borrower whitout writing it on deleteborrower.
1838 + Deletes reserves for the borrower
1843 my $dbh = C4::Context->dbh;
1844 my $borrowernumber = shift;
1845 #warn "in delmember with $borrowernumber";
1846 return unless $borrowernumber; # borrowernumber is mandatory.
1848 my $query = qq|DELETE
1850 WHERE borrowernumber=?|;
1851 my $sth = $dbh->prepare($query);
1852 $sth->execute($borrowernumber);
1856 WHERE borrowernumber = ?
1858 $sth = $dbh->prepare($query);
1859 $sth->execute($borrowernumber);
1860 logaction("MEMBERS", "DELETE", $borrowernumber, "") if C4::Context->preference("BorrowersLog");
1864 =head2 ExtendMemberSubscriptionTo (OUEST-PROVENCE)
1866 $date = ExtendMemberSubscriptionTo($borrowerid, $date);
1868 Extending the subscription to a given date or to the expiry date calculated on ISO date.
1873 sub ExtendMemberSubscriptionTo {
1874 my ( $borrowerid,$date) = @_;
1875 my $dbh = C4::Context->dbh;
1876 my $borrower = GetMember('borrowernumber'=>$borrowerid);
1878 $date = (C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry') ?
1879 C4::Dates->new($borrower->{'dateexpiry'}, 'iso')->output("iso") :
1880 C4::Dates->new()->output("iso");
1881 $date = GetExpiryDate( $borrower->{'categorycode'}, $date );
1883 my $sth = $dbh->do(<<EOF);
1885 SET dateexpiry='$date'
1886 WHERE borrowernumber='$borrowerid'
1889 AddEnrolmentFeeIfNeeded( $borrower->{categorycode}, $borrower->{borrowernumber} );
1891 logaction("MEMBERS", "RENEW", $borrower->{'borrowernumber'}, "Membership renewed")if C4::Context->preference("BorrowersLog");
1892 return $date if ($sth);
1896 =head2 GetTitles (OUEST-PROVENCE)
1898 ($borrowertitle)= &GetTitles();
1900 Looks up the different title . Returns array with all borrowers title
1905 my @borrowerTitle = split (/,|\|/,C4::Context->preference('BorrowersTitles'));
1906 unshift( @borrowerTitle, "" );
1907 my $count=@borrowerTitle;
1912 return ( \@borrowerTitle);
1916 =head2 GetPatronImage
1918 my ($imagedata, $dberror) = GetPatronImage($borrowernumber);
1920 Returns the mimetype and binary image data of the image for the patron with the supplied borrowernumber.
1924 sub GetPatronImage {
1925 my ($borrowernumber) = @_;
1926 warn "Borrowernumber passed to GetPatronImage is $borrowernumber" if $debug;
1927 my $dbh = C4::Context->dbh;
1928 my $query = 'SELECT mimetype, imagefile FROM patronimage WHERE borrowernumber = ?';
1929 my $sth = $dbh->prepare($query);
1930 $sth->execute($borrowernumber);
1931 my $imagedata = $sth->fetchrow_hashref;
1932 warn "Database error!" if $sth->errstr;
1933 return $imagedata, $sth->errstr;
1936 =head2 PutPatronImage
1938 PutPatronImage($cardnumber, $mimetype, $imgfile);
1940 Stores patron binary image data and mimetype in database.
1941 NOTE: This function is good for updating images as well as inserting new images in the database.
1945 sub PutPatronImage {
1946 my ($cardnumber, $mimetype, $imgfile) = @_;
1947 warn "Parameters passed in: Cardnumber=$cardnumber, Mimetype=$mimetype, " . ($imgfile ? "Imagefile" : "No Imagefile") if $debug;
1948 my $dbh = C4::Context->dbh;
1949 my $query = "INSERT INTO patronimage (borrowernumber, mimetype, imagefile) VALUES ( ( SELECT borrowernumber from borrowers WHERE cardnumber = ? ),?,?) ON DUPLICATE KEY UPDATE imagefile = ?;";
1950 my $sth = $dbh->prepare($query);
1951 $sth->execute($cardnumber,$mimetype,$imgfile,$imgfile);
1952 warn "Error returned inserting $cardnumber.$mimetype." if $sth->errstr;
1953 return $sth->errstr;
1956 =head2 RmPatronImage
1958 my ($dberror) = RmPatronImage($borrowernumber);
1960 Removes the image for the patron with the supplied borrowernumber.
1965 my ($borrowernumber) = @_;
1966 warn "Borrowernumber passed to GetPatronImage is $borrowernumber" if $debug;
1967 my $dbh = C4::Context->dbh;
1968 my $query = "DELETE FROM patronimage WHERE borrowernumber = ?;";
1969 my $sth = $dbh->prepare($query);
1970 $sth->execute($borrowernumber);
1971 my $dberror = $sth->errstr;
1972 warn "Database error!" if $sth->errstr;
1976 =head2 GetHideLostItemsPreference
1978 $hidelostitemspref = &GetHideLostItemsPreference($borrowernumber);
1980 Returns the HideLostItems preference for the patron category of the supplied borrowernumber
1981 C<&$hidelostitemspref>return value of function, 0 or 1
1985 sub GetHideLostItemsPreference {
1986 my ($borrowernumber) = @_;
1987 my $dbh = C4::Context->dbh;
1988 my $query = "SELECT hidelostitems FROM borrowers,categories WHERE borrowers.categorycode = categories.categorycode AND borrowernumber = ?";
1989 my $sth = $dbh->prepare($query);
1990 $sth->execute($borrowernumber);
1991 my $hidelostitems = $sth->fetchrow;
1992 return $hidelostitems;
1995 =head2 GetBorrowersToExpunge
1997 $borrowers = &GetBorrowersToExpunge(
1998 not_borrowered_since => $not_borrowered_since,
1999 expired_before => $expired_before,
2000 category_code => $category_code,
2001 branchcode => $branchcode
2004 This function get all borrowers based on the given criteria.
2008 sub GetBorrowersToExpunge {
2011 my $filterdate = $params->{'not_borrowered_since'};
2012 my $filterexpiry = $params->{'expired_before'};
2013 my $filtercategory = $params->{'category_code'};
2014 my $filterbranch = $params->{'branchcode'} ||
2015 ((C4::Context->preference('IndependentBranches')
2016 && C4::Context->userenv
2017 && !C4::Context->IsSuperLibrarian()
2018 && C4::Context->userenv->{branch})
2019 ? C4::Context->userenv->{branch}
2022 my $dbh = C4::Context->dbh;
2024 SELECT borrowers.borrowernumber,
2025 MAX(old_issues.timestamp) AS latestissue,
2026 MAX(issues.timestamp) AS currentissue
2028 JOIN categories USING (categorycode)
2029 LEFT JOIN old_issues USING (borrowernumber)
2030 LEFT JOIN issues USING (borrowernumber)
2031 WHERE category_type <> 'S'
2032 AND borrowernumber NOT IN (SELECT guarantorid FROM borrowers WHERE guarantorid IS NOT NULL AND guarantorid <> 0)
2035 if ( $filterbranch && $filterbranch ne "" ) {
2036 $query.= " AND borrowers.branchcode = ? ";
2037 push( @query_params, $filterbranch );
2039 if ( $filterexpiry ) {
2040 $query .= " AND dateexpiry < ? ";
2041 push( @query_params, $filterexpiry );
2043 if ( $filtercategory ) {
2044 $query .= " AND categorycode = ? ";
2045 push( @query_params, $filtercategory );
2047 $query.=" GROUP BY borrowers.borrowernumber HAVING currentissue IS NULL ";
2048 if ( $filterdate ) {
2049 $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
2050 push @query_params,$filterdate;
2052 warn $query if $debug;
2054 my $sth = $dbh->prepare($query);
2055 if (scalar(@query_params)>0){
2056 $sth->execute(@query_params);
2063 while ( my $data = $sth->fetchrow_hashref ) {
2064 push @results, $data;
2069 =head2 GetBorrowersWhoHaveNeverBorrowed
2071 $results = &GetBorrowersWhoHaveNeverBorrowed
2073 This function get all borrowers who have never borrowed.
2075 I<$result> is a ref to an array which all elements are a hasref.
2079 sub GetBorrowersWhoHaveNeverBorrowed {
2080 my $filterbranch = shift ||
2081 ((C4::Context->preference('IndependentBranches')
2082 && C4::Context->userenv
2083 && !C4::Context->IsSuperLibrarian()
2084 && C4::Context->userenv->{branch})
2085 ? C4::Context->userenv->{branch}
2087 my $dbh = C4::Context->dbh;
2089 SELECT borrowers.borrowernumber,max(timestamp) as latestissue
2091 LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
2092 WHERE issues.borrowernumber IS NULL
2095 if ($filterbranch && $filterbranch ne ""){
2096 $query.=" AND borrowers.branchcode= ?";
2097 push @query_params,$filterbranch;
2099 warn $query if $debug;
2101 my $sth = $dbh->prepare($query);
2102 if (scalar(@query_params)>0){
2103 $sth->execute(@query_params);
2110 while ( my $data = $sth->fetchrow_hashref ) {
2111 push @results, $data;
2116 =head2 GetBorrowersWithIssuesHistoryOlderThan
2118 $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
2120 this function get all borrowers who has an issue history older than I<$date> given on input arg.
2122 I<$result> is a ref to an array which all elements are a hashref.
2123 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2127 sub GetBorrowersWithIssuesHistoryOlderThan {
2128 my $dbh = C4::Context->dbh;
2129 my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
2130 my $filterbranch = shift ||
2131 ((C4::Context->preference('IndependentBranches')
2132 && C4::Context->userenv
2133 && !C4::Context->IsSuperLibrarian()
2134 && C4::Context->userenv->{branch})
2135 ? C4::Context->userenv->{branch}
2138 SELECT count(borrowernumber) as n,borrowernumber
2140 WHERE returndate < ?
2141 AND borrowernumber IS NOT NULL
2144 push @query_params, $date;
2146 $query.=" AND branchcode = ?";
2147 push @query_params, $filterbranch;
2149 $query.=" GROUP BY borrowernumber ";
2150 warn $query if $debug;
2151 my $sth = $dbh->prepare($query);
2152 $sth->execute(@query_params);
2155 while ( my $data = $sth->fetchrow_hashref ) {
2156 push @results, $data;
2161 =head2 GetBorrowersNamesAndLatestIssue
2163 $results = &GetBorrowersNamesAndLatestIssueList(@borrowernumbers)
2165 this function get borrowers Names and surnames and Issue information.
2167 I<@borrowernumbers> is an array which all elements are borrowernumbers.
2168 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2172 sub GetBorrowersNamesAndLatestIssue {
2173 my $dbh = C4::Context->dbh;
2174 my @borrowernumbers=@_;
2176 SELECT surname,lastname, phone, email,max(timestamp)
2178 LEFT JOIN issues ON borrowers.borrowernumber=issues.borrowernumber
2179 GROUP BY borrowernumber
2181 my $sth = $dbh->prepare($query);
2183 my $results = $sth->fetchall_arrayref({});
2191 my $success = ModPrivacy( $borrowernumber, $privacy );
2193 Update the privacy of a patron.
2196 true on success, false on failure
2203 my $borrowernumber = shift;
2204 my $privacy = shift;
2205 return unless defined $borrowernumber;
2206 return unless $borrowernumber =~ /^\d+$/;
2208 return ModMember( borrowernumber => $borrowernumber,
2209 privacy => $privacy );
2214 AddMessage( $borrowernumber, $message_type, $message, $branchcode );
2216 Adds a message to the messages table for the given borrower.
2225 my ( $borrowernumber, $message_type, $message, $branchcode ) = @_;
2227 my $dbh = C4::Context->dbh;
2229 if ( ! ( $borrowernumber && $message_type && $message && $branchcode ) ) {
2233 my $query = "INSERT INTO messages ( borrowernumber, branchcode, message_type, message ) VALUES ( ?, ?, ?, ? )";
2234 my $sth = $dbh->prepare($query);
2235 $sth->execute( $borrowernumber, $branchcode, $message_type, $message );
2236 logaction("MEMBERS", "ADDCIRCMESSAGE", $borrowernumber, $message) if C4::Context->preference("BorrowersLog");
2242 GetMessages( $borrowernumber, $type );
2244 $type is message type, B for borrower, or L for Librarian.
2245 Empty type returns all messages of any type.
2247 Returns all messages for the given borrowernumber
2252 my ( $borrowernumber, $type, $branchcode ) = @_;
2258 my $dbh = C4::Context->dbh;
2261 branches.branchname,
2264 messages.branchcode LIKE '$branchcode' AS can_delete
2265 FROM messages, branches
2266 WHERE borrowernumber = ?
2267 AND message_type LIKE ?
2268 AND messages.branchcode = branches.branchcode
2269 ORDER BY message_date DESC";
2270 my $sth = $dbh->prepare($query);
2271 $sth->execute( $borrowernumber, $type ) ;
2274 while ( my $data = $sth->fetchrow_hashref ) {
2275 my $d = C4::Dates->new( $data->{message_date}, 'iso' );
2276 $data->{message_date_formatted} = $d->output;
2277 push @results, $data;
2285 GetMessagesCount( $borrowernumber, $type );
2287 $type is message type, B for borrower, or L for Librarian.
2288 Empty type returns all messages of any type.
2290 Returns the number of messages for the given borrowernumber
2294 sub GetMessagesCount {
2295 my ( $borrowernumber, $type, $branchcode ) = @_;
2301 my $dbh = C4::Context->dbh;
2303 my $query = "SELECT COUNT(*) as MsgCount FROM messages WHERE borrowernumber = ? AND message_type LIKE ?";
2304 my $sth = $dbh->prepare($query);
2305 $sth->execute( $borrowernumber, $type ) ;
2308 my $data = $sth->fetchrow_hashref;
2309 my $count = $data->{'MsgCount'};
2316 =head2 DeleteMessage
2318 DeleteMessage( $message_id );
2323 my ( $message_id ) = @_;
2325 my $dbh = C4::Context->dbh;
2326 my $query = "SELECT * FROM messages WHERE message_id = ?";
2327 my $sth = $dbh->prepare($query);
2328 $sth->execute( $message_id );
2329 my $message = $sth->fetchrow_hashref();
2331 $query = "DELETE FROM messages WHERE message_id = ?";
2332 $sth = $dbh->prepare($query);
2333 $sth->execute( $message_id );
2334 logaction("MEMBERS", "DELCIRCMESSAGE", $message->{'borrowernumber'}, $message->{'message'}) if C4::Context->preference("BorrowersLog");
2339 IssueSlip($branchcode, $borrowernumber, $quickslip)
2341 Returns letter hash ( see C4::Letters::GetPreparedLetter )
2343 $quickslip is boolean, to indicate whether we want a quick slip
2348 my ($branch, $borrowernumber, $quickslip) = @_;
2350 # return unless ( C4::Context->boolean_preference('printcirculationslips') );
2352 my $now = POSIX::strftime("%Y-%m-%d", localtime);
2354 my $issueslist = GetPendingIssues($borrowernumber);
2355 foreach my $it (@$issueslist){
2356 if ((substr $it->{'issuedate'}, 0, 10) eq $now || (substr $it->{'lastreneweddate'}, 0, 10) eq $now) {
2359 elsif ((substr $it->{'date_due'}, 0, 10) le $now) {
2360 $it->{'overdue'} = 1;
2362 my $dt = dt_from_string( $it->{'date_due'} );
2363 $it->{'date_due'} = output_pref( $dt );;
2365 my @issues = sort { $b->{'timestamp'} <=> $a->{'timestamp'} } @$issueslist;
2367 my ($letter_code, %repeat);
2369 $letter_code = 'ISSUEQSLIP';
2371 'checkedout' => [ map {
2375 }, grep { $_->{'now'} } @issues ],
2379 $letter_code = 'ISSUESLIP';
2381 'checkedout' => [ map {
2385 }, grep { !$_->{'overdue'} } @issues ],
2387 'overdue' => [ map {
2391 }, grep { $_->{'overdue'} } @issues ],
2394 $_->{'timestamp'} = $_->{'newdate'};
2396 } @{ GetNewsToDisplay("slip",$branch) } ],
2400 return C4::Letters::GetPreparedLetter (
2401 module => 'circulation',
2402 letter_code => $letter_code,
2403 branchcode => $branch,
2405 'branches' => $branch,
2406 'borrowers' => $borrowernumber,
2412 =head2 GetBorrowersWithEmail
2414 ([$borrnum,$userid], ...) = GetBorrowersWithEmail('me@example.com');
2416 This gets a list of users and their basic details from their email address.
2417 As it's possible for multiple user to have the same email address, it provides
2418 you with all of them. If there is no userid for the user, there will be an
2419 C<undef> there. An empty list will be returned if there are no matches.
2423 sub GetBorrowersWithEmail {
2426 my $dbh = C4::Context->dbh;
2428 my $query = "SELECT borrowernumber, userid FROM borrowers WHERE email=?";
2429 my $sth=$dbh->prepare($query);
2430 $sth->execute($email);
2432 while (my $ref = $sth->fetch) {
2435 die "Failure searching for borrowers by email address: $sth->errstr" if $sth->err;
2439 sub AddMember_Opac {
2440 my ( %borrower ) = @_;
2442 $borrower{'categorycode'} = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
2444 my $sr = new String::Random;
2445 $sr->{'A'} = [ 'A'..'Z', 'a'..'z' ];
2446 my $password = $sr->randpattern("AAAAAAAAAA");
2447 $borrower{'password'} = $password;
2449 $borrower{'cardnumber'} = fixup_cardnumber();
2451 my $borrowernumber = AddMember(%borrower);
2453 return ( $borrowernumber, $password );
2456 =head2 AddEnrolmentFeeIfNeeded
2458 AddEnrolmentFeeIfNeeded( $borrower->{categorycode}, $borrower->{borrowernumber} );
2460 Add enrolment fee for a patron if needed.
2464 sub AddEnrolmentFeeIfNeeded {
2465 my ( $categorycode, $borrowernumber ) = @_;
2466 # check for enrollment fee & add it if needed
2467 my $dbh = C4::Context->dbh;
2468 my $sth = $dbh->prepare(q{
2471 WHERE categorycode=?
2473 $sth->execute( $categorycode );
2475 warn sprintf('Database returned the following error: %s', $sth->errstr);
2478 my ($enrolmentfee) = $sth->fetchrow;
2479 if ($enrolmentfee && $enrolmentfee > 0) {
2480 # insert fee in patron debts
2481 C4::Accounts::manualinvoice( $borrowernumber, '', '', 'A', $enrolmentfee );
2486 my ( $borrowernumber ) = @_;
2488 my $sql = "SELECT COUNT(*) FROM issues WHERE date_due < NOW() AND borrowernumber = ?";
2489 my $sth = C4::Context->dbh->prepare( $sql );
2490 $sth->execute( $borrowernumber );
2491 my ( $count ) = $sth->fetchrow_array();
2496 END { } # module clean-up code here (global destructor)