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
31 use C4::SQLHelper qw(InsertInTable UpdateInTable);
33 our ($VERSION,@ISA,@EXPORT,@EXPORT_OK,$debug);
37 $debug = $ENV{DEBUG} || 0;
48 &GetMemberIssuesAndFines
68 &GetMemberAccountRecords
69 &GetBorNotifyAcctRecord
73 &GetBorrowercategoryList
75 &GetBorrowersWhoHaveNotBorrowedSince
76 &GetBorrowersWhoHaveNeverBorrowed
77 &GetBorrowersWithIssuesHistoryOlderThan
103 &ExtendMemberSubscriptionTo
121 C4::Members - Perl Module containing convenience functions for member handling
129 This module contains routines for adding, modifying and deleting members/patrons/borrowers
137 ($count, $borrowers) = &SearchMember($searchstring, $type,$category_type,$filter,$showallbranches);
141 Looks up patrons (borrowers) by name.
143 BUGFIX 499: C<$type> is now used to determine type of search.
144 if $type is "simple", search is performed on the first letter of the
147 $category_type is used to get a specified type of user.
148 (mainly adults when creating a child.)
150 C<$searchstring> is a space-separated list of search terms. Each term
151 must match the beginning a borrower's surname, first name, or other
154 C<$filter> is assumed to be a list of elements to filter results on
156 C<$showallbranches> is used in IndependantBranches Context to display all branches results.
158 C<&SearchMember> returns a two-element list. C<$borrowers> is a
159 reference-to-array; each element is a reference-to-hash, whose keys
160 are the fields of the C<borrowers> table in the Koha database.
161 C<$count> is the number of elements in C<$borrowers>.
166 #used by member enquiries from the intranet
167 #called by member.pl and circ/circulation.pl
169 my ($searchstring, $orderby, $type,$category_type,$filter,$showallbranches ) = @_;
170 my $dbh = C4::Context->dbh;
176 # this is used by circulation everytime a new borrowers cardnumber is scanned
177 # so we can check an exact match first, if that works return, otherwise do the rest
178 $query = "SELECT * FROM borrowers
179 LEFT JOIN categories ON borrowers.categorycode=categories.categorycode
181 my $sth = $dbh->prepare("$query WHERE cardnumber = ?");
182 $sth->execute($searchstring);
183 my $data = $sth->fetchall_arrayref({});
185 return ( scalar(@$data), $data );
189 if ( $type eq "simple" ) # simple search for one letter only
191 $query .= ($category_type ? " AND category_type = ".$dbh->quote($category_type) : "");
192 $query .= " WHERE (surname LIKE ? OR cardnumber like ?) ";
193 if (C4::Context->preference("IndependantBranches") && !$showallbranches){
194 if (C4::Context->userenv && C4::Context->userenv->{flags} % 2 !=1 && C4::Context->userenv->{'branch'}){
195 $query.=" AND borrowers.branchcode =".$dbh->quote(C4::Context->userenv->{'branch'}) unless (C4::Context->userenv->{'branch'} eq "insecure");
198 $query.=" ORDER BY $orderby";
199 @bind = ("$searchstring%","$searchstring");
201 else # advanced search looking in surname, firstname and othernames
203 @data = split( ' ', $searchstring );
206 if (C4::Context->preference("IndependantBranches") && !$showallbranches){
207 if (C4::Context->userenv && C4::Context->userenv->{flags} % 2 !=1 && C4::Context->userenv->{'branch'}){
208 $query.=" borrowers.branchcode =".$dbh->quote(C4::Context->userenv->{'branch'})." AND " unless (C4::Context->userenv->{'branch'} eq "insecure");
211 $query.="((surname LIKE ? OR surname LIKE ?
212 OR firstname LIKE ? OR firstname LIKE ?
213 OR othernames LIKE ? OR othernames LIKE ?)
215 ($category_type?" AND category_type = ".$dbh->quote($category_type):"");
217 "$data[0]%", "% $data[0]%", "$data[0]%", "% $data[0]%",
218 "$data[0]%", "% $data[0]%"
220 for ( my $i = 1 ; $i < $count ; $i++ ) {
221 $query = $query . " AND (" . " surname LIKE ? OR surname LIKE ?
222 OR firstname LIKE ? OR firstname LIKE ?
223 OR othernames LIKE ? OR othernames LIKE ?)";
225 "$data[$i]%", "% $data[$i]%", "$data[$i]%",
226 "% $data[$i]%", "$data[$i]%", "% $data[$i]%" );
230 $query = $query . ") OR cardnumber LIKE ? ";
231 push( @bind, $searchstring );
232 if (C4::Context->preference('ExtendedPatronAttributes')) {
233 $query .= "OR borrowernumber IN (
234 SELECT borrowernumber
235 FROM borrower_attributes
236 JOIN borrower_attribute_types USING (code)
237 WHERE staff_searchable = 1
240 push (@bind, $searchstring);
242 $query .= "order by $orderby";
247 $sth = $dbh->prepare($query);
249 $debug and print STDERR "Q $orderby : $query\n";
250 $sth->execute(@bind);
252 $data = $sth->fetchall_arrayref({});
255 return ( scalar(@$data), $data );
258 =head2 GetMemberDetails
260 ($borrower) = &GetMemberDetails($borrowernumber, $cardnumber);
262 Looks up a patron and returns information about him or her. If
263 C<$borrowernumber> is true (nonzero), C<&GetMemberDetails> looks
264 up the borrower by number; otherwise, it looks up the borrower by card
267 C<$borrower> is a reference-to-hash whose keys are the fields of the
268 borrowers table in the Koha database. In addition,
269 C<$borrower-E<gt>{flags}> is a hash giving more detailed information
270 about the patron. Its keys act as flags :
272 if $borrower->{flags}->{LOST} {
273 # Patron's card was reported lost
276 If the state of a flag means that the patron should not be
277 allowed to borrow any more books, then it will have a C<noissues> key
280 See patronflags for more details.
282 C<$borrower-E<gt>{authflags}> is a hash giving more detailed information
283 about the top-level permissions flags set for the borrower. For example,
284 if a user has the "editcatalogue" permission,
285 C<$borrower-E<gt>{authflags}-E<gt>{editcatalogue}> will exist and have
290 sub GetMemberDetails {
291 my ( $borrowernumber, $cardnumber ) = @_;
292 my $dbh = C4::Context->dbh;
295 if ($borrowernumber) {
296 $sth = $dbh->prepare("select borrowers.*,category_type,categories.description from borrowers left join categories on borrowers.categorycode=categories.categorycode where borrowernumber=?");
297 $sth->execute($borrowernumber);
299 elsif ($cardnumber) {
300 $sth = $dbh->prepare("select borrowers.*,category_type,categories.description from borrowers left join categories on borrowers.categorycode=categories.categorycode where cardnumber=?");
301 $sth->execute($cardnumber);
306 my $borrower = $sth->fetchrow_hashref;
307 my ($amount) = GetMemberAccountRecords( $borrowernumber);
308 $borrower->{'amountoutstanding'} = $amount;
309 # FIXME - patronflags calls GetMemberAccountRecords... just have patronflags return $amount
310 my $flags = patronflags( $borrower);
313 $sth = $dbh->prepare("select bit,flag from userflags");
315 while ( my ( $bit, $flag ) = $sth->fetchrow ) {
316 if ( $borrower->{'flags'} && $borrower->{'flags'} & 2**$bit ) {
317 $accessflagshash->{$flag} = 1;
321 $borrower->{'flags'} = $flags;
322 $borrower->{'authflags'} = $accessflagshash;
324 # find out how long the membership lasts
327 "select enrolmentperiod from categories where categorycode = ?");
328 $sth->execute( $borrower->{'categorycode'} );
329 my $enrolment = $sth->fetchrow;
330 $borrower->{'enrolmentperiod'} = $enrolment;
331 return ($borrower); #, $flags, $accessflagshash);
336 $flags = &patronflags($patron);
338 This function is not exported.
340 The following will be set where applicable:
341 $flags->{CHARGES}->{amount} Amount of debt
342 $flags->{CHARGES}->{noissues} Set if debt amount >$5.00 (or syspref noissuescharge)
343 $flags->{CHARGES}->{message} Message -- deprecated
345 $flags->{CREDITS}->{amount} Amount of credit
346 $flags->{CREDITS}->{message} Message -- deprecated
348 $flags->{ GNA } Patron has no valid address
349 $flags->{ GNA }->{noissues} Set for each GNA
350 $flags->{ GNA }->{message} "Borrower has no valid address" -- deprecated
352 $flags->{ LOST } Patron's card reported lost
353 $flags->{ LOST }->{noissues} Set for each LOST
354 $flags->{ LOST }->{message} Message -- deprecated
356 $flags->{DBARRED} Set if patron debarred, no access
357 $flags->{DBARRED}->{noissues} Set for each DBARRED
358 $flags->{DBARRED}->{message} Message -- deprecated
361 $flags->{ NOTES }->{message} The note itself. NOT deprecated
363 $flags->{ ODUES } Set if patron has overdue books.
364 $flags->{ ODUES }->{message} "Yes" -- deprecated
365 $flags->{ ODUES }->{itemlist} ref-to-array: list of overdue books
366 $flags->{ ODUES }->{itemlisttext} Text list of overdue items -- deprecated
368 $flags->{WAITING} Set if any of patron's reserves are available
369 $flags->{WAITING}->{message} Message -- deprecated
370 $flags->{WAITING}->{itemlist} ref-to-array: list of available items
374 C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
375 overdue items. Its elements are references-to-hash, each describing an
376 overdue item. The keys are selected fields from the issues, biblio,
377 biblioitems, and items tables of the Koha database.
379 C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
380 the overdue items, one per line. Deprecated.
382 C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
383 available items. Each element is a reference-to-hash whose keys are
384 fields from the reserves table of the Koha database.
388 All the "message" fields that include language generated in this function are deprecated,
389 because such strings belong properly in the display layer.
391 The "message" field that comes from the DB is OK.
395 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
396 # FIXME rename this function.
399 my ( $patroninformation) = @_;
400 my $dbh=C4::Context->dbh;
401 my ($amount) = GetMemberAccountRecords( $patroninformation->{'borrowernumber'});
404 my $noissuescharge = C4::Context->preference("noissuescharge") || 5;
405 $flaginfo{'message'} = sprintf "Patron owes \$%.02f", $amount;
406 $flaginfo{'amount'} = sprintf "%.02f", $amount;
407 if ( $amount > $noissuescharge ) {
408 $flaginfo{'noissues'} = 1;
410 $flags{'CHARGES'} = \%flaginfo;
412 elsif ( $amount < 0 ) {
414 $flaginfo{'message'} = sprintf "Patron has credit of \$%.02f", -$amount;
415 $flaginfo{'amount'} = sprintf "%.02f", $amount;
416 $flags{'CREDITS'} = \%flaginfo;
418 if ( $patroninformation->{'gonenoaddress'}
419 && $patroninformation->{'gonenoaddress'} == 1 )
422 $flaginfo{'message'} = 'Borrower has no valid address.';
423 $flaginfo{'noissues'} = 1;
424 $flags{'GNA'} = \%flaginfo;
426 if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
428 $flaginfo{'message'} = 'Borrower\'s card reported lost.';
429 $flaginfo{'noissues'} = 1;
430 $flags{'LOST'} = \%flaginfo;
432 if ( $patroninformation->{'debarred'}
433 && $patroninformation->{'debarred'} == 1 )
436 $flaginfo{'message'} = 'Borrower is Debarred.';
437 $flaginfo{'noissues'} = 1;
438 $flags{'DBARRED'} = \%flaginfo;
440 if ( $patroninformation->{'borrowernotes'}
441 && $patroninformation->{'borrowernotes'} )
444 $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
445 $flags{'NOTES'} = \%flaginfo;
447 my ( $odues, $itemsoverdue ) = checkoverdues($patroninformation->{'borrowernumber'});
450 $flaginfo{'message'} = "Yes";
451 $flaginfo{'itemlist'} = $itemsoverdue;
452 foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
455 $flaginfo{'itemlisttext'} .=
456 "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n"; # newline is display layer
458 $flags{'ODUES'} = \%flaginfo;
460 my @itemswaiting = C4::Reserves::GetReservesFromBorrowernumber( $patroninformation->{'borrowernumber'},'W' );
461 my $nowaiting = scalar @itemswaiting;
462 if ( $nowaiting > 0 ) {
464 $flaginfo{'message'} = "Reserved items available";
465 $flaginfo{'itemlist'} = \@itemswaiting;
466 $flags{'WAITING'} = \%flaginfo;
474 $borrower = &GetMember(%information);
476 Looks up information about a patron (borrower) by either card number
477 ,firstname, or borrower number, depending on $type value.
478 If C<$type> == 'cardnumber', C<&GetBorrower>
479 searches by cardnumber then by firstname if not found in cardnumber;
480 otherwise, it searches by borrowernumber.
482 C<&GetBorrower> returns a reference-to-hash whose keys are the fields of
483 the C<borrowers> table in the Koha database.
489 my ( %information ) = @_;
490 my $dbh = C4::Context->dbh;
493 SELECT borrowers.*, categories.category_type, categories.description
495 LEFT JOIN categories on borrowers.categorycode=categories.categorycode
497 $select.=" WHERE ".join(" AND ",map {"$_ = ?"}keys %information);
499 $debug && warn $select, " ",values %information;
500 $sth = $dbh->prepare("$select");
501 $sth->execute(map{$information{$_}} keys %information);
502 my $data = $sth->fetchall_arrayref({});
503 return undef if (scalar(@$data)==0);
504 if (scalar(@$data)==1) {return $$data[0];}
505 ($data) and return $data;
509 =head2 IsMemberBlocked
513 my $blocked = IsMemberBlocked( $borrowernumber );
515 return the status, and the number of day or documents, depends his punishment
518 -1 if the user have overdue returns
519 1 if the user is punished X days
520 0 if the user is authorised to loan
526 sub IsMemberBlocked {
527 my $borrowernumber = shift;
528 my $dbh = C4::Context->dbh;
529 # if he have late issues
530 my $sth = $dbh->prepare(
531 "SELECT COUNT(*) as latedocs
533 WHERE borrowernumber = ?
534 AND date_due < now()"
536 $sth->execute($borrowernumber);
537 my $latedocs = $sth->fetchrow_hashref->{'latedocs'};
539 return (-1, $latedocs) if $latedocs > 0;
543 ADDDATE(returndate, finedays * DATEDIFF(returndate,date_due) ) AS blockingdate,
544 DATEDIFF(ADDDATE(returndate, finedays * DATEDIFF(returndate,date_due)),NOW()) AS blockedcount
547 # or if he must wait to loan
548 if(C4::Context->preference("item-level_itypes")){
550 qq{ LEFT JOIN items ON (items.itemnumber=old_issues.itemnumber)
551 LEFT JOIN issuingrules ON (issuingrules.itemtype=items.itype)}
554 qq{ LEFT JOIN items ON (items.itemnumber=old_issues.itemnumber)
555 LEFT JOIN biblioitems ON (biblioitems.biblioitemnumber=items.biblioitemnumber)
556 LEFT JOIN issuingrules ON (issuingrules.itemtype=biblioitems.itemtype) };
559 qq{ WHERE finedays IS NOT NULL
560 AND date_due < returndate
561 AND borrowernumber = ?
562 ORDER BY blockingdate DESC, blockedcount DESC
564 $sth=$dbh->prepare($strsth);
565 $sth->execute($borrowernumber);
566 my $row = $sth->fetchrow_hashref;
567 my $blockeddate = $row->{'blockeddate'};
568 my $blockedcount = $row->{'blockedcount'};
570 return (1, $blockedcount) if $blockedcount > 0;
575 =head2 GetMemberIssuesAndFines
577 ($overdue_count, $issue_count, $total_fines) = &GetMemberIssuesAndFines($borrowernumber);
579 Returns aggregate data about items borrowed by the patron with the
580 given borrowernumber.
582 C<&GetMemberIssuesAndFines> returns a three-element array. C<$overdue_count> is the
583 number of overdue items the patron currently has borrowed. C<$issue_count> is the
584 number of books the patron currently has borrowed. C<$total_fines> is
585 the total fine currently due by the borrower.
590 sub GetMemberIssuesAndFines {
591 my ( $borrowernumber ) = @_;
592 my $dbh = C4::Context->dbh;
593 my $query = "SELECT COUNT(*) FROM issues WHERE borrowernumber = ?";
595 $debug and warn $query."\n";
596 my $sth = $dbh->prepare($query);
597 $sth->execute($borrowernumber);
598 my $issue_count = $sth->fetchrow_arrayref->[0];
601 $sth = $dbh->prepare(
602 "SELECT COUNT(*) FROM issues
603 WHERE borrowernumber = ?
604 AND date_due < now()"
606 $sth->execute($borrowernumber);
607 my $overdue_count = $sth->fetchrow_arrayref->[0];
610 $sth = $dbh->prepare("SELECT SUM(amountoutstanding) FROM accountlines WHERE borrowernumber = ?");
611 $sth->execute($borrowernumber);
612 my $total_fines = $sth->fetchrow_arrayref->[0];
615 return ($overdue_count, $issue_count, $total_fines);
619 return @{C4::Context->dbh->selectcol_arrayref("SHOW columns from borrowers")};
628 my $success = ModMember(borrowernumber => $borrowernumber, [ field => value ]... );
630 Modify borrower's data. All date fields should ALREADY be in ISO format.
633 true on success, or false on failure
640 # test to know if you must update or not the borrower password
641 if (exists $data{password}) {
642 if ($data{password} eq '****' or $data{password} eq '') {
643 delete $data{password};
645 $data{password} = md5_base64($data{password});
648 my $execute_success=UpdateInTable("borrowers",\%data);
649 # ok if its an adult (type) it may have borrowers that depend on it as a guarantor
650 # so when we update information for an adult we should check for guarantees and update the relevant part
651 # of their records, ie addresses and phone numbers
652 my $borrowercategory= GetBorrowercategory( $data{'category_type'} );
653 if ( exists $borrowercategory->{'category_type'} && $borrowercategory->{'category_type'} eq ('A' || 'S') ) {
654 # is adult check guarantees;
655 UpdateGuarantees(%data);
657 logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "UPDATE (executed w/ arg: $data{'borrowernumber'})")
658 if C4::Context->preference("BorrowersLog");
660 return $execute_success;
668 $borrowernumber = &AddMember(%borrower);
670 insert new borrower into table
671 Returns the borrowernumber
678 my $dbh = C4::Context->dbh;
679 $data{'userid'} = '' unless $data{'password'};
680 $data{'password'} = md5_base64( $data{'password'} ) if $data{'password'};
681 $data{'borrowernumber'}=InsertInTable("borrowers",\%data);
682 # mysql_insertid is probably bad. not necessarily accurate and mysql-specific at best.
683 logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
685 # check for enrollment fee & add it if needed
686 my $sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
687 $sth->execute($data{'categorycode'});
688 my ($enrolmentfee) = $sth->fetchrow;
689 if ($enrolmentfee && $enrolmentfee > 0) {
690 # insert fee in patron debts
691 manualinvoice($data{'borrowernumber'}, '', '', 'A', $enrolmentfee);
693 return $data{'borrowernumber'};
698 my ($uid,$member) = @_;
699 my $dbh = C4::Context->dbh;
700 # Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
701 # Then we need to tell the user and have them create a new one.
704 "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
705 $sth->execute( $uid, $member );
706 if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
714 sub Generate_Userid {
715 my ($borrowernumber, $firstname, $surname) = @_;
719 $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
720 $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
721 $newuid = lc("$firstname.$surname");
722 $newuid .= $offset unless $offset == 0;
725 } while (!Check_Userid($newuid,$borrowernumber));
731 my ( $uid, $member, $digest ) = @_;
732 my $dbh = C4::Context->dbh;
734 #Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
735 #Then we need to tell the user and have them create a new one.
739 "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
740 $sth->execute( $uid, $member );
741 if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
745 #Everything is good so we can update the information.
748 "update borrowers set userid=?, password=? where borrowernumber=?");
749 $sth->execute( $uid, $digest, $member );
753 logaction("MEMBERS", "CHANGE PASS", $member, "") if C4::Context->preference("BorrowersLog");
759 =head2 fixup_cardnumber
761 Warning: The caller is responsible for locking the members table in write
762 mode, to avoid database corruption.
766 use vars qw( @weightings );
767 my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
769 sub fixup_cardnumber ($) {
770 my ($cardnumber) = @_;
771 my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;
773 # Find out whether member numbers should be generated
774 # automatically. Should be either "1" or something else.
775 # Defaults to "0", which is interpreted as "no".
777 # if ($cardnumber !~ /\S/ && $autonumber_members) {
778 ($autonumber_members) or return $cardnumber;
779 my $checkdigit = C4::Context->preference('checkdigit');
780 my $dbh = C4::Context->dbh;
781 if ( $checkdigit and $checkdigit eq 'katipo' ) {
783 # if checkdigit is selected, calculate katipo-style cardnumber.
784 # otherwise, just use the max()
785 # purpose: generate checksum'd member numbers.
786 # We'll assume we just got the max value of digits 2-8 of member #'s
787 # from the database and our job is to increment that by one,
788 # determine the 1st and 9th digits and return the full string.
789 my $sth = $dbh->prepare(
790 "select max(substring(borrowers.cardnumber,2,7)) as new_num from borrowers"
793 my $data = $sth->fetchrow_hashref;
794 $cardnumber = $data->{new_num};
795 if ( !$cardnumber ) { # If DB has no values,
796 $cardnumber = 1000000; # start at 1000000
802 for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
803 # read weightings, left to right, 1 char at a time
804 my $temp1 = $weightings[$i];
806 # sequence left to right, 1 char at a time
807 my $temp2 = substr( $cardnumber, $i, 1 );
809 # mult each char 1-7 by its corresponding weighting
810 $sum += $temp1 * $temp2;
813 my $rem = ( $sum % 11 );
814 $rem = 'X' if $rem == 10;
816 return "V$cardnumber$rem";
819 # MODIFIED BY JF: mysql4.1 allows casting as an integer, which is probably
820 # better. I'll leave the original in in case it needs to be changed for you
821 # my $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers");
822 my $sth = $dbh->prepare(
823 "select max(cast(cardnumber as signed)) from borrowers"
826 my ($result) = $sth->fetchrow;
829 return $cardnumber; # just here as a fallback/reminder
834 ($num_children, $children_arrayref) = &GetGuarantees($parent_borrno);
835 $child0_cardno = $children_arrayref->[0]{"cardnumber"};
836 $child0_borrno = $children_arrayref->[0]{"borrowernumber"};
838 C<&GetGuarantees> takes a borrower number (e.g., that of a patron
839 with children) and looks up the borrowers who are guaranteed by that
840 borrower (i.e., the patron's children).
842 C<&GetGuarantees> returns two values: an integer giving the number of
843 borrowers guaranteed by C<$parent_borrno>, and a reference to an array
844 of references to hash, which gives the actual results.
850 my ($borrowernumber) = @_;
851 my $dbh = C4::Context->dbh;
854 "select cardnumber,borrowernumber, firstname, surname from borrowers where guarantorid=?"
856 $sth->execute($borrowernumber);
859 my $data = $sth->fetchall_arrayref({});
861 return ( scalar(@$data), $data );
864 =head2 UpdateGuarantees
866 &UpdateGuarantees($parent_borrno);
869 C<&UpdateGuarantees> borrower data for an adult and updates all the guarantees
870 with the modified information
875 sub UpdateGuarantees {
877 my $dbh = C4::Context->dbh;
878 my ( $count, $guarantees ) = GetGuarantees( $data{'borrowernumber'} );
879 for ( my $i = 0 ; $i < $count ; $i++ ) {
882 # It looks like the $i is only being returned to handle walking through
883 # the array, which is probably better done as a foreach loop.
885 my $guaquery = qq|UPDATE borrowers
886 SET address='$data{'address'}',fax='$data{'fax'}',
887 B_city='$data{'B_city'}',mobile='$data{'mobile'}',city='$data{'city'}',phone='$data{'phone'}'
888 WHERE borrowernumber='$guarantees->[$i]->{'borrowernumber'}'
890 my $sth3 = $dbh->prepare($guaquery);
895 =head2 GetPendingIssues
897 my $issues = &GetPendingIssues($borrowernumber);
899 Looks up what the patron with the given borrowernumber has borrowed.
901 C<&GetPendingIssues> returns a
902 reference-to-array where each element is a reference-to-hash; the
903 keys are the fields from the C<issues>, C<biblio>, and C<items> tables.
904 The keys include C<biblioitems> fields except marc and marcxml.
909 sub GetPendingIssues {
910 my ($borrowernumber) = @_;
911 # must avoid biblioitems.* to prevent large marc and marcxml fields from killing performance
912 # FIXME: namespace collision: each table has "timestamp" fields. Which one is "timestamp" ?
913 # FIXME: circ/ciculation.pl tries to sort by timestamp!
914 # FIXME: C4::Print::printslip tries to sort by timestamp!
915 # FIXME: namespace collision: other collisions possible.
916 # FIXME: most of this data isn't really being used by callers.
917 my $sth = C4::Context->dbh->prepare(
923 biblioitems.itemtype,
926 biblioitems.publicationyear,
927 biblioitems.publishercode,
928 biblioitems.volumedate,
929 biblioitems.volumedesc,
932 issues.timestamp AS timestamp,
933 issues.renewals AS renewals,
934 items.renewals AS totalrenewals
936 LEFT JOIN items ON items.itemnumber = issues.itemnumber
937 LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
938 LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
941 ORDER BY issues.issuedate"
943 $sth->execute($borrowernumber);
944 my $data = $sth->fetchall_arrayref({});
945 my $today = C4::Dates->new->output('iso');
947 $_->{date_due} or next;
948 ($_->{date_due} lt $today) and $_->{overdue} = 1;
955 ($count, $issues) = &GetAllIssues($borrowernumber, $sortkey, $limit);
957 Looks up what the patron with the given borrowernumber has borrowed,
958 and sorts the results.
960 C<$sortkey> is the name of a field on which to sort the results. This
961 should be the name of a field in the C<issues>, C<biblio>,
962 C<biblioitems>, or C<items> table in the Koha database.
964 C<$limit> is the maximum number of results to return.
966 C<&GetAllIssues> returns a two-element array. C<$issues> is a
967 reference-to-array, where each element is a reference-to-hash; the
968 keys are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
969 C<items> tables of the Koha database. C<$count> is the number of
970 elements in C<$issues>
976 my ( $borrowernumber, $order, $limit ) = @_;
978 #FIXME: sanity-check order and limit
979 my $dbh = C4::Context->dbh;
982 "SELECT *,issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
984 LEFT JOIN items on items.itemnumber=issues.itemnumber
985 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
986 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
987 WHERE borrowernumber=?
989 SELECT *,old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
991 LEFT JOIN items on items.itemnumber=old_issues.itemnumber
992 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
993 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
994 WHERE borrowernumber=?
997 $query .= " limit $limit";
1001 my $sth = $dbh->prepare($query);
1002 $sth->execute($borrowernumber, $borrowernumber);
1005 while ( my $data = $sth->fetchrow_hashref ) {
1006 $result[$i] = $data;
1011 # get all issued items for borrowernumber from oldissues table
1012 # large chunk of older issues data put into table oldissues
1013 # to speed up db calls for issuing items
1014 if ( C4::Context->preference("ReadingHistory") ) {
1015 # FIXME oldissues (not to be confused with old_issues) is
1016 # apparently specific to HLT. Not sure if the ReadingHistory
1017 # syspref is still required, as old_issues by design
1018 # is no longer checked with each loan.
1019 my $query2 = "SELECT * FROM oldissues
1020 LEFT JOIN items ON items.itemnumber=oldissues.itemnumber
1021 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1022 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1023 WHERE borrowernumber=?
1025 if ( $limit != 0 ) {
1026 $limit = $limit - $count;
1027 $query2 .= " limit $limit";
1030 my $sth2 = $dbh->prepare($query2);
1031 $sth2->execute($borrowernumber);
1033 while ( my $data2 = $sth2->fetchrow_hashref ) {
1034 $result[$i] = $data2;
1041 return ( $i, \@result );
1045 =head2 GetMemberAccountRecords
1047 ($total, $acctlines, $count) = &GetMemberAccountRecords($borrowernumber);
1049 Looks up accounting data for the patron with the given borrowernumber.
1051 C<&GetMemberAccountRecords> returns a three-element array. C<$acctlines> is a
1052 reference-to-array, where each element is a reference-to-hash; the
1053 keys are the fields of the C<accountlines> table in the Koha database.
1054 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1055 total amount outstanding for all of the account lines.
1060 sub GetMemberAccountRecords {
1061 my ($borrowernumber,$date) = @_;
1062 my $dbh = C4::Context->dbh;
1068 WHERE borrowernumber=?);
1069 my @bind = ($borrowernumber);
1070 if ($date && $date ne ''){
1071 $strsth.=" AND date < ? ";
1074 $strsth.=" ORDER BY date desc,timestamp DESC";
1075 my $sth= $dbh->prepare( $strsth );
1076 $sth->execute( @bind );
1078 while ( my $data = $sth->fetchrow_hashref ) {
1079 my $biblio = GetBiblioFromItemNumber($data->{itemnumber}) if $data->{itemnumber};
1080 $data->{biblionumber} = $biblio->{biblionumber};
1081 $data->{title} = $biblio->{title};
1082 $acctlines[$numlines] = $data;
1084 $total += int(1000 * $data->{'amountoutstanding'}); # convert float to integer to avoid round-off errors
1088 return ( $total, \@acctlines,$numlines);
1091 =head2 GetBorNotifyAcctRecord
1093 ($count, $acctlines, $total) = &GetBorNotifyAcctRecord($params,$notifyid);
1095 Looks up accounting data for the patron with the given borrowernumber per file number.
1097 (FIXME - I'm not at all sure what this is about.)
1099 C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a
1100 reference-to-array, where each element is a reference-to-hash; the
1101 keys are the fields of the C<accountlines> table in the Koha database.
1102 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1103 total amount outstanding for all of the account lines.
1107 sub GetBorNotifyAcctRecord {
1108 my ( $borrowernumber, $notifyid ) = @_;
1109 my $dbh = C4::Context->dbh;
1112 my $sth = $dbh->prepare(
1115 WHERE borrowernumber=?
1117 AND amountoutstanding != '0'
1118 ORDER BY notify_id,accounttype
1120 # 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')
1122 $sth->execute( $borrowernumber, $notifyid );
1124 while ( my $data = $sth->fetchrow_hashref ) {
1125 $acctlines[$numlines] = $data;
1127 $total += int(100 * $data->{'amountoutstanding'});
1131 return ( $total, \@acctlines, $numlines );
1134 =head2 checkuniquemember (OUEST-PROVENCE)
1136 ($result,$categorycode) = &checkuniquemember($collectivity,$surname,$firstname,$dateofbirth);
1138 Checks that a member exists or not in the database.
1140 C<&result> is nonzero (=exist) or 0 (=does not exist)
1141 C<&categorycode> is from categorycode table
1142 C<&collectivity> is 1 (= we add a collectivity) or 0 (= we add a physical member)
1143 C<&surname> is the surname
1144 C<&firstname> is the firstname (only if collectivity=0)
1145 C<&dateofbirth> is the date of birth in ISO format (only if collectivity=0)
1149 # FIXME: This function is not legitimate. Multiple patrons might have the same first/last name and birthdate.
1150 # This is especially true since first name is not even a required field.
1152 sub checkuniquemember {
1153 my ( $collectivity, $surname, $firstname, $dateofbirth ) = @_;
1154 my $dbh = C4::Context->dbh;
1155 my $request = ($collectivity) ?
1156 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? " :
1158 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=? and dateofbirth=?" :
1159 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=?";
1160 my $sth = $dbh->prepare($request);
1161 if ($collectivity) {
1162 $sth->execute( uc($surname) );
1163 } elsif($dateofbirth){
1164 $sth->execute( uc($surname), ucfirst($firstname), $dateofbirth );
1166 $sth->execute( uc($surname), ucfirst($firstname));
1168 my @data = $sth->fetchrow;
1170 ( $data[0] ) and return $data[0], $data[1];
1174 sub checkcardnumber {
1175 my ($cardnumber,$borrowernumber) = @_;
1176 my $dbh = C4::Context->dbh;
1177 my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
1178 $query .= " AND borrowernumber <> ?" if ($borrowernumber);
1179 my $sth = $dbh->prepare($query);
1180 if ($borrowernumber) {
1181 $sth->execute($cardnumber,$borrowernumber);
1183 $sth->execute($cardnumber);
1185 if (my $data= $sth->fetchrow_hashref()){
1195 =head2 getzipnamecity (OUEST-PROVENCE)
1197 take all info from table city for the fields city and zip
1198 check for the name and the zip code of the city selected
1202 sub getzipnamecity {
1204 my $dbh = C4::Context->dbh;
1207 "select city_name,city_zipcode from cities where cityid=? ");
1208 $sth->execute($cityid);
1209 my @data = $sth->fetchrow;
1210 return $data[0], $data[1];
1214 =head2 getdcity (OUEST-PROVENCE)
1216 recover cityid with city_name condition
1221 my ($city_name) = @_;
1222 my $dbh = C4::Context->dbh;
1223 my $sth = $dbh->prepare("select cityid from cities where city_name=? ");
1224 $sth->execute($city_name);
1225 my $data = $sth->fetchrow;
1230 =head2 GetExpiryDate
1232 $expirydate = GetExpiryDate($categorycode, $dateenrolled);
1234 Calculate expiry date given a categorycode and starting date. Date argument must be in ISO format.
1235 Return date is also in ISO format.
1240 my ( $categorycode, $dateenrolled ) = @_;
1241 my $enrolmentperiod = 12; # reasonable default
1242 if ($categorycode) {
1243 my $dbh = C4::Context->dbh;
1244 my $sth = $dbh->prepare("select enrolmentperiod from categories where categorycode=?");
1245 $sth->execute($categorycode);
1246 $enrolmentperiod = $sth->fetchrow;
1248 # die "GetExpiryDate: for enrollmentperiod $enrolmentperiod (category '$categorycode') starting $dateenrolled.\n";
1249 my @date = split /-/,$dateenrolled;
1250 return sprintf("%04d-%02d-%02d", Add_Delta_YM(@date,0,$enrolmentperiod));
1253 =head2 checkuserpassword (OUEST-PROVENCE)
1255 check for the password and login are not used
1256 return the number of record
1257 0=> NOT USED 1=> USED
1261 sub checkuserpassword {
1262 my ( $borrowernumber, $userid, $password ) = @_;
1263 $password = md5_base64($password);
1264 my $dbh = C4::Context->dbh;
1267 "Select count(*) from borrowers where borrowernumber !=? and userid =? and password=? "
1269 $sth->execute( $borrowernumber, $userid, $password );
1270 my $number_rows = $sth->fetchrow;
1271 return $number_rows;
1275 =head2 GetborCatFromCatType
1277 ($codes_arrayref, $labels_hashref) = &GetborCatFromCatType();
1279 Looks up the different types of borrowers in the database. Returns two
1280 elements: a reference-to-array, which lists the borrower category
1281 codes, and a reference-to-hash, which maps the borrower category codes
1282 to category descriptions.
1287 sub GetborCatFromCatType {
1288 my ( $category_type, $action ) = @_;
1289 # FIXME - This API seems both limited and dangerous.
1290 my $dbh = C4::Context->dbh;
1291 my $request = qq| SELECT categorycode,description
1294 ORDER BY categorycode|;
1295 my $sth = $dbh->prepare($request);
1297 $sth->execute($category_type);
1306 while ( my $data = $sth->fetchrow_hashref ) {
1307 push @codes, $data->{'categorycode'};
1308 $labels{ $data->{'categorycode'} } = $data->{'description'};
1311 return ( \@codes, \%labels );
1314 =head2 GetBorrowercategory
1316 $hashref = &GetBorrowercategory($categorycode);
1318 Given the borrower's category code, the function returns the corresponding
1319 data hashref for a comprehensive information display.
1321 $arrayref_hashref = &GetBorrowercategory;
1322 If no category code provided, the function returns all the categories.
1326 sub GetBorrowercategory {
1328 my $dbh = C4::Context->dbh;
1332 "SELECT description,dateofbirthrequired,upperagelimit,category_type
1334 WHERE categorycode = ?"
1336 $sth->execute($catcode);
1338 $sth->fetchrow_hashref;
1343 } # sub getborrowercategory
1345 =head2 GetBorrowercategoryList
1347 $arrayref_hashref = &GetBorrowercategoryList;
1348 If no category code provided, the function returns all the categories.
1352 sub GetBorrowercategoryList {
1353 my $dbh = C4::Context->dbh;
1358 ORDER BY description"
1362 $sth->fetchall_arrayref({});
1365 } # sub getborrowercategory
1367 =head2 ethnicitycategories
1369 ($codes_arrayref, $labels_hashref) = ðnicitycategories();
1371 Looks up the different ethnic types in the database. Returns two
1372 elements: a reference-to-array, which lists the ethnicity codes, and a
1373 reference-to-hash, which maps the ethnicity codes to ethnicity
1380 sub ethnicitycategories {
1381 my $dbh = C4::Context->dbh;
1382 my $sth = $dbh->prepare("Select code,name from ethnicity order by name");
1386 while ( my $data = $sth->fetchrow_hashref ) {
1387 push @codes, $data->{'code'};
1388 $labels{ $data->{'code'} } = $data->{'name'};
1391 return ( \@codes, \%labels );
1396 $ethn_name = &fixEthnicity($ethn_code);
1398 Takes an ethnicity code (e.g., "european" or "pi") and returns the
1399 corresponding descriptive name from the C<ethnicity> table in the
1400 Koha database ("European" or "Pacific Islander").
1407 my $ethnicity = shift;
1408 return unless $ethnicity;
1409 my $dbh = C4::Context->dbh;
1410 my $sth = $dbh->prepare("Select name from ethnicity where code = ?");
1411 $sth->execute($ethnicity);
1412 my $data = $sth->fetchrow_hashref;
1414 return $data->{'name'};
1415 } # sub fixEthnicity
1419 $dateofbirth,$date = &GetAge($date);
1421 this function return the borrowers age with the value of dateofbirth
1427 my ( $date, $date_ref ) = @_;
1429 if ( not defined $date_ref ) {
1430 $date_ref = sprintf( '%04d-%02d-%02d', Today() );
1433 my ( $year1, $month1, $day1 ) = split /-/, $date;
1434 my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
1436 my $age = $year2 - $year1;
1437 if ( $month1 . $day1 > $month2 . $day2 ) {
1444 =head2 get_institutions
1445 $insitutions = get_institutions();
1447 Just returns a list of all the borrowers of type I, borrownumber and name
1452 sub get_institutions {
1453 my $dbh = C4::Context->dbh();
1456 "SELECT borrowernumber,surname FROM borrowers WHERE categorycode=? ORDER BY surname"
1460 while ( my $data = $sth->fetchrow_hashref() ) {
1461 $orgs{ $data->{'borrowernumber'} } = $data;
1466 } # sub get_institutions
1468 =head2 add_member_orgs
1470 add_member_orgs($borrowernumber,$borrowernumbers);
1472 Takes a borrowernumber and a list of other borrowernumbers and inserts them into the borrowers_to_borrowers table
1477 sub add_member_orgs {
1478 my ( $borrowernumber, $otherborrowers ) = @_;
1479 my $dbh = C4::Context->dbh();
1481 "INSERT INTO borrowers_to_borrowers (borrower1,borrower2) VALUES (?,?)";
1482 my $sth = $dbh->prepare($query);
1483 foreach my $otherborrowernumber (@$otherborrowers) {
1484 $sth->execute( $borrowernumber, $otherborrowernumber );
1488 } # sub add_member_orgs
1490 =head2 GetCities (OUEST-PROVENCE)
1492 ($id_cityarrayref, $city_hashref) = &GetCities();
1494 Looks up the different city and zip in the database. Returns two
1495 elements: a reference-to-array, which lists the zip city
1496 codes, and a reference-to-hash, which maps the name of the city.
1497 WHERE =>OUEST PROVENCE OR EXTERIEUR
1503 #my ($type_city) = @_;
1504 my $dbh = C4::Context->dbh;
1505 my $query = qq|SELECT cityid,city_zipcode,city_name
1507 ORDER BY city_name|;
1508 my $sth = $dbh->prepare($query);
1510 #$sth->execute($type_city);
1514 # insert empty value to create a empty choice in cgi popup
1517 while ( my $data = $sth->fetchrow_hashref ) {
1518 push @id, $data->{'city_zipcode'}."|".$data->{'city_name'};
1519 $city{ $data->{'city_zipcode'}."|".$data->{'city_name'} } = $data->{'city_name'};
1522 #test to know if the table contain some records if no the function return nothing
1526 # all we have is the one blank row
1531 return ( \@id, \%city );
1535 =head2 GetSortDetails (OUEST-PROVENCE)
1537 ($lib) = &GetSortDetails($category,$sortvalue);
1539 Returns the authorized value details
1540 C<&$lib>return value of authorized value details
1541 C<&$sortvalue>this is the value of authorized value
1542 C<&$category>this is the value of authorized value category
1546 sub GetSortDetails {
1547 my ( $category, $sortvalue ) = @_;
1548 my $dbh = C4::Context->dbh;
1549 my $query = qq|SELECT lib
1550 FROM authorised_values
1552 AND authorised_value=? |;
1553 my $sth = $dbh->prepare($query);
1554 $sth->execute( $category, $sortvalue );
1555 my $lib = $sth->fetchrow;
1556 return ($lib) if ($lib);
1557 return ($sortvalue) unless ($lib);
1560 =head2 MoveMemberToDeleted
1562 $result = &MoveMemberToDeleted($borrowernumber);
1564 Copy the record from borrowers to deletedborrowers table.
1568 # FIXME: should do it in one SQL statement w/ subquery
1569 # Otherwise, we should return the @data on success
1571 sub MoveMemberToDeleted {
1572 my ($member) = shift or return;
1573 my $dbh = C4::Context->dbh;
1574 my $query = qq|SELECT *
1576 WHERE borrowernumber=?|;
1577 my $sth = $dbh->prepare($query);
1578 $sth->execute($member);
1579 my @data = $sth->fetchrow_array;
1580 (@data) or return; # if we got a bad borrowernumber, there's nothing to insert
1582 $dbh->prepare( "INSERT INTO deletedborrowers VALUES ("
1583 . ( "?," x ( scalar(@data) - 1 ) )
1585 $sth->execute(@data);
1590 DelMember($borrowernumber);
1592 This function remove directly a borrower whitout writing it on deleteborrower.
1593 + Deletes reserves for the borrower
1598 my $dbh = C4::Context->dbh;
1599 my $borrowernumber = shift;
1600 #warn "in delmember with $borrowernumber";
1601 return unless $borrowernumber; # borrowernumber is mandatory.
1603 my $query = qq|DELETE
1605 WHERE borrowernumber=?|;
1606 my $sth = $dbh->prepare($query);
1607 $sth->execute($borrowernumber);
1612 WHERE borrowernumber = ?
1614 $sth = $dbh->prepare($query);
1615 $sth->execute($borrowernumber);
1617 logaction("MEMBERS", "DELETE", $borrowernumber, "") if C4::Context->preference("BorrowersLog");
1621 =head2 ExtendMemberSubscriptionTo (OUEST-PROVENCE)
1623 $date = ExtendMemberSubscriptionTo($borrowerid, $date);
1625 Extending the subscription to a given date or to the expiry date calculated on ISO date.
1630 sub ExtendMemberSubscriptionTo {
1631 my ( $borrowerid,$date) = @_;
1632 my $dbh = C4::Context->dbh;
1633 my $borrower = GetMember('borrowernumber'=>$borrowerid);
1635 $date=POSIX::strftime("%Y-%m-%d",localtime());
1636 $date = GetExpiryDate( $borrower->{'categorycode'}, $date );
1638 my $sth = $dbh->do(<<EOF);
1640 SET dateexpiry='$date'
1641 WHERE borrowernumber='$borrowerid'
1643 # add enrolmentfee if needed
1644 $sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
1645 $sth->execute($borrower->{'categorycode'});
1646 my ($enrolmentfee) = $sth->fetchrow;
1647 if ($enrolmentfee && $enrolmentfee > 0) {
1648 # insert fee in patron debts
1649 manualinvoice($borrower->{'borrowernumber'}, '', '', 'A', $enrolmentfee);
1651 return $date if ($sth);
1655 =head2 GetRoadTypes (OUEST-PROVENCE)
1657 ($idroadtypearrayref, $roadttype_hashref) = &GetRoadTypes();
1659 Looks up the different road type . Returns two
1660 elements: a reference-to-array, which lists the id_roadtype
1661 codes, and a reference-to-hash, which maps the road type of the road .
1666 my $dbh = C4::Context->dbh;
1668 SELECT roadtypeid,road_type
1670 ORDER BY road_type|;
1671 my $sth = $dbh->prepare($query);
1676 # insert empty value to create a empty choice in cgi popup
1678 while ( my $data = $sth->fetchrow_hashref ) {
1680 push @id, $data->{'roadtypeid'};
1681 $roadtype{ $data->{'roadtypeid'} } = $data->{'road_type'};
1684 #test to know if the table contain some records if no the function return nothing
1692 return ( \@id, \%roadtype );
1698 =head2 GetTitles (OUEST-PROVENCE)
1700 ($borrowertitle)= &GetTitles();
1702 Looks up the different title . Returns array with all borrowers title
1707 my @borrowerTitle = split /,|\|/,C4::Context->preference('BorrowersTitles');
1708 unshift( @borrowerTitle, "" );
1709 my $count=@borrowerTitle;
1714 return ( \@borrowerTitle);
1718 =head2 GetPatronImage
1720 my ($imagedata, $dberror) = GetPatronImage($cardnumber);
1722 Returns the mimetype and binary image data of the image for the patron with the supplied cardnumber.
1726 sub GetPatronImage {
1727 my ($cardnumber) = @_;
1728 warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1729 my $dbh = C4::Context->dbh;
1730 my $query = 'SELECT mimetype, imagefile FROM patronimage WHERE cardnumber = ?';
1731 my $sth = $dbh->prepare($query);
1732 $sth->execute($cardnumber);
1733 my $imagedata = $sth->fetchrow_hashref;
1734 warn "Database error!" if $sth->errstr;
1735 return $imagedata, $sth->errstr;
1738 =head2 PutPatronImage
1740 PutPatronImage($cardnumber, $mimetype, $imgfile);
1742 Stores patron binary image data and mimetype in database.
1743 NOTE: This function is good for updating images as well as inserting new images in the database.
1747 sub PutPatronImage {
1748 my ($cardnumber, $mimetype, $imgfile) = @_;
1749 warn "Parameters passed in: Cardnumber=$cardnumber, Mimetype=$mimetype, " . ($imgfile ? "Imagefile" : "No Imagefile") if $debug;
1750 my $dbh = C4::Context->dbh;
1751 my $query = "INSERT INTO patronimage (cardnumber, mimetype, imagefile) VALUES (?,?,?) ON DUPLICATE KEY UPDATE imagefile = ?;";
1752 my $sth = $dbh->prepare($query);
1753 $sth->execute($cardnumber,$mimetype,$imgfile,$imgfile);
1754 warn "Error returned inserting $cardnumber.$mimetype." if $sth->errstr;
1755 return $sth->errstr;
1758 =head2 RmPatronImage
1760 my ($dberror) = RmPatronImage($cardnumber);
1762 Removes the image for the patron with the supplied cardnumber.
1767 my ($cardnumber) = @_;
1768 warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1769 my $dbh = C4::Context->dbh;
1770 my $query = "DELETE FROM patronimage WHERE cardnumber = ?;";
1771 my $sth = $dbh->prepare($query);
1772 $sth->execute($cardnumber);
1773 my $dberror = $sth->errstr;
1774 warn "Database error!" if $sth->errstr;
1778 =head2 GetRoadTypeDetails (OUEST-PROVENCE)
1780 ($roadtype) = &GetRoadTypeDetails($roadtypeid);
1782 Returns the description of roadtype
1783 C<&$roadtype>return description of road type
1784 C<&$roadtypeid>this is the value of roadtype s
1788 sub GetRoadTypeDetails {
1789 my ($roadtypeid) = @_;
1790 my $dbh = C4::Context->dbh;
1794 WHERE roadtypeid=?|;
1795 my $sth = $dbh->prepare($query);
1796 $sth->execute($roadtypeid);
1797 my $roadtype = $sth->fetchrow;
1801 =head2 GetBorrowersWhoHaveNotBorrowedSince
1803 &GetBorrowersWhoHaveNotBorrowedSince($date)
1805 this function get all borrowers who haven't borrowed since the date given on input arg.
1809 sub GetBorrowersWhoHaveNotBorrowedSince {
1810 ### 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.
1812 my $filterdate = shift||POSIX::strftime("%Y-%m-%d",localtime());
1813 my $filterbranch = shift ||
1814 ((C4::Context->preference('IndependantBranches')
1815 && C4::Context->userenv
1816 && C4::Context->userenv->{flags} % 2 !=1
1817 && C4::Context->userenv->{branch})
1818 ? C4::Context->userenv->{branch}
1820 my $dbh = C4::Context->dbh;
1822 SELECT borrowers.borrowernumber,max(issues.timestamp) as latestissue
1824 JOIN categories USING (categorycode)
1825 LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
1826 WHERE category_type <> 'S'
1829 if ($filterbranch && $filterbranch ne ""){
1830 $query.=" AND borrowers.branchcode= ?";
1831 push @query_params,$filterbranch;
1833 $query.=" GROUP BY borrowers.borrowernumber";
1835 $query.=" HAVING latestissue <? OR latestissue IS NULL";
1836 push @query_params,$filterdate;
1838 warn $query if $debug;
1839 my $sth = $dbh->prepare($query);
1840 if (scalar(@query_params)>0){
1841 $sth->execute(@query_params);
1848 while ( my $data = $sth->fetchrow_hashref ) {
1849 push @results, $data;
1854 =head2 GetBorrowersWhoHaveNeverBorrowed
1856 $results = &GetBorrowersWhoHaveNeverBorrowed
1858 this function get all borrowers who have never borrowed.
1860 I<$result> is a ref to an array which all elements are a hasref.
1864 sub GetBorrowersWhoHaveNeverBorrowed {
1865 my $filterbranch = shift ||
1866 ((C4::Context->preference('IndependantBranches')
1867 && C4::Context->userenv
1868 && C4::Context->userenv->{flags} % 2 !=1
1869 && C4::Context->userenv->{branch})
1870 ? C4::Context->userenv->{branch}
1872 my $dbh = C4::Context->dbh;
1874 SELECT borrowers.borrowernumber,max(timestamp) as latestissue
1876 LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
1877 WHERE issues.borrowernumber IS NULL
1880 if ($filterbranch && $filterbranch ne ""){
1881 $query.=" AND borrowers.branchcode= ?";
1882 push @query_params,$filterbranch;
1884 warn $query if $debug;
1886 my $sth = $dbh->prepare($query);
1887 if (scalar(@query_params)>0){
1888 $sth->execute(@query_params);
1895 while ( my $data = $sth->fetchrow_hashref ) {
1896 push @results, $data;
1901 =head2 GetBorrowersWithIssuesHistoryOlderThan
1903 $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
1905 this function get all borrowers who has an issue history older than I<$date> given on input arg.
1907 I<$result> is a ref to an array which all elements are a hashref.
1908 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
1912 sub GetBorrowersWithIssuesHistoryOlderThan {
1913 my $dbh = C4::Context->dbh;
1914 my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
1915 my $filterbranch = shift ||
1916 ((C4::Context->preference('IndependantBranches')
1917 && C4::Context->userenv
1918 && C4::Context->userenv->{flags} % 2 !=1
1919 && C4::Context->userenv->{branch})
1920 ? C4::Context->userenv->{branch}
1923 SELECT count(borrowernumber) as n,borrowernumber
1925 WHERE returndate < ?
1926 AND borrowernumber IS NOT NULL
1929 push @query_params, $date;
1931 $query.=" AND branchcode = ?";
1932 push @query_params, $filterbranch;
1934 $query.=" GROUP BY borrowernumber ";
1935 warn $query if $debug;
1936 my $sth = $dbh->prepare($query);
1937 $sth->execute(@query_params);
1940 while ( my $data = $sth->fetchrow_hashref ) {
1941 push @results, $data;
1946 =head2 GetBorrowersNamesAndLatestIssue
1948 $results = &GetBorrowersNamesAndLatestIssueList(@borrowernumbers)
1950 this function get borrowers Names and surnames and Issue information.
1952 I<@borrowernumbers> is an array which all elements are borrowernumbers.
1953 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
1957 sub GetBorrowersNamesAndLatestIssue {
1958 my $dbh = C4::Context->dbh;
1959 my @borrowernumbers=@_;
1961 SELECT surname,lastname, phone, email,max(timestamp)
1963 LEFT JOIN issues ON borrowers.borrowernumber=issues.borrowernumber
1964 GROUP BY borrowernumber
1966 my $sth = $dbh->prepare($query);
1968 my $results = $sth->fetchall_arrayref({});
1976 my $success = DebarMember( $borrowernumber );
1978 marks a Member as debarred, and therefore unable to checkout any more
1982 true on success, false on failure
1989 my $borrowernumber = shift;
1991 return unless defined $borrowernumber;
1992 return unless $borrowernumber =~ /^\d+$/;
1994 return ModMember( borrowernumber => $borrowernumber,
2003 AddMessage( $borrowernumber, $message_type, $message, $branchcode );
2005 Adds a message to the messages table for the given borrower.
2016 my ( $borrowernumber, $message_type, $message, $branchcode ) = @_;
2018 my $dbh = C4::Context->dbh;
2020 if ( ! ( $borrowernumber && $message_type && $message && $branchcode ) ) {
2024 my $query = "INSERT INTO messages ( borrowernumber, branchcode, message_type, message ) VALUES ( ?, ?, ?, ? )";
2025 my $sth = $dbh->prepare($query);
2026 $sth->execute( $borrowernumber, $branchcode, $message_type, $message );
2035 GetMessages( $borrowernumber, $type );
2037 $type is message type, B for borrower, or L for Librarian.
2038 Empty type returns all messages of any type.
2040 Returns all messages for the given borrowernumber
2047 my ( $borrowernumber, $type, $branchcode ) = @_;
2053 my $dbh = C4::Context->dbh;
2056 branches.branchname,
2058 DATE_FORMAT( message_date, '%m/%d/%Y' ) AS message_date_formatted,
2059 messages.branchcode LIKE '$branchcode' AS can_delete
2060 FROM messages, branches
2061 WHERE borrowernumber = ?
2062 AND message_type LIKE ?
2063 AND messages.branchcode = branches.branchcode
2064 ORDER BY message_date DESC";
2065 my $sth = $dbh->prepare($query);
2066 $sth->execute( $borrowernumber, $type ) ;
2069 while ( my $data = $sth->fetchrow_hashref ) {
2070 push @results, $data;
2080 GetMessagesCount( $borrowernumber, $type );
2082 $type is message type, B for borrower, or L for Librarian.
2083 Empty type returns all messages of any type.
2085 Returns the number of messages for the given borrowernumber
2091 sub GetMessagesCount {
2092 my ( $borrowernumber, $type, $branchcode ) = @_;
2098 my $dbh = C4::Context->dbh;
2100 my $query = "SELECT COUNT(*) as MsgCount FROM messages WHERE borrowernumber = ? AND message_type LIKE ?";
2101 my $sth = $dbh->prepare($query);
2102 $sth->execute( $borrowernumber, $type ) ;
2105 my $data = $sth->fetchrow_hashref;
2106 my $count = $data->{'MsgCount'};
2113 =head2 DeleteMessage
2117 DeleteMessage( $message_id );
2124 my ( $message_id ) = @_;
2126 my $dbh = C4::Context->dbh;
2128 my $query = "DELETE FROM messages WHERE message_id = ?";
2129 my $sth = $dbh->prepare($query);
2130 $sth->execute( $message_id );
2134 END { } # module clean-up code here (global destructor)