3 # Copyright 2000-2003 Katipo Communications
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 2 of the License, or (at your option) any later
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
16 # You should have received a copy of the GNU General Public License along
17 # with Koha; if not, write to the Free Software Foundation, Inc.,
18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
22 #use warnings; FIXME - Bug 2505
24 use C4::Dates qw(format_date_in_iso);
25 use Digest::MD5 qw(md5_base64);
26 use Date::Calc qw/Today Add_Delta_YM/;
27 use C4::Log; # logaction
32 use C4::SQLHelper qw(InsertInTable UpdateInTable SearchInTable);
33 use C4::Members::Attributes qw(SearchIdMatchingAttribute);
35 our ($VERSION,@ISA,@EXPORT,@EXPORT_OK,$debug);
39 $debug = $ENV{DEBUG} || 0;
51 &GetMemberIssuesAndFines
59 &GetFirstValidEmailAddress
73 &GetMemberAccountRecords
74 &GetBorNotifyAcctRecord
78 &GetBorrowercategoryList
80 &GetBorrowersWhoHaveNotBorrowedSince
81 &GetBorrowersWhoHaveNeverBorrowed
82 &GetBorrowersWithIssuesHistoryOlderThan
108 &ExtendMemberSubscriptionTo
126 C4::Members - Perl Module containing convenience functions for member handling
134 This module contains routines for adding, modifying and deleting members/patrons/borrowers
140 ($count, $borrowers) = &SearchMember($searchstring, $type,
141 $category_type, $filter, $showallbranches);
143 Looks up patrons (borrowers) by name.
145 BUGFIX 499: C<$type> is now used to determine type of search.
146 if $type is "simple", search is performed on the first letter of the
149 $category_type is used to get a specified type of user.
150 (mainly adults when creating a child.)
152 C<$searchstring> is a space-separated list of search terms. Each term
153 must match the beginning a borrower's surname, first name, or other
156 C<$filter> is assumed to be a list of elements to filter results on
158 C<$showallbranches> is used in IndependantBranches Context to display all branches results.
160 C<&SearchMember> returns a two-element list. C<$borrowers> is a
161 reference-to-array; each element is a reference-to-hash, whose keys
162 are the fields of the C<borrowers> table in the Koha database.
163 C<$count> is the number of elements in C<$borrowers>.
168 #used by member enquiries from the intranet
170 my ($searchstring, $orderby, $type,$category_type,$filter,$showallbranches ) = @_;
171 my $dbh = C4::Context->dbh;
177 # this is used by circulation everytime a new borrowers cardnumber is scanned
178 # so we can check an exact match first, if that works return, otherwise do the rest
179 $query = "SELECT * FROM borrowers
180 LEFT JOIN categories ON borrowers.categorycode=categories.categorycode
182 my $sth = $dbh->prepare("$query WHERE cardnumber = ?");
183 $sth->execute($searchstring);
184 my $data = $sth->fetchall_arrayref({});
186 return ( scalar(@$data), $data );
189 if ( $type eq "simple" ) # simple search for one letter only
191 $query .= ($category_type ? " AND category_type = ".$dbh->quote($category_type) : "");
192 $query .= " WHERE (surname LIKE ? OR cardnumber like ?) ";
193 if (C4::Context->preference("IndependantBranches") && !$showallbranches){
194 if (C4::Context->userenv && C4::Context->userenv->{flags} % 2 !=1 && C4::Context->userenv->{'branch'}){
195 $query.=" AND borrowers.branchcode =".$dbh->quote(C4::Context->userenv->{'branch'}) unless (C4::Context->userenv->{'branch'} eq "insecure");
198 $query.=" ORDER BY $orderby";
199 @bind = ("$searchstring%","$searchstring");
201 else # advanced search looking in surname, firstname and othernames
203 @data = split( ' ', $searchstring );
206 if (C4::Context->preference("IndependantBranches") && !$showallbranches){
207 if (C4::Context->userenv && C4::Context->userenv->{flags} % 2 !=1 && C4::Context->userenv->{'branch'}){
208 $query.=" borrowers.branchcode =".$dbh->quote(C4::Context->userenv->{'branch'})." AND " unless (C4::Context->userenv->{'branch'} eq "insecure");
211 $query.="((surname LIKE ? OR surname LIKE ?
212 OR firstname LIKE ? OR firstname LIKE ?
213 OR othernames LIKE ? OR othernames LIKE ?)
215 ($category_type?" AND category_type = ".$dbh->quote($category_type):"");
217 "$data[0]%", "% $data[0]%", "$data[0]%", "% $data[0]%",
218 "$data[0]%", "% $data[0]%"
220 for ( my $i = 1 ; $i < $count ; $i++ ) {
221 $query = $query . " AND (" . " surname LIKE ? OR surname LIKE ?
222 OR firstname LIKE ? OR firstname LIKE ?
223 OR othernames LIKE ? OR othernames LIKE ?)";
225 "$data[$i]%", "% $data[$i]%", "$data[$i]%",
226 "% $data[$i]%", "$data[$i]%", "% $data[$i]%" );
230 $query = $query . ") OR cardnumber LIKE ? ";
231 push( @bind, $searchstring );
232 $query .= "order by $orderby";
237 $sth = $dbh->prepare($query);
239 $debug and print STDERR "Q $orderby : $query\n";
240 $sth->execute(@bind);
242 $data = $sth->fetchall_arrayref({});
244 return ( scalar(@$data), $data );
249 $borrowers_result_array_ref = &Search($filter,$orderby, $limit,
250 $columns_out, $search_on_fields,$searchtype);
252 Looks up patrons (borrowers) on filter.
254 BUGFIX 499: C<$type> is now used to determine type of search.
255 if $type is "simple", search is performed on the first letter of the
258 $category_type is used to get a specified type of user.
259 (mainly adults when creating a child.)
262 - a space-separated list of search terms. Implicit AND is done on them
263 - a hash ref containing fieldnames associated with queried value
264 - an array ref combining the two previous elements Implicit OR is done between each array element
267 C<$orderby> is an arrayref of hashref. Contains the name of the field and 0 or 1 depending if order is ascending or descending
269 C<$limit> is there to allow limiting number of results returned
271 C<&columns_out> is an array ref to the fieldnames you want to see in the result list
273 C<&search_on_fields> is an array ref to the fieldnames you want to limit search on when you are using string search
275 C<&searchtype> is a string telling the type of search you want todo : start_with, exact or contains are allowed
280 my ($filter,$orderby, $limit, $columns_out, $search_on_fields,$searchtype) = @_;
282 if (ref($filter) eq "ARRAY"){
283 push @filters,@$filter;
286 push @filters,$filter;
288 if (C4::Context->preference('ExtendedPatronAttributes')) {
289 my $matching_records = C4::Members::Attributes::SearchIdMatchingAttribute($filter);
290 push @filters,@$matching_records;
292 $searchtype||="start_with";
293 my $data=SearchInTable("borrowers",\@filters,$orderby,$limit,$columns_out,$search_on_fields,$searchtype);
298 =head2 GetMemberDetails
300 ($borrower) = &GetMemberDetails($borrowernumber, $cardnumber);
302 Looks up a patron and returns information about him or her. If
303 C<$borrowernumber> is true (nonzero), C<&GetMemberDetails> looks
304 up the borrower by number; otherwise, it looks up the borrower by card
307 C<$borrower> is a reference-to-hash whose keys are the fields of the
308 borrowers table in the Koha database. In addition,
309 C<$borrower-E<gt>{flags}> is a hash giving more detailed information
310 about the patron. Its keys act as flags :
312 if $borrower->{flags}->{LOST} {
313 # Patron's card was reported lost
316 If the state of a flag means that the patron should not be
317 allowed to borrow any more books, then it will have a C<noissues> key
320 See patronflags for more details.
322 C<$borrower-E<gt>{authflags}> is a hash giving more detailed information
323 about the top-level permissions flags set for the borrower. For example,
324 if a user has the "editcatalogue" permission,
325 C<$borrower-E<gt>{authflags}-E<gt>{editcatalogue}> will exist and have
330 sub GetMemberDetails {
331 my ( $borrowernumber, $cardnumber ) = @_;
332 my $dbh = C4::Context->dbh;
335 if ($borrowernumber) {
336 $sth = $dbh->prepare("select borrowers.*,category_type,categories.description from borrowers left join categories on borrowers.categorycode=categories.categorycode where borrowernumber=?");
337 $sth->execute($borrowernumber);
339 elsif ($cardnumber) {
340 $sth = $dbh->prepare("select borrowers.*,category_type,categories.description from borrowers left join categories on borrowers.categorycode=categories.categorycode where cardnumber=?");
341 $sth->execute($cardnumber);
346 my $borrower = $sth->fetchrow_hashref;
347 my ($amount) = GetMemberAccountRecords( $borrowernumber);
348 $borrower->{'amountoutstanding'} = $amount;
349 # FIXME - patronflags calls GetMemberAccountRecords... just have patronflags return $amount
350 my $flags = patronflags( $borrower);
353 $sth = $dbh->prepare("select bit,flag from userflags");
355 while ( my ( $bit, $flag ) = $sth->fetchrow ) {
356 if ( $borrower->{'flags'} && $borrower->{'flags'} & 2**$bit ) {
357 $accessflagshash->{$flag} = 1;
360 $borrower->{'flags'} = $flags;
361 $borrower->{'authflags'} = $accessflagshash;
363 # find out how long the membership lasts
366 "select enrolmentperiod from categories where categorycode = ?");
367 $sth->execute( $borrower->{'categorycode'} );
368 my $enrolment = $sth->fetchrow;
369 $borrower->{'enrolmentperiod'} = $enrolment;
370 return ($borrower); #, $flags, $accessflagshash);
375 $flags = &patronflags($patron);
377 This function is not exported.
379 The following will be set where applicable:
380 $flags->{CHARGES}->{amount} Amount of debt
381 $flags->{CHARGES}->{noissues} Set if debt amount >$5.00 (or syspref noissuescharge)
382 $flags->{CHARGES}->{message} Message -- deprecated
384 $flags->{CREDITS}->{amount} Amount of credit
385 $flags->{CREDITS}->{message} Message -- deprecated
387 $flags->{ GNA } Patron has no valid address
388 $flags->{ GNA }->{noissues} Set for each GNA
389 $flags->{ GNA }->{message} "Borrower has no valid address" -- deprecated
391 $flags->{ LOST } Patron's card reported lost
392 $flags->{ LOST }->{noissues} Set for each LOST
393 $flags->{ LOST }->{message} Message -- deprecated
395 $flags->{DBARRED} Set if patron debarred, no access
396 $flags->{DBARRED}->{noissues} Set for each DBARRED
397 $flags->{DBARRED}->{message} Message -- deprecated
400 $flags->{ NOTES }->{message} The note itself. NOT deprecated
402 $flags->{ ODUES } Set if patron has overdue books.
403 $flags->{ ODUES }->{message} "Yes" -- deprecated
404 $flags->{ ODUES }->{itemlist} ref-to-array: list of overdue books
405 $flags->{ ODUES }->{itemlisttext} Text list of overdue items -- deprecated
407 $flags->{WAITING} Set if any of patron's reserves are available
408 $flags->{WAITING}->{message} Message -- deprecated
409 $flags->{WAITING}->{itemlist} ref-to-array: list of available items
413 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
414 overdue items. Its elements are references-to-hash, each describing an
415 overdue item. The keys are selected fields from the issues, biblio,
416 biblioitems, and items tables of the Koha database.
418 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
419 the overdue items, one per line. Deprecated.
421 =item C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
422 available items. Each element is a reference-to-hash whose keys are
423 fields from the reserves table of the Koha database.
427 All the "message" fields that include language generated in this function are deprecated,
428 because such strings belong properly in the display layer.
430 The "message" field that comes from the DB is OK.
434 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
435 # FIXME rename this function.
438 my ( $patroninformation) = @_;
439 my $dbh=C4::Context->dbh;
440 my ($amount) = GetMemberAccountRecords( $patroninformation->{'borrowernumber'});
443 my $noissuescharge = C4::Context->preference("noissuescharge") || 5;
444 $flaginfo{'message'} = sprintf "Patron owes \$%.02f", $amount;
445 $flaginfo{'amount'} = sprintf "%.02f", $amount;
446 if ( $amount > $noissuescharge ) {
447 $flaginfo{'noissues'} = 1;
449 $flags{'CHARGES'} = \%flaginfo;
451 elsif ( $amount < 0 ) {
453 $flaginfo{'message'} = sprintf "Patron has credit of \$%.02f", -$amount;
454 $flaginfo{'amount'} = sprintf "%.02f", $amount;
455 $flags{'CREDITS'} = \%flaginfo;
457 if ( $patroninformation->{'gonenoaddress'}
458 && $patroninformation->{'gonenoaddress'} == 1 )
461 $flaginfo{'message'} = 'Borrower has no valid address.';
462 $flaginfo{'noissues'} = 1;
463 $flags{'GNA'} = \%flaginfo;
465 if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
467 $flaginfo{'message'} = 'Borrower\'s card reported lost.';
468 $flaginfo{'noissues'} = 1;
469 $flags{'LOST'} = \%flaginfo;
471 if ( $patroninformation->{'debarred'}
472 && $patroninformation->{'debarred'} == 1 )
475 $flaginfo{'message'} = 'Borrower is Debarred.';
476 $flaginfo{'noissues'} = 1;
477 $flags{'DBARRED'} = \%flaginfo;
479 if ( $patroninformation->{'borrowernotes'}
480 && $patroninformation->{'borrowernotes'} )
483 $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
484 $flags{'NOTES'} = \%flaginfo;
486 my ( $odues, $itemsoverdue ) = checkoverdues($patroninformation->{'borrowernumber'});
489 $flaginfo{'message'} = "Yes";
490 $flaginfo{'itemlist'} = $itemsoverdue;
491 foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
494 $flaginfo{'itemlisttext'} .=
495 "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n"; # newline is display layer
497 $flags{'ODUES'} = \%flaginfo;
499 my @itemswaiting = C4::Reserves::GetReservesFromBorrowernumber( $patroninformation->{'borrowernumber'},'W' );
500 my $nowaiting = scalar @itemswaiting;
501 if ( $nowaiting > 0 ) {
503 $flaginfo{'message'} = "Reserved items available";
504 $flaginfo{'itemlist'} = \@itemswaiting;
505 $flags{'WAITING'} = \%flaginfo;
513 $borrower = &GetMember(%information);
515 Retrieve the first patron record meeting on criteria listed in the
516 C<%information> hash, which should contain one or more
517 pairs of borrowers column names and values, e.g.,
519 $borrower = GetMember(borrowernumber => id);
521 C<&GetBorrower> returns a reference-to-hash whose keys are the fields of
522 the C<borrowers> table in the Koha database.
524 FIXME: GetMember() is used throughout the code as a lookup
525 on a unique key such as the borrowernumber, but this meaning is not
526 enforced in the routine itself.
532 my ( %information ) = @_;
533 if (exists $information{borrowernumber} && !defined $information{borrowernumber}) {
534 #passing mysql's kohaadmin?? Makes no sense as a query
537 my $dbh = C4::Context->dbh;
539 q{SELECT borrowers.*, categories.category_type, categories.description
541 LEFT JOIN categories on borrowers.categorycode=categories.categorycode WHERE };
544 for (keys %information ) {
552 if (defined $information{$_}) {
554 push @values, $information{$_};
557 $select .= "$_ IS NULL";
560 $debug && warn $select, " ",values %information;
561 my $sth = $dbh->prepare("$select");
562 $sth->execute(map{$information{$_}} keys %information);
563 my $data = $sth->fetchall_arrayref({});
564 #FIXME interface to this routine now allows generation of a result set
565 #so whole array should be returned but bowhere in the current code expects this
574 =head2 IsMemberBlocked
576 my ($block_status, $count) = IsMemberBlocked( $borrowernumber );
578 Returns whether a patron has overdue items that may result
579 in a block or whether the patron has active fine days
580 that would block circulation privileges.
582 C<$block_status> can have the following values:
584 1 if the patron has outstanding fine days, in which case C<$count> is the number of them
586 -1 if the patron has overdue items, in which case C<$count> is the number of them
588 0 if the patron has no overdue items or outstanding fine days, in which case C<$count> is 0
590 Outstanding fine days are checked before current overdue items
593 FIXME: this needs to be split into two functions; a potential block
594 based on the number of current overdue items could be orthogonal
595 to a block based on whether the patron has any fine days accrued.
599 sub IsMemberBlocked {
600 my $borrowernumber = shift;
601 my $dbh = C4::Context->dbh;
603 # does patron have current fine days?
606 ADDDATE(returndate, finedays * DATEDIFF(returndate,date_due) ) AS blockingdate,
607 DATEDIFF(ADDDATE(returndate, finedays * DATEDIFF(returndate,date_due)),NOW()) AS blockedcount
610 if(C4::Context->preference("item-level_itypes")){
612 qq{ LEFT JOIN items ON (items.itemnumber=old_issues.itemnumber)
613 LEFT JOIN issuingrules ON (issuingrules.itemtype=items.itype)}
616 qq{ LEFT JOIN items ON (items.itemnumber=old_issues.itemnumber)
617 LEFT JOIN biblioitems ON (biblioitems.biblioitemnumber=items.biblioitemnumber)
618 LEFT JOIN issuingrules ON (issuingrules.itemtype=biblioitems.itemtype) };
621 qq{ WHERE finedays IS NOT NULL
622 AND date_due < returndate
623 AND borrowernumber = ?
624 ORDER BY blockingdate DESC, blockedcount DESC
626 my $sth=$dbh->prepare($strsth);
627 $sth->execute($borrowernumber);
628 my $row = $sth->fetchrow_hashref;
629 my $blockeddate = $row->{'blockeddate'};
630 my $blockedcount = $row->{'blockedcount'};
632 return (1, $blockedcount) if $blockedcount > 0;
634 # if he have late issues
635 $sth = $dbh->prepare(
636 "SELECT COUNT(*) as latedocs
638 WHERE borrowernumber = ?
639 AND date_due < curdate()"
641 $sth->execute($borrowernumber);
642 my $latedocs = $sth->fetchrow_hashref->{'latedocs'};
644 return (-1, $latedocs) if $latedocs > 0;
649 =head2 GetMemberIssuesAndFines
651 ($overdue_count, $issue_count, $total_fines) = &GetMemberIssuesAndFines($borrowernumber);
653 Returns aggregate data about items borrowed by the patron with the
654 given borrowernumber.
656 C<&GetMemberIssuesAndFines> returns a three-element array. C<$overdue_count> is the
657 number of overdue items the patron currently has borrowed. C<$issue_count> is the
658 number of books the patron currently has borrowed. C<$total_fines> is
659 the total fine currently due by the borrower.
664 sub GetMemberIssuesAndFines {
665 my ( $borrowernumber ) = @_;
666 my $dbh = C4::Context->dbh;
667 my $query = "SELECT COUNT(*) FROM issues WHERE borrowernumber = ?";
669 $debug and warn $query."\n";
670 my $sth = $dbh->prepare($query);
671 $sth->execute($borrowernumber);
672 my $issue_count = $sth->fetchrow_arrayref->[0];
674 $sth = $dbh->prepare(
675 "SELECT COUNT(*) FROM issues
676 WHERE borrowernumber = ?
677 AND date_due < curdate()"
679 $sth->execute($borrowernumber);
680 my $overdue_count = $sth->fetchrow_arrayref->[0];
682 $sth = $dbh->prepare("SELECT SUM(amountoutstanding) FROM accountlines WHERE borrowernumber = ?");
683 $sth->execute($borrowernumber);
684 my $total_fines = $sth->fetchrow_arrayref->[0];
686 return ($overdue_count, $issue_count, $total_fines);
690 return @{C4::Context->dbh->selectcol_arrayref("SHOW columns from borrowers")};
695 my $success = ModMember(borrowernumber => $borrowernumber,
696 [ field => value ]... );
698 Modify borrower's data. All date fields should ALREADY be in ISO format.
701 true on success, or false on failure
707 # test to know if you must update or not the borrower password
708 if (exists $data{password}) {
709 if ($data{password} eq '****' or $data{password} eq '') {
710 delete $data{password};
712 $data{password} = md5_base64($data{password});
715 my $execute_success=UpdateInTable("borrowers",\%data);
716 # ok if its an adult (type) it may have borrowers that depend on it as a guarantor
717 # so when we update information for an adult we should check for guarantees and update the relevant part
718 # of their records, ie addresses and phone numbers
719 my $borrowercategory= GetBorrowercategory( $data{'category_type'} );
720 if ( exists $borrowercategory->{'category_type'} && $borrowercategory->{'category_type'} eq ('A' || 'S') ) {
721 # is adult check guarantees;
722 UpdateGuarantees(%data);
724 logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "UPDATE (executed w/ arg: $data{'borrowernumber'})")
725 if C4::Context->preference("BorrowersLog");
727 return $execute_success;
733 $borrowernumber = &AddMember(%borrower);
735 insert new borrower into table
736 Returns the borrowernumber
743 my $dbh = C4::Context->dbh;
744 $data{'password'} = '!' if (not $data{'password'} and $data{'userid'});
745 $data{'password'} = md5_base64( $data{'password'} ) if $data{'password'};
746 $data{'borrowernumber'}=InsertInTable("borrowers",\%data);
747 # mysql_insertid is probably bad. not necessarily accurate and mysql-specific at best.
748 logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
750 # check for enrollment fee & add it if needed
751 my $sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
752 $sth->execute($data{'categorycode'});
753 my ($enrolmentfee) = $sth->fetchrow;
754 if ($enrolmentfee && $enrolmentfee > 0) {
755 # insert fee in patron debts
756 manualinvoice($data{'borrowernumber'}, '', '', 'A', $enrolmentfee);
758 return $data{'borrowernumber'};
763 my ($uid,$member) = @_;
764 my $dbh = C4::Context->dbh;
765 # Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
766 # Then we need to tell the user and have them create a new one.
769 "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
770 $sth->execute( $uid, $member );
771 if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
779 sub Generate_Userid {
780 my ($borrowernumber, $firstname, $surname) = @_;
784 $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
785 $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
786 $newuid = lc("$firstname.$surname");
787 $newuid .= $offset unless $offset == 0;
790 } while (!Check_Userid($newuid,$borrowernumber));
796 my ( $uid, $member, $digest ) = @_;
797 my $dbh = C4::Context->dbh;
799 #Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
800 #Then we need to tell the user and have them create a new one.
804 "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
805 $sth->execute( $uid, $member );
806 if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
810 #Everything is good so we can update the information.
813 "update borrowers set userid=?, password=? where borrowernumber=?");
814 $sth->execute( $uid, $digest, $member );
818 logaction("MEMBERS", "CHANGE PASS", $member, "") if C4::Context->preference("BorrowersLog");
824 =head2 fixup_cardnumber
826 Warning: The caller is responsible for locking the members table in write
827 mode, to avoid database corruption.
831 use vars qw( @weightings );
832 my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
834 sub fixup_cardnumber ($) {
835 my ($cardnumber) = @_;
836 my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;
838 # Find out whether member numbers should be generated
839 # automatically. Should be either "1" or something else.
840 # Defaults to "0", which is interpreted as "no".
842 # if ($cardnumber !~ /\S/ && $autonumber_members) {
843 ($autonumber_members) or return $cardnumber;
844 my $checkdigit = C4::Context->preference('checkdigit');
845 my $dbh = C4::Context->dbh;
846 if ( $checkdigit and $checkdigit eq 'katipo' ) {
848 # if checkdigit is selected, calculate katipo-style cardnumber.
849 # otherwise, just use the max()
850 # purpose: generate checksum'd member numbers.
851 # We'll assume we just got the max value of digits 2-8 of member #'s
852 # from the database and our job is to increment that by one,
853 # determine the 1st and 9th digits and return the full string.
854 my $sth = $dbh->prepare(
855 "select max(substring(borrowers.cardnumber,2,7)) as new_num from borrowers"
858 my $data = $sth->fetchrow_hashref;
859 $cardnumber = $data->{new_num};
860 if ( !$cardnumber ) { # If DB has no values,
861 $cardnumber = 1000000; # start at 1000000
867 for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
868 # read weightings, left to right, 1 char at a time
869 my $temp1 = $weightings[$i];
871 # sequence left to right, 1 char at a time
872 my $temp2 = substr( $cardnumber, $i, 1 );
874 # mult each char 1-7 by its corresponding weighting
875 $sum += $temp1 * $temp2;
878 my $rem = ( $sum % 11 );
879 $rem = 'X' if $rem == 10;
881 return "V$cardnumber$rem";
884 # MODIFIED BY JF: mysql4.1 allows casting as an integer, which is probably
885 # better. I'll leave the original in in case it needs to be changed for you
886 # my $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers");
887 my $sth = $dbh->prepare(
888 "select max(cast(cardnumber as signed)) from borrowers"
891 my ($result) = $sth->fetchrow;
894 return $cardnumber; # just here as a fallback/reminder
899 ($num_children, $children_arrayref) = &GetGuarantees($parent_borrno);
900 $child0_cardno = $children_arrayref->[0]{"cardnumber"};
901 $child0_borrno = $children_arrayref->[0]{"borrowernumber"};
903 C<&GetGuarantees> takes a borrower number (e.g., that of a patron
904 with children) and looks up the borrowers who are guaranteed by that
905 borrower (i.e., the patron's children).
907 C<&GetGuarantees> returns two values: an integer giving the number of
908 borrowers guaranteed by C<$parent_borrno>, and a reference to an array
909 of references to hash, which gives the actual results.
915 my ($borrowernumber) = @_;
916 my $dbh = C4::Context->dbh;
919 "select cardnumber,borrowernumber, firstname, surname from borrowers where guarantorid=?"
921 $sth->execute($borrowernumber);
924 my $data = $sth->fetchall_arrayref({});
925 return ( scalar(@$data), $data );
928 =head2 UpdateGuarantees
930 &UpdateGuarantees($parent_borrno);
933 C<&UpdateGuarantees> borrower data for an adult and updates all the guarantees
934 with the modified information
939 sub UpdateGuarantees {
941 my $dbh = C4::Context->dbh;
942 my ( $count, $guarantees ) = GetGuarantees( $data{'borrowernumber'} );
943 for ( my $i = 0 ; $i < $count ; $i++ ) {
946 # It looks like the $i is only being returned to handle walking through
947 # the array, which is probably better done as a foreach loop.
949 my $guaquery = qq|UPDATE borrowers
950 SET address='$data{'address'}',fax='$data{'fax'}',
951 B_city='$data{'B_city'}',mobile='$data{'mobile'}',city='$data{'city'}',phone='$data{'phone'}'
952 WHERE borrowernumber='$guarantees->[$i]->{'borrowernumber'}'
954 my $sth3 = $dbh->prepare($guaquery);
958 =head2 GetPendingIssues
960 my $issues = &GetPendingIssues($borrowernumber);
962 Looks up what the patron with the given borrowernumber has borrowed.
964 C<&GetPendingIssues> returns a
965 reference-to-array where each element is a reference-to-hash; the
966 keys are the fields from the C<issues>, C<biblio>, and C<items> tables.
967 The keys include C<biblioitems> fields except marc and marcxml.
972 sub GetPendingIssues {
973 my ($borrowernumber) = @_;
974 # must avoid biblioitems.* to prevent large marc and marcxml fields from killing performance
975 # FIXME: namespace collision: each table has "timestamp" fields. Which one is "timestamp" ?
976 # FIXME: circ/ciculation.pl tries to sort by timestamp!
977 # FIXME: C4::Print::printslip tries to sort by timestamp!
978 # FIXME: namespace collision: other collisions possible.
979 # FIXME: most of this data isn't really being used by callers.
980 my $sth = C4::Context->dbh->prepare(
986 biblioitems.itemtype,
989 biblioitems.publicationyear,
990 biblioitems.publishercode,
991 biblioitems.volumedate,
992 biblioitems.volumedesc,
995 issues.timestamp AS timestamp,
996 issues.renewals AS renewals,
997 items.renewals AS totalrenewals
999 LEFT JOIN items ON items.itemnumber = issues.itemnumber
1000 LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
1001 LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
1004 ORDER BY issues.issuedate"
1006 $sth->execute($borrowernumber);
1007 my $data = $sth->fetchall_arrayref({});
1008 my $today = C4::Dates->new->output('iso');
1010 $_->{date_due} or next;
1011 ($_->{date_due} lt $today) and $_->{overdue} = 1;
1018 $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
1020 Looks up what the patron with the given borrowernumber has borrowed,
1021 and sorts the results.
1023 C<$sortkey> is the name of a field on which to sort the results. This
1024 should be the name of a field in the C<issues>, C<biblio>,
1025 C<biblioitems>, or C<items> table in the Koha database.
1027 C<$limit> is the maximum number of results to return.
1029 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
1030 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
1031 C<items> tables of the Koha database.
1037 my ( $borrowernumber, $order, $limit ) = @_;
1039 #FIXME: sanity-check order and limit
1040 my $dbh = C4::Context->dbh;
1042 "SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1044 LEFT JOIN items on items.itemnumber=issues.itemnumber
1045 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1046 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1047 WHERE borrowernumber=?
1049 SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1051 LEFT JOIN items on items.itemnumber=old_issues.itemnumber
1052 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1053 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1054 WHERE borrowernumber=?
1056 if ( $limit != 0 ) {
1057 $query .= " limit $limit";
1060 my $sth = $dbh->prepare($query);
1061 $sth->execute($borrowernumber, $borrowernumber);
1064 while ( my $data = $sth->fetchrow_hashref ) {
1065 push @result, $data;
1072 =head2 GetMemberAccountRecords
1074 ($total, $acctlines, $count) = &GetMemberAccountRecords($borrowernumber);
1076 Looks up accounting data for the patron with the given borrowernumber.
1078 C<&GetMemberAccountRecords> returns a three-element array. C<$acctlines> is a
1079 reference-to-array, where each element is a reference-to-hash; the
1080 keys are the fields of the C<accountlines> table in the Koha database.
1081 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1082 total amount outstanding for all of the account lines.
1087 sub GetMemberAccountRecords {
1088 my ($borrowernumber,$date) = @_;
1089 my $dbh = C4::Context->dbh;
1095 WHERE borrowernumber=?);
1096 my @bind = ($borrowernumber);
1097 if ($date && $date ne ''){
1098 $strsth.=" AND date < ? ";
1101 $strsth.=" ORDER BY date desc,timestamp DESC";
1102 my $sth= $dbh->prepare( $strsth );
1103 $sth->execute( @bind );
1105 while ( my $data = $sth->fetchrow_hashref ) {
1106 my $biblio = GetBiblioFromItemNumber($data->{itemnumber}) if $data->{itemnumber};
1107 $data->{biblionumber} = $biblio->{biblionumber};
1108 $data->{title} = $biblio->{title};
1109 $acctlines[$numlines] = $data;
1111 $total += int(1000 * $data->{'amountoutstanding'}); # convert float to integer to avoid round-off errors
1114 return ( $total, \@acctlines,$numlines);
1117 =head2 GetBorNotifyAcctRecord
1119 ($count, $acctlines, $total) = &GetBorNotifyAcctRecord($params,$notifyid);
1121 Looks up accounting data for the patron with the given borrowernumber per file number.
1123 (FIXME - I'm not at all sure what this is about.)
1125 C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a
1126 reference-to-array, where each element is a reference-to-hash; the
1127 keys are the fields of the C<accountlines> table in the Koha database.
1128 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1129 total amount outstanding for all of the account lines.
1133 sub GetBorNotifyAcctRecord {
1134 my ( $borrowernumber, $notifyid ) = @_;
1135 my $dbh = C4::Context->dbh;
1138 my $sth = $dbh->prepare(
1141 WHERE borrowernumber=?
1143 AND amountoutstanding != '0'
1144 ORDER BY notify_id,accounttype
1146 # AND (accounttype='FU' OR accounttype='N' OR accounttype='M'OR accounttype='A'OR accounttype='F'OR accounttype='L' OR accounttype='IP' OR accounttype='CH' OR accounttype='RE' OR accounttype='RL')
1148 $sth->execute( $borrowernumber, $notifyid );
1150 while ( my $data = $sth->fetchrow_hashref ) {
1151 $acctlines[$numlines] = $data;
1153 $total += int(100 * $data->{'amountoutstanding'});
1156 return ( $total, \@acctlines, $numlines );
1159 =head2 checkuniquemember (OUEST-PROVENCE)
1161 ($result,$categorycode) = &checkuniquemember($collectivity,$surname,$firstname,$dateofbirth);
1163 Checks that a member exists or not in the database.
1165 C<&result> is nonzero (=exist) or 0 (=does not exist)
1166 C<&categorycode> is from categorycode table
1167 C<&collectivity> is 1 (= we add a collectivity) or 0 (= we add a physical member)
1168 C<&surname> is the surname
1169 C<&firstname> is the firstname (only if collectivity=0)
1170 C<&dateofbirth> is the date of birth in ISO format (only if collectivity=0)
1174 # FIXME: This function is not legitimate. Multiple patrons might have the same first/last name and birthdate.
1175 # This is especially true since first name is not even a required field.
1177 sub checkuniquemember {
1178 my ( $collectivity, $surname, $firstname, $dateofbirth ) = @_;
1179 my $dbh = C4::Context->dbh;
1180 my $request = ($collectivity) ?
1181 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? " :
1183 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=? and dateofbirth=?" :
1184 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=?";
1185 my $sth = $dbh->prepare($request);
1186 if ($collectivity) {
1187 $sth->execute( uc($surname) );
1188 } elsif($dateofbirth){
1189 $sth->execute( uc($surname), ucfirst($firstname), $dateofbirth );
1191 $sth->execute( uc($surname), ucfirst($firstname));
1193 my @data = $sth->fetchrow;
1194 ( $data[0] ) and return $data[0], $data[1];
1198 sub checkcardnumber {
1199 my ($cardnumber,$borrowernumber) = @_;
1200 my $dbh = C4::Context->dbh;
1201 my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
1202 $query .= " AND borrowernumber <> ?" if ($borrowernumber);
1203 my $sth = $dbh->prepare($query);
1204 if ($borrowernumber) {
1205 $sth->execute($cardnumber,$borrowernumber);
1207 $sth->execute($cardnumber);
1209 if (my $data= $sth->fetchrow_hashref()){
1218 =head2 getzipnamecity (OUEST-PROVENCE)
1220 take all info from table city for the fields city and zip
1221 check for the name and the zip code of the city selected
1225 sub getzipnamecity {
1227 my $dbh = C4::Context->dbh;
1230 "select city_name,city_zipcode from cities where cityid=? ");
1231 $sth->execute($cityid);
1232 my @data = $sth->fetchrow;
1233 return $data[0], $data[1];
1237 =head2 getdcity (OUEST-PROVENCE)
1239 recover cityid with city_name condition
1244 my ($city_name) = @_;
1245 my $dbh = C4::Context->dbh;
1246 my $sth = $dbh->prepare("select cityid from cities where city_name=? ");
1247 $sth->execute($city_name);
1248 my $data = $sth->fetchrow;
1252 =head2 GetFirstValidEmailAddress
1254 $email = GetFirstValidEmailAddress($borrowernumber);
1256 Return the first valid email address for a borrower, given the borrowernumber. For now, the order
1257 is defined as email, emailpro, B_email. Returns the empty string if the borrower has no email
1262 sub GetFirstValidEmailAddress {
1263 my $borrowernumber = shift;
1264 my $dbh = C4::Context->dbh;
1265 my $sth = $dbh->prepare( "SELECT email, emailpro, B_email FROM borrowers where borrowernumber = ? ");
1266 $sth->execute( $borrowernumber );
1267 my $data = $sth->fetchrow_hashref;
1269 if ($data->{'email'}) {
1270 return $data->{'email'};
1271 } elsif ($data->{'emailpro'}) {
1272 return $data->{'emailpro'};
1273 } elsif ($data->{'B_email'}) {
1274 return $data->{'B_email'};
1280 =head2 GetExpiryDate
1282 $expirydate = GetExpiryDate($categorycode, $dateenrolled);
1284 Calculate expiry date given a categorycode and starting date. Date argument must be in ISO format.
1285 Return date is also in ISO format.
1290 my ( $categorycode, $dateenrolled ) = @_;
1292 if ($categorycode) {
1293 my $dbh = C4::Context->dbh;
1294 my $sth = $dbh->prepare("SELECT enrolmentperiod,enrolmentperioddate FROM categories WHERE categorycode=?");
1295 $sth->execute($categorycode);
1296 $enrolments = $sth->fetchrow_hashref;
1298 # die "GetExpiryDate: for enrollmentperiod $enrolmentperiod (category '$categorycode') starting $dateenrolled.\n";
1299 my @date = split (/-/,$dateenrolled);
1300 if($enrolments->{enrolmentperiod}){
1301 return sprintf("%04d-%02d-%02d", Add_Delta_YM(@date,0,$enrolments->{enrolmentperiod}));
1303 return $enrolments->{enrolmentperioddate};
1307 =head2 checkuserpassword (OUEST-PROVENCE)
1309 check for the password and login are not used
1310 return the number of record
1311 0=> NOT USED 1=> USED
1315 sub checkuserpassword {
1316 my ( $borrowernumber, $userid, $password ) = @_;
1317 $password = md5_base64($password);
1318 my $dbh = C4::Context->dbh;
1321 "Select count(*) from borrowers where borrowernumber !=? and userid =? and password=? "
1323 $sth->execute( $borrowernumber, $userid, $password );
1324 my $number_rows = $sth->fetchrow;
1325 return $number_rows;
1329 =head2 GetborCatFromCatType
1331 ($codes_arrayref, $labels_hashref) = &GetborCatFromCatType();
1333 Looks up the different types of borrowers in the database. Returns two
1334 elements: a reference-to-array, which lists the borrower category
1335 codes, and a reference-to-hash, which maps the borrower category codes
1336 to category descriptions.
1341 sub GetborCatFromCatType {
1342 my ( $category_type, $action ) = @_;
1343 # FIXME - This API seems both limited and dangerous.
1344 my $dbh = C4::Context->dbh;
1345 my $request = qq| SELECT categorycode,description
1348 ORDER BY categorycode|;
1349 my $sth = $dbh->prepare($request);
1351 $sth->execute($category_type);
1360 while ( my $data = $sth->fetchrow_hashref ) {
1361 push @codes, $data->{'categorycode'};
1362 $labels{ $data->{'categorycode'} } = $data->{'description'};
1364 return ( \@codes, \%labels );
1367 =head2 GetBorrowercategory
1369 $hashref = &GetBorrowercategory($categorycode);
1371 Given the borrower's category code, the function returns the corresponding
1372 data hashref for a comprehensive information display.
1374 $arrayref_hashref = &GetBorrowercategory;
1376 If no category code provided, the function returns all the categories.
1380 sub GetBorrowercategory {
1382 my $dbh = C4::Context->dbh;
1386 "SELECT description,dateofbirthrequired,upperagelimit,category_type
1388 WHERE categorycode = ?"
1390 $sth->execute($catcode);
1392 $sth->fetchrow_hashref;
1396 } # sub getborrowercategory
1398 =head2 GetBorrowercategoryList
1400 $arrayref_hashref = &GetBorrowercategoryList;
1401 If no category code provided, the function returns all the categories.
1405 sub GetBorrowercategoryList {
1406 my $dbh = C4::Context->dbh;
1411 ORDER BY description"
1415 $sth->fetchall_arrayref({});
1417 } # sub getborrowercategory
1419 =head2 ethnicitycategories
1421 ($codes_arrayref, $labels_hashref) = ðnicitycategories();
1423 Looks up the different ethnic types in the database. Returns two
1424 elements: a reference-to-array, which lists the ethnicity codes, and a
1425 reference-to-hash, which maps the ethnicity codes to ethnicity
1432 sub ethnicitycategories {
1433 my $dbh = C4::Context->dbh;
1434 my $sth = $dbh->prepare("Select code,name from ethnicity order by name");
1438 while ( my $data = $sth->fetchrow_hashref ) {
1439 push @codes, $data->{'code'};
1440 $labels{ $data->{'code'} } = $data->{'name'};
1442 return ( \@codes, \%labels );
1447 $ethn_name = &fixEthnicity($ethn_code);
1449 Takes an ethnicity code (e.g., "european" or "pi") and returns the
1450 corresponding descriptive name from the C<ethnicity> table in the
1451 Koha database ("European" or "Pacific Islander").
1458 my $ethnicity = shift;
1459 return unless $ethnicity;
1460 my $dbh = C4::Context->dbh;
1461 my $sth = $dbh->prepare("Select name from ethnicity where code = ?");
1462 $sth->execute($ethnicity);
1463 my $data = $sth->fetchrow_hashref;
1464 return $data->{'name'};
1465 } # sub fixEthnicity
1469 $dateofbirth,$date = &GetAge($date);
1471 this function return the borrowers age with the value of dateofbirth
1477 my ( $date, $date_ref ) = @_;
1479 if ( not defined $date_ref ) {
1480 $date_ref = sprintf( '%04d-%02d-%02d', Today() );
1483 my ( $year1, $month1, $day1 ) = split /-/, $date;
1484 my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
1486 my $age = $year2 - $year1;
1487 if ( $month1 . $day1 > $month2 . $day2 ) {
1494 =head2 get_institutions
1496 $insitutions = get_institutions();
1498 Just returns a list of all the borrowers of type I, borrownumber and name
1503 sub get_institutions {
1504 my $dbh = C4::Context->dbh();
1507 "SELECT borrowernumber,surname FROM borrowers WHERE categorycode=? ORDER BY surname"
1511 while ( my $data = $sth->fetchrow_hashref() ) {
1512 $orgs{ $data->{'borrowernumber'} } = $data;
1516 } # sub get_institutions
1518 =head2 add_member_orgs
1520 add_member_orgs($borrowernumber,$borrowernumbers);
1522 Takes a borrowernumber and a list of other borrowernumbers and inserts them into the borrowers_to_borrowers table
1527 sub add_member_orgs {
1528 my ( $borrowernumber, $otherborrowers ) = @_;
1529 my $dbh = C4::Context->dbh();
1531 "INSERT INTO borrowers_to_borrowers (borrower1,borrower2) VALUES (?,?)";
1532 my $sth = $dbh->prepare($query);
1533 foreach my $otherborrowernumber (@$otherborrowers) {
1534 $sth->execute( $borrowernumber, $otherborrowernumber );
1537 } # sub add_member_orgs
1541 $cityarrayref = GetCities();
1543 Returns an array_ref of the entries in the cities table
1544 If there are entries in the table an empty row is returned
1545 This is currently only used to populate a popup in memberentry
1551 my $dbh = C4::Context->dbh;
1552 my $city_arr = $dbh->selectall_arrayref(
1553 q|SELECT cityid,city_zipcode,city_name FROM cities ORDER BY city_name|,
1555 if ( @{$city_arr} ) {
1556 unshift @{$city_arr}, {
1557 city_zipcode => q{},
1566 =head2 GetSortDetails (OUEST-PROVENCE)
1568 ($lib) = &GetSortDetails($category,$sortvalue);
1570 Returns the authorized value details
1571 C<&$lib>return value of authorized value details
1572 C<&$sortvalue>this is the value of authorized value
1573 C<&$category>this is the value of authorized value category
1577 sub GetSortDetails {
1578 my ( $category, $sortvalue ) = @_;
1579 my $dbh = C4::Context->dbh;
1580 my $query = qq|SELECT lib
1581 FROM authorised_values
1583 AND authorised_value=? |;
1584 my $sth = $dbh->prepare($query);
1585 $sth->execute( $category, $sortvalue );
1586 my $lib = $sth->fetchrow;
1587 return ($lib) if ($lib);
1588 return ($sortvalue) unless ($lib);
1591 =head2 MoveMemberToDeleted
1593 $result = &MoveMemberToDeleted($borrowernumber);
1595 Copy the record from borrowers to deletedborrowers table.
1599 # FIXME: should do it in one SQL statement w/ subquery
1600 # Otherwise, we should return the @data on success
1602 sub MoveMemberToDeleted {
1603 my ($member) = shift or return;
1604 my $dbh = C4::Context->dbh;
1605 my $query = qq|SELECT *
1607 WHERE borrowernumber=?|;
1608 my $sth = $dbh->prepare($query);
1609 $sth->execute($member);
1610 my @data = $sth->fetchrow_array;
1611 (@data) or return; # if we got a bad borrowernumber, there's nothing to insert
1613 $dbh->prepare( "INSERT INTO deletedborrowers VALUES ("
1614 . ( "?," x ( scalar(@data) - 1 ) )
1616 $sth->execute(@data);
1621 DelMember($borrowernumber);
1623 This function remove directly a borrower whitout writing it on deleteborrower.
1624 + Deletes reserves for the borrower
1629 my $dbh = C4::Context->dbh;
1630 my $borrowernumber = shift;
1631 #warn "in delmember with $borrowernumber";
1632 return unless $borrowernumber; # borrowernumber is mandatory.
1634 my $query = qq|DELETE
1636 WHERE borrowernumber=?|;
1637 my $sth = $dbh->prepare($query);
1638 $sth->execute($borrowernumber);
1642 WHERE borrowernumber = ?
1644 $sth = $dbh->prepare($query);
1645 $sth->execute($borrowernumber);
1646 logaction("MEMBERS", "DELETE", $borrowernumber, "") if C4::Context->preference("BorrowersLog");
1650 =head2 ExtendMemberSubscriptionTo (OUEST-PROVENCE)
1652 $date = ExtendMemberSubscriptionTo($borrowerid, $date);
1654 Extending the subscription to a given date or to the expiry date calculated on ISO date.
1659 sub ExtendMemberSubscriptionTo {
1660 my ( $borrowerid,$date) = @_;
1661 my $dbh = C4::Context->dbh;
1662 my $borrower = GetMember('borrowernumber'=>$borrowerid);
1664 $date=POSIX::strftime("%Y-%m-%d",localtime());
1665 $date = GetExpiryDate( $borrower->{'categorycode'}, $date );
1667 my $sth = $dbh->do(<<EOF);
1669 SET dateexpiry='$date'
1670 WHERE borrowernumber='$borrowerid'
1672 # add enrolmentfee if needed
1673 $sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
1674 $sth->execute($borrower->{'categorycode'});
1675 my ($enrolmentfee) = $sth->fetchrow;
1676 if ($enrolmentfee && $enrolmentfee > 0) {
1677 # insert fee in patron debts
1678 manualinvoice($borrower->{'borrowernumber'}, '', '', 'A', $enrolmentfee);
1680 return $date if ($sth);
1684 =head2 GetRoadTypes (OUEST-PROVENCE)
1686 ($idroadtypearrayref, $roadttype_hashref) = &GetRoadTypes();
1688 Looks up the different road type . Returns two
1689 elements: a reference-to-array, which lists the id_roadtype
1690 codes, and a reference-to-hash, which maps the road type of the road .
1695 my $dbh = C4::Context->dbh;
1697 SELECT roadtypeid,road_type
1699 ORDER BY road_type|;
1700 my $sth = $dbh->prepare($query);
1705 # insert empty value to create a empty choice in cgi popup
1707 while ( my $data = $sth->fetchrow_hashref ) {
1709 push @id, $data->{'roadtypeid'};
1710 $roadtype{ $data->{'roadtypeid'} } = $data->{'road_type'};
1713 #test to know if the table contain some records if no the function return nothing
1720 return ( \@id, \%roadtype );
1726 =head2 GetTitles (OUEST-PROVENCE)
1728 ($borrowertitle)= &GetTitles();
1730 Looks up the different title . Returns array with all borrowers title
1735 my @borrowerTitle = split (/,|\|/,C4::Context->preference('BorrowersTitles'));
1736 unshift( @borrowerTitle, "" );
1737 my $count=@borrowerTitle;
1742 return ( \@borrowerTitle);
1746 =head2 GetPatronImage
1748 my ($imagedata, $dberror) = GetPatronImage($cardnumber);
1750 Returns the mimetype and binary image data of the image for the patron with the supplied cardnumber.
1754 sub GetPatronImage {
1755 my ($cardnumber) = @_;
1756 warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1757 my $dbh = C4::Context->dbh;
1758 my $query = 'SELECT mimetype, imagefile FROM patronimage WHERE cardnumber = ?';
1759 my $sth = $dbh->prepare($query);
1760 $sth->execute($cardnumber);
1761 my $imagedata = $sth->fetchrow_hashref;
1762 warn "Database error!" if $sth->errstr;
1763 return $imagedata, $sth->errstr;
1766 =head2 PutPatronImage
1768 PutPatronImage($cardnumber, $mimetype, $imgfile);
1770 Stores patron binary image data and mimetype in database.
1771 NOTE: This function is good for updating images as well as inserting new images in the database.
1775 sub PutPatronImage {
1776 my ($cardnumber, $mimetype, $imgfile) = @_;
1777 warn "Parameters passed in: Cardnumber=$cardnumber, Mimetype=$mimetype, " . ($imgfile ? "Imagefile" : "No Imagefile") if $debug;
1778 my $dbh = C4::Context->dbh;
1779 my $query = "INSERT INTO patronimage (cardnumber, mimetype, imagefile) VALUES (?,?,?) ON DUPLICATE KEY UPDATE imagefile = ?;";
1780 my $sth = $dbh->prepare($query);
1781 $sth->execute($cardnumber,$mimetype,$imgfile,$imgfile);
1782 warn "Error returned inserting $cardnumber.$mimetype." if $sth->errstr;
1783 return $sth->errstr;
1786 =head2 RmPatronImage
1788 my ($dberror) = RmPatronImage($cardnumber);
1790 Removes the image for the patron with the supplied cardnumber.
1795 my ($cardnumber) = @_;
1796 warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1797 my $dbh = C4::Context->dbh;
1798 my $query = "DELETE FROM patronimage WHERE cardnumber = ?;";
1799 my $sth = $dbh->prepare($query);
1800 $sth->execute($cardnumber);
1801 my $dberror = $sth->errstr;
1802 warn "Database error!" if $sth->errstr;
1806 =head2 GetRoadTypeDetails (OUEST-PROVENCE)
1808 ($roadtype) = &GetRoadTypeDetails($roadtypeid);
1810 Returns the description of roadtype
1811 C<&$roadtype>return description of road type
1812 C<&$roadtypeid>this is the value of roadtype s
1816 sub GetRoadTypeDetails {
1817 my ($roadtypeid) = @_;
1818 my $dbh = C4::Context->dbh;
1822 WHERE roadtypeid=?|;
1823 my $sth = $dbh->prepare($query);
1824 $sth->execute($roadtypeid);
1825 my $roadtype = $sth->fetchrow;
1829 =head2 GetBorrowersWhoHaveNotBorrowedSince
1831 &GetBorrowersWhoHaveNotBorrowedSince($date)
1833 this function get all borrowers who haven't borrowed since the date given on input arg.
1837 sub GetBorrowersWhoHaveNotBorrowedSince {
1838 my $filterdate = shift||POSIX::strftime("%Y-%m-%d",localtime());
1839 my $filterexpiry = shift;
1840 my $filterbranch = shift ||
1841 ((C4::Context->preference('IndependantBranches')
1842 && C4::Context->userenv
1843 && C4::Context->userenv->{flags} % 2 !=1
1844 && C4::Context->userenv->{branch})
1845 ? C4::Context->userenv->{branch}
1847 my $dbh = C4::Context->dbh;
1849 SELECT borrowers.borrowernumber,
1850 max(old_issues.timestamp) as latestissue,
1851 max(issues.timestamp) as currentissue
1853 JOIN categories USING (categorycode)
1854 LEFT JOIN old_issues USING (borrowernumber)
1855 LEFT JOIN issues USING (borrowernumber)
1856 WHERE category_type <> 'S'
1857 AND borrowernumber NOT IN (SELECT guarantorid FROM borrowers WHERE guarantorid IS NOT NULL AND guarantorid <> 0)
1860 if ($filterbranch && $filterbranch ne ""){
1861 $query.=" AND borrowers.branchcode= ?";
1862 push @query_params,$filterbranch;
1865 $query .= " AND dateexpiry < ? ";
1866 push @query_params,$filterdate;
1868 $query.=" GROUP BY borrowers.borrowernumber";
1870 $query.=" HAVING (latestissue < ? OR latestissue IS NULL)
1871 AND currentissue IS NULL";
1872 push @query_params,$filterdate;
1874 warn $query if $debug;
1875 my $sth = $dbh->prepare($query);
1876 if (scalar(@query_params)>0){
1877 $sth->execute(@query_params);
1884 while ( my $data = $sth->fetchrow_hashref ) {
1885 push @results, $data;
1890 =head2 GetBorrowersWhoHaveNeverBorrowed
1892 $results = &GetBorrowersWhoHaveNeverBorrowed
1894 This function get all borrowers who have never borrowed.
1896 I<$result> is a ref to an array which all elements are a hasref.
1900 sub GetBorrowersWhoHaveNeverBorrowed {
1901 my $filterbranch = shift ||
1902 ((C4::Context->preference('IndependantBranches')
1903 && C4::Context->userenv
1904 && C4::Context->userenv->{flags} % 2 !=1
1905 && C4::Context->userenv->{branch})
1906 ? C4::Context->userenv->{branch}
1908 my $dbh = C4::Context->dbh;
1910 SELECT borrowers.borrowernumber,max(timestamp) as latestissue
1912 LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
1913 WHERE issues.borrowernumber IS NULL
1916 if ($filterbranch && $filterbranch ne ""){
1917 $query.=" AND borrowers.branchcode= ?";
1918 push @query_params,$filterbranch;
1920 warn $query if $debug;
1922 my $sth = $dbh->prepare($query);
1923 if (scalar(@query_params)>0){
1924 $sth->execute(@query_params);
1931 while ( my $data = $sth->fetchrow_hashref ) {
1932 push @results, $data;
1937 =head2 GetBorrowersWithIssuesHistoryOlderThan
1939 $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
1941 this function get all borrowers who has an issue history older than I<$date> given on input arg.
1943 I<$result> is a ref to an array which all elements are a hashref.
1944 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
1948 sub GetBorrowersWithIssuesHistoryOlderThan {
1949 my $dbh = C4::Context->dbh;
1950 my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
1951 my $filterbranch = shift ||
1952 ((C4::Context->preference('IndependantBranches')
1953 && C4::Context->userenv
1954 && C4::Context->userenv->{flags} % 2 !=1
1955 && C4::Context->userenv->{branch})
1956 ? C4::Context->userenv->{branch}
1959 SELECT count(borrowernumber) as n,borrowernumber
1961 WHERE returndate < ?
1962 AND borrowernumber IS NOT NULL
1965 push @query_params, $date;
1967 $query.=" AND branchcode = ?";
1968 push @query_params, $filterbranch;
1970 $query.=" GROUP BY borrowernumber ";
1971 warn $query if $debug;
1972 my $sth = $dbh->prepare($query);
1973 $sth->execute(@query_params);
1976 while ( my $data = $sth->fetchrow_hashref ) {
1977 push @results, $data;
1982 =head2 GetBorrowersNamesAndLatestIssue
1984 $results = &GetBorrowersNamesAndLatestIssueList(@borrowernumbers)
1986 this function get borrowers Names and surnames and Issue information.
1988 I<@borrowernumbers> is an array which all elements are borrowernumbers.
1989 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
1993 sub GetBorrowersNamesAndLatestIssue {
1994 my $dbh = C4::Context->dbh;
1995 my @borrowernumbers=@_;
1997 SELECT surname,lastname, phone, email,max(timestamp)
1999 LEFT JOIN issues ON borrowers.borrowernumber=issues.borrowernumber
2000 GROUP BY borrowernumber
2002 my $sth = $dbh->prepare($query);
2004 my $results = $sth->fetchall_arrayref({});
2010 my $success = DebarMember( $borrowernumber );
2012 marks a Member as debarred, and therefore unable to checkout any more
2016 true on success, false on failure
2021 my $borrowernumber = shift;
2023 return unless defined $borrowernumber;
2024 return unless $borrowernumber =~ /^\d+$/;
2026 return ModMember( borrowernumber => $borrowernumber,
2033 AddMessage( $borrowernumber, $message_type, $message, $branchcode );
2035 Adds a message to the messages table for the given borrower.
2044 my ( $borrowernumber, $message_type, $message, $branchcode ) = @_;
2046 my $dbh = C4::Context->dbh;
2048 if ( ! ( $borrowernumber && $message_type && $message && $branchcode ) ) {
2052 my $query = "INSERT INTO messages ( borrowernumber, branchcode, message_type, message ) VALUES ( ?, ?, ?, ? )";
2053 my $sth = $dbh->prepare($query);
2054 $sth->execute( $borrowernumber, $branchcode, $message_type, $message );
2061 GetMessages( $borrowernumber, $type );
2063 $type is message type, B for borrower, or L for Librarian.
2064 Empty type returns all messages of any type.
2066 Returns all messages for the given borrowernumber
2071 my ( $borrowernumber, $type, $branchcode ) = @_;
2077 my $dbh = C4::Context->dbh;
2080 branches.branchname,
2082 DATE_FORMAT( message_date, '%m/%d/%Y' ) AS message_date_formatted,
2083 messages.branchcode LIKE '$branchcode' AS can_delete
2084 FROM messages, branches
2085 WHERE borrowernumber = ?
2086 AND message_type LIKE ?
2087 AND messages.branchcode = branches.branchcode
2088 ORDER BY message_date DESC";
2089 my $sth = $dbh->prepare($query);
2090 $sth->execute( $borrowernumber, $type ) ;
2093 while ( my $data = $sth->fetchrow_hashref ) {
2094 push @results, $data;
2102 GetMessagesCount( $borrowernumber, $type );
2104 $type is message type, B for borrower, or L for Librarian.
2105 Empty type returns all messages of any type.
2107 Returns the number of messages for the given borrowernumber
2111 sub GetMessagesCount {
2112 my ( $borrowernumber, $type, $branchcode ) = @_;
2118 my $dbh = C4::Context->dbh;
2120 my $query = "SELECT COUNT(*) as MsgCount FROM messages WHERE borrowernumber = ? AND message_type LIKE ?";
2121 my $sth = $dbh->prepare($query);
2122 $sth->execute( $borrowernumber, $type ) ;
2125 my $data = $sth->fetchrow_hashref;
2126 my $count = $data->{'MsgCount'};
2133 =head2 DeleteMessage
2135 DeleteMessage( $message_id );
2140 my ( $message_id ) = @_;
2142 my $dbh = C4::Context->dbh;
2144 my $query = "DELETE FROM messages WHERE message_id = ?";
2145 my $sth = $dbh->prepare($query);
2146 $sth->execute( $message_id );
2150 END { } # module clean-up code here (global destructor)