3 # Copyright 2000-2003 Katipo Communications
4 # Copyright 2010 BibLibre
6 # This file is part of Koha.
8 # Koha is free software; you can redistribute it and/or modify it under the
9 # terms of the GNU General Public License as published by the Free Software
10 # Foundation; either version 2 of the License, or (at your option) any later
13 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
14 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
15 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License along
18 # with Koha; if not, write to the Free Software Foundation, Inc.,
19 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
23 #use warnings; FIXME - Bug 2505
25 use C4::Dates qw(format_date_in_iso);
26 use Digest::MD5 qw(md5_base64);
27 use Date::Calc qw/Today Add_Delta_YM/;
28 use C4::Log; # logaction
33 use C4::SQLHelper qw(InsertInTable UpdateInTable SearchInTable);
34 use C4::Members::Attributes qw(SearchIdMatchingAttribute);
36 our ($VERSION,@ISA,@EXPORT,@EXPORT_OK,$debug);
40 $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 ($count, $borrowers) = &SearchMember($searchstring, $type,
146 $category_type, $filter, $showallbranches);
148 Looks up patrons (borrowers) by name.
150 BUGFIX 499: C<$type> is now used to determine type of search.
151 if $type is "simple", search is performed on the first letter of the
154 $category_type is used to get a specified type of user.
155 (mainly adults when creating a child.)
157 C<$searchstring> is a space-separated list of search terms. Each term
158 must match the beginning a borrower's surname, first name, or other
161 C<$filter> is assumed to be a list of elements to filter results on
163 C<$showallbranches> is used in IndependantBranches Context to display all branches results.
165 C<&SearchMember> returns a two-element list. C<$borrowers> is a
166 reference-to-array; each element is a reference-to-hash, whose keys
167 are the fields of the C<borrowers> table in the Koha database.
168 C<$count> is the number of elements in C<$borrowers>.
173 #used by member enquiries from the intranet
175 my ($searchstring, $orderby, $type,$category_type,$filter,$showallbranches ) = @_;
176 my $dbh = C4::Context->dbh;
182 # this is used by circulation everytime a new borrowers cardnumber is scanned
183 # so we can check an exact match first, if that works return, otherwise do the rest
184 $query = "SELECT * FROM borrowers
185 LEFT JOIN categories ON borrowers.categorycode=categories.categorycode
187 my $sth = $dbh->prepare("$query WHERE cardnumber = ?");
188 $sth->execute($searchstring);
189 my $data = $sth->fetchall_arrayref({});
191 return ( scalar(@$data), $data );
194 if ( $type eq "simple" ) # simple search for one letter only
196 $query .= ($category_type ? " AND category_type = ".$dbh->quote($category_type) : "");
197 $query .= " WHERE (surname LIKE ? OR cardnumber like ?) ";
198 if (C4::Context->preference("IndependantBranches") && !$showallbranches){
199 if (C4::Context->userenv && C4::Context->userenv->{flags} % 2 !=1 && C4::Context->userenv->{'branch'}){
200 $query.=" AND borrowers.branchcode =".$dbh->quote(C4::Context->userenv->{'branch'}) unless (C4::Context->userenv->{'branch'} eq "insecure");
203 $query.=" ORDER BY $orderby";
204 @bind = ("$searchstring%","$searchstring");
206 else # advanced search looking in surname, firstname and othernames
208 @data = split( ' ', $searchstring );
211 if (C4::Context->preference("IndependantBranches") && !$showallbranches){
212 if (C4::Context->userenv && C4::Context->userenv->{flags} % 2 !=1 && C4::Context->userenv->{'branch'}){
213 $query.=" borrowers.branchcode =".$dbh->quote(C4::Context->userenv->{'branch'})." AND " unless (C4::Context->userenv->{'branch'} eq "insecure");
216 $query.="((surname LIKE ? OR surname LIKE ?
217 OR firstname LIKE ? OR firstname LIKE ?
218 OR othernames LIKE ? OR othernames LIKE ?)
220 ($category_type?" AND category_type = ".$dbh->quote($category_type):"");
222 "$data[0]%", "% $data[0]%", "$data[0]%", "% $data[0]%",
223 "$data[0]%", "% $data[0]%"
225 for ( my $i = 1 ; $i < $count ; $i++ ) {
226 $query = $query . " AND (" . " surname LIKE ? OR surname LIKE ?
227 OR firstname LIKE ? OR firstname LIKE ?
228 OR othernames LIKE ? OR othernames LIKE ?)";
230 "$data[$i]%", "% $data[$i]%", "$data[$i]%",
231 "% $data[$i]%", "$data[$i]%", "% $data[$i]%" );
235 $query = $query . ") OR cardnumber LIKE ? ";
236 push( @bind, $searchstring );
237 $query .= "order by $orderby";
242 $sth = $dbh->prepare($query);
244 $debug and print STDERR "Q $orderby : $query\n";
245 $sth->execute(@bind);
247 $data = $sth->fetchall_arrayref({});
249 return ( scalar(@$data), $data );
254 $borrowers_result_array_ref = &Search($filter,$orderby, $limit,
255 $columns_out, $search_on_fields,$searchtype);
257 Looks up patrons (borrowers) on filter.
259 BUGFIX 499: C<$type> is now used to determine type of search.
260 if $type is "simple", search is performed on the first letter of the
263 $category_type is used to get a specified type of user.
264 (mainly adults when creating a child.)
267 - a space-separated list of search terms. Implicit AND is done on them
268 - a hash ref containing fieldnames associated with queried value
269 - an array ref combining the two previous elements Implicit OR is done between each array element
272 C<$orderby> is an arrayref of hashref. Contains the name of the field and 0 or 1 depending if order is ascending or descending
274 C<$limit> is there to allow limiting number of results returned
276 C<&columns_out> is an array ref to the fieldnames you want to see in the result list
278 C<&search_on_fields> is an array ref to the fieldnames you want to limit search on when you are using string search
280 C<&searchtype> is a string telling the type of search you want todo : start_with, exact or contains are allowed
285 my ( $filter, $orderby, $limit, $columns_out, $search_on_fields, $searchtype ) = @_;
287 my %filtersmatching_record;
289 if ( ref($filter) eq "ARRAY" ) {
290 push @filters, @$filter;
292 push @filters, $filter;
294 if ( C4::Context->preference('ExtendedPatronAttributes') ) {
295 my $matching_records = C4::Members::Attributes::SearchIdMatchingAttribute($filter);
296 if(scalar(@$matching_records)>0) {
297 foreach my $matching_record (@$matching_records) {
298 $filtersmatching_record{$$matching_record[0]}=1;
300 foreach my $k (keys(%filtersmatching_record)) {
301 push @filters, {"borrowernumber"=>$k};
305 $searchtype ||= "start_with";
306 push @finalfilter, \@filters;
307 my $data = SearchInTable( "borrowers", \@finalfilter, $orderby, $limit, $columns_out, $search_on_fields, $searchtype );
311 =head2 GetMemberDetails
313 ($borrower) = &GetMemberDetails($borrowernumber, $cardnumber);
315 Looks up a patron and returns information about him or her. If
316 C<$borrowernumber> is true (nonzero), C<&GetMemberDetails> looks
317 up the borrower by number; otherwise, it looks up the borrower by card
320 C<$borrower> is a reference-to-hash whose keys are the fields of the
321 borrowers table in the Koha database. In addition,
322 C<$borrower-E<gt>{flags}> is a hash giving more detailed information
323 about the patron. Its keys act as flags :
325 if $borrower->{flags}->{LOST} {
326 # Patron's card was reported lost
329 If the state of a flag means that the patron should not be
330 allowed to borrow any more books, then it will have a C<noissues> key
333 See patronflags for more details.
335 C<$borrower-E<gt>{authflags}> is a hash giving more detailed information
336 about the top-level permissions flags set for the borrower. For example,
337 if a user has the "editcatalogue" permission,
338 C<$borrower-E<gt>{authflags}-E<gt>{editcatalogue}> will exist and have
343 sub GetMemberDetails {
344 my ( $borrowernumber, $cardnumber ) = @_;
345 my $dbh = C4::Context->dbh;
348 if ($borrowernumber) {
349 $sth = $dbh->prepare("select borrowers.*,category_type,categories.description from borrowers left join categories on borrowers.categorycode=categories.categorycode where borrowernumber=?");
350 $sth->execute($borrowernumber);
352 elsif ($cardnumber) {
353 $sth = $dbh->prepare("select borrowers.*,category_type,categories.description from borrowers left join categories on borrowers.categorycode=categories.categorycode where cardnumber=?");
354 $sth->execute($cardnumber);
359 my $borrower = $sth->fetchrow_hashref;
360 my ($amount) = GetMemberAccountRecords( $borrowernumber);
361 $borrower->{'amountoutstanding'} = $amount;
362 # FIXME - patronflags calls GetMemberAccountRecords... just have patronflags return $amount
363 my $flags = patronflags( $borrower);
366 $sth = $dbh->prepare("select bit,flag from userflags");
368 while ( my ( $bit, $flag ) = $sth->fetchrow ) {
369 if ( $borrower->{'flags'} && $borrower->{'flags'} & 2**$bit ) {
370 $accessflagshash->{$flag} = 1;
373 $borrower->{'flags'} = $flags;
374 $borrower->{'authflags'} = $accessflagshash;
376 # find out how long the membership lasts
379 "select enrolmentperiod from categories where categorycode = ?");
380 $sth->execute( $borrower->{'categorycode'} );
381 my $enrolment = $sth->fetchrow;
382 $borrower->{'enrolmentperiod'} = $enrolment;
383 return ($borrower); #, $flags, $accessflagshash);
388 $flags = &patronflags($patron);
390 This function is not exported.
392 The following will be set where applicable:
393 $flags->{CHARGES}->{amount} Amount of debt
394 $flags->{CHARGES}->{noissues} Set if debt amount >$5.00 (or syspref noissuescharge)
395 $flags->{CHARGES}->{message} Message -- deprecated
397 $flags->{CREDITS}->{amount} Amount of credit
398 $flags->{CREDITS}->{message} Message -- deprecated
400 $flags->{ GNA } Patron has no valid address
401 $flags->{ GNA }->{noissues} Set for each GNA
402 $flags->{ GNA }->{message} "Borrower has no valid address" -- deprecated
404 $flags->{ LOST } Patron's card reported lost
405 $flags->{ LOST }->{noissues} Set for each LOST
406 $flags->{ LOST }->{message} Message -- deprecated
408 $flags->{DBARRED} Set if patron debarred, no access
409 $flags->{DBARRED}->{noissues} Set for each DBARRED
410 $flags->{DBARRED}->{message} Message -- deprecated
413 $flags->{ NOTES }->{message} The note itself. NOT deprecated
415 $flags->{ ODUES } Set if patron has overdue books.
416 $flags->{ ODUES }->{message} "Yes" -- deprecated
417 $flags->{ ODUES }->{itemlist} ref-to-array: list of overdue books
418 $flags->{ ODUES }->{itemlisttext} Text list of overdue items -- deprecated
420 $flags->{WAITING} Set if any of patron's reserves are available
421 $flags->{WAITING}->{message} Message -- deprecated
422 $flags->{WAITING}->{itemlist} ref-to-array: list of available items
426 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
427 overdue items. Its elements are references-to-hash, each describing an
428 overdue item. The keys are selected fields from the issues, biblio,
429 biblioitems, and items tables of the Koha database.
431 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
432 the overdue items, one per line. Deprecated.
434 =item C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
435 available items. Each element is a reference-to-hash whose keys are
436 fields from the reserves table of the Koha database.
440 All the "message" fields that include language generated in this function are deprecated,
441 because such strings belong properly in the display layer.
443 The "message" field that comes from the DB is OK.
447 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
448 # FIXME rename this function.
451 my ( $patroninformation) = @_;
452 my $dbh=C4::Context->dbh;
453 my ($amount) = GetMemberAccountRecords( $patroninformation->{'borrowernumber'});
456 my $noissuescharge = C4::Context->preference("noissuescharge") || 5;
457 $flaginfo{'message'} = sprintf "Patron owes \$%.02f", $amount;
458 $flaginfo{'amount'} = sprintf "%.02f", $amount;
459 if ( $amount > $noissuescharge && !C4::Context->preference("AllowFineOverride") ) {
460 $flaginfo{'noissues'} = 1;
462 $flags{'CHARGES'} = \%flaginfo;
464 elsif ( $amount < 0 ) {
466 $flaginfo{'message'} = sprintf "Patron has credit of \$%.02f", -$amount;
467 $flaginfo{'amount'} = sprintf "%.02f", $amount;
468 $flags{'CREDITS'} = \%flaginfo;
470 if ( $patroninformation->{'gonenoaddress'}
471 && $patroninformation->{'gonenoaddress'} == 1 )
474 $flaginfo{'message'} = 'Borrower has no valid address.';
475 $flaginfo{'noissues'} = 1;
476 $flags{'GNA'} = \%flaginfo;
478 if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
480 $flaginfo{'message'} = 'Borrower\'s card reported lost.';
481 $flaginfo{'noissues'} = 1;
482 $flags{'LOST'} = \%flaginfo;
484 if ( $patroninformation->{'debarred'}
485 && $patroninformation->{'debarred'} == 1 )
488 $flaginfo{'message'} = 'Borrower is Debarred.';
489 $flaginfo{'noissues'} = 1;
490 $flags{'DBARRED'} = \%flaginfo;
492 if ( $patroninformation->{'borrowernotes'}
493 && $patroninformation->{'borrowernotes'} )
496 $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
497 $flags{'NOTES'} = \%flaginfo;
499 my ( $odues, $itemsoverdue ) = checkoverdues($patroninformation->{'borrowernumber'});
500 if ( $odues && $odues > 0 ) {
502 $flaginfo{'message'} = "Yes";
503 $flaginfo{'itemlist'} = $itemsoverdue;
504 foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
507 $flaginfo{'itemlisttext'} .=
508 "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n"; # newline is display layer
510 $flags{'ODUES'} = \%flaginfo;
512 my @itemswaiting = C4::Reserves::GetReservesFromBorrowernumber( $patroninformation->{'borrowernumber'},'W' );
513 my $nowaiting = scalar @itemswaiting;
514 if ( $nowaiting > 0 ) {
516 $flaginfo{'message'} = "Reserved items available";
517 $flaginfo{'itemlist'} = \@itemswaiting;
518 $flags{'WAITING'} = \%flaginfo;
526 $borrower = &GetMember(%information);
528 Retrieve the first patron record meeting on criteria listed in the
529 C<%information> hash, which should contain one or more
530 pairs of borrowers column names and values, e.g.,
532 $borrower = GetMember(borrowernumber => id);
534 C<&GetBorrower> returns a reference-to-hash whose keys are the fields of
535 the C<borrowers> table in the Koha database.
537 FIXME: GetMember() is used throughout the code as a lookup
538 on a unique key such as the borrowernumber, but this meaning is not
539 enforced in the routine itself.
545 my ( %information ) = @_;
546 if (exists $information{borrowernumber} && !defined $information{borrowernumber}) {
547 #passing mysql's kohaadmin?? Makes no sense as a query
550 my $dbh = C4::Context->dbh;
552 q{SELECT borrowers.*, categories.category_type, categories.description
554 LEFT JOIN categories on borrowers.categorycode=categories.categorycode WHERE };
557 for (keys %information ) {
565 if (defined $information{$_}) {
567 push @values, $information{$_};
570 $select .= "$_ IS NULL";
573 $debug && warn $select, " ",values %information;
574 my $sth = $dbh->prepare("$select");
575 $sth->execute(map{$information{$_}} keys %information);
576 my $data = $sth->fetchall_arrayref({});
577 #FIXME interface to this routine now allows generation of a result set
578 #so whole array should be returned but bowhere in the current code expects this
586 =head2 GetMemberRelatives
588 @borrowernumbers = GetMemberRelatives($borrowernumber);
590 C<GetMemberRelatives> returns a borrowersnumber's list of guarantor/guarantees of the member given in parameter
593 sub GetMemberRelatives {
594 my $borrowernumber = shift;
595 my $dbh = C4::Context->dbh;
599 my $query = "SELECT guarantorid FROM borrowers WHERE borrowernumber=?";
600 my $sth = $dbh->prepare($query);
601 $sth->execute($borrowernumber);
602 my $data = $sth->fetchrow_arrayref();
603 push @glist, $data->[0] if $data->[0];
604 my $guarantor = $data->[0] if $data->[0];
607 $query = "SELECT borrowernumber FROM borrowers WHERE guarantorid=?";
608 $sth = $dbh->prepare($query);
609 $sth->execute($borrowernumber);
610 while ($data = $sth->fetchrow_arrayref()) {
611 push @glist, $data->[0];
614 # Getting sibling guarantees
616 $query = "SELECT borrowernumber FROM borrowers WHERE guarantorid=?";
617 $sth = $dbh->prepare($query);
618 $sth->execute($guarantor);
619 while ($data = $sth->fetchrow_arrayref()) {
620 push @glist, $data->[0] if ($data->[0] != $borrowernumber);
627 =head2 IsMemberBlocked
629 my ($block_status, $count) = IsMemberBlocked( $borrowernumber );
631 Returns whether a patron has overdue items that may result
632 in a block or whether the patron has active fine days
633 that would block circulation privileges.
635 C<$block_status> can have the following values:
637 1 if the patron has outstanding fine days, in which case C<$count> is the number of them
639 -1 if the patron has overdue items, in which case C<$count> is the number of them
641 0 if the patron has no overdue items or outstanding fine days, in which case C<$count> is 0
643 Outstanding fine days are checked before current overdue items
646 FIXME: this needs to be split into two functions; a potential block
647 based on the number of current overdue items could be orthogonal
648 to a block based on whether the patron has any fine days accrued.
652 sub IsMemberBlocked {
653 my $borrowernumber = shift;
654 my $dbh = C4::Context->dbh;
656 # does patron have current fine days?
659 ADDDATE(returndate, finedays * DATEDIFF(returndate,date_due) ) AS blockingdate,
660 DATEDIFF(ADDDATE(returndate, finedays * DATEDIFF(returndate,date_due)),NOW()) AS blockedcount
663 if(C4::Context->preference("item-level_itypes")){
665 qq{ LEFT JOIN items ON (items.itemnumber=old_issues.itemnumber)
666 LEFT JOIN issuingrules ON (issuingrules.itemtype=items.itype)}
669 qq{ LEFT JOIN items ON (items.itemnumber=old_issues.itemnumber)
670 LEFT JOIN biblioitems ON (biblioitems.biblioitemnumber=items.biblioitemnumber)
671 LEFT JOIN issuingrules ON (issuingrules.itemtype=biblioitems.itemtype) };
674 qq{ WHERE finedays IS NOT NULL
675 AND date_due < returndate
676 AND borrowernumber = ?
677 ORDER BY blockingdate DESC, blockedcount DESC
679 my $sth=$dbh->prepare($strsth);
680 $sth->execute($borrowernumber);
681 my $row = $sth->fetchrow_hashref;
682 my $blockeddate = $row->{'blockeddate'};
683 my $blockedcount = $row->{'blockedcount'};
685 return (1, $blockedcount) if $blockedcount > 0;
687 # if he have late issues
688 $sth = $dbh->prepare(
689 "SELECT COUNT(*) as latedocs
691 WHERE borrowernumber = ?
692 AND date_due < curdate()"
694 $sth->execute($borrowernumber);
695 my $latedocs = $sth->fetchrow_hashref->{'latedocs'};
697 return (-1, $latedocs) if $latedocs > 0;
702 =head2 GetMemberIssuesAndFines
704 ($overdue_count, $issue_count, $total_fines) = &GetMemberIssuesAndFines($borrowernumber);
706 Returns aggregate data about items borrowed by the patron with the
707 given borrowernumber.
709 C<&GetMemberIssuesAndFines> returns a three-element array. C<$overdue_count> is the
710 number of overdue items the patron currently has borrowed. C<$issue_count> is the
711 number of books the patron currently has borrowed. C<$total_fines> is
712 the total fine currently due by the borrower.
717 sub GetMemberIssuesAndFines {
718 my ( $borrowernumber ) = @_;
719 my $dbh = C4::Context->dbh;
720 my $query = "SELECT COUNT(*) FROM issues WHERE borrowernumber = ?";
722 $debug and warn $query."\n";
723 my $sth = $dbh->prepare($query);
724 $sth->execute($borrowernumber);
725 my $issue_count = $sth->fetchrow_arrayref->[0];
727 $sth = $dbh->prepare(
728 "SELECT COUNT(*) FROM issues
729 WHERE borrowernumber = ?
730 AND date_due < curdate()"
732 $sth->execute($borrowernumber);
733 my $overdue_count = $sth->fetchrow_arrayref->[0];
735 $sth = $dbh->prepare("SELECT SUM(amountoutstanding) FROM accountlines WHERE borrowernumber = ?");
736 $sth->execute($borrowernumber);
737 my $total_fines = $sth->fetchrow_arrayref->[0];
739 return ($overdue_count, $issue_count, $total_fines);
743 return @{C4::Context->dbh->selectcol_arrayref("SHOW columns from borrowers")};
748 my $success = ModMember(borrowernumber => $borrowernumber,
749 [ field => value ]... );
751 Modify borrower's data. All date fields should ALREADY be in ISO format.
754 true on success, or false on failure
760 # test to know if you must update or not the borrower password
761 if (exists $data{password}) {
762 if ($data{password} eq '****' or $data{password} eq '') {
763 delete $data{password};
765 $data{password} = md5_base64($data{password});
768 my $execute_success=UpdateInTable("borrowers",\%data);
769 # ok if its an adult (type) it may have borrowers that depend on it as a guarantor
770 # so when we update information for an adult we should check for guarantees and update the relevant part
771 # of their records, ie addresses and phone numbers
772 my $borrowercategory= GetBorrowercategory( $data{'category_type'} );
773 if ( exists $borrowercategory->{'category_type'} && $borrowercategory->{'category_type'} eq ('A' || 'S') ) {
774 # is adult check guarantees;
775 UpdateGuarantees(%data);
777 logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "UPDATE (executed w/ arg: $data{'borrowernumber'})")
778 if C4::Context->preference("BorrowersLog");
780 return $execute_success;
786 $borrowernumber = &AddMember(%borrower);
788 insert new borrower into table
789 Returns the borrowernumber
796 my $dbh = C4::Context->dbh;
797 $data{'password'} = '!' if (not $data{'password'} and $data{'userid'});
798 $data{'password'} = md5_base64( $data{'password'} ) if $data{'password'};
799 $data{'borrowernumber'}=InsertInTable("borrowers",\%data);
800 # mysql_insertid is probably bad. not necessarily accurate and mysql-specific at best.
801 logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
803 # check for enrollment fee & add it if needed
804 my $sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
805 $sth->execute($data{'categorycode'});
806 my ($enrolmentfee) = $sth->fetchrow;
807 if ($enrolmentfee && $enrolmentfee > 0) {
808 # insert fee in patron debts
809 manualinvoice($data{'borrowernumber'}, '', '', 'A', $enrolmentfee);
811 return $data{'borrowernumber'};
816 my ($uid,$member) = @_;
817 my $dbh = C4::Context->dbh;
818 # Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
819 # Then we need to tell the user and have them create a new one.
822 "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
823 $sth->execute( $uid, $member );
824 if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
832 sub Generate_Userid {
833 my ($borrowernumber, $firstname, $surname) = @_;
837 $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
838 $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
839 $newuid = lc("$firstname.$surname");
840 $newuid .= $offset unless $offset == 0;
843 } while (!Check_Userid($newuid,$borrowernumber));
849 my ( $uid, $member, $digest ) = @_;
850 my $dbh = C4::Context->dbh;
852 #Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
853 #Then we need to tell the user and have them create a new one.
857 "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
858 $sth->execute( $uid, $member );
859 if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
863 #Everything is good so we can update the information.
866 "update borrowers set userid=?, password=? where borrowernumber=?");
867 $sth->execute( $uid, $digest, $member );
871 logaction("MEMBERS", "CHANGE PASS", $member, "") if C4::Context->preference("BorrowersLog");
877 =head2 fixup_cardnumber
879 Warning: The caller is responsible for locking the members table in write
880 mode, to avoid database corruption.
884 use vars qw( @weightings );
885 my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
887 sub fixup_cardnumber ($) {
888 my ($cardnumber) = @_;
889 my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;
891 # Find out whether member numbers should be generated
892 # automatically. Should be either "1" or something else.
893 # Defaults to "0", which is interpreted as "no".
895 # if ($cardnumber !~ /\S/ && $autonumber_members) {
896 ($autonumber_members) or return $cardnumber;
897 my $checkdigit = C4::Context->preference('checkdigit');
898 my $dbh = C4::Context->dbh;
899 if ( $checkdigit and $checkdigit eq 'katipo' ) {
901 # if checkdigit is selected, calculate katipo-style cardnumber.
902 # otherwise, just use the max()
903 # purpose: generate checksum'd member numbers.
904 # We'll assume we just got the max value of digits 2-8 of member #'s
905 # from the database and our job is to increment that by one,
906 # determine the 1st and 9th digits and return the full string.
907 my $sth = $dbh->prepare(
908 "select max(substring(borrowers.cardnumber,2,7)) as new_num from borrowers"
911 my $data = $sth->fetchrow_hashref;
912 $cardnumber = $data->{new_num};
913 if ( !$cardnumber ) { # If DB has no values,
914 $cardnumber = 1000000; # start at 1000000
920 for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
921 # read weightings, left to right, 1 char at a time
922 my $temp1 = $weightings[$i];
924 # sequence left to right, 1 char at a time
925 my $temp2 = substr( $cardnumber, $i, 1 );
927 # mult each char 1-7 by its corresponding weighting
928 $sum += $temp1 * $temp2;
931 my $rem = ( $sum % 11 );
932 $rem = 'X' if $rem == 10;
934 return "V$cardnumber$rem";
937 # MODIFIED BY JF: mysql4.1 allows casting as an integer, which is probably
938 # better. I'll leave the original in in case it needs to be changed for you
939 # my $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers");
940 my $sth = $dbh->prepare(
941 "select max(cast(cardnumber as signed)) from borrowers"
944 my ($result) = $sth->fetchrow;
947 return $cardnumber; # just here as a fallback/reminder
952 ($num_children, $children_arrayref) = &GetGuarantees($parent_borrno);
953 $child0_cardno = $children_arrayref->[0]{"cardnumber"};
954 $child0_borrno = $children_arrayref->[0]{"borrowernumber"};
956 C<&GetGuarantees> takes a borrower number (e.g., that of a patron
957 with children) and looks up the borrowers who are guaranteed by that
958 borrower (i.e., the patron's children).
960 C<&GetGuarantees> returns two values: an integer giving the number of
961 borrowers guaranteed by C<$parent_borrno>, and a reference to an array
962 of references to hash, which gives the actual results.
968 my ($borrowernumber) = @_;
969 my $dbh = C4::Context->dbh;
972 "select cardnumber,borrowernumber, firstname, surname from borrowers where guarantorid=?"
974 $sth->execute($borrowernumber);
977 my $data = $sth->fetchall_arrayref({});
978 return ( scalar(@$data), $data );
981 =head2 UpdateGuarantees
983 &UpdateGuarantees($parent_borrno);
986 C<&UpdateGuarantees> borrower data for an adult and updates all the guarantees
987 with the modified information
992 sub UpdateGuarantees {
994 my $dbh = C4::Context->dbh;
995 my ( $count, $guarantees ) = GetGuarantees( $data{'borrowernumber'} );
996 foreach my $guarantee (@$guarantees){
997 my $guaquery = qq|UPDATE borrowers
998 SET address=?,fax=?,B_city=?,mobile=?,city=?,phone=?
999 WHERE borrowernumber=?
1001 my $sth = $dbh->prepare($guaquery);
1002 $sth->execute($data{'address'},$data{'fax'},$data{'B_city'},$data{'mobile'},$data{'city'},$data{'phone'},$guarantee->{'borrowernumber'});
1005 =head2 GetPendingIssues
1007 my $issues = &GetPendingIssues(@borrowernumber);
1009 Looks up what the patron with the given borrowernumber has borrowed.
1011 C<&GetPendingIssues> returns a
1012 reference-to-array where each element is a reference-to-hash; the
1013 keys are the fields from the C<issues>, C<biblio>, and C<items> tables.
1014 The keys include C<biblioitems> fields except marc and marcxml.
1019 sub GetPendingIssues {
1020 my (@borrowernumbers) = @_;
1022 # Borrowers part of the query
1024 for (my $i = 0; $i < @borrowernumbers; $i++) {
1025 $bquery .= " borrowernumber = ?";
1026 $bquery .= " OR" if ($i < (scalar(@borrowernumbers) - 1));
1029 # must avoid biblioitems.* to prevent large marc and marcxml fields from killing performance
1030 # FIXME: namespace collision: each table has "timestamp" fields. Which one is "timestamp" ?
1031 # FIXME: circ/ciculation.pl tries to sort by timestamp!
1032 # FIXME: C4::Print::printslip tries to sort by timestamp!
1033 # FIXME: namespace collision: other collisions possible.
1034 # FIXME: most of this data isn't really being used by callers.
1041 biblioitems.itemtype,
1044 biblioitems.publicationyear,
1045 biblioitems.publishercode,
1046 biblioitems.volumedate,
1047 biblioitems.volumedesc,
1050 issues.timestamp AS timestamp,
1051 issues.renewals AS renewals,
1052 issues.borrowernumber AS borrowernumber,
1053 items.renewals AS totalrenewals
1055 LEFT JOIN items ON items.itemnumber = issues.itemnumber
1056 LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
1057 LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
1060 ORDER BY issues.issuedate"
1063 my $sth = C4::Context->dbh->prepare($query);
1064 $sth->execute(@borrowernumbers);
1065 my $data = $sth->fetchall_arrayref({});
1066 my $today = C4::Dates->new->output('iso');
1068 $_->{date_due} or next;
1069 ($_->{date_due} lt $today) and $_->{overdue} = 1;
1076 $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
1078 Looks up what the patron with the given borrowernumber has borrowed,
1079 and sorts the results.
1081 C<$sortkey> is the name of a field on which to sort the results. This
1082 should be the name of a field in the C<issues>, C<biblio>,
1083 C<biblioitems>, or C<items> table in the Koha database.
1085 C<$limit> is the maximum number of results to return.
1087 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
1088 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
1089 C<items> tables of the Koha database.
1095 my ( $borrowernumber, $order, $limit ) = @_;
1097 #FIXME: sanity-check order and limit
1098 my $dbh = C4::Context->dbh;
1100 "SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1102 LEFT JOIN items on items.itemnumber=issues.itemnumber
1103 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1104 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1105 WHERE borrowernumber=?
1107 SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1109 LEFT JOIN items on items.itemnumber=old_issues.itemnumber
1110 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1111 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1112 WHERE borrowernumber=?
1114 if ( $limit != 0 ) {
1115 $query .= " limit $limit";
1118 my $sth = $dbh->prepare($query);
1119 $sth->execute($borrowernumber, $borrowernumber);
1122 while ( my $data = $sth->fetchrow_hashref ) {
1123 push @result, $data;
1130 =head2 GetMemberAccountRecords
1132 ($total, $acctlines, $count) = &GetMemberAccountRecords($borrowernumber);
1134 Looks up accounting data for the patron with the given borrowernumber.
1136 C<&GetMemberAccountRecords> returns a three-element array. C<$acctlines> is a
1137 reference-to-array, where each element is a reference-to-hash; the
1138 keys are the fields of the C<accountlines> table in the Koha database.
1139 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1140 total amount outstanding for all of the account lines.
1145 sub GetMemberAccountRecords {
1146 my ($borrowernumber,$date) = @_;
1147 my $dbh = C4::Context->dbh;
1153 WHERE borrowernumber=?);
1154 my @bind = ($borrowernumber);
1155 if ($date && $date ne ''){
1156 $strsth.=" AND date < ? ";
1159 $strsth.=" ORDER BY date desc,timestamp DESC";
1160 my $sth= $dbh->prepare( $strsth );
1161 $sth->execute( @bind );
1163 while ( my $data = $sth->fetchrow_hashref ) {
1164 my $biblio = GetBiblioFromItemNumber($data->{itemnumber}) if $data->{itemnumber};
1165 $data->{biblionumber} = $biblio->{biblionumber};
1166 $data->{title} = $biblio->{title};
1167 $acctlines[$numlines] = $data;
1169 $total += int(1000 * $data->{'amountoutstanding'}); # convert float to integer to avoid round-off errors
1172 return ( $total, \@acctlines,$numlines);
1175 =head2 GetBorNotifyAcctRecord
1177 ($count, $acctlines, $total) = &GetBorNotifyAcctRecord($params,$notifyid);
1179 Looks up accounting data for the patron with the given borrowernumber per file number.
1181 (FIXME - I'm not at all sure what this is about.)
1183 C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a
1184 reference-to-array, where each element is a reference-to-hash; the
1185 keys are the fields of the C<accountlines> table in the Koha database.
1186 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1187 total amount outstanding for all of the account lines.
1191 sub GetBorNotifyAcctRecord {
1192 my ( $borrowernumber, $notifyid ) = @_;
1193 my $dbh = C4::Context->dbh;
1196 my $sth = $dbh->prepare(
1199 WHERE borrowernumber=?
1201 AND amountoutstanding != '0'
1202 ORDER BY notify_id,accounttype
1204 # 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')
1206 $sth->execute( $borrowernumber, $notifyid );
1208 while ( my $data = $sth->fetchrow_hashref ) {
1209 $acctlines[$numlines] = $data;
1211 $total += int(100 * $data->{'amountoutstanding'});
1214 return ( $total, \@acctlines, $numlines );
1217 =head2 checkuniquemember (OUEST-PROVENCE)
1219 ($result,$categorycode) = &checkuniquemember($collectivity,$surname,$firstname,$dateofbirth);
1221 Checks that a member exists or not in the database.
1223 C<&result> is nonzero (=exist) or 0 (=does not exist)
1224 C<&categorycode> is from categorycode table
1225 C<&collectivity> is 1 (= we add a collectivity) or 0 (= we add a physical member)
1226 C<&surname> is the surname
1227 C<&firstname> is the firstname (only if collectivity=0)
1228 C<&dateofbirth> is the date of birth in ISO format (only if collectivity=0)
1232 # FIXME: This function is not legitimate. Multiple patrons might have the same first/last name and birthdate.
1233 # This is especially true since first name is not even a required field.
1235 sub checkuniquemember {
1236 my ( $collectivity, $surname, $firstname, $dateofbirth ) = @_;
1237 my $dbh = C4::Context->dbh;
1238 my $request = ($collectivity) ?
1239 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? " :
1241 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=? and dateofbirth=?" :
1242 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=?";
1243 my $sth = $dbh->prepare($request);
1244 if ($collectivity) {
1245 $sth->execute( uc($surname) );
1246 } elsif($dateofbirth){
1247 $sth->execute( uc($surname), ucfirst($firstname), $dateofbirth );
1249 $sth->execute( uc($surname), ucfirst($firstname));
1251 my @data = $sth->fetchrow;
1252 ( $data[0] ) and return $data[0], $data[1];
1256 sub checkcardnumber {
1257 my ($cardnumber,$borrowernumber) = @_;
1258 my $dbh = C4::Context->dbh;
1259 my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
1260 $query .= " AND borrowernumber <> ?" if ($borrowernumber);
1261 my $sth = $dbh->prepare($query);
1262 if ($borrowernumber) {
1263 $sth->execute($cardnumber,$borrowernumber);
1265 $sth->execute($cardnumber);
1267 if (my $data= $sth->fetchrow_hashref()){
1276 =head2 getzipnamecity (OUEST-PROVENCE)
1278 take all info from table city for the fields city and zip
1279 check for the name and the zip code of the city selected
1283 sub getzipnamecity {
1285 my $dbh = C4::Context->dbh;
1288 "select city_name,city_zipcode from cities where cityid=? ");
1289 $sth->execute($cityid);
1290 my @data = $sth->fetchrow;
1291 return $data[0], $data[1];
1295 =head2 getdcity (OUEST-PROVENCE)
1297 recover cityid with city_name condition
1302 my ($city_name) = @_;
1303 my $dbh = C4::Context->dbh;
1304 my $sth = $dbh->prepare("select cityid from cities where city_name=? ");
1305 $sth->execute($city_name);
1306 my $data = $sth->fetchrow;
1310 =head2 GetFirstValidEmailAddress
1312 $email = GetFirstValidEmailAddress($borrowernumber);
1314 Return the first valid email address for a borrower, given the borrowernumber. For now, the order
1315 is defined as email, emailpro, B_email. Returns the empty string if the borrower has no email
1320 sub GetFirstValidEmailAddress {
1321 my $borrowernumber = shift;
1322 my $dbh = C4::Context->dbh;
1323 my $sth = $dbh->prepare( "SELECT email, emailpro, B_email FROM borrowers where borrowernumber = ? ");
1324 $sth->execute( $borrowernumber );
1325 my $data = $sth->fetchrow_hashref;
1327 if ($data->{'email'}) {
1328 return $data->{'email'};
1329 } elsif ($data->{'emailpro'}) {
1330 return $data->{'emailpro'};
1331 } elsif ($data->{'B_email'}) {
1332 return $data->{'B_email'};
1338 =head2 GetExpiryDate
1340 $expirydate = GetExpiryDate($categorycode, $dateenrolled);
1342 Calculate expiry date given a categorycode and starting date. Date argument must be in ISO format.
1343 Return date is also in ISO format.
1348 my ( $categorycode, $dateenrolled ) = @_;
1350 if ($categorycode) {
1351 my $dbh = C4::Context->dbh;
1352 my $sth = $dbh->prepare("SELECT enrolmentperiod,enrolmentperioddate FROM categories WHERE categorycode=?");
1353 $sth->execute($categorycode);
1354 $enrolments = $sth->fetchrow_hashref;
1356 # die "GetExpiryDate: for enrollmentperiod $enrolmentperiod (category '$categorycode') starting $dateenrolled.\n";
1357 my @date = split (/-/,$dateenrolled);
1358 if($enrolments->{enrolmentperiod}){
1359 return sprintf("%04d-%02d-%02d", Add_Delta_YM(@date,0,$enrolments->{enrolmentperiod}));
1361 return $enrolments->{enrolmentperioddate};
1365 =head2 checkuserpassword (OUEST-PROVENCE)
1367 check for the password and login are not used
1368 return the number of record
1369 0=> NOT USED 1=> USED
1373 sub checkuserpassword {
1374 my ( $borrowernumber, $userid, $password ) = @_;
1375 $password = md5_base64($password);
1376 my $dbh = C4::Context->dbh;
1379 "Select count(*) from borrowers where borrowernumber !=? and userid =? and password=? "
1381 $sth->execute( $borrowernumber, $userid, $password );
1382 my $number_rows = $sth->fetchrow;
1383 return $number_rows;
1387 =head2 GetborCatFromCatType
1389 ($codes_arrayref, $labels_hashref) = &GetborCatFromCatType();
1391 Looks up the different types of borrowers in the database. Returns two
1392 elements: a reference-to-array, which lists the borrower category
1393 codes, and a reference-to-hash, which maps the borrower category codes
1394 to category descriptions.
1399 sub GetborCatFromCatType {
1400 my ( $category_type, $action ) = @_;
1401 # FIXME - This API seems both limited and dangerous.
1402 my $dbh = C4::Context->dbh;
1403 my $request = qq| SELECT categorycode,description
1406 ORDER BY categorycode|;
1407 my $sth = $dbh->prepare($request);
1409 $sth->execute($category_type);
1418 while ( my $data = $sth->fetchrow_hashref ) {
1419 push @codes, $data->{'categorycode'};
1420 $labels{ $data->{'categorycode'} } = $data->{'description'};
1422 return ( \@codes, \%labels );
1425 =head2 GetBorrowercategory
1427 $hashref = &GetBorrowercategory($categorycode);
1429 Given the borrower's category code, the function returns the corresponding
1430 data hashref for a comprehensive information display.
1432 $arrayref_hashref = &GetBorrowercategory;
1434 If no category code provided, the function returns all the categories.
1438 sub GetBorrowercategory {
1440 my $dbh = C4::Context->dbh;
1444 "SELECT description,dateofbirthrequired,upperagelimit,category_type
1446 WHERE categorycode = ?"
1448 $sth->execute($catcode);
1450 $sth->fetchrow_hashref;
1454 } # sub getborrowercategory
1456 =head2 GetBorrowercategoryList
1458 $arrayref_hashref = &GetBorrowercategoryList;
1459 If no category code provided, the function returns all the categories.
1463 sub GetBorrowercategoryList {
1464 my $dbh = C4::Context->dbh;
1469 ORDER BY description"
1473 $sth->fetchall_arrayref({});
1475 } # sub getborrowercategory
1477 =head2 ethnicitycategories
1479 ($codes_arrayref, $labels_hashref) = ðnicitycategories();
1481 Looks up the different ethnic types in the database. Returns two
1482 elements: a reference-to-array, which lists the ethnicity codes, and a
1483 reference-to-hash, which maps the ethnicity codes to ethnicity
1490 sub ethnicitycategories {
1491 my $dbh = C4::Context->dbh;
1492 my $sth = $dbh->prepare("Select code,name from ethnicity order by name");
1496 while ( my $data = $sth->fetchrow_hashref ) {
1497 push @codes, $data->{'code'};
1498 $labels{ $data->{'code'} } = $data->{'name'};
1500 return ( \@codes, \%labels );
1505 $ethn_name = &fixEthnicity($ethn_code);
1507 Takes an ethnicity code (e.g., "european" or "pi") and returns the
1508 corresponding descriptive name from the C<ethnicity> table in the
1509 Koha database ("European" or "Pacific Islander").
1516 my $ethnicity = shift;
1517 return unless $ethnicity;
1518 my $dbh = C4::Context->dbh;
1519 my $sth = $dbh->prepare("Select name from ethnicity where code = ?");
1520 $sth->execute($ethnicity);
1521 my $data = $sth->fetchrow_hashref;
1522 return $data->{'name'};
1523 } # sub fixEthnicity
1527 $dateofbirth,$date = &GetAge($date);
1529 this function return the borrowers age with the value of dateofbirth
1535 my ( $date, $date_ref ) = @_;
1537 if ( not defined $date_ref ) {
1538 $date_ref = sprintf( '%04d-%02d-%02d', Today() );
1541 my ( $year1, $month1, $day1 ) = split /-/, $date;
1542 my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
1544 my $age = $year2 - $year1;
1545 if ( $month1 . $day1 > $month2 . $day2 ) {
1552 =head2 get_institutions
1554 $insitutions = get_institutions();
1556 Just returns a list of all the borrowers of type I, borrownumber and name
1561 sub get_institutions {
1562 my $dbh = C4::Context->dbh();
1565 "SELECT borrowernumber,surname FROM borrowers WHERE categorycode=? ORDER BY surname"
1569 while ( my $data = $sth->fetchrow_hashref() ) {
1570 $orgs{ $data->{'borrowernumber'} } = $data;
1574 } # sub get_institutions
1576 =head2 add_member_orgs
1578 add_member_orgs($borrowernumber,$borrowernumbers);
1580 Takes a borrowernumber and a list of other borrowernumbers and inserts them into the borrowers_to_borrowers table
1585 sub add_member_orgs {
1586 my ( $borrowernumber, $otherborrowers ) = @_;
1587 my $dbh = C4::Context->dbh();
1589 "INSERT INTO borrowers_to_borrowers (borrower1,borrower2) VALUES (?,?)";
1590 my $sth = $dbh->prepare($query);
1591 foreach my $otherborrowernumber (@$otherborrowers) {
1592 $sth->execute( $borrowernumber, $otherborrowernumber );
1595 } # sub add_member_orgs
1599 $cityarrayref = GetCities();
1601 Returns an array_ref of the entries in the cities table
1602 If there are entries in the table an empty row is returned
1603 This is currently only used to populate a popup in memberentry
1609 my $dbh = C4::Context->dbh;
1610 my $city_arr = $dbh->selectall_arrayref(
1611 q|SELECT cityid,city_zipcode,city_name FROM cities ORDER BY city_name|,
1613 if ( @{$city_arr} ) {
1614 unshift @{$city_arr}, {
1615 city_zipcode => q{},
1624 =head2 GetSortDetails (OUEST-PROVENCE)
1626 ($lib) = &GetSortDetails($category,$sortvalue);
1628 Returns the authorized value details
1629 C<&$lib>return value of authorized value details
1630 C<&$sortvalue>this is the value of authorized value
1631 C<&$category>this is the value of authorized value category
1635 sub GetSortDetails {
1636 my ( $category, $sortvalue ) = @_;
1637 my $dbh = C4::Context->dbh;
1638 my $query = qq|SELECT lib
1639 FROM authorised_values
1641 AND authorised_value=? |;
1642 my $sth = $dbh->prepare($query);
1643 $sth->execute( $category, $sortvalue );
1644 my $lib = $sth->fetchrow;
1645 return ($lib) if ($lib);
1646 return ($sortvalue) unless ($lib);
1649 =head2 MoveMemberToDeleted
1651 $result = &MoveMemberToDeleted($borrowernumber);
1653 Copy the record from borrowers to deletedborrowers table.
1657 # FIXME: should do it in one SQL statement w/ subquery
1658 # Otherwise, we should return the @data on success
1660 sub MoveMemberToDeleted {
1661 my ($member) = shift or return;
1662 my $dbh = C4::Context->dbh;
1663 my $query = qq|SELECT *
1665 WHERE borrowernumber=?|;
1666 my $sth = $dbh->prepare($query);
1667 $sth->execute($member);
1668 my @data = $sth->fetchrow_array;
1669 (@data) or return; # if we got a bad borrowernumber, there's nothing to insert
1671 $dbh->prepare( "INSERT INTO deletedborrowers VALUES ("
1672 . ( "?," x ( scalar(@data) - 1 ) )
1674 $sth->execute(@data);
1679 DelMember($borrowernumber);
1681 This function remove directly a borrower whitout writing it on deleteborrower.
1682 + Deletes reserves for the borrower
1687 my $dbh = C4::Context->dbh;
1688 my $borrowernumber = shift;
1689 #warn "in delmember with $borrowernumber";
1690 return unless $borrowernumber; # borrowernumber is mandatory.
1692 my $query = qq|DELETE
1694 WHERE borrowernumber=?|;
1695 my $sth = $dbh->prepare($query);
1696 $sth->execute($borrowernumber);
1700 WHERE borrowernumber = ?
1702 $sth = $dbh->prepare($query);
1703 $sth->execute($borrowernumber);
1704 logaction("MEMBERS", "DELETE", $borrowernumber, "") if C4::Context->preference("BorrowersLog");
1708 =head2 ExtendMemberSubscriptionTo (OUEST-PROVENCE)
1710 $date = ExtendMemberSubscriptionTo($borrowerid, $date);
1712 Extending the subscription to a given date or to the expiry date calculated on ISO date.
1717 sub ExtendMemberSubscriptionTo {
1718 my ( $borrowerid,$date) = @_;
1719 my $dbh = C4::Context->dbh;
1720 my $borrower = GetMember('borrowernumber'=>$borrowerid);
1722 $date=POSIX::strftime("%Y-%m-%d",localtime());
1723 $date = GetExpiryDate( $borrower->{'categorycode'}, $date );
1725 my $sth = $dbh->do(<<EOF);
1727 SET dateexpiry='$date'
1728 WHERE borrowernumber='$borrowerid'
1730 # add enrolmentfee if needed
1731 $sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
1732 $sth->execute($borrower->{'categorycode'});
1733 my ($enrolmentfee) = $sth->fetchrow;
1734 if ($enrolmentfee && $enrolmentfee > 0) {
1735 # insert fee in patron debts
1736 manualinvoice($borrower->{'borrowernumber'}, '', '', 'A', $enrolmentfee);
1738 return $date if ($sth);
1742 =head2 GetRoadTypes (OUEST-PROVENCE)
1744 ($idroadtypearrayref, $roadttype_hashref) = &GetRoadTypes();
1746 Looks up the different road type . Returns two
1747 elements: a reference-to-array, which lists the id_roadtype
1748 codes, and a reference-to-hash, which maps the road type of the road .
1753 my $dbh = C4::Context->dbh;
1755 SELECT roadtypeid,road_type
1757 ORDER BY road_type|;
1758 my $sth = $dbh->prepare($query);
1763 # insert empty value to create a empty choice in cgi popup
1765 while ( my $data = $sth->fetchrow_hashref ) {
1767 push @id, $data->{'roadtypeid'};
1768 $roadtype{ $data->{'roadtypeid'} } = $data->{'road_type'};
1771 #test to know if the table contain some records if no the function return nothing
1778 return ( \@id, \%roadtype );
1784 =head2 GetTitles (OUEST-PROVENCE)
1786 ($borrowertitle)= &GetTitles();
1788 Looks up the different title . Returns array with all borrowers title
1793 my @borrowerTitle = split (/,|\|/,C4::Context->preference('BorrowersTitles'));
1794 unshift( @borrowerTitle, "" );
1795 my $count=@borrowerTitle;
1800 return ( \@borrowerTitle);
1804 =head2 GetPatronImage
1806 my ($imagedata, $dberror) = GetPatronImage($cardnumber);
1808 Returns the mimetype and binary image data of the image for the patron with the supplied cardnumber.
1812 sub GetPatronImage {
1813 my ($cardnumber) = @_;
1814 warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1815 my $dbh = C4::Context->dbh;
1816 my $query = 'SELECT mimetype, imagefile FROM patronimage WHERE cardnumber = ?';
1817 my $sth = $dbh->prepare($query);
1818 $sth->execute($cardnumber);
1819 my $imagedata = $sth->fetchrow_hashref;
1820 warn "Database error!" if $sth->errstr;
1821 return $imagedata, $sth->errstr;
1824 =head2 PutPatronImage
1826 PutPatronImage($cardnumber, $mimetype, $imgfile);
1828 Stores patron binary image data and mimetype in database.
1829 NOTE: This function is good for updating images as well as inserting new images in the database.
1833 sub PutPatronImage {
1834 my ($cardnumber, $mimetype, $imgfile) = @_;
1835 warn "Parameters passed in: Cardnumber=$cardnumber, Mimetype=$mimetype, " . ($imgfile ? "Imagefile" : "No Imagefile") if $debug;
1836 my $dbh = C4::Context->dbh;
1837 my $query = "INSERT INTO patronimage (cardnumber, mimetype, imagefile) VALUES (?,?,?) ON DUPLICATE KEY UPDATE imagefile = ?;";
1838 my $sth = $dbh->prepare($query);
1839 $sth->execute($cardnumber,$mimetype,$imgfile,$imgfile);
1840 warn "Error returned inserting $cardnumber.$mimetype." if $sth->errstr;
1841 return $sth->errstr;
1844 =head2 RmPatronImage
1846 my ($dberror) = RmPatronImage($cardnumber);
1848 Removes the image for the patron with the supplied cardnumber.
1853 my ($cardnumber) = @_;
1854 warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1855 my $dbh = C4::Context->dbh;
1856 my $query = "DELETE FROM patronimage WHERE cardnumber = ?;";
1857 my $sth = $dbh->prepare($query);
1858 $sth->execute($cardnumber);
1859 my $dberror = $sth->errstr;
1860 warn "Database error!" if $sth->errstr;
1864 =head2 GetHideLostItemsPreference
1866 $hidelostitemspref = &GetHideLostItemsPreference($borrowernumber);
1868 Returns the HideLostItems preference for the patron category of the supplied borrowernumber
1869 C<&$hidelostitemspref>return value of function, 0 or 1
1873 sub GetHideLostItemsPreference {
1874 my ($borrowernumber) = @_;
1875 my $dbh = C4::Context->dbh;
1876 my $query = "SELECT hidelostitems FROM borrowers,categories WHERE borrowers.categorycode = categories.categorycode AND borrowernumber = ?";
1877 my $sth = $dbh->prepare($query);
1878 $sth->execute($borrowernumber);
1879 my $hidelostitems = $sth->fetchrow;
1880 return $hidelostitems;
1883 =head2 GetRoadTypeDetails (OUEST-PROVENCE)
1885 ($roadtype) = &GetRoadTypeDetails($roadtypeid);
1887 Returns the description of roadtype
1888 C<&$roadtype>return description of road type
1889 C<&$roadtypeid>this is the value of roadtype s
1893 sub GetRoadTypeDetails {
1894 my ($roadtypeid) = @_;
1895 my $dbh = C4::Context->dbh;
1899 WHERE roadtypeid=?|;
1900 my $sth = $dbh->prepare($query);
1901 $sth->execute($roadtypeid);
1902 my $roadtype = $sth->fetchrow;
1906 =head2 GetBorrowersWhoHaveNotBorrowedSince
1908 &GetBorrowersWhoHaveNotBorrowedSince($date)
1910 this function get all borrowers who haven't borrowed since the date given on input arg.
1914 sub GetBorrowersWhoHaveNotBorrowedSince {
1915 my $filterdate = shift||POSIX::strftime("%Y-%m-%d",localtime());
1916 my $filterexpiry = shift;
1917 my $filterbranch = shift ||
1918 ((C4::Context->preference('IndependantBranches')
1919 && C4::Context->userenv
1920 && C4::Context->userenv->{flags} % 2 !=1
1921 && C4::Context->userenv->{branch})
1922 ? C4::Context->userenv->{branch}
1924 my $dbh = C4::Context->dbh;
1926 SELECT borrowers.borrowernumber,
1927 max(old_issues.timestamp) as latestissue,
1928 max(issues.timestamp) as currentissue
1930 JOIN categories USING (categorycode)
1931 LEFT JOIN old_issues USING (borrowernumber)
1932 LEFT JOIN issues USING (borrowernumber)
1933 WHERE category_type <> 'S'
1934 AND borrowernumber NOT IN (SELECT guarantorid FROM borrowers WHERE guarantorid IS NOT NULL AND guarantorid <> 0)
1937 if ($filterbranch && $filterbranch ne ""){
1938 $query.=" AND borrowers.branchcode= ?";
1939 push @query_params,$filterbranch;
1942 $query .= " AND dateexpiry < ? ";
1943 push @query_params,$filterdate;
1945 $query.=" GROUP BY borrowers.borrowernumber";
1947 $query.=" HAVING (latestissue < ? OR latestissue IS NULL)
1948 AND currentissue IS NULL";
1949 push @query_params,$filterdate;
1951 warn $query if $debug;
1952 my $sth = $dbh->prepare($query);
1953 if (scalar(@query_params)>0){
1954 $sth->execute(@query_params);
1961 while ( my $data = $sth->fetchrow_hashref ) {
1962 push @results, $data;
1967 =head2 GetBorrowersWhoHaveNeverBorrowed
1969 $results = &GetBorrowersWhoHaveNeverBorrowed
1971 This function get all borrowers who have never borrowed.
1973 I<$result> is a ref to an array which all elements are a hasref.
1977 sub GetBorrowersWhoHaveNeverBorrowed {
1978 my $filterbranch = shift ||
1979 ((C4::Context->preference('IndependantBranches')
1980 && C4::Context->userenv
1981 && C4::Context->userenv->{flags} % 2 !=1
1982 && C4::Context->userenv->{branch})
1983 ? C4::Context->userenv->{branch}
1985 my $dbh = C4::Context->dbh;
1987 SELECT borrowers.borrowernumber,max(timestamp) as latestissue
1989 LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
1990 WHERE issues.borrowernumber IS NULL
1993 if ($filterbranch && $filterbranch ne ""){
1994 $query.=" AND borrowers.branchcode= ?";
1995 push @query_params,$filterbranch;
1997 warn $query if $debug;
1999 my $sth = $dbh->prepare($query);
2000 if (scalar(@query_params)>0){
2001 $sth->execute(@query_params);
2008 while ( my $data = $sth->fetchrow_hashref ) {
2009 push @results, $data;
2014 =head2 GetBorrowersWithIssuesHistoryOlderThan
2016 $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
2018 this function get all borrowers who has an issue history older than I<$date> given on input arg.
2020 I<$result> is a ref to an array which all elements are a hashref.
2021 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2025 sub GetBorrowersWithIssuesHistoryOlderThan {
2026 my $dbh = C4::Context->dbh;
2027 my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
2028 my $filterbranch = shift ||
2029 ((C4::Context->preference('IndependantBranches')
2030 && C4::Context->userenv
2031 && C4::Context->userenv->{flags} % 2 !=1
2032 && C4::Context->userenv->{branch})
2033 ? C4::Context->userenv->{branch}
2036 SELECT count(borrowernumber) as n,borrowernumber
2038 WHERE returndate < ?
2039 AND borrowernumber IS NOT NULL
2042 push @query_params, $date;
2044 $query.=" AND branchcode = ?";
2045 push @query_params, $filterbranch;
2047 $query.=" GROUP BY borrowernumber ";
2048 warn $query if $debug;
2049 my $sth = $dbh->prepare($query);
2050 $sth->execute(@query_params);
2053 while ( my $data = $sth->fetchrow_hashref ) {
2054 push @results, $data;
2059 =head2 GetBorrowersNamesAndLatestIssue
2061 $results = &GetBorrowersNamesAndLatestIssueList(@borrowernumbers)
2063 this function get borrowers Names and surnames and Issue information.
2065 I<@borrowernumbers> is an array which all elements are borrowernumbers.
2066 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2070 sub GetBorrowersNamesAndLatestIssue {
2071 my $dbh = C4::Context->dbh;
2072 my @borrowernumbers=@_;
2074 SELECT surname,lastname, phone, email,max(timestamp)
2076 LEFT JOIN issues ON borrowers.borrowernumber=issues.borrowernumber
2077 GROUP BY borrowernumber
2079 my $sth = $dbh->prepare($query);
2081 my $results = $sth->fetchall_arrayref({});
2087 my $success = DebarMember( $borrowernumber );
2089 marks a Member as debarred, and therefore unable to checkout any more
2093 true on success, false on failure
2098 my $borrowernumber = shift;
2100 return unless defined $borrowernumber;
2101 return unless $borrowernumber =~ /^\d+$/;
2103 return ModMember( borrowernumber => $borrowernumber,
2112 my $success = ModPrivacy( $borrowernumber, $privacy );
2114 Update the privacy of a patron.
2117 true on success, false on failure
2124 my $borrowernumber = shift;
2125 my $privacy = shift;
2126 return unless defined $borrowernumber;
2127 return unless $borrowernumber =~ /^\d+$/;
2129 return ModMember( borrowernumber => $borrowernumber,
2130 privacy => $privacy );
2135 AddMessage( $borrowernumber, $message_type, $message, $branchcode );
2137 Adds a message to the messages table for the given borrower.
2146 my ( $borrowernumber, $message_type, $message, $branchcode ) = @_;
2148 my $dbh = C4::Context->dbh;
2150 if ( ! ( $borrowernumber && $message_type && $message && $branchcode ) ) {
2154 my $query = "INSERT INTO messages ( borrowernumber, branchcode, message_type, message ) VALUES ( ?, ?, ?, ? )";
2155 my $sth = $dbh->prepare($query);
2156 $sth->execute( $borrowernumber, $branchcode, $message_type, $message );
2163 GetMessages( $borrowernumber, $type );
2165 $type is message type, B for borrower, or L for Librarian.
2166 Empty type returns all messages of any type.
2168 Returns all messages for the given borrowernumber
2173 my ( $borrowernumber, $type, $branchcode ) = @_;
2179 my $dbh = C4::Context->dbh;
2182 branches.branchname,
2185 messages.branchcode LIKE '$branchcode' AS can_delete
2186 FROM messages, branches
2187 WHERE borrowernumber = ?
2188 AND message_type LIKE ?
2189 AND messages.branchcode = branches.branchcode
2190 ORDER BY message_date DESC";
2191 my $sth = $dbh->prepare($query);
2192 $sth->execute( $borrowernumber, $type ) ;
2195 while ( my $data = $sth->fetchrow_hashref ) {
2196 my $d = C4::Dates->new( $data->{message_date}, 'iso' );
2197 $data->{message_date_formatted} = $d->output;
2198 push @results, $data;
2206 GetMessagesCount( $borrowernumber, $type );
2208 $type is message type, B for borrower, or L for Librarian.
2209 Empty type returns all messages of any type.
2211 Returns the number of messages for the given borrowernumber
2215 sub GetMessagesCount {
2216 my ( $borrowernumber, $type, $branchcode ) = @_;
2222 my $dbh = C4::Context->dbh;
2224 my $query = "SELECT COUNT(*) as MsgCount FROM messages WHERE borrowernumber = ? AND message_type LIKE ?";
2225 my $sth = $dbh->prepare($query);
2226 $sth->execute( $borrowernumber, $type ) ;
2229 my $data = $sth->fetchrow_hashref;
2230 my $count = $data->{'MsgCount'};
2237 =head2 DeleteMessage
2239 DeleteMessage( $message_id );
2244 my ( $message_id ) = @_;
2246 my $dbh = C4::Context->dbh;
2248 my $query = "DELETE FROM messages WHERE message_id = ?";
2249 my $sth = $dbh->prepare($query);
2250 $sth->execute( $message_id );
2254 END { } # module clean-up code here (global destructor)