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 ) ) {
890 =head2 Generate_Userid
892 my $newuid = Generate_Userid($borrowernumber, $firstname, $surname);
894 Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
896 $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.
899 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).
903 sub Generate_Userid {
904 my ($borrowernumber, $firstname, $surname) = @_;
907 #The script will "do" the following code and increment the $offset until Check_Userid = 1 (i.e. until $newuid comes back as unique)
909 $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
910 $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
911 $newuid = lc(($firstname)? "$firstname.$surname" : $surname);
912 $newuid = unac_string('utf-8',$newuid);
913 $newuid .= $offset unless $offset == 0;
916 } while (!Check_Userid($newuid,$borrowernumber));
922 my ( $uid, $member, $digest ) = @_;
923 my $dbh = C4::Context->dbh;
925 #Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
926 #Then we need to tell the user and have them create a new one.
930 "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
931 $sth->execute( $uid, $member );
932 if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
936 #Everything is good so we can update the information.
939 "update borrowers set userid=?, password=? where borrowernumber=?");
940 $sth->execute( $uid, $digest, $member );
944 logaction("MEMBERS", "CHANGE PASS", $member, "") if C4::Context->preference("BorrowersLog");
950 =head2 fixup_cardnumber
952 Warning: The caller is responsible for locking the members table in write
953 mode, to avoid database corruption.
957 use vars qw( @weightings );
958 my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
960 sub fixup_cardnumber {
961 my ($cardnumber) = @_;
962 my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;
964 # Find out whether member numbers should be generated
965 # automatically. Should be either "1" or something else.
966 # Defaults to "0", which is interpreted as "no".
968 # if ($cardnumber !~ /\S/ && $autonumber_members) {
969 ($autonumber_members) or return $cardnumber;
970 my $checkdigit = C4::Context->preference('checkdigit');
971 my $dbh = C4::Context->dbh;
972 if ( $checkdigit and $checkdigit eq 'katipo' ) {
974 # if checkdigit is selected, calculate katipo-style cardnumber.
975 # otherwise, just use the max()
976 # purpose: generate checksum'd member numbers.
977 # We'll assume we just got the max value of digits 2-8 of member #'s
978 # from the database and our job is to increment that by one,
979 # determine the 1st and 9th digits and return the full string.
980 my $sth = $dbh->prepare(
981 "select max(substring(borrowers.cardnumber,2,7)) as new_num from borrowers"
984 my $data = $sth->fetchrow_hashref;
985 $cardnumber = $data->{new_num};
986 if ( !$cardnumber ) { # If DB has no values,
987 $cardnumber = 1000000; # start at 1000000
993 for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
994 # read weightings, left to right, 1 char at a time
995 my $temp1 = $weightings[$i];
997 # sequence left to right, 1 char at a time
998 my $temp2 = substr( $cardnumber, $i, 1 );
1000 # mult each char 1-7 by its corresponding weighting
1001 $sum += $temp1 * $temp2;
1004 my $rem = ( $sum % 11 );
1005 $rem = 'X' if $rem == 10;
1007 return "V$cardnumber$rem";
1010 my $sth = $dbh->prepare(
1011 'SELECT MAX( CAST( cardnumber AS SIGNED ) ) FROM borrowers WHERE cardnumber REGEXP "^-?[0-9]+$"'
1014 my ($result) = $sth->fetchrow;
1017 return $cardnumber; # just here as a fallback/reminder
1020 =head2 GetGuarantees
1022 ($num_children, $children_arrayref) = &GetGuarantees($parent_borrno);
1023 $child0_cardno = $children_arrayref->[0]{"cardnumber"};
1024 $child0_borrno = $children_arrayref->[0]{"borrowernumber"};
1026 C<&GetGuarantees> takes a borrower number (e.g., that of a patron
1027 with children) and looks up the borrowers who are guaranteed by that
1028 borrower (i.e., the patron's children).
1030 C<&GetGuarantees> returns two values: an integer giving the number of
1031 borrowers guaranteed by C<$parent_borrno>, and a reference to an array
1032 of references to hash, which gives the actual results.
1038 my ($borrowernumber) = @_;
1039 my $dbh = C4::Context->dbh;
1042 "select cardnumber,borrowernumber, firstname, surname from borrowers where guarantorid=?"
1044 $sth->execute($borrowernumber);
1047 my $data = $sth->fetchall_arrayref({});
1048 return ( scalar(@$data), $data );
1051 =head2 UpdateGuarantees
1053 &UpdateGuarantees($parent_borrno);
1056 C<&UpdateGuarantees> borrower data for an adult and updates all the guarantees
1057 with the modified information
1062 sub UpdateGuarantees {
1064 my $dbh = C4::Context->dbh;
1065 my ( $count, $guarantees ) = GetGuarantees( $data{'borrowernumber'} );
1066 foreach my $guarantee (@$guarantees){
1067 my $guaquery = qq|UPDATE borrowers
1068 SET address=?,fax=?,B_city=?,mobile=?,city=?,phone=?
1069 WHERE borrowernumber=?
1071 my $sth = $dbh->prepare($guaquery);
1072 $sth->execute($data{'address'},$data{'fax'},$data{'B_city'},$data{'mobile'},$data{'city'},$data{'phone'},$guarantee->{'borrowernumber'});
1075 =head2 GetPendingIssues
1077 my $issues = &GetPendingIssues(@borrowernumber);
1079 Looks up what the patron with the given borrowernumber has borrowed.
1081 C<&GetPendingIssues> returns a
1082 reference-to-array where each element is a reference-to-hash; the
1083 keys are the fields from the C<issues>, C<biblio>, and C<items> tables.
1084 The keys include C<biblioitems> fields except marc and marcxml.
1089 sub GetPendingIssues {
1090 my @borrowernumbers = @_;
1092 unless (@borrowernumbers ) { # return a ref_to_array
1093 return \@borrowernumbers; # to not cause surprise to caller
1096 # Borrowers part of the query
1098 for (my $i = 0; $i < @borrowernumbers; $i++) {
1099 $bquery .= ' issues.borrowernumber = ?';
1100 if ($i < $#borrowernumbers ) {
1105 # must avoid biblioitems.* to prevent large marc and marcxml fields from killing performance
1106 # FIXME: namespace collision: each table has "timestamp" fields. Which one is "timestamp" ?
1107 # FIXME: circ/ciculation.pl tries to sort by timestamp!
1108 # FIXME: namespace collision: other collisions possible.
1109 # FIXME: most of this data isn't really being used by callers.
1116 biblioitems.itemtype,
1119 biblioitems.publicationyear,
1120 biblioitems.publishercode,
1121 biblioitems.volumedate,
1122 biblioitems.volumedesc,
1125 borrowers.firstname,
1127 borrowers.cardnumber,
1128 issues.timestamp AS timestamp,
1129 issues.renewals AS renewals,
1130 issues.borrowernumber AS borrowernumber,
1131 items.renewals AS totalrenewals
1133 LEFT JOIN items ON items.itemnumber = issues.itemnumber
1134 LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
1135 LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
1136 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
1139 ORDER BY issues.issuedate"
1142 my $sth = C4::Context->dbh->prepare($query);
1143 $sth->execute(@borrowernumbers);
1144 my $data = $sth->fetchall_arrayref({});
1145 my $tz = C4::Context->tz();
1146 my $today = DateTime->now( time_zone => $tz);
1147 foreach (@{$data}) {
1148 if ($_->{issuedate}) {
1149 $_->{issuedate} = dt_from_string($_->{issuedate}, 'sql');
1151 $_->{date_due} or next;
1152 $_->{date_due} = DateTime::Format::DateParse->parse_datetime($_->{date_due}, $tz->name());
1153 if ( DateTime->compare($_->{date_due}, $today) == -1 ) {
1162 $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
1164 Looks up what the patron with the given borrowernumber has borrowed,
1165 and sorts the results.
1167 C<$sortkey> is the name of a field on which to sort the results. This
1168 should be the name of a field in the C<issues>, C<biblio>,
1169 C<biblioitems>, or C<items> table in the Koha database.
1171 C<$limit> is the maximum number of results to return.
1173 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
1174 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
1175 C<items> tables of the Koha database.
1181 my ( $borrowernumber, $order, $limit ) = @_;
1183 my $dbh = C4::Context->dbh;
1185 'SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1187 LEFT JOIN items on items.itemnumber=issues.itemnumber
1188 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1189 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1190 WHERE borrowernumber=?
1192 SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1194 LEFT JOIN items on items.itemnumber=old_issues.itemnumber
1195 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1196 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1197 WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL
1198 order by ' . $order;
1200 $query .= " limit $limit";
1203 my $sth = $dbh->prepare($query);
1204 $sth->execute( $borrowernumber, $borrowernumber );
1205 return $sth->fetchall_arrayref( {} );
1209 =head2 GetMemberAccountRecords
1211 ($total, $acctlines, $count) = &GetMemberAccountRecords($borrowernumber);
1213 Looks up accounting data for the patron with the given borrowernumber.
1215 C<&GetMemberAccountRecords> returns a three-element array. C<$acctlines> is a
1216 reference-to-array, where each element is a reference-to-hash; the
1217 keys are the fields of the C<accountlines> table in the Koha database.
1218 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1219 total amount outstanding for all of the account lines.
1223 sub GetMemberAccountRecords {
1224 my ($borrowernumber) = @_;
1225 my $dbh = C4::Context->dbh;
1231 WHERE borrowernumber=?);
1232 $strsth.=" ORDER BY date desc,timestamp DESC";
1233 my $sth= $dbh->prepare( $strsth );
1234 $sth->execute( $borrowernumber );
1237 while ( my $data = $sth->fetchrow_hashref ) {
1238 if ( $data->{itemnumber} ) {
1239 my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
1240 $data->{biblionumber} = $biblio->{biblionumber};
1241 $data->{title} = $biblio->{title};
1243 $acctlines[$numlines] = $data;
1245 $total += int(1000 * $data->{'amountoutstanding'}); # convert float to integer to avoid round-off errors
1248 return ( $total, \@acctlines,$numlines);
1251 =head2 GetMemberAccountBalance
1253 ($total_balance, $non_issue_balance, $other_charges) = &GetMemberAccountBalance($borrowernumber);
1255 Calculates amount immediately owing by the patron - non-issue charges.
1256 Based on GetMemberAccountRecords.
1257 Charges exempt from non-issue are:
1259 * Rent (rental) if RentalsInNoissuesCharge syspref is set to false
1260 * Manual invoices if ManInvInNoissuesCharge syspref is set to false
1264 sub GetMemberAccountBalance {
1265 my ($borrowernumber) = @_;
1267 my $ACCOUNT_TYPE_LENGTH = 5; # this is plain ridiculous...
1269 my @not_fines = ('Res');
1270 push @not_fines, 'Rent' unless C4::Context->preference('RentalsInNoissuesCharge');
1271 unless ( C4::Context->preference('ManInvInNoissuesCharge') ) {
1272 my $dbh = C4::Context->dbh;
1273 my $man_inv_types = $dbh->selectcol_arrayref(qq{SELECT authorised_value FROM authorised_values WHERE category = 'MANUAL_INV'});
1274 push @not_fines, map substr($_, 0, $ACCOUNT_TYPE_LENGTH), @$man_inv_types;
1276 my %not_fine = map {$_ => 1} @not_fines;
1278 my ($total, $acctlines) = GetMemberAccountRecords($borrowernumber);
1279 my $other_charges = 0;
1280 foreach (@$acctlines) {
1281 $other_charges += $_->{amountoutstanding} if $not_fine{ substr($_->{accounttype}, 0, $ACCOUNT_TYPE_LENGTH) };
1284 return ( $total, $total - $other_charges, $other_charges);
1287 =head2 GetBorNotifyAcctRecord
1289 ($total, $acctlines, $count) = &GetBorNotifyAcctRecord($params,$notifyid);
1291 Looks up accounting data for the patron with the given borrowernumber per file number.
1293 C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a
1294 reference-to-array, where each element is a reference-to-hash; the
1295 keys are the fields of the C<accountlines> table in the Koha database.
1296 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1297 total amount outstanding for all of the account lines.
1301 sub GetBorNotifyAcctRecord {
1302 my ( $borrowernumber, $notifyid ) = @_;
1303 my $dbh = C4::Context->dbh;
1306 my $sth = $dbh->prepare(
1309 WHERE borrowernumber=?
1311 AND amountoutstanding != '0'
1312 ORDER BY notify_id,accounttype
1315 $sth->execute( $borrowernumber, $notifyid );
1317 while ( my $data = $sth->fetchrow_hashref ) {
1318 if ( $data->{itemnumber} ) {
1319 my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
1320 $data->{biblionumber} = $biblio->{biblionumber};
1321 $data->{title} = $biblio->{title};
1323 $acctlines[$numlines] = $data;
1325 $total += int(100 * $data->{'amountoutstanding'});
1328 return ( $total, \@acctlines, $numlines );
1331 =head2 checkuniquemember (OUEST-PROVENCE)
1333 ($result,$categorycode) = &checkuniquemember($collectivity,$surname,$firstname,$dateofbirth);
1335 Checks that a member exists or not in the database.
1337 C<&result> is nonzero (=exist) or 0 (=does not exist)
1338 C<&categorycode> is from categorycode table
1339 C<&collectivity> is 1 (= we add a collectivity) or 0 (= we add a physical member)
1340 C<&surname> is the surname
1341 C<&firstname> is the firstname (only if collectivity=0)
1342 C<&dateofbirth> is the date of birth in ISO format (only if collectivity=0)
1346 # FIXME: This function is not legitimate. Multiple patrons might have the same first/last name and birthdate.
1347 # This is especially true since first name is not even a required field.
1349 sub checkuniquemember {
1350 my ( $collectivity, $surname, $firstname, $dateofbirth ) = @_;
1351 my $dbh = C4::Context->dbh;
1352 my $request = ($collectivity) ?
1353 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? " :
1355 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=? and dateofbirth=?" :
1356 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=?";
1357 my $sth = $dbh->prepare($request);
1358 if ($collectivity) {
1359 $sth->execute( uc($surname) );
1360 } elsif($dateofbirth){
1361 $sth->execute( uc($surname), ucfirst($firstname), $dateofbirth );
1363 $sth->execute( uc($surname), ucfirst($firstname));
1365 my @data = $sth->fetchrow;
1366 ( $data[0] ) and return $data[0], $data[1];
1370 sub checkcardnumber {
1371 my ( $cardnumber, $borrowernumber ) = @_;
1373 # If cardnumber is null, we assume they're allowed.
1374 return 0 unless defined $cardnumber;
1376 my $dbh = C4::Context->dbh;
1377 my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
1378 $query .= " AND borrowernumber <> ?" if ($borrowernumber);
1379 my $sth = $dbh->prepare($query);
1382 ( $borrowernumber ? $borrowernumber : () )
1385 return 1 if $sth->fetchrow_hashref;
1387 my ( $min_length, $max_length ) = get_cardnumber_length();
1389 if length $cardnumber > $max_length
1390 or length $cardnumber < $min_length;
1395 =head2 get_cardnumber_length
1397 my ($min, $max) = C4::Members::get_cardnumber_length()
1399 Returns the minimum and maximum length for patron cardnumbers as
1400 determined by the CardnumberLength system preference, the
1401 BorrowerMandatoryField system preference, and the width of the
1406 sub get_cardnumber_length {
1407 my ( $min, $max ) = ( 0, 16 ); # borrowers.cardnumber is a nullable varchar(16)
1408 $min = 1 if C4::Context->preference('BorrowerMandatoryField') =~ /cardnumber/;
1409 if ( my $cardnumber_length = C4::Context->preference('CardnumberLength') ) {
1410 # Is integer and length match
1411 if ( $cardnumber_length =~ m|^\d+$| ) {
1412 $min = $max = $cardnumber_length
1413 if $cardnumber_length >= $min
1414 and $cardnumber_length <= $max;
1416 # Else assuming it is a range
1417 elsif ( $cardnumber_length =~ m|(\d*),(\d*)| ) {
1418 $min = $1 if $1 and $min < $1;
1419 $max = $2 if $2 and $max > $2;
1423 return ( $min, $max );
1426 =head2 getzipnamecity (OUEST-PROVENCE)
1428 take all info from table city for the fields city and zip
1429 check for the name and the zip code of the city selected
1433 sub getzipnamecity {
1435 my $dbh = C4::Context->dbh;
1438 "select city_name,city_state,city_zipcode,city_country from cities where cityid=? ");
1439 $sth->execute($cityid);
1440 my @data = $sth->fetchrow;
1441 return $data[0], $data[1], $data[2], $data[3];
1445 =head2 getdcity (OUEST-PROVENCE)
1447 recover cityid with city_name condition
1452 my ($city_name) = @_;
1453 my $dbh = C4::Context->dbh;
1454 my $sth = $dbh->prepare("select cityid from cities where city_name=? ");
1455 $sth->execute($city_name);
1456 my $data = $sth->fetchrow;
1460 =head2 GetFirstValidEmailAddress
1462 $email = GetFirstValidEmailAddress($borrowernumber);
1464 Return the first valid email address for a borrower, given the borrowernumber. For now, the order
1465 is defined as email, emailpro, B_email. Returns the empty string if the borrower has no email
1470 sub GetFirstValidEmailAddress {
1471 my $borrowernumber = shift;
1472 my $dbh = C4::Context->dbh;
1473 my $sth = $dbh->prepare( "SELECT email, emailpro, B_email FROM borrowers where borrowernumber = ? ");
1474 $sth->execute( $borrowernumber );
1475 my $data = $sth->fetchrow_hashref;
1477 if ($data->{'email'}) {
1478 return $data->{'email'};
1479 } elsif ($data->{'emailpro'}) {
1480 return $data->{'emailpro'};
1481 } elsif ($data->{'B_email'}) {
1482 return $data->{'B_email'};
1488 =head2 GetNoticeEmailAddress
1490 $email = GetNoticeEmailAddress($borrowernumber);
1492 Return the email address of borrower used for notices, given the borrowernumber.
1493 Returns the empty string if no email address.
1497 sub GetNoticeEmailAddress {
1498 my $borrowernumber = shift;
1500 my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
1501 # if syspref is set to 'first valid' (value == OFF), look up email address
1502 if ( $which_address eq 'OFF' ) {
1503 return GetFirstValidEmailAddress($borrowernumber);
1505 # specified email address field
1506 my $dbh = C4::Context->dbh;
1507 my $sth = $dbh->prepare( qq{
1508 SELECT $which_address AS primaryemail
1510 WHERE borrowernumber=?
1512 $sth->execute($borrowernumber);
1513 my $data = $sth->fetchrow_hashref;
1514 return $data->{'primaryemail'} || '';
1517 =head2 GetExpiryDate
1519 $expirydate = GetExpiryDate($categorycode, $dateenrolled);
1521 Calculate expiry date given a categorycode and starting date. Date argument must be in ISO format.
1522 Return date is also in ISO format.
1527 my ( $categorycode, $dateenrolled ) = @_;
1529 if ($categorycode) {
1530 my $dbh = C4::Context->dbh;
1531 my $sth = $dbh->prepare("SELECT enrolmentperiod,enrolmentperioddate FROM categories WHERE categorycode=?");
1532 $sth->execute($categorycode);
1533 $enrolments = $sth->fetchrow_hashref;
1535 # die "GetExpiryDate: for enrollmentperiod $enrolmentperiod (category '$categorycode') starting $dateenrolled.\n";
1536 my @date = split (/-/,$dateenrolled);
1537 if($enrolments->{enrolmentperiod}){
1538 return sprintf("%04d-%02d-%02d", Add_Delta_YM(@date,0,$enrolments->{enrolmentperiod}));
1540 return $enrolments->{enrolmentperioddate};
1544 =head2 GetborCatFromCatType
1546 ($codes_arrayref, $labels_hashref) = &GetborCatFromCatType();
1548 Looks up the different types of borrowers in the database. Returns two
1549 elements: a reference-to-array, which lists the borrower category
1550 codes, and a reference-to-hash, which maps the borrower category codes
1551 to category descriptions.
1556 sub GetborCatFromCatType {
1557 my ( $category_type, $action, $no_branch_limit ) = @_;
1559 my $branch_limit = $no_branch_limit
1561 : C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1563 # FIXME - This API seems both limited and dangerous.
1564 my $dbh = C4::Context->dbh;
1567 SELECT categories.categorycode, categories.description
1571 LEFT JOIN categories_branches ON categories.categorycode = categories_branches.categorycode
1574 $request .= " $action ";
1575 $request .= " AND (branchcode = ? OR branchcode IS NULL) GROUP BY description" if $branch_limit;
1577 $request .= " WHERE branchcode = ? OR branchcode IS NULL GROUP BY description" if $branch_limit;
1579 $request .= " ORDER BY categorycode";
1581 my $sth = $dbh->prepare($request);
1583 $action ? $category_type : (),
1584 $branch_limit ? $branch_limit : ()
1590 while ( my $data = $sth->fetchrow_hashref ) {
1591 push @codes, $data->{'categorycode'};
1592 $labels{ $data->{'categorycode'} } = $data->{'description'};
1595 return ( \@codes, \%labels );
1598 =head2 GetBorrowercategory
1600 $hashref = &GetBorrowercategory($categorycode);
1602 Given the borrower's category code, the function returns the corresponding
1603 data hashref for a comprehensive information display.
1607 sub GetBorrowercategory {
1609 my $dbh = C4::Context->dbh;
1613 "SELECT description,dateofbirthrequired,upperagelimit,category_type
1615 WHERE categorycode = ?"
1617 $sth->execute($catcode);
1619 $sth->fetchrow_hashref;
1623 } # sub getborrowercategory
1626 =head2 GetBorrowerCategorycode
1628 $categorycode = &GetBorrowerCategoryCode( $borrowernumber );
1630 Given the borrowernumber, the function returns the corresponding categorycode
1633 sub GetBorrowerCategorycode {
1634 my ( $borrowernumber ) = @_;
1635 my $dbh = C4::Context->dbh;
1636 my $sth = $dbh->prepare( qq{
1639 WHERE borrowernumber = ?
1641 $sth->execute( $borrowernumber );
1642 return $sth->fetchrow;
1645 =head2 GetBorrowercategoryList
1647 $arrayref_hashref = &GetBorrowercategoryList;
1648 If no category code provided, the function returns all the categories.
1652 sub GetBorrowercategoryList {
1653 my $no_branch_limit = @_ ? shift : 0;
1654 my $branch_limit = $no_branch_limit
1656 : C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1657 my $dbh = C4::Context->dbh;
1658 my $query = "SELECT categories.* FROM categories";
1660 LEFT JOIN categories_branches ON categories.categorycode = categories_branches.categorycode
1661 WHERE branchcode = ? OR branchcode IS NULL GROUP BY description
1663 $query .= " ORDER BY description";
1664 my $sth = $dbh->prepare( $query );
1665 $sth->execute( $branch_limit ? $branch_limit : () );
1666 my $data = $sth->fetchall_arrayref( {} );
1669 } # sub getborrowercategory
1671 =head2 ethnicitycategories
1673 ($codes_arrayref, $labels_hashref) = ðnicitycategories();
1675 Looks up the different ethnic types in the database. Returns two
1676 elements: a reference-to-array, which lists the ethnicity codes, and a
1677 reference-to-hash, which maps the ethnicity codes to ethnicity
1684 sub ethnicitycategories {
1685 my $dbh = C4::Context->dbh;
1686 my $sth = $dbh->prepare("Select code,name from ethnicity order by name");
1690 while ( my $data = $sth->fetchrow_hashref ) {
1691 push @codes, $data->{'code'};
1692 $labels{ $data->{'code'} } = $data->{'name'};
1694 return ( \@codes, \%labels );
1699 $ethn_name = &fixEthnicity($ethn_code);
1701 Takes an ethnicity code (e.g., "european" or "pi") and returns the
1702 corresponding descriptive name from the C<ethnicity> table in the
1703 Koha database ("European" or "Pacific Islander").
1710 my $ethnicity = shift;
1711 return unless $ethnicity;
1712 my $dbh = C4::Context->dbh;
1713 my $sth = $dbh->prepare("Select name from ethnicity where code = ?");
1714 $sth->execute($ethnicity);
1715 my $data = $sth->fetchrow_hashref;
1716 return $data->{'name'};
1717 } # sub fixEthnicity
1721 $dateofbirth,$date = &GetAge($date);
1723 this function return the borrowers age with the value of dateofbirth
1729 my ( $date, $date_ref ) = @_;
1731 if ( not defined $date_ref ) {
1732 $date_ref = sprintf( '%04d-%02d-%02d', Today() );
1735 my ( $year1, $month1, $day1 ) = split /-/, $date;
1736 my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
1738 my $age = $year2 - $year1;
1739 if ( $month1 . $day1 > $month2 . $day2 ) {
1748 $cityarrayref = GetCities();
1750 Returns an array_ref of the entries in the cities table
1751 If there are entries in the table an empty row is returned
1752 This is currently only used to populate a popup in memberentry
1758 my $dbh = C4::Context->dbh;
1759 my $city_arr = $dbh->selectall_arrayref(
1760 q|SELECT cityid,city_zipcode,city_name,city_state,city_country FROM cities ORDER BY city_name|,
1762 if ( @{$city_arr} ) {
1763 unshift @{$city_arr}, {
1764 city_zipcode => q{},
1768 city_country => q{},
1775 =head2 GetSortDetails (OUEST-PROVENCE)
1777 ($lib) = &GetSortDetails($category,$sortvalue);
1779 Returns the authorized value details
1780 C<&$lib>return value of authorized value details
1781 C<&$sortvalue>this is the value of authorized value
1782 C<&$category>this is the value of authorized value category
1786 sub GetSortDetails {
1787 my ( $category, $sortvalue ) = @_;
1788 my $dbh = C4::Context->dbh;
1789 my $query = qq|SELECT lib
1790 FROM authorised_values
1792 AND authorised_value=? |;
1793 my $sth = $dbh->prepare($query);
1794 $sth->execute( $category, $sortvalue );
1795 my $lib = $sth->fetchrow;
1796 return ($lib) if ($lib);
1797 return ($sortvalue) unless ($lib);
1800 =head2 MoveMemberToDeleted
1802 $result = &MoveMemberToDeleted($borrowernumber);
1804 Copy the record from borrowers to deletedborrowers table.
1808 # FIXME: should do it in one SQL statement w/ subquery
1809 # Otherwise, we should return the @data on success
1811 sub MoveMemberToDeleted {
1812 my ($member) = shift or return;
1813 my $dbh = C4::Context->dbh;
1814 my $query = qq|SELECT *
1816 WHERE borrowernumber=?|;
1817 my $sth = $dbh->prepare($query);
1818 $sth->execute($member);
1819 my @data = $sth->fetchrow_array;
1820 (@data) or return; # if we got a bad borrowernumber, there's nothing to insert
1822 $dbh->prepare( "INSERT INTO deletedborrowers VALUES ("
1823 . ( "?," x ( scalar(@data) - 1 ) )
1825 $sth->execute(@data);
1830 DelMember($borrowernumber);
1832 This function remove directly a borrower whitout writing it on deleteborrower.
1833 + Deletes reserves for the borrower
1838 my $dbh = C4::Context->dbh;
1839 my $borrowernumber = shift;
1840 #warn "in delmember with $borrowernumber";
1841 return unless $borrowernumber; # borrowernumber is mandatory.
1843 my $query = qq|DELETE
1845 WHERE borrowernumber=?|;
1846 my $sth = $dbh->prepare($query);
1847 $sth->execute($borrowernumber);
1851 WHERE borrowernumber = ?
1853 $sth = $dbh->prepare($query);
1854 $sth->execute($borrowernumber);
1855 logaction("MEMBERS", "DELETE", $borrowernumber, "") if C4::Context->preference("BorrowersLog");
1859 =head2 ExtendMemberSubscriptionTo (OUEST-PROVENCE)
1861 $date = ExtendMemberSubscriptionTo($borrowerid, $date);
1863 Extending the subscription to a given date or to the expiry date calculated on ISO date.
1868 sub ExtendMemberSubscriptionTo {
1869 my ( $borrowerid,$date) = @_;
1870 my $dbh = C4::Context->dbh;
1871 my $borrower = GetMember('borrowernumber'=>$borrowerid);
1873 $date = (C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry') ?
1874 C4::Dates->new($borrower->{'dateexpiry'}, 'iso')->output("iso") :
1875 C4::Dates->new()->output("iso");
1876 $date = GetExpiryDate( $borrower->{'categorycode'}, $date );
1878 my $sth = $dbh->do(<<EOF);
1880 SET dateexpiry='$date'
1881 WHERE borrowernumber='$borrowerid'
1884 AddEnrolmentFeeIfNeeded( $borrower->{categorycode}, $borrower->{borrowernumber} );
1886 logaction("MEMBERS", "RENEW", $borrower->{'borrowernumber'}, "Membership renewed")if C4::Context->preference("BorrowersLog");
1887 return $date if ($sth);
1891 =head2 GetTitles (OUEST-PROVENCE)
1893 ($borrowertitle)= &GetTitles();
1895 Looks up the different title . Returns array with all borrowers title
1900 my @borrowerTitle = split (/,|\|/,C4::Context->preference('BorrowersTitles'));
1901 unshift( @borrowerTitle, "" );
1902 my $count=@borrowerTitle;
1907 return ( \@borrowerTitle);
1911 =head2 GetPatronImage
1913 my ($imagedata, $dberror) = GetPatronImage($borrowernumber);
1915 Returns the mimetype and binary image data of the image for the patron with the supplied borrowernumber.
1919 sub GetPatronImage {
1920 my ($borrowernumber) = @_;
1921 warn "Borrowernumber passed to GetPatronImage is $borrowernumber" if $debug;
1922 my $dbh = C4::Context->dbh;
1923 my $query = 'SELECT mimetype, imagefile FROM patronimage WHERE borrowernumber = ?';
1924 my $sth = $dbh->prepare($query);
1925 $sth->execute($borrowernumber);
1926 my $imagedata = $sth->fetchrow_hashref;
1927 warn "Database error!" if $sth->errstr;
1928 return $imagedata, $sth->errstr;
1931 =head2 PutPatronImage
1933 PutPatronImage($cardnumber, $mimetype, $imgfile);
1935 Stores patron binary image data and mimetype in database.
1936 NOTE: This function is good for updating images as well as inserting new images in the database.
1940 sub PutPatronImage {
1941 my ($cardnumber, $mimetype, $imgfile) = @_;
1942 warn "Parameters passed in: Cardnumber=$cardnumber, Mimetype=$mimetype, " . ($imgfile ? "Imagefile" : "No Imagefile") if $debug;
1943 my $dbh = C4::Context->dbh;
1944 my $query = "INSERT INTO patronimage (borrowernumber, mimetype, imagefile) VALUES ( ( SELECT borrowernumber from borrowers WHERE cardnumber = ? ),?,?) ON DUPLICATE KEY UPDATE imagefile = ?;";
1945 my $sth = $dbh->prepare($query);
1946 $sth->execute($cardnumber,$mimetype,$imgfile,$imgfile);
1947 warn "Error returned inserting $cardnumber.$mimetype." if $sth->errstr;
1948 return $sth->errstr;
1951 =head2 RmPatronImage
1953 my ($dberror) = RmPatronImage($borrowernumber);
1955 Removes the image for the patron with the supplied borrowernumber.
1960 my ($borrowernumber) = @_;
1961 warn "Borrowernumber passed to GetPatronImage is $borrowernumber" if $debug;
1962 my $dbh = C4::Context->dbh;
1963 my $query = "DELETE FROM patronimage WHERE borrowernumber = ?;";
1964 my $sth = $dbh->prepare($query);
1965 $sth->execute($borrowernumber);
1966 my $dberror = $sth->errstr;
1967 warn "Database error!" if $sth->errstr;
1971 =head2 GetHideLostItemsPreference
1973 $hidelostitemspref = &GetHideLostItemsPreference($borrowernumber);
1975 Returns the HideLostItems preference for the patron category of the supplied borrowernumber
1976 C<&$hidelostitemspref>return value of function, 0 or 1
1980 sub GetHideLostItemsPreference {
1981 my ($borrowernumber) = @_;
1982 my $dbh = C4::Context->dbh;
1983 my $query = "SELECT hidelostitems FROM borrowers,categories WHERE borrowers.categorycode = categories.categorycode AND borrowernumber = ?";
1984 my $sth = $dbh->prepare($query);
1985 $sth->execute($borrowernumber);
1986 my $hidelostitems = $sth->fetchrow;
1987 return $hidelostitems;
1990 =head2 GetBorrowersToExpunge
1992 $borrowers = &GetBorrowersToExpunge(
1993 not_borrowered_since => $not_borrowered_since,
1994 expired_before => $expired_before,
1995 category_code => $category_code,
1996 branchcode => $branchcode
1999 This function get all borrowers based on the given criteria.
2003 sub GetBorrowersToExpunge {
2006 my $filterdate = $params->{'not_borrowered_since'};
2007 my $filterexpiry = $params->{'expired_before'};
2008 my $filtercategory = $params->{'category_code'};
2009 my $filterbranch = $params->{'branchcode'} ||
2010 ((C4::Context->preference('IndependentBranches')
2011 && C4::Context->userenv
2012 && !C4::Context->IsSuperLibrarian()
2013 && C4::Context->userenv->{branch})
2014 ? C4::Context->userenv->{branch}
2017 my $dbh = C4::Context->dbh;
2019 SELECT borrowers.borrowernumber,
2020 MAX(old_issues.timestamp) AS latestissue,
2021 MAX(issues.timestamp) AS currentissue
2023 JOIN categories USING (categorycode)
2024 LEFT JOIN old_issues USING (borrowernumber)
2025 LEFT JOIN issues USING (borrowernumber)
2026 WHERE category_type <> 'S'
2027 AND borrowernumber NOT IN (SELECT guarantorid FROM borrowers WHERE guarantorid IS NOT NULL AND guarantorid <> 0)
2030 if ( $filterbranch && $filterbranch ne "" ) {
2031 $query.= " AND borrowers.branchcode = ? ";
2032 push( @query_params, $filterbranch );
2034 if ( $filterexpiry ) {
2035 $query .= " AND dateexpiry < ? ";
2036 push( @query_params, $filterexpiry );
2038 if ( $filtercategory ) {
2039 $query .= " AND categorycode = ? ";
2040 push( @query_params, $filtercategory );
2042 $query.=" GROUP BY borrowers.borrowernumber HAVING currentissue IS NULL ";
2043 if ( $filterdate ) {
2044 $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
2045 push @query_params,$filterdate;
2047 warn $query if $debug;
2049 my $sth = $dbh->prepare($query);
2050 if (scalar(@query_params)>0){
2051 $sth->execute(@query_params);
2058 while ( my $data = $sth->fetchrow_hashref ) {
2059 push @results, $data;
2064 =head2 GetBorrowersWhoHaveNeverBorrowed
2066 $results = &GetBorrowersWhoHaveNeverBorrowed
2068 This function get all borrowers who have never borrowed.
2070 I<$result> is a ref to an array which all elements are a hasref.
2074 sub GetBorrowersWhoHaveNeverBorrowed {
2075 my $filterbranch = shift ||
2076 ((C4::Context->preference('IndependentBranches')
2077 && C4::Context->userenv
2078 && !C4::Context->IsSuperLibrarian()
2079 && C4::Context->userenv->{branch})
2080 ? C4::Context->userenv->{branch}
2082 my $dbh = C4::Context->dbh;
2084 SELECT borrowers.borrowernumber,max(timestamp) as latestissue
2086 LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
2087 WHERE issues.borrowernumber IS NULL
2090 if ($filterbranch && $filterbranch ne ""){
2091 $query.=" AND borrowers.branchcode= ?";
2092 push @query_params,$filterbranch;
2094 warn $query if $debug;
2096 my $sth = $dbh->prepare($query);
2097 if (scalar(@query_params)>0){
2098 $sth->execute(@query_params);
2105 while ( my $data = $sth->fetchrow_hashref ) {
2106 push @results, $data;
2111 =head2 GetBorrowersWithIssuesHistoryOlderThan
2113 $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
2115 this function get all borrowers who has an issue history older than I<$date> given on input arg.
2117 I<$result> is a ref to an array which all elements are a hashref.
2118 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2122 sub GetBorrowersWithIssuesHistoryOlderThan {
2123 my $dbh = C4::Context->dbh;
2124 my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
2125 my $filterbranch = shift ||
2126 ((C4::Context->preference('IndependentBranches')
2127 && C4::Context->userenv
2128 && !C4::Context->IsSuperLibrarian()
2129 && C4::Context->userenv->{branch})
2130 ? C4::Context->userenv->{branch}
2133 SELECT count(borrowernumber) as n,borrowernumber
2135 WHERE returndate < ?
2136 AND borrowernumber IS NOT NULL
2139 push @query_params, $date;
2141 $query.=" AND branchcode = ?";
2142 push @query_params, $filterbranch;
2144 $query.=" GROUP BY borrowernumber ";
2145 warn $query if $debug;
2146 my $sth = $dbh->prepare($query);
2147 $sth->execute(@query_params);
2150 while ( my $data = $sth->fetchrow_hashref ) {
2151 push @results, $data;
2156 =head2 GetBorrowersNamesAndLatestIssue
2158 $results = &GetBorrowersNamesAndLatestIssueList(@borrowernumbers)
2160 this function get borrowers Names and surnames and Issue information.
2162 I<@borrowernumbers> is an array which all elements are borrowernumbers.
2163 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2167 sub GetBorrowersNamesAndLatestIssue {
2168 my $dbh = C4::Context->dbh;
2169 my @borrowernumbers=@_;
2171 SELECT surname,lastname, phone, email,max(timestamp)
2173 LEFT JOIN issues ON borrowers.borrowernumber=issues.borrowernumber
2174 GROUP BY borrowernumber
2176 my $sth = $dbh->prepare($query);
2178 my $results = $sth->fetchall_arrayref({});
2186 my $success = ModPrivacy( $borrowernumber, $privacy );
2188 Update the privacy of a patron.
2191 true on success, false on failure
2198 my $borrowernumber = shift;
2199 my $privacy = shift;
2200 return unless defined $borrowernumber;
2201 return unless $borrowernumber =~ /^\d+$/;
2203 return ModMember( borrowernumber => $borrowernumber,
2204 privacy => $privacy );
2209 AddMessage( $borrowernumber, $message_type, $message, $branchcode );
2211 Adds a message to the messages table for the given borrower.
2220 my ( $borrowernumber, $message_type, $message, $branchcode ) = @_;
2222 my $dbh = C4::Context->dbh;
2224 if ( ! ( $borrowernumber && $message_type && $message && $branchcode ) ) {
2228 my $query = "INSERT INTO messages ( borrowernumber, branchcode, message_type, message ) VALUES ( ?, ?, ?, ? )";
2229 my $sth = $dbh->prepare($query);
2230 $sth->execute( $borrowernumber, $branchcode, $message_type, $message );
2231 logaction("MEMBERS", "ADDCIRCMESSAGE", $borrowernumber, $message) if C4::Context->preference("BorrowersLog");
2237 GetMessages( $borrowernumber, $type );
2239 $type is message type, B for borrower, or L for Librarian.
2240 Empty type returns all messages of any type.
2242 Returns all messages for the given borrowernumber
2247 my ( $borrowernumber, $type, $branchcode ) = @_;
2253 my $dbh = C4::Context->dbh;
2256 branches.branchname,
2259 messages.branchcode LIKE '$branchcode' AS can_delete
2260 FROM messages, branches
2261 WHERE borrowernumber = ?
2262 AND message_type LIKE ?
2263 AND messages.branchcode = branches.branchcode
2264 ORDER BY message_date DESC";
2265 my $sth = $dbh->prepare($query);
2266 $sth->execute( $borrowernumber, $type ) ;
2269 while ( my $data = $sth->fetchrow_hashref ) {
2270 my $d = C4::Dates->new( $data->{message_date}, 'iso' );
2271 $data->{message_date_formatted} = $d->output;
2272 push @results, $data;
2280 GetMessagesCount( $borrowernumber, $type );
2282 $type is message type, B for borrower, or L for Librarian.
2283 Empty type returns all messages of any type.
2285 Returns the number of messages for the given borrowernumber
2289 sub GetMessagesCount {
2290 my ( $borrowernumber, $type, $branchcode ) = @_;
2296 my $dbh = C4::Context->dbh;
2298 my $query = "SELECT COUNT(*) as MsgCount FROM messages WHERE borrowernumber = ? AND message_type LIKE ?";
2299 my $sth = $dbh->prepare($query);
2300 $sth->execute( $borrowernumber, $type ) ;
2303 my $data = $sth->fetchrow_hashref;
2304 my $count = $data->{'MsgCount'};
2311 =head2 DeleteMessage
2313 DeleteMessage( $message_id );
2318 my ( $message_id ) = @_;
2320 my $dbh = C4::Context->dbh;
2321 my $query = "SELECT * FROM messages WHERE message_id = ?";
2322 my $sth = $dbh->prepare($query);
2323 $sth->execute( $message_id );
2324 my $message = $sth->fetchrow_hashref();
2326 $query = "DELETE FROM messages WHERE message_id = ?";
2327 $sth = $dbh->prepare($query);
2328 $sth->execute( $message_id );
2329 logaction("MEMBERS", "DELCIRCMESSAGE", $message->{'borrowernumber'}, $message->{'message'}) if C4::Context->preference("BorrowersLog");
2334 IssueSlip($branchcode, $borrowernumber, $quickslip)
2336 Returns letter hash ( see C4::Letters::GetPreparedLetter )
2338 $quickslip is boolean, to indicate whether we want a quick slip
2343 my ($branch, $borrowernumber, $quickslip) = @_;
2345 # return unless ( C4::Context->boolean_preference('printcirculationslips') );
2347 my $now = POSIX::strftime("%Y-%m-%d", localtime);
2349 my $issueslist = GetPendingIssues($borrowernumber);
2350 foreach my $it (@$issueslist){
2351 if ((substr $it->{'issuedate'}, 0, 10) eq $now || (substr $it->{'lastreneweddate'}, 0, 10) eq $now) {
2354 elsif ((substr $it->{'date_due'}, 0, 10) le $now) {
2355 $it->{'overdue'} = 1;
2357 my $dt = dt_from_string( $it->{'date_due'} );
2358 $it->{'date_due'} = output_pref( $dt );;
2360 my @issues = sort { $b->{'timestamp'} <=> $a->{'timestamp'} } @$issueslist;
2362 my ($letter_code, %repeat);
2364 $letter_code = 'ISSUEQSLIP';
2366 'checkedout' => [ map {
2370 }, grep { $_->{'now'} } @issues ],
2374 $letter_code = 'ISSUESLIP';
2376 'checkedout' => [ map {
2380 }, grep { !$_->{'overdue'} } @issues ],
2382 'overdue' => [ map {
2386 }, grep { $_->{'overdue'} } @issues ],
2389 $_->{'timestamp'} = $_->{'newdate'};
2391 } @{ GetNewsToDisplay("slip",$branch) } ],
2395 return C4::Letters::GetPreparedLetter (
2396 module => 'circulation',
2397 letter_code => $letter_code,
2398 branchcode => $branch,
2400 'branches' => $branch,
2401 'borrowers' => $borrowernumber,
2407 =head2 GetBorrowersWithEmail
2409 ([$borrnum,$userid], ...) = GetBorrowersWithEmail('me@example.com');
2411 This gets a list of users and their basic details from their email address.
2412 As it's possible for multiple user to have the same email address, it provides
2413 you with all of them. If there is no userid for the user, there will be an
2414 C<undef> there. An empty list will be returned if there are no matches.
2418 sub GetBorrowersWithEmail {
2421 my $dbh = C4::Context->dbh;
2423 my $query = "SELECT borrowernumber, userid FROM borrowers WHERE email=?";
2424 my $sth=$dbh->prepare($query);
2425 $sth->execute($email);
2427 while (my $ref = $sth->fetch) {
2430 die "Failure searching for borrowers by email address: $sth->errstr" if $sth->err;
2434 sub AddMember_Opac {
2435 my ( %borrower ) = @_;
2437 $borrower{'categorycode'} = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
2439 my $sr = new String::Random;
2440 $sr->{'A'} = [ 'A'..'Z', 'a'..'z' ];
2441 my $password = $sr->randpattern("AAAAAAAAAA");
2442 $borrower{'password'} = $password;
2444 $borrower{'cardnumber'} = fixup_cardnumber();
2446 my $borrowernumber = AddMember(%borrower);
2448 return ( $borrowernumber, $password );
2451 =head2 AddEnrolmentFeeIfNeeded
2453 AddEnrolmentFeeIfNeeded( $borrower->{categorycode}, $borrower->{borrowernumber} );
2455 Add enrolment fee for a patron if needed.
2459 sub AddEnrolmentFeeIfNeeded {
2460 my ( $categorycode, $borrowernumber ) = @_;
2461 # check for enrollment fee & add it if needed
2462 my $dbh = C4::Context->dbh;
2463 my $sth = $dbh->prepare(q{
2466 WHERE categorycode=?
2468 $sth->execute( $categorycode );
2470 warn sprintf('Database returned the following error: %s', $sth->errstr);
2473 my ($enrolmentfee) = $sth->fetchrow;
2474 if ($enrolmentfee && $enrolmentfee > 0) {
2475 # insert fee in patron debts
2476 C4::Accounts::manualinvoice( $borrowernumber, '', '', 'A', $enrolmentfee );
2481 my ( $borrowernumber ) = @_;
2483 my $sql = "SELECT COUNT(*) FROM issues WHERE date_due < NOW() AND borrowernumber = ?";
2484 my $sth = C4::Context->dbh->prepare( $sql );
2485 $sth->execute( $borrowernumber );
2486 my ( $count ) = $sth->fetchrow_array();
2491 END { } # module clean-up code here (global destructor)