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 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 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 # find out how long the membership lasts
346 "select enrolmentperiod from categories where categorycode = ?");
347 $sth->execute( $borrower->{'categorycode'} );
348 my $enrolment = $sth->fetchrow;
349 $borrower->{'enrolmentperiod'} = $enrolment;
351 return ($borrower); #, $flags, $accessflagshash);
356 $flags = &patronflags($patron);
358 This function is not exported.
360 The following will be set where applicable:
361 $flags->{CHARGES}->{amount} Amount of debt
362 $flags->{CHARGES}->{noissues} Set if debt amount >$5.00 (or syspref noissuescharge)
363 $flags->{CHARGES}->{message} Message -- deprecated
365 $flags->{CREDITS}->{amount} Amount of credit
366 $flags->{CREDITS}->{message} Message -- deprecated
368 $flags->{ GNA } Patron has no valid address
369 $flags->{ GNA }->{noissues} Set for each GNA
370 $flags->{ GNA }->{message} "Borrower has no valid address" -- deprecated
372 $flags->{ LOST } Patron's card reported lost
373 $flags->{ LOST }->{noissues} Set for each LOST
374 $flags->{ LOST }->{message} Message -- deprecated
376 $flags->{DBARRED} Set if patron debarred, no access
377 $flags->{DBARRED}->{noissues} Set for each DBARRED
378 $flags->{DBARRED}->{message} Message -- deprecated
381 $flags->{ NOTES }->{message} The note itself. NOT deprecated
383 $flags->{ ODUES } Set if patron has overdue books.
384 $flags->{ ODUES }->{message} "Yes" -- deprecated
385 $flags->{ ODUES }->{itemlist} ref-to-array: list of overdue books
386 $flags->{ ODUES }->{itemlisttext} Text list of overdue items -- deprecated
388 $flags->{WAITING} Set if any of patron's reserves are available
389 $flags->{WAITING}->{message} Message -- deprecated
390 $flags->{WAITING}->{itemlist} ref-to-array: list of available items
394 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
395 overdue items. Its elements are references-to-hash, each describing an
396 overdue item. The keys are selected fields from the issues, biblio,
397 biblioitems, and items tables of the Koha database.
399 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
400 the overdue items, one per line. Deprecated.
402 =item C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
403 available items. Each element is a reference-to-hash whose keys are
404 fields from the reserves table of the Koha database.
408 All the "message" fields that include language generated in this function are deprecated,
409 because such strings belong properly in the display layer.
411 The "message" field that comes from the DB is OK.
415 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
416 # FIXME rename this function.
419 my ( $patroninformation) = @_;
420 my $dbh=C4::Context->dbh;
421 my ($amount) = GetMemberAccountRecords( $patroninformation->{'borrowernumber'});
424 my $noissuescharge = C4::Context->preference("noissuescharge") || 5;
425 $flaginfo{'message'} = sprintf "Patron owes \$%.02f", $amount;
426 $flaginfo{'amount'} = sprintf "%.02f", $amount;
427 if ( $amount > $noissuescharge && !C4::Context->preference("AllowFineOverride") ) {
428 $flaginfo{'noissues'} = 1;
430 $flags{'CHARGES'} = \%flaginfo;
432 elsif ( $amount < 0 ) {
434 $flaginfo{'message'} = sprintf "Patron has credit of \$%.02f", -$amount;
435 $flaginfo{'amount'} = sprintf "%.02f", $amount;
436 $flags{'CREDITS'} = \%flaginfo;
438 if ( $patroninformation->{'gonenoaddress'}
439 && $patroninformation->{'gonenoaddress'} == 1 )
442 $flaginfo{'message'} = 'Borrower has no valid address.';
443 $flaginfo{'noissues'} = 1;
444 $flags{'GNA'} = \%flaginfo;
446 if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
448 $flaginfo{'message'} = 'Borrower\'s card reported lost.';
449 $flaginfo{'noissues'} = 1;
450 $flags{'LOST'} = \%flaginfo;
452 if ( $patroninformation->{'debarred'}
453 && $patroninformation->{'debarred'} == 1 )
456 $flaginfo{'message'} = 'Borrower is Debarred.';
457 $flaginfo{'noissues'} = 1;
458 $flags{'DBARRED'} = \%flaginfo;
460 if ( $patroninformation->{'borrowernotes'}
461 && $patroninformation->{'borrowernotes'} )
464 $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
465 $flags{'NOTES'} = \%flaginfo;
467 my ( $odues, $itemsoverdue ) = checkoverdues($patroninformation->{'borrowernumber'});
468 if ( $odues && $odues > 0 ) {
470 $flaginfo{'message'} = "Yes";
471 $flaginfo{'itemlist'} = $itemsoverdue;
472 foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
475 $flaginfo{'itemlisttext'} .=
476 "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n"; # newline is display layer
478 $flags{'ODUES'} = \%flaginfo;
480 my @itemswaiting = C4::Reserves::GetReservesFromBorrowernumber( $patroninformation->{'borrowernumber'},'W' );
481 my $nowaiting = scalar @itemswaiting;
482 if ( $nowaiting > 0 ) {
484 $flaginfo{'message'} = "Reserved items available";
485 $flaginfo{'itemlist'} = \@itemswaiting;
486 $flags{'WAITING'} = \%flaginfo;
494 $borrower = &GetMember(%information);
496 Retrieve the first patron record meeting on criteria listed in the
497 C<%information> hash, which should contain one or more
498 pairs of borrowers column names and values, e.g.,
500 $borrower = GetMember(borrowernumber => id);
502 C<&GetBorrower> returns a reference-to-hash whose keys are the fields of
503 the C<borrowers> table in the Koha database.
505 FIXME: GetMember() is used throughout the code as a lookup
506 on a unique key such as the borrowernumber, but this meaning is not
507 enforced in the routine itself.
513 my ( %information ) = @_;
514 if (exists $information{borrowernumber} && !defined $information{borrowernumber}) {
515 #passing mysql's kohaadmin?? Makes no sense as a query
518 my $dbh = C4::Context->dbh;
520 q{SELECT borrowers.*, categories.category_type, categories.description
522 LEFT JOIN categories on borrowers.categorycode=categories.categorycode WHERE };
525 for (keys %information ) {
533 if (defined $information{$_}) {
535 push @values, $information{$_};
538 $select .= "$_ IS NULL";
541 $debug && warn $select, " ",values %information;
542 my $sth = $dbh->prepare("$select");
543 $sth->execute(map{$information{$_}} keys %information);
544 my $data = $sth->fetchall_arrayref({});
545 #FIXME interface to this routine now allows generation of a result set
546 #so whole array should be returned but bowhere in the current code expects this
554 =head2 GetMemberRelatives
556 @borrowernumbers = GetMemberRelatives($borrowernumber);
558 C<GetMemberRelatives> returns a borrowersnumber's list of guarantor/guarantees of the member given in parameter
561 sub GetMemberRelatives {
562 my $borrowernumber = shift;
563 my $dbh = C4::Context->dbh;
567 my $query = "SELECT guarantorid FROM borrowers WHERE borrowernumber=?";
568 my $sth = $dbh->prepare($query);
569 $sth->execute($borrowernumber);
570 my $data = $sth->fetchrow_arrayref();
571 push @glist, $data->[0] if $data->[0];
572 my $guarantor = $data->[0] if $data->[0];
575 $query = "SELECT borrowernumber FROM borrowers WHERE guarantorid=?";
576 $sth = $dbh->prepare($query);
577 $sth->execute($borrowernumber);
578 while ($data = $sth->fetchrow_arrayref()) {
579 push @glist, $data->[0];
582 # Getting sibling guarantees
584 $query = "SELECT borrowernumber FROM borrowers WHERE guarantorid=?";
585 $sth = $dbh->prepare($query);
586 $sth->execute($guarantor);
587 while ($data = $sth->fetchrow_arrayref()) {
588 push @glist, $data->[0] if ($data->[0] != $borrowernumber);
595 =head2 IsMemberBlocked
597 my ($block_status, $count) = IsMemberBlocked( $borrowernumber );
599 Returns whether a patron has overdue items that may result
600 in a block or whether the patron has active fine days
601 that would block circulation privileges.
603 C<$block_status> can have the following values:
605 1 if the patron has outstanding fine days, in which case C<$count> is the number of them
607 -1 if the patron has overdue items, in which case C<$count> is the number of them
609 0 if the patron has no overdue items or outstanding fine days, in which case C<$count> is 0
611 Outstanding fine days are checked before current overdue items
614 FIXME: this needs to be split into two functions; a potential block
615 based on the number of current overdue items could be orthogonal
616 to a block based on whether the patron has any fine days accrued.
620 sub IsMemberBlocked {
621 my $borrowernumber = shift;
622 my $dbh = C4::Context->dbh;
624 # does patron have current fine days?
627 ADDDATE(returndate, finedays * DATEDIFF(returndate,date_due) ) AS blockingdate,
628 DATEDIFF(ADDDATE(returndate, finedays * DATEDIFF(returndate,date_due)),NOW()) AS blockedcount
631 if(C4::Context->preference("item-level_itypes")){
633 qq{ LEFT JOIN items ON (items.itemnumber=old_issues.itemnumber)
634 LEFT JOIN issuingrules ON (issuingrules.itemtype=items.itype)}
637 qq{ LEFT JOIN items ON (items.itemnumber=old_issues.itemnumber)
638 LEFT JOIN biblioitems ON (biblioitems.biblioitemnumber=items.biblioitemnumber)
639 LEFT JOIN issuingrules ON (issuingrules.itemtype=biblioitems.itemtype) };
642 qq{ WHERE finedays IS NOT NULL
643 AND date_due < returndate
644 AND borrowernumber = ?
645 ORDER BY blockingdate DESC, blockedcount DESC
647 my $sth=$dbh->prepare($strsth);
648 $sth->execute($borrowernumber);
649 my $row = $sth->fetchrow_hashref;
650 my $blockeddate = $row->{'blockeddate'};
651 my $blockedcount = $row->{'blockedcount'};
653 return (1, $blockedcount) if $blockedcount > 0;
655 # if he have late issues
656 $sth = $dbh->prepare(
657 "SELECT COUNT(*) as latedocs
659 WHERE borrowernumber = ?
660 AND date_due < curdate()"
662 $sth->execute($borrowernumber);
663 my $latedocs = $sth->fetchrow_hashref->{'latedocs'};
665 return (-1, $latedocs) if $latedocs > 0;
670 =head2 GetMemberIssuesAndFines
672 ($overdue_count, $issue_count, $total_fines) = &GetMemberIssuesAndFines($borrowernumber);
674 Returns aggregate data about items borrowed by the patron with the
675 given borrowernumber.
677 C<&GetMemberIssuesAndFines> returns a three-element array. C<$overdue_count> is the
678 number of overdue items the patron currently has borrowed. C<$issue_count> is the
679 number of books the patron currently has borrowed. C<$total_fines> is
680 the total fine currently due by the borrower.
685 sub GetMemberIssuesAndFines {
686 my ( $borrowernumber ) = @_;
687 my $dbh = C4::Context->dbh;
688 my $query = "SELECT COUNT(*) FROM issues WHERE borrowernumber = ?";
690 $debug and warn $query."\n";
691 my $sth = $dbh->prepare($query);
692 $sth->execute($borrowernumber);
693 my $issue_count = $sth->fetchrow_arrayref->[0];
695 $sth = $dbh->prepare(
696 "SELECT COUNT(*) FROM issues
697 WHERE borrowernumber = ?
698 AND date_due < curdate()"
700 $sth->execute($borrowernumber);
701 my $overdue_count = $sth->fetchrow_arrayref->[0];
703 $sth = $dbh->prepare("SELECT SUM(amountoutstanding) FROM accountlines WHERE borrowernumber = ?");
704 $sth->execute($borrowernumber);
705 my $total_fines = $sth->fetchrow_arrayref->[0];
707 return ($overdue_count, $issue_count, $total_fines);
711 return @{C4::Context->dbh->selectcol_arrayref("SHOW columns from borrowers")};
716 my $success = ModMember(borrowernumber => $borrowernumber,
717 [ field => value ]... );
719 Modify borrower's data. All date fields should ALREADY be in ISO format.
722 true on success, or false on failure
728 # test to know if you must update or not the borrower password
729 if (exists $data{password}) {
730 if ($data{password} eq '****' or $data{password} eq '') {
731 delete $data{password};
733 $data{password} = md5_base64($data{password});
736 my $execute_success=UpdateInTable("borrowers",\%data);
737 if ($execute_success) { # only proceed if the update was a success
738 # ok if its an adult (type) it may have borrowers that depend on it as a guarantor
739 # so when we update information for an adult we should check for guarantees and update the relevant part
740 # of their records, ie addresses and phone numbers
741 my $borrowercategory= GetBorrowercategory( $data{'category_type'} );
742 if ( exists $borrowercategory->{'category_type'} && $borrowercategory->{'category_type'} eq ('A' || 'S') ) {
743 # is adult check guarantees;
744 UpdateGuarantees(%data);
746 logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "UPDATE (executed w/ arg: $data{'borrowernumber'})") if C4::Context->preference("BorrowersLog");
748 return $execute_success;
754 $borrowernumber = &AddMember(%borrower);
756 insert new borrower into table
757 Returns the borrowernumber upon success
759 Returns as undef upon any db error without further processing
766 my $dbh = C4::Context->dbh;
767 # generate a proper login if none provided
768 $data{'userid'} = Generate_Userid($data{'borrowernumber'}, $data{'firstname'}, $data{'surname'}) if $data{'userid'} eq '';
769 # create a disabled account if no password provided
770 $data{'password'} = ($data{'password'})? md5_base64($data{'password'}) : '!';
771 $data{'borrowernumber'}=InsertInTable("borrowers",\%data);
772 # mysql_insertid is probably bad. not necessarily accurate and mysql-specific at best.
773 logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
775 # check for enrollment fee & add it if needed
776 my $sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
777 $sth->execute($data{'categorycode'});
778 my ($enrolmentfee) = $sth->fetchrow;
780 warn sprintf('Database returned the following error: %s', $sth->errstr);
783 if ($enrolmentfee && $enrolmentfee > 0) {
784 # insert fee in patron debts
785 manualinvoice($data{'borrowernumber'}, '', '', 'A', $enrolmentfee);
788 return $data{'borrowernumber'};
793 my ($uid,$member) = @_;
794 my $dbh = C4::Context->dbh;
795 # Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
796 # Then we need to tell the user and have them create a new one.
799 "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
800 $sth->execute( $uid, $member );
801 if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
809 sub Generate_Userid {
810 my ($borrowernumber, $firstname, $surname) = @_;
814 $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
815 $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
816 $newuid = lc(($firstname)? "$firstname.$surname" : $surname);
817 $newuid .= $offset unless $offset == 0;
820 } while (!Check_Userid($newuid,$borrowernumber));
826 my ( $uid, $member, $digest ) = @_;
827 my $dbh = C4::Context->dbh;
829 #Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
830 #Then we need to tell the user and have them create a new one.
834 "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
835 $sth->execute( $uid, $member );
836 if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
840 #Everything is good so we can update the information.
843 "update borrowers set userid=?, password=? where borrowernumber=?");
844 $sth->execute( $uid, $digest, $member );
848 logaction("MEMBERS", "CHANGE PASS", $member, "") if C4::Context->preference("BorrowersLog");
854 =head2 fixup_cardnumber
856 Warning: The caller is responsible for locking the members table in write
857 mode, to avoid database corruption.
861 use vars qw( @weightings );
862 my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
864 sub fixup_cardnumber ($) {
865 my ($cardnumber) = @_;
866 my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;
868 # Find out whether member numbers should be generated
869 # automatically. Should be either "1" or something else.
870 # Defaults to "0", which is interpreted as "no".
872 # if ($cardnumber !~ /\S/ && $autonumber_members) {
873 ($autonumber_members) or return $cardnumber;
874 my $checkdigit = C4::Context->preference('checkdigit');
875 my $dbh = C4::Context->dbh;
876 if ( $checkdigit and $checkdigit eq 'katipo' ) {
878 # if checkdigit is selected, calculate katipo-style cardnumber.
879 # otherwise, just use the max()
880 # purpose: generate checksum'd member numbers.
881 # We'll assume we just got the max value of digits 2-8 of member #'s
882 # from the database and our job is to increment that by one,
883 # determine the 1st and 9th digits and return the full string.
884 my $sth = $dbh->prepare(
885 "select max(substring(borrowers.cardnumber,2,7)) as new_num from borrowers"
888 my $data = $sth->fetchrow_hashref;
889 $cardnumber = $data->{new_num};
890 if ( !$cardnumber ) { # If DB has no values,
891 $cardnumber = 1000000; # start at 1000000
897 for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
898 # read weightings, left to right, 1 char at a time
899 my $temp1 = $weightings[$i];
901 # sequence left to right, 1 char at a time
902 my $temp2 = substr( $cardnumber, $i, 1 );
904 # mult each char 1-7 by its corresponding weighting
905 $sum += $temp1 * $temp2;
908 my $rem = ( $sum % 11 );
909 $rem = 'X' if $rem == 10;
911 return "V$cardnumber$rem";
914 # MODIFIED BY JF: mysql4.1 allows casting as an integer, which is probably
915 # better. I'll leave the original in in case it needs to be changed for you
916 # my $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers");
917 my $sth = $dbh->prepare(
918 "select max(cast(cardnumber as signed)) from borrowers"
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: C4::Print::printslip tries to sort by timestamp!
1016 # FIXME: namespace collision: other collisions possible.
1017 # FIXME: most of this data isn't really being used by callers.
1024 biblioitems.itemtype,
1027 biblioitems.publicationyear,
1028 biblioitems.publishercode,
1029 biblioitems.volumedate,
1030 biblioitems.volumedesc,
1033 borrowers.firstname,
1035 borrowers.cardnumber,
1036 issues.timestamp AS timestamp,
1037 issues.renewals AS renewals,
1038 issues.borrowernumber AS borrowernumber,
1039 items.renewals AS totalrenewals
1041 LEFT JOIN items ON items.itemnumber = issues.itemnumber
1042 LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
1043 LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
1044 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
1047 ORDER BY issues.issuedate"
1050 my $sth = C4::Context->dbh->prepare($query);
1051 $sth->execute(@borrowernumbers);
1052 my $data = $sth->fetchall_arrayref({});
1053 my $today = C4::Dates->new->output('iso');
1054 foreach (@{$data}) {
1055 if ($_->{date_due} and $_->{date_due} lt $today) {
1064 $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
1066 Looks up what the patron with the given borrowernumber has borrowed,
1067 and sorts the results.
1069 C<$sortkey> is the name of a field on which to sort the results. This
1070 should be the name of a field in the C<issues>, C<biblio>,
1071 C<biblioitems>, or C<items> table in the Koha database.
1073 C<$limit> is the maximum number of results to return.
1075 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
1076 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
1077 C<items> tables of the Koha database.
1083 my ( $borrowernumber, $order, $limit ) = @_;
1085 #FIXME: sanity-check order and limit
1086 my $dbh = C4::Context->dbh;
1088 "SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1090 LEFT JOIN items on items.itemnumber=issues.itemnumber
1091 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1092 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1093 WHERE borrowernumber=?
1095 SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1097 LEFT JOIN items on items.itemnumber=old_issues.itemnumber
1098 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1099 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1100 WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL
1102 if ( $limit != 0 ) {
1103 $query .= " limit $limit";
1106 my $sth = $dbh->prepare($query);
1107 $sth->execute($borrowernumber, $borrowernumber);
1110 while ( my $data = $sth->fetchrow_hashref ) {
1111 push @result, $data;
1118 =head2 GetMemberAccountRecords
1120 ($total, $acctlines, $count) = &GetMemberAccountRecords($borrowernumber);
1122 Looks up accounting data for the patron with the given borrowernumber.
1124 C<&GetMemberAccountRecords> returns a three-element array. C<$acctlines> is a
1125 reference-to-array, where each element is a reference-to-hash; the
1126 keys are the fields of the C<accountlines> table in the Koha database.
1127 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1128 total amount outstanding for all of the account lines.
1133 sub GetMemberAccountRecords {
1134 my ($borrowernumber,$date) = @_;
1135 my $dbh = C4::Context->dbh;
1141 WHERE borrowernumber=?);
1142 my @bind = ($borrowernumber);
1143 if ($date && $date ne ''){
1144 $strsth.=" AND date < ? ";
1147 $strsth.=" ORDER BY date desc,timestamp DESC";
1148 my $sth= $dbh->prepare( $strsth );
1149 $sth->execute( @bind );
1151 while ( my $data = $sth->fetchrow_hashref ) {
1152 if ( $data->{itemnumber} ) {
1153 my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
1154 $data->{biblionumber} = $biblio->{biblionumber};
1155 $data->{title} = $biblio->{title};
1157 $acctlines[$numlines] = $data;
1159 $total += int(1000 * $data->{'amountoutstanding'}); # convert float to integer to avoid round-off errors
1162 return ( $total, \@acctlines,$numlines);
1165 =head2 GetBorNotifyAcctRecord
1167 ($total, $acctlines, $count) = &GetBorNotifyAcctRecord($params,$notifyid);
1169 Looks up accounting data for the patron with the given borrowernumber per file number.
1171 C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a
1172 reference-to-array, where each element is a reference-to-hash; the
1173 keys are the fields of the C<accountlines> table in the Koha database.
1174 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1175 total amount outstanding for all of the account lines.
1179 sub GetBorNotifyAcctRecord {
1180 my ( $borrowernumber, $notifyid ) = @_;
1181 my $dbh = C4::Context->dbh;
1184 my $sth = $dbh->prepare(
1187 WHERE borrowernumber=?
1189 AND amountoutstanding != '0'
1190 ORDER BY notify_id,accounttype
1193 $sth->execute( $borrowernumber, $notifyid );
1195 while ( my $data = $sth->fetchrow_hashref ) {
1196 $acctlines[$numlines] = $data;
1198 $total += int(100 * $data->{'amountoutstanding'});
1201 return ( $total, \@acctlines, $numlines );
1204 =head2 checkuniquemember (OUEST-PROVENCE)
1206 ($result,$categorycode) = &checkuniquemember($collectivity,$surname,$firstname,$dateofbirth);
1208 Checks that a member exists or not in the database.
1210 C<&result> is nonzero (=exist) or 0 (=does not exist)
1211 C<&categorycode> is from categorycode table
1212 C<&collectivity> is 1 (= we add a collectivity) or 0 (= we add a physical member)
1213 C<&surname> is the surname
1214 C<&firstname> is the firstname (only if collectivity=0)
1215 C<&dateofbirth> is the date of birth in ISO format (only if collectivity=0)
1219 # FIXME: This function is not legitimate. Multiple patrons might have the same first/last name and birthdate.
1220 # This is especially true since first name is not even a required field.
1222 sub checkuniquemember {
1223 my ( $collectivity, $surname, $firstname, $dateofbirth ) = @_;
1224 my $dbh = C4::Context->dbh;
1225 my $request = ($collectivity) ?
1226 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? " :
1228 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=? and dateofbirth=?" :
1229 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=?";
1230 my $sth = $dbh->prepare($request);
1231 if ($collectivity) {
1232 $sth->execute( uc($surname) );
1233 } elsif($dateofbirth){
1234 $sth->execute( uc($surname), ucfirst($firstname), $dateofbirth );
1236 $sth->execute( uc($surname), ucfirst($firstname));
1238 my @data = $sth->fetchrow;
1239 ( $data[0] ) and return $data[0], $data[1];
1243 sub checkcardnumber {
1244 my ($cardnumber,$borrowernumber) = @_;
1245 # If cardnumber is null, we assume they're allowed.
1246 return 0 if !defined($cardnumber);
1247 my $dbh = C4::Context->dbh;
1248 my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
1249 $query .= " AND borrowernumber <> ?" if ($borrowernumber);
1250 my $sth = $dbh->prepare($query);
1251 if ($borrowernumber) {
1252 $sth->execute($cardnumber,$borrowernumber);
1254 $sth->execute($cardnumber);
1256 if (my $data= $sth->fetchrow_hashref()){
1265 =head2 getzipnamecity (OUEST-PROVENCE)
1267 take all info from table city for the fields city and zip
1268 check for the name and the zip code of the city selected
1272 sub getzipnamecity {
1274 my $dbh = C4::Context->dbh;
1277 "select city_name,city_state,city_zipcode,city_country from cities where cityid=? ");
1278 $sth->execute($cityid);
1279 my @data = $sth->fetchrow;
1280 return $data[0], $data[1], $data[2], $data[3];
1284 =head2 getdcity (OUEST-PROVENCE)
1286 recover cityid with city_name condition
1291 my ($city_name) = @_;
1292 my $dbh = C4::Context->dbh;
1293 my $sth = $dbh->prepare("select cityid from cities where city_name=? ");
1294 $sth->execute($city_name);
1295 my $data = $sth->fetchrow;
1299 =head2 GetFirstValidEmailAddress
1301 $email = GetFirstValidEmailAddress($borrowernumber);
1303 Return the first valid email address for a borrower, given the borrowernumber. For now, the order
1304 is defined as email, emailpro, B_email. Returns the empty string if the borrower has no email
1309 sub GetFirstValidEmailAddress {
1310 my $borrowernumber = shift;
1311 my $dbh = C4::Context->dbh;
1312 my $sth = $dbh->prepare( "SELECT email, emailpro, B_email FROM borrowers where borrowernumber = ? ");
1313 $sth->execute( $borrowernumber );
1314 my $data = $sth->fetchrow_hashref;
1316 if ($data->{'email'}) {
1317 return $data->{'email'};
1318 } elsif ($data->{'emailpro'}) {
1319 return $data->{'emailpro'};
1320 } elsif ($data->{'B_email'}) {
1321 return $data->{'B_email'};
1327 =head2 GetExpiryDate
1329 $expirydate = GetExpiryDate($categorycode, $dateenrolled);
1331 Calculate expiry date given a categorycode and starting date. Date argument must be in ISO format.
1332 Return date is also in ISO format.
1337 my ( $categorycode, $dateenrolled ) = @_;
1339 if ($categorycode) {
1340 my $dbh = C4::Context->dbh;
1341 my $sth = $dbh->prepare("SELECT enrolmentperiod,enrolmentperioddate FROM categories WHERE categorycode=?");
1342 $sth->execute($categorycode);
1343 $enrolments = $sth->fetchrow_hashref;
1345 # die "GetExpiryDate: for enrollmentperiod $enrolmentperiod (category '$categorycode') starting $dateenrolled.\n";
1346 my @date = split (/-/,$dateenrolled);
1347 if($enrolments->{enrolmentperiod}){
1348 return sprintf("%04d-%02d-%02d", Add_Delta_YM(@date,0,$enrolments->{enrolmentperiod}));
1350 return $enrolments->{enrolmentperioddate};
1354 =head2 checkuserpassword (OUEST-PROVENCE)
1356 check for the password and login are not used
1357 return the number of record
1358 0=> NOT USED 1=> USED
1362 sub checkuserpassword {
1363 my ( $borrowernumber, $userid, $password ) = @_;
1364 $password = md5_base64($password);
1365 my $dbh = C4::Context->dbh;
1368 "Select count(*) from borrowers where borrowernumber !=? and userid =? and password=? "
1370 $sth->execute( $borrowernumber, $userid, $password );
1371 my $number_rows = $sth->fetchrow;
1372 return $number_rows;
1376 =head2 GetborCatFromCatType
1378 ($codes_arrayref, $labels_hashref) = &GetborCatFromCatType();
1380 Looks up the different types of borrowers in the database. Returns two
1381 elements: a reference-to-array, which lists the borrower category
1382 codes, and a reference-to-hash, which maps the borrower category codes
1383 to category descriptions.
1388 sub GetborCatFromCatType {
1389 my ( $category_type, $action ) = @_;
1390 # FIXME - This API seems both limited and dangerous.
1391 my $dbh = C4::Context->dbh;
1392 my $request = qq| SELECT categorycode,description
1395 ORDER BY categorycode|;
1396 my $sth = $dbh->prepare($request);
1398 $sth->execute($category_type);
1407 while ( my $data = $sth->fetchrow_hashref ) {
1408 push @codes, $data->{'categorycode'};
1409 $labels{ $data->{'categorycode'} } = $data->{'description'};
1411 return ( \@codes, \%labels );
1414 =head2 GetBorrowercategory
1416 $hashref = &GetBorrowercategory($categorycode);
1418 Given the borrower's category code, the function returns the corresponding
1419 data hashref for a comprehensive information display.
1421 $arrayref_hashref = &GetBorrowercategory;
1423 If no category code provided, the function returns all the categories.
1427 sub GetBorrowercategory {
1429 my $dbh = C4::Context->dbh;
1433 "SELECT description,dateofbirthrequired,upperagelimit,category_type
1435 WHERE categorycode = ?"
1437 $sth->execute($catcode);
1439 $sth->fetchrow_hashref;
1443 } # sub getborrowercategory
1445 =head2 GetBorrowercategoryList
1447 $arrayref_hashref = &GetBorrowercategoryList;
1448 If no category code provided, the function returns all the categories.
1452 sub GetBorrowercategoryList {
1453 my $dbh = C4::Context->dbh;
1458 ORDER BY description"
1462 $sth->fetchall_arrayref({});
1464 } # sub getborrowercategory
1466 =head2 ethnicitycategories
1468 ($codes_arrayref, $labels_hashref) = ðnicitycategories();
1470 Looks up the different ethnic types in the database. Returns two
1471 elements: a reference-to-array, which lists the ethnicity codes, and a
1472 reference-to-hash, which maps the ethnicity codes to ethnicity
1479 sub ethnicitycategories {
1480 my $dbh = C4::Context->dbh;
1481 my $sth = $dbh->prepare("Select code,name from ethnicity order by name");
1485 while ( my $data = $sth->fetchrow_hashref ) {
1486 push @codes, $data->{'code'};
1487 $labels{ $data->{'code'} } = $data->{'name'};
1489 return ( \@codes, \%labels );
1494 $ethn_name = &fixEthnicity($ethn_code);
1496 Takes an ethnicity code (e.g., "european" or "pi") and returns the
1497 corresponding descriptive name from the C<ethnicity> table in the
1498 Koha database ("European" or "Pacific Islander").
1505 my $ethnicity = shift;
1506 return unless $ethnicity;
1507 my $dbh = C4::Context->dbh;
1508 my $sth = $dbh->prepare("Select name from ethnicity where code = ?");
1509 $sth->execute($ethnicity);
1510 my $data = $sth->fetchrow_hashref;
1511 return $data->{'name'};
1512 } # sub fixEthnicity
1516 $dateofbirth,$date = &GetAge($date);
1518 this function return the borrowers age with the value of dateofbirth
1524 my ( $date, $date_ref ) = @_;
1526 if ( not defined $date_ref ) {
1527 $date_ref = sprintf( '%04d-%02d-%02d', Today() );
1530 my ( $year1, $month1, $day1 ) = split /-/, $date;
1531 my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
1533 my $age = $year2 - $year1;
1534 if ( $month1 . $day1 > $month2 . $day2 ) {
1541 =head2 get_institutions
1543 $insitutions = get_institutions();
1545 Just returns a list of all the borrowers of type I, borrownumber and name
1550 sub get_institutions {
1551 my $dbh = C4::Context->dbh();
1554 "SELECT borrowernumber,surname FROM borrowers WHERE categorycode=? ORDER BY surname"
1558 while ( my $data = $sth->fetchrow_hashref() ) {
1559 $orgs{ $data->{'borrowernumber'} } = $data;
1563 } # sub get_institutions
1565 =head2 add_member_orgs
1567 add_member_orgs($borrowernumber,$borrowernumbers);
1569 Takes a borrowernumber and a list of other borrowernumbers and inserts them into the borrowers_to_borrowers table
1574 sub add_member_orgs {
1575 my ( $borrowernumber, $otherborrowers ) = @_;
1576 my $dbh = C4::Context->dbh();
1578 "INSERT INTO borrowers_to_borrowers (borrower1,borrower2) VALUES (?,?)";
1579 my $sth = $dbh->prepare($query);
1580 foreach my $otherborrowernumber (@$otherborrowers) {
1581 $sth->execute( $borrowernumber, $otherborrowernumber );
1584 } # sub add_member_orgs
1588 $cityarrayref = GetCities();
1590 Returns an array_ref of the entries in the cities table
1591 If there are entries in the table an empty row is returned
1592 This is currently only used to populate a popup in memberentry
1598 my $dbh = C4::Context->dbh;
1599 my $city_arr = $dbh->selectall_arrayref(
1600 q|SELECT cityid,city_zipcode,city_name,city_state,city_country FROM cities ORDER BY city_name|,
1602 if ( @{$city_arr} ) {
1603 unshift @{$city_arr}, {
1604 city_zipcode => q{},
1608 city_country => q{},
1615 =head2 GetSortDetails (OUEST-PROVENCE)
1617 ($lib) = &GetSortDetails($category,$sortvalue);
1619 Returns the authorized value details
1620 C<&$lib>return value of authorized value details
1621 C<&$sortvalue>this is the value of authorized value
1622 C<&$category>this is the value of authorized value category
1626 sub GetSortDetails {
1627 my ( $category, $sortvalue ) = @_;
1628 my $dbh = C4::Context->dbh;
1629 my $query = qq|SELECT lib
1630 FROM authorised_values
1632 AND authorised_value=? |;
1633 my $sth = $dbh->prepare($query);
1634 $sth->execute( $category, $sortvalue );
1635 my $lib = $sth->fetchrow;
1636 return ($lib) if ($lib);
1637 return ($sortvalue) unless ($lib);
1640 =head2 MoveMemberToDeleted
1642 $result = &MoveMemberToDeleted($borrowernumber);
1644 Copy the record from borrowers to deletedborrowers table.
1648 # FIXME: should do it in one SQL statement w/ subquery
1649 # Otherwise, we should return the @data on success
1651 sub MoveMemberToDeleted {
1652 my ($member) = shift or return;
1653 my $dbh = C4::Context->dbh;
1654 my $query = qq|SELECT *
1656 WHERE borrowernumber=?|;
1657 my $sth = $dbh->prepare($query);
1658 $sth->execute($member);
1659 my @data = $sth->fetchrow_array;
1660 (@data) or return; # if we got a bad borrowernumber, there's nothing to insert
1662 $dbh->prepare( "INSERT INTO deletedborrowers VALUES ("
1663 . ( "?," x ( scalar(@data) - 1 ) )
1665 $sth->execute(@data);
1670 DelMember($borrowernumber);
1672 This function remove directly a borrower whitout writing it on deleteborrower.
1673 + Deletes reserves for the borrower
1678 my $dbh = C4::Context->dbh;
1679 my $borrowernumber = shift;
1680 #warn "in delmember with $borrowernumber";
1681 return unless $borrowernumber; # borrowernumber is mandatory.
1683 my $query = qq|DELETE
1685 WHERE borrowernumber=?|;
1686 my $sth = $dbh->prepare($query);
1687 $sth->execute($borrowernumber);
1691 WHERE borrowernumber = ?
1693 $sth = $dbh->prepare($query);
1694 $sth->execute($borrowernumber);
1695 logaction("MEMBERS", "DELETE", $borrowernumber, "") if C4::Context->preference("BorrowersLog");
1699 =head2 ExtendMemberSubscriptionTo (OUEST-PROVENCE)
1701 $date = ExtendMemberSubscriptionTo($borrowerid, $date);
1703 Extending the subscription to a given date or to the expiry date calculated on ISO date.
1708 sub ExtendMemberSubscriptionTo {
1709 my ( $borrowerid,$date) = @_;
1710 my $dbh = C4::Context->dbh;
1711 my $borrower = GetMember('borrowernumber'=>$borrowerid);
1713 $date=POSIX::strftime("%Y-%m-%d",localtime());
1714 $date = GetExpiryDate( $borrower->{'categorycode'}, $date );
1716 my $sth = $dbh->do(<<EOF);
1718 SET dateexpiry='$date'
1719 WHERE borrowernumber='$borrowerid'
1721 # add enrolmentfee if needed
1722 $sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
1723 $sth->execute($borrower->{'categorycode'});
1724 my ($enrolmentfee) = $sth->fetchrow;
1725 if ($enrolmentfee && $enrolmentfee > 0) {
1726 # insert fee in patron debts
1727 manualinvoice($borrower->{'borrowernumber'}, '', '', 'A', $enrolmentfee);
1729 logaction("MEMBERS", "RENEW", $borrower->{'borrowernumber'}, "Membership renewed")if C4::Context->preference("BorrowersLog");
1730 return $date if ($sth);
1734 =head2 GetRoadTypes (OUEST-PROVENCE)
1736 ($idroadtypearrayref, $roadttype_hashref) = &GetRoadTypes();
1738 Looks up the different road type . Returns two
1739 elements: a reference-to-array, which lists the id_roadtype
1740 codes, and a reference-to-hash, which maps the road type of the road .
1745 my $dbh = C4::Context->dbh;
1747 SELECT roadtypeid,road_type
1749 ORDER BY road_type|;
1750 my $sth = $dbh->prepare($query);
1755 # insert empty value to create a empty choice in cgi popup
1757 while ( my $data = $sth->fetchrow_hashref ) {
1759 push @id, $data->{'roadtypeid'};
1760 $roadtype{ $data->{'roadtypeid'} } = $data->{'road_type'};
1763 #test to know if the table contain some records if no the function return nothing
1770 return ( \@id, \%roadtype );
1776 =head2 GetTitles (OUEST-PROVENCE)
1778 ($borrowertitle)= &GetTitles();
1780 Looks up the different title . Returns array with all borrowers title
1785 my @borrowerTitle = split (/,|\|/,C4::Context->preference('BorrowersTitles'));
1786 unshift( @borrowerTitle, "" );
1787 my $count=@borrowerTitle;
1792 return ( \@borrowerTitle);
1796 =head2 GetPatronImage
1798 my ($imagedata, $dberror) = GetPatronImage($cardnumber);
1800 Returns the mimetype and binary image data of the image for the patron with the supplied cardnumber.
1804 sub GetPatronImage {
1805 my ($cardnumber) = @_;
1806 warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1807 my $dbh = C4::Context->dbh;
1808 my $query = 'SELECT mimetype, imagefile FROM patronimage WHERE cardnumber = ?';
1809 my $sth = $dbh->prepare($query);
1810 $sth->execute($cardnumber);
1811 my $imagedata = $sth->fetchrow_hashref;
1812 warn "Database error!" if $sth->errstr;
1813 return $imagedata, $sth->errstr;
1816 =head2 PutPatronImage
1818 PutPatronImage($cardnumber, $mimetype, $imgfile);
1820 Stores patron binary image data and mimetype in database.
1821 NOTE: This function is good for updating images as well as inserting new images in the database.
1825 sub PutPatronImage {
1826 my ($cardnumber, $mimetype, $imgfile) = @_;
1827 warn "Parameters passed in: Cardnumber=$cardnumber, Mimetype=$mimetype, " . ($imgfile ? "Imagefile" : "No Imagefile") if $debug;
1828 my $dbh = C4::Context->dbh;
1829 my $query = "INSERT INTO patronimage (cardnumber, mimetype, imagefile) VALUES (?,?,?) ON DUPLICATE KEY UPDATE imagefile = ?;";
1830 my $sth = $dbh->prepare($query);
1831 $sth->execute($cardnumber,$mimetype,$imgfile,$imgfile);
1832 warn "Error returned inserting $cardnumber.$mimetype." if $sth->errstr;
1833 return $sth->errstr;
1836 =head2 RmPatronImage
1838 my ($dberror) = RmPatronImage($cardnumber);
1840 Removes the image for the patron with the supplied cardnumber.
1845 my ($cardnumber) = @_;
1846 warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1847 my $dbh = C4::Context->dbh;
1848 my $query = "DELETE FROM patronimage WHERE cardnumber = ?;";
1849 my $sth = $dbh->prepare($query);
1850 $sth->execute($cardnumber);
1851 my $dberror = $sth->errstr;
1852 warn "Database error!" if $sth->errstr;
1856 =head2 GetHideLostItemsPreference
1858 $hidelostitemspref = &GetHideLostItemsPreference($borrowernumber);
1860 Returns the HideLostItems preference for the patron category of the supplied borrowernumber
1861 C<&$hidelostitemspref>return value of function, 0 or 1
1865 sub GetHideLostItemsPreference {
1866 my ($borrowernumber) = @_;
1867 my $dbh = C4::Context->dbh;
1868 my $query = "SELECT hidelostitems FROM borrowers,categories WHERE borrowers.categorycode = categories.categorycode AND borrowernumber = ?";
1869 my $sth = $dbh->prepare($query);
1870 $sth->execute($borrowernumber);
1871 my $hidelostitems = $sth->fetchrow;
1872 return $hidelostitems;
1875 =head2 GetRoadTypeDetails (OUEST-PROVENCE)
1877 ($roadtype) = &GetRoadTypeDetails($roadtypeid);
1879 Returns the description of roadtype
1880 C<&$roadtype>return description of road type
1881 C<&$roadtypeid>this is the value of roadtype s
1885 sub GetRoadTypeDetails {
1886 my ($roadtypeid) = @_;
1887 my $dbh = C4::Context->dbh;
1891 WHERE roadtypeid=?|;
1892 my $sth = $dbh->prepare($query);
1893 $sth->execute($roadtypeid);
1894 my $roadtype = $sth->fetchrow;
1898 =head2 GetBorrowersWhoHaveNotBorrowedSince
1900 &GetBorrowersWhoHaveNotBorrowedSince($date)
1902 this function get all borrowers who haven't borrowed since the date given on input arg.
1906 sub GetBorrowersWhoHaveNotBorrowedSince {
1907 my $filterdate = shift||POSIX::strftime("%Y-%m-%d",localtime());
1908 my $filterexpiry = shift;
1909 my $filterbranch = shift ||
1910 ((C4::Context->preference('IndependantBranches')
1911 && C4::Context->userenv
1912 && C4::Context->userenv->{flags} % 2 !=1
1913 && C4::Context->userenv->{branch})
1914 ? C4::Context->userenv->{branch}
1916 my $dbh = C4::Context->dbh;
1918 SELECT borrowers.borrowernumber,
1919 max(old_issues.timestamp) as latestissue,
1920 max(issues.timestamp) as currentissue
1922 JOIN categories USING (categorycode)
1923 LEFT JOIN old_issues USING (borrowernumber)
1924 LEFT JOIN issues USING (borrowernumber)
1925 WHERE category_type <> 'S'
1926 AND borrowernumber NOT IN (SELECT guarantorid FROM borrowers WHERE guarantorid IS NOT NULL AND guarantorid <> 0)
1929 if ($filterbranch && $filterbranch ne ""){
1930 $query.=" AND borrowers.branchcode= ?";
1931 push @query_params,$filterbranch;
1934 $query .= " AND dateexpiry < ? ";
1935 push @query_params,$filterdate;
1937 $query.=" GROUP BY borrowers.borrowernumber";
1939 $query.=" HAVING (latestissue < ? OR latestissue IS NULL)
1940 AND currentissue IS NULL";
1941 push @query_params,$filterdate;
1943 warn $query if $debug;
1944 my $sth = $dbh->prepare($query);
1945 if (scalar(@query_params)>0){
1946 $sth->execute(@query_params);
1953 while ( my $data = $sth->fetchrow_hashref ) {
1954 push @results, $data;
1959 =head2 GetBorrowersWhoHaveNeverBorrowed
1961 $results = &GetBorrowersWhoHaveNeverBorrowed
1963 This function get all borrowers who have never borrowed.
1965 I<$result> is a ref to an array which all elements are a hasref.
1969 sub GetBorrowersWhoHaveNeverBorrowed {
1970 my $filterbranch = shift ||
1971 ((C4::Context->preference('IndependantBranches')
1972 && C4::Context->userenv
1973 && C4::Context->userenv->{flags} % 2 !=1
1974 && C4::Context->userenv->{branch})
1975 ? C4::Context->userenv->{branch}
1977 my $dbh = C4::Context->dbh;
1979 SELECT borrowers.borrowernumber,max(timestamp) as latestissue
1981 LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
1982 WHERE issues.borrowernumber IS NULL
1985 if ($filterbranch && $filterbranch ne ""){
1986 $query.=" AND borrowers.branchcode= ?";
1987 push @query_params,$filterbranch;
1989 warn $query if $debug;
1991 my $sth = $dbh->prepare($query);
1992 if (scalar(@query_params)>0){
1993 $sth->execute(@query_params);
2000 while ( my $data = $sth->fetchrow_hashref ) {
2001 push @results, $data;
2006 =head2 GetBorrowersWithIssuesHistoryOlderThan
2008 $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
2010 this function get all borrowers who has an issue history older than I<$date> given on input arg.
2012 I<$result> is a ref to an array which all elements are a hashref.
2013 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2017 sub GetBorrowersWithIssuesHistoryOlderThan {
2018 my $dbh = C4::Context->dbh;
2019 my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
2020 my $filterbranch = shift ||
2021 ((C4::Context->preference('IndependantBranches')
2022 && C4::Context->userenv
2023 && C4::Context->userenv->{flags} % 2 !=1
2024 && C4::Context->userenv->{branch})
2025 ? C4::Context->userenv->{branch}
2028 SELECT count(borrowernumber) as n,borrowernumber
2030 WHERE returndate < ?
2031 AND borrowernumber IS NOT NULL
2034 push @query_params, $date;
2036 $query.=" AND branchcode = ?";
2037 push @query_params, $filterbranch;
2039 $query.=" GROUP BY borrowernumber ";
2040 warn $query if $debug;
2041 my $sth = $dbh->prepare($query);
2042 $sth->execute(@query_params);
2045 while ( my $data = $sth->fetchrow_hashref ) {
2046 push @results, $data;
2051 =head2 GetBorrowersNamesAndLatestIssue
2053 $results = &GetBorrowersNamesAndLatestIssueList(@borrowernumbers)
2055 this function get borrowers Names and surnames and Issue information.
2057 I<@borrowernumbers> is an array which all elements are borrowernumbers.
2058 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2062 sub GetBorrowersNamesAndLatestIssue {
2063 my $dbh = C4::Context->dbh;
2064 my @borrowernumbers=@_;
2066 SELECT surname,lastname, phone, email,max(timestamp)
2068 LEFT JOIN issues ON borrowers.borrowernumber=issues.borrowernumber
2069 GROUP BY borrowernumber
2071 my $sth = $dbh->prepare($query);
2073 my $results = $sth->fetchall_arrayref({});
2079 my $success = DebarMember( $borrowernumber );
2081 marks a Member as debarred, and therefore unable to checkout any more
2085 true on success, false on failure
2090 my $borrowernumber = shift;
2092 return unless defined $borrowernumber;
2093 return unless $borrowernumber =~ /^\d+$/;
2095 return ModMember( borrowernumber => $borrowernumber,
2104 my $success = ModPrivacy( $borrowernumber, $privacy );
2106 Update the privacy of a patron.
2109 true on success, false on failure
2116 my $borrowernumber = shift;
2117 my $privacy = shift;
2118 return unless defined $borrowernumber;
2119 return unless $borrowernumber =~ /^\d+$/;
2121 return ModMember( borrowernumber => $borrowernumber,
2122 privacy => $privacy );
2127 AddMessage( $borrowernumber, $message_type, $message, $branchcode );
2129 Adds a message to the messages table for the given borrower.
2138 my ( $borrowernumber, $message_type, $message, $branchcode ) = @_;
2140 my $dbh = C4::Context->dbh;
2142 if ( ! ( $borrowernumber && $message_type && $message && $branchcode ) ) {
2146 my $query = "INSERT INTO messages ( borrowernumber, branchcode, message_type, message ) VALUES ( ?, ?, ?, ? )";
2147 my $sth = $dbh->prepare($query);
2148 $sth->execute( $borrowernumber, $branchcode, $message_type, $message );
2155 GetMessages( $borrowernumber, $type );
2157 $type is message type, B for borrower, or L for Librarian.
2158 Empty type returns all messages of any type.
2160 Returns all messages for the given borrowernumber
2165 my ( $borrowernumber, $type, $branchcode ) = @_;
2171 my $dbh = C4::Context->dbh;
2174 branches.branchname,
2177 messages.branchcode LIKE '$branchcode' AS can_delete
2178 FROM messages, branches
2179 WHERE borrowernumber = ?
2180 AND message_type LIKE ?
2181 AND messages.branchcode = branches.branchcode
2182 ORDER BY message_date DESC";
2183 my $sth = $dbh->prepare($query);
2184 $sth->execute( $borrowernumber, $type ) ;
2187 while ( my $data = $sth->fetchrow_hashref ) {
2188 my $d = C4::Dates->new( $data->{message_date}, 'iso' );
2189 $data->{message_date_formatted} = $d->output;
2190 push @results, $data;
2198 GetMessagesCount( $borrowernumber, $type );
2200 $type is message type, B for borrower, or L for Librarian.
2201 Empty type returns all messages of any type.
2203 Returns the number of messages for the given borrowernumber
2207 sub GetMessagesCount {
2208 my ( $borrowernumber, $type, $branchcode ) = @_;
2214 my $dbh = C4::Context->dbh;
2216 my $query = "SELECT COUNT(*) as MsgCount FROM messages WHERE borrowernumber = ? AND message_type LIKE ?";
2217 my $sth = $dbh->prepare($query);
2218 $sth->execute( $borrowernumber, $type ) ;
2221 my $data = $sth->fetchrow_hashref;
2222 my $count = $data->{'MsgCount'};
2229 =head2 DeleteMessage
2231 DeleteMessage( $message_id );
2236 my ( $message_id ) = @_;
2238 my $dbh = C4::Context->dbh;
2240 my $query = "DELETE FROM messages WHERE message_id = ?";
2241 my $sth = $dbh->prepare($query);
2242 $sth->execute( $message_id );
2246 END { } # module clean-up code here (global destructor)