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 with
17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
18 # Suite 330, Boston, MA 02111-1307 USA
23 use C4::Dates qw(format_date_in_iso);
24 use Digest::MD5 qw(md5_base64);
25 use Date::Calc qw/Today Add_Delta_YM/;
26 use C4::Log; # logaction
32 our ($VERSION,@ISA,@EXPORT,@EXPORT_OK,$debug);
36 $debug = $ENV{DEBUG} || 0;
47 &GetMemberIssuesAndFines
66 &GetMemberAccountRecords
67 &GetBorNotifyAcctRecord
71 &GetBorrowercategoryList
73 &GetBorrowersWhoHaveNotBorrowedSince
74 &GetBorrowersWhoHaveNeverBorrowed
75 &GetBorrowersWithIssuesHistoryOlderThan
96 &ExtendMemberSubscriptionTo
114 C4::Members - Perl Module containing convenience functions for member handling
122 This module contains routines for adding, modifying and deleting members/patrons/borrowers
130 ($count, $borrowers) = &SearchMember($searchstring, $type,$category_type,$filter,$showallbranches);
134 Looks up patrons (borrowers) by name.
136 BUGFIX 499: C<$type> is now used to determine type of search.
137 if $type is "simple", search is performed on the first letter of the
140 $category_type is used to get a specified type of user.
141 (mainly adults when creating a child.)
143 C<$searchstring> is a space-separated list of search terms. Each term
144 must match the beginning a borrower's surname, first name, or other
147 C<$filter> is assumed to be a list of elements to filter results on
149 C<$showallbranches> is used in IndependantBranches Context to display all branches results.
151 C<&SearchMember> returns a two-element list. C<$borrowers> is a
152 reference-to-array; each element is a reference-to-hash, whose keys
153 are the fields of the C<borrowers> table in the Koha database.
154 C<$count> is the number of elements in C<$borrowers>.
159 #used by member enquiries from the intranet
160 #called by member.pl and circ/circulation.pl
162 my ($searchstring, $orderby, $type,$category_type,$filter,$showallbranches ) = @_;
163 my $dbh = C4::Context->dbh;
169 # this is used by circulation everytime a new borrowers cardnumber is scanned
170 # so we can check an exact match first, if that works return, otherwise do the rest
171 $query = "SELECT * FROM borrowers
172 LEFT JOIN categories ON borrowers.categorycode=categories.categorycode
174 my $sth = $dbh->prepare("$query WHERE cardnumber = ?");
175 $sth->execute($searchstring);
176 my $data = $sth->fetchall_arrayref({});
178 return ( scalar(@$data), $data );
182 if ( $type eq "simple" ) # simple search for one letter only
184 $query .= ($category_type ? " AND category_type = ".$dbh->quote($category_type) : "");
185 $query .= " WHERE (surname LIKE ? OR cardnumber like ?) ";
186 if (C4::Context->preference("IndependantBranches") && !$showallbranches){
187 if (C4::Context->userenv && C4::Context->userenv->{flags} % 2 !=1 && C4::Context->userenv->{'branch'}){
188 $query.=" AND borrowers.branchcode =".$dbh->quote(C4::Context->userenv->{'branch'}) unless (C4::Context->userenv->{'branch'} eq "insecure");
191 $query.=" ORDER BY $orderby";
192 @bind = ("$searchstring%","$searchstring");
194 else # advanced search looking in surname, firstname and othernames
196 @data = split( ' ', $searchstring );
199 if (C4::Context->preference("IndependantBranches") && !$showallbranches){
200 if (C4::Context->userenv && C4::Context->userenv->{flags} % 2 !=1 && C4::Context->userenv->{'branch'}){
201 $query.=" borrowers.branchcode =".$dbh->quote(C4::Context->userenv->{'branch'})." AND " unless (C4::Context->userenv->{'branch'} eq "insecure");
204 $query.="((surname LIKE ? OR surname LIKE ?
205 OR firstname LIKE ? OR firstname LIKE ?
206 OR othernames LIKE ? OR othernames LIKE ?)
208 ($category_type?" AND category_type = ".$dbh->quote($category_type):"");
210 "$data[0]%", "% $data[0]%", "$data[0]%", "% $data[0]%",
211 "$data[0]%", "% $data[0]%"
213 for ( my $i = 1 ; $i < $count ; $i++ ) {
214 $query = $query . " AND (" . " surname LIKE ? OR surname LIKE ?
215 OR firstname LIKE ? OR firstname LIKE ?
216 OR othernames LIKE ? OR othernames LIKE ?)";
218 "$data[$i]%", "% $data[$i]%", "$data[$i]%",
219 "% $data[$i]%", "$data[$i]%", "% $data[$i]%" );
223 $query = $query . ") OR cardnumber LIKE ? ";
224 push( @bind, $searchstring );
225 if (C4::Context->preference('ExtendedPatronAttributes')) {
226 $query .= "OR borrowernumber IN (
227 SELECT borrowernumber
228 FROM borrower_attributes
229 JOIN borrower_attribute_types USING (code)
230 WHERE staff_searchable = 1
233 push (@bind, $searchstring);
235 $query .= "order by $orderby";
240 $sth = $dbh->prepare($query);
242 $debug and print STDERR "Q $orderby : $query\n";
243 $sth->execute(@bind);
245 $data = $sth->fetchall_arrayref({});
248 return ( scalar(@$data), $data );
251 =head2 GetMemberDetails
253 ($borrower) = &GetMemberDetails($borrowernumber, $cardnumber);
255 Looks up a patron and returns information about him or her. If
256 C<$borrowernumber> is true (nonzero), C<&GetMemberDetails> looks
257 up the borrower by number; otherwise, it looks up the borrower by card
260 C<$borrower> is a reference-to-hash whose keys are the fields of the
261 borrowers table in the Koha database. In addition,
262 C<$borrower-E<gt>{flags}> is a hash giving more detailed information
263 about the patron. Its keys act as flags :
265 if $borrower->{flags}->{LOST} {
266 # Patron's card was reported lost
269 If the state of a flag means that the patron should not be
270 allowed to borrow any more books, then it will have a C<noissues> key
273 See patronflags for more details.
275 C<$borrower-E<gt>{authflags}> is a hash giving more detailed information
276 about the top-level permissions flags set for the borrower. For example,
277 if a user has the "editcatalogue" permission,
278 C<$borrower-E<gt>{authflags}-E<gt>{editcatalogue}> will exist and have
283 sub GetMemberDetails {
284 my ( $borrowernumber, $cardnumber ) = @_;
285 my $dbh = C4::Context->dbh;
288 if ($borrowernumber) {
289 $sth = $dbh->prepare("select borrowers.*,category_type,categories.description from borrowers left join categories on borrowers.categorycode=categories.categorycode where borrowernumber=?");
290 $sth->execute($borrowernumber);
292 elsif ($cardnumber) {
293 $sth = $dbh->prepare("select borrowers.*,category_type,categories.description from borrowers left join categories on borrowers.categorycode=categories.categorycode where cardnumber=?");
294 $sth->execute($cardnumber);
299 my $borrower = $sth->fetchrow_hashref;
300 my ($amount) = GetMemberAccountRecords( $borrowernumber);
301 $borrower->{'amountoutstanding'} = $amount;
302 # FIXME - patronflags calls GetMemberAccountRecords... just have patronflags return $amount
303 my $flags = patronflags( $borrower);
306 $sth = $dbh->prepare("select bit,flag from userflags");
308 while ( my ( $bit, $flag ) = $sth->fetchrow ) {
309 if ( $borrower->{'flags'} && $borrower->{'flags'} & 2**$bit ) {
310 $accessflagshash->{$flag} = 1;
314 $borrower->{'flags'} = $flags;
315 $borrower->{'authflags'} = $accessflagshash;
317 # find out how long the membership lasts
320 "select enrolmentperiod from categories where categorycode = ?");
321 $sth->execute( $borrower->{'categorycode'} );
322 my $enrolment = $sth->fetchrow;
323 $borrower->{'enrolmentperiod'} = $enrolment;
324 return ($borrower); #, $flags, $accessflagshash);
329 $flags = &patronflags($patron);
331 This function is not exported.
333 The following will be set where applicable:
334 $flags->{CHARGES}->{amount} Amount of debt
335 $flags->{CHARGES}->{noissues} Set if debt amount >$5.00 (or syspref noissuescharge)
336 $flags->{CHARGES}->{message} Message -- deprecated
338 $flags->{CREDITS}->{amount} Amount of credit
339 $flags->{CREDITS}->{message} Message -- deprecated
341 $flags->{ GNA } Patron has no valid address
342 $flags->{ GNA }->{noissues} Set for each GNA
343 $flags->{ GNA }->{message} "Borrower has no valid address" -- deprecated
345 $flags->{ LOST } Patron's card reported lost
346 $flags->{ LOST }->{noissues} Set for each LOST
347 $flags->{ LOST }->{message} Message -- deprecated
349 $flags->{DBARRED} Set if patron debarred, no access
350 $flags->{DBARRED}->{noissues} Set for each DBARRED
351 $flags->{DBARRED}->{message} Message -- deprecated
354 $flags->{ NOTES }->{message} The note itself. NOT deprecated
356 $flags->{ ODUES } Set if patron has overdue books.
357 $flags->{ ODUES }->{message} "Yes" -- deprecated
358 $flags->{ ODUES }->{itemlist} ref-to-array: list of overdue books
359 $flags->{ ODUES }->{itemlisttext} Text list of overdue items -- deprecated
361 $flags->{WAITING} Set if any of patron's reserves are available
362 $flags->{WAITING}->{message} Message -- deprecated
363 $flags->{WAITING}->{itemlist} ref-to-array: list of available items
367 C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
368 overdue items. Its elements are references-to-hash, each describing an
369 overdue item. The keys are selected fields from the issues, biblio,
370 biblioitems, and items tables of the Koha database.
372 C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
373 the overdue items, one per line. Deprecated.
375 C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
376 available items. Each element is a reference-to-hash whose keys are
377 fields from the reserves table of the Koha database.
381 All the "message" fields that include language generated in this function are deprecated,
382 because such strings belong properly in the display layer.
384 The "message" field that comes from the DB is OK.
388 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
389 # FIXME rename this function.
392 my ( $patroninformation) = @_;
393 my $dbh=C4::Context->dbh;
394 my ($amount) = GetMemberAccountRecords( $patroninformation->{'borrowernumber'});
397 my $noissuescharge = C4::Context->preference("noissuescharge") || 5;
398 $flaginfo{'message'} = sprintf "Patron owes \$%.02f", $amount;
399 $flaginfo{'amount'} = sprintf "%.02f", $amount;
400 if ( $amount > $noissuescharge ) {
401 $flaginfo{'noissues'} = 1;
403 $flags{'CHARGES'} = \%flaginfo;
405 elsif ( $amount < 0 ) {
407 $flaginfo{'message'} = sprintf "Patron has credit of \$%.02f", -$amount;
408 $flaginfo{'amount'} = sprintf "%.02f", $amount;
409 $flags{'CREDITS'} = \%flaginfo;
411 if ( $patroninformation->{'gonenoaddress'}
412 && $patroninformation->{'gonenoaddress'} == 1 )
415 $flaginfo{'message'} = 'Borrower has no valid address.';
416 $flaginfo{'noissues'} = 1;
417 $flags{'GNA'} = \%flaginfo;
419 if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
421 $flaginfo{'message'} = 'Borrower\'s card reported lost.';
422 $flaginfo{'noissues'} = 1;
423 $flags{'LOST'} = \%flaginfo;
425 if ( $patroninformation->{'debarred'}
426 && $patroninformation->{'debarred'} == 1 )
429 $flaginfo{'message'} = 'Borrower is Debarred.';
430 $flaginfo{'noissues'} = 1;
431 $flags{'DBARRED'} = \%flaginfo;
433 if ( $patroninformation->{'borrowernotes'}
434 && $patroninformation->{'borrowernotes'} )
437 $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
438 $flags{'NOTES'} = \%flaginfo;
440 my ( $odues, $itemsoverdue ) = checkoverdues($patroninformation->{'borrowernumber'});
443 $flaginfo{'message'} = "Yes";
444 $flaginfo{'itemlist'} = $itemsoverdue;
445 foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
448 $flaginfo{'itemlisttext'} .=
449 "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n"; # newline is display layer
451 $flags{'ODUES'} = \%flaginfo;
453 my @itemswaiting = C4::Reserves::GetReservesFromBorrowernumber( $patroninformation->{'borrowernumber'},'W' );
454 my $nowaiting = scalar @itemswaiting;
455 if ( $nowaiting > 0 ) {
457 $flaginfo{'message'} = "Reserved items available";
458 $flaginfo{'itemlist'} = \@itemswaiting;
459 $flags{'WAITING'} = \%flaginfo;
467 $borrower = &GetMember($information, $type);
469 Looks up information about a patron (borrower) by either card number
470 ,firstname, or borrower number, depending on $type value.
471 If C<$type> == 'cardnumber', C<&GetBorrower>
472 searches by cardnumber then by firstname if not found in cardnumber;
473 otherwise, it searches by borrowernumber.
475 C<&GetBorrower> returns a reference-to-hash whose keys are the fields of
476 the C<borrowers> table in the Koha database.
482 my ( $information, $type ) = @_;
483 my $dbh = C4::Context->dbh;
486 SELECT borrowers.*, categories.category_type, categories.description
488 LEFT JOIN categories on borrowers.categorycode=categories.categorycode
490 if (defined($type) and ( $type eq 'cardnumber' || $type eq 'firstname'|| $type eq 'userid'|| $type eq 'borrowernumber' ) ){
491 $information = uc $information;
492 $sth = $dbh->prepare("$select WHERE $type=?");
494 $sth = $dbh->prepare("$select WHERE borrowernumber=?");
496 $sth->execute($information);
497 my $data = $sth->fetchrow_hashref;
498 ($data) and return ($data);
500 if (defined($type) and ($type eq 'cardnumber' || $type eq 'firstname')) { # otherwise, try with firstname
501 $sth = $dbh->prepare("$select WHERE firstname like ?");
502 $sth->execute($information);
503 $data = $sth->fetchrow_hashref;
504 ($data) and return ($data);
509 =head2 GetMemberIssuesAndFines
511 ($overdue_count, $issue_count, $total_fines) = &GetMemberIssuesAndFines($borrowernumber);
513 Returns aggregate data about items borrowed by the patron with the
514 given borrowernumber.
516 C<&GetMemberIssuesAndFines> returns a three-element array. C<$overdue_count> is the
517 number of overdue items the patron currently has borrowed. C<$issue_count> is the
518 number of books the patron currently has borrowed. C<$total_fines> is
519 the total fine currently due by the borrower.
524 sub GetMemberIssuesAndFines {
525 my ( $borrowernumber ) = @_;
526 my $dbh = C4::Context->dbh;
527 my $query = "SELECT COUNT(*) FROM issues WHERE borrowernumber = ?";
529 $debug and warn $query."\n";
530 my $sth = $dbh->prepare($query);
531 $sth->execute($borrowernumber);
532 my $issue_count = $sth->fetchrow_arrayref->[0];
535 $sth = $dbh->prepare(
536 "SELECT COUNT(*) FROM issues
537 WHERE borrowernumber = ?
538 AND date_due < now()"
540 $sth->execute($borrowernumber);
541 my $overdue_count = $sth->fetchrow_arrayref->[0];
544 $sth = $dbh->prepare("SELECT SUM(amountoutstanding) FROM accountlines WHERE borrowernumber = ?");
545 $sth->execute($borrowernumber);
546 my $total_fines = $sth->fetchrow_arrayref->[0];
549 return ($overdue_count, $issue_count, $total_fines);
553 return @{C4::Context->dbh->selectcol_arrayref("SHOW columns from borrowers")};
562 my $success = ModMember(borrowernumber => $borrowernumber, [ field => value ]... );
564 Modify borrower's data. All date fields should ALREADY be in ISO format.
567 true on success, or false on failure
575 my $dbh = C4::Context->dbh;
576 my $iso_re = C4::Dates->new()->regexp('iso');
577 foreach (qw(dateofbirth dateexpiry dateenrolled)) {
578 if (my $tempdate = $data{$_}) { # assignment, not comparison
579 ($tempdate =~ /$iso_re/) and next; # Congatulations, you sent a valid ISO date.
580 warn "ModMember given $_ not in ISO format ($tempdate)";
581 my $tempdate2 = format_date_in_iso($tempdate);
582 if (!$tempdate2 or $tempdate2 eq '0000-00-00') {
583 warn "ModMember cannot convert '$tempdate' (from syspref to ISO)";
586 $data{$_} = $tempdate2;
589 if (!$data{'dateofbirth'}){
590 delete $data{'dateofbirth'};
592 my @columns = &columns;
593 my %hashborrowerfields = (map {$_=>1} @columns);
594 my $query = "UPDATE borrowers SET \n";
598 # test to know if you must update or not the borrower password
599 if (exists $data{password}) {
600 if ($data{password} eq '****' or $data{password} eq '') {
601 delete $data{password};
603 $data{password} = md5_base64($data{password});
607 foreach (keys %data) {
608 next if ($_ eq 'borrowernumber' or $_ eq 'flags');
609 if ($hashborrowerfields{$_}){
611 push @parameters,$data{$_};
617 (@badkeys) and warn scalar(@badkeys) . " Illegal key(s) passed to ModMember: " . join(',',@badkeys);
619 $query .= " WHERE borrowernumber=?";
620 push @parameters, $data{'borrowernumber'};
621 $debug and print STDERR "$query (executed w/ arg: $data{'borrowernumber'})";
622 $sth = $dbh->prepare($query);
623 my $execute_success = $sth->execute(@parameters);
626 # ok if its an adult (type) it may have borrowers that depend on it as a guarantor
627 # so when we update information for an adult we should check for guarantees and update the relevant part
628 # of their records, ie addresses and phone numbers
629 my $borrowercategory= GetBorrowercategory( $data{'category_type'} );
630 if ( exists $borrowercategory->{'category_type'} && $borrowercategory->{'category_type'} eq ('A' || 'S') ) {
631 # is adult check guarantees;
632 UpdateGuarantees(%data);
634 logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "$query (executed w/ arg: $data{'borrowernumber'})")
635 if C4::Context->preference("BorrowersLog");
637 return $execute_success;
645 $borrowernumber = &AddMember(%borrower);
647 insert new borrower into table
648 Returns the borrowernumber
655 my $dbh = C4::Context->dbh;
656 $data{'userid'} = '' unless $data{'password'};
657 $data{'password'} = md5_base64( $data{'password'} ) if $data{'password'};
659 # WE SHOULD NEVER PASS THIS SUBROUTINE ANYTHING OTHER THAN ISO DATES
660 # IF YOU UNCOMMENT THESE LINES YOU BETTER HAVE A DARN COMPELLING REASON
661 # $data{'dateofbirth'} = format_date_in_iso( $data{'dateofbirth'} );
662 # $data{'dateenrolled'} = format_date_in_iso( $data{'dateenrolled'});
663 # $data{'dateexpiry'} = format_date_in_iso( $data{'dateexpiry'} );
664 # This query should be rewritten to use "?" at execute.
665 if (!$data{'dateofbirth'}){
666 undef ($data{'dateofbirth'});
669 "insert into borrowers set cardnumber=" . $dbh->quote( $data{'cardnumber'} )
670 . ",surname=" . $dbh->quote( $data{'surname'} )
671 . ",firstname=" . $dbh->quote( $data{'firstname'} )
672 . ",title=" . $dbh->quote( $data{'title'} )
673 . ",othernames=" . $dbh->quote( $data{'othernames'} )
674 . ",initials=" . $dbh->quote( $data{'initials'} )
675 . ",streetnumber=". $dbh->quote( $data{'streetnumber'} )
676 . ",streettype=" . $dbh->quote( $data{'streettype'} )
677 . ",address=" . $dbh->quote( $data{'address'} )
678 . ",address2=" . $dbh->quote( $data{'address2'} )
679 . ",zipcode=" . $dbh->quote( $data{'zipcode'} )
680 . ",country=" . $dbh->quote( $data{'country'} )
681 . ",city=" . $dbh->quote( $data{'city'} )
682 . ",phone=" . $dbh->quote( $data{'phone'} )
683 . ",email=" . $dbh->quote( $data{'email'} )
684 . ",mobile=" . $dbh->quote( $data{'mobile'} )
685 . ",phonepro=" . $dbh->quote( $data{'phonepro'} )
686 . ",opacnote=" . $dbh->quote( $data{'opacnote'} )
687 . ",guarantorid=" . $dbh->quote( $data{'guarantorid'} )
688 . ",dateofbirth=" . $dbh->quote( $data{'dateofbirth'} )
689 . ",branchcode=" . $dbh->quote( $data{'branchcode'} )
690 . ",categorycode=" . $dbh->quote( $data{'categorycode'} )
691 . ",dateenrolled=" . $dbh->quote( $data{'dateenrolled'} )
692 . ",contactname=" . $dbh->quote( $data{'contactname'} )
693 . ",borrowernotes=" . $dbh->quote( $data{'borrowernotes'} )
694 . ",dateexpiry=" . $dbh->quote( $data{'dateexpiry'} )
695 . ",contactnote=" . $dbh->quote( $data{'contactnote'} )
696 . ",B_address=" . $dbh->quote( $data{'B_address'} )
697 . ",B_address2=" . $dbh->quote( $data{'B_address2'} )
698 . ",B_zipcode=" . $dbh->quote( $data{'B_zipcode'} )
699 . ",B_country=" . $dbh->quote( $data{'B_country'} )
700 . ",B_city=" . $dbh->quote( $data{'B_city'} )
701 . ",B_phone=" . $dbh->quote( $data{'B_phone'} )
702 . ",B_email=" . $dbh->quote( $data{'B_email'} )
703 . ",password=" . $dbh->quote( $data{'password'} )
704 . ",userid=" . $dbh->quote( $data{'userid'} )
705 . ",sort1=" . $dbh->quote( $data{'sort1'} )
706 . ",sort2=" . $dbh->quote( $data{'sort2'} )
707 . ",contacttitle=" . $dbh->quote( $data{'contacttitle'} )
708 . ",emailpro=" . $dbh->quote( $data{'emailpro'} )
709 . ",contactfirstname=" . $dbh->quote( $data{'contactfirstname'} )
710 . ",sex=" . $dbh->quote( $data{'sex'} )
711 . ",fax=" . $dbh->quote( $data{'fax'} )
712 . ",relationship=" . $dbh->quote( $data{'relationship'} )
713 . ",B_streetnumber=" . $dbh->quote( $data{'B_streetnumber'} )
714 . ",B_streettype=" . $dbh->quote( $data{'B_streettype'} )
715 . ",gonenoaddress=" . $dbh->quote( $data{'gonenoaddress'} )
716 . ",lost=" . $dbh->quote( $data{'lost'} )
717 . ",debarred=" . $dbh->quote( $data{'debarred'} )
718 . ",ethnicity=" . $dbh->quote( $data{'ethnicity'} )
719 . ",ethnotes=" . $dbh->quote( $data{'ethnotes'} )
720 . ",altcontactsurname=" . $dbh->quote( $data{'altcontactsurname'} )
721 . ",altcontactfirstname=" . $dbh->quote( $data{'altcontactfirstname'} )
722 . ",altcontactaddress1=" . $dbh->quote( $data{'altcontactaddress1'} )
723 . ",altcontactaddress2=" . $dbh->quote( $data{'altcontactaddress2'} )
724 . ",altcontactaddress3=" . $dbh->quote( $data{'altcontactaddress3'} )
725 . ",altcontactzipcode=" . $dbh->quote( $data{'altcontactzipcode'} )
726 . ",altcontactcountry=" . $dbh->quote( $data{'altcontactcountry'} )
727 . ",altcontactphone=" . $dbh->quote( $data{'altcontactphone'} ) ;
728 $debug and print STDERR "AddMember SQL: ($query)\n";
729 my $sth = $dbh->prepare($query);
730 # print "Executing SQL: $query\n";
733 $data{'borrowernumber'} = $dbh->{'mysql_insertid'}; # unneeded w/ autoincrement ?
734 # mysql_insertid is probably bad. not necessarily accurate and mysql-specific at best.
736 logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
738 # check for enrollment fee & add it if needed
739 $sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
740 $sth->execute($data{'categorycode'});
741 my ($enrolmentfee) = $sth->fetchrow;
742 if ($enrolmentfee && $enrolmentfee > 0) {
743 # insert fee in patron debts
744 manualinvoice($data{'borrowernumber'}, '', '', 'A', $enrolmentfee);
746 return $data{'borrowernumber'};
750 my ($uid,$member) = @_;
751 my $dbh = C4::Context->dbh;
752 # Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
753 # Then we need to tell the user and have them create a new one.
756 "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
757 $sth->execute( $uid, $member );
758 if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
766 sub Generate_Userid {
767 my ($borrowernumber, $firstname, $surname) = @_;
771 $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
772 $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
773 $newuid = lc("$firstname.$surname");
774 $newuid .= $offset unless $offset == 0;
777 } while (!Check_Userid($newuid,$borrowernumber));
783 my ( $uid, $member, $digest ) = @_;
784 my $dbh = C4::Context->dbh;
786 #Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
787 #Then we need to tell the user and have them create a new one.
791 "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
792 $sth->execute( $uid, $member );
793 if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
797 #Everything is good so we can update the information.
800 "update borrowers set userid=?, password=? where borrowernumber=?");
801 $sth->execute( $uid, $digest, $member );
805 logaction("MEMBERS", "CHANGE PASS", $member, "") if C4::Context->preference("BorrowersLog");
811 =head2 fixup_cardnumber
813 Warning: The caller is responsible for locking the members table in write
814 mode, to avoid database corruption.
818 use vars qw( @weightings );
819 my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
821 sub fixup_cardnumber ($) {
822 my ($cardnumber) = @_;
823 my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;
825 # Find out whether member numbers should be generated
826 # automatically. Should be either "1" or something else.
827 # Defaults to "0", which is interpreted as "no".
829 # if ($cardnumber !~ /\S/ && $autonumber_members) {
830 ($autonumber_members) or return $cardnumber;
831 my $checkdigit = C4::Context->preference('checkdigit');
832 my $dbh = C4::Context->dbh;
833 if ( $checkdigit and $checkdigit eq 'katipo' ) {
835 # if checkdigit is selected, calculate katipo-style cardnumber.
836 # otherwise, just use the max()
837 # purpose: generate checksum'd member numbers.
838 # We'll assume we just got the max value of digits 2-8 of member #'s
839 # from the database and our job is to increment that by one,
840 # determine the 1st and 9th digits and return the full string.
841 my $sth = $dbh->prepare(
842 "select max(substring(borrowers.cardnumber,2,7)) as new_num from borrowers"
845 my $data = $sth->fetchrow_hashref;
846 $cardnumber = $data->{new_num};
847 if ( !$cardnumber ) { # If DB has no values,
848 $cardnumber = 1000000; # start at 1000000
854 for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
855 # read weightings, left to right, 1 char at a time
856 my $temp1 = $weightings[$i];
858 # sequence left to right, 1 char at a time
859 my $temp2 = substr( $cardnumber, $i, 1 );
861 # mult each char 1-7 by its corresponding weighting
862 $sum += $temp1 * $temp2;
865 my $rem = ( $sum % 11 );
866 $rem = 'X' if $rem == 10;
868 return "V$cardnumber$rem";
871 # MODIFIED BY JF: mysql4.1 allows casting as an integer, which is probably
872 # better. I'll leave the original in in case it needs to be changed for you
873 # my $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers");
874 my $sth = $dbh->prepare(
875 "select max(cast(cardnumber as signed)) from borrowers"
878 my ($result) = $sth->fetchrow;
881 return $cardnumber; # just here as a fallback/reminder
886 ($num_children, $children_arrayref) = &GetGuarantees($parent_borrno);
887 $child0_cardno = $children_arrayref->[0]{"cardnumber"};
888 $child0_borrno = $children_arrayref->[0]{"borrowernumber"};
890 C<&GetGuarantees> takes a borrower number (e.g., that of a patron
891 with children) and looks up the borrowers who are guaranteed by that
892 borrower (i.e., the patron's children).
894 C<&GetGuarantees> returns two values: an integer giving the number of
895 borrowers guaranteed by C<$parent_borrno>, and a reference to an array
896 of references to hash, which gives the actual results.
902 my ($borrowernumber) = @_;
903 my $dbh = C4::Context->dbh;
906 "select cardnumber,borrowernumber, firstname, surname from borrowers where guarantorid=?"
908 $sth->execute($borrowernumber);
911 my $data = $sth->fetchall_arrayref({});
913 return ( scalar(@$data), $data );
916 =head2 UpdateGuarantees
918 &UpdateGuarantees($parent_borrno);
921 C<&UpdateGuarantees> borrower data for an adult and updates all the guarantees
922 with the modified information
927 sub UpdateGuarantees {
929 my $dbh = C4::Context->dbh;
930 my ( $count, $guarantees ) = GetGuarantees( $data{'borrowernumber'} );
931 for ( my $i = 0 ; $i < $count ; $i++ ) {
934 # It looks like the $i is only being returned to handle walking through
935 # the array, which is probably better done as a foreach loop.
937 my $guaquery = qq|UPDATE borrowers
938 SET address='$data{'address'}',fax='$data{'fax'}',
939 B_city='$data{'B_city'}',mobile='$data{'mobile'}',city='$data{'city'}',phone='$data{'phone'}'
940 WHERE borrowernumber='$guarantees->[$i]->{'borrowernumber'}'
942 my $sth3 = $dbh->prepare($guaquery);
947 =head2 GetPendingIssues
949 my $issues = &GetPendingIssues($borrowernumber);
951 Looks up what the patron with the given borrowernumber has borrowed.
953 C<&GetPendingIssues> returns a
954 reference-to-array where each element is a reference-to-hash; the
955 keys are the fields from the C<issues>, C<biblio>, and C<items> tables.
956 The keys include C<biblioitems> fields except marc and marcxml.
961 sub GetPendingIssues {
962 my ($borrowernumber) = @_;
963 # must avoid biblioitems.* to prevent large marc and marcxml fields from killing performance
964 # FIXME: namespace collision: each table has "timestamp" fields. Which one is "timestamp" ?
965 # FIXME: circ/ciculation.pl tries to sort by timestamp!
966 # FIXME: C4::Print::printslip tries to sort by timestamp!
967 # FIXME: namespace collision: other collisions possible.
968 # FIXME: most of this data isn't really being used by callers.
969 my $sth = C4::Context->dbh->prepare(
975 biblioitems.itemtype,
978 biblioitems.publicationyear,
979 biblioitems.publishercode,
980 biblioitems.volumedate,
981 biblioitems.volumedesc,
984 issues.timestamp AS timestamp,
985 issues.renewals AS renewals,
986 items.renewals AS totalrenewals
988 LEFT JOIN items ON items.itemnumber = issues.itemnumber
989 LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
990 LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
993 ORDER BY issues.issuedate"
995 $sth->execute($borrowernumber);
996 my $data = $sth->fetchall_arrayref({});
997 my $today = C4::Dates->new->output('iso');
999 $_->{date_due} or next;
1000 ($_->{date_due} lt $today) and $_->{overdue} = 1;
1007 ($count, $issues) = &GetAllIssues($borrowernumber, $sortkey, $limit);
1009 Looks up what the patron with the given borrowernumber has borrowed,
1010 and sorts the results.
1012 C<$sortkey> is the name of a field on which to sort the results. This
1013 should be the name of a field in the C<issues>, C<biblio>,
1014 C<biblioitems>, or C<items> table in the Koha database.
1016 C<$limit> is the maximum number of results to return.
1018 C<&GetAllIssues> returns a two-element array. C<$issues> is a
1019 reference-to-array, where each element is a reference-to-hash; the
1020 keys are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
1021 C<items> tables of the Koha database. C<$count> is the number of
1022 elements in C<$issues>
1028 my ( $borrowernumber, $order, $limit ) = @_;
1030 #FIXME: sanity-check order and limit
1031 my $dbh = C4::Context->dbh;
1034 "SELECT *,issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1036 LEFT JOIN items on items.itemnumber=issues.itemnumber
1037 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1038 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1039 WHERE borrowernumber=?
1041 SELECT *,old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1043 LEFT JOIN items on items.itemnumber=old_issues.itemnumber
1044 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1045 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1046 WHERE borrowernumber=?
1048 if ( $limit != 0 ) {
1049 $query .= " limit $limit";
1053 my $sth = $dbh->prepare($query);
1054 $sth->execute($borrowernumber, $borrowernumber);
1057 while ( my $data = $sth->fetchrow_hashref ) {
1058 $result[$i] = $data;
1063 # get all issued items for borrowernumber from oldissues table
1064 # large chunk of older issues data put into table oldissues
1065 # to speed up db calls for issuing items
1066 if ( C4::Context->preference("ReadingHistory") ) {
1067 # FIXME oldissues (not to be confused with old_issues) is
1068 # apparently specific to HLT. Not sure if the ReadingHistory
1069 # syspref is still required, as old_issues by design
1070 # is no longer checked with each loan.
1071 my $query2 = "SELECT * FROM oldissues
1072 LEFT JOIN items ON items.itemnumber=oldissues.itemnumber
1073 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1074 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1075 WHERE borrowernumber=?
1077 if ( $limit != 0 ) {
1078 $limit = $limit - $count;
1079 $query2 .= " limit $limit";
1082 my $sth2 = $dbh->prepare($query2);
1083 $sth2->execute($borrowernumber);
1085 while ( my $data2 = $sth2->fetchrow_hashref ) {
1086 $result[$i] = $data2;
1093 return ( $i, \@result );
1097 =head2 GetMemberAccountRecords
1099 ($total, $acctlines, $count) = &GetMemberAccountRecords($borrowernumber);
1101 Looks up accounting data for the patron with the given borrowernumber.
1103 C<&GetMemberAccountRecords> returns a three-element array. C<$acctlines> is a
1104 reference-to-array, where each element is a reference-to-hash; the
1105 keys are the fields of the C<accountlines> table in the Koha database.
1106 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1107 total amount outstanding for all of the account lines.
1112 sub GetMemberAccountRecords {
1113 my ($borrowernumber,$date) = @_;
1114 my $dbh = C4::Context->dbh;
1120 WHERE borrowernumber=?);
1121 my @bind = ($borrowernumber);
1122 if ($date && $date ne ''){
1123 $strsth.=" AND date < ? ";
1126 $strsth.=" ORDER BY date desc,timestamp DESC";
1127 my $sth= $dbh->prepare( $strsth );
1128 $sth->execute( @bind );
1130 while ( my $data = $sth->fetchrow_hashref ) {
1131 my $biblio = GetBiblioFromItemNumber($data->{itemnumber}) if $data->{itemnumber};
1132 $data->{biblionumber} = $biblio->{biblionumber};
1133 $data->{title} = $biblio->{title};
1134 $acctlines[$numlines] = $data;
1136 $total += int(1000 * $data->{'amountoutstanding'}); # convert float to integer to avoid round-off errors
1140 return ( $total, \@acctlines,$numlines);
1143 =head2 GetBorNotifyAcctRecord
1145 ($count, $acctlines, $total) = &GetBorNotifyAcctRecord($params,$notifyid);
1147 Looks up accounting data for the patron with the given borrowernumber per file number.
1149 (FIXME - I'm not at all sure what this is about.)
1151 C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a
1152 reference-to-array, where each element is a reference-to-hash; the
1153 keys are the fields of the C<accountlines> table in the Koha database.
1154 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1155 total amount outstanding for all of the account lines.
1159 sub GetBorNotifyAcctRecord {
1160 my ( $borrowernumber, $notifyid ) = @_;
1161 my $dbh = C4::Context->dbh;
1164 my $sth = $dbh->prepare(
1167 WHERE borrowernumber=?
1169 AND amountoutstanding != '0'
1170 ORDER BY notify_id,accounttype
1172 # 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')
1174 $sth->execute( $borrowernumber, $notifyid );
1176 while ( my $data = $sth->fetchrow_hashref ) {
1177 $acctlines[$numlines] = $data;
1179 $total += int(100 * $data->{'amountoutstanding'});
1183 return ( $total, \@acctlines, $numlines );
1186 =head2 checkuniquemember (OUEST-PROVENCE)
1188 ($result,$categorycode) = &checkuniquemember($collectivity,$surname,$firstname,$dateofbirth);
1190 Checks that a member exists or not in the database.
1192 C<&result> is nonzero (=exist) or 0 (=does not exist)
1193 C<&categorycode> is from categorycode table
1194 C<&collectivity> is 1 (= we add a collectivity) or 0 (= we add a physical member)
1195 C<&surname> is the surname
1196 C<&firstname> is the firstname (only if collectivity=0)
1197 C<&dateofbirth> is the date of birth in ISO format (only if collectivity=0)
1201 # FIXME: This function is not legitimate. Multiple patrons might have the same first/last name and birthdate.
1202 # This is especially true since first name is not even a required field.
1204 sub checkuniquemember {
1205 my ( $collectivity, $surname, $firstname, $dateofbirth ) = @_;
1206 my $dbh = C4::Context->dbh;
1207 my $request = ($collectivity) ?
1208 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? " :
1210 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=? and dateofbirth=?" :
1211 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=?";
1212 my $sth = $dbh->prepare($request);
1213 if ($collectivity) {
1214 $sth->execute( uc($surname) );
1215 } elsif($dateofbirth){
1216 $sth->execute( uc($surname), ucfirst($firstname), $dateofbirth );
1218 $sth->execute( uc($surname), ucfirst($firstname));
1220 my @data = $sth->fetchrow;
1222 ( $data[0] ) and return $data[0], $data[1];
1226 sub checkcardnumber {
1227 my ($cardnumber,$borrowernumber) = @_;
1228 my $dbh = C4::Context->dbh;
1229 my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
1230 $query .= " AND borrowernumber <> ?" if ($borrowernumber);
1231 my $sth = $dbh->prepare($query);
1232 if ($borrowernumber) {
1233 $sth->execute($cardnumber,$borrowernumber);
1235 $sth->execute($cardnumber);
1237 if (my $data= $sth->fetchrow_hashref()){
1247 =head2 getzipnamecity (OUEST-PROVENCE)
1249 take all info from table city for the fields city and zip
1250 check for the name and the zip code of the city selected
1254 sub getzipnamecity {
1256 my $dbh = C4::Context->dbh;
1259 "select city_name,city_zipcode from cities where cityid=? ");
1260 $sth->execute($cityid);
1261 my @data = $sth->fetchrow;
1262 return $data[0], $data[1];
1266 =head2 getdcity (OUEST-PROVENCE)
1268 recover cityid with city_name condition
1273 my ($city_name) = @_;
1274 my $dbh = C4::Context->dbh;
1275 my $sth = $dbh->prepare("select cityid from cities where city_name=? ");
1276 $sth->execute($city_name);
1277 my $data = $sth->fetchrow;
1282 =head2 GetExpiryDate
1284 $expirydate = GetExpiryDate($categorycode, $dateenrolled);
1286 Calculate expiry date given a categorycode and starting date. Date argument must be in ISO format.
1287 Return date is also in ISO format.
1292 my ( $categorycode, $dateenrolled ) = @_;
1293 my $enrolmentperiod = 12; # reasonable default
1294 if ($categorycode) {
1295 my $dbh = C4::Context->dbh;
1296 my $sth = $dbh->prepare("select enrolmentperiod from categories where categorycode=?");
1297 $sth->execute($categorycode);
1298 $enrolmentperiod = $sth->fetchrow;
1300 # die "GetExpiryDate: for enrollmentperiod $enrolmentperiod (category '$categorycode') starting $dateenrolled.\n";
1301 my @date = split /-/,$dateenrolled;
1302 return sprintf("%04d-%02d-%02d", Add_Delta_YM(@date,0,$enrolmentperiod));
1305 =head2 checkuserpassword (OUEST-PROVENCE)
1307 check for the password and login are not used
1308 return the number of record
1309 0=> NOT USED 1=> USED
1313 sub checkuserpassword {
1314 my ( $borrowernumber, $userid, $password ) = @_;
1315 $password = md5_base64($password);
1316 my $dbh = C4::Context->dbh;
1319 "Select count(*) from borrowers where borrowernumber !=? and userid =? and password=? "
1321 $sth->execute( $borrowernumber, $userid, $password );
1322 my $number_rows = $sth->fetchrow;
1323 return $number_rows;
1327 =head2 GetborCatFromCatType
1329 ($codes_arrayref, $labels_hashref) = &GetborCatFromCatType();
1331 Looks up the different types of borrowers in the database. Returns two
1332 elements: a reference-to-array, which lists the borrower category
1333 codes, and a reference-to-hash, which maps the borrower category codes
1334 to category descriptions.
1339 sub GetborCatFromCatType {
1340 my ( $category_type, $action ) = @_;
1341 # FIXME - This API seems both limited and dangerous.
1342 my $dbh = C4::Context->dbh;
1343 my $request = qq| SELECT categorycode,description
1346 ORDER BY categorycode|;
1347 my $sth = $dbh->prepare($request);
1349 $sth->execute($category_type);
1358 while ( my $data = $sth->fetchrow_hashref ) {
1359 push @codes, $data->{'categorycode'};
1360 $labels{ $data->{'categorycode'} } = $data->{'description'};
1363 return ( \@codes, \%labels );
1366 =head2 GetBorrowercategory
1368 $hashref = &GetBorrowercategory($categorycode);
1370 Given the borrower's category code, the function returns the corresponding
1371 data hashref for a comprehensive information display.
1373 $arrayref_hashref = &GetBorrowercategory;
1374 If no category code provided, the function returns all the categories.
1378 sub GetBorrowercategory {
1380 my $dbh = C4::Context->dbh;
1384 "SELECT description,dateofbirthrequired,upperagelimit,category_type
1386 WHERE categorycode = ?"
1388 $sth->execute($catcode);
1390 $sth->fetchrow_hashref;
1395 } # sub getborrowercategory
1397 =head2 GetBorrowercategoryList
1399 $arrayref_hashref = &GetBorrowercategoryList;
1400 If no category code provided, the function returns all the categories.
1404 sub GetBorrowercategoryList {
1405 my $dbh = C4::Context->dbh;
1410 ORDER BY description"
1414 $sth->fetchall_arrayref({});
1417 } # sub getborrowercategory
1419 =head2 ethnicitycategories
1421 ($codes_arrayref, $labels_hashref) = ðnicitycategories();
1423 Looks up the different ethnic types in the database. Returns two
1424 elements: a reference-to-array, which lists the ethnicity codes, and a
1425 reference-to-hash, which maps the ethnicity codes to ethnicity
1432 sub ethnicitycategories {
1433 my $dbh = C4::Context->dbh;
1434 my $sth = $dbh->prepare("Select code,name from ethnicity order by name");
1438 while ( my $data = $sth->fetchrow_hashref ) {
1439 push @codes, $data->{'code'};
1440 $labels{ $data->{'code'} } = $data->{'name'};
1443 return ( \@codes, \%labels );
1448 $ethn_name = &fixEthnicity($ethn_code);
1450 Takes an ethnicity code (e.g., "european" or "pi") and returns the
1451 corresponding descriptive name from the C<ethnicity> table in the
1452 Koha database ("European" or "Pacific Islander").
1459 my $ethnicity = shift;
1460 return unless $ethnicity;
1461 my $dbh = C4::Context->dbh;
1462 my $sth = $dbh->prepare("Select name from ethnicity where code = ?");
1463 $sth->execute($ethnicity);
1464 my $data = $sth->fetchrow_hashref;
1466 return $data->{'name'};
1467 } # sub fixEthnicity
1471 $dateofbirth,$date = &GetAge($date);
1473 this function return the borrowers age with the value of dateofbirth
1479 my ( $date, $date_ref ) = @_;
1481 if ( not defined $date_ref ) {
1482 $date_ref = sprintf( '%04d-%02d-%02d', Today() );
1485 my ( $year1, $month1, $day1 ) = split /-/, $date;
1486 my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
1488 my $age = $year2 - $year1;
1489 if ( $month1 . $day1 > $month2 . $day2 ) {
1496 =head2 get_institutions
1497 $insitutions = get_institutions();
1499 Just returns a list of all the borrowers of type I, borrownumber and name
1504 sub get_institutions {
1505 my $dbh = C4::Context->dbh();
1508 "SELECT borrowernumber,surname FROM borrowers WHERE categorycode=? ORDER BY surname"
1512 while ( my $data = $sth->fetchrow_hashref() ) {
1513 $orgs{ $data->{'borrowernumber'} } = $data;
1518 } # sub get_institutions
1520 =head2 add_member_orgs
1522 add_member_orgs($borrowernumber,$borrowernumbers);
1524 Takes a borrowernumber and a list of other borrowernumbers and inserts them into the borrowers_to_borrowers table
1529 sub add_member_orgs {
1530 my ( $borrowernumber, $otherborrowers ) = @_;
1531 my $dbh = C4::Context->dbh();
1533 "INSERT INTO borrowers_to_borrowers (borrower1,borrower2) VALUES (?,?)";
1534 my $sth = $dbh->prepare($query);
1535 foreach my $otherborrowernumber (@$otherborrowers) {
1536 $sth->execute( $borrowernumber, $otherborrowernumber );
1540 } # sub add_member_orgs
1542 =head2 GetCities (OUEST-PROVENCE)
1544 ($id_cityarrayref, $city_hashref) = &GetCities();
1546 Looks up the different city and zip in the database. Returns two
1547 elements: a reference-to-array, which lists the zip city
1548 codes, and a reference-to-hash, which maps the name of the city.
1549 WHERE =>OUEST PROVENCE OR EXTERIEUR
1555 #my ($type_city) = @_;
1556 my $dbh = C4::Context->dbh;
1557 my $query = qq|SELECT cityid,city_zipcode,city_name
1559 ORDER BY city_name|;
1560 my $sth = $dbh->prepare($query);
1562 #$sth->execute($type_city);
1566 # insert empty value to create a empty choice in cgi popup
1569 while ( my $data = $sth->fetchrow_hashref ) {
1570 push @id, $data->{'city_zipcode'}."|".$data->{'city_name'};
1571 $city{ $data->{'city_zipcode'}."|".$data->{'city_name'} } = $data->{'city_name'};
1574 #test to know if the table contain some records if no the function return nothing
1578 # all we have is the one blank row
1583 return ( \@id, \%city );
1587 =head2 GetSortDetails (OUEST-PROVENCE)
1589 ($lib) = &GetSortDetails($category,$sortvalue);
1591 Returns the authorized value details
1592 C<&$lib>return value of authorized value details
1593 C<&$sortvalue>this is the value of authorized value
1594 C<&$category>this is the value of authorized value category
1598 sub GetSortDetails {
1599 my ( $category, $sortvalue ) = @_;
1600 my $dbh = C4::Context->dbh;
1601 my $query = qq|SELECT lib
1602 FROM authorised_values
1604 AND authorised_value=? |;
1605 my $sth = $dbh->prepare($query);
1606 $sth->execute( $category, $sortvalue );
1607 my $lib = $sth->fetchrow;
1608 return ($lib) if ($lib);
1609 return ($sortvalue) unless ($lib);
1612 =head2 MoveMemberToDeleted
1614 $result = &MoveMemberToDeleted($borrowernumber);
1616 Copy the record from borrowers to deletedborrowers table.
1620 # FIXME: should do it in one SQL statement w/ subquery
1621 # Otherwise, we should return the @data on success
1623 sub MoveMemberToDeleted {
1624 my ($member) = shift or return;
1625 my $dbh = C4::Context->dbh;
1626 my $query = qq|SELECT *
1628 WHERE borrowernumber=?|;
1629 my $sth = $dbh->prepare($query);
1630 $sth->execute($member);
1631 my @data = $sth->fetchrow_array;
1632 (@data) or return; # if we got a bad borrowernumber, there's nothing to insert
1634 $dbh->prepare( "INSERT INTO deletedborrowers VALUES ("
1635 . ( "?," x ( scalar(@data) - 1 ) )
1637 $sth->execute(@data);
1642 DelMember($borrowernumber);
1644 This function remove directly a borrower whitout writing it on deleteborrower.
1645 + Deletes reserves for the borrower
1650 my $dbh = C4::Context->dbh;
1651 my $borrowernumber = shift;
1652 #warn "in delmember with $borrowernumber";
1653 return unless $borrowernumber; # borrowernumber is mandatory.
1655 my $query = qq|DELETE
1657 WHERE borrowernumber=?|;
1658 my $sth = $dbh->prepare($query);
1659 $sth->execute($borrowernumber);
1664 WHERE borrowernumber = ?
1666 $sth = $dbh->prepare($query);
1667 $sth->execute($borrowernumber);
1669 logaction("MEMBERS", "DELETE", $borrowernumber, "") if C4::Context->preference("BorrowersLog");
1673 =head2 ExtendMemberSubscriptionTo (OUEST-PROVENCE)
1675 $date = ExtendMemberSubscriptionTo($borrowerid, $date);
1677 Extending the subscription to a given date or to the expiry date calculated on ISO date.
1682 sub ExtendMemberSubscriptionTo {
1683 my ( $borrowerid,$date) = @_;
1684 my $dbh = C4::Context->dbh;
1685 my $borrower = GetMember($borrowerid,'borrowernumber');
1687 $date=POSIX::strftime("%Y-%m-%d",localtime());
1688 my $borrower = GetMember($borrowerid,'borrowernumber');
1689 $date = GetExpiryDate( $borrower->{'categorycode'}, $date );
1691 my $sth = $dbh->do(<<EOF);
1693 SET dateexpiry='$date'
1694 WHERE borrowernumber='$borrowerid'
1696 # add enrolmentfee if needed
1697 $sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
1698 $sth->execute($borrower->{'categorycode'});
1699 my ($enrolmentfee) = $sth->fetchrow;
1700 if ($enrolmentfee && $enrolmentfee > 0) {
1701 # insert fee in patron debts
1702 manualinvoice($borrower->{'borrowernumber'}, '', '', 'A', $enrolmentfee);
1704 return $date if ($sth);
1708 =head2 GetRoadTypes (OUEST-PROVENCE)
1710 ($idroadtypearrayref, $roadttype_hashref) = &GetRoadTypes();
1712 Looks up the different road type . Returns two
1713 elements: a reference-to-array, which lists the id_roadtype
1714 codes, and a reference-to-hash, which maps the road type of the road .
1719 my $dbh = C4::Context->dbh;
1721 SELECT roadtypeid,road_type
1723 ORDER BY road_type|;
1724 my $sth = $dbh->prepare($query);
1729 # insert empty value to create a empty choice in cgi popup
1731 while ( my $data = $sth->fetchrow_hashref ) {
1733 push @id, $data->{'roadtypeid'};
1734 $roadtype{ $data->{'roadtypeid'} } = $data->{'road_type'};
1737 #test to know if the table contain some records if no the function return nothing
1745 return ( \@id, \%roadtype );
1751 =head2 GetTitles (OUEST-PROVENCE)
1753 ($borrowertitle)= &GetTitles();
1755 Looks up the different title . Returns array with all borrowers title
1760 my @borrowerTitle = split /,|\|/,C4::Context->preference('BorrowersTitles');
1761 unshift( @borrowerTitle, "" );
1762 my $count=@borrowerTitle;
1767 return ( \@borrowerTitle);
1771 =head2 GetPatronImage
1773 my ($imagedata, $dberror) = GetPatronImage($cardnumber);
1775 Returns the mimetype and binary image data of the image for the patron with the supplied cardnumber.
1779 sub GetPatronImage {
1780 my ($cardnumber) = @_;
1781 warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1782 my $dbh = C4::Context->dbh;
1783 my $query = 'SELECT mimetype, imagefile FROM patronimage WHERE cardnumber = ?';
1784 my $sth = $dbh->prepare($query);
1785 $sth->execute($cardnumber);
1786 my $imagedata = $sth->fetchrow_hashref;
1787 warn "Database error!" if $sth->errstr;
1788 return $imagedata, $sth->errstr;
1791 =head2 PutPatronImage
1793 PutPatronImage($cardnumber, $mimetype, $imgfile);
1795 Stores patron binary image data and mimetype in database.
1796 NOTE: This function is good for updating images as well as inserting new images in the database.
1800 sub PutPatronImage {
1801 my ($cardnumber, $mimetype, $imgfile) = @_;
1802 warn "Parameters passed in: Cardnumber=$cardnumber, Mimetype=$mimetype, " . ($imgfile ? "Imagefile" : "No Imagefile") if $debug;
1803 my $dbh = C4::Context->dbh;
1804 my $query = "INSERT INTO patronimage (cardnumber, mimetype, imagefile) VALUES (?,?,?) ON DUPLICATE KEY UPDATE imagefile = ?;";
1805 my $sth = $dbh->prepare($query);
1806 $sth->execute($cardnumber,$mimetype,$imgfile,$imgfile);
1807 warn "Error returned inserting $cardnumber.$mimetype." if $sth->errstr;
1808 return $sth->errstr;
1811 =head2 RmPatronImage
1813 my ($dberror) = RmPatronImage($cardnumber);
1815 Removes the image for the patron with the supplied cardnumber.
1820 my ($cardnumber) = @_;
1821 warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1822 my $dbh = C4::Context->dbh;
1823 my $query = "DELETE FROM patronimage WHERE cardnumber = ?;";
1824 my $sth = $dbh->prepare($query);
1825 $sth->execute($cardnumber);
1826 my $dberror = $sth->errstr;
1827 warn "Database error!" if $sth->errstr;
1831 =head2 GetRoadTypeDetails (OUEST-PROVENCE)
1833 ($roadtype) = &GetRoadTypeDetails($roadtypeid);
1835 Returns the description of roadtype
1836 C<&$roadtype>return description of road type
1837 C<&$roadtypeid>this is the value of roadtype s
1841 sub GetRoadTypeDetails {
1842 my ($roadtypeid) = @_;
1843 my $dbh = C4::Context->dbh;
1847 WHERE roadtypeid=?|;
1848 my $sth = $dbh->prepare($query);
1849 $sth->execute($roadtypeid);
1850 my $roadtype = $sth->fetchrow;
1854 =head2 GetBorrowersWhoHaveNotBorrowedSince
1856 &GetBorrowersWhoHaveNotBorrowedSince($date)
1858 this function get all borrowers who haven't borrowed since the date given on input arg.
1862 sub GetBorrowersWhoHaveNotBorrowedSince {
1863 ### TODO : It could be dangerous to delete Borrowers who have just been entered and who have not yet borrowed any book. May be good to add a dateexpiry or dateenrolled filter.
1865 my $filterdate = shift||POSIX::strftime("%Y-%m-%d",localtime());
1866 my $filterbranch = shift ||
1867 ((C4::Context->preference('IndependantBranches')
1868 && C4::Context->userenv
1869 && C4::Context->userenv->{flags} % 2 !=1
1870 && C4::Context->userenv->{branch})
1871 ? C4::Context->userenv->{branch}
1873 my $dbh = C4::Context->dbh;
1875 SELECT borrowers.borrowernumber,max(issues.timestamp) as latestissue
1877 JOIN categories USING (categorycode)
1878 LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
1879 WHERE category_type <> 'S'
1882 if ($filterbranch && $filterbranch ne ""){
1883 $query.=" AND borrowers.branchcode= ?";
1884 push @query_params,$filterbranch;
1886 $query.=" GROUP BY borrowers.borrowernumber";
1888 $query.=" HAVING latestissue <? OR latestissue IS NULL";
1889 push @query_params,$filterdate;
1891 warn $query if $debug;
1892 my $sth = $dbh->prepare($query);
1893 if (scalar(@query_params)>0){
1894 $sth->execute(@query_params);
1901 while ( my $data = $sth->fetchrow_hashref ) {
1902 push @results, $data;
1907 =head2 GetBorrowersWhoHaveNeverBorrowed
1909 $results = &GetBorrowersWhoHaveNeverBorrowed
1911 this function get all borrowers who have never borrowed.
1913 I<$result> is a ref to an array which all elements are a hasref.
1917 sub GetBorrowersWhoHaveNeverBorrowed {
1918 my $filterbranch = shift ||
1919 ((C4::Context->preference('IndependantBranches')
1920 && C4::Context->userenv
1921 && C4::Context->userenv->{flags} % 2 !=1
1922 && C4::Context->userenv->{branch})
1923 ? C4::Context->userenv->{branch}
1925 my $dbh = C4::Context->dbh;
1927 SELECT borrowers.borrowernumber,max(timestamp) as latestissue
1929 LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
1930 WHERE issues.borrowernumber IS NULL
1933 if ($filterbranch && $filterbranch ne ""){
1934 $query.=" AND borrowers.branchcode= ?";
1935 push @query_params,$filterbranch;
1937 warn $query if $debug;
1939 my $sth = $dbh->prepare($query);
1940 if (scalar(@query_params)>0){
1941 $sth->execute(@query_params);
1948 while ( my $data = $sth->fetchrow_hashref ) {
1949 push @results, $data;
1954 =head2 GetBorrowersWithIssuesHistoryOlderThan
1956 $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
1958 this function get all borrowers who has an issue history older than I<$date> given on input arg.
1960 I<$result> is a ref to an array which all elements are a hashref.
1961 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
1965 sub GetBorrowersWithIssuesHistoryOlderThan {
1966 my $dbh = C4::Context->dbh;
1967 my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
1968 my $filterbranch = shift ||
1969 ((C4::Context->preference('IndependantBranches')
1970 && C4::Context->userenv
1971 && C4::Context->userenv->{flags} % 2 !=1
1972 && C4::Context->userenv->{branch})
1973 ? C4::Context->userenv->{branch}
1976 SELECT count(borrowernumber) as n,borrowernumber
1978 WHERE returndate < ?
1979 AND borrowernumber IS NOT NULL
1982 push @query_params, $date;
1984 $query.=" AND branchcode = ?";
1985 push @query_params, $filterbranch;
1987 $query.=" GROUP BY borrowernumber ";
1988 warn $query if $debug;
1989 my $sth = $dbh->prepare($query);
1990 $sth->execute(@query_params);
1993 while ( my $data = $sth->fetchrow_hashref ) {
1994 push @results, $data;
1999 =head2 GetBorrowersNamesAndLatestIssue
2001 $results = &GetBorrowersNamesAndLatestIssueList(@borrowernumbers)
2003 this function get borrowers Names and surnames and Issue information.
2005 I<@borrowernumbers> is an array which all elements are borrowernumbers.
2006 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2010 sub GetBorrowersNamesAndLatestIssue {
2011 my $dbh = C4::Context->dbh;
2012 my @borrowernumbers=@_;
2014 SELECT surname,lastname, phone, email,max(timestamp)
2016 LEFT JOIN issues ON borrowers.borrowernumber=issues.borrowernumber
2017 GROUP BY borrowernumber
2019 my $sth = $dbh->prepare($query);
2021 my $results = $sth->fetchall_arrayref({});
2029 my $success = DebarMember( $borrowernumber );
2031 marks a Member as debarred, and therefore unable to checkout any more
2035 true on success, false on failure
2042 my $borrowernumber = shift;
2044 return unless defined $borrowernumber;
2045 return unless $borrowernumber =~ /^\d+$/;
2047 return ModMember( borrowernumber => $borrowernumber,
2052 END { } # module clean-up code here (global destructor)