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);
27 use Digest::MD5 qw(md5_base64);
28 use Date::Calc qw/Today Add_Delta_YM/;
29 use C4::Log; # logaction
34 use C4::SQLHelper qw(InsertInTable UpdateInTable SearchInTable);
35 use C4::Members::Attributes qw(SearchIdMatchingAttribute);
37 our ($VERSION,@ISA,@EXPORT,@EXPORT_OK,$debug);
41 $debug = $ENV{DEBUG} || 0;
53 &GetMemberIssuesAndFines
61 &GetFirstValidEmailAddress
74 &GetHideLostItemsPreference
77 &GetMemberAccountRecords
78 &GetBorNotifyAcctRecord
82 &GetBorrowercategoryList
84 &GetBorrowersWhoHaveNotBorrowedSince
85 &GetBorrowersWhoHaveNeverBorrowed
86 &GetBorrowersWithIssuesHistoryOlderThan
113 &ExtendMemberSubscriptionTo
131 C4::Members - Perl Module containing convenience functions for member handling
139 This module contains routines for adding, modifying and deleting members/patrons/borrowers
145 $borrowers_result_array_ref = &Search($filter,$orderby, $limit,
146 $columns_out, $search_on_fields,$searchtype);
148 Looks up patrons (borrowers) on filter. A wrapper for SearchInTable('borrowers').
150 For C<$filter>, C<$orderby>, C<$limit>, C<&columns_out>, C<&search_on_fields> and C<&searchtype>
151 refer to C4::SQLHelper:SearchInTable().
153 Special C<$filter> key '' is effectively expanded to search on surname firstname othernamescw
154 and cardnumber unless C<&search_on_fields> is defined
158 $borrowers = Search('abcd', 'cardnumber');
160 $borrowers = Search({''=>'abcd', category_type=>'I'}, 'surname');
164 sub _express_member_find {
167 # this is used by circulation everytime a new borrowers cardnumber is scanned
168 # so we can check an exact match first, if that works return, otherwise do the rest
169 my $dbh = C4::Context->dbh;
170 my $query = "SELECT borrowernumber FROM borrowers WHERE cardnumber = ?";
171 if ( my $borrowernumber = $dbh->selectrow_array($query, undef, $filter) ) {
172 return( {"borrowernumber"=>$borrowernumber} );
175 my ($search_on_fields, $searchtype);
176 if ( length($filter) == 1 ) {
177 $search_on_fields = [ qw(surname) ];
178 $searchtype = 'start_with';
180 $search_on_fields = [ qw(surname firstname othernames cardnumber) ];
181 $searchtype = 'contain';
184 return (undef, $search_on_fields, $searchtype);
188 my ( $filter, $orderby, $limit, $columns_out, $search_on_fields, $searchtype ) = @_;
193 if ( my $fr = ref $filter ) {
194 if ( $fr eq "HASH" ) {
195 if ( my $search_string = $filter->{''} ) {
196 my ($member_filter, $member_search_on_fields, $member_searchtype) = _express_member_find($search_string);
197 if ($member_filter) {
198 $filter = $member_filter;
201 $search_on_fields ||= $member_search_on_fields;
202 $searchtype ||= $member_searchtype;
207 $search_string = $filter;
211 $search_string = $filter;
212 my ($member_filter, $member_search_on_fields, $member_searchtype) = _express_member_find($search_string);
213 if ($member_filter) {
214 $filter = $member_filter;
217 $search_on_fields ||= $member_search_on_fields;
218 $searchtype ||= $member_searchtype;
222 if ( !$found_borrower && C4::Context->preference('ExtendedPatronAttributes') && $search_string ) {
223 my $matching_records = C4::Members::Attributes::SearchIdMatchingAttribute($search_string);
224 if(scalar(@$matching_records)>0) {
225 if ( my $fr = ref $filter ) {
226 if ( $fr eq "HASH" ) {
228 $filter = [ $filter ];
230 push @$filter, { %f, "borrowernumber"=>$$matching_records };
233 push @$filter, {"borrowernumber"=>$matching_records};
237 $filter = [ $filter ];
238 push @$filter, {"borrowernumber"=>$matching_records};
243 # $showallbranches was not used at the time SearchMember() was mainstreamed into Search().
244 # Mentioning for the reference
246 if ( C4::Context->preference("IndependantBranches") ) { # && !$showallbranches){
247 if ( my $userenv = C4::Context->userenv ) {
248 my $branch = $userenv->{'branch'};
249 if ( ($userenv->{flags} % 2 !=1) &&
250 $branch && $branch ne "insecure" ){
252 if (my $fr = ref $filter) {
253 if ( $fr eq "HASH" ) {
254 $filter->{branchcode} = $branch;
258 $_ = { '' => $_ } unless ref $_;
259 $_->{branchcode} = $branch;
264 $filter = { '' => $filter, branchcode => $branch };
270 if ($found_borrower) {
271 $searchtype = "exact";
273 $searchtype ||= "start_with";
275 return SearchInTable( "borrowers", $filter, $orderby, $limit, $columns_out, $search_on_fields, $searchtype );
278 =head2 GetMemberDetails
280 ($borrower) = &GetMemberDetails($borrowernumber, $cardnumber);
282 Looks up a patron and returns information about him or her. If
283 C<$borrowernumber> is true (nonzero), C<&GetMemberDetails> looks
284 up the borrower by number; otherwise, it looks up the borrower by card
287 C<$borrower> is a reference-to-hash whose keys are the fields of the
288 borrowers table in the Koha database. In addition,
289 C<$borrower-E<gt>{flags}> is a hash giving more detailed information
290 about the patron. Its keys act as flags :
292 if $borrower->{flags}->{LOST} {
293 # Patron's card was reported lost
296 If the state of a flag means that the patron should not be
297 allowed to borrow any more books, then it will have a C<noissues> key
300 See patronflags for more details.
302 C<$borrower-E<gt>{authflags}> is a hash giving more detailed information
303 about the top-level permissions flags set for the borrower. For example,
304 if a user has the "editcatalogue" permission,
305 C<$borrower-E<gt>{authflags}-E<gt>{editcatalogue}> will exist and have
310 sub GetMemberDetails {
311 my ( $borrowernumber, $cardnumber ) = @_;
312 my $dbh = C4::Context->dbh;
315 if ($borrowernumber) {
316 $sth = $dbh->prepare("SELECT borrowers.*,category_type,categories.description,reservefee,enrolmentperiod FROM borrowers LEFT JOIN categories ON borrowers.categorycode=categories.categorycode WHERE borrowernumber=?");
317 $sth->execute($borrowernumber);
319 elsif ($cardnumber) {
320 $sth = $dbh->prepare("SELECT borrowers.*,category_type,categories.description,reservefee,enrolmentperiod FROM borrowers LEFT JOIN categories ON borrowers.categorycode=categories.categorycode WHERE cardnumber=?");
321 $sth->execute($cardnumber);
326 my $borrower = $sth->fetchrow_hashref;
327 my ($amount) = GetMemberAccountRecords( $borrowernumber);
328 $borrower->{'amountoutstanding'} = $amount;
329 # FIXME - patronflags calls GetMemberAccountRecords... just have patronflags return $amount
330 my $flags = patronflags( $borrower);
333 $sth = $dbh->prepare("select bit,flag from userflags");
335 while ( my ( $bit, $flag ) = $sth->fetchrow ) {
336 if ( $borrower->{'flags'} && $borrower->{'flags'} & 2**$bit ) {
337 $accessflagshash->{$flag} = 1;
340 $borrower->{'flags'} = $flags;
341 $borrower->{'authflags'} = $accessflagshash;
343 # For the purposes of making templates easier, we'll define a
344 # 'showname' which is the alternate form the user's first name if
345 # 'other name' is defined.
346 if ($borrower->{category_type} eq 'I') {
347 $borrower->{'showname'} = $borrower->{'othernames'};
348 $borrower->{'showname'} .= " $borrower->{'firstname'}" if $borrower->{'firstname'};
350 $borrower->{'showname'} = $borrower->{'firstname'};
353 return ($borrower); #, $flags, $accessflagshash);
358 $flags = &patronflags($patron);
360 This function is not exported.
362 The following will be set where applicable:
363 $flags->{CHARGES}->{amount} Amount of debt
364 $flags->{CHARGES}->{noissues} Set if debt amount >$5.00 (or syspref noissuescharge)
365 $flags->{CHARGES}->{message} Message -- deprecated
367 $flags->{CREDITS}->{amount} Amount of credit
368 $flags->{CREDITS}->{message} Message -- deprecated
370 $flags->{ GNA } Patron has no valid address
371 $flags->{ GNA }->{noissues} Set for each GNA
372 $flags->{ GNA }->{message} "Borrower has no valid address" -- deprecated
374 $flags->{ LOST } Patron's card reported lost
375 $flags->{ LOST }->{noissues} Set for each LOST
376 $flags->{ LOST }->{message} Message -- deprecated
378 $flags->{DBARRED} Set if patron debarred, no access
379 $flags->{DBARRED}->{noissues} Set for each DBARRED
380 $flags->{DBARRED}->{message} Message -- deprecated
383 $flags->{ NOTES }->{message} The note itself. NOT deprecated
385 $flags->{ ODUES } Set if patron has overdue books.
386 $flags->{ ODUES }->{message} "Yes" -- deprecated
387 $flags->{ ODUES }->{itemlist} ref-to-array: list of overdue books
388 $flags->{ ODUES }->{itemlisttext} Text list of overdue items -- deprecated
390 $flags->{WAITING} Set if any of patron's reserves are available
391 $flags->{WAITING}->{message} Message -- deprecated
392 $flags->{WAITING}->{itemlist} ref-to-array: list of available items
396 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
397 overdue items. Its elements are references-to-hash, each describing an
398 overdue item. The keys are selected fields from the issues, biblio,
399 biblioitems, and items tables of the Koha database.
401 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
402 the overdue items, one per line. Deprecated.
404 =item C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
405 available items. Each element is a reference-to-hash whose keys are
406 fields from the reserves table of the Koha database.
410 All the "message" fields that include language generated in this function are deprecated,
411 because such strings belong properly in the display layer.
413 The "message" field that comes from the DB is OK.
417 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
418 # FIXME rename this function.
421 my ( $patroninformation) = @_;
422 my $dbh=C4::Context->dbh;
423 my ($amount) = GetMemberAccountRecords( $patroninformation->{'borrowernumber'});
426 my $noissuescharge = C4::Context->preference("noissuescharge") || 5;
427 $flaginfo{'message'} = sprintf "Patron owes \$%.02f", $amount;
428 $flaginfo{'amount'} = sprintf "%.02f", $amount;
429 if ( $amount > $noissuescharge && !C4::Context->preference("AllowFineOverride") ) {
430 $flaginfo{'noissues'} = 1;
432 $flags{'CHARGES'} = \%flaginfo;
434 elsif ( $amount < 0 ) {
436 $flaginfo{'message'} = sprintf "Patron has credit of \$%.02f", -$amount;
437 $flaginfo{'amount'} = sprintf "%.02f", $amount;
438 $flags{'CREDITS'} = \%flaginfo;
440 if ( $patroninformation->{'gonenoaddress'}
441 && $patroninformation->{'gonenoaddress'} == 1 )
444 $flaginfo{'message'} = 'Borrower has no valid address.';
445 $flaginfo{'noissues'} = 1;
446 $flags{'GNA'} = \%flaginfo;
448 if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
450 $flaginfo{'message'} = 'Borrower\'s card reported lost.';
451 $flaginfo{'noissues'} = 1;
452 $flags{'LOST'} = \%flaginfo;
454 if ( $patroninformation->{'debarred'}
455 && $patroninformation->{'debarred'} == 1 )
458 $flaginfo{'message'} = 'Borrower is Debarred.';
459 $flaginfo{'noissues'} = 1;
460 $flags{'DBARRED'} = \%flaginfo;
462 if ( $patroninformation->{'borrowernotes'}
463 && $patroninformation->{'borrowernotes'} )
466 $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
467 $flags{'NOTES'} = \%flaginfo;
469 my ( $odues, $itemsoverdue ) = checkoverdues($patroninformation->{'borrowernumber'});
470 if ( $odues && $odues > 0 ) {
472 $flaginfo{'message'} = "Yes";
473 $flaginfo{'itemlist'} = $itemsoverdue;
474 foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
477 $flaginfo{'itemlisttext'} .=
478 "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n"; # newline is display layer
480 $flags{'ODUES'} = \%flaginfo;
482 my @itemswaiting = C4::Reserves::GetReservesFromBorrowernumber( $patroninformation->{'borrowernumber'},'W' );
483 my $nowaiting = scalar @itemswaiting;
484 if ( $nowaiting > 0 ) {
486 $flaginfo{'message'} = "Reserved items available";
487 $flaginfo{'itemlist'} = \@itemswaiting;
488 $flags{'WAITING'} = \%flaginfo;
496 $borrower = &GetMember(%information);
498 Retrieve the first patron record meeting on criteria listed in the
499 C<%information> hash, which should contain one or more
500 pairs of borrowers column names and values, e.g.,
502 $borrower = GetMember(borrowernumber => id);
504 C<&GetBorrower> returns a reference-to-hash whose keys are the fields of
505 the C<borrowers> table in the Koha database.
507 FIXME: GetMember() is used throughout the code as a lookup
508 on a unique key such as the borrowernumber, but this meaning is not
509 enforced in the routine itself.
515 my ( %information ) = @_;
516 if (exists $information{borrowernumber} && !defined $information{borrowernumber}) {
517 #passing mysql's kohaadmin?? Makes no sense as a query
520 my $dbh = C4::Context->dbh;
522 q{SELECT borrowers.*, categories.category_type, categories.description
524 LEFT JOIN categories on borrowers.categorycode=categories.categorycode WHERE };
527 for (keys %information ) {
535 if (defined $information{$_}) {
537 push @values, $information{$_};
540 $select .= "$_ IS NULL";
543 $debug && warn $select, " ",values %information;
544 my $sth = $dbh->prepare("$select");
545 $sth->execute(map{$information{$_}} keys %information);
546 my $data = $sth->fetchall_arrayref({});
547 #FIXME interface to this routine now allows generation of a result set
548 #so whole array should be returned but bowhere in the current code expects this
556 =head2 GetMemberRelatives
558 @borrowernumbers = GetMemberRelatives($borrowernumber);
560 C<GetMemberRelatives> returns a borrowersnumber's list of guarantor/guarantees of the member given in parameter
563 sub GetMemberRelatives {
564 my $borrowernumber = shift;
565 my $dbh = C4::Context->dbh;
569 my $query = "SELECT guarantorid FROM borrowers WHERE borrowernumber=?";
570 my $sth = $dbh->prepare($query);
571 $sth->execute($borrowernumber);
572 my $data = $sth->fetchrow_arrayref();
573 push @glist, $data->[0] if $data->[0];
574 my $guarantor = $data->[0] if $data->[0];
577 $query = "SELECT borrowernumber FROM borrowers WHERE guarantorid=?";
578 $sth = $dbh->prepare($query);
579 $sth->execute($borrowernumber);
580 while ($data = $sth->fetchrow_arrayref()) {
581 push @glist, $data->[0];
584 # Getting sibling guarantees
586 $query = "SELECT borrowernumber FROM borrowers WHERE guarantorid=?";
587 $sth = $dbh->prepare($query);
588 $sth->execute($guarantor);
589 while ($data = $sth->fetchrow_arrayref()) {
590 push @glist, $data->[0] if ($data->[0] != $borrowernumber);
597 =head2 IsMemberBlocked
599 my ($block_status, $count) = IsMemberBlocked( $borrowernumber );
601 Returns whether a patron has overdue items that may result
602 in a block or whether the patron has active fine days
603 that would block circulation privileges.
605 C<$block_status> can have the following values:
607 1 if the patron has outstanding fine days, in which case C<$count> is the number of them
609 -1 if the patron has overdue items, in which case C<$count> is the number of them
611 0 if the patron has no overdue items or outstanding fine days, in which case C<$count> is 0
613 Outstanding fine days are checked before current overdue items
616 FIXME: this needs to be split into two functions; a potential block
617 based on the number of current overdue items could be orthogonal
618 to a block based on whether the patron has any fine days accrued.
622 sub IsMemberBlocked {
623 my $borrowernumber = shift;
624 my $dbh = C4::Context->dbh;
626 # does patron have current fine days?
629 ADDDATE(returndate, finedays * DATEDIFF(returndate,date_due) ) AS blockingdate,
630 DATEDIFF(ADDDATE(returndate, finedays * DATEDIFF(returndate,date_due)),NOW()) AS blockedcount
633 if(C4::Context->preference("item-level_itypes")){
635 qq{ LEFT JOIN items ON (items.itemnumber=old_issues.itemnumber)
636 LEFT JOIN issuingrules ON (issuingrules.itemtype=items.itype)}
639 qq{ LEFT JOIN items ON (items.itemnumber=old_issues.itemnumber)
640 LEFT JOIN biblioitems ON (biblioitems.biblioitemnumber=items.biblioitemnumber)
641 LEFT JOIN issuingrules ON (issuingrules.itemtype=biblioitems.itemtype) };
644 qq{ WHERE finedays IS NOT NULL
645 AND date_due < returndate
646 AND borrowernumber = ?
647 ORDER BY blockingdate DESC, blockedcount DESC
649 my $sth=$dbh->prepare($strsth);
650 $sth->execute($borrowernumber);
651 my $row = $sth->fetchrow_hashref;
652 my $blockeddate = $row->{'blockeddate'};
653 my $blockedcount = $row->{'blockedcount'};
655 return (1, $blockedcount) if $blockedcount > 0;
657 # if he have late issues
658 $sth = $dbh->prepare(
659 "SELECT COUNT(*) as latedocs
661 WHERE borrowernumber = ?
662 AND date_due < curdate()"
664 $sth->execute($borrowernumber);
665 my $latedocs = $sth->fetchrow_hashref->{'latedocs'};
667 return (-1, $latedocs) if $latedocs > 0;
672 =head2 GetMemberIssuesAndFines
674 ($overdue_count, $issue_count, $total_fines) = &GetMemberIssuesAndFines($borrowernumber);
676 Returns aggregate data about items borrowed by the patron with the
677 given borrowernumber.
679 C<&GetMemberIssuesAndFines> returns a three-element array. C<$overdue_count> is the
680 number of overdue items the patron currently has borrowed. C<$issue_count> is the
681 number of books the patron currently has borrowed. C<$total_fines> is
682 the total fine currently due by the borrower.
687 sub GetMemberIssuesAndFines {
688 my ( $borrowernumber ) = @_;
689 my $dbh = C4::Context->dbh;
690 my $query = "SELECT COUNT(*) FROM issues WHERE borrowernumber = ?";
692 $debug and warn $query."\n";
693 my $sth = $dbh->prepare($query);
694 $sth->execute($borrowernumber);
695 my $issue_count = $sth->fetchrow_arrayref->[0];
697 $sth = $dbh->prepare(
698 "SELECT COUNT(*) FROM issues
699 WHERE borrowernumber = ?
700 AND date_due < curdate()"
702 $sth->execute($borrowernumber);
703 my $overdue_count = $sth->fetchrow_arrayref->[0];
705 $sth = $dbh->prepare("SELECT SUM(amountoutstanding) FROM accountlines WHERE borrowernumber = ?");
706 $sth->execute($borrowernumber);
707 my $total_fines = $sth->fetchrow_arrayref->[0];
709 return ($overdue_count, $issue_count, $total_fines);
713 return @{C4::Context->dbh->selectcol_arrayref("SHOW columns from borrowers")};
718 my $success = ModMember(borrowernumber => $borrowernumber,
719 [ field => value ]... );
721 Modify borrower's data. All date fields should ALREADY be in ISO format.
724 true on success, or false on failure
730 # test to know if you must update or not the borrower password
731 if (exists $data{password}) {
732 if ($data{password} eq '****' or $data{password} eq '') {
733 delete $data{password};
735 $data{password} = md5_base64($data{password});
738 my $execute_success=UpdateInTable("borrowers",\%data);
739 if ($execute_success) { # only proceed if the update was a success
740 # ok if its an adult (type) it may have borrowers that depend on it as a guarantor
741 # so when we update information for an adult we should check for guarantees and update the relevant part
742 # of their records, ie addresses and phone numbers
743 my $borrowercategory= GetBorrowercategory( $data{'category_type'} );
744 if ( exists $borrowercategory->{'category_type'} && $borrowercategory->{'category_type'} eq ('A' || 'S') ) {
745 # is adult check guarantees;
746 UpdateGuarantees(%data);
748 logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "UPDATE (executed w/ arg: $data{'borrowernumber'})") if C4::Context->preference("BorrowersLog");
750 return $execute_success;
756 $borrowernumber = &AddMember(%borrower);
758 insert new borrower into table
759 Returns the borrowernumber upon success
761 Returns as undef upon any db error without further processing
768 my $dbh = C4::Context->dbh;
769 # generate a proper login if none provided
770 $data{'userid'} = Generate_Userid($data{'borrowernumber'}, $data{'firstname'}, $data{'surname'}) if $data{'userid'} eq '';
771 # create a disabled account if no password provided
772 $data{'password'} = ($data{'password'})? md5_base64($data{'password'}) : '!';
773 $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 .= $offset unless $offset == 0;
822 } while (!Check_Userid($newuid,$borrowernumber));
828 my ( $uid, $member, $digest ) = @_;
829 my $dbh = C4::Context->dbh;
831 #Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
832 #Then we need to tell the user and have them create a new one.
836 "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
837 $sth->execute( $uid, $member );
838 if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
842 #Everything is good so we can update the information.
845 "update borrowers set userid=?, password=? where borrowernumber=?");
846 $sth->execute( $uid, $digest, $member );
850 logaction("MEMBERS", "CHANGE PASS", $member, "") if C4::Context->preference("BorrowersLog");
856 =head2 fixup_cardnumber
858 Warning: The caller is responsible for locking the members table in write
859 mode, to avoid database corruption.
863 use vars qw( @weightings );
864 my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
866 sub fixup_cardnumber ($) {
867 my ($cardnumber) = @_;
868 my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;
870 # Find out whether member numbers should be generated
871 # automatically. Should be either "1" or something else.
872 # Defaults to "0", which is interpreted as "no".
874 # if ($cardnumber !~ /\S/ && $autonumber_members) {
875 ($autonumber_members) or return $cardnumber;
876 my $checkdigit = C4::Context->preference('checkdigit');
877 my $dbh = C4::Context->dbh;
878 if ( $checkdigit and $checkdigit eq 'katipo' ) {
880 # if checkdigit is selected, calculate katipo-style cardnumber.
881 # otherwise, just use the max()
882 # purpose: generate checksum'd member numbers.
883 # We'll assume we just got the max value of digits 2-8 of member #'s
884 # from the database and our job is to increment that by one,
885 # determine the 1st and 9th digits and return the full string.
886 my $sth = $dbh->prepare(
887 "select max(substring(borrowers.cardnumber,2,7)) as new_num from borrowers"
890 my $data = $sth->fetchrow_hashref;
891 $cardnumber = $data->{new_num};
892 if ( !$cardnumber ) { # If DB has no values,
893 $cardnumber = 1000000; # start at 1000000
899 for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
900 # read weightings, left to right, 1 char at a time
901 my $temp1 = $weightings[$i];
903 # sequence left to right, 1 char at a time
904 my $temp2 = substr( $cardnumber, $i, 1 );
906 # mult each char 1-7 by its corresponding weighting
907 $sum += $temp1 * $temp2;
910 my $rem = ( $sum % 11 );
911 $rem = 'X' if $rem == 10;
913 return "V$cardnumber$rem";
916 # MODIFIED BY JF: mysql4.1 allows casting as an integer, which is probably
917 # better. I'll leave the original in in case it needs to be changed for you
918 # my $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers");
919 my $sth = $dbh->prepare(
920 "select max(cast(cardnumber as signed)) from borrowers"
923 my ($result) = $sth->fetchrow;
926 return $cardnumber; # just here as a fallback/reminder
931 ($num_children, $children_arrayref) = &GetGuarantees($parent_borrno);
932 $child0_cardno = $children_arrayref->[0]{"cardnumber"};
933 $child0_borrno = $children_arrayref->[0]{"borrowernumber"};
935 C<&GetGuarantees> takes a borrower number (e.g., that of a patron
936 with children) and looks up the borrowers who are guaranteed by that
937 borrower (i.e., the patron's children).
939 C<&GetGuarantees> returns two values: an integer giving the number of
940 borrowers guaranteed by C<$parent_borrno>, and a reference to an array
941 of references to hash, which gives the actual results.
947 my ($borrowernumber) = @_;
948 my $dbh = C4::Context->dbh;
951 "select cardnumber,borrowernumber, firstname, surname from borrowers where guarantorid=?"
953 $sth->execute($borrowernumber);
956 my $data = $sth->fetchall_arrayref({});
957 return ( scalar(@$data), $data );
960 =head2 UpdateGuarantees
962 &UpdateGuarantees($parent_borrno);
965 C<&UpdateGuarantees> borrower data for an adult and updates all the guarantees
966 with the modified information
971 sub UpdateGuarantees {
973 my $dbh = C4::Context->dbh;
974 my ( $count, $guarantees ) = GetGuarantees( $data{'borrowernumber'} );
975 foreach my $guarantee (@$guarantees){
976 my $guaquery = qq|UPDATE borrowers
977 SET address=?,fax=?,B_city=?,mobile=?,city=?,phone=?
978 WHERE borrowernumber=?
980 my $sth = $dbh->prepare($guaquery);
981 $sth->execute($data{'address'},$data{'fax'},$data{'B_city'},$data{'mobile'},$data{'city'},$data{'phone'},$guarantee->{'borrowernumber'});
984 =head2 GetPendingIssues
986 my $issues = &GetPendingIssues(@borrowernumber);
988 Looks up what the patron with the given borrowernumber has borrowed.
990 C<&GetPendingIssues> returns a
991 reference-to-array where each element is a reference-to-hash; the
992 keys are the fields from the C<issues>, C<biblio>, and C<items> tables.
993 The keys include C<biblioitems> fields except marc and marcxml.
998 sub GetPendingIssues {
999 my @borrowernumbers = @_;
1001 unless (@borrowernumbers ) { # return a ref_to_array
1002 return \@borrowernumbers; # to not cause surprise to caller
1005 # Borrowers part of the query
1007 for (my $i = 0; $i < @borrowernumbers; $i++) {
1008 $bquery .= ' issues.borrowernumber = ?';
1009 if ($i < $#borrowernumbers ) {
1014 # must avoid biblioitems.* to prevent large marc and marcxml fields from killing performance
1015 # FIXME: namespace collision: each table has "timestamp" fields. Which one is "timestamp" ?
1016 # FIXME: circ/ciculation.pl tries to sort by timestamp!
1017 # FIXME: C4::Print::printslip tries to sort by timestamp!
1018 # FIXME: namespace collision: other collisions possible.
1019 # FIXME: most of this data isn't really being used by callers.
1026 biblioitems.itemtype,
1029 biblioitems.publicationyear,
1030 biblioitems.publishercode,
1031 biblioitems.volumedate,
1032 biblioitems.volumedesc,
1035 borrowers.firstname,
1037 borrowers.cardnumber,
1038 issues.timestamp AS timestamp,
1039 issues.renewals AS renewals,
1040 issues.borrowernumber AS borrowernumber,
1041 items.renewals AS totalrenewals
1043 LEFT JOIN items ON items.itemnumber = issues.itemnumber
1044 LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
1045 LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
1046 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
1049 ORDER BY issues.issuedate"
1052 my $sth = C4::Context->dbh->prepare($query);
1053 $sth->execute(@borrowernumbers);
1054 my $data = $sth->fetchall_arrayref({});
1055 my $today = C4::Dates->new->output('iso');
1056 foreach (@{$data}) {
1057 if ($_->{date_due} and $_->{date_due} lt $today) {
1066 $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
1068 Looks up what the patron with the given borrowernumber has borrowed,
1069 and sorts the results.
1071 C<$sortkey> is the name of a field on which to sort the results. This
1072 should be the name of a field in the C<issues>, C<biblio>,
1073 C<biblioitems>, or C<items> table in the Koha database.
1075 C<$limit> is the maximum number of results to return.
1077 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
1078 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
1079 C<items> tables of the Koha database.
1085 my ( $borrowernumber, $order, $limit ) = @_;
1087 #FIXME: sanity-check order and limit
1088 my $dbh = C4::Context->dbh;
1090 "SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1092 LEFT JOIN items on items.itemnumber=issues.itemnumber
1093 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1094 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1095 WHERE borrowernumber=?
1097 SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1099 LEFT JOIN items on items.itemnumber=old_issues.itemnumber
1100 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1101 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1102 WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL
1104 if ( $limit != 0 ) {
1105 $query .= " limit $limit";
1108 my $sth = $dbh->prepare($query);
1109 $sth->execute($borrowernumber, $borrowernumber);
1112 while ( my $data = $sth->fetchrow_hashref ) {
1113 push @result, $data;
1120 =head2 GetMemberAccountRecords
1122 ($total, $acctlines, $count) = &GetMemberAccountRecords($borrowernumber);
1124 Looks up accounting data for the patron with the given borrowernumber.
1126 C<&GetMemberAccountRecords> returns a three-element array. C<$acctlines> is a
1127 reference-to-array, where each element is a reference-to-hash; the
1128 keys are the fields of the C<accountlines> table in the Koha database.
1129 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1130 total amount outstanding for all of the account lines.
1135 sub GetMemberAccountRecords {
1136 my ($borrowernumber,$date) = @_;
1137 my $dbh = C4::Context->dbh;
1143 WHERE borrowernumber=?);
1144 my @bind = ($borrowernumber);
1145 if ($date && $date ne ''){
1146 $strsth.=" AND date < ? ";
1149 $strsth.=" ORDER BY date desc,timestamp DESC";
1150 my $sth= $dbh->prepare( $strsth );
1151 $sth->execute( @bind );
1153 while ( my $data = $sth->fetchrow_hashref ) {
1154 if ( $data->{itemnumber} ) {
1155 my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
1156 $data->{biblionumber} = $biblio->{biblionumber};
1157 $data->{title} = $biblio->{title};
1159 $acctlines[$numlines] = $data;
1161 $total += int(1000 * $data->{'amountoutstanding'}); # convert float to integer to avoid round-off errors
1164 return ( $total, \@acctlines,$numlines);
1167 =head2 GetBorNotifyAcctRecord
1169 ($total, $acctlines, $count) = &GetBorNotifyAcctRecord($params,$notifyid);
1171 Looks up accounting data for the patron with the given borrowernumber per file number.
1173 C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a
1174 reference-to-array, where each element is a reference-to-hash; the
1175 keys are the fields of the C<accountlines> table in the Koha database.
1176 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1177 total amount outstanding for all of the account lines.
1181 sub GetBorNotifyAcctRecord {
1182 my ( $borrowernumber, $notifyid ) = @_;
1183 my $dbh = C4::Context->dbh;
1186 my $sth = $dbh->prepare(
1189 WHERE borrowernumber=?
1191 AND amountoutstanding != '0'
1192 ORDER BY notify_id,accounttype
1195 $sth->execute( $borrowernumber, $notifyid );
1197 while ( my $data = $sth->fetchrow_hashref ) {
1198 $acctlines[$numlines] = $data;
1200 $total += int(100 * $data->{'amountoutstanding'});
1203 return ( $total, \@acctlines, $numlines );
1206 =head2 checkuniquemember (OUEST-PROVENCE)
1208 ($result,$categorycode) = &checkuniquemember($collectivity,$surname,$firstname,$dateofbirth);
1210 Checks that a member exists or not in the database.
1212 C<&result> is nonzero (=exist) or 0 (=does not exist)
1213 C<&categorycode> is from categorycode table
1214 C<&collectivity> is 1 (= we add a collectivity) or 0 (= we add a physical member)
1215 C<&surname> is the surname
1216 C<&firstname> is the firstname (only if collectivity=0)
1217 C<&dateofbirth> is the date of birth in ISO format (only if collectivity=0)
1221 # FIXME: This function is not legitimate. Multiple patrons might have the same first/last name and birthdate.
1222 # This is especially true since first name is not even a required field.
1224 sub checkuniquemember {
1225 my ( $collectivity, $surname, $firstname, $dateofbirth ) = @_;
1226 my $dbh = C4::Context->dbh;
1227 my $request = ($collectivity) ?
1228 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? " :
1230 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=? and dateofbirth=?" :
1231 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=?";
1232 my $sth = $dbh->prepare($request);
1233 if ($collectivity) {
1234 $sth->execute( uc($surname) );
1235 } elsif($dateofbirth){
1236 $sth->execute( uc($surname), ucfirst($firstname), $dateofbirth );
1238 $sth->execute( uc($surname), ucfirst($firstname));
1240 my @data = $sth->fetchrow;
1241 ( $data[0] ) and return $data[0], $data[1];
1245 sub checkcardnumber {
1246 my ($cardnumber,$borrowernumber) = @_;
1247 # If cardnumber is null, we assume they're allowed.
1248 return 0 if !defined($cardnumber);
1249 my $dbh = C4::Context->dbh;
1250 my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
1251 $query .= " AND borrowernumber <> ?" if ($borrowernumber);
1252 my $sth = $dbh->prepare($query);
1253 if ($borrowernumber) {
1254 $sth->execute($cardnumber,$borrowernumber);
1256 $sth->execute($cardnumber);
1258 if (my $data= $sth->fetchrow_hashref()){
1267 =head2 getzipnamecity (OUEST-PROVENCE)
1269 take all info from table city for the fields city and zip
1270 check for the name and the zip code of the city selected
1274 sub getzipnamecity {
1276 my $dbh = C4::Context->dbh;
1279 "select city_name,city_state,city_zipcode,city_country from cities where cityid=? ");
1280 $sth->execute($cityid);
1281 my @data = $sth->fetchrow;
1282 return $data[0], $data[1], $data[2], $data[3];
1286 =head2 getdcity (OUEST-PROVENCE)
1288 recover cityid with city_name condition
1293 my ($city_name) = @_;
1294 my $dbh = C4::Context->dbh;
1295 my $sth = $dbh->prepare("select cityid from cities where city_name=? ");
1296 $sth->execute($city_name);
1297 my $data = $sth->fetchrow;
1301 =head2 GetFirstValidEmailAddress
1303 $email = GetFirstValidEmailAddress($borrowernumber);
1305 Return the first valid email address for a borrower, given the borrowernumber. For now, the order
1306 is defined as email, emailpro, B_email. Returns the empty string if the borrower has no email
1311 sub GetFirstValidEmailAddress {
1312 my $borrowernumber = shift;
1313 my $dbh = C4::Context->dbh;
1314 my $sth = $dbh->prepare( "SELECT email, emailpro, B_email FROM borrowers where borrowernumber = ? ");
1315 $sth->execute( $borrowernumber );
1316 my $data = $sth->fetchrow_hashref;
1318 if ($data->{'email'}) {
1319 return $data->{'email'};
1320 } elsif ($data->{'emailpro'}) {
1321 return $data->{'emailpro'};
1322 } elsif ($data->{'B_email'}) {
1323 return $data->{'B_email'};
1329 =head2 GetExpiryDate
1331 $expirydate = GetExpiryDate($categorycode, $dateenrolled);
1333 Calculate expiry date given a categorycode and starting date. Date argument must be in ISO format.
1334 Return date is also in ISO format.
1339 my ( $categorycode, $dateenrolled ) = @_;
1341 if ($categorycode) {
1342 my $dbh = C4::Context->dbh;
1343 my $sth = $dbh->prepare("SELECT enrolmentperiod,enrolmentperioddate FROM categories WHERE categorycode=?");
1344 $sth->execute($categorycode);
1345 $enrolments = $sth->fetchrow_hashref;
1347 # die "GetExpiryDate: for enrollmentperiod $enrolmentperiod (category '$categorycode') starting $dateenrolled.\n";
1348 my @date = split (/-/,$dateenrolled);
1349 if($enrolments->{enrolmentperiod}){
1350 return sprintf("%04d-%02d-%02d", Add_Delta_YM(@date,0,$enrolments->{enrolmentperiod}));
1352 return $enrolments->{enrolmentperioddate};
1356 =head2 checkuserpassword (OUEST-PROVENCE)
1358 check for the password and login are not used
1359 return the number of record
1360 0=> NOT USED 1=> USED
1364 sub checkuserpassword {
1365 my ( $borrowernumber, $userid, $password ) = @_;
1366 $password = md5_base64($password);
1367 my $dbh = C4::Context->dbh;
1370 "Select count(*) from borrowers where borrowernumber !=? and userid =? and password=? "
1372 $sth->execute( $borrowernumber, $userid, $password );
1373 my $number_rows = $sth->fetchrow;
1374 return $number_rows;
1378 =head2 GetborCatFromCatType
1380 ($codes_arrayref, $labels_hashref) = &GetborCatFromCatType();
1382 Looks up the different types of borrowers in the database. Returns two
1383 elements: a reference-to-array, which lists the borrower category
1384 codes, and a reference-to-hash, which maps the borrower category codes
1385 to category descriptions.
1390 sub GetborCatFromCatType {
1391 my ( $category_type, $action ) = @_;
1392 # FIXME - This API seems both limited and dangerous.
1393 my $dbh = C4::Context->dbh;
1394 my $request = qq| SELECT categorycode,description
1397 ORDER BY categorycode|;
1398 my $sth = $dbh->prepare($request);
1400 $sth->execute($category_type);
1409 while ( my $data = $sth->fetchrow_hashref ) {
1410 push @codes, $data->{'categorycode'};
1411 $labels{ $data->{'categorycode'} } = $data->{'description'};
1413 return ( \@codes, \%labels );
1416 =head2 GetBorrowercategory
1418 $hashref = &GetBorrowercategory($categorycode);
1420 Given the borrower's category code, the function returns the corresponding
1421 data hashref for a comprehensive information display.
1423 $arrayref_hashref = &GetBorrowercategory;
1425 If no category code provided, the function returns all the categories.
1429 sub GetBorrowercategory {
1431 my $dbh = C4::Context->dbh;
1435 "SELECT description,dateofbirthrequired,upperagelimit,category_type
1437 WHERE categorycode = ?"
1439 $sth->execute($catcode);
1441 $sth->fetchrow_hashref;
1445 } # sub getborrowercategory
1447 =head2 GetBorrowercategoryList
1449 $arrayref_hashref = &GetBorrowercategoryList;
1450 If no category code provided, the function returns all the categories.
1454 sub GetBorrowercategoryList {
1455 my $dbh = C4::Context->dbh;
1460 ORDER BY description"
1464 $sth->fetchall_arrayref({});
1466 } # sub getborrowercategory
1468 =head2 ethnicitycategories
1470 ($codes_arrayref, $labels_hashref) = ðnicitycategories();
1472 Looks up the different ethnic types in the database. Returns two
1473 elements: a reference-to-array, which lists the ethnicity codes, and a
1474 reference-to-hash, which maps the ethnicity codes to ethnicity
1481 sub ethnicitycategories {
1482 my $dbh = C4::Context->dbh;
1483 my $sth = $dbh->prepare("Select code,name from ethnicity order by name");
1487 while ( my $data = $sth->fetchrow_hashref ) {
1488 push @codes, $data->{'code'};
1489 $labels{ $data->{'code'} } = $data->{'name'};
1491 return ( \@codes, \%labels );
1496 $ethn_name = &fixEthnicity($ethn_code);
1498 Takes an ethnicity code (e.g., "european" or "pi") and returns the
1499 corresponding descriptive name from the C<ethnicity> table in the
1500 Koha database ("European" or "Pacific Islander").
1507 my $ethnicity = shift;
1508 return unless $ethnicity;
1509 my $dbh = C4::Context->dbh;
1510 my $sth = $dbh->prepare("Select name from ethnicity where code = ?");
1511 $sth->execute($ethnicity);
1512 my $data = $sth->fetchrow_hashref;
1513 return $data->{'name'};
1514 } # sub fixEthnicity
1518 $dateofbirth,$date = &GetAge($date);
1520 this function return the borrowers age with the value of dateofbirth
1526 my ( $date, $date_ref ) = @_;
1528 if ( not defined $date_ref ) {
1529 $date_ref = sprintf( '%04d-%02d-%02d', Today() );
1532 my ( $year1, $month1, $day1 ) = split /-/, $date;
1533 my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
1535 my $age = $year2 - $year1;
1536 if ( $month1 . $day1 > $month2 . $day2 ) {
1543 =head2 get_institutions
1545 $insitutions = get_institutions();
1547 Just returns a list of all the borrowers of type I, borrownumber and name
1552 sub get_institutions {
1553 my $dbh = C4::Context->dbh();
1556 "SELECT borrowernumber,surname FROM borrowers WHERE categorycode=? ORDER BY surname"
1560 while ( my $data = $sth->fetchrow_hashref() ) {
1561 $orgs{ $data->{'borrowernumber'} } = $data;
1565 } # sub get_institutions
1567 =head2 add_member_orgs
1569 add_member_orgs($borrowernumber,$borrowernumbers);
1571 Takes a borrowernumber and a list of other borrowernumbers and inserts them into the borrowers_to_borrowers table
1576 sub add_member_orgs {
1577 my ( $borrowernumber, $otherborrowers ) = @_;
1578 my $dbh = C4::Context->dbh();
1580 "INSERT INTO borrowers_to_borrowers (borrower1,borrower2) VALUES (?,?)";
1581 my $sth = $dbh->prepare($query);
1582 foreach my $otherborrowernumber (@$otherborrowers) {
1583 $sth->execute( $borrowernumber, $otherborrowernumber );
1586 } # sub add_member_orgs
1590 $cityarrayref = GetCities();
1592 Returns an array_ref of the entries in the cities table
1593 If there are entries in the table an empty row is returned
1594 This is currently only used to populate a popup in memberentry
1600 my $dbh = C4::Context->dbh;
1601 my $city_arr = $dbh->selectall_arrayref(
1602 q|SELECT cityid,city_zipcode,city_name,city_state,city_country FROM cities ORDER BY city_name|,
1604 if ( @{$city_arr} ) {
1605 unshift @{$city_arr}, {
1606 city_zipcode => q{},
1610 city_country => q{},
1617 =head2 GetSortDetails (OUEST-PROVENCE)
1619 ($lib) = &GetSortDetails($category,$sortvalue);
1621 Returns the authorized value details
1622 C<&$lib>return value of authorized value details
1623 C<&$sortvalue>this is the value of authorized value
1624 C<&$category>this is the value of authorized value category
1628 sub GetSortDetails {
1629 my ( $category, $sortvalue ) = @_;
1630 my $dbh = C4::Context->dbh;
1631 my $query = qq|SELECT lib
1632 FROM authorised_values
1634 AND authorised_value=? |;
1635 my $sth = $dbh->prepare($query);
1636 $sth->execute( $category, $sortvalue );
1637 my $lib = $sth->fetchrow;
1638 return ($lib) if ($lib);
1639 return ($sortvalue) unless ($lib);
1642 =head2 MoveMemberToDeleted
1644 $result = &MoveMemberToDeleted($borrowernumber);
1646 Copy the record from borrowers to deletedborrowers table.
1650 # FIXME: should do it in one SQL statement w/ subquery
1651 # Otherwise, we should return the @data on success
1653 sub MoveMemberToDeleted {
1654 my ($member) = shift or return;
1655 my $dbh = C4::Context->dbh;
1656 my $query = qq|SELECT *
1658 WHERE borrowernumber=?|;
1659 my $sth = $dbh->prepare($query);
1660 $sth->execute($member);
1661 my @data = $sth->fetchrow_array;
1662 (@data) or return; # if we got a bad borrowernumber, there's nothing to insert
1664 $dbh->prepare( "INSERT INTO deletedborrowers VALUES ("
1665 . ( "?," x ( scalar(@data) - 1 ) )
1667 $sth->execute(@data);
1672 DelMember($borrowernumber);
1674 This function remove directly a borrower whitout writing it on deleteborrower.
1675 + Deletes reserves for the borrower
1680 my $dbh = C4::Context->dbh;
1681 my $borrowernumber = shift;
1682 #warn "in delmember with $borrowernumber";
1683 return unless $borrowernumber; # borrowernumber is mandatory.
1685 my $query = qq|DELETE
1687 WHERE borrowernumber=?|;
1688 my $sth = $dbh->prepare($query);
1689 $sth->execute($borrowernumber);
1693 WHERE borrowernumber = ?
1695 $sth = $dbh->prepare($query);
1696 $sth->execute($borrowernumber);
1697 logaction("MEMBERS", "DELETE", $borrowernumber, "") if C4::Context->preference("BorrowersLog");
1701 =head2 ExtendMemberSubscriptionTo (OUEST-PROVENCE)
1703 $date = ExtendMemberSubscriptionTo($borrowerid, $date);
1705 Extending the subscription to a given date or to the expiry date calculated on ISO date.
1710 sub ExtendMemberSubscriptionTo {
1711 my ( $borrowerid,$date) = @_;
1712 my $dbh = C4::Context->dbh;
1713 my $borrower = GetMember('borrowernumber'=>$borrowerid);
1715 $date=POSIX::strftime("%Y-%m-%d",localtime());
1716 $date = GetExpiryDate( $borrower->{'categorycode'}, $date );
1718 my $sth = $dbh->do(<<EOF);
1720 SET dateexpiry='$date'
1721 WHERE borrowernumber='$borrowerid'
1723 # add enrolmentfee if needed
1724 $sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
1725 $sth->execute($borrower->{'categorycode'});
1726 my ($enrolmentfee) = $sth->fetchrow;
1727 if ($enrolmentfee && $enrolmentfee > 0) {
1728 # insert fee in patron debts
1729 manualinvoice($borrower->{'borrowernumber'}, '', '', 'A', $enrolmentfee);
1731 logaction("MEMBERS", "RENEW", $borrower->{'borrowernumber'}, "Membership renewed")if C4::Context->preference("BorrowersLog");
1732 return $date if ($sth);
1736 =head2 GetRoadTypes (OUEST-PROVENCE)
1738 ($idroadtypearrayref, $roadttype_hashref) = &GetRoadTypes();
1740 Looks up the different road type . Returns two
1741 elements: a reference-to-array, which lists the id_roadtype
1742 codes, and a reference-to-hash, which maps the road type of the road .
1747 my $dbh = C4::Context->dbh;
1749 SELECT roadtypeid,road_type
1751 ORDER BY road_type|;
1752 my $sth = $dbh->prepare($query);
1757 # insert empty value to create a empty choice in cgi popup
1759 while ( my $data = $sth->fetchrow_hashref ) {
1761 push @id, $data->{'roadtypeid'};
1762 $roadtype{ $data->{'roadtypeid'} } = $data->{'road_type'};
1765 #test to know if the table contain some records if no the function return nothing
1772 return ( \@id, \%roadtype );
1778 =head2 GetTitles (OUEST-PROVENCE)
1780 ($borrowertitle)= &GetTitles();
1782 Looks up the different title . Returns array with all borrowers title
1787 my @borrowerTitle = split (/,|\|/,C4::Context->preference('BorrowersTitles'));
1788 unshift( @borrowerTitle, "" );
1789 my $count=@borrowerTitle;
1794 return ( \@borrowerTitle);
1798 =head2 GetPatronImage
1800 my ($imagedata, $dberror) = GetPatronImage($cardnumber);
1802 Returns the mimetype and binary image data of the image for the patron with the supplied cardnumber.
1806 sub GetPatronImage {
1807 my ($cardnumber) = @_;
1808 warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1809 my $dbh = C4::Context->dbh;
1810 my $query = 'SELECT mimetype, imagefile FROM patronimage WHERE cardnumber = ?';
1811 my $sth = $dbh->prepare($query);
1812 $sth->execute($cardnumber);
1813 my $imagedata = $sth->fetchrow_hashref;
1814 warn "Database error!" if $sth->errstr;
1815 return $imagedata, $sth->errstr;
1818 =head2 PutPatronImage
1820 PutPatronImage($cardnumber, $mimetype, $imgfile);
1822 Stores patron binary image data and mimetype in database.
1823 NOTE: This function is good for updating images as well as inserting new images in the database.
1827 sub PutPatronImage {
1828 my ($cardnumber, $mimetype, $imgfile) = @_;
1829 warn "Parameters passed in: Cardnumber=$cardnumber, Mimetype=$mimetype, " . ($imgfile ? "Imagefile" : "No Imagefile") if $debug;
1830 my $dbh = C4::Context->dbh;
1831 my $query = "INSERT INTO patronimage (cardnumber, mimetype, imagefile) VALUES (?,?,?) ON DUPLICATE KEY UPDATE imagefile = ?;";
1832 my $sth = $dbh->prepare($query);
1833 $sth->execute($cardnumber,$mimetype,$imgfile,$imgfile);
1834 warn "Error returned inserting $cardnumber.$mimetype." if $sth->errstr;
1835 return $sth->errstr;
1838 =head2 RmPatronImage
1840 my ($dberror) = RmPatronImage($cardnumber);
1842 Removes the image for the patron with the supplied cardnumber.
1847 my ($cardnumber) = @_;
1848 warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1849 my $dbh = C4::Context->dbh;
1850 my $query = "DELETE FROM patronimage WHERE cardnumber = ?;";
1851 my $sth = $dbh->prepare($query);
1852 $sth->execute($cardnumber);
1853 my $dberror = $sth->errstr;
1854 warn "Database error!" if $sth->errstr;
1858 =head2 GetHideLostItemsPreference
1860 $hidelostitemspref = &GetHideLostItemsPreference($borrowernumber);
1862 Returns the HideLostItems preference for the patron category of the supplied borrowernumber
1863 C<&$hidelostitemspref>return value of function, 0 or 1
1867 sub GetHideLostItemsPreference {
1868 my ($borrowernumber) = @_;
1869 my $dbh = C4::Context->dbh;
1870 my $query = "SELECT hidelostitems FROM borrowers,categories WHERE borrowers.categorycode = categories.categorycode AND borrowernumber = ?";
1871 my $sth = $dbh->prepare($query);
1872 $sth->execute($borrowernumber);
1873 my $hidelostitems = $sth->fetchrow;
1874 return $hidelostitems;
1877 =head2 GetRoadTypeDetails (OUEST-PROVENCE)
1879 ($roadtype) = &GetRoadTypeDetails($roadtypeid);
1881 Returns the description of roadtype
1882 C<&$roadtype>return description of road type
1883 C<&$roadtypeid>this is the value of roadtype s
1887 sub GetRoadTypeDetails {
1888 my ($roadtypeid) = @_;
1889 my $dbh = C4::Context->dbh;
1893 WHERE roadtypeid=?|;
1894 my $sth = $dbh->prepare($query);
1895 $sth->execute($roadtypeid);
1896 my $roadtype = $sth->fetchrow;
1900 =head2 GetBorrowersWhoHaveNotBorrowedSince
1902 &GetBorrowersWhoHaveNotBorrowedSince($date)
1904 this function get all borrowers who haven't borrowed since the date given on input arg.
1908 sub GetBorrowersWhoHaveNotBorrowedSince {
1909 my $filterdate = shift||POSIX::strftime("%Y-%m-%d",localtime());
1910 my $filterexpiry = shift;
1911 my $filterbranch = shift ||
1912 ((C4::Context->preference('IndependantBranches')
1913 && C4::Context->userenv
1914 && C4::Context->userenv->{flags} % 2 !=1
1915 && C4::Context->userenv->{branch})
1916 ? C4::Context->userenv->{branch}
1918 my $dbh = C4::Context->dbh;
1920 SELECT borrowers.borrowernumber,
1921 max(old_issues.timestamp) as latestissue,
1922 max(issues.timestamp) as currentissue
1924 JOIN categories USING (categorycode)
1925 LEFT JOIN old_issues USING (borrowernumber)
1926 LEFT JOIN issues USING (borrowernumber)
1927 WHERE category_type <> 'S'
1928 AND borrowernumber NOT IN (SELECT guarantorid FROM borrowers WHERE guarantorid IS NOT NULL AND guarantorid <> 0)
1931 if ($filterbranch && $filterbranch ne ""){
1932 $query.=" AND borrowers.branchcode= ?";
1933 push @query_params,$filterbranch;
1936 $query .= " AND dateexpiry < ? ";
1937 push @query_params,$filterdate;
1939 $query.=" GROUP BY borrowers.borrowernumber";
1941 $query.=" HAVING (latestissue < ? OR latestissue IS NULL)
1942 AND currentissue IS NULL";
1943 push @query_params,$filterdate;
1945 warn $query if $debug;
1946 my $sth = $dbh->prepare($query);
1947 if (scalar(@query_params)>0){
1948 $sth->execute(@query_params);
1955 while ( my $data = $sth->fetchrow_hashref ) {
1956 push @results, $data;
1961 =head2 GetBorrowersWhoHaveNeverBorrowed
1963 $results = &GetBorrowersWhoHaveNeverBorrowed
1965 This function get all borrowers who have never borrowed.
1967 I<$result> is a ref to an array which all elements are a hasref.
1971 sub GetBorrowersWhoHaveNeverBorrowed {
1972 my $filterbranch = shift ||
1973 ((C4::Context->preference('IndependantBranches')
1974 && C4::Context->userenv
1975 && C4::Context->userenv->{flags} % 2 !=1
1976 && C4::Context->userenv->{branch})
1977 ? C4::Context->userenv->{branch}
1979 my $dbh = C4::Context->dbh;
1981 SELECT borrowers.borrowernumber,max(timestamp) as latestissue
1983 LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
1984 WHERE issues.borrowernumber IS NULL
1987 if ($filterbranch && $filterbranch ne ""){
1988 $query.=" AND borrowers.branchcode= ?";
1989 push @query_params,$filterbranch;
1991 warn $query if $debug;
1993 my $sth = $dbh->prepare($query);
1994 if (scalar(@query_params)>0){
1995 $sth->execute(@query_params);
2002 while ( my $data = $sth->fetchrow_hashref ) {
2003 push @results, $data;
2008 =head2 GetBorrowersWithIssuesHistoryOlderThan
2010 $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
2012 this function get all borrowers who has an issue history older than I<$date> given on input arg.
2014 I<$result> is a ref to an array which all elements are a hashref.
2015 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2019 sub GetBorrowersWithIssuesHistoryOlderThan {
2020 my $dbh = C4::Context->dbh;
2021 my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
2022 my $filterbranch = shift ||
2023 ((C4::Context->preference('IndependantBranches')
2024 && C4::Context->userenv
2025 && C4::Context->userenv->{flags} % 2 !=1
2026 && C4::Context->userenv->{branch})
2027 ? C4::Context->userenv->{branch}
2030 SELECT count(borrowernumber) as n,borrowernumber
2032 WHERE returndate < ?
2033 AND borrowernumber IS NOT NULL
2036 push @query_params, $date;
2038 $query.=" AND branchcode = ?";
2039 push @query_params, $filterbranch;
2041 $query.=" GROUP BY borrowernumber ";
2042 warn $query if $debug;
2043 my $sth = $dbh->prepare($query);
2044 $sth->execute(@query_params);
2047 while ( my $data = $sth->fetchrow_hashref ) {
2048 push @results, $data;
2053 =head2 GetBorrowersNamesAndLatestIssue
2055 $results = &GetBorrowersNamesAndLatestIssueList(@borrowernumbers)
2057 this function get borrowers Names and surnames and Issue information.
2059 I<@borrowernumbers> is an array which all elements are borrowernumbers.
2060 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2064 sub GetBorrowersNamesAndLatestIssue {
2065 my $dbh = C4::Context->dbh;
2066 my @borrowernumbers=@_;
2068 SELECT surname,lastname, phone, email,max(timestamp)
2070 LEFT JOIN issues ON borrowers.borrowernumber=issues.borrowernumber
2071 GROUP BY borrowernumber
2073 my $sth = $dbh->prepare($query);
2075 my $results = $sth->fetchall_arrayref({});
2081 my $success = DebarMember( $borrowernumber );
2083 marks a Member as debarred, and therefore unable to checkout any more
2087 true on success, false on failure
2092 my $borrowernumber = shift;
2094 return unless defined $borrowernumber;
2095 return unless $borrowernumber =~ /^\d+$/;
2097 return ModMember( borrowernumber => $borrowernumber,
2106 my $success = ModPrivacy( $borrowernumber, $privacy );
2108 Update the privacy of a patron.
2111 true on success, false on failure
2118 my $borrowernumber = shift;
2119 my $privacy = shift;
2120 return unless defined $borrowernumber;
2121 return unless $borrowernumber =~ /^\d+$/;
2123 return ModMember( borrowernumber => $borrowernumber,
2124 privacy => $privacy );
2129 AddMessage( $borrowernumber, $message_type, $message, $branchcode );
2131 Adds a message to the messages table for the given borrower.
2140 my ( $borrowernumber, $message_type, $message, $branchcode ) = @_;
2142 my $dbh = C4::Context->dbh;
2144 if ( ! ( $borrowernumber && $message_type && $message && $branchcode ) ) {
2148 my $query = "INSERT INTO messages ( borrowernumber, branchcode, message_type, message ) VALUES ( ?, ?, ?, ? )";
2149 my $sth = $dbh->prepare($query);
2150 $sth->execute( $borrowernumber, $branchcode, $message_type, $message );
2157 GetMessages( $borrowernumber, $type );
2159 $type is message type, B for borrower, or L for Librarian.
2160 Empty type returns all messages of any type.
2162 Returns all messages for the given borrowernumber
2167 my ( $borrowernumber, $type, $branchcode ) = @_;
2173 my $dbh = C4::Context->dbh;
2176 branches.branchname,
2179 messages.branchcode LIKE '$branchcode' AS can_delete
2180 FROM messages, branches
2181 WHERE borrowernumber = ?
2182 AND message_type LIKE ?
2183 AND messages.branchcode = branches.branchcode
2184 ORDER BY message_date DESC";
2185 my $sth = $dbh->prepare($query);
2186 $sth->execute( $borrowernumber, $type ) ;
2189 while ( my $data = $sth->fetchrow_hashref ) {
2190 my $d = C4::Dates->new( $data->{message_date}, 'iso' );
2191 $data->{message_date_formatted} = $d->output;
2192 push @results, $data;
2200 GetMessagesCount( $borrowernumber, $type );
2202 $type is message type, B for borrower, or L for Librarian.
2203 Empty type returns all messages of any type.
2205 Returns the number of messages for the given borrowernumber
2209 sub GetMessagesCount {
2210 my ( $borrowernumber, $type, $branchcode ) = @_;
2216 my $dbh = C4::Context->dbh;
2218 my $query = "SELECT COUNT(*) as MsgCount FROM messages WHERE borrowernumber = ? AND message_type LIKE ?";
2219 my $sth = $dbh->prepare($query);
2220 $sth->execute( $borrowernumber, $type ) ;
2223 my $data = $sth->fetchrow_hashref;
2224 my $count = $data->{'MsgCount'};
2231 =head2 DeleteMessage
2233 DeleteMessage( $message_id );
2238 my ( $message_id ) = @_;
2240 my $dbh = C4::Context->dbh;
2242 my $query = "DELETE FROM messages WHERE message_id = ?";
2243 my $sth = $dbh->prepare($query);
2244 $sth->execute( $message_id );
2248 END { } # module clean-up code here (global destructor)