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 Digest::MD5 qw(md5_base64);
28 use String::Random qw( random_string );
29 use Date::Calc qw/Today Add_Delta_YM check_date Date_to_Days/;
30 use C4::Log; # logaction
36 use C4::SQLHelper qw(InsertInTable UpdateInTable SearchInTable);
37 use C4::Members::Attributes qw(SearchIdMatchingAttribute);
38 use C4::NewsChannels; #get slip news
40 use DateTime::Format::DateParse;
42 use Text::Unaccent qw( unac_string );
44 our ($VERSION,@ISA,@EXPORT,@EXPORT_OK,$debug);
47 $VERSION = 3.07.00.049;
48 $debug = $ENV{DEBUG} || 0;
60 &GetMemberIssuesAndFines
68 &GetFirstValidEmailAddress
69 &GetNoticeEmailAddress
82 &GetHideLostItemsPreference
85 &GetMemberAccountRecords
86 &GetBorNotifyAcctRecord
90 GetBorrowerCategorycode
91 &GetBorrowercategoryList
93 &GetBorrowersToExpunge
94 &GetBorrowersWhoHaveNeverBorrowed
95 &GetBorrowersWithIssuesHistoryOlderThan
105 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("IndependantBranches") ) { # && !$showallbranches){
260 if ( my $userenv = C4::Context->userenv ) {
261 my $branch = $userenv->{'branch'};
262 if ( ($userenv->{flags} % 2 !=1) && $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("SELECT borrowers.*,category_type,categories.description,reservefee,enrolmentperiod FROM borrowers LEFT JOIN categories ON borrowers.categorycode=categories.categorycode WHERE borrowernumber=?");
328 $sth->execute($borrowernumber);
330 elsif ($cardnumber) {
331 $sth = $dbh->prepare("SELECT borrowers.*,category_type,categories.description,reservefee,enrolmentperiod FROM borrowers LEFT JOIN categories ON borrowers.categorycode=categories.categorycode WHERE cardnumber=?");
332 $sth->execute($cardnumber);
337 my $borrower = $sth->fetchrow_hashref;
338 my ($amount) = GetMemberAccountRecords( $borrowernumber);
339 $borrower->{'amountoutstanding'} = $amount;
340 # FIXME - patronflags calls GetMemberAccountRecords... just have patronflags return $amount
341 my $flags = patronflags( $borrower);
344 $sth = $dbh->prepare("select bit,flag from userflags");
346 while ( my ( $bit, $flag ) = $sth->fetchrow ) {
347 if ( $borrower->{'flags'} && $borrower->{'flags'} & 2**$bit ) {
348 $accessflagshash->{$flag} = 1;
351 $borrower->{'flags'} = $flags;
352 $borrower->{'authflags'} = $accessflagshash;
354 # For the purposes of making templates easier, we'll define a
355 # 'showname' which is the alternate form the user's first name if
356 # 'other name' is defined.
357 if ($borrower->{category_type} eq 'I') {
358 $borrower->{'showname'} = $borrower->{'othernames'};
359 $borrower->{'showname'} .= " $borrower->{'firstname'}" if $borrower->{'firstname'};
361 $borrower->{'showname'} = $borrower->{'firstname'};
364 return ($borrower); #, $flags, $accessflagshash);
369 $flags = &patronflags($patron);
371 This function is not exported.
373 The following will be set where applicable:
374 $flags->{CHARGES}->{amount} Amount of debt
375 $flags->{CHARGES}->{noissues} Set if debt amount >$5.00 (or syspref noissuescharge)
376 $flags->{CHARGES}->{message} Message -- deprecated
378 $flags->{CREDITS}->{amount} Amount of credit
379 $flags->{CREDITS}->{message} Message -- deprecated
381 $flags->{ GNA } Patron has no valid address
382 $flags->{ GNA }->{noissues} Set for each GNA
383 $flags->{ GNA }->{message} "Borrower has no valid address" -- deprecated
385 $flags->{ LOST } Patron's card reported lost
386 $flags->{ LOST }->{noissues} Set for each LOST
387 $flags->{ LOST }->{message} Message -- deprecated
389 $flags->{DBARRED} Set if patron debarred, no access
390 $flags->{DBARRED}->{noissues} Set for each DBARRED
391 $flags->{DBARRED}->{message} Message -- deprecated
394 $flags->{ NOTES }->{message} The note itself. NOT deprecated
396 $flags->{ ODUES } Set if patron has overdue books.
397 $flags->{ ODUES }->{message} "Yes" -- deprecated
398 $flags->{ ODUES }->{itemlist} ref-to-array: list of overdue books
399 $flags->{ ODUES }->{itemlisttext} Text list of overdue items -- deprecated
401 $flags->{WAITING} Set if any of patron's reserves are available
402 $flags->{WAITING}->{message} Message -- deprecated
403 $flags->{WAITING}->{itemlist} ref-to-array: list of available items
407 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
408 overdue items. Its elements are references-to-hash, each describing an
409 overdue item. The keys are selected fields from the issues, biblio,
410 biblioitems, and items tables of the Koha database.
412 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
413 the overdue items, one per line. Deprecated.
415 =item C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
416 available items. Each element is a reference-to-hash whose keys are
417 fields from the reserves table of the Koha database.
421 All the "message" fields that include language generated in this function are deprecated,
422 because such strings belong properly in the display layer.
424 The "message" field that comes from the DB is OK.
428 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
429 # FIXME rename this function.
432 my ( $patroninformation) = @_;
433 my $dbh=C4::Context->dbh;
434 my ($balance, $owing) = GetMemberAccountBalance( $patroninformation->{'borrowernumber'});
437 my $noissuescharge = C4::Context->preference("noissuescharge") || 5;
438 $flaginfo{'message'} = sprintf "Patron owes \$%.02f", $owing;
439 $flaginfo{'amount'} = sprintf "%.02f", $owing;
440 if ( $owing > $noissuescharge && !C4::Context->preference("AllowFineOverride") ) {
441 $flaginfo{'noissues'} = 1;
443 $flags{'CHARGES'} = \%flaginfo;
445 elsif ( $balance < 0 ) {
447 $flaginfo{'message'} = sprintf "Patron has credit of \$%.02f", -$balance;
448 $flaginfo{'amount'} = sprintf "%.02f", $balance;
449 $flags{'CREDITS'} = \%flaginfo;
451 if ( $patroninformation->{'gonenoaddress'}
452 && $patroninformation->{'gonenoaddress'} == 1 )
455 $flaginfo{'message'} = 'Borrower has no valid address.';
456 $flaginfo{'noissues'} = 1;
457 $flags{'GNA'} = \%flaginfo;
459 if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
461 $flaginfo{'message'} = 'Borrower\'s card reported lost.';
462 $flaginfo{'noissues'} = 1;
463 $flags{'LOST'} = \%flaginfo;
465 if ( $patroninformation->{'debarred'} && check_date( split( /-/, $patroninformation->{'debarred'} ) ) ) {
466 if ( Date_to_Days(Date::Calc::Today) < Date_to_Days( split( /-/, $patroninformation->{'debarred'} ) ) ) {
468 $flaginfo{'debarredcomment'} = $patroninformation->{'debarredcomment'};
469 $flaginfo{'message'} = $patroninformation->{'debarredcomment'};
470 $flaginfo{'noissues'} = 1;
471 $flaginfo{'dateend'} = $patroninformation->{'debarred'};
472 $flags{'DBARRED'} = \%flaginfo;
475 if ( $patroninformation->{'borrowernotes'}
476 && $patroninformation->{'borrowernotes'} )
479 $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
480 $flags{'NOTES'} = \%flaginfo;
482 my ( $odues, $itemsoverdue ) = C4::Overdues::checkoverdues($patroninformation->{'borrowernumber'});
483 if ( $odues && $odues > 0 ) {
485 $flaginfo{'message'} = "Yes";
486 $flaginfo{'itemlist'} = $itemsoverdue;
487 foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
490 $flaginfo{'itemlisttext'} .=
491 "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n"; # newline is display layer
493 $flags{'ODUES'} = \%flaginfo;
495 my @itemswaiting = C4::Reserves::GetReservesFromBorrowernumber( $patroninformation->{'borrowernumber'},'W' );
496 my $nowaiting = scalar @itemswaiting;
497 if ( $nowaiting > 0 ) {
499 $flaginfo{'message'} = "Reserved items available";
500 $flaginfo{'itemlist'} = \@itemswaiting;
501 $flags{'WAITING'} = \%flaginfo;
509 $borrower = &GetMember(%information);
511 Retrieve the first patron record meeting on criteria listed in the
512 C<%information> hash, which should contain one or more
513 pairs of borrowers column names and values, e.g.,
515 $borrower = GetMember(borrowernumber => id);
517 C<&GetBorrower> returns a reference-to-hash whose keys are the fields of
518 the C<borrowers> table in the Koha database.
520 FIXME: GetMember() is used throughout the code as a lookup
521 on a unique key such as the borrowernumber, but this meaning is not
522 enforced in the routine itself.
528 my ( %information ) = @_;
529 if (exists $information{borrowernumber} && !defined $information{borrowernumber}) {
530 #passing mysql's kohaadmin?? Makes no sense as a query
533 my $dbh = C4::Context->dbh;
535 q{SELECT borrowers.*, categories.category_type, categories.description
537 LEFT JOIN categories on borrowers.categorycode=categories.categorycode WHERE };
540 for (keys %information ) {
548 if (defined $information{$_}) {
550 push @values, $information{$_};
553 $select .= "$_ IS NULL";
556 $debug && warn $select, " ",values %information;
557 my $sth = $dbh->prepare("$select");
558 $sth->execute(map{$information{$_}} keys %information);
559 my $data = $sth->fetchall_arrayref({});
560 #FIXME interface to this routine now allows generation of a result set
561 #so whole array should be returned but bowhere in the current code expects this
569 =head2 GetMemberRelatives
571 @borrowernumbers = GetMemberRelatives($borrowernumber);
573 C<GetMemberRelatives> returns a borrowersnumber's list of guarantor/guarantees of the member given in parameter
576 sub GetMemberRelatives {
577 my $borrowernumber = shift;
578 my $dbh = C4::Context->dbh;
582 my $query = "SELECT guarantorid FROM borrowers WHERE borrowernumber=?";
583 my $sth = $dbh->prepare($query);
584 $sth->execute($borrowernumber);
585 my $data = $sth->fetchrow_arrayref();
586 push @glist, $data->[0] if $data->[0];
587 my $guarantor = $data->[0] ? $data->[0] : undef;
590 $query = "SELECT borrowernumber FROM borrowers WHERE guarantorid=?";
591 $sth = $dbh->prepare($query);
592 $sth->execute($borrowernumber);
593 while ($data = $sth->fetchrow_arrayref()) {
594 push @glist, $data->[0];
597 # Getting sibling guarantees
599 $query = "SELECT borrowernumber FROM borrowers WHERE guarantorid=?";
600 $sth = $dbh->prepare($query);
601 $sth->execute($guarantor);
602 while ($data = $sth->fetchrow_arrayref()) {
603 push @glist, $data->[0] if ($data->[0] != $borrowernumber);
610 =head2 IsMemberBlocked
612 my ($block_status, $count) = IsMemberBlocked( $borrowernumber );
614 Returns whether a patron has overdue items that may result
615 in a block or whether the patron has active fine days
616 that would block circulation privileges.
618 C<$block_status> can have the following values:
620 1 if the patron has outstanding fine days, in which case C<$count> is the number of them
622 -1 if the patron has overdue items, in which case C<$count> is the number of them
624 0 if the patron has no overdue items or outstanding fine days, in which case C<$count> is 0
626 Outstanding fine days are checked before current overdue items
629 FIXME: this needs to be split into two functions; a potential block
630 based on the number of current overdue items could be orthogonal
631 to a block based on whether the patron has any fine days accrued.
635 sub IsMemberBlocked {
636 my $borrowernumber = shift;
637 my $dbh = C4::Context->dbh;
639 my $blockeddate = CheckBorrowerDebarred($borrowernumber);
641 return ( 1, $blockeddate ) if $blockeddate;
643 # if he have late issues
644 my $sth = $dbh->prepare(
645 "SELECT COUNT(*) as latedocs
647 WHERE borrowernumber = ?
648 AND date_due < now()"
650 $sth->execute($borrowernumber);
651 my $latedocs = $sth->fetchrow_hashref->{'latedocs'};
653 return ( -1, $latedocs ) if $latedocs > 0;
658 =head2 GetMemberIssuesAndFines
660 ($overdue_count, $issue_count, $total_fines) = &GetMemberIssuesAndFines($borrowernumber);
662 Returns aggregate data about items borrowed by the patron with the
663 given borrowernumber.
665 C<&GetMemberIssuesAndFines> returns a three-element array. C<$overdue_count> is the
666 number of overdue items the patron currently has borrowed. C<$issue_count> is the
667 number of books the patron currently has borrowed. C<$total_fines> is
668 the total fine currently due by the borrower.
673 sub GetMemberIssuesAndFines {
674 my ( $borrowernumber ) = @_;
675 my $dbh = C4::Context->dbh;
676 my $query = "SELECT COUNT(*) FROM issues WHERE borrowernumber = ?";
678 $debug and warn $query."\n";
679 my $sth = $dbh->prepare($query);
680 $sth->execute($borrowernumber);
681 my $issue_count = $sth->fetchrow_arrayref->[0];
683 $sth = $dbh->prepare(
684 "SELECT COUNT(*) FROM issues
685 WHERE borrowernumber = ?
686 AND date_due < now()"
688 $sth->execute($borrowernumber);
689 my $overdue_count = $sth->fetchrow_arrayref->[0];
691 $sth = $dbh->prepare("SELECT SUM(amountoutstanding) FROM accountlines WHERE borrowernumber = ?");
692 $sth->execute($borrowernumber);
693 my $total_fines = $sth->fetchrow_arrayref->[0];
695 return ($overdue_count, $issue_count, $total_fines);
699 return @{C4::Context->dbh->selectcol_arrayref("SHOW columns from borrowers")};
704 my $success = ModMember(borrowernumber => $borrowernumber,
705 [ field => value ]... );
707 Modify borrower's data. All date fields should ALREADY be in ISO format.
710 true on success, or false on failure
716 # test to know if you must update or not the borrower password
717 if (exists $data{password}) {
718 if ($data{password} eq '****' or $data{password} eq '') {
719 delete $data{password};
721 $data{password} = md5_base64($data{password});
724 my $execute_success=UpdateInTable("borrowers",\%data);
725 if ($execute_success) { # only proceed if the update was a success
726 # ok if its an adult (type) it may have borrowers that depend on it as a guarantor
727 # so when we update information for an adult we should check for guarantees and update the relevant part
728 # of their records, ie addresses and phone numbers
729 my $borrowercategory= GetBorrowercategory( $data{'category_type'} );
730 if ( exists $borrowercategory->{'category_type'} && $borrowercategory->{'category_type'} eq ('A' || 'S') ) {
731 # is adult check guarantees;
732 UpdateGuarantees(%data);
734 logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "UPDATE (executed w/ arg: $data{'borrowernumber'})") if C4::Context->preference("BorrowersLog");
736 return $execute_success;
742 $borrowernumber = &AddMember(%borrower);
744 insert new borrower into table
745 Returns the borrowernumber upon success
747 Returns as undef upon any db error without further processing
754 my $dbh = C4::Context->dbh;
756 # generate a proper login if none provided
757 $data{'userid'} = Generate_Userid($data{'borrowernumber'}, $data{'firstname'}, $data{'surname'}) if $data{'userid'} eq '';
759 # add expiration date if it isn't already there
760 unless ( $data{'dateexpiry'} ) {
761 $data{'dateexpiry'} = GetExpiryDate( $data{'categorycode'}, C4::Dates->new()->output("iso") );
764 # add enrollment date if it isn't already there
765 unless ( $data{'dateenrolled'} ) {
766 $data{'dateenrolled'} = C4::Dates->new()->output("iso");
769 # create a disabled account if no password provided
770 $data{'password'} = ($data{'password'})? md5_base64($data{'password'}) : '!';
771 $data{'borrowernumber'}=InsertInTable("borrowers",\%data);
774 # mysql_insertid is probably bad. not necessarily accurate and mysql-specific at best.
775 logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
777 # check for enrollment fee & add it if needed
778 my $sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
779 $sth->execute($data{'categorycode'});
780 my ($enrolmentfee) = $sth->fetchrow;
782 warn sprintf('Database returned the following error: %s', $sth->errstr);
785 if ($enrolmentfee && $enrolmentfee > 0) {
786 # insert fee in patron debts
787 manualinvoice($data{'borrowernumber'}, '', '', 'A', $enrolmentfee);
790 return $data{'borrowernumber'};
795 my ($uid,$member) = @_;
796 my $dbh = C4::Context->dbh;
797 # Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
798 # Then we need to tell the user and have them create a new one.
801 "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
802 $sth->execute( $uid, $member );
803 if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
811 sub Generate_Userid {
812 my ($borrowernumber, $firstname, $surname) = @_;
816 $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
817 $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
818 $newuid = lc(($firstname)? "$firstname.$surname" : $surname);
819 $newuid = unac_string('utf-8',$newuid);
820 $newuid .= $offset unless $offset == 0;
823 } while (!Check_Userid($newuid,$borrowernumber));
829 my ( $uid, $member, $digest ) = @_;
830 my $dbh = C4::Context->dbh;
832 #Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
833 #Then we need to tell the user and have them create a new one.
837 "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
838 $sth->execute( $uid, $member );
839 if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
843 #Everything is good so we can update the information.
846 "update borrowers set userid=?, password=? where borrowernumber=?");
847 $sth->execute( $uid, $digest, $member );
851 logaction("MEMBERS", "CHANGE PASS", $member, "") if C4::Context->preference("BorrowersLog");
857 =head2 fixup_cardnumber
859 Warning: The caller is responsible for locking the members table in write
860 mode, to avoid database corruption.
864 use vars qw( @weightings );
865 my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
867 sub fixup_cardnumber {
868 my ($cardnumber) = @_;
869 my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;
871 # Find out whether member numbers should be generated
872 # automatically. Should be either "1" or something else.
873 # Defaults to "0", which is interpreted as "no".
875 # if ($cardnumber !~ /\S/ && $autonumber_members) {
876 ($autonumber_members) or return $cardnumber;
877 my $checkdigit = C4::Context->preference('checkdigit');
878 my $dbh = C4::Context->dbh;
879 if ( $checkdigit and $checkdigit eq 'katipo' ) {
881 # if checkdigit is selected, calculate katipo-style cardnumber.
882 # otherwise, just use the max()
883 # purpose: generate checksum'd member numbers.
884 # We'll assume we just got the max value of digits 2-8 of member #'s
885 # from the database and our job is to increment that by one,
886 # determine the 1st and 9th digits and return the full string.
887 my $sth = $dbh->prepare(
888 "select max(substring(borrowers.cardnumber,2,7)) as new_num from borrowers"
891 my $data = $sth->fetchrow_hashref;
892 $cardnumber = $data->{new_num};
893 if ( !$cardnumber ) { # If DB has no values,
894 $cardnumber = 1000000; # start at 1000000
900 for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
901 # read weightings, left to right, 1 char at a time
902 my $temp1 = $weightings[$i];
904 # sequence left to right, 1 char at a time
905 my $temp2 = substr( $cardnumber, $i, 1 );
907 # mult each char 1-7 by its corresponding weighting
908 $sum += $temp1 * $temp2;
911 my $rem = ( $sum % 11 );
912 $rem = 'X' if $rem == 10;
914 return "V$cardnumber$rem";
917 my $sth = $dbh->prepare(
918 'SELECT MAX( CAST( cardnumber AS SIGNED ) ) FROM borrowers WHERE cardnumber REGEXP "^-?[0-9]+$"'
921 my ($result) = $sth->fetchrow;
924 return $cardnumber; # just here as a fallback/reminder
929 ($num_children, $children_arrayref) = &GetGuarantees($parent_borrno);
930 $child0_cardno = $children_arrayref->[0]{"cardnumber"};
931 $child0_borrno = $children_arrayref->[0]{"borrowernumber"};
933 C<&GetGuarantees> takes a borrower number (e.g., that of a patron
934 with children) and looks up the borrowers who are guaranteed by that
935 borrower (i.e., the patron's children).
937 C<&GetGuarantees> returns two values: an integer giving the number of
938 borrowers guaranteed by C<$parent_borrno>, and a reference to an array
939 of references to hash, which gives the actual results.
945 my ($borrowernumber) = @_;
946 my $dbh = C4::Context->dbh;
949 "select cardnumber,borrowernumber, firstname, surname from borrowers where guarantorid=?"
951 $sth->execute($borrowernumber);
954 my $data = $sth->fetchall_arrayref({});
955 return ( scalar(@$data), $data );
958 =head2 UpdateGuarantees
960 &UpdateGuarantees($parent_borrno);
963 C<&UpdateGuarantees> borrower data for an adult and updates all the guarantees
964 with the modified information
969 sub UpdateGuarantees {
971 my $dbh = C4::Context->dbh;
972 my ( $count, $guarantees ) = GetGuarantees( $data{'borrowernumber'} );
973 foreach my $guarantee (@$guarantees){
974 my $guaquery = qq|UPDATE borrowers
975 SET address=?,fax=?,B_city=?,mobile=?,city=?,phone=?
976 WHERE borrowernumber=?
978 my $sth = $dbh->prepare($guaquery);
979 $sth->execute($data{'address'},$data{'fax'},$data{'B_city'},$data{'mobile'},$data{'city'},$data{'phone'},$guarantee->{'borrowernumber'});
982 =head2 GetPendingIssues
984 my $issues = &GetPendingIssues(@borrowernumber);
986 Looks up what the patron with the given borrowernumber has borrowed.
988 C<&GetPendingIssues> returns a
989 reference-to-array where each element is a reference-to-hash; the
990 keys are the fields from the C<issues>, C<biblio>, and C<items> tables.
991 The keys include C<biblioitems> fields except marc and marcxml.
996 sub GetPendingIssues {
997 my @borrowernumbers = @_;
999 unless (@borrowernumbers ) { # return a ref_to_array
1000 return \@borrowernumbers; # to not cause surprise to caller
1003 # Borrowers part of the query
1005 for (my $i = 0; $i < @borrowernumbers; $i++) {
1006 $bquery .= ' issues.borrowernumber = ?';
1007 if ($i < $#borrowernumbers ) {
1012 # must avoid biblioitems.* to prevent large marc and marcxml fields from killing performance
1013 # FIXME: namespace collision: each table has "timestamp" fields. Which one is "timestamp" ?
1014 # FIXME: circ/ciculation.pl tries to sort by timestamp!
1015 # FIXME: namespace collision: other collisions possible.
1016 # FIXME: most of this data isn't really being used by callers.
1023 biblioitems.itemtype,
1026 biblioitems.publicationyear,
1027 biblioitems.publishercode,
1028 biblioitems.volumedate,
1029 biblioitems.volumedesc,
1032 borrowers.firstname,
1034 borrowers.cardnumber,
1035 issues.timestamp AS timestamp,
1036 issues.renewals AS renewals,
1037 issues.borrowernumber AS borrowernumber,
1038 items.renewals AS totalrenewals
1040 LEFT JOIN items ON items.itemnumber = issues.itemnumber
1041 LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
1042 LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
1043 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
1046 ORDER BY issues.issuedate"
1049 my $sth = C4::Context->dbh->prepare($query);
1050 $sth->execute(@borrowernumbers);
1051 my $data = $sth->fetchall_arrayref({});
1052 my $tz = C4::Context->tz();
1053 my $today = DateTime->now( time_zone => $tz);
1054 foreach (@{$data}) {
1055 if ($_->{issuedate}) {
1056 $_->{issuedate} = dt_from_string($_->{issuedate}, 'sql');
1058 $_->{date_due} or next;
1059 $_->{date_due} = DateTime::Format::DateParse->parse_datetime($_->{date_due}, $tz->name());
1060 if ( DateTime->compare($_->{date_due}, $today) == -1 ) {
1069 $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
1071 Looks up what the patron with the given borrowernumber has borrowed,
1072 and sorts the results.
1074 C<$sortkey> is the name of a field on which to sort the results. This
1075 should be the name of a field in the C<issues>, C<biblio>,
1076 C<biblioitems>, or C<items> table in the Koha database.
1078 C<$limit> is the maximum number of results to return.
1080 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
1081 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
1082 C<items> tables of the Koha database.
1088 my ( $borrowernumber, $order, $limit ) = @_;
1090 my $dbh = C4::Context->dbh;
1092 'SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1094 LEFT JOIN items on items.itemnumber=issues.itemnumber
1095 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1096 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1097 WHERE borrowernumber=?
1099 SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1101 LEFT JOIN items on items.itemnumber=old_issues.itemnumber
1102 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1103 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1104 WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL
1105 order by ' . $order;
1107 $query .= " limit $limit";
1110 my $sth = $dbh->prepare($query);
1111 $sth->execute( $borrowernumber, $borrowernumber );
1112 return $sth->fetchall_arrayref( {} );
1116 =head2 GetMemberAccountRecords
1118 ($total, $acctlines, $count) = &GetMemberAccountRecords($borrowernumber);
1120 Looks up accounting data for the patron with the given borrowernumber.
1122 C<&GetMemberAccountRecords> returns a three-element array. C<$acctlines> is a
1123 reference-to-array, where each element is a reference-to-hash; the
1124 keys are the fields of the C<accountlines> table in the Koha database.
1125 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1126 total amount outstanding for all of the account lines.
1130 sub GetMemberAccountRecords {
1131 my ($borrowernumber) = @_;
1132 my $dbh = C4::Context->dbh;
1138 WHERE borrowernumber=?);
1139 $strsth.=" ORDER BY date desc,timestamp DESC";
1140 my $sth= $dbh->prepare( $strsth );
1141 $sth->execute( $borrowernumber );
1144 while ( my $data = $sth->fetchrow_hashref ) {
1145 if ( $data->{itemnumber} ) {
1146 my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
1147 $data->{biblionumber} = $biblio->{biblionumber};
1148 $data->{title} = $biblio->{title};
1150 $acctlines[$numlines] = $data;
1152 $total += int(1000 * $data->{'amountoutstanding'}); # convert float to integer to avoid round-off errors
1155 return ( $total, \@acctlines,$numlines);
1158 =head2 GetMemberAccountBalance
1160 ($total_balance, $non_issue_balance, $other_charges) = &GetMemberAccountBalance($borrowernumber);
1162 Calculates amount immediately owing by the patron - non-issue charges.
1163 Based on GetMemberAccountRecords.
1164 Charges exempt from non-issue are:
1166 * Rent (rental) if RentalsInNoissuesCharge syspref is set to false
1167 * Manual invoices if ManInvInNoissuesCharge syspref is set to false
1171 sub GetMemberAccountBalance {
1172 my ($borrowernumber) = @_;
1174 my $ACCOUNT_TYPE_LENGTH = 5; # this is plain ridiculous...
1176 my @not_fines = ('Res');
1177 push @not_fines, 'Rent' unless C4::Context->preference('RentalsInNoissuesCharge');
1178 unless ( C4::Context->preference('ManInvInNoissuesCharge') ) {
1179 my $dbh = C4::Context->dbh;
1180 my $man_inv_types = $dbh->selectcol_arrayref(qq{SELECT authorised_value FROM authorised_values WHERE category = 'MANUAL_INV'});
1181 push @not_fines, map substr($_, 0, $ACCOUNT_TYPE_LENGTH), @$man_inv_types;
1183 my %not_fine = map {$_ => 1} @not_fines;
1185 my ($total, $acctlines) = GetMemberAccountRecords($borrowernumber);
1186 my $other_charges = 0;
1187 foreach (@$acctlines) {
1188 $other_charges += $_->{amountoutstanding} if $not_fine{ substr($_->{accounttype}, 0, $ACCOUNT_TYPE_LENGTH) };
1191 return ( $total, $total - $other_charges, $other_charges);
1194 =head2 GetBorNotifyAcctRecord
1196 ($total, $acctlines, $count) = &GetBorNotifyAcctRecord($params,$notifyid);
1198 Looks up accounting data for the patron with the given borrowernumber per file number.
1200 C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a
1201 reference-to-array, where each element is a reference-to-hash; the
1202 keys are the fields of the C<accountlines> table in the Koha database.
1203 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1204 total amount outstanding for all of the account lines.
1208 sub GetBorNotifyAcctRecord {
1209 my ( $borrowernumber, $notifyid ) = @_;
1210 my $dbh = C4::Context->dbh;
1213 my $sth = $dbh->prepare(
1216 WHERE borrowernumber=?
1218 AND amountoutstanding != '0'
1219 ORDER BY notify_id,accounttype
1222 $sth->execute( $borrowernumber, $notifyid );
1224 while ( my $data = $sth->fetchrow_hashref ) {
1225 if ( $data->{itemnumber} ) {
1226 my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
1227 $data->{biblionumber} = $biblio->{biblionumber};
1228 $data->{title} = $biblio->{title};
1230 $acctlines[$numlines] = $data;
1232 $total += int(100 * $data->{'amountoutstanding'});
1235 return ( $total, \@acctlines, $numlines );
1238 =head2 checkuniquemember (OUEST-PROVENCE)
1240 ($result,$categorycode) = &checkuniquemember($collectivity,$surname,$firstname,$dateofbirth);
1242 Checks that a member exists or not in the database.
1244 C<&result> is nonzero (=exist) or 0 (=does not exist)
1245 C<&categorycode> is from categorycode table
1246 C<&collectivity> is 1 (= we add a collectivity) or 0 (= we add a physical member)
1247 C<&surname> is the surname
1248 C<&firstname> is the firstname (only if collectivity=0)
1249 C<&dateofbirth> is the date of birth in ISO format (only if collectivity=0)
1253 # FIXME: This function is not legitimate. Multiple patrons might have the same first/last name and birthdate.
1254 # This is especially true since first name is not even a required field.
1256 sub checkuniquemember {
1257 my ( $collectivity, $surname, $firstname, $dateofbirth ) = @_;
1258 my $dbh = C4::Context->dbh;
1259 my $request = ($collectivity) ?
1260 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? " :
1262 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=? and dateofbirth=?" :
1263 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=?";
1264 my $sth = $dbh->prepare($request);
1265 if ($collectivity) {
1266 $sth->execute( uc($surname) );
1267 } elsif($dateofbirth){
1268 $sth->execute( uc($surname), ucfirst($firstname), $dateofbirth );
1270 $sth->execute( uc($surname), ucfirst($firstname));
1272 my @data = $sth->fetchrow;
1273 ( $data[0] ) and return $data[0], $data[1];
1277 sub checkcardnumber {
1278 my ($cardnumber,$borrowernumber) = @_;
1279 # If cardnumber is null, we assume they're allowed.
1280 return 0 if !defined($cardnumber);
1281 my $dbh = C4::Context->dbh;
1282 my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
1283 $query .= " AND borrowernumber <> ?" if ($borrowernumber);
1284 my $sth = $dbh->prepare($query);
1285 if ($borrowernumber) {
1286 $sth->execute($cardnumber,$borrowernumber);
1288 $sth->execute($cardnumber);
1290 if (my $data= $sth->fetchrow_hashref()){
1299 =head2 getzipnamecity (OUEST-PROVENCE)
1301 take all info from table city for the fields city and zip
1302 check for the name and the zip code of the city selected
1306 sub getzipnamecity {
1308 my $dbh = C4::Context->dbh;
1311 "select city_name,city_state,city_zipcode,city_country from cities where cityid=? ");
1312 $sth->execute($cityid);
1313 my @data = $sth->fetchrow;
1314 return $data[0], $data[1], $data[2], $data[3];
1318 =head2 getdcity (OUEST-PROVENCE)
1320 recover cityid with city_name condition
1325 my ($city_name) = @_;
1326 my $dbh = C4::Context->dbh;
1327 my $sth = $dbh->prepare("select cityid from cities where city_name=? ");
1328 $sth->execute($city_name);
1329 my $data = $sth->fetchrow;
1333 =head2 GetFirstValidEmailAddress
1335 $email = GetFirstValidEmailAddress($borrowernumber);
1337 Return the first valid email address for a borrower, given the borrowernumber. For now, the order
1338 is defined as email, emailpro, B_email. Returns the empty string if the borrower has no email
1343 sub GetFirstValidEmailAddress {
1344 my $borrowernumber = shift;
1345 my $dbh = C4::Context->dbh;
1346 my $sth = $dbh->prepare( "SELECT email, emailpro, B_email FROM borrowers where borrowernumber = ? ");
1347 $sth->execute( $borrowernumber );
1348 my $data = $sth->fetchrow_hashref;
1350 if ($data->{'email'}) {
1351 return $data->{'email'};
1352 } elsif ($data->{'emailpro'}) {
1353 return $data->{'emailpro'};
1354 } elsif ($data->{'B_email'}) {
1355 return $data->{'B_email'};
1361 =head2 GetNoticeEmailAddress
1363 $email = GetNoticeEmailAddress($borrowernumber);
1365 Return the email address of borrower used for notices, given the borrowernumber.
1366 Returns the empty string if no email address.
1370 sub GetNoticeEmailAddress {
1371 my $borrowernumber = shift;
1373 my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
1374 # if syspref is set to 'first valid' (value == OFF), look up email address
1375 if ( $which_address eq 'OFF' ) {
1376 return GetFirstValidEmailAddress($borrowernumber);
1378 # specified email address field
1379 my $dbh = C4::Context->dbh;
1380 my $sth = $dbh->prepare( qq{
1381 SELECT $which_address AS primaryemail
1383 WHERE borrowernumber=?
1385 $sth->execute($borrowernumber);
1386 my $data = $sth->fetchrow_hashref;
1387 return $data->{'primaryemail'} || '';
1390 =head2 GetExpiryDate
1392 $expirydate = GetExpiryDate($categorycode, $dateenrolled);
1394 Calculate expiry date given a categorycode and starting date. Date argument must be in ISO format.
1395 Return date is also in ISO format.
1400 my ( $categorycode, $dateenrolled ) = @_;
1402 if ($categorycode) {
1403 my $dbh = C4::Context->dbh;
1404 my $sth = $dbh->prepare("SELECT enrolmentperiod,enrolmentperioddate FROM categories WHERE categorycode=?");
1405 $sth->execute($categorycode);
1406 $enrolments = $sth->fetchrow_hashref;
1408 # die "GetExpiryDate: for enrollmentperiod $enrolmentperiod (category '$categorycode') starting $dateenrolled.\n";
1409 my @date = split (/-/,$dateenrolled);
1410 if($enrolments->{enrolmentperiod}){
1411 return sprintf("%04d-%02d-%02d", Add_Delta_YM(@date,0,$enrolments->{enrolmentperiod}));
1413 return $enrolments->{enrolmentperioddate};
1417 =head2 checkuserpassword (OUEST-PROVENCE)
1419 check for the password and login are not used
1420 return the number of record
1421 0=> NOT USED 1=> USED
1425 sub checkuserpassword {
1426 my ( $borrowernumber, $userid, $password ) = @_;
1427 $password = md5_base64($password);
1428 my $dbh = C4::Context->dbh;
1431 "Select count(*) from borrowers where borrowernumber !=? and userid =? and password=? "
1433 $sth->execute( $borrowernumber, $userid, $password );
1434 my $number_rows = $sth->fetchrow;
1435 return $number_rows;
1439 =head2 GetborCatFromCatType
1441 ($codes_arrayref, $labels_hashref) = &GetborCatFromCatType();
1443 Looks up the different types of borrowers in the database. Returns two
1444 elements: a reference-to-array, which lists the borrower category
1445 codes, and a reference-to-hash, which maps the borrower category codes
1446 to category descriptions.
1451 sub GetborCatFromCatType {
1452 my ( $category_type, $action, $no_branch_limit ) = @_;
1454 my $branch_limit = $no_branch_limit
1456 : C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1458 # FIXME - This API seems both limited and dangerous.
1459 my $dbh = C4::Context->dbh;
1462 SELECT categories.categorycode, categories.description
1466 LEFT JOIN categories_branches ON categories.categorycode = categories_branches.categorycode
1469 $request .= " $action ";
1470 $request .= " AND (branchcode = ? OR branchcode IS NULL) GROUP BY description" if $branch_limit;
1472 $request .= " WHERE branchcode = ? OR branchcode IS NULL GROUP BY description" if $branch_limit;
1474 $request .= " ORDER BY categorycode";
1476 my $sth = $dbh->prepare($request);
1478 $action ? $category_type : (),
1479 $branch_limit ? $branch_limit : ()
1485 while ( my $data = $sth->fetchrow_hashref ) {
1486 push @codes, $data->{'categorycode'};
1487 $labels{ $data->{'categorycode'} } = $data->{'description'};
1490 return ( \@codes, \%labels );
1493 =head2 GetBorrowercategory
1495 $hashref = &GetBorrowercategory($categorycode);
1497 Given the borrower's category code, the function returns the corresponding
1498 data hashref for a comprehensive information display.
1502 sub GetBorrowercategory {
1504 my $dbh = C4::Context->dbh;
1508 "SELECT description,dateofbirthrequired,upperagelimit,category_type
1510 WHERE categorycode = ?"
1512 $sth->execute($catcode);
1514 $sth->fetchrow_hashref;
1518 } # sub getborrowercategory
1521 =head2 GetBorrowerCategorycode
1523 $categorycode = &GetBorrowerCategoryCode( $borrowernumber );
1525 Given the borrowernumber, the function returns the corresponding categorycode
1528 sub GetBorrowerCategorycode {
1529 my ( $borrowernumber ) = @_;
1530 my $dbh = C4::Context->dbh;
1531 my $sth = $dbh->prepare( qq{
1534 WHERE borrowernumber = ?
1536 $sth->execute( $borrowernumber );
1537 return $sth->fetchrow;
1540 =head2 GetBorrowercategoryList
1542 $arrayref_hashref = &GetBorrowercategoryList;
1543 If no category code provided, the function returns all the categories.
1547 sub GetBorrowercategoryList {
1548 my $no_branch_limit = @_ ? shift : 0;
1549 my $branch_limit = $no_branch_limit
1551 : C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1552 my $dbh = C4::Context->dbh;
1553 my $query = "SELECT categories.* FROM categories";
1555 LEFT JOIN categories_branches ON categories.categorycode = categories_branches.categorycode
1556 WHERE branchcode = ? OR branchcode IS NULL GROUP BY description
1558 $query .= " ORDER BY description";
1559 my $sth = $dbh->prepare( $query );
1560 $sth->execute( $branch_limit ? $branch_limit : () );
1561 my $data = $sth->fetchall_arrayref( {} );
1564 } # sub getborrowercategory
1566 =head2 ethnicitycategories
1568 ($codes_arrayref, $labels_hashref) = ðnicitycategories();
1570 Looks up the different ethnic types in the database. Returns two
1571 elements: a reference-to-array, which lists the ethnicity codes, and a
1572 reference-to-hash, which maps the ethnicity codes to ethnicity
1579 sub ethnicitycategories {
1580 my $dbh = C4::Context->dbh;
1581 my $sth = $dbh->prepare("Select code,name from ethnicity order by name");
1585 while ( my $data = $sth->fetchrow_hashref ) {
1586 push @codes, $data->{'code'};
1587 $labels{ $data->{'code'} } = $data->{'name'};
1589 return ( \@codes, \%labels );
1594 $ethn_name = &fixEthnicity($ethn_code);
1596 Takes an ethnicity code (e.g., "european" or "pi") and returns the
1597 corresponding descriptive name from the C<ethnicity> table in the
1598 Koha database ("European" or "Pacific Islander").
1605 my $ethnicity = shift;
1606 return unless $ethnicity;
1607 my $dbh = C4::Context->dbh;
1608 my $sth = $dbh->prepare("Select name from ethnicity where code = ?");
1609 $sth->execute($ethnicity);
1610 my $data = $sth->fetchrow_hashref;
1611 return $data->{'name'};
1612 } # sub fixEthnicity
1616 $dateofbirth,$date = &GetAge($date);
1618 this function return the borrowers age with the value of dateofbirth
1624 my ( $date, $date_ref ) = @_;
1626 if ( not defined $date_ref ) {
1627 $date_ref = sprintf( '%04d-%02d-%02d', Today() );
1630 my ( $year1, $month1, $day1 ) = split /-/, $date;
1631 my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
1633 my $age = $year2 - $year1;
1634 if ( $month1 . $day1 > $month2 . $day2 ) {
1641 =head2 get_institutions
1643 $insitutions = get_institutions();
1645 Just returns a list of all the borrowers of type I, borrownumber and name
1650 sub get_institutions {
1651 my $dbh = C4::Context->dbh();
1654 "SELECT borrowernumber,surname FROM borrowers WHERE categorycode=? ORDER BY surname"
1658 while ( my $data = $sth->fetchrow_hashref() ) {
1659 $orgs{ $data->{'borrowernumber'} } = $data;
1663 } # sub get_institutions
1665 =head2 add_member_orgs
1667 add_member_orgs($borrowernumber,$borrowernumbers);
1669 Takes a borrowernumber and a list of other borrowernumbers and inserts them into the borrowers_to_borrowers table
1674 sub add_member_orgs {
1675 my ( $borrowernumber, $otherborrowers ) = @_;
1676 my $dbh = C4::Context->dbh();
1678 "INSERT INTO borrowers_to_borrowers (borrower1,borrower2) VALUES (?,?)";
1679 my $sth = $dbh->prepare($query);
1680 foreach my $otherborrowernumber (@$otherborrowers) {
1681 $sth->execute( $borrowernumber, $otherborrowernumber );
1684 } # sub add_member_orgs
1688 $cityarrayref = GetCities();
1690 Returns an array_ref of the entries in the cities table
1691 If there are entries in the table an empty row is returned
1692 This is currently only used to populate a popup in memberentry
1698 my $dbh = C4::Context->dbh;
1699 my $city_arr = $dbh->selectall_arrayref(
1700 q|SELECT cityid,city_zipcode,city_name,city_state,city_country FROM cities ORDER BY city_name|,
1702 if ( @{$city_arr} ) {
1703 unshift @{$city_arr}, {
1704 city_zipcode => q{},
1708 city_country => q{},
1715 =head2 GetSortDetails (OUEST-PROVENCE)
1717 ($lib) = &GetSortDetails($category,$sortvalue);
1719 Returns the authorized value details
1720 C<&$lib>return value of authorized value details
1721 C<&$sortvalue>this is the value of authorized value
1722 C<&$category>this is the value of authorized value category
1726 sub GetSortDetails {
1727 my ( $category, $sortvalue ) = @_;
1728 my $dbh = C4::Context->dbh;
1729 my $query = qq|SELECT lib
1730 FROM authorised_values
1732 AND authorised_value=? |;
1733 my $sth = $dbh->prepare($query);
1734 $sth->execute( $category, $sortvalue );
1735 my $lib = $sth->fetchrow;
1736 return ($lib) if ($lib);
1737 return ($sortvalue) unless ($lib);
1740 =head2 MoveMemberToDeleted
1742 $result = &MoveMemberToDeleted($borrowernumber);
1744 Copy the record from borrowers to deletedborrowers table.
1748 # FIXME: should do it in one SQL statement w/ subquery
1749 # Otherwise, we should return the @data on success
1751 sub MoveMemberToDeleted {
1752 my ($member) = shift or return;
1753 my $dbh = C4::Context->dbh;
1754 my $query = qq|SELECT *
1756 WHERE borrowernumber=?|;
1757 my $sth = $dbh->prepare($query);
1758 $sth->execute($member);
1759 my @data = $sth->fetchrow_array;
1760 (@data) or return; # if we got a bad borrowernumber, there's nothing to insert
1762 $dbh->prepare( "INSERT INTO deletedborrowers VALUES ("
1763 . ( "?," x ( scalar(@data) - 1 ) )
1765 $sth->execute(@data);
1770 DelMember($borrowernumber);
1772 This function remove directly a borrower whitout writing it on deleteborrower.
1773 + Deletes reserves for the borrower
1778 my $dbh = C4::Context->dbh;
1779 my $borrowernumber = shift;
1780 #warn "in delmember with $borrowernumber";
1781 return unless $borrowernumber; # borrowernumber is mandatory.
1783 my $query = qq|DELETE
1785 WHERE borrowernumber=?|;
1786 my $sth = $dbh->prepare($query);
1787 $sth->execute($borrowernumber);
1791 WHERE borrowernumber = ?
1793 $sth = $dbh->prepare($query);
1794 $sth->execute($borrowernumber);
1795 logaction("MEMBERS", "DELETE", $borrowernumber, "") if C4::Context->preference("BorrowersLog");
1799 =head2 ExtendMemberSubscriptionTo (OUEST-PROVENCE)
1801 $date = ExtendMemberSubscriptionTo($borrowerid, $date);
1803 Extending the subscription to a given date or to the expiry date calculated on ISO date.
1808 sub ExtendMemberSubscriptionTo {
1809 my ( $borrowerid,$date) = @_;
1810 my $dbh = C4::Context->dbh;
1811 my $borrower = GetMember('borrowernumber'=>$borrowerid);
1813 $date = (C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry') ?
1814 C4::Dates->new($borrower->{'dateexpiry'}, 'iso')->output("iso") :
1815 C4::Dates->new()->output("iso");
1816 $date = GetExpiryDate( $borrower->{'categorycode'}, $date );
1818 my $sth = $dbh->do(<<EOF);
1820 SET dateexpiry='$date'
1821 WHERE borrowernumber='$borrowerid'
1823 # add enrolmentfee if needed
1824 $sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
1825 $sth->execute($borrower->{'categorycode'});
1826 my ($enrolmentfee) = $sth->fetchrow;
1827 if ($enrolmentfee && $enrolmentfee > 0) {
1828 # insert fee in patron debts
1829 manualinvoice($borrower->{'borrowernumber'}, '', '', 'A', $enrolmentfee);
1831 logaction("MEMBERS", "RENEW", $borrower->{'borrowernumber'}, "Membership renewed")if C4::Context->preference("BorrowersLog");
1832 return $date if ($sth);
1836 =head2 GetRoadTypes (OUEST-PROVENCE)
1838 ($idroadtypearrayref, $roadttype_hashref) = &GetRoadTypes();
1840 Looks up the different road type . Returns two
1841 elements: a reference-to-array, which lists the id_roadtype
1842 codes, and a reference-to-hash, which maps the road type of the road .
1847 my $dbh = C4::Context->dbh;
1849 SELECT roadtypeid,road_type
1851 ORDER BY road_type|;
1852 my $sth = $dbh->prepare($query);
1857 # insert empty value to create a empty choice in cgi popup
1859 while ( my $data = $sth->fetchrow_hashref ) {
1861 push @id, $data->{'roadtypeid'};
1862 $roadtype{ $data->{'roadtypeid'} } = $data->{'road_type'};
1865 #test to know if the table contain some records if no the function return nothing
1872 return ( \@id, \%roadtype );
1878 =head2 GetTitles (OUEST-PROVENCE)
1880 ($borrowertitle)= &GetTitles();
1882 Looks up the different title . Returns array with all borrowers title
1887 my @borrowerTitle = split (/,|\|/,C4::Context->preference('BorrowersTitles'));
1888 unshift( @borrowerTitle, "" );
1889 my $count=@borrowerTitle;
1894 return ( \@borrowerTitle);
1898 =head2 GetPatronImage
1900 my ($imagedata, $dberror) = GetPatronImage($cardnumber);
1902 Returns the mimetype and binary image data of the image for the patron with the supplied cardnumber.
1906 sub GetPatronImage {
1907 my ($cardnumber) = @_;
1908 warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1909 my $dbh = C4::Context->dbh;
1910 my $query = 'SELECT mimetype, imagefile FROM patronimage WHERE cardnumber = ?';
1911 my $sth = $dbh->prepare($query);
1912 $sth->execute($cardnumber);
1913 my $imagedata = $sth->fetchrow_hashref;
1914 warn "Database error!" if $sth->errstr;
1915 return $imagedata, $sth->errstr;
1918 =head2 PutPatronImage
1920 PutPatronImage($cardnumber, $mimetype, $imgfile);
1922 Stores patron binary image data and mimetype in database.
1923 NOTE: This function is good for updating images as well as inserting new images in the database.
1927 sub PutPatronImage {
1928 my ($cardnumber, $mimetype, $imgfile) = @_;
1929 warn "Parameters passed in: Cardnumber=$cardnumber, Mimetype=$mimetype, " . ($imgfile ? "Imagefile" : "No Imagefile") if $debug;
1930 my $dbh = C4::Context->dbh;
1931 my $query = "INSERT INTO patronimage (cardnumber, mimetype, imagefile) VALUES (?,?,?) ON DUPLICATE KEY UPDATE imagefile = ?;";
1932 my $sth = $dbh->prepare($query);
1933 $sth->execute($cardnumber,$mimetype,$imgfile,$imgfile);
1934 warn "Error returned inserting $cardnumber.$mimetype." if $sth->errstr;
1935 return $sth->errstr;
1938 =head2 RmPatronImage
1940 my ($dberror) = RmPatronImage($cardnumber);
1942 Removes the image for the patron with the supplied cardnumber.
1947 my ($cardnumber) = @_;
1948 warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1949 my $dbh = C4::Context->dbh;
1950 my $query = "DELETE FROM patronimage WHERE cardnumber = ?;";
1951 my $sth = $dbh->prepare($query);
1952 $sth->execute($cardnumber);
1953 my $dberror = $sth->errstr;
1954 warn "Database error!" if $sth->errstr;
1958 =head2 GetHideLostItemsPreference
1960 $hidelostitemspref = &GetHideLostItemsPreference($borrowernumber);
1962 Returns the HideLostItems preference for the patron category of the supplied borrowernumber
1963 C<&$hidelostitemspref>return value of function, 0 or 1
1967 sub GetHideLostItemsPreference {
1968 my ($borrowernumber) = @_;
1969 my $dbh = C4::Context->dbh;
1970 my $query = "SELECT hidelostitems FROM borrowers,categories WHERE borrowers.categorycode = categories.categorycode AND borrowernumber = ?";
1971 my $sth = $dbh->prepare($query);
1972 $sth->execute($borrowernumber);
1973 my $hidelostitems = $sth->fetchrow;
1974 return $hidelostitems;
1977 =head2 GetRoadTypeDetails (OUEST-PROVENCE)
1979 ($roadtype) = &GetRoadTypeDetails($roadtypeid);
1981 Returns the description of roadtype
1982 C<&$roadtype>return description of road type
1983 C<&$roadtypeid>this is the value of roadtype s
1987 sub GetRoadTypeDetails {
1988 my ($roadtypeid) = @_;
1989 my $dbh = C4::Context->dbh;
1993 WHERE roadtypeid=?|;
1994 my $sth = $dbh->prepare($query);
1995 $sth->execute($roadtypeid);
1996 my $roadtype = $sth->fetchrow;
2000 =head2 GetBorrowersToExpunge
2002 $borrowers = &GetBorrowersToExpunge(
2003 not_borrowered_since => $not_borrowered_since,
2004 expired_before => $expired_before,
2005 category_code => $category_code,
2006 branchcode => $branchcode
2009 This function get all borrowers based on the given criteria.
2013 sub GetBorrowersToExpunge {
2016 my $filterdate = $params->{'not_borrowered_since'};
2017 my $filterexpiry = $params->{'expired_before'};
2018 my $filtercategory = $params->{'category_code'};
2019 my $filterbranch = $params->{'branchcode'} ||
2020 ((C4::Context->preference('IndependantBranches')
2021 && C4::Context->userenv
2022 && C4::Context->userenv->{flags} % 2 !=1
2023 && C4::Context->userenv->{branch})
2024 ? C4::Context->userenv->{branch}
2027 my $dbh = C4::Context->dbh;
2029 SELECT borrowers.borrowernumber,
2030 MAX(old_issues.timestamp) AS latestissue,
2031 MAX(issues.timestamp) AS currentissue
2033 JOIN categories USING (categorycode)
2034 LEFT JOIN old_issues USING (borrowernumber)
2035 LEFT JOIN issues USING (borrowernumber)
2036 WHERE category_type <> 'S'
2037 AND borrowernumber NOT IN (SELECT guarantorid FROM borrowers WHERE guarantorid IS NOT NULL AND guarantorid <> 0)
2040 if ( $filterbranch && $filterbranch ne "" ) {
2041 $query.= " AND borrowers.branchcode = ? ";
2042 push( @query_params, $filterbranch );
2044 if ( $filterexpiry ) {
2045 $query .= " AND dateexpiry < ? ";
2046 push( @query_params, $filterexpiry );
2048 if ( $filtercategory ) {
2049 $query .= " AND categorycode = ? ";
2050 push( @query_params, $filtercategory );
2052 $query.=" GROUP BY borrowers.borrowernumber HAVING currentissue IS NULL ";
2053 if ( $filterdate ) {
2054 $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
2055 push @query_params,$filterdate;
2057 warn $query if $debug;
2059 my $sth = $dbh->prepare($query);
2060 if (scalar(@query_params)>0){
2061 $sth->execute(@query_params);
2068 while ( my $data = $sth->fetchrow_hashref ) {
2069 push @results, $data;
2074 =head2 GetBorrowersWhoHaveNeverBorrowed
2076 $results = &GetBorrowersWhoHaveNeverBorrowed
2078 This function get all borrowers who have never borrowed.
2080 I<$result> is a ref to an array which all elements are a hasref.
2084 sub GetBorrowersWhoHaveNeverBorrowed {
2085 my $filterbranch = shift ||
2086 ((C4::Context->preference('IndependantBranches')
2087 && C4::Context->userenv
2088 && C4::Context->userenv->{flags} % 2 !=1
2089 && C4::Context->userenv->{branch})
2090 ? C4::Context->userenv->{branch}
2092 my $dbh = C4::Context->dbh;
2094 SELECT borrowers.borrowernumber,max(timestamp) as latestissue
2096 LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
2097 WHERE issues.borrowernumber IS NULL
2100 if ($filterbranch && $filterbranch ne ""){
2101 $query.=" AND borrowers.branchcode= ?";
2102 push @query_params,$filterbranch;
2104 warn $query if $debug;
2106 my $sth = $dbh->prepare($query);
2107 if (scalar(@query_params)>0){
2108 $sth->execute(@query_params);
2115 while ( my $data = $sth->fetchrow_hashref ) {
2116 push @results, $data;
2121 =head2 GetBorrowersWithIssuesHistoryOlderThan
2123 $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
2125 this function get all borrowers who has an issue history older than I<$date> given on input arg.
2127 I<$result> is a ref to an array which all elements are a hashref.
2128 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2132 sub GetBorrowersWithIssuesHistoryOlderThan {
2133 my $dbh = C4::Context->dbh;
2134 my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
2135 my $filterbranch = shift ||
2136 ((C4::Context->preference('IndependantBranches')
2137 && C4::Context->userenv
2138 && C4::Context->userenv->{flags} % 2 !=1
2139 && C4::Context->userenv->{branch})
2140 ? C4::Context->userenv->{branch}
2143 SELECT count(borrowernumber) as n,borrowernumber
2145 WHERE returndate < ?
2146 AND borrowernumber IS NOT NULL
2149 push @query_params, $date;
2151 $query.=" AND branchcode = ?";
2152 push @query_params, $filterbranch;
2154 $query.=" GROUP BY borrowernumber ";
2155 warn $query if $debug;
2156 my $sth = $dbh->prepare($query);
2157 $sth->execute(@query_params);
2160 while ( my $data = $sth->fetchrow_hashref ) {
2161 push @results, $data;
2166 =head2 GetBorrowersNamesAndLatestIssue
2168 $results = &GetBorrowersNamesAndLatestIssueList(@borrowernumbers)
2170 this function get borrowers Names and surnames and Issue information.
2172 I<@borrowernumbers> is an array which all elements are borrowernumbers.
2173 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2177 sub GetBorrowersNamesAndLatestIssue {
2178 my $dbh = C4::Context->dbh;
2179 my @borrowernumbers=@_;
2181 SELECT surname,lastname, phone, email,max(timestamp)
2183 LEFT JOIN issues ON borrowers.borrowernumber=issues.borrowernumber
2184 GROUP BY borrowernumber
2186 my $sth = $dbh->prepare($query);
2188 my $results = $sth->fetchall_arrayref({});
2194 my $success = DebarMember( $borrowernumber, $todate );
2196 marks a Member as debarred, and therefore unable to checkout any more
2200 true on success, false on failure
2205 my $borrowernumber = shift;
2208 return unless defined $borrowernumber;
2209 return unless $borrowernumber =~ /^\d+$/;
2212 borrowernumber => $borrowernumber,
2222 my $success = ModPrivacy( $borrowernumber, $privacy );
2224 Update the privacy of a patron.
2227 true on success, false on failure
2234 my $borrowernumber = shift;
2235 my $privacy = shift;
2236 return unless defined $borrowernumber;
2237 return unless $borrowernumber =~ /^\d+$/;
2239 return ModMember( borrowernumber => $borrowernumber,
2240 privacy => $privacy );
2245 AddMessage( $borrowernumber, $message_type, $message, $branchcode );
2247 Adds a message to the messages table for the given borrower.
2256 my ( $borrowernumber, $message_type, $message, $branchcode ) = @_;
2258 my $dbh = C4::Context->dbh;
2260 if ( ! ( $borrowernumber && $message_type && $message && $branchcode ) ) {
2264 my $query = "INSERT INTO messages ( borrowernumber, branchcode, message_type, message ) VALUES ( ?, ?, ?, ? )";
2265 my $sth = $dbh->prepare($query);
2266 $sth->execute( $borrowernumber, $branchcode, $message_type, $message );
2267 logaction("MEMBERS", "ADDCIRCMESSAGE", $borrowernumber, $message) if C4::Context->preference("BorrowersLog");
2273 GetMessages( $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 all messages for the given borrowernumber
2283 my ( $borrowernumber, $type, $branchcode ) = @_;
2289 my $dbh = C4::Context->dbh;
2292 branches.branchname,
2295 messages.branchcode LIKE '$branchcode' AS can_delete
2296 FROM messages, branches
2297 WHERE borrowernumber = ?
2298 AND message_type LIKE ?
2299 AND messages.branchcode = branches.branchcode
2300 ORDER BY message_date DESC";
2301 my $sth = $dbh->prepare($query);
2302 $sth->execute( $borrowernumber, $type ) ;
2305 while ( my $data = $sth->fetchrow_hashref ) {
2306 my $d = C4::Dates->new( $data->{message_date}, 'iso' );
2307 $data->{message_date_formatted} = $d->output;
2308 push @results, $data;
2316 GetMessagesCount( $borrowernumber, $type );
2318 $type is message type, B for borrower, or L for Librarian.
2319 Empty type returns all messages of any type.
2321 Returns the number of messages for the given borrowernumber
2325 sub GetMessagesCount {
2326 my ( $borrowernumber, $type, $branchcode ) = @_;
2332 my $dbh = C4::Context->dbh;
2334 my $query = "SELECT COUNT(*) as MsgCount FROM messages WHERE borrowernumber = ? AND message_type LIKE ?";
2335 my $sth = $dbh->prepare($query);
2336 $sth->execute( $borrowernumber, $type ) ;
2339 my $data = $sth->fetchrow_hashref;
2340 my $count = $data->{'MsgCount'};
2347 =head2 DeleteMessage
2349 DeleteMessage( $message_id );
2354 my ( $message_id ) = @_;
2356 my $dbh = C4::Context->dbh;
2357 my $query = "SELECT * FROM messages WHERE message_id = ?";
2358 my $sth = $dbh->prepare($query);
2359 $sth->execute( $message_id );
2360 my $message = $sth->fetchrow_hashref();
2362 $query = "DELETE FROM messages WHERE message_id = ?";
2363 $sth = $dbh->prepare($query);
2364 $sth->execute( $message_id );
2365 logaction("MEMBERS", "DELCIRCMESSAGE", $message->{'borrowernumber'}, $message->{'message'}) if C4::Context->preference("BorrowersLog");
2370 IssueSlip($branchcode, $borrowernumber, $quickslip)
2372 Returns letter hash ( see C4::Letters::GetPreparedLetter )
2374 $quickslip is boolean, to indicate whether we want a quick slip
2379 my ($branch, $borrowernumber, $quickslip) = @_;
2381 # return unless ( C4::Context->boolean_preference('printcirculationslips') );
2383 my $now = POSIX::strftime("%Y-%m-%d", localtime);
2385 my $issueslist = GetPendingIssues($borrowernumber);
2386 foreach my $it (@$issueslist){
2387 if ((substr $it->{'issuedate'}, 0, 10) eq $now || (substr $it->{'lastreneweddate'}, 0, 10) eq $now) {
2390 elsif ((substr $it->{'date_due'}, 0, 10) le $now) {
2391 $it->{'overdue'} = 1;
2394 $it->{'date_due'}=format_date($it->{'date_due'});
2396 my @issues = sort { $b->{'timestamp'} <=> $a->{'timestamp'} } @$issueslist;
2398 my ($letter_code, %repeat);
2400 $letter_code = 'ISSUEQSLIP';
2402 'checkedout' => [ map {
2406 }, grep { $_->{'now'} } @issues ],
2410 $letter_code = 'ISSUESLIP';
2412 'checkedout' => [ map {
2416 }, grep { !$_->{'overdue'} } @issues ],
2418 'overdue' => [ map {
2422 }, grep { $_->{'overdue'} } @issues ],
2425 $_->{'timestamp'} = $_->{'newdate'};
2427 } @{ GetNewsToDisplay("slip") } ],
2431 return C4::Letters::GetPreparedLetter (
2432 module => 'circulation',
2433 letter_code => $letter_code,
2434 branchcode => $branch,
2436 'branches' => $branch,
2437 'borrowers' => $borrowernumber,
2443 =head2 GetBorrowersWithEmail
2445 ([$borrnum,$userid], ...) = GetBorrowersWithEmail('me@example.com');
2447 This gets a list of users and their basic details from their email address.
2448 As it's possible for multiple user to have the same email address, it provides
2449 you with all of them. If there is no userid for the user, there will be an
2450 C<undef> there. An empty list will be returned if there are no matches.
2454 sub GetBorrowersWithEmail {
2457 my $dbh = C4::Context->dbh;
2459 my $query = "SELECT borrowernumber, userid FROM borrowers WHERE email=?";
2460 my $sth=$dbh->prepare($query);
2461 $sth->execute($email);
2463 while (my $ref = $sth->fetch) {
2466 die "Failure searching for borrowers by email address: $sth->errstr" if $sth->err;
2470 sub AddMember_Opac {
2471 my ( %borrower ) = @_;
2473 $borrower{'categorycode'} = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
2475 my $sr = new String::Random;
2476 $sr->{'A'} = [ 'A'..'Z', 'a'..'z' ];
2477 my $password = $sr->randpattern("AAAAAAAAAA");
2478 $borrower{'password'} = $password;
2480 $borrower{'cardnumber'} = fixup_cardnumber();
2482 my $borrowernumber = AddMember(%borrower);
2484 return ( $borrowernumber, $password );
2487 END { } # module clean-up code here (global destructor)