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
109 &ExtendMemberSubscriptionTo
127 C4::Members - Perl Module containing convenience functions for member handling
135 This module contains routines for adding, modifying and deleting members/patrons/borrowers
141 ($count, $borrowers) = &SearchMember($searchstring, $type,
142 $category_type, $filter, $showallbranches);
144 Looks up patrons (borrowers) by name.
146 BUGFIX 499: C<$type> is now used to determine type of search.
147 if $type is "simple", search is performed on the first letter of the
150 $category_type is used to get a specified type of user.
151 (mainly adults when creating a child.)
153 C<$searchstring> is a space-separated list of search terms. Each term
154 must match the beginning a borrower's surname, first name, or other
157 C<$filter> is assumed to be a list of elements to filter results on
159 C<$showallbranches> is used in IndependantBranches Context to display all branches results.
161 C<&SearchMember> returns a two-element list. C<$borrowers> is a
162 reference-to-array; each element is a reference-to-hash, whose keys
163 are the fields of the C<borrowers> table in the Koha database.
164 C<$count> is the number of elements in C<$borrowers>.
169 #used by member enquiries from the intranet
171 my ($searchstring, $orderby, $type,$category_type,$filter,$showallbranches ) = @_;
172 my $dbh = C4::Context->dbh;
178 # this is used by circulation everytime a new borrowers cardnumber is scanned
179 # so we can check an exact match first, if that works return, otherwise do the rest
180 $query = "SELECT * FROM borrowers
181 LEFT JOIN categories ON borrowers.categorycode=categories.categorycode
183 my $sth = $dbh->prepare("$query WHERE cardnumber = ?");
184 $sth->execute($searchstring);
185 my $data = $sth->fetchall_arrayref({});
187 return ( scalar(@$data), $data );
190 if ( $type eq "simple" ) # simple search for one letter only
192 $query .= ($category_type ? " AND category_type = ".$dbh->quote($category_type) : "");
193 $query .= " WHERE (surname LIKE ? OR cardnumber like ?) ";
194 if (C4::Context->preference("IndependantBranches") && !$showallbranches){
195 if (C4::Context->userenv && C4::Context->userenv->{flags} % 2 !=1 && C4::Context->userenv->{'branch'}){
196 $query.=" AND borrowers.branchcode =".$dbh->quote(C4::Context->userenv->{'branch'}) unless (C4::Context->userenv->{'branch'} eq "insecure");
199 $query.=" ORDER BY $orderby";
200 @bind = ("$searchstring%","$searchstring");
202 else # advanced search looking in surname, firstname and othernames
204 @data = split( ' ', $searchstring );
207 if (C4::Context->preference("IndependantBranches") && !$showallbranches){
208 if (C4::Context->userenv && C4::Context->userenv->{flags} % 2 !=1 && C4::Context->userenv->{'branch'}){
209 $query.=" borrowers.branchcode =".$dbh->quote(C4::Context->userenv->{'branch'})." AND " unless (C4::Context->userenv->{'branch'} eq "insecure");
212 $query.="((surname LIKE ? OR surname LIKE ?
213 OR firstname LIKE ? OR firstname LIKE ?
214 OR othernames LIKE ? OR othernames LIKE ?)
216 ($category_type?" AND category_type = ".$dbh->quote($category_type):"");
218 "$data[0]%", "% $data[0]%", "$data[0]%", "% $data[0]%",
219 "$data[0]%", "% $data[0]%"
221 for ( my $i = 1 ; $i < $count ; $i++ ) {
222 $query = $query . " AND (" . " surname LIKE ? OR surname LIKE ?
223 OR firstname LIKE ? OR firstname LIKE ?
224 OR othernames LIKE ? OR othernames LIKE ?)";
226 "$data[$i]%", "% $data[$i]%", "$data[$i]%",
227 "% $data[$i]%", "$data[$i]%", "% $data[$i]%" );
231 $query = $query . ") OR cardnumber LIKE ? ";
232 push( @bind, $searchstring );
233 $query .= "order by $orderby";
238 $sth = $dbh->prepare($query);
240 $debug and print STDERR "Q $orderby : $query\n";
241 $sth->execute(@bind);
243 $data = $sth->fetchall_arrayref({});
245 return ( scalar(@$data), $data );
250 $borrowers_result_array_ref = &Search($filter,$orderby, $limit,
251 $columns_out, $search_on_fields,$searchtype);
253 Looks up patrons (borrowers) on filter.
255 BUGFIX 499: C<$type> is now used to determine type of search.
256 if $type is "simple", search is performed on the first letter of the
259 $category_type is used to get a specified type of user.
260 (mainly adults when creating a child.)
263 - a space-separated list of search terms. Implicit AND is done on them
264 - a hash ref containing fieldnames associated with queried value
265 - an array ref combining the two previous elements Implicit OR is done between each array element
268 C<$orderby> is an arrayref of hashref. Contains the name of the field and 0 or 1 depending if order is ascending or descending
270 C<$limit> is there to allow limiting number of results returned
272 C<&columns_out> is an array ref to the fieldnames you want to see in the result list
274 C<&search_on_fields> is an array ref to the fieldnames you want to limit search on when you are using string search
276 C<&searchtype> is a string telling the type of search you want todo : start_with, exact or contains are allowed
281 my ($filter,$orderby, $limit, $columns_out, $search_on_fields,$searchtype) = @_;
283 if (ref($filter) eq "ARRAY"){
284 push @filters,@$filter;
287 push @filters,$filter;
289 if (C4::Context->preference('ExtendedPatronAttributes')) {
290 my $matching_records = C4::Members::Attributes::SearchIdMatchingAttribute($filter);
291 push @filters,@$matching_records;
293 $searchtype||="start_with";
294 my $data=SearchInTable("borrowers",\@filters,$orderby,$limit,$columns_out,$search_on_fields,$searchtype);
299 =head2 GetMemberDetails
301 ($borrower) = &GetMemberDetails($borrowernumber, $cardnumber);
303 Looks up a patron and returns information about him or her. If
304 C<$borrowernumber> is true (nonzero), C<&GetMemberDetails> looks
305 up the borrower by number; otherwise, it looks up the borrower by card
308 C<$borrower> is a reference-to-hash whose keys are the fields of the
309 borrowers table in the Koha database. In addition,
310 C<$borrower-E<gt>{flags}> is a hash giving more detailed information
311 about the patron. Its keys act as flags :
313 if $borrower->{flags}->{LOST} {
314 # Patron's card was reported lost
317 If the state of a flag means that the patron should not be
318 allowed to borrow any more books, then it will have a C<noissues> key
321 See patronflags for more details.
323 C<$borrower-E<gt>{authflags}> is a hash giving more detailed information
324 about the top-level permissions flags set for the borrower. For example,
325 if a user has the "editcatalogue" permission,
326 C<$borrower-E<gt>{authflags}-E<gt>{editcatalogue}> will exist and have
331 sub GetMemberDetails {
332 my ( $borrowernumber, $cardnumber ) = @_;
333 my $dbh = C4::Context->dbh;
336 if ($borrowernumber) {
337 $sth = $dbh->prepare("select borrowers.*,category_type,categories.description from borrowers left join categories on borrowers.categorycode=categories.categorycode where borrowernumber=?");
338 $sth->execute($borrowernumber);
340 elsif ($cardnumber) {
341 $sth = $dbh->prepare("select borrowers.*,category_type,categories.description from borrowers left join categories on borrowers.categorycode=categories.categorycode where cardnumber=?");
342 $sth->execute($cardnumber);
347 my $borrower = $sth->fetchrow_hashref;
348 my ($amount) = GetMemberAccountRecords( $borrowernumber);
349 $borrower->{'amountoutstanding'} = $amount;
350 # FIXME - patronflags calls GetMemberAccountRecords... just have patronflags return $amount
351 my $flags = patronflags( $borrower);
354 $sth = $dbh->prepare("select bit,flag from userflags");
356 while ( my ( $bit, $flag ) = $sth->fetchrow ) {
357 if ( $borrower->{'flags'} && $borrower->{'flags'} & 2**$bit ) {
358 $accessflagshash->{$flag} = 1;
361 $borrower->{'flags'} = $flags;
362 $borrower->{'authflags'} = $accessflagshash;
364 # find out how long the membership lasts
367 "select enrolmentperiod from categories where categorycode = ?");
368 $sth->execute( $borrower->{'categorycode'} );
369 my $enrolment = $sth->fetchrow;
370 $borrower->{'enrolmentperiod'} = $enrolment;
371 return ($borrower); #, $flags, $accessflagshash);
376 $flags = &patronflags($patron);
378 This function is not exported.
380 The following will be set where applicable:
381 $flags->{CHARGES}->{amount} Amount of debt
382 $flags->{CHARGES}->{noissues} Set if debt amount >$5.00 (or syspref noissuescharge)
383 $flags->{CHARGES}->{message} Message -- deprecated
385 $flags->{CREDITS}->{amount} Amount of credit
386 $flags->{CREDITS}->{message} Message -- deprecated
388 $flags->{ GNA } Patron has no valid address
389 $flags->{ GNA }->{noissues} Set for each GNA
390 $flags->{ GNA }->{message} "Borrower has no valid address" -- deprecated
392 $flags->{ LOST } Patron's card reported lost
393 $flags->{ LOST }->{noissues} Set for each LOST
394 $flags->{ LOST }->{message} Message -- deprecated
396 $flags->{DBARRED} Set if patron debarred, no access
397 $flags->{DBARRED}->{noissues} Set for each DBARRED
398 $flags->{DBARRED}->{message} Message -- deprecated
401 $flags->{ NOTES }->{message} The note itself. NOT deprecated
403 $flags->{ ODUES } Set if patron has overdue books.
404 $flags->{ ODUES }->{message} "Yes" -- deprecated
405 $flags->{ ODUES }->{itemlist} ref-to-array: list of overdue books
406 $flags->{ ODUES }->{itemlisttext} Text list of overdue items -- deprecated
408 $flags->{WAITING} Set if any of patron's reserves are available
409 $flags->{WAITING}->{message} Message -- deprecated
410 $flags->{WAITING}->{itemlist} ref-to-array: list of available items
414 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
415 overdue items. Its elements are references-to-hash, each describing an
416 overdue item. The keys are selected fields from the issues, biblio,
417 biblioitems, and items tables of the Koha database.
419 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
420 the overdue items, one per line. Deprecated.
422 =item C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
423 available items. Each element is a reference-to-hash whose keys are
424 fields from the reserves table of the Koha database.
428 All the "message" fields that include language generated in this function are deprecated,
429 because such strings belong properly in the display layer.
431 The "message" field that comes from the DB is OK.
435 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
436 # FIXME rename this function.
439 my ( $patroninformation) = @_;
440 my $dbh=C4::Context->dbh;
441 my ($amount) = GetMemberAccountRecords( $patroninformation->{'borrowernumber'});
444 my $noissuescharge = C4::Context->preference("noissuescharge") || 5;
445 $flaginfo{'message'} = sprintf "Patron owes \$%.02f", $amount;
446 $flaginfo{'amount'} = sprintf "%.02f", $amount;
447 if ( $amount > $noissuescharge ) {
448 $flaginfo{'noissues'} = 1;
450 $flags{'CHARGES'} = \%flaginfo;
452 elsif ( $amount < 0 ) {
454 $flaginfo{'message'} = sprintf "Patron has credit of \$%.02f", -$amount;
455 $flaginfo{'amount'} = sprintf "%.02f", $amount;
456 $flags{'CREDITS'} = \%flaginfo;
458 if ( $patroninformation->{'gonenoaddress'}
459 && $patroninformation->{'gonenoaddress'} == 1 )
462 $flaginfo{'message'} = 'Borrower has no valid address.';
463 $flaginfo{'noissues'} = 1;
464 $flags{'GNA'} = \%flaginfo;
466 if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
468 $flaginfo{'message'} = 'Borrower\'s card reported lost.';
469 $flaginfo{'noissues'} = 1;
470 $flags{'LOST'} = \%flaginfo;
472 if ( $patroninformation->{'debarred'}
473 && $patroninformation->{'debarred'} == 1 )
476 $flaginfo{'message'} = 'Borrower is Debarred.';
477 $flaginfo{'noissues'} = 1;
478 $flags{'DBARRED'} = \%flaginfo;
480 if ( $patroninformation->{'borrowernotes'}
481 && $patroninformation->{'borrowernotes'} )
484 $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
485 $flags{'NOTES'} = \%flaginfo;
487 my ( $odues, $itemsoverdue ) = checkoverdues($patroninformation->{'borrowernumber'});
488 if ( $odues && $odues > 0 ) {
490 $flaginfo{'message'} = "Yes";
491 $flaginfo{'itemlist'} = $itemsoverdue;
492 foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
495 $flaginfo{'itemlisttext'} .=
496 "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n"; # newline is display layer
498 $flags{'ODUES'} = \%flaginfo;
500 my @itemswaiting = C4::Reserves::GetReservesFromBorrowernumber( $patroninformation->{'borrowernumber'},'W' );
501 my $nowaiting = scalar @itemswaiting;
502 if ( $nowaiting > 0 ) {
504 $flaginfo{'message'} = "Reserved items available";
505 $flaginfo{'itemlist'} = \@itemswaiting;
506 $flags{'WAITING'} = \%flaginfo;
514 $borrower = &GetMember(%information);
516 Retrieve the first patron record meeting on criteria listed in the
517 C<%information> hash, which should contain one or more
518 pairs of borrowers column names and values, e.g.,
520 $borrower = GetMember(borrowernumber => id);
522 C<&GetBorrower> returns a reference-to-hash whose keys are the fields of
523 the C<borrowers> table in the Koha database.
525 FIXME: GetMember() is used throughout the code as a lookup
526 on a unique key such as the borrowernumber, but this meaning is not
527 enforced in the routine itself.
533 my ( %information ) = @_;
534 if (exists $information{borrowernumber} && !defined $information{borrowernumber}) {
535 #passing mysql's kohaadmin?? Makes no sense as a query
538 my $dbh = C4::Context->dbh;
540 q{SELECT borrowers.*, categories.category_type, categories.description
542 LEFT JOIN categories on borrowers.categorycode=categories.categorycode WHERE };
545 for (keys %information ) {
553 if (defined $information{$_}) {
555 push @values, $information{$_};
558 $select .= "$_ IS NULL";
561 $debug && warn $select, " ",values %information;
562 my $sth = $dbh->prepare("$select");
563 $sth->execute(map{$information{$_}} keys %information);
564 my $data = $sth->fetchall_arrayref({});
565 #FIXME interface to this routine now allows generation of a result set
566 #so whole array should be returned but bowhere in the current code expects this
575 =head2 IsMemberBlocked
577 my ($block_status, $count) = IsMemberBlocked( $borrowernumber );
579 Returns whether a patron has overdue items that may result
580 in a block or whether the patron has active fine days
581 that would block circulation privileges.
583 C<$block_status> can have the following values:
585 1 if the patron has outstanding fine days, in which case C<$count> is the number of them
587 -1 if the patron has overdue items, in which case C<$count> is the number of them
589 0 if the patron has no overdue items or outstanding fine days, in which case C<$count> is 0
591 Outstanding fine days are checked before current overdue items
594 FIXME: this needs to be split into two functions; a potential block
595 based on the number of current overdue items could be orthogonal
596 to a block based on whether the patron has any fine days accrued.
600 sub IsMemberBlocked {
601 my $borrowernumber = shift;
602 my $dbh = C4::Context->dbh;
604 # does patron have current fine days?
607 ADDDATE(returndate, finedays * DATEDIFF(returndate,date_due) ) AS blockingdate,
608 DATEDIFF(ADDDATE(returndate, finedays * DATEDIFF(returndate,date_due)),NOW()) AS blockedcount
611 if(C4::Context->preference("item-level_itypes")){
613 qq{ LEFT JOIN items ON (items.itemnumber=old_issues.itemnumber)
614 LEFT JOIN issuingrules ON (issuingrules.itemtype=items.itype)}
617 qq{ LEFT JOIN items ON (items.itemnumber=old_issues.itemnumber)
618 LEFT JOIN biblioitems ON (biblioitems.biblioitemnumber=items.biblioitemnumber)
619 LEFT JOIN issuingrules ON (issuingrules.itemtype=biblioitems.itemtype) };
622 qq{ WHERE finedays IS NOT NULL
623 AND date_due < returndate
624 AND borrowernumber = ?
625 ORDER BY blockingdate DESC, blockedcount DESC
627 my $sth=$dbh->prepare($strsth);
628 $sth->execute($borrowernumber);
629 my $row = $sth->fetchrow_hashref;
630 my $blockeddate = $row->{'blockeddate'};
631 my $blockedcount = $row->{'blockedcount'};
633 return (1, $blockedcount) if $blockedcount > 0;
635 # if he have late issues
636 $sth = $dbh->prepare(
637 "SELECT COUNT(*) as latedocs
639 WHERE borrowernumber = ?
640 AND date_due < curdate()"
642 $sth->execute($borrowernumber);
643 my $latedocs = $sth->fetchrow_hashref->{'latedocs'};
645 return (-1, $latedocs) if $latedocs > 0;
650 =head2 GetMemberIssuesAndFines
652 ($overdue_count, $issue_count, $total_fines) = &GetMemberIssuesAndFines($borrowernumber);
654 Returns aggregate data about items borrowed by the patron with the
655 given borrowernumber.
657 C<&GetMemberIssuesAndFines> returns a three-element array. C<$overdue_count> is the
658 number of overdue items the patron currently has borrowed. C<$issue_count> is the
659 number of books the patron currently has borrowed. C<$total_fines> is
660 the total fine currently due by the borrower.
665 sub GetMemberIssuesAndFines {
666 my ( $borrowernumber ) = @_;
667 my $dbh = C4::Context->dbh;
668 my $query = "SELECT COUNT(*) FROM issues WHERE borrowernumber = ?";
670 $debug and warn $query."\n";
671 my $sth = $dbh->prepare($query);
672 $sth->execute($borrowernumber);
673 my $issue_count = $sth->fetchrow_arrayref->[0];
675 $sth = $dbh->prepare(
676 "SELECT COUNT(*) FROM issues
677 WHERE borrowernumber = ?
678 AND date_due < curdate()"
680 $sth->execute($borrowernumber);
681 my $overdue_count = $sth->fetchrow_arrayref->[0];
683 $sth = $dbh->prepare("SELECT SUM(amountoutstanding) FROM accountlines WHERE borrowernumber = ?");
684 $sth->execute($borrowernumber);
685 my $total_fines = $sth->fetchrow_arrayref->[0];
687 return ($overdue_count, $issue_count, $total_fines);
691 return @{C4::Context->dbh->selectcol_arrayref("SHOW columns from borrowers")};
696 my $success = ModMember(borrowernumber => $borrowernumber,
697 [ field => value ]... );
699 Modify borrower's data. All date fields should ALREADY be in ISO format.
702 true on success, or false on failure
708 # test to know if you must update or not the borrower password
709 if (exists $data{password}) {
710 if ($data{password} eq '****' or $data{password} eq '') {
711 delete $data{password};
713 $data{password} = md5_base64($data{password});
716 my $execute_success=UpdateInTable("borrowers",\%data);
717 # ok if its an adult (type) it may have borrowers that depend on it as a guarantor
718 # so when we update information for an adult we should check for guarantees and update the relevant part
719 # of their records, ie addresses and phone numbers
720 my $borrowercategory= GetBorrowercategory( $data{'category_type'} );
721 if ( exists $borrowercategory->{'category_type'} && $borrowercategory->{'category_type'} eq ('A' || 'S') ) {
722 # is adult check guarantees;
723 UpdateGuarantees(%data);
725 logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "UPDATE (executed w/ arg: $data{'borrowernumber'})")
726 if C4::Context->preference("BorrowersLog");
728 return $execute_success;
734 $borrowernumber = &AddMember(%borrower);
736 insert new borrower into table
737 Returns the borrowernumber
744 my $dbh = C4::Context->dbh;
745 $data{'password'} = '!' if (not $data{'password'} and $data{'userid'});
746 $data{'password'} = md5_base64( $data{'password'} ) if $data{'password'};
747 $data{'borrowernumber'}=InsertInTable("borrowers",\%data);
748 # mysql_insertid is probably bad. not necessarily accurate and mysql-specific at best.
749 logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
751 # check for enrollment fee & add it if needed
752 my $sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
753 $sth->execute($data{'categorycode'});
754 my ($enrolmentfee) = $sth->fetchrow;
755 if ($enrolmentfee && $enrolmentfee > 0) {
756 # insert fee in patron debts
757 manualinvoice($data{'borrowernumber'}, '', '', 'A', $enrolmentfee);
759 return $data{'borrowernumber'};
764 my ($uid,$member) = @_;
765 my $dbh = C4::Context->dbh;
766 # Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
767 # Then we need to tell the user and have them create a new one.
770 "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
771 $sth->execute( $uid, $member );
772 if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
780 sub Generate_Userid {
781 my ($borrowernumber, $firstname, $surname) = @_;
785 $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
786 $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
787 $newuid = lc("$firstname.$surname");
788 $newuid .= $offset unless $offset == 0;
791 } while (!Check_Userid($newuid,$borrowernumber));
797 my ( $uid, $member, $digest ) = @_;
798 my $dbh = C4::Context->dbh;
800 #Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
801 #Then we need to tell the user and have them create a new one.
805 "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
806 $sth->execute( $uid, $member );
807 if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
811 #Everything is good so we can update the information.
814 "update borrowers set userid=?, password=? where borrowernumber=?");
815 $sth->execute( $uid, $digest, $member );
819 logaction("MEMBERS", "CHANGE PASS", $member, "") if C4::Context->preference("BorrowersLog");
825 =head2 fixup_cardnumber
827 Warning: The caller is responsible for locking the members table in write
828 mode, to avoid database corruption.
832 use vars qw( @weightings );
833 my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
835 sub fixup_cardnumber ($) {
836 my ($cardnumber) = @_;
837 my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;
839 # Find out whether member numbers should be generated
840 # automatically. Should be either "1" or something else.
841 # Defaults to "0", which is interpreted as "no".
843 # if ($cardnumber !~ /\S/ && $autonumber_members) {
844 ($autonumber_members) or return $cardnumber;
845 my $checkdigit = C4::Context->preference('checkdigit');
846 my $dbh = C4::Context->dbh;
847 if ( $checkdigit and $checkdigit eq 'katipo' ) {
849 # if checkdigit is selected, calculate katipo-style cardnumber.
850 # otherwise, just use the max()
851 # purpose: generate checksum'd member numbers.
852 # We'll assume we just got the max value of digits 2-8 of member #'s
853 # from the database and our job is to increment that by one,
854 # determine the 1st and 9th digits and return the full string.
855 my $sth = $dbh->prepare(
856 "select max(substring(borrowers.cardnumber,2,7)) as new_num from borrowers"
859 my $data = $sth->fetchrow_hashref;
860 $cardnumber = $data->{new_num};
861 if ( !$cardnumber ) { # If DB has no values,
862 $cardnumber = 1000000; # start at 1000000
868 for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
869 # read weightings, left to right, 1 char at a time
870 my $temp1 = $weightings[$i];
872 # sequence left to right, 1 char at a time
873 my $temp2 = substr( $cardnumber, $i, 1 );
875 # mult each char 1-7 by its corresponding weighting
876 $sum += $temp1 * $temp2;
879 my $rem = ( $sum % 11 );
880 $rem = 'X' if $rem == 10;
882 return "V$cardnumber$rem";
885 # MODIFIED BY JF: mysql4.1 allows casting as an integer, which is probably
886 # better. I'll leave the original in in case it needs to be changed for you
887 # my $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers");
888 my $sth = $dbh->prepare(
889 "select max(cast(cardnumber as signed)) from borrowers"
892 my ($result) = $sth->fetchrow;
895 return $cardnumber; # just here as a fallback/reminder
900 ($num_children, $children_arrayref) = &GetGuarantees($parent_borrno);
901 $child0_cardno = $children_arrayref->[0]{"cardnumber"};
902 $child0_borrno = $children_arrayref->[0]{"borrowernumber"};
904 C<&GetGuarantees> takes a borrower number (e.g., that of a patron
905 with children) and looks up the borrowers who are guaranteed by that
906 borrower (i.e., the patron's children).
908 C<&GetGuarantees> returns two values: an integer giving the number of
909 borrowers guaranteed by C<$parent_borrno>, and a reference to an array
910 of references to hash, which gives the actual results.
916 my ($borrowernumber) = @_;
917 my $dbh = C4::Context->dbh;
920 "select cardnumber,borrowernumber, firstname, surname from borrowers where guarantorid=?"
922 $sth->execute($borrowernumber);
925 my $data = $sth->fetchall_arrayref({});
926 return ( scalar(@$data), $data );
929 =head2 UpdateGuarantees
931 &UpdateGuarantees($parent_borrno);
934 C<&UpdateGuarantees> borrower data for an adult and updates all the guarantees
935 with the modified information
940 sub UpdateGuarantees {
942 my $dbh = C4::Context->dbh;
943 my ( $count, $guarantees ) = GetGuarantees( $data{'borrowernumber'} );
944 foreach my $guarantee (@$guarantees){
945 my $guaquery = qq|UPDATE borrowers
946 SET address=?,fax=?,B_city=?,mobile=?,city=?,phone=?
947 WHERE borrowernumber=?
949 my $sth = $dbh->prepare($guaquery);
950 $sth->execute($data{'address'},$data{'fax'},$data{'B_city'},$data{'mobile'},$data{'city'},$data{'phone'},$guarantee->{'borrowernumber'});
953 =head2 GetPendingIssues
955 my $issues = &GetPendingIssues($borrowernumber);
957 Looks up what the patron with the given borrowernumber has borrowed.
959 C<&GetPendingIssues> returns a
960 reference-to-array where each element is a reference-to-hash; the
961 keys are the fields from the C<issues>, C<biblio>, and C<items> tables.
962 The keys include C<biblioitems> fields except marc and marcxml.
967 sub GetPendingIssues {
968 my ($borrowernumber) = @_;
969 # must avoid biblioitems.* to prevent large marc and marcxml fields from killing performance
970 # FIXME: namespace collision: each table has "timestamp" fields. Which one is "timestamp" ?
971 # FIXME: circ/ciculation.pl tries to sort by timestamp!
972 # FIXME: C4::Print::printslip tries to sort by timestamp!
973 # FIXME: namespace collision: other collisions possible.
974 # FIXME: most of this data isn't really being used by callers.
975 my $sth = C4::Context->dbh->prepare(
981 biblioitems.itemtype,
984 biblioitems.publicationyear,
985 biblioitems.publishercode,
986 biblioitems.volumedate,
987 biblioitems.volumedesc,
990 issues.timestamp AS timestamp,
991 issues.renewals AS renewals,
992 items.renewals AS totalrenewals
994 LEFT JOIN items ON items.itemnumber = issues.itemnumber
995 LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
996 LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
999 ORDER BY issues.issuedate"
1001 $sth->execute($borrowernumber);
1002 my $data = $sth->fetchall_arrayref({});
1003 my $today = C4::Dates->new->output('iso');
1005 $_->{date_due} or next;
1006 ($_->{date_due} lt $today) and $_->{overdue} = 1;
1013 $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
1015 Looks up what the patron with the given borrowernumber has borrowed,
1016 and sorts the results.
1018 C<$sortkey> is the name of a field on which to sort the results. This
1019 should be the name of a field in the C<issues>, C<biblio>,
1020 C<biblioitems>, or C<items> table in the Koha database.
1022 C<$limit> is the maximum number of results to return.
1024 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
1025 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
1026 C<items> tables of the Koha database.
1032 my ( $borrowernumber, $order, $limit ) = @_;
1034 #FIXME: sanity-check order and limit
1035 my $dbh = C4::Context->dbh;
1037 "SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1039 LEFT JOIN items on items.itemnumber=issues.itemnumber
1040 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1041 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1042 WHERE borrowernumber=?
1044 SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1046 LEFT JOIN items on items.itemnumber=old_issues.itemnumber
1047 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1048 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1049 WHERE borrowernumber=?
1051 if ( $limit != 0 ) {
1052 $query .= " limit $limit";
1055 my $sth = $dbh->prepare($query);
1056 $sth->execute($borrowernumber, $borrowernumber);
1059 while ( my $data = $sth->fetchrow_hashref ) {
1060 push @result, $data;
1067 =head2 GetMemberAccountRecords
1069 ($total, $acctlines, $count) = &GetMemberAccountRecords($borrowernumber);
1071 Looks up accounting data for the patron with the given borrowernumber.
1073 C<&GetMemberAccountRecords> returns a three-element array. C<$acctlines> is a
1074 reference-to-array, where each element is a reference-to-hash; the
1075 keys are the fields of the C<accountlines> table in the Koha database.
1076 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1077 total amount outstanding for all of the account lines.
1082 sub GetMemberAccountRecords {
1083 my ($borrowernumber,$date) = @_;
1084 my $dbh = C4::Context->dbh;
1090 WHERE borrowernumber=?);
1091 my @bind = ($borrowernumber);
1092 if ($date && $date ne ''){
1093 $strsth.=" AND date < ? ";
1096 $strsth.=" ORDER BY date desc,timestamp DESC";
1097 my $sth= $dbh->prepare( $strsth );
1098 $sth->execute( @bind );
1100 while ( my $data = $sth->fetchrow_hashref ) {
1101 my $biblio = GetBiblioFromItemNumber($data->{itemnumber}) if $data->{itemnumber};
1102 $data->{biblionumber} = $biblio->{biblionumber};
1103 $data->{title} = $biblio->{title};
1104 $acctlines[$numlines] = $data;
1106 $total += int(1000 * $data->{'amountoutstanding'}); # convert float to integer to avoid round-off errors
1109 return ( $total, \@acctlines,$numlines);
1112 =head2 GetBorNotifyAcctRecord
1114 ($count, $acctlines, $total) = &GetBorNotifyAcctRecord($params,$notifyid);
1116 Looks up accounting data for the patron with the given borrowernumber per file number.
1118 (FIXME - I'm not at all sure what this is about.)
1120 C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a
1121 reference-to-array, where each element is a reference-to-hash; the
1122 keys are the fields of the C<accountlines> table in the Koha database.
1123 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1124 total amount outstanding for all of the account lines.
1128 sub GetBorNotifyAcctRecord {
1129 my ( $borrowernumber, $notifyid ) = @_;
1130 my $dbh = C4::Context->dbh;
1133 my $sth = $dbh->prepare(
1136 WHERE borrowernumber=?
1138 AND amountoutstanding != '0'
1139 ORDER BY notify_id,accounttype
1141 # 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')
1143 $sth->execute( $borrowernumber, $notifyid );
1145 while ( my $data = $sth->fetchrow_hashref ) {
1146 $acctlines[$numlines] = $data;
1148 $total += int(100 * $data->{'amountoutstanding'});
1151 return ( $total, \@acctlines, $numlines );
1154 =head2 checkuniquemember (OUEST-PROVENCE)
1156 ($result,$categorycode) = &checkuniquemember($collectivity,$surname,$firstname,$dateofbirth);
1158 Checks that a member exists or not in the database.
1160 C<&result> is nonzero (=exist) or 0 (=does not exist)
1161 C<&categorycode> is from categorycode table
1162 C<&collectivity> is 1 (= we add a collectivity) or 0 (= we add a physical member)
1163 C<&surname> is the surname
1164 C<&firstname> is the firstname (only if collectivity=0)
1165 C<&dateofbirth> is the date of birth in ISO format (only if collectivity=0)
1169 # FIXME: This function is not legitimate. Multiple patrons might have the same first/last name and birthdate.
1170 # This is especially true since first name is not even a required field.
1172 sub checkuniquemember {
1173 my ( $collectivity, $surname, $firstname, $dateofbirth ) = @_;
1174 my $dbh = C4::Context->dbh;
1175 my $request = ($collectivity) ?
1176 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? " :
1178 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=? and dateofbirth=?" :
1179 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=?";
1180 my $sth = $dbh->prepare($request);
1181 if ($collectivity) {
1182 $sth->execute( uc($surname) );
1183 } elsif($dateofbirth){
1184 $sth->execute( uc($surname), ucfirst($firstname), $dateofbirth );
1186 $sth->execute( uc($surname), ucfirst($firstname));
1188 my @data = $sth->fetchrow;
1189 ( $data[0] ) and return $data[0], $data[1];
1193 sub checkcardnumber {
1194 my ($cardnumber,$borrowernumber) = @_;
1195 my $dbh = C4::Context->dbh;
1196 my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
1197 $query .= " AND borrowernumber <> ?" if ($borrowernumber);
1198 my $sth = $dbh->prepare($query);
1199 if ($borrowernumber) {
1200 $sth->execute($cardnumber,$borrowernumber);
1202 $sth->execute($cardnumber);
1204 if (my $data= $sth->fetchrow_hashref()){
1213 =head2 getzipnamecity (OUEST-PROVENCE)
1215 take all info from table city for the fields city and zip
1216 check for the name and the zip code of the city selected
1220 sub getzipnamecity {
1222 my $dbh = C4::Context->dbh;
1225 "select city_name,city_zipcode from cities where cityid=? ");
1226 $sth->execute($cityid);
1227 my @data = $sth->fetchrow;
1228 return $data[0], $data[1];
1232 =head2 getdcity (OUEST-PROVENCE)
1234 recover cityid with city_name condition
1239 my ($city_name) = @_;
1240 my $dbh = C4::Context->dbh;
1241 my $sth = $dbh->prepare("select cityid from cities where city_name=? ");
1242 $sth->execute($city_name);
1243 my $data = $sth->fetchrow;
1247 =head2 GetFirstValidEmailAddress
1249 $email = GetFirstValidEmailAddress($borrowernumber);
1251 Return the first valid email address for a borrower, given the borrowernumber. For now, the order
1252 is defined as email, emailpro, B_email. Returns the empty string if the borrower has no email
1257 sub GetFirstValidEmailAddress {
1258 my $borrowernumber = shift;
1259 my $dbh = C4::Context->dbh;
1260 my $sth = $dbh->prepare( "SELECT email, emailpro, B_email FROM borrowers where borrowernumber = ? ");
1261 $sth->execute( $borrowernumber );
1262 my $data = $sth->fetchrow_hashref;
1264 if ($data->{'email'}) {
1265 return $data->{'email'};
1266 } elsif ($data->{'emailpro'}) {
1267 return $data->{'emailpro'};
1268 } elsif ($data->{'B_email'}) {
1269 return $data->{'B_email'};
1275 =head2 GetExpiryDate
1277 $expirydate = GetExpiryDate($categorycode, $dateenrolled);
1279 Calculate expiry date given a categorycode and starting date. Date argument must be in ISO format.
1280 Return date is also in ISO format.
1285 my ( $categorycode, $dateenrolled ) = @_;
1287 if ($categorycode) {
1288 my $dbh = C4::Context->dbh;
1289 my $sth = $dbh->prepare("SELECT enrolmentperiod,enrolmentperioddate FROM categories WHERE categorycode=?");
1290 $sth->execute($categorycode);
1291 $enrolments = $sth->fetchrow_hashref;
1293 # die "GetExpiryDate: for enrollmentperiod $enrolmentperiod (category '$categorycode') starting $dateenrolled.\n";
1294 my @date = split (/-/,$dateenrolled);
1295 if($enrolments->{enrolmentperiod}){
1296 return sprintf("%04d-%02d-%02d", Add_Delta_YM(@date,0,$enrolments->{enrolmentperiod}));
1298 return $enrolments->{enrolmentperioddate};
1302 =head2 checkuserpassword (OUEST-PROVENCE)
1304 check for the password and login are not used
1305 return the number of record
1306 0=> NOT USED 1=> USED
1310 sub checkuserpassword {
1311 my ( $borrowernumber, $userid, $password ) = @_;
1312 $password = md5_base64($password);
1313 my $dbh = C4::Context->dbh;
1316 "Select count(*) from borrowers where borrowernumber !=? and userid =? and password=? "
1318 $sth->execute( $borrowernumber, $userid, $password );
1319 my $number_rows = $sth->fetchrow;
1320 return $number_rows;
1324 =head2 GetborCatFromCatType
1326 ($codes_arrayref, $labels_hashref) = &GetborCatFromCatType();
1328 Looks up the different types of borrowers in the database. Returns two
1329 elements: a reference-to-array, which lists the borrower category
1330 codes, and a reference-to-hash, which maps the borrower category codes
1331 to category descriptions.
1336 sub GetborCatFromCatType {
1337 my ( $category_type, $action ) = @_;
1338 # FIXME - This API seems both limited and dangerous.
1339 my $dbh = C4::Context->dbh;
1340 my $request = qq| SELECT categorycode,description
1343 ORDER BY categorycode|;
1344 my $sth = $dbh->prepare($request);
1346 $sth->execute($category_type);
1355 while ( my $data = $sth->fetchrow_hashref ) {
1356 push @codes, $data->{'categorycode'};
1357 $labels{ $data->{'categorycode'} } = $data->{'description'};
1359 return ( \@codes, \%labels );
1362 =head2 GetBorrowercategory
1364 $hashref = &GetBorrowercategory($categorycode);
1366 Given the borrower's category code, the function returns the corresponding
1367 data hashref for a comprehensive information display.
1369 $arrayref_hashref = &GetBorrowercategory;
1371 If no category code provided, the function returns all the categories.
1375 sub GetBorrowercategory {
1377 my $dbh = C4::Context->dbh;
1381 "SELECT description,dateofbirthrequired,upperagelimit,category_type
1383 WHERE categorycode = ?"
1385 $sth->execute($catcode);
1387 $sth->fetchrow_hashref;
1391 } # sub getborrowercategory
1393 =head2 GetBorrowercategoryList
1395 $arrayref_hashref = &GetBorrowercategoryList;
1396 If no category code provided, the function returns all the categories.
1400 sub GetBorrowercategoryList {
1401 my $dbh = C4::Context->dbh;
1406 ORDER BY description"
1410 $sth->fetchall_arrayref({});
1412 } # sub getborrowercategory
1414 =head2 ethnicitycategories
1416 ($codes_arrayref, $labels_hashref) = ðnicitycategories();
1418 Looks up the different ethnic types in the database. Returns two
1419 elements: a reference-to-array, which lists the ethnicity codes, and a
1420 reference-to-hash, which maps the ethnicity codes to ethnicity
1427 sub ethnicitycategories {
1428 my $dbh = C4::Context->dbh;
1429 my $sth = $dbh->prepare("Select code,name from ethnicity order by name");
1433 while ( my $data = $sth->fetchrow_hashref ) {
1434 push @codes, $data->{'code'};
1435 $labels{ $data->{'code'} } = $data->{'name'};
1437 return ( \@codes, \%labels );
1442 $ethn_name = &fixEthnicity($ethn_code);
1444 Takes an ethnicity code (e.g., "european" or "pi") and returns the
1445 corresponding descriptive name from the C<ethnicity> table in the
1446 Koha database ("European" or "Pacific Islander").
1453 my $ethnicity = shift;
1454 return unless $ethnicity;
1455 my $dbh = C4::Context->dbh;
1456 my $sth = $dbh->prepare("Select name from ethnicity where code = ?");
1457 $sth->execute($ethnicity);
1458 my $data = $sth->fetchrow_hashref;
1459 return $data->{'name'};
1460 } # sub fixEthnicity
1464 $dateofbirth,$date = &GetAge($date);
1466 this function return the borrowers age with the value of dateofbirth
1472 my ( $date, $date_ref ) = @_;
1474 if ( not defined $date_ref ) {
1475 $date_ref = sprintf( '%04d-%02d-%02d', Today() );
1478 my ( $year1, $month1, $day1 ) = split /-/, $date;
1479 my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
1481 my $age = $year2 - $year1;
1482 if ( $month1 . $day1 > $month2 . $day2 ) {
1489 =head2 get_institutions
1491 $insitutions = get_institutions();
1493 Just returns a list of all the borrowers of type I, borrownumber and name
1498 sub get_institutions {
1499 my $dbh = C4::Context->dbh();
1502 "SELECT borrowernumber,surname FROM borrowers WHERE categorycode=? ORDER BY surname"
1506 while ( my $data = $sth->fetchrow_hashref() ) {
1507 $orgs{ $data->{'borrowernumber'} } = $data;
1511 } # sub get_institutions
1513 =head2 add_member_orgs
1515 add_member_orgs($borrowernumber,$borrowernumbers);
1517 Takes a borrowernumber and a list of other borrowernumbers and inserts them into the borrowers_to_borrowers table
1522 sub add_member_orgs {
1523 my ( $borrowernumber, $otherborrowers ) = @_;
1524 my $dbh = C4::Context->dbh();
1526 "INSERT INTO borrowers_to_borrowers (borrower1,borrower2) VALUES (?,?)";
1527 my $sth = $dbh->prepare($query);
1528 foreach my $otherborrowernumber (@$otherborrowers) {
1529 $sth->execute( $borrowernumber, $otherborrowernumber );
1532 } # sub add_member_orgs
1536 $cityarrayref = GetCities();
1538 Returns an array_ref of the entries in the cities table
1539 If there are entries in the table an empty row is returned
1540 This is currently only used to populate a popup in memberentry
1546 my $dbh = C4::Context->dbh;
1547 my $city_arr = $dbh->selectall_arrayref(
1548 q|SELECT cityid,city_zipcode,city_name FROM cities ORDER BY city_name|,
1550 if ( @{$city_arr} ) {
1551 unshift @{$city_arr}, {
1552 city_zipcode => q{},
1561 =head2 GetSortDetails (OUEST-PROVENCE)
1563 ($lib) = &GetSortDetails($category,$sortvalue);
1565 Returns the authorized value details
1566 C<&$lib>return value of authorized value details
1567 C<&$sortvalue>this is the value of authorized value
1568 C<&$category>this is the value of authorized value category
1572 sub GetSortDetails {
1573 my ( $category, $sortvalue ) = @_;
1574 my $dbh = C4::Context->dbh;
1575 my $query = qq|SELECT lib
1576 FROM authorised_values
1578 AND authorised_value=? |;
1579 my $sth = $dbh->prepare($query);
1580 $sth->execute( $category, $sortvalue );
1581 my $lib = $sth->fetchrow;
1582 return ($lib) if ($lib);
1583 return ($sortvalue) unless ($lib);
1586 =head2 MoveMemberToDeleted
1588 $result = &MoveMemberToDeleted($borrowernumber);
1590 Copy the record from borrowers to deletedborrowers table.
1594 # FIXME: should do it in one SQL statement w/ subquery
1595 # Otherwise, we should return the @data on success
1597 sub MoveMemberToDeleted {
1598 my ($member) = shift or return;
1599 my $dbh = C4::Context->dbh;
1600 my $query = qq|SELECT *
1602 WHERE borrowernumber=?|;
1603 my $sth = $dbh->prepare($query);
1604 $sth->execute($member);
1605 my @data = $sth->fetchrow_array;
1606 (@data) or return; # if we got a bad borrowernumber, there's nothing to insert
1608 $dbh->prepare( "INSERT INTO deletedborrowers VALUES ("
1609 . ( "?," x ( scalar(@data) - 1 ) )
1611 $sth->execute(@data);
1616 DelMember($borrowernumber);
1618 This function remove directly a borrower whitout writing it on deleteborrower.
1619 + Deletes reserves for the borrower
1624 my $dbh = C4::Context->dbh;
1625 my $borrowernumber = shift;
1626 #warn "in delmember with $borrowernumber";
1627 return unless $borrowernumber; # borrowernumber is mandatory.
1629 my $query = qq|DELETE
1631 WHERE borrowernumber=?|;
1632 my $sth = $dbh->prepare($query);
1633 $sth->execute($borrowernumber);
1637 WHERE borrowernumber = ?
1639 $sth = $dbh->prepare($query);
1640 $sth->execute($borrowernumber);
1641 logaction("MEMBERS", "DELETE", $borrowernumber, "") if C4::Context->preference("BorrowersLog");
1645 =head2 ExtendMemberSubscriptionTo (OUEST-PROVENCE)
1647 $date = ExtendMemberSubscriptionTo($borrowerid, $date);
1649 Extending the subscription to a given date or to the expiry date calculated on ISO date.
1654 sub ExtendMemberSubscriptionTo {
1655 my ( $borrowerid,$date) = @_;
1656 my $dbh = C4::Context->dbh;
1657 my $borrower = GetMember('borrowernumber'=>$borrowerid);
1659 $date=POSIX::strftime("%Y-%m-%d",localtime());
1660 $date = GetExpiryDate( $borrower->{'categorycode'}, $date );
1662 my $sth = $dbh->do(<<EOF);
1664 SET dateexpiry='$date'
1665 WHERE borrowernumber='$borrowerid'
1667 # add enrolmentfee if needed
1668 $sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
1669 $sth->execute($borrower->{'categorycode'});
1670 my ($enrolmentfee) = $sth->fetchrow;
1671 if ($enrolmentfee && $enrolmentfee > 0) {
1672 # insert fee in patron debts
1673 manualinvoice($borrower->{'borrowernumber'}, '', '', 'A', $enrolmentfee);
1675 return $date if ($sth);
1679 =head2 GetRoadTypes (OUEST-PROVENCE)
1681 ($idroadtypearrayref, $roadttype_hashref) = &GetRoadTypes();
1683 Looks up the different road type . Returns two
1684 elements: a reference-to-array, which lists the id_roadtype
1685 codes, and a reference-to-hash, which maps the road type of the road .
1690 my $dbh = C4::Context->dbh;
1692 SELECT roadtypeid,road_type
1694 ORDER BY road_type|;
1695 my $sth = $dbh->prepare($query);
1700 # insert empty value to create a empty choice in cgi popup
1702 while ( my $data = $sth->fetchrow_hashref ) {
1704 push @id, $data->{'roadtypeid'};
1705 $roadtype{ $data->{'roadtypeid'} } = $data->{'road_type'};
1708 #test to know if the table contain some records if no the function return nothing
1715 return ( \@id, \%roadtype );
1721 =head2 GetTitles (OUEST-PROVENCE)
1723 ($borrowertitle)= &GetTitles();
1725 Looks up the different title . Returns array with all borrowers title
1730 my @borrowerTitle = split (/,|\|/,C4::Context->preference('BorrowersTitles'));
1731 unshift( @borrowerTitle, "" );
1732 my $count=@borrowerTitle;
1737 return ( \@borrowerTitle);
1741 =head2 GetPatronImage
1743 my ($imagedata, $dberror) = GetPatronImage($cardnumber);
1745 Returns the mimetype and binary image data of the image for the patron with the supplied cardnumber.
1749 sub GetPatronImage {
1750 my ($cardnumber) = @_;
1751 warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1752 my $dbh = C4::Context->dbh;
1753 my $query = 'SELECT mimetype, imagefile FROM patronimage WHERE cardnumber = ?';
1754 my $sth = $dbh->prepare($query);
1755 $sth->execute($cardnumber);
1756 my $imagedata = $sth->fetchrow_hashref;
1757 warn "Database error!" if $sth->errstr;
1758 return $imagedata, $sth->errstr;
1761 =head2 PutPatronImage
1763 PutPatronImage($cardnumber, $mimetype, $imgfile);
1765 Stores patron binary image data and mimetype in database.
1766 NOTE: This function is good for updating images as well as inserting new images in the database.
1770 sub PutPatronImage {
1771 my ($cardnumber, $mimetype, $imgfile) = @_;
1772 warn "Parameters passed in: Cardnumber=$cardnumber, Mimetype=$mimetype, " . ($imgfile ? "Imagefile" : "No Imagefile") if $debug;
1773 my $dbh = C4::Context->dbh;
1774 my $query = "INSERT INTO patronimage (cardnumber, mimetype, imagefile) VALUES (?,?,?) ON DUPLICATE KEY UPDATE imagefile = ?;";
1775 my $sth = $dbh->prepare($query);
1776 $sth->execute($cardnumber,$mimetype,$imgfile,$imgfile);
1777 warn "Error returned inserting $cardnumber.$mimetype." if $sth->errstr;
1778 return $sth->errstr;
1781 =head2 RmPatronImage
1783 my ($dberror) = RmPatronImage($cardnumber);
1785 Removes the image for the patron with the supplied cardnumber.
1790 my ($cardnumber) = @_;
1791 warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1792 my $dbh = C4::Context->dbh;
1793 my $query = "DELETE FROM patronimage WHERE cardnumber = ?;";
1794 my $sth = $dbh->prepare($query);
1795 $sth->execute($cardnumber);
1796 my $dberror = $sth->errstr;
1797 warn "Database error!" if $sth->errstr;
1801 =head2 GetRoadTypeDetails (OUEST-PROVENCE)
1803 ($roadtype) = &GetRoadTypeDetails($roadtypeid);
1805 Returns the description of roadtype
1806 C<&$roadtype>return description of road type
1807 C<&$roadtypeid>this is the value of roadtype s
1811 sub GetRoadTypeDetails {
1812 my ($roadtypeid) = @_;
1813 my $dbh = C4::Context->dbh;
1817 WHERE roadtypeid=?|;
1818 my $sth = $dbh->prepare($query);
1819 $sth->execute($roadtypeid);
1820 my $roadtype = $sth->fetchrow;
1824 =head2 GetBorrowersWhoHaveNotBorrowedSince
1826 &GetBorrowersWhoHaveNotBorrowedSince($date)
1828 this function get all borrowers who haven't borrowed since the date given on input arg.
1832 sub GetBorrowersWhoHaveNotBorrowedSince {
1833 my $filterdate = shift||POSIX::strftime("%Y-%m-%d",localtime());
1834 my $filterexpiry = shift;
1835 my $filterbranch = shift ||
1836 ((C4::Context->preference('IndependantBranches')
1837 && C4::Context->userenv
1838 && C4::Context->userenv->{flags} % 2 !=1
1839 && C4::Context->userenv->{branch})
1840 ? C4::Context->userenv->{branch}
1842 my $dbh = C4::Context->dbh;
1844 SELECT borrowers.borrowernumber,
1845 max(old_issues.timestamp) as latestissue,
1846 max(issues.timestamp) as currentissue
1848 JOIN categories USING (categorycode)
1849 LEFT JOIN old_issues USING (borrowernumber)
1850 LEFT JOIN issues USING (borrowernumber)
1851 WHERE category_type <> 'S'
1852 AND borrowernumber NOT IN (SELECT guarantorid FROM borrowers WHERE guarantorid IS NOT NULL AND guarantorid <> 0)
1855 if ($filterbranch && $filterbranch ne ""){
1856 $query.=" AND borrowers.branchcode= ?";
1857 push @query_params,$filterbranch;
1860 $query .= " AND dateexpiry < ? ";
1861 push @query_params,$filterdate;
1863 $query.=" GROUP BY borrowers.borrowernumber";
1865 $query.=" HAVING (latestissue < ? OR latestissue IS NULL)
1866 AND currentissue IS NULL";
1867 push @query_params,$filterdate;
1869 warn $query if $debug;
1870 my $sth = $dbh->prepare($query);
1871 if (scalar(@query_params)>0){
1872 $sth->execute(@query_params);
1879 while ( my $data = $sth->fetchrow_hashref ) {
1880 push @results, $data;
1885 =head2 GetBorrowersWhoHaveNeverBorrowed
1887 $results = &GetBorrowersWhoHaveNeverBorrowed
1889 This function get all borrowers who have never borrowed.
1891 I<$result> is a ref to an array which all elements are a hasref.
1895 sub GetBorrowersWhoHaveNeverBorrowed {
1896 my $filterbranch = shift ||
1897 ((C4::Context->preference('IndependantBranches')
1898 && C4::Context->userenv
1899 && C4::Context->userenv->{flags} % 2 !=1
1900 && C4::Context->userenv->{branch})
1901 ? C4::Context->userenv->{branch}
1903 my $dbh = C4::Context->dbh;
1905 SELECT borrowers.borrowernumber,max(timestamp) as latestissue
1907 LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
1908 WHERE issues.borrowernumber IS NULL
1911 if ($filterbranch && $filterbranch ne ""){
1912 $query.=" AND borrowers.branchcode= ?";
1913 push @query_params,$filterbranch;
1915 warn $query if $debug;
1917 my $sth = $dbh->prepare($query);
1918 if (scalar(@query_params)>0){
1919 $sth->execute(@query_params);
1926 while ( my $data = $sth->fetchrow_hashref ) {
1927 push @results, $data;
1932 =head2 GetBorrowersWithIssuesHistoryOlderThan
1934 $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
1936 this function get all borrowers who has an issue history older than I<$date> given on input arg.
1938 I<$result> is a ref to an array which all elements are a hashref.
1939 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
1943 sub GetBorrowersWithIssuesHistoryOlderThan {
1944 my $dbh = C4::Context->dbh;
1945 my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
1946 my $filterbranch = shift ||
1947 ((C4::Context->preference('IndependantBranches')
1948 && C4::Context->userenv
1949 && C4::Context->userenv->{flags} % 2 !=1
1950 && C4::Context->userenv->{branch})
1951 ? C4::Context->userenv->{branch}
1954 SELECT count(borrowernumber) as n,borrowernumber
1956 WHERE returndate < ?
1957 AND borrowernumber IS NOT NULL
1960 push @query_params, $date;
1962 $query.=" AND branchcode = ?";
1963 push @query_params, $filterbranch;
1965 $query.=" GROUP BY borrowernumber ";
1966 warn $query if $debug;
1967 my $sth = $dbh->prepare($query);
1968 $sth->execute(@query_params);
1971 while ( my $data = $sth->fetchrow_hashref ) {
1972 push @results, $data;
1977 =head2 GetBorrowersNamesAndLatestIssue
1979 $results = &GetBorrowersNamesAndLatestIssueList(@borrowernumbers)
1981 this function get borrowers Names and surnames and Issue information.
1983 I<@borrowernumbers> is an array which all elements are borrowernumbers.
1984 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
1988 sub GetBorrowersNamesAndLatestIssue {
1989 my $dbh = C4::Context->dbh;
1990 my @borrowernumbers=@_;
1992 SELECT surname,lastname, phone, email,max(timestamp)
1994 LEFT JOIN issues ON borrowers.borrowernumber=issues.borrowernumber
1995 GROUP BY borrowernumber
1997 my $sth = $dbh->prepare($query);
1999 my $results = $sth->fetchall_arrayref({});
2005 my $success = DebarMember( $borrowernumber );
2007 marks a Member as debarred, and therefore unable to checkout any more
2011 true on success, false on failure
2016 my $borrowernumber = shift;
2018 return unless defined $borrowernumber;
2019 return unless $borrowernumber =~ /^\d+$/;
2021 return ModMember( borrowernumber => $borrowernumber,
2030 my $success = ModPrivacy( $borrowernumber, $privacy );
2032 Update the privacy of a patron.
2035 true on success, false on failure
2042 my $borrowernumber = shift;
2043 my $privacy = shift;
2044 return unless defined $borrowernumber;
2045 return unless $borrowernumber =~ /^\d+$/;
2047 return ModMember( borrowernumber => $borrowernumber,
2048 privacy => $privacy );
2053 AddMessage( $borrowernumber, $message_type, $message, $branchcode );
2055 Adds a message to the messages table for the given borrower.
2064 my ( $borrowernumber, $message_type, $message, $branchcode ) = @_;
2066 my $dbh = C4::Context->dbh;
2068 if ( ! ( $borrowernumber && $message_type && $message && $branchcode ) ) {
2072 my $query = "INSERT INTO messages ( borrowernumber, branchcode, message_type, message ) VALUES ( ?, ?, ?, ? )";
2073 my $sth = $dbh->prepare($query);
2074 $sth->execute( $borrowernumber, $branchcode, $message_type, $message );
2081 GetMessages( $borrowernumber, $type );
2083 $type is message type, B for borrower, or L for Librarian.
2084 Empty type returns all messages of any type.
2086 Returns all messages for the given borrowernumber
2091 my ( $borrowernumber, $type, $branchcode ) = @_;
2097 my $dbh = C4::Context->dbh;
2100 branches.branchname,
2103 messages.branchcode LIKE '$branchcode' AS can_delete
2104 FROM messages, branches
2105 WHERE borrowernumber = ?
2106 AND message_type LIKE ?
2107 AND messages.branchcode = branches.branchcode
2108 ORDER BY message_date DESC";
2109 my $sth = $dbh->prepare($query);
2110 $sth->execute( $borrowernumber, $type ) ;
2113 while ( my $data = $sth->fetchrow_hashref ) {
2114 my $d = C4::Dates->new( $data->{message_date}, 'iso' );
2115 $data->{message_date_formatted} = $d->output;
2116 push @results, $data;
2124 GetMessagesCount( $borrowernumber, $type );
2126 $type is message type, B for borrower, or L for Librarian.
2127 Empty type returns all messages of any type.
2129 Returns the number of messages for the given borrowernumber
2133 sub GetMessagesCount {
2134 my ( $borrowernumber, $type, $branchcode ) = @_;
2140 my $dbh = C4::Context->dbh;
2142 my $query = "SELECT COUNT(*) as MsgCount FROM messages WHERE borrowernumber = ? AND message_type LIKE ?";
2143 my $sth = $dbh->prepare($query);
2144 $sth->execute( $borrowernumber, $type ) ;
2147 my $data = $sth->fetchrow_hashref;
2148 my $count = $data->{'MsgCount'};
2155 =head2 DeleteMessage
2157 DeleteMessage( $message_id );
2162 my ( $message_id ) = @_;
2164 my $dbh = C4::Context->dbh;
2166 my $query = "DELETE FROM messages WHERE message_id = ?";
2167 my $sth = $dbh->prepare($query);
2168 $sth->execute( $message_id );
2172 END { } # module clean-up code here (global destructor)