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);
45 our ($VERSION,@ISA,@EXPORT,@EXPORT_OK,$debug);
48 $VERSION = 3.07.00.049;
49 $debug = $ENV{DEBUG} || 0;
61 &GetMemberIssuesAndFines
68 &GetFirstValidEmailAddress
69 &GetNoticeEmailAddress
80 &GetHideLostItemsPreference
83 &GetMemberAccountRecords
84 &GetBorNotifyAcctRecord
88 GetBorrowerCategorycode
89 &GetBorrowercategoryList
91 &GetBorrowersToExpunge
92 &GetBorrowersWhoHaveNeverBorrowed
93 &GetBorrowersWithIssuesHistoryOlderThan
103 GetBorrowersWithEmail
125 &ExtendMemberSubscriptionTo
143 C4::Members - Perl Module containing convenience functions for member handling
151 This module contains routines for adding, modifying and deleting members/patrons/borrowers
157 $borrowers_result_array_ref = &Search($filter,$orderby, $limit,
158 $columns_out, $search_on_fields,$searchtype);
160 Looks up patrons (borrowers) on filter. A wrapper for SearchInTable('borrowers').
162 For C<$filter>, C<$orderby>, C<$limit>, C<&columns_out>, C<&search_on_fields> and C<&searchtype>
163 refer to C4::SQLHelper:SearchInTable().
165 Special C<$filter> key '' is effectively expanded to search on surname firstname othernamescw
166 and cardnumber unless C<&search_on_fields> is defined
170 $borrowers = Search('abcd', 'cardnumber');
172 $borrowers = Search({''=>'abcd', category_type=>'I'}, 'surname');
176 sub _express_member_find {
179 # this is used by circulation everytime a new borrowers cardnumber is scanned
180 # so we can check an exact match first, if that works return, otherwise do the rest
181 my $dbh = C4::Context->dbh;
182 my $query = "SELECT borrowernumber FROM borrowers WHERE cardnumber = ?";
183 if ( my $borrowernumber = $dbh->selectrow_array($query, undef, $filter) ) {
184 return( {"borrowernumber"=>$borrowernumber} );
187 my ($search_on_fields, $searchtype);
188 if ( length($filter) == 1 ) {
189 $search_on_fields = [ qw(surname) ];
190 $searchtype = 'start_with';
192 $search_on_fields = [ qw(surname firstname othernames cardnumber) ];
193 $searchtype = 'contain';
196 return (undef, $search_on_fields, $searchtype);
200 my ( $filter, $orderby, $limit, $columns_out, $search_on_fields, $searchtype ) = @_;
205 if ( my $fr = ref $filter ) {
206 if ( $fr eq "HASH" ) {
207 if ( my $search_string = $filter->{''} ) {
208 my ($member_filter, $member_search_on_fields, $member_searchtype) = _express_member_find($search_string);
209 if ($member_filter) {
210 $filter = $member_filter;
213 $search_on_fields ||= $member_search_on_fields;
214 $searchtype ||= $member_searchtype;
219 $search_string = $filter;
223 $search_string = $filter;
224 my ($member_filter, $member_search_on_fields, $member_searchtype) = _express_member_find($search_string);
225 if ($member_filter) {
226 $filter = $member_filter;
229 $search_on_fields ||= $member_search_on_fields;
230 $searchtype ||= $member_searchtype;
234 if ( !$found_borrower && C4::Context->preference('ExtendedPatronAttributes') && $search_string ) {
235 my $matching_records = C4::Members::Attributes::SearchIdMatchingAttribute($search_string);
236 if(scalar(@$matching_records)>0) {
237 if ( my $fr = ref $filter ) {
238 if ( $fr eq "HASH" ) {
240 $filter = [ $filter ];
242 push @$filter, { %f, "borrowernumber"=>$$matching_records };
245 push @$filter, {"borrowernumber"=>$matching_records};
249 $filter = [ $filter ];
250 push @$filter, {"borrowernumber"=>$matching_records};
255 # $showallbranches was not used at the time SearchMember() was mainstreamed into Search().
256 # Mentioning for the reference
258 if ( C4::Context->preference("IndependentBranches") ) { # && !$showallbranches){
259 if ( my $userenv = C4::Context->userenv ) {
260 my $branch = $userenv->{'branch'};
261 if ( !C4::Context->IsSuperLibrarian() && $branch ){
262 if (my $fr = ref $filter) {
263 if ( $fr eq "HASH" ) {
264 $filter->{branchcode} = $branch;
268 $_ = { '' => $_ } unless ref $_;
269 $_->{branchcode} = $branch;
274 $filter = { '' => $filter, branchcode => $branch };
280 if ($found_borrower) {
281 $searchtype = "exact";
283 $searchtype ||= "start_with";
285 return SearchInTable( "borrowers", $filter, $orderby, $limit, $columns_out, $search_on_fields, $searchtype );
288 =head2 GetMemberDetails
290 ($borrower) = &GetMemberDetails($borrowernumber, $cardnumber);
292 Looks up a patron and returns information about him or her. If
293 C<$borrowernumber> is true (nonzero), C<&GetMemberDetails> looks
294 up the borrower by number; otherwise, it looks up the borrower by card
297 C<$borrower> is a reference-to-hash whose keys are the fields of the
298 borrowers table in the Koha database. In addition,
299 C<$borrower-E<gt>{flags}> is a hash giving more detailed information
300 about the patron. Its keys act as flags :
302 if $borrower->{flags}->{LOST} {
303 # Patron's card was reported lost
306 If the state of a flag means that the patron should not be
307 allowed to borrow any more books, then it will have a C<noissues> key
310 See patronflags for more details.
312 C<$borrower-E<gt>{authflags}> is a hash giving more detailed information
313 about the top-level permissions flags set for the borrower. For example,
314 if a user has the "editcatalogue" permission,
315 C<$borrower-E<gt>{authflags}-E<gt>{editcatalogue}> will exist and have
320 sub GetMemberDetails {
321 my ( $borrowernumber, $cardnumber ) = @_;
322 my $dbh = C4::Context->dbh;
325 if ($borrowernumber) {
326 $sth = $dbh->prepare("
329 categories.description,
330 categories.BlockExpiredPatronOpacActions,
334 LEFT JOIN categories ON borrowers.categorycode=categories.categorycode
335 WHERE borrowernumber = ?
337 $sth->execute($borrowernumber);
339 elsif ($cardnumber) {
340 $sth = $dbh->prepare("
343 categories.description,
344 categories.BlockExpiredPatronOpacActions,
348 LEFT JOIN categories ON borrowers.categorycode = categories.categorycode
351 $sth->execute($cardnumber);
356 my $borrower = $sth->fetchrow_hashref;
357 return unless $borrower;
358 my ($amount) = GetMemberAccountRecords( $borrowernumber);
359 $borrower->{'amountoutstanding'} = $amount;
360 # FIXME - patronflags calls GetMemberAccountRecords... just have patronflags return $amount
361 my $flags = patronflags( $borrower);
364 $sth = $dbh->prepare("select bit,flag from userflags");
366 while ( my ( $bit, $flag ) = $sth->fetchrow ) {
367 if ( $borrower->{'flags'} && $borrower->{'flags'} & 2**$bit ) {
368 $accessflagshash->{$flag} = 1;
371 $borrower->{'flags'} = $flags;
372 $borrower->{'authflags'} = $accessflagshash;
374 # For the purposes of making templates easier, we'll define a
375 # 'showname' which is the alternate form the user's first name if
376 # 'other name' is defined.
377 if ($borrower->{category_type} eq 'I') {
378 $borrower->{'showname'} = $borrower->{'othernames'};
379 $borrower->{'showname'} .= " $borrower->{'firstname'}" if $borrower->{'firstname'};
381 $borrower->{'showname'} = $borrower->{'firstname'};
384 # Handle setting the true behavior for BlockExpiredPatronOpacActions
385 $borrower->{'BlockExpiredPatronOpacActions'} =
386 C4::Context->preference('BlockExpiredPatronOpacActions')
387 if ( $borrower->{'BlockExpiredPatronOpacActions'} == -1 );
389 $borrower->{'is_expired'} = 0;
390 $borrower->{'is_expired'} = 1 if
391 defined($borrower->{dateexpiry}) &&
392 $borrower->{'dateexpiry'} ne '0000-00-00' &&
393 Date_to_Days( Today() ) >
394 Date_to_Days( split /-/, $borrower->{'dateexpiry'} );
396 return ($borrower); #, $flags, $accessflagshash);
401 $flags = &patronflags($patron);
403 This function is not exported.
405 The following will be set where applicable:
406 $flags->{CHARGES}->{amount} Amount of debt
407 $flags->{CHARGES}->{noissues} Set if debt amount >$5.00 (or syspref noissuescharge)
408 $flags->{CHARGES}->{message} Message -- deprecated
410 $flags->{CREDITS}->{amount} Amount of credit
411 $flags->{CREDITS}->{message} Message -- deprecated
413 $flags->{ GNA } Patron has no valid address
414 $flags->{ GNA }->{noissues} Set for each GNA
415 $flags->{ GNA }->{message} "Borrower has no valid address" -- deprecated
417 $flags->{ LOST } Patron's card reported lost
418 $flags->{ LOST }->{noissues} Set for each LOST
419 $flags->{ LOST }->{message} Message -- deprecated
421 $flags->{DBARRED} Set if patron debarred, no access
422 $flags->{DBARRED}->{noissues} Set for each DBARRED
423 $flags->{DBARRED}->{message} Message -- deprecated
426 $flags->{ NOTES }->{message} The note itself. NOT deprecated
428 $flags->{ ODUES } Set if patron has overdue books.
429 $flags->{ ODUES }->{message} "Yes" -- deprecated
430 $flags->{ ODUES }->{itemlist} ref-to-array: list of overdue books
431 $flags->{ ODUES }->{itemlisttext} Text list of overdue items -- deprecated
433 $flags->{WAITING} Set if any of patron's reserves are available
434 $flags->{WAITING}->{message} Message -- deprecated
435 $flags->{WAITING}->{itemlist} ref-to-array: list of available items
439 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
440 overdue items. Its elements are references-to-hash, each describing an
441 overdue item. The keys are selected fields from the issues, biblio,
442 biblioitems, and items tables of the Koha database.
444 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
445 the overdue items, one per line. Deprecated.
447 =item C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
448 available items. Each element is a reference-to-hash whose keys are
449 fields from the reserves table of the Koha database.
453 All the "message" fields that include language generated in this function are deprecated,
454 because such strings belong properly in the display layer.
456 The "message" field that comes from the DB is OK.
460 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
461 # FIXME rename this function.
464 my ( $patroninformation) = @_;
465 my $dbh=C4::Context->dbh;
466 my ($balance, $owing) = GetMemberAccountBalance( $patroninformation->{'borrowernumber'});
469 my $noissuescharge = C4::Context->preference("noissuescharge") || 5;
470 $flaginfo{'message'} = sprintf 'Patron owes %.02f', $owing;
471 $flaginfo{'amount'} = sprintf "%.02f", $owing;
472 if ( $owing > $noissuescharge && !C4::Context->preference("AllowFineOverride") ) {
473 $flaginfo{'noissues'} = 1;
475 $flags{'CHARGES'} = \%flaginfo;
477 elsif ( $balance < 0 ) {
479 $flaginfo{'message'} = sprintf 'Patron has credit of %.02f', -$balance;
480 $flaginfo{'amount'} = sprintf "%.02f", $balance;
481 $flags{'CREDITS'} = \%flaginfo;
483 if ( $patroninformation->{'gonenoaddress'}
484 && $patroninformation->{'gonenoaddress'} == 1 )
487 $flaginfo{'message'} = 'Borrower has no valid address.';
488 $flaginfo{'noissues'} = 1;
489 $flags{'GNA'} = \%flaginfo;
491 if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
493 $flaginfo{'message'} = 'Borrower\'s card reported lost.';
494 $flaginfo{'noissues'} = 1;
495 $flags{'LOST'} = \%flaginfo;
497 if ( $patroninformation->{'debarred'} && check_date( split( /-/, $patroninformation->{'debarred'} ) ) ) {
498 if ( Date_to_Days(Date::Calc::Today) < Date_to_Days( split( /-/, $patroninformation->{'debarred'} ) ) ) {
500 $flaginfo{'debarredcomment'} = $patroninformation->{'debarredcomment'};
501 $flaginfo{'message'} = $patroninformation->{'debarredcomment'};
502 $flaginfo{'noissues'} = 1;
503 $flaginfo{'dateend'} = $patroninformation->{'debarred'};
504 $flags{'DBARRED'} = \%flaginfo;
507 if ( $patroninformation->{'borrowernotes'}
508 && $patroninformation->{'borrowernotes'} )
511 $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
512 $flags{'NOTES'} = \%flaginfo;
514 my ( $odues, $itemsoverdue ) = C4::Overdues::checkoverdues($patroninformation->{'borrowernumber'});
515 if ( $odues && $odues > 0 ) {
517 $flaginfo{'message'} = "Yes";
518 $flaginfo{'itemlist'} = $itemsoverdue;
519 foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
522 $flaginfo{'itemlisttext'} .=
523 "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n"; # newline is display layer
525 $flags{'ODUES'} = \%flaginfo;
527 my @itemswaiting = C4::Reserves::GetReservesFromBorrowernumber( $patroninformation->{'borrowernumber'},'W' );
528 my $nowaiting = scalar @itemswaiting;
529 if ( $nowaiting > 0 ) {
531 $flaginfo{'message'} = "Reserved items available";
532 $flaginfo{'itemlist'} = \@itemswaiting;
533 $flags{'WAITING'} = \%flaginfo;
541 $borrower = &GetMember(%information);
543 Retrieve the first patron record meeting on criteria listed in the
544 C<%information> hash, which should contain one or more
545 pairs of borrowers column names and values, e.g.,
547 $borrower = GetMember(borrowernumber => id);
549 C<&GetBorrower> returns a reference-to-hash whose keys are the fields of
550 the C<borrowers> table in the Koha database.
552 FIXME: GetMember() is used throughout the code as a lookup
553 on a unique key such as the borrowernumber, but this meaning is not
554 enforced in the routine itself.
560 my ( %information ) = @_;
561 if (exists $information{borrowernumber} && !defined $information{borrowernumber}) {
562 #passing mysql's kohaadmin?? Makes no sense as a query
565 my $dbh = C4::Context->dbh;
567 q{SELECT borrowers.*, categories.category_type, categories.description
569 LEFT JOIN categories on borrowers.categorycode=categories.categorycode WHERE };
572 for (keys %information ) {
580 if (defined $information{$_}) {
582 push @values, $information{$_};
585 $select .= "$_ IS NULL";
588 $debug && warn $select, " ",values %information;
589 my $sth = $dbh->prepare("$select");
590 $sth->execute(map{$information{$_}} keys %information);
591 my $data = $sth->fetchall_arrayref({});
592 #FIXME interface to this routine now allows generation of a result set
593 #so whole array should be returned but bowhere in the current code expects this
601 =head2 GetMemberRelatives
603 @borrowernumbers = GetMemberRelatives($borrowernumber);
605 C<GetMemberRelatives> returns a borrowersnumber's list of guarantor/guarantees of the member given in parameter
608 sub GetMemberRelatives {
609 my $borrowernumber = shift;
610 my $dbh = C4::Context->dbh;
614 my $query = "SELECT guarantorid FROM borrowers WHERE borrowernumber=?";
615 my $sth = $dbh->prepare($query);
616 $sth->execute($borrowernumber);
617 my $data = $sth->fetchrow_arrayref();
618 push @glist, $data->[0] if $data->[0];
619 my $guarantor = $data->[0] ? $data->[0] : undef;
622 $query = "SELECT borrowernumber FROM borrowers WHERE guarantorid=?";
623 $sth = $dbh->prepare($query);
624 $sth->execute($borrowernumber);
625 while ($data = $sth->fetchrow_arrayref()) {
626 push @glist, $data->[0];
629 # Getting sibling guarantees
631 $query = "SELECT borrowernumber FROM borrowers WHERE guarantorid=?";
632 $sth = $dbh->prepare($query);
633 $sth->execute($guarantor);
634 while ($data = $sth->fetchrow_arrayref()) {
635 push @glist, $data->[0] if ($data->[0] != $borrowernumber);
642 =head2 IsMemberBlocked
644 my ($block_status, $count) = IsMemberBlocked( $borrowernumber );
646 Returns whether a patron has overdue items that may result
647 in a block or whether the patron has active fine days
648 that would block circulation privileges.
650 C<$block_status> can have the following values:
652 1 if the patron has outstanding fine days, in which case C<$count> is the number of them
654 -1 if the patron has overdue items, in which case C<$count> is the number of them
656 0 if the patron has no overdue items or outstanding fine days, in which case C<$count> is 0
658 Outstanding fine days are checked before current overdue items
661 FIXME: this needs to be split into two functions; a potential block
662 based on the number of current overdue items could be orthogonal
663 to a block based on whether the patron has any fine days accrued.
667 sub IsMemberBlocked {
668 my $borrowernumber = shift;
669 my $dbh = C4::Context->dbh;
671 my $blockeddate = Koha::Borrower::Debarments::IsDebarred($borrowernumber);
673 return ( 1, $blockeddate ) if $blockeddate;
675 # if he have late issues
676 my $sth = $dbh->prepare(
677 "SELECT COUNT(*) as latedocs
679 WHERE borrowernumber = ?
680 AND date_due < now()"
682 $sth->execute($borrowernumber);
683 my $latedocs = $sth->fetchrow_hashref->{'latedocs'};
685 return ( -1, $latedocs ) if $latedocs > 0;
690 =head2 GetMemberIssuesAndFines
692 ($overdue_count, $issue_count, $total_fines) = &GetMemberIssuesAndFines($borrowernumber);
694 Returns aggregate data about items borrowed by the patron with the
695 given borrowernumber.
697 C<&GetMemberIssuesAndFines> returns a three-element array. C<$overdue_count> is the
698 number of overdue items the patron currently has borrowed. C<$issue_count> is the
699 number of books the patron currently has borrowed. C<$total_fines> is
700 the total fine currently due by the borrower.
705 sub GetMemberIssuesAndFines {
706 my ( $borrowernumber ) = @_;
707 my $dbh = C4::Context->dbh;
708 my $query = "SELECT COUNT(*) FROM issues WHERE borrowernumber = ?";
710 $debug and warn $query."\n";
711 my $sth = $dbh->prepare($query);
712 $sth->execute($borrowernumber);
713 my $issue_count = $sth->fetchrow_arrayref->[0];
715 $sth = $dbh->prepare(
716 "SELECT COUNT(*) FROM issues
717 WHERE borrowernumber = ?
718 AND date_due < now()"
720 $sth->execute($borrowernumber);
721 my $overdue_count = $sth->fetchrow_arrayref->[0];
723 $sth = $dbh->prepare("SELECT SUM(amountoutstanding) FROM accountlines WHERE borrowernumber = ?");
724 $sth->execute($borrowernumber);
725 my $total_fines = $sth->fetchrow_arrayref->[0];
727 return ($overdue_count, $issue_count, $total_fines);
733 my @columns = C4::Member::columns();
735 Returns an array of borrowers' table columns on success,
736 and an empty array on failure.
742 # Pure ANSI SQL goodness.
743 my $sql = 'SELECT * FROM borrowers WHERE 1=0;';
745 # Get the database handle.
746 my $dbh = C4::Context->dbh;
748 # Run the SQL statement to load STH's readonly properties.
749 my $sth = $dbh->prepare($sql);
750 my $rv = $sth->execute();
752 # This only fails if the table doesn't exist.
753 # This will always be called AFTER an install or upgrade,
754 # so borrowers will exist!
756 if ($sth->{NUM_OF_FIELDS}>0) {
757 @data = @{$sth->{NAME}};
768 my $success = ModMember(borrowernumber => $borrowernumber,
769 [ field => value ]... );
771 Modify borrower's data. All date fields should ALREADY be in ISO format.
774 true on success, or false on failure
780 # test to know if you must update or not the borrower password
781 if (exists $data{password}) {
782 if ($data{password} eq '****' or $data{password} eq '') {
783 delete $data{password};
785 $data{password} = hash_password($data{password});
788 my $old_categorycode = GetBorrowerCategorycode( $data{borrowernumber} );
789 my $execute_success=UpdateInTable("borrowers",\%data);
790 if ($execute_success) { # only proceed if the update was a success
791 # ok if its an adult (type) it may have borrowers that depend on it as a guarantor
792 # so when we update information for an adult we should check for guarantees and update the relevant part
793 # of their records, ie addresses and phone numbers
794 my $borrowercategory= GetBorrowercategory( $data{'category_type'} );
795 if ( exists $borrowercategory->{'category_type'} && $borrowercategory->{'category_type'} eq ('A' || 'S') ) {
796 # is adult check guarantees;
797 UpdateGuarantees(%data);
800 # If the patron changes to a category with enrollment fee, we add a fee
801 if ( $data{categorycode} and $data{categorycode} ne $old_categorycode ) {
802 AddEnrolmentFeeIfNeeded( $data{categorycode}, $data{borrowernumber} );
805 logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "UPDATE (executed w/ arg: $data{'borrowernumber'})") if C4::Context->preference("BorrowersLog");
807 return $execute_success;
812 $borrowernumber = &AddMember(%borrower);
814 insert new borrower into table
815 Returns the borrowernumber upon success
817 Returns as undef upon any db error without further processing
824 my $dbh = C4::Context->dbh;
826 # generate a proper login if none provided
827 $data{'userid'} = Generate_Userid($data{'borrowernumber'}, $data{'firstname'}, $data{'surname'}) if $data{'userid'} eq '';
829 # add expiration date if it isn't already there
830 unless ( $data{'dateexpiry'} ) {
831 $data{'dateexpiry'} = GetExpiryDate( $data{'categorycode'}, C4::Dates->new()->output("iso") );
834 # add enrollment date if it isn't already there
835 unless ( $data{'dateenrolled'} ) {
836 $data{'dateenrolled'} = C4::Dates->new()->output("iso");
839 # create a disabled account if no password provided
840 $data{'password'} = ($data{'password'})? hash_password($data{'password'}) : '!';
841 $data{'borrowernumber'}=InsertInTable("borrowers",\%data);
843 # mysql_insertid is probably bad. not necessarily accurate and mysql-specific at best.
844 logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
846 AddEnrolmentFeeIfNeeded( $data{categorycode}, $data{borrowernumber} );
848 return $data{'borrowernumber'};
853 my $uniqueness = Check_Userid($userid,$borrowernumber);
855 $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 != '').
857 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.
860 0 for not unique (i.e. this $userid already exists)
861 1 for unique (i.e. this $userid does not exist, or this $userid/$borrowernumber combination already exists)
866 my ( $uid, $borrowernumber ) = @_;
868 return 0 unless ($uid); # userid is a unique column, we should assume NULL is not unique
870 return 0 if ( $uid eq C4::Context->config('user') );
872 my $rs = Koha::Database->new()->schema()->resultset('Borrower');
875 $params->{userid} = $uid;
876 $params->{borrowernumber} = { '!=' => $borrowernumber } if ($borrowernumber);
878 my $count = $rs->count( $params );
880 return $count ? 0 : 1;
883 =head2 Generate_Userid
885 my $newuid = Generate_Userid($borrowernumber, $firstname, $surname);
887 Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
889 $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.
892 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).
896 sub Generate_Userid {
897 my ($borrowernumber, $firstname, $surname) = @_;
900 #The script will "do" the following code and increment the $offset until Check_Userid = 1 (i.e. until $newuid comes back as unique)
902 $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
903 $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
904 $newuid = lc(($firstname)? "$firstname.$surname" : $surname);
905 $newuid = unac_string('utf-8',$newuid);
906 $newuid .= $offset unless $offset == 0;
909 } while (!Check_Userid($newuid,$borrowernumber));
915 my ( $uid, $member, $digest ) = @_;
916 my $dbh = C4::Context->dbh;
918 #Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
919 #Then we need to tell the user and have them create a new one.
923 "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
924 $sth->execute( $uid, $member );
925 if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
929 #Everything is good so we can update the information.
932 "update borrowers set userid=?, password=? where borrowernumber=?");
933 $sth->execute( $uid, $digest, $member );
937 logaction("MEMBERS", "CHANGE PASS", $member, "") if C4::Context->preference("BorrowersLog");
943 =head2 fixup_cardnumber
945 Warning: The caller is responsible for locking the members table in write
946 mode, to avoid database corruption.
950 use vars qw( @weightings );
951 my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
953 sub fixup_cardnumber {
954 my ($cardnumber) = @_;
955 my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;
957 # Find out whether member numbers should be generated
958 # automatically. Should be either "1" or something else.
959 # Defaults to "0", which is interpreted as "no".
961 # if ($cardnumber !~ /\S/ && $autonumber_members) {
962 ($autonumber_members) or return $cardnumber;
963 my $checkdigit = C4::Context->preference('checkdigit');
964 my $dbh = C4::Context->dbh;
965 if ( $checkdigit and $checkdigit eq 'katipo' ) {
967 # if checkdigit is selected, calculate katipo-style cardnumber.
968 # otherwise, just use the max()
969 # purpose: generate checksum'd member numbers.
970 # We'll assume we just got the max value of digits 2-8 of member #'s
971 # from the database and our job is to increment that by one,
972 # determine the 1st and 9th digits and return the full string.
973 my $sth = $dbh->prepare(
974 "select max(substring(borrowers.cardnumber,2,7)) as new_num from borrowers"
977 my $data = $sth->fetchrow_hashref;
978 $cardnumber = $data->{new_num};
979 if ( !$cardnumber ) { # If DB has no values,
980 $cardnumber = 1000000; # start at 1000000
986 for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
987 # read weightings, left to right, 1 char at a time
988 my $temp1 = $weightings[$i];
990 # sequence left to right, 1 char at a time
991 my $temp2 = substr( $cardnumber, $i, 1 );
993 # mult each char 1-7 by its corresponding weighting
994 $sum += $temp1 * $temp2;
997 my $rem = ( $sum % 11 );
998 $rem = 'X' if $rem == 10;
1000 return "V$cardnumber$rem";
1003 my $sth = $dbh->prepare(
1004 'SELECT MAX( CAST( cardnumber AS SIGNED ) ) FROM borrowers WHERE cardnumber REGEXP "^-?[0-9]+$"'
1007 my ($result) = $sth->fetchrow;
1010 return $cardnumber; # just here as a fallback/reminder
1013 =head2 GetGuarantees
1015 ($num_children, $children_arrayref) = &GetGuarantees($parent_borrno);
1016 $child0_cardno = $children_arrayref->[0]{"cardnumber"};
1017 $child0_borrno = $children_arrayref->[0]{"borrowernumber"};
1019 C<&GetGuarantees> takes a borrower number (e.g., that of a patron
1020 with children) and looks up the borrowers who are guaranteed by that
1021 borrower (i.e., the patron's children).
1023 C<&GetGuarantees> returns two values: an integer giving the number of
1024 borrowers guaranteed by C<$parent_borrno>, and a reference to an array
1025 of references to hash, which gives the actual results.
1031 my ($borrowernumber) = @_;
1032 my $dbh = C4::Context->dbh;
1035 "select cardnumber,borrowernumber, firstname, surname from borrowers where guarantorid=?"
1037 $sth->execute($borrowernumber);
1040 my $data = $sth->fetchall_arrayref({});
1041 return ( scalar(@$data), $data );
1044 =head2 UpdateGuarantees
1046 &UpdateGuarantees($parent_borrno);
1049 C<&UpdateGuarantees> borrower data for an adult and updates all the guarantees
1050 with the modified information
1055 sub UpdateGuarantees {
1057 my $dbh = C4::Context->dbh;
1058 my ( $count, $guarantees ) = GetGuarantees( $data{'borrowernumber'} );
1059 foreach my $guarantee (@$guarantees){
1060 my $guaquery = qq|UPDATE borrowers
1061 SET address=?,fax=?,B_city=?,mobile=?,city=?,phone=?
1062 WHERE borrowernumber=?
1064 my $sth = $dbh->prepare($guaquery);
1065 $sth->execute($data{'address'},$data{'fax'},$data{'B_city'},$data{'mobile'},$data{'city'},$data{'phone'},$guarantee->{'borrowernumber'});
1068 =head2 GetPendingIssues
1070 my $issues = &GetPendingIssues(@borrowernumber);
1072 Looks up what the patron with the given borrowernumber has borrowed.
1074 C<&GetPendingIssues> returns a
1075 reference-to-array where each element is a reference-to-hash; the
1076 keys are the fields from the C<issues>, C<biblio>, and C<items> tables.
1077 The keys include C<biblioitems> fields except marc and marcxml.
1082 sub GetPendingIssues {
1083 my @borrowernumbers = @_;
1085 unless (@borrowernumbers ) { # return a ref_to_array
1086 return \@borrowernumbers; # to not cause surprise to caller
1089 # Borrowers part of the query
1091 for (my $i = 0; $i < @borrowernumbers; $i++) {
1092 $bquery .= ' issues.borrowernumber = ?';
1093 if ($i < $#borrowernumbers ) {
1098 # must avoid biblioitems.* to prevent large marc and marcxml fields from killing performance
1099 # FIXME: namespace collision: each table has "timestamp" fields. Which one is "timestamp" ?
1100 # FIXME: circ/ciculation.pl tries to sort by timestamp!
1101 # FIXME: namespace collision: other collisions possible.
1102 # FIXME: most of this data isn't really being used by callers.
1109 biblioitems.itemtype,
1112 biblioitems.publicationyear,
1113 biblioitems.publishercode,
1114 biblioitems.volumedate,
1115 biblioitems.volumedesc,
1118 borrowers.firstname,
1120 borrowers.cardnumber,
1121 issues.timestamp AS timestamp,
1122 issues.renewals AS renewals,
1123 issues.borrowernumber AS borrowernumber,
1124 items.renewals AS totalrenewals
1126 LEFT JOIN items ON items.itemnumber = issues.itemnumber
1127 LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
1128 LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
1129 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
1132 ORDER BY issues.issuedate"
1135 my $sth = C4::Context->dbh->prepare($query);
1136 $sth->execute(@borrowernumbers);
1137 my $data = $sth->fetchall_arrayref({});
1138 my $tz = C4::Context->tz();
1139 my $today = DateTime->now( time_zone => $tz);
1140 foreach (@{$data}) {
1141 if ($_->{issuedate}) {
1142 $_->{issuedate} = dt_from_string($_->{issuedate}, 'sql');
1144 $_->{date_due} or next;
1145 $_->{date_due} = DateTime::Format::DateParse->parse_datetime($_->{date_due}, $tz->name());
1146 if ( DateTime->compare($_->{date_due}, $today) == -1 ) {
1155 $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
1157 Looks up what the patron with the given borrowernumber has borrowed,
1158 and sorts the results.
1160 C<$sortkey> is the name of a field on which to sort the results. This
1161 should be the name of a field in the C<issues>, C<biblio>,
1162 C<biblioitems>, or C<items> table in the Koha database.
1164 C<$limit> is the maximum number of results to return.
1166 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
1167 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
1168 C<items> tables of the Koha database.
1174 my ( $borrowernumber, $order, $limit ) = @_;
1176 my $dbh = C4::Context->dbh;
1178 'SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1180 LEFT JOIN items on items.itemnumber=issues.itemnumber
1181 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1182 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1183 WHERE borrowernumber=?
1185 SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1187 LEFT JOIN items on items.itemnumber=old_issues.itemnumber
1188 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1189 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1190 WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL
1191 order by ' . $order;
1193 $query .= " limit $limit";
1196 my $sth = $dbh->prepare($query);
1197 $sth->execute( $borrowernumber, $borrowernumber );
1198 return $sth->fetchall_arrayref( {} );
1202 =head2 GetMemberAccountRecords
1204 ($total, $acctlines, $count) = &GetMemberAccountRecords($borrowernumber);
1206 Looks up accounting data for the patron with the given borrowernumber.
1208 C<&GetMemberAccountRecords> returns a three-element array. C<$acctlines> is a
1209 reference-to-array, where each element is a reference-to-hash; the
1210 keys are the fields of the C<accountlines> table in the Koha database.
1211 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1212 total amount outstanding for all of the account lines.
1216 sub GetMemberAccountRecords {
1217 my ($borrowernumber) = @_;
1218 my $dbh = C4::Context->dbh;
1224 WHERE borrowernumber=?);
1225 $strsth.=" ORDER BY date desc,timestamp DESC";
1226 my $sth= $dbh->prepare( $strsth );
1227 $sth->execute( $borrowernumber );
1230 while ( my $data = $sth->fetchrow_hashref ) {
1231 if ( $data->{itemnumber} ) {
1232 my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
1233 $data->{biblionumber} = $biblio->{biblionumber};
1234 $data->{title} = $biblio->{title};
1236 $acctlines[$numlines] = $data;
1238 $total += int(1000 * $data->{'amountoutstanding'}); # convert float to integer to avoid round-off errors
1241 return ( $total, \@acctlines,$numlines);
1244 =head2 GetMemberAccountBalance
1246 ($total_balance, $non_issue_balance, $other_charges) = &GetMemberAccountBalance($borrowernumber);
1248 Calculates amount immediately owing by the patron - non-issue charges.
1249 Based on GetMemberAccountRecords.
1250 Charges exempt from non-issue are:
1252 * Rent (rental) if RentalsInNoissuesCharge syspref is set to false
1253 * Manual invoices if ManInvInNoissuesCharge syspref is set to false
1257 sub GetMemberAccountBalance {
1258 my ($borrowernumber) = @_;
1260 my $ACCOUNT_TYPE_LENGTH = 5; # this is plain ridiculous...
1262 my @not_fines = ('Res');
1263 push @not_fines, 'Rent' unless C4::Context->preference('RentalsInNoissuesCharge');
1264 unless ( C4::Context->preference('ManInvInNoissuesCharge') ) {
1265 my $dbh = C4::Context->dbh;
1266 my $man_inv_types = $dbh->selectcol_arrayref(qq{SELECT authorised_value FROM authorised_values WHERE category = 'MANUAL_INV'});
1267 push @not_fines, map substr($_, 0, $ACCOUNT_TYPE_LENGTH), @$man_inv_types;
1269 my %not_fine = map {$_ => 1} @not_fines;
1271 my ($total, $acctlines) = GetMemberAccountRecords($borrowernumber);
1272 my $other_charges = 0;
1273 foreach (@$acctlines) {
1274 $other_charges += $_->{amountoutstanding} if $not_fine{ substr($_->{accounttype}, 0, $ACCOUNT_TYPE_LENGTH) };
1277 return ( $total, $total - $other_charges, $other_charges);
1280 =head2 GetBorNotifyAcctRecord
1282 ($total, $acctlines, $count) = &GetBorNotifyAcctRecord($params,$notifyid);
1284 Looks up accounting data for the patron with the given borrowernumber per file number.
1286 C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a
1287 reference-to-array, where each element is a reference-to-hash; the
1288 keys are the fields of the C<accountlines> table in the Koha database.
1289 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1290 total amount outstanding for all of the account lines.
1294 sub GetBorNotifyAcctRecord {
1295 my ( $borrowernumber, $notifyid ) = @_;
1296 my $dbh = C4::Context->dbh;
1299 my $sth = $dbh->prepare(
1302 WHERE borrowernumber=?
1304 AND amountoutstanding != '0'
1305 ORDER BY notify_id,accounttype
1308 $sth->execute( $borrowernumber, $notifyid );
1310 while ( my $data = $sth->fetchrow_hashref ) {
1311 if ( $data->{itemnumber} ) {
1312 my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
1313 $data->{biblionumber} = $biblio->{biblionumber};
1314 $data->{title} = $biblio->{title};
1316 $acctlines[$numlines] = $data;
1318 $total += int(100 * $data->{'amountoutstanding'});
1321 return ( $total, \@acctlines, $numlines );
1324 =head2 checkuniquemember (OUEST-PROVENCE)
1326 ($result,$categorycode) = &checkuniquemember($collectivity,$surname,$firstname,$dateofbirth);
1328 Checks that a member exists or not in the database.
1330 C<&result> is nonzero (=exist) or 0 (=does not exist)
1331 C<&categorycode> is from categorycode table
1332 C<&collectivity> is 1 (= we add a collectivity) or 0 (= we add a physical member)
1333 C<&surname> is the surname
1334 C<&firstname> is the firstname (only if collectivity=0)
1335 C<&dateofbirth> is the date of birth in ISO format (only if collectivity=0)
1339 # FIXME: This function is not legitimate. Multiple patrons might have the same first/last name and birthdate.
1340 # This is especially true since first name is not even a required field.
1342 sub checkuniquemember {
1343 my ( $collectivity, $surname, $firstname, $dateofbirth ) = @_;
1344 my $dbh = C4::Context->dbh;
1345 my $request = ($collectivity) ?
1346 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? " :
1348 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=? and dateofbirth=?" :
1349 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=?";
1350 my $sth = $dbh->prepare($request);
1351 if ($collectivity) {
1352 $sth->execute( uc($surname) );
1353 } elsif($dateofbirth){
1354 $sth->execute( uc($surname), ucfirst($firstname), $dateofbirth );
1356 $sth->execute( uc($surname), ucfirst($firstname));
1358 my @data = $sth->fetchrow;
1359 ( $data[0] ) and return $data[0], $data[1];
1363 sub checkcardnumber {
1364 my ( $cardnumber, $borrowernumber ) = @_;
1366 # If cardnumber is null, we assume they're allowed.
1367 return 0 unless defined $cardnumber;
1369 my $dbh = C4::Context->dbh;
1370 my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
1371 $query .= " AND borrowernumber <> ?" if ($borrowernumber);
1372 my $sth = $dbh->prepare($query);
1375 ( $borrowernumber ? $borrowernumber : () )
1378 return 1 if $sth->fetchrow_hashref;
1380 my ( $min_length, $max_length ) = get_cardnumber_length();
1382 if length $cardnumber > $max_length
1383 or length $cardnumber < $min_length;
1388 =head2 get_cardnumber_length
1390 my ($min, $max) = C4::Members::get_cardnumber_length()
1392 Returns the minimum and maximum length for patron cardnumbers as
1393 determined by the CardnumberLength system preference, the
1394 BorrowerMandatoryField system preference, and the width of the
1399 sub get_cardnumber_length {
1400 my ( $min, $max ) = ( 0, 16 ); # borrowers.cardnumber is a nullable varchar(16)
1401 $min = 1 if C4::Context->preference('BorrowerMandatoryField') =~ /cardnumber/;
1402 if ( my $cardnumber_length = C4::Context->preference('CardnumberLength') ) {
1403 # Is integer and length match
1404 if ( $cardnumber_length =~ m|^\d+$| ) {
1405 $min = $max = $cardnumber_length
1406 if $cardnumber_length >= $min
1407 and $cardnumber_length <= $max;
1409 # Else assuming it is a range
1410 elsif ( $cardnumber_length =~ m|(\d*),(\d*)| ) {
1411 $min = $1 if $1 and $min < $1;
1412 $max = $2 if $2 and $max > $2;
1416 return ( $min, $max );
1419 =head2 getzipnamecity (OUEST-PROVENCE)
1421 take all info from table city for the fields city and zip
1422 check for the name and the zip code of the city selected
1426 sub getzipnamecity {
1428 my $dbh = C4::Context->dbh;
1431 "select city_name,city_state,city_zipcode,city_country from cities where cityid=? ");
1432 $sth->execute($cityid);
1433 my @data = $sth->fetchrow;
1434 return $data[0], $data[1], $data[2], $data[3];
1438 =head2 getdcity (OUEST-PROVENCE)
1440 recover cityid with city_name condition
1445 my ($city_name) = @_;
1446 my $dbh = C4::Context->dbh;
1447 my $sth = $dbh->prepare("select cityid from cities where city_name=? ");
1448 $sth->execute($city_name);
1449 my $data = $sth->fetchrow;
1453 =head2 GetFirstValidEmailAddress
1455 $email = GetFirstValidEmailAddress($borrowernumber);
1457 Return the first valid email address for a borrower, given the borrowernumber. For now, the order
1458 is defined as email, emailpro, B_email. Returns the empty string if the borrower has no email
1463 sub GetFirstValidEmailAddress {
1464 my $borrowernumber = shift;
1465 my $dbh = C4::Context->dbh;
1466 my $sth = $dbh->prepare( "SELECT email, emailpro, B_email FROM borrowers where borrowernumber = ? ");
1467 $sth->execute( $borrowernumber );
1468 my $data = $sth->fetchrow_hashref;
1470 if ($data->{'email'}) {
1471 return $data->{'email'};
1472 } elsif ($data->{'emailpro'}) {
1473 return $data->{'emailpro'};
1474 } elsif ($data->{'B_email'}) {
1475 return $data->{'B_email'};
1481 =head2 GetNoticeEmailAddress
1483 $email = GetNoticeEmailAddress($borrowernumber);
1485 Return the email address of borrower used for notices, given the borrowernumber.
1486 Returns the empty string if no email address.
1490 sub GetNoticeEmailAddress {
1491 my $borrowernumber = shift;
1493 my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
1494 # if syspref is set to 'first valid' (value == OFF), look up email address
1495 if ( $which_address eq 'OFF' ) {
1496 return GetFirstValidEmailAddress($borrowernumber);
1498 # specified email address field
1499 my $dbh = C4::Context->dbh;
1500 my $sth = $dbh->prepare( qq{
1501 SELECT $which_address AS primaryemail
1503 WHERE borrowernumber=?
1505 $sth->execute($borrowernumber);
1506 my $data = $sth->fetchrow_hashref;
1507 return $data->{'primaryemail'} || '';
1510 =head2 GetExpiryDate
1512 $expirydate = GetExpiryDate($categorycode, $dateenrolled);
1514 Calculate expiry date given a categorycode and starting date. Date argument must be in ISO format.
1515 Return date is also in ISO format.
1520 my ( $categorycode, $dateenrolled ) = @_;
1522 if ($categorycode) {
1523 my $dbh = C4::Context->dbh;
1524 my $sth = $dbh->prepare("SELECT enrolmentperiod,enrolmentperioddate FROM categories WHERE categorycode=?");
1525 $sth->execute($categorycode);
1526 $enrolments = $sth->fetchrow_hashref;
1528 # die "GetExpiryDate: for enrollmentperiod $enrolmentperiod (category '$categorycode') starting $dateenrolled.\n";
1529 my @date = split (/-/,$dateenrolled);
1530 if($enrolments->{enrolmentperiod}){
1531 return sprintf("%04d-%02d-%02d", Add_Delta_YM(@date,0,$enrolments->{enrolmentperiod}));
1533 return $enrolments->{enrolmentperioddate};
1537 =head2 GetborCatFromCatType
1539 ($codes_arrayref, $labels_hashref) = &GetborCatFromCatType();
1541 Looks up the different types of borrowers in the database. Returns two
1542 elements: a reference-to-array, which lists the borrower category
1543 codes, and a reference-to-hash, which maps the borrower category codes
1544 to category descriptions.
1549 sub GetborCatFromCatType {
1550 my ( $category_type, $action, $no_branch_limit ) = @_;
1552 my $branch_limit = $no_branch_limit
1554 : C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1556 # FIXME - This API seems both limited and dangerous.
1557 my $dbh = C4::Context->dbh;
1560 SELECT categories.categorycode, categories.description
1564 LEFT JOIN categories_branches ON categories.categorycode = categories_branches.categorycode
1567 $request .= " $action ";
1568 $request .= " AND (branchcode = ? OR branchcode IS NULL) GROUP BY description" if $branch_limit;
1570 $request .= " WHERE branchcode = ? OR branchcode IS NULL GROUP BY description" if $branch_limit;
1572 $request .= " ORDER BY categorycode";
1574 my $sth = $dbh->prepare($request);
1576 $action ? $category_type : (),
1577 $branch_limit ? $branch_limit : ()
1583 while ( my $data = $sth->fetchrow_hashref ) {
1584 push @codes, $data->{'categorycode'};
1585 $labels{ $data->{'categorycode'} } = $data->{'description'};
1588 return ( \@codes, \%labels );
1591 =head2 GetBorrowercategory
1593 $hashref = &GetBorrowercategory($categorycode);
1595 Given the borrower's category code, the function returns the corresponding
1596 data hashref for a comprehensive information display.
1600 sub GetBorrowercategory {
1602 my $dbh = C4::Context->dbh;
1606 "SELECT description,dateofbirthrequired,upperagelimit,category_type
1608 WHERE categorycode = ?"
1610 $sth->execute($catcode);
1612 $sth->fetchrow_hashref;
1616 } # sub getborrowercategory
1619 =head2 GetBorrowerCategorycode
1621 $categorycode = &GetBorrowerCategoryCode( $borrowernumber );
1623 Given the borrowernumber, the function returns the corresponding categorycode
1626 sub GetBorrowerCategorycode {
1627 my ( $borrowernumber ) = @_;
1628 my $dbh = C4::Context->dbh;
1629 my $sth = $dbh->prepare( qq{
1632 WHERE borrowernumber = ?
1634 $sth->execute( $borrowernumber );
1635 return $sth->fetchrow;
1638 =head2 GetBorrowercategoryList
1640 $arrayref_hashref = &GetBorrowercategoryList;
1641 If no category code provided, the function returns all the categories.
1645 sub GetBorrowercategoryList {
1646 my $no_branch_limit = @_ ? shift : 0;
1647 my $branch_limit = $no_branch_limit
1649 : C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1650 my $dbh = C4::Context->dbh;
1651 my $query = "SELECT categories.* FROM categories";
1653 LEFT JOIN categories_branches ON categories.categorycode = categories_branches.categorycode
1654 WHERE branchcode = ? OR branchcode IS NULL GROUP BY description
1656 $query .= " ORDER BY description";
1657 my $sth = $dbh->prepare( $query );
1658 $sth->execute( $branch_limit ? $branch_limit : () );
1659 my $data = $sth->fetchall_arrayref( {} );
1662 } # sub getborrowercategory
1664 =head2 ethnicitycategories
1666 ($codes_arrayref, $labels_hashref) = ðnicitycategories();
1668 Looks up the different ethnic types in the database. Returns two
1669 elements: a reference-to-array, which lists the ethnicity codes, and a
1670 reference-to-hash, which maps the ethnicity codes to ethnicity
1677 sub ethnicitycategories {
1678 my $dbh = C4::Context->dbh;
1679 my $sth = $dbh->prepare("Select code,name from ethnicity order by name");
1683 while ( my $data = $sth->fetchrow_hashref ) {
1684 push @codes, $data->{'code'};
1685 $labels{ $data->{'code'} } = $data->{'name'};
1687 return ( \@codes, \%labels );
1692 $ethn_name = &fixEthnicity($ethn_code);
1694 Takes an ethnicity code (e.g., "european" or "pi") and returns the
1695 corresponding descriptive name from the C<ethnicity> table in the
1696 Koha database ("European" or "Pacific Islander").
1703 my $ethnicity = shift;
1704 return unless $ethnicity;
1705 my $dbh = C4::Context->dbh;
1706 my $sth = $dbh->prepare("Select name from ethnicity where code = ?");
1707 $sth->execute($ethnicity);
1708 my $data = $sth->fetchrow_hashref;
1709 return $data->{'name'};
1710 } # sub fixEthnicity
1714 $dateofbirth,$date = &GetAge($date);
1716 this function return the borrowers age with the value of dateofbirth
1722 my ( $date, $date_ref ) = @_;
1724 if ( not defined $date_ref ) {
1725 $date_ref = sprintf( '%04d-%02d-%02d', Today() );
1728 my ( $year1, $month1, $day1 ) = split /-/, $date;
1729 my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
1731 my $age = $year2 - $year1;
1732 if ( $month1 . $day1 > $month2 . $day2 ) {
1741 $cityarrayref = GetCities();
1743 Returns an array_ref of the entries in the cities table
1744 If there are entries in the table an empty row is returned
1745 This is currently only used to populate a popup in memberentry
1751 my $dbh = C4::Context->dbh;
1752 my $city_arr = $dbh->selectall_arrayref(
1753 q|SELECT cityid,city_zipcode,city_name,city_state,city_country FROM cities ORDER BY city_name|,
1755 if ( @{$city_arr} ) {
1756 unshift @{$city_arr}, {
1757 city_zipcode => q{},
1761 city_country => q{},
1768 =head2 GetSortDetails (OUEST-PROVENCE)
1770 ($lib) = &GetSortDetails($category,$sortvalue);
1772 Returns the authorized value details
1773 C<&$lib>return value of authorized value details
1774 C<&$sortvalue>this is the value of authorized value
1775 C<&$category>this is the value of authorized value category
1779 sub GetSortDetails {
1780 my ( $category, $sortvalue ) = @_;
1781 my $dbh = C4::Context->dbh;
1782 my $query = qq|SELECT lib
1783 FROM authorised_values
1785 AND authorised_value=? |;
1786 my $sth = $dbh->prepare($query);
1787 $sth->execute( $category, $sortvalue );
1788 my $lib = $sth->fetchrow;
1789 return ($lib) if ($lib);
1790 return ($sortvalue) unless ($lib);
1793 =head2 MoveMemberToDeleted
1795 $result = &MoveMemberToDeleted($borrowernumber);
1797 Copy the record from borrowers to deletedborrowers table.
1801 # FIXME: should do it in one SQL statement w/ subquery
1802 # Otherwise, we should return the @data on success
1804 sub MoveMemberToDeleted {
1805 my ($member) = shift or return;
1806 my $dbh = C4::Context->dbh;
1807 my $query = qq|SELECT *
1809 WHERE borrowernumber=?|;
1810 my $sth = $dbh->prepare($query);
1811 $sth->execute($member);
1812 my @data = $sth->fetchrow_array;
1813 (@data) or return; # if we got a bad borrowernumber, there's nothing to insert
1815 $dbh->prepare( "INSERT INTO deletedborrowers VALUES ("
1816 . ( "?," x ( scalar(@data) - 1 ) )
1818 $sth->execute(@data);
1823 DelMember($borrowernumber);
1825 This function remove directly a borrower whitout writing it on deleteborrower.
1826 + Deletes reserves for the borrower
1831 my $dbh = C4::Context->dbh;
1832 my $borrowernumber = shift;
1833 #warn "in delmember with $borrowernumber";
1834 return unless $borrowernumber; # borrowernumber is mandatory.
1836 my $query = qq|DELETE
1838 WHERE borrowernumber=?|;
1839 my $sth = $dbh->prepare($query);
1840 $sth->execute($borrowernumber);
1844 WHERE borrowernumber = ?
1846 $sth = $dbh->prepare($query);
1847 $sth->execute($borrowernumber);
1848 logaction("MEMBERS", "DELETE", $borrowernumber, "") if C4::Context->preference("BorrowersLog");
1852 =head2 ExtendMemberSubscriptionTo (OUEST-PROVENCE)
1854 $date = ExtendMemberSubscriptionTo($borrowerid, $date);
1856 Extending the subscription to a given date or to the expiry date calculated on ISO date.
1861 sub ExtendMemberSubscriptionTo {
1862 my ( $borrowerid,$date) = @_;
1863 my $dbh = C4::Context->dbh;
1864 my $borrower = GetMember('borrowernumber'=>$borrowerid);
1866 $date = (C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry') ?
1867 C4::Dates->new($borrower->{'dateexpiry'}, 'iso')->output("iso") :
1868 C4::Dates->new()->output("iso");
1869 $date = GetExpiryDate( $borrower->{'categorycode'}, $date );
1871 my $sth = $dbh->do(<<EOF);
1873 SET dateexpiry='$date'
1874 WHERE borrowernumber='$borrowerid'
1877 AddEnrolmentFeeIfNeeded( $borrower->{categorycode}, $borrower->{borrowernumber} );
1879 logaction("MEMBERS", "RENEW", $borrower->{'borrowernumber'}, "Membership renewed")if C4::Context->preference("BorrowersLog");
1880 return $date if ($sth);
1884 =head2 GetTitles (OUEST-PROVENCE)
1886 ($borrowertitle)= &GetTitles();
1888 Looks up the different title . Returns array with all borrowers title
1893 my @borrowerTitle = split (/,|\|/,C4::Context->preference('BorrowersTitles'));
1894 unshift( @borrowerTitle, "" );
1895 my $count=@borrowerTitle;
1900 return ( \@borrowerTitle);
1904 =head2 GetPatronImage
1906 my ($imagedata, $dberror) = GetPatronImage($borrowernumber);
1908 Returns the mimetype and binary image data of the image for the patron with the supplied borrowernumber.
1912 sub GetPatronImage {
1913 my ($borrowernumber) = @_;
1914 warn "Borrowernumber passed to GetPatronImage is $borrowernumber" if $debug;
1915 my $dbh = C4::Context->dbh;
1916 my $query = 'SELECT mimetype, imagefile FROM patronimage WHERE borrowernumber = ?';
1917 my $sth = $dbh->prepare($query);
1918 $sth->execute($borrowernumber);
1919 my $imagedata = $sth->fetchrow_hashref;
1920 warn "Database error!" if $sth->errstr;
1921 return $imagedata, $sth->errstr;
1924 =head2 PutPatronImage
1926 PutPatronImage($cardnumber, $mimetype, $imgfile);
1928 Stores patron binary image data and mimetype in database.
1929 NOTE: This function is good for updating images as well as inserting new images in the database.
1933 sub PutPatronImage {
1934 my ($cardnumber, $mimetype, $imgfile) = @_;
1935 warn "Parameters passed in: Cardnumber=$cardnumber, Mimetype=$mimetype, " . ($imgfile ? "Imagefile" : "No Imagefile") if $debug;
1936 my $dbh = C4::Context->dbh;
1937 my $query = "INSERT INTO patronimage (borrowernumber, mimetype, imagefile) VALUES ( ( SELECT borrowernumber from borrowers WHERE cardnumber = ? ),?,?) ON DUPLICATE KEY UPDATE imagefile = ?;";
1938 my $sth = $dbh->prepare($query);
1939 $sth->execute($cardnumber,$mimetype,$imgfile,$imgfile);
1940 warn "Error returned inserting $cardnumber.$mimetype." if $sth->errstr;
1941 return $sth->errstr;
1944 =head2 RmPatronImage
1946 my ($dberror) = RmPatronImage($borrowernumber);
1948 Removes the image for the patron with the supplied borrowernumber.
1953 my ($borrowernumber) = @_;
1954 warn "Borrowernumber passed to GetPatronImage is $borrowernumber" if $debug;
1955 my $dbh = C4::Context->dbh;
1956 my $query = "DELETE FROM patronimage WHERE borrowernumber = ?;";
1957 my $sth = $dbh->prepare($query);
1958 $sth->execute($borrowernumber);
1959 my $dberror = $sth->errstr;
1960 warn "Database error!" if $sth->errstr;
1964 =head2 GetHideLostItemsPreference
1966 $hidelostitemspref = &GetHideLostItemsPreference($borrowernumber);
1968 Returns the HideLostItems preference for the patron category of the supplied borrowernumber
1969 C<&$hidelostitemspref>return value of function, 0 or 1
1973 sub GetHideLostItemsPreference {
1974 my ($borrowernumber) = @_;
1975 my $dbh = C4::Context->dbh;
1976 my $query = "SELECT hidelostitems FROM borrowers,categories WHERE borrowers.categorycode = categories.categorycode AND borrowernumber = ?";
1977 my $sth = $dbh->prepare($query);
1978 $sth->execute($borrowernumber);
1979 my $hidelostitems = $sth->fetchrow;
1980 return $hidelostitems;
1983 =head2 GetBorrowersToExpunge
1985 $borrowers = &GetBorrowersToExpunge(
1986 not_borrowered_since => $not_borrowered_since,
1987 expired_before => $expired_before,
1988 category_code => $category_code,
1989 branchcode => $branchcode
1992 This function get all borrowers based on the given criteria.
1996 sub GetBorrowersToExpunge {
1999 my $filterdate = $params->{'not_borrowered_since'};
2000 my $filterexpiry = $params->{'expired_before'};
2001 my $filtercategory = $params->{'category_code'};
2002 my $filterbranch = $params->{'branchcode'} ||
2003 ((C4::Context->preference('IndependentBranches')
2004 && C4::Context->userenv
2005 && !C4::Context->IsSuperLibrarian()
2006 && C4::Context->userenv->{branch})
2007 ? C4::Context->userenv->{branch}
2010 my $dbh = C4::Context->dbh;
2012 SELECT borrowers.borrowernumber,
2013 MAX(old_issues.timestamp) AS latestissue,
2014 MAX(issues.timestamp) AS currentissue
2016 JOIN categories USING (categorycode)
2017 LEFT JOIN old_issues USING (borrowernumber)
2018 LEFT JOIN issues USING (borrowernumber)
2019 WHERE category_type <> 'S'
2020 AND borrowernumber NOT IN (SELECT guarantorid FROM borrowers WHERE guarantorid IS NOT NULL AND guarantorid <> 0)
2023 if ( $filterbranch && $filterbranch ne "" ) {
2024 $query.= " AND borrowers.branchcode = ? ";
2025 push( @query_params, $filterbranch );
2027 if ( $filterexpiry ) {
2028 $query .= " AND dateexpiry < ? ";
2029 push( @query_params, $filterexpiry );
2031 if ( $filtercategory ) {
2032 $query .= " AND categorycode = ? ";
2033 push( @query_params, $filtercategory );
2035 $query.=" GROUP BY borrowers.borrowernumber HAVING currentissue IS NULL ";
2036 if ( $filterdate ) {
2037 $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
2038 push @query_params,$filterdate;
2040 warn $query if $debug;
2042 my $sth = $dbh->prepare($query);
2043 if (scalar(@query_params)>0){
2044 $sth->execute(@query_params);
2051 while ( my $data = $sth->fetchrow_hashref ) {
2052 push @results, $data;
2057 =head2 GetBorrowersWhoHaveNeverBorrowed
2059 $results = &GetBorrowersWhoHaveNeverBorrowed
2061 This function get all borrowers who have never borrowed.
2063 I<$result> is a ref to an array which all elements are a hasref.
2067 sub GetBorrowersWhoHaveNeverBorrowed {
2068 my $filterbranch = shift ||
2069 ((C4::Context->preference('IndependentBranches')
2070 && C4::Context->userenv
2071 && !C4::Context->IsSuperLibrarian()
2072 && C4::Context->userenv->{branch})
2073 ? C4::Context->userenv->{branch}
2075 my $dbh = C4::Context->dbh;
2077 SELECT borrowers.borrowernumber,max(timestamp) as latestissue
2079 LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
2080 WHERE issues.borrowernumber IS NULL
2083 if ($filterbranch && $filterbranch ne ""){
2084 $query.=" AND borrowers.branchcode= ?";
2085 push @query_params,$filterbranch;
2087 warn $query if $debug;
2089 my $sth = $dbh->prepare($query);
2090 if (scalar(@query_params)>0){
2091 $sth->execute(@query_params);
2098 while ( my $data = $sth->fetchrow_hashref ) {
2099 push @results, $data;
2104 =head2 GetBorrowersWithIssuesHistoryOlderThan
2106 $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
2108 this function get all borrowers who has an issue history older than I<$date> given on input arg.
2110 I<$result> is a ref to an array which all elements are a hashref.
2111 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2115 sub GetBorrowersWithIssuesHistoryOlderThan {
2116 my $dbh = C4::Context->dbh;
2117 my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
2118 my $filterbranch = shift ||
2119 ((C4::Context->preference('IndependentBranches')
2120 && C4::Context->userenv
2121 && !C4::Context->IsSuperLibrarian()
2122 && C4::Context->userenv->{branch})
2123 ? C4::Context->userenv->{branch}
2126 SELECT count(borrowernumber) as n,borrowernumber
2128 WHERE returndate < ?
2129 AND borrowernumber IS NOT NULL
2132 push @query_params, $date;
2134 $query.=" AND branchcode = ?";
2135 push @query_params, $filterbranch;
2137 $query.=" GROUP BY borrowernumber ";
2138 warn $query if $debug;
2139 my $sth = $dbh->prepare($query);
2140 $sth->execute(@query_params);
2143 while ( my $data = $sth->fetchrow_hashref ) {
2144 push @results, $data;
2149 =head2 GetBorrowersNamesAndLatestIssue
2151 $results = &GetBorrowersNamesAndLatestIssueList(@borrowernumbers)
2153 this function get borrowers Names and surnames and Issue information.
2155 I<@borrowernumbers> is an array which all elements are borrowernumbers.
2156 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2160 sub GetBorrowersNamesAndLatestIssue {
2161 my $dbh = C4::Context->dbh;
2162 my @borrowernumbers=@_;
2164 SELECT surname,lastname, phone, email,max(timestamp)
2166 LEFT JOIN issues ON borrowers.borrowernumber=issues.borrowernumber
2167 GROUP BY borrowernumber
2169 my $sth = $dbh->prepare($query);
2171 my $results = $sth->fetchall_arrayref({});
2179 my $success = ModPrivacy( $borrowernumber, $privacy );
2181 Update the privacy of a patron.
2184 true on success, false on failure
2191 my $borrowernumber = shift;
2192 my $privacy = shift;
2193 return unless defined $borrowernumber;
2194 return unless $borrowernumber =~ /^\d+$/;
2196 return ModMember( borrowernumber => $borrowernumber,
2197 privacy => $privacy );
2202 AddMessage( $borrowernumber, $message_type, $message, $branchcode );
2204 Adds a message to the messages table for the given borrower.
2213 my ( $borrowernumber, $message_type, $message, $branchcode ) = @_;
2215 my $dbh = C4::Context->dbh;
2217 if ( ! ( $borrowernumber && $message_type && $message && $branchcode ) ) {
2221 my $query = "INSERT INTO messages ( borrowernumber, branchcode, message_type, message ) VALUES ( ?, ?, ?, ? )";
2222 my $sth = $dbh->prepare($query);
2223 $sth->execute( $borrowernumber, $branchcode, $message_type, $message );
2224 logaction("MEMBERS", "ADDCIRCMESSAGE", $borrowernumber, $message) if C4::Context->preference("BorrowersLog");
2230 GetMessages( $borrowernumber, $type );
2232 $type is message type, B for borrower, or L for Librarian.
2233 Empty type returns all messages of any type.
2235 Returns all messages for the given borrowernumber
2240 my ( $borrowernumber, $type, $branchcode ) = @_;
2246 my $dbh = C4::Context->dbh;
2249 branches.branchname,
2252 messages.branchcode LIKE '$branchcode' AS can_delete
2253 FROM messages, branches
2254 WHERE borrowernumber = ?
2255 AND message_type LIKE ?
2256 AND messages.branchcode = branches.branchcode
2257 ORDER BY message_date DESC";
2258 my $sth = $dbh->prepare($query);
2259 $sth->execute( $borrowernumber, $type ) ;
2262 while ( my $data = $sth->fetchrow_hashref ) {
2263 my $d = C4::Dates->new( $data->{message_date}, 'iso' );
2264 $data->{message_date_formatted} = $d->output;
2265 push @results, $data;
2273 GetMessagesCount( $borrowernumber, $type );
2275 $type is message type, B for borrower, or L for Librarian.
2276 Empty type returns all messages of any type.
2278 Returns the number of messages for the given borrowernumber
2282 sub GetMessagesCount {
2283 my ( $borrowernumber, $type, $branchcode ) = @_;
2289 my $dbh = C4::Context->dbh;
2291 my $query = "SELECT COUNT(*) as MsgCount FROM messages WHERE borrowernumber = ? AND message_type LIKE ?";
2292 my $sth = $dbh->prepare($query);
2293 $sth->execute( $borrowernumber, $type ) ;
2296 my $data = $sth->fetchrow_hashref;
2297 my $count = $data->{'MsgCount'};
2304 =head2 DeleteMessage
2306 DeleteMessage( $message_id );
2311 my ( $message_id ) = @_;
2313 my $dbh = C4::Context->dbh;
2314 my $query = "SELECT * FROM messages WHERE message_id = ?";
2315 my $sth = $dbh->prepare($query);
2316 $sth->execute( $message_id );
2317 my $message = $sth->fetchrow_hashref();
2319 $query = "DELETE FROM messages WHERE message_id = ?";
2320 $sth = $dbh->prepare($query);
2321 $sth->execute( $message_id );
2322 logaction("MEMBERS", "DELCIRCMESSAGE", $message->{'borrowernumber'}, $message->{'message'}) if C4::Context->preference("BorrowersLog");
2327 IssueSlip($branchcode, $borrowernumber, $quickslip)
2329 Returns letter hash ( see C4::Letters::GetPreparedLetter )
2331 $quickslip is boolean, to indicate whether we want a quick slip
2336 my ($branch, $borrowernumber, $quickslip) = @_;
2338 # return unless ( C4::Context->boolean_preference('printcirculationslips') );
2340 my $now = POSIX::strftime("%Y-%m-%d", localtime);
2342 my $issueslist = GetPendingIssues($borrowernumber);
2343 foreach my $it (@$issueslist){
2344 if ((substr $it->{'issuedate'}, 0, 10) eq $now || (substr $it->{'lastreneweddate'}, 0, 10) eq $now) {
2347 elsif ((substr $it->{'date_due'}, 0, 10) le $now) {
2348 $it->{'overdue'} = 1;
2350 my $dt = dt_from_string( $it->{'date_due'} );
2351 $it->{'date_due'} = output_pref( $dt );;
2353 my @issues = sort { $b->{'timestamp'} <=> $a->{'timestamp'} } @$issueslist;
2355 my ($letter_code, %repeat);
2357 $letter_code = 'ISSUEQSLIP';
2359 'checkedout' => [ map {
2363 }, grep { $_->{'now'} } @issues ],
2367 $letter_code = 'ISSUESLIP';
2369 'checkedout' => [ map {
2373 }, grep { !$_->{'overdue'} } @issues ],
2375 'overdue' => [ map {
2379 }, grep { $_->{'overdue'} } @issues ],
2382 $_->{'timestamp'} = $_->{'newdate'};
2384 } @{ GetNewsToDisplay("slip",$branch) } ],
2388 return C4::Letters::GetPreparedLetter (
2389 module => 'circulation',
2390 letter_code => $letter_code,
2391 branchcode => $branch,
2393 'branches' => $branch,
2394 'borrowers' => $borrowernumber,
2400 =head2 GetBorrowersWithEmail
2402 ([$borrnum,$userid], ...) = GetBorrowersWithEmail('me@example.com');
2404 This gets a list of users and their basic details from their email address.
2405 As it's possible for multiple user to have the same email address, it provides
2406 you with all of them. If there is no userid for the user, there will be an
2407 C<undef> there. An empty list will be returned if there are no matches.
2411 sub GetBorrowersWithEmail {
2414 my $dbh = C4::Context->dbh;
2416 my $query = "SELECT borrowernumber, userid FROM borrowers WHERE email=?";
2417 my $sth=$dbh->prepare($query);
2418 $sth->execute($email);
2420 while (my $ref = $sth->fetch) {
2423 die "Failure searching for borrowers by email address: $sth->errstr" if $sth->err;
2427 sub AddMember_Opac {
2428 my ( %borrower ) = @_;
2430 $borrower{'categorycode'} = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
2432 my $sr = new String::Random;
2433 $sr->{'A'} = [ 'A'..'Z', 'a'..'z' ];
2434 my $password = $sr->randpattern("AAAAAAAAAA");
2435 $borrower{'password'} = $password;
2437 $borrower{'cardnumber'} = fixup_cardnumber();
2439 my $borrowernumber = AddMember(%borrower);
2441 return ( $borrowernumber, $password );
2444 =head2 AddEnrolmentFeeIfNeeded
2446 AddEnrolmentFeeIfNeeded( $borrower->{categorycode}, $borrower->{borrowernumber} );
2448 Add enrolment fee for a patron if needed.
2452 sub AddEnrolmentFeeIfNeeded {
2453 my ( $categorycode, $borrowernumber ) = @_;
2454 # check for enrollment fee & add it if needed
2455 my $dbh = C4::Context->dbh;
2456 my $sth = $dbh->prepare(q{
2459 WHERE categorycode=?
2461 $sth->execute( $categorycode );
2463 warn sprintf('Database returned the following error: %s', $sth->errstr);
2466 my ($enrolmentfee) = $sth->fetchrow;
2467 if ($enrolmentfee && $enrolmentfee > 0) {
2468 # insert fee in patron debts
2469 C4::Accounts::manualinvoice( $borrowernumber, '', '', 'A', $enrolmentfee );
2474 my ( $borrowernumber ) = @_;
2476 my $sql = "SELECT COUNT(*) FROM issues WHERE date_due < NOW() AND borrowernumber = ?";
2477 my $sth = C4::Context->dbh->prepare( $sql );
2478 $sth->execute( $borrowernumber );
2479 my ( $count ) = $sth->fetchrow_array();
2484 END { } # module clean-up code here (global destructor)