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 SearchInTable);
32 use C4::Members::Attributes qw(SearchIdMatchingAttribute);
34 our ($VERSION,@ISA,@EXPORT,@EXPORT_OK,$debug);
38 $debug = $ENV{DEBUG} || 0;
50 &GetMemberIssuesAndFines
70 &GetMemberAccountRecords
71 &GetBorNotifyAcctRecord
75 &GetBorrowercategoryList
77 &GetBorrowersWhoHaveNotBorrowedSince
78 &GetBorrowersWhoHaveNeverBorrowed
79 &GetBorrowersWithIssuesHistoryOlderThan
105 &ExtendMemberSubscriptionTo
123 C4::Members - Perl Module containing convenience functions for member handling
131 This module contains routines for adding, modifying and deleting members/patrons/borrowers
139 ($count, $borrowers) = &SearchMember($searchstring, $type,$category_type,$filter,$showallbranches);
143 Looks up patrons (borrowers) by name.
145 BUGFIX 499: C<$type> is now used to determine type of search.
146 if $type is "simple", search is performed on the first letter of the
149 $category_type is used to get a specified type of user.
150 (mainly adults when creating a child.)
152 C<$searchstring> is a space-separated list of search terms. Each term
153 must match the beginning a borrower's surname, first name, or other
156 C<$filter> is assumed to be a list of elements to filter results on
158 C<$showallbranches> is used in IndependantBranches Context to display all branches results.
160 C<&SearchMember> returns a two-element list. C<$borrowers> is a
161 reference-to-array; each element is a reference-to-hash, whose keys
162 are the fields of the C<borrowers> table in the Koha database.
163 C<$count> is the number of elements in C<$borrowers>.
168 #used by member enquiries from the intranet
170 my ($searchstring, $orderby, $type,$category_type,$filter,$showallbranches ) = @_;
171 my $dbh = C4::Context->dbh;
177 # this is used by circulation everytime a new borrowers cardnumber is scanned
178 # so we can check an exact match first, if that works return, otherwise do the rest
179 $query = "SELECT * FROM borrowers
180 LEFT JOIN categories ON borrowers.categorycode=categories.categorycode
182 my $sth = $dbh->prepare("$query WHERE cardnumber = ?");
183 $sth->execute($searchstring);
184 my $data = $sth->fetchall_arrayref({});
186 return ( scalar(@$data), $data );
189 if ( $type eq "simple" ) # simple search for one letter only
191 $query .= ($category_type ? " AND category_type = ".$dbh->quote($category_type) : "");
192 $query .= " WHERE (surname LIKE ? OR cardnumber like ?) ";
193 if (C4::Context->preference("IndependantBranches") && !$showallbranches){
194 if (C4::Context->userenv && C4::Context->userenv->{flags} % 2 !=1 && C4::Context->userenv->{'branch'}){
195 $query.=" AND borrowers.branchcode =".$dbh->quote(C4::Context->userenv->{'branch'}) unless (C4::Context->userenv->{'branch'} eq "insecure");
198 $query.=" ORDER BY $orderby";
199 @bind = ("$searchstring%","$searchstring");
201 else # advanced search looking in surname, firstname and othernames
203 @data = split( ' ', $searchstring );
206 if (C4::Context->preference("IndependantBranches") && !$showallbranches){
207 if (C4::Context->userenv && C4::Context->userenv->{flags} % 2 !=1 && C4::Context->userenv->{'branch'}){
208 $query.=" borrowers.branchcode =".$dbh->quote(C4::Context->userenv->{'branch'})." AND " unless (C4::Context->userenv->{'branch'} eq "insecure");
211 $query.="((surname LIKE ? OR surname LIKE ?
212 OR firstname LIKE ? OR firstname LIKE ?
213 OR othernames LIKE ? OR othernames LIKE ?)
215 ($category_type?" AND category_type = ".$dbh->quote($category_type):"");
217 "$data[0]%", "% $data[0]%", "$data[0]%", "% $data[0]%",
218 "$data[0]%", "% $data[0]%"
220 for ( my $i = 1 ; $i < $count ; $i++ ) {
221 $query = $query . " AND (" . " surname LIKE ? OR surname LIKE ?
222 OR firstname LIKE ? OR firstname LIKE ?
223 OR othernames LIKE ? OR othernames LIKE ?)";
225 "$data[$i]%", "% $data[$i]%", "$data[$i]%",
226 "% $data[$i]%", "$data[$i]%", "% $data[$i]%" );
230 $query = $query . ") OR cardnumber LIKE ? ";
231 push( @bind, $searchstring );
232 $query .= "order by $orderby";
237 $sth = $dbh->prepare($query);
239 $debug and print STDERR "Q $orderby : $query\n";
240 $sth->execute(@bind);
242 $data = $sth->fetchall_arrayref({});
244 return ( scalar(@$data), $data );
248 my ($filter,$orderby, $limit, $columns_out, $search_on_fields,$searchtype) = @_;
250 if (ref($filter) eq "ARRAY"){
251 push @filters,@$filter;
254 push @filters,$filter;
256 if (C4::Context->preference('ExtendedPatronAttributes')) {
257 my $matching_records = C4::Members::Attributes::SearchIdMatchingAttribute($filter);
258 push @filters,@$matching_records;
260 $searchtype||="start_with";
261 my $data=SearchInTable("borrowers",\@filters,$orderby,$limit,$columns_out,$search_on_fields,$searchtype);
266 =head2 GetMemberDetails
268 ($borrower) = &GetMemberDetails($borrowernumber, $cardnumber);
270 Looks up a patron and returns information about him or her. If
271 C<$borrowernumber> is true (nonzero), C<&GetMemberDetails> looks
272 up the borrower by number; otherwise, it looks up the borrower by card
275 C<$borrower> is a reference-to-hash whose keys are the fields of the
276 borrowers table in the Koha database. In addition,
277 C<$borrower-E<gt>{flags}> is a hash giving more detailed information
278 about the patron. Its keys act as flags :
280 if $borrower->{flags}->{LOST} {
281 # Patron's card was reported lost
284 If the state of a flag means that the patron should not be
285 allowed to borrow any more books, then it will have a C<noissues> key
288 See patronflags for more details.
290 C<$borrower-E<gt>{authflags}> is a hash giving more detailed information
291 about the top-level permissions flags set for the borrower. For example,
292 if a user has the "editcatalogue" permission,
293 C<$borrower-E<gt>{authflags}-E<gt>{editcatalogue}> will exist and have
298 sub GetMemberDetails {
299 my ( $borrowernumber, $cardnumber ) = @_;
300 my $dbh = C4::Context->dbh;
303 if ($borrowernumber) {
304 $sth = $dbh->prepare("select borrowers.*,category_type,categories.description from borrowers left join categories on borrowers.categorycode=categories.categorycode where borrowernumber=?");
305 $sth->execute($borrowernumber);
307 elsif ($cardnumber) {
308 $sth = $dbh->prepare("select borrowers.*,category_type,categories.description from borrowers left join categories on borrowers.categorycode=categories.categorycode where cardnumber=?");
309 $sth->execute($cardnumber);
314 my $borrower = $sth->fetchrow_hashref;
315 my ($amount) = GetMemberAccountRecords( $borrowernumber);
316 $borrower->{'amountoutstanding'} = $amount;
317 # FIXME - patronflags calls GetMemberAccountRecords... just have patronflags return $amount
318 my $flags = patronflags( $borrower);
321 $sth = $dbh->prepare("select bit,flag from userflags");
323 while ( my ( $bit, $flag ) = $sth->fetchrow ) {
324 if ( $borrower->{'flags'} && $borrower->{'flags'} & 2**$bit ) {
325 $accessflagshash->{$flag} = 1;
328 $borrower->{'flags'} = $flags;
329 $borrower->{'authflags'} = $accessflagshash;
331 # find out how long the membership lasts
334 "select enrolmentperiod from categories where categorycode = ?");
335 $sth->execute( $borrower->{'categorycode'} );
336 my $enrolment = $sth->fetchrow;
337 $borrower->{'enrolmentperiod'} = $enrolment;
338 return ($borrower); #, $flags, $accessflagshash);
343 $flags = &patronflags($patron);
345 This function is not exported.
347 The following will be set where applicable:
348 $flags->{CHARGES}->{amount} Amount of debt
349 $flags->{CHARGES}->{noissues} Set if debt amount >$5.00 (or syspref noissuescharge)
350 $flags->{CHARGES}->{message} Message -- deprecated
352 $flags->{CREDITS}->{amount} Amount of credit
353 $flags->{CREDITS}->{message} Message -- deprecated
355 $flags->{ GNA } Patron has no valid address
356 $flags->{ GNA }->{noissues} Set for each GNA
357 $flags->{ GNA }->{message} "Borrower has no valid address" -- deprecated
359 $flags->{ LOST } Patron's card reported lost
360 $flags->{ LOST }->{noissues} Set for each LOST
361 $flags->{ LOST }->{message} Message -- deprecated
363 $flags->{DBARRED} Set if patron debarred, no access
364 $flags->{DBARRED}->{noissues} Set for each DBARRED
365 $flags->{DBARRED}->{message} Message -- deprecated
368 $flags->{ NOTES }->{message} The note itself. NOT deprecated
370 $flags->{ ODUES } Set if patron has overdue books.
371 $flags->{ ODUES }->{message} "Yes" -- deprecated
372 $flags->{ ODUES }->{itemlist} ref-to-array: list of overdue books
373 $flags->{ ODUES }->{itemlisttext} Text list of overdue items -- deprecated
375 $flags->{WAITING} Set if any of patron's reserves are available
376 $flags->{WAITING}->{message} Message -- deprecated
377 $flags->{WAITING}->{itemlist} ref-to-array: list of available items
381 C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
382 overdue items. Its elements are references-to-hash, each describing an
383 overdue item. The keys are selected fields from the issues, biblio,
384 biblioitems, and items tables of the Koha database.
386 C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
387 the overdue items, one per line. Deprecated.
389 C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
390 available items. Each element is a reference-to-hash whose keys are
391 fields from the reserves table of the Koha database.
395 All the "message" fields that include language generated in this function are deprecated,
396 because such strings belong properly in the display layer.
398 The "message" field that comes from the DB is OK.
402 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
403 # FIXME rename this function.
406 my ( $patroninformation) = @_;
407 my $dbh=C4::Context->dbh;
408 my ($amount) = GetMemberAccountRecords( $patroninformation->{'borrowernumber'});
411 my $noissuescharge = C4::Context->preference("noissuescharge") || 5;
412 $flaginfo{'message'} = sprintf "Patron owes \$%.02f", $amount;
413 $flaginfo{'amount'} = sprintf "%.02f", $amount;
414 if ( $amount > $noissuescharge ) {
415 $flaginfo{'noissues'} = 1;
417 $flags{'CHARGES'} = \%flaginfo;
419 elsif ( $amount < 0 ) {
421 $flaginfo{'message'} = sprintf "Patron has credit of \$%.02f", -$amount;
422 $flaginfo{'amount'} = sprintf "%.02f", $amount;
423 $flags{'CREDITS'} = \%flaginfo;
425 if ( $patroninformation->{'gonenoaddress'}
426 && $patroninformation->{'gonenoaddress'} == 1 )
429 $flaginfo{'message'} = 'Borrower has no valid address.';
430 $flaginfo{'noissues'} = 1;
431 $flags{'GNA'} = \%flaginfo;
433 if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
435 $flaginfo{'message'} = 'Borrower\'s card reported lost.';
436 $flaginfo{'noissues'} = 1;
437 $flags{'LOST'} = \%flaginfo;
439 if ( $patroninformation->{'debarred'}
440 && $patroninformation->{'debarred'} == 1 )
443 $flaginfo{'message'} = 'Borrower is Debarred.';
444 $flaginfo{'noissues'} = 1;
445 $flags{'DBARRED'} = \%flaginfo;
447 if ( $patroninformation->{'borrowernotes'}
448 && $patroninformation->{'borrowernotes'} )
451 $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
452 $flags{'NOTES'} = \%flaginfo;
454 my ( $odues, $itemsoverdue ) = checkoverdues($patroninformation->{'borrowernumber'});
457 $flaginfo{'message'} = "Yes";
458 $flaginfo{'itemlist'} = $itemsoverdue;
459 foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
462 $flaginfo{'itemlisttext'} .=
463 "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n"; # newline is display layer
465 $flags{'ODUES'} = \%flaginfo;
467 my @itemswaiting = C4::Reserves::GetReservesFromBorrowernumber( $patroninformation->{'borrowernumber'},'W' );
468 my $nowaiting = scalar @itemswaiting;
469 if ( $nowaiting > 0 ) {
471 $flaginfo{'message'} = "Reserved items available";
472 $flaginfo{'itemlist'} = \@itemswaiting;
473 $flags{'WAITING'} = \%flaginfo;
481 $borrower = &GetMember(%information);
483 Looks up information about a patron (borrower) by either card number
484 ,firstname, or borrower number, depending on $type value.
485 If C<$type> == 'cardnumber', C<&GetBorrower>
486 searches by cardnumber then by firstname if not found in cardnumber;
487 otherwise, it searches by borrowernumber.
489 C<&GetBorrower> returns a reference-to-hash whose keys are the fields of
490 the C<borrowers> table in the Koha database.
496 my ( %information ) = @_;
497 my $dbh = C4::Context->dbh;
500 SELECT borrowers.*, categories.category_type, categories.description
502 LEFT JOIN categories on borrowers.categorycode=categories.categorycode
504 $select.=" WHERE ".join(" AND ",map {"$_ = ?"}keys %information);
506 $debug && warn $select, " ",values %information;
507 $sth = $dbh->prepare("$select");
508 $sth->execute(map{$information{$_}} keys %information);
509 my $data = $sth->fetchall_arrayref({});
510 return undef if (scalar(@$data)==0);
511 if (scalar(@$data)==1) {return $$data[0];}
512 ($data) and return $data;
516 =head2 IsMemberBlocked
520 my $blocked = IsMemberBlocked( $borrowernumber );
522 return the status, and the number of day or documents, depends his punishment
525 -1 if the user have overdue returns
526 1 if the user is punished X days
527 0 if the user is authorised to loan
533 sub IsMemberBlocked {
534 my $borrowernumber = shift;
535 my $dbh = C4::Context->dbh;
536 # if he have late issues
537 my $sth = $dbh->prepare(
538 "SELECT COUNT(*) as latedocs
540 WHERE borrowernumber = ?
541 AND date_due < now()"
543 $sth->execute($borrowernumber);
544 my $latedocs = $sth->fetchrow_hashref->{'latedocs'};
546 return (-1, $latedocs) if $latedocs > 0;
550 ADDDATE(returndate, finedays * DATEDIFF(returndate,date_due) ) AS blockingdate,
551 DATEDIFF(ADDDATE(returndate, finedays * DATEDIFF(returndate,date_due)),NOW()) AS blockedcount
554 # or if he must wait to loan
555 if(C4::Context->preference("item-level_itypes")){
557 qq{ LEFT JOIN items ON (items.itemnumber=old_issues.itemnumber)
558 LEFT JOIN issuingrules ON (issuingrules.itemtype=items.itype)}
561 qq{ LEFT JOIN items ON (items.itemnumber=old_issues.itemnumber)
562 LEFT JOIN biblioitems ON (biblioitems.biblioitemnumber=items.biblioitemnumber)
563 LEFT JOIN issuingrules ON (issuingrules.itemtype=biblioitems.itemtype) };
566 qq{ WHERE finedays IS NOT NULL
567 AND date_due < returndate
568 AND borrowernumber = ?
569 ORDER BY blockingdate DESC, blockedcount DESC
571 $sth=$dbh->prepare($strsth);
572 $sth->execute($borrowernumber);
573 my $row = $sth->fetchrow_hashref;
574 my $blockeddate = $row->{'blockeddate'};
575 my $blockedcount = $row->{'blockedcount'};
577 return (1, $blockedcount) if $blockedcount > 0;
582 =head2 GetMemberIssuesAndFines
584 ($overdue_count, $issue_count, $total_fines) = &GetMemberIssuesAndFines($borrowernumber);
586 Returns aggregate data about items borrowed by the patron with the
587 given borrowernumber.
589 C<&GetMemberIssuesAndFines> returns a three-element array. C<$overdue_count> is the
590 number of overdue items the patron currently has borrowed. C<$issue_count> is the
591 number of books the patron currently has borrowed. C<$total_fines> is
592 the total fine currently due by the borrower.
597 sub GetMemberIssuesAndFines {
598 my ( $borrowernumber ) = @_;
599 my $dbh = C4::Context->dbh;
600 my $query = "SELECT COUNT(*) FROM issues WHERE borrowernumber = ?";
602 $debug and warn $query."\n";
603 my $sth = $dbh->prepare($query);
604 $sth->execute($borrowernumber);
605 my $issue_count = $sth->fetchrow_arrayref->[0];
607 $sth = $dbh->prepare(
608 "SELECT COUNT(*) FROM issues
609 WHERE borrowernumber = ?
610 AND date_due < now()"
612 $sth->execute($borrowernumber);
613 my $overdue_count = $sth->fetchrow_arrayref->[0];
615 $sth = $dbh->prepare("SELECT SUM(amountoutstanding) FROM accountlines WHERE borrowernumber = ?");
616 $sth->execute($borrowernumber);
617 my $total_fines = $sth->fetchrow_arrayref->[0];
619 return ($overdue_count, $issue_count, $total_fines);
623 return @{C4::Context->dbh->selectcol_arrayref("SHOW columns from borrowers")};
632 my $success = ModMember(borrowernumber => $borrowernumber, [ field => value ]... );
634 Modify borrower's data. All date fields should ALREADY be in ISO format.
637 true on success, or false on failure
644 # test to know if you must update or not the borrower password
645 if (exists $data{password}) {
646 if ($data{password} eq '****' or $data{password} eq '') {
647 delete $data{password};
649 $data{password} = md5_base64($data{password});
652 my $execute_success=UpdateInTable("borrowers",\%data);
653 # ok if its an adult (type) it may have borrowers that depend on it as a guarantor
654 # so when we update information for an adult we should check for guarantees and update the relevant part
655 # of their records, ie addresses and phone numbers
656 my $borrowercategory= GetBorrowercategory( $data{'category_type'} );
657 if ( exists $borrowercategory->{'category_type'} && $borrowercategory->{'category_type'} eq ('A' || 'S') ) {
658 # is adult check guarantees;
659 UpdateGuarantees(%data);
661 logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "UPDATE (executed w/ arg: $data{'borrowernumber'})")
662 if C4::Context->preference("BorrowersLog");
664 return $execute_success;
672 $borrowernumber = &AddMember(%borrower);
674 insert new borrower into table
675 Returns the borrowernumber
682 my $dbh = C4::Context->dbh;
683 $data{'userid'} = '' unless $data{'password'};
684 $data{'password'} = md5_base64( $data{'password'} ) if $data{'password'};
685 $data{'borrowernumber'}=InsertInTable("borrowers",\%data);
686 # mysql_insertid is probably bad. not necessarily accurate and mysql-specific at best.
687 logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
689 # check for enrollment fee & add it if needed
690 my $sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
691 $sth->execute($data{'categorycode'});
692 my ($enrolmentfee) = $sth->fetchrow;
693 if ($enrolmentfee && $enrolmentfee > 0) {
694 # insert fee in patron debts
695 manualinvoice($data{'borrowernumber'}, '', '', 'A', $enrolmentfee);
697 return $data{'borrowernumber'};
702 my ($uid,$member) = @_;
703 my $dbh = C4::Context->dbh;
704 # Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
705 # Then we need to tell the user and have them create a new one.
708 "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
709 $sth->execute( $uid, $member );
710 if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
718 sub Generate_Userid {
719 my ($borrowernumber, $firstname, $surname) = @_;
723 $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
724 $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
725 $newuid = lc("$firstname.$surname");
726 $newuid .= $offset unless $offset == 0;
729 } while (!Check_Userid($newuid,$borrowernumber));
735 my ( $uid, $member, $digest ) = @_;
736 my $dbh = C4::Context->dbh;
738 #Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
739 #Then we need to tell the user and have them create a new one.
743 "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
744 $sth->execute( $uid, $member );
745 if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
749 #Everything is good so we can update the information.
752 "update borrowers set userid=?, password=? where borrowernumber=?");
753 $sth->execute( $uid, $digest, $member );
757 logaction("MEMBERS", "CHANGE PASS", $member, "") if C4::Context->preference("BorrowersLog");
763 =head2 fixup_cardnumber
765 Warning: The caller is responsible for locking the members table in write
766 mode, to avoid database corruption.
770 use vars qw( @weightings );
771 my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
773 sub fixup_cardnumber ($) {
774 my ($cardnumber) = @_;
775 my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;
777 # Find out whether member numbers should be generated
778 # automatically. Should be either "1" or something else.
779 # Defaults to "0", which is interpreted as "no".
781 # if ($cardnumber !~ /\S/ && $autonumber_members) {
782 ($autonumber_members) or return $cardnumber;
783 my $checkdigit = C4::Context->preference('checkdigit');
784 my $dbh = C4::Context->dbh;
785 if ( $checkdigit and $checkdigit eq 'katipo' ) {
787 # if checkdigit is selected, calculate katipo-style cardnumber.
788 # otherwise, just use the max()
789 # purpose: generate checksum'd member numbers.
790 # We'll assume we just got the max value of digits 2-8 of member #'s
791 # from the database and our job is to increment that by one,
792 # determine the 1st and 9th digits and return the full string.
793 my $sth = $dbh->prepare(
794 "select max(substring(borrowers.cardnumber,2,7)) as new_num from borrowers"
797 my $data = $sth->fetchrow_hashref;
798 $cardnumber = $data->{new_num};
799 if ( !$cardnumber ) { # If DB has no values,
800 $cardnumber = 1000000; # start at 1000000
806 for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
807 # read weightings, left to right, 1 char at a time
808 my $temp1 = $weightings[$i];
810 # sequence left to right, 1 char at a time
811 my $temp2 = substr( $cardnumber, $i, 1 );
813 # mult each char 1-7 by its corresponding weighting
814 $sum += $temp1 * $temp2;
817 my $rem = ( $sum % 11 );
818 $rem = 'X' if $rem == 10;
820 return "V$cardnumber$rem";
823 # MODIFIED BY JF: mysql4.1 allows casting as an integer, which is probably
824 # better. I'll leave the original in in case it needs to be changed for you
825 # my $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers");
826 my $sth = $dbh->prepare(
827 "select max(cast(cardnumber as signed)) from borrowers"
830 my ($result) = $sth->fetchrow;
833 return $cardnumber; # just here as a fallback/reminder
838 ($num_children, $children_arrayref) = &GetGuarantees($parent_borrno);
839 $child0_cardno = $children_arrayref->[0]{"cardnumber"};
840 $child0_borrno = $children_arrayref->[0]{"borrowernumber"};
842 C<&GetGuarantees> takes a borrower number (e.g., that of a patron
843 with children) and looks up the borrowers who are guaranteed by that
844 borrower (i.e., the patron's children).
846 C<&GetGuarantees> returns two values: an integer giving the number of
847 borrowers guaranteed by C<$parent_borrno>, and a reference to an array
848 of references to hash, which gives the actual results.
854 my ($borrowernumber) = @_;
855 my $dbh = C4::Context->dbh;
858 "select cardnumber,borrowernumber, firstname, surname from borrowers where guarantorid=?"
860 $sth->execute($borrowernumber);
863 my $data = $sth->fetchall_arrayref({});
864 return ( scalar(@$data), $data );
867 =head2 UpdateGuarantees
869 &UpdateGuarantees($parent_borrno);
872 C<&UpdateGuarantees> borrower data for an adult and updates all the guarantees
873 with the modified information
878 sub UpdateGuarantees {
880 my $dbh = C4::Context->dbh;
881 my ( $count, $guarantees ) = GetGuarantees( $data{'borrowernumber'} );
882 for ( my $i = 0 ; $i < $count ; $i++ ) {
885 # It looks like the $i is only being returned to handle walking through
886 # the array, which is probably better done as a foreach loop.
888 my $guaquery = qq|UPDATE borrowers
889 SET address='$data{'address'}',fax='$data{'fax'}',
890 B_city='$data{'B_city'}',mobile='$data{'mobile'}',city='$data{'city'}',phone='$data{'phone'}'
891 WHERE borrowernumber='$guarantees->[$i]->{'borrowernumber'}'
893 my $sth3 = $dbh->prepare($guaquery);
897 =head2 GetPendingIssues
899 my $issues = &GetPendingIssues($borrowernumber);
901 Looks up what the patron with the given borrowernumber has borrowed.
903 C<&GetPendingIssues> returns a
904 reference-to-array where each element is a reference-to-hash; the
905 keys are the fields from the C<issues>, C<biblio>, and C<items> tables.
906 The keys include C<biblioitems> fields except marc and marcxml.
911 sub GetPendingIssues {
912 my ($borrowernumber) = @_;
913 # must avoid biblioitems.* to prevent large marc and marcxml fields from killing performance
914 # FIXME: namespace collision: each table has "timestamp" fields. Which one is "timestamp" ?
915 # FIXME: circ/ciculation.pl tries to sort by timestamp!
916 # FIXME: C4::Print::printslip tries to sort by timestamp!
917 # FIXME: namespace collision: other collisions possible.
918 # FIXME: most of this data isn't really being used by callers.
919 my $sth = C4::Context->dbh->prepare(
925 biblioitems.itemtype,
928 biblioitems.publicationyear,
929 biblioitems.publishercode,
930 biblioitems.volumedate,
931 biblioitems.volumedesc,
934 issues.timestamp AS timestamp,
935 issues.renewals AS renewals,
936 items.renewals AS totalrenewals
938 LEFT JOIN items ON items.itemnumber = issues.itemnumber
939 LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
940 LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
943 ORDER BY issues.issuedate"
945 $sth->execute($borrowernumber);
946 my $data = $sth->fetchall_arrayref({});
947 my $today = C4::Dates->new->output('iso');
949 $_->{date_due} or next;
950 ($_->{date_due} lt $today) and $_->{overdue} = 1;
957 ($count, $issues) = &GetAllIssues($borrowernumber, $sortkey, $limit);
959 Looks up what the patron with the given borrowernumber has borrowed,
960 and sorts the results.
962 C<$sortkey> is the name of a field on which to sort the results. This
963 should be the name of a field in the C<issues>, C<biblio>,
964 C<biblioitems>, or C<items> table in the Koha database.
966 C<$limit> is the maximum number of results to return.
968 C<&GetAllIssues> returns a two-element array. C<$issues> is a
969 reference-to-array, where each element is a reference-to-hash; the
970 keys are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
971 C<items> tables of the Koha database. C<$count> is the number of
972 elements in C<$issues>
978 my ( $borrowernumber, $order, $limit ) = @_;
980 #FIXME: sanity-check order and limit
981 my $dbh = C4::Context->dbh;
984 "SELECT *,issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
986 LEFT JOIN items on items.itemnumber=issues.itemnumber
987 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
988 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
989 WHERE borrowernumber=?
991 SELECT *,old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
993 LEFT JOIN items on items.itemnumber=old_issues.itemnumber
994 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
995 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
996 WHERE borrowernumber=?
999 $query .= " limit $limit";
1003 my $sth = $dbh->prepare($query);
1004 $sth->execute($borrowernumber, $borrowernumber);
1007 while ( my $data = $sth->fetchrow_hashref ) {
1008 $result[$i] = $data;
1013 # get all issued items for borrowernumber from oldissues table
1014 # large chunk of older issues data put into table oldissues
1015 # to speed up db calls for issuing items
1016 if ( C4::Context->preference("ReadingHistory") ) {
1017 # FIXME oldissues (not to be confused with old_issues) is
1018 # apparently specific to HLT. Not sure if the ReadingHistory
1019 # syspref is still required, as old_issues by design
1020 # is no longer checked with each loan.
1021 my $query2 = "SELECT * FROM oldissues
1022 LEFT JOIN items ON items.itemnumber=oldissues.itemnumber
1023 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1024 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1025 WHERE borrowernumber=?
1027 if ( $limit != 0 ) {
1028 $limit = $limit - $count;
1029 $query2 .= " limit $limit";
1032 my $sth2 = $dbh->prepare($query2);
1033 $sth2->execute($borrowernumber);
1035 while ( my $data2 = $sth2->fetchrow_hashref ) {
1036 $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
1087 return ( $total, \@acctlines,$numlines);
1090 =head2 GetBorNotifyAcctRecord
1092 ($count, $acctlines, $total) = &GetBorNotifyAcctRecord($params,$notifyid);
1094 Looks up accounting data for the patron with the given borrowernumber per file number.
1096 (FIXME - I'm not at all sure what this is about.)
1098 C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a
1099 reference-to-array, where each element is a reference-to-hash; the
1100 keys are the fields of the C<accountlines> table in the Koha database.
1101 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1102 total amount outstanding for all of the account lines.
1106 sub GetBorNotifyAcctRecord {
1107 my ( $borrowernumber, $notifyid ) = @_;
1108 my $dbh = C4::Context->dbh;
1111 my $sth = $dbh->prepare(
1114 WHERE borrowernumber=?
1116 AND amountoutstanding != '0'
1117 ORDER BY notify_id,accounttype
1119 # 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')
1121 $sth->execute( $borrowernumber, $notifyid );
1123 while ( my $data = $sth->fetchrow_hashref ) {
1124 $acctlines[$numlines] = $data;
1126 $total += int(100 * $data->{'amountoutstanding'});
1129 return ( $total, \@acctlines, $numlines );
1132 =head2 checkuniquemember (OUEST-PROVENCE)
1134 ($result,$categorycode) = &checkuniquemember($collectivity,$surname,$firstname,$dateofbirth);
1136 Checks that a member exists or not in the database.
1138 C<&result> is nonzero (=exist) or 0 (=does not exist)
1139 C<&categorycode> is from categorycode table
1140 C<&collectivity> is 1 (= we add a collectivity) or 0 (= we add a physical member)
1141 C<&surname> is the surname
1142 C<&firstname> is the firstname (only if collectivity=0)
1143 C<&dateofbirth> is the date of birth in ISO format (only if collectivity=0)
1147 # FIXME: This function is not legitimate. Multiple patrons might have the same first/last name and birthdate.
1148 # This is especially true since first name is not even a required field.
1150 sub checkuniquemember {
1151 my ( $collectivity, $surname, $firstname, $dateofbirth ) = @_;
1152 my $dbh = C4::Context->dbh;
1153 my $request = ($collectivity) ?
1154 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? " :
1156 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=? and dateofbirth=?" :
1157 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=?";
1158 my $sth = $dbh->prepare($request);
1159 if ($collectivity) {
1160 $sth->execute( uc($surname) );
1161 } elsif($dateofbirth){
1162 $sth->execute( uc($surname), ucfirst($firstname), $dateofbirth );
1164 $sth->execute( uc($surname), ucfirst($firstname));
1166 my @data = $sth->fetchrow;
1167 ( $data[0] ) and return $data[0], $data[1];
1171 sub checkcardnumber {
1172 my ($cardnumber,$borrowernumber) = @_;
1173 my $dbh = C4::Context->dbh;
1174 my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
1175 $query .= " AND borrowernumber <> ?" if ($borrowernumber);
1176 my $sth = $dbh->prepare($query);
1177 if ($borrowernumber) {
1178 $sth->execute($cardnumber,$borrowernumber);
1180 $sth->execute($cardnumber);
1182 if (my $data= $sth->fetchrow_hashref()){
1191 =head2 getzipnamecity (OUEST-PROVENCE)
1193 take all info from table city for the fields city and zip
1194 check for the name and the zip code of the city selected
1198 sub getzipnamecity {
1200 my $dbh = C4::Context->dbh;
1203 "select city_name,city_zipcode from cities where cityid=? ");
1204 $sth->execute($cityid);
1205 my @data = $sth->fetchrow;
1206 return $data[0], $data[1];
1210 =head2 getdcity (OUEST-PROVENCE)
1212 recover cityid with city_name condition
1217 my ($city_name) = @_;
1218 my $dbh = C4::Context->dbh;
1219 my $sth = $dbh->prepare("select cityid from cities where city_name=? ");
1220 $sth->execute($city_name);
1221 my $data = $sth->fetchrow;
1226 =head2 GetExpiryDate
1228 $expirydate = GetExpiryDate($categorycode, $dateenrolled);
1230 Calculate expiry date given a categorycode and starting date. Date argument must be in ISO format.
1231 Return date is also in ISO format.
1236 my ( $categorycode, $dateenrolled ) = @_;
1237 my $enrolmentperiod = 12; # reasonable default
1238 if ($categorycode) {
1239 my $dbh = C4::Context->dbh;
1240 my $sth = $dbh->prepare("select enrolmentperiod from categories where categorycode=?");
1241 $sth->execute($categorycode);
1242 $enrolmentperiod = $sth->fetchrow;
1244 # die "GetExpiryDate: for enrollmentperiod $enrolmentperiod (category '$categorycode') starting $dateenrolled.\n";
1245 my @date = split /-/,$dateenrolled;
1246 return sprintf("%04d-%02d-%02d", Add_Delta_YM(@date,0,$enrolmentperiod));
1249 =head2 checkuserpassword (OUEST-PROVENCE)
1251 check for the password and login are not used
1252 return the number of record
1253 0=> NOT USED 1=> USED
1257 sub checkuserpassword {
1258 my ( $borrowernumber, $userid, $password ) = @_;
1259 $password = md5_base64($password);
1260 my $dbh = C4::Context->dbh;
1263 "Select count(*) from borrowers where borrowernumber !=? and userid =? and password=? "
1265 $sth->execute( $borrowernumber, $userid, $password );
1266 my $number_rows = $sth->fetchrow;
1267 return $number_rows;
1271 =head2 GetborCatFromCatType
1273 ($codes_arrayref, $labels_hashref) = &GetborCatFromCatType();
1275 Looks up the different types of borrowers in the database. Returns two
1276 elements: a reference-to-array, which lists the borrower category
1277 codes, and a reference-to-hash, which maps the borrower category codes
1278 to category descriptions.
1283 sub GetborCatFromCatType {
1284 my ( $category_type, $action ) = @_;
1285 # FIXME - This API seems both limited and dangerous.
1286 my $dbh = C4::Context->dbh;
1287 my $request = qq| SELECT categorycode,description
1290 ORDER BY categorycode|;
1291 my $sth = $dbh->prepare($request);
1293 $sth->execute($category_type);
1302 while ( my $data = $sth->fetchrow_hashref ) {
1303 push @codes, $data->{'categorycode'};
1304 $labels{ $data->{'categorycode'} } = $data->{'description'};
1306 return ( \@codes, \%labels );
1309 =head2 GetBorrowercategory
1311 $hashref = &GetBorrowercategory($categorycode);
1313 Given the borrower's category code, the function returns the corresponding
1314 data hashref for a comprehensive information display.
1316 $arrayref_hashref = &GetBorrowercategory;
1317 If no category code provided, the function returns all the categories.
1321 sub GetBorrowercategory {
1323 my $dbh = C4::Context->dbh;
1327 "SELECT description,dateofbirthrequired,upperagelimit,category_type
1329 WHERE categorycode = ?"
1331 $sth->execute($catcode);
1333 $sth->fetchrow_hashref;
1337 } # sub getborrowercategory
1339 =head2 GetBorrowercategoryList
1341 $arrayref_hashref = &GetBorrowercategoryList;
1342 If no category code provided, the function returns all the categories.
1346 sub GetBorrowercategoryList {
1347 my $dbh = C4::Context->dbh;
1352 ORDER BY description"
1356 $sth->fetchall_arrayref({});
1358 } # sub getborrowercategory
1360 =head2 ethnicitycategories
1362 ($codes_arrayref, $labels_hashref) = ðnicitycategories();
1364 Looks up the different ethnic types in the database. Returns two
1365 elements: a reference-to-array, which lists the ethnicity codes, and a
1366 reference-to-hash, which maps the ethnicity codes to ethnicity
1373 sub ethnicitycategories {
1374 my $dbh = C4::Context->dbh;
1375 my $sth = $dbh->prepare("Select code,name from ethnicity order by name");
1379 while ( my $data = $sth->fetchrow_hashref ) {
1380 push @codes, $data->{'code'};
1381 $labels{ $data->{'code'} } = $data->{'name'};
1383 return ( \@codes, \%labels );
1388 $ethn_name = &fixEthnicity($ethn_code);
1390 Takes an ethnicity code (e.g., "european" or "pi") and returns the
1391 corresponding descriptive name from the C<ethnicity> table in the
1392 Koha database ("European" or "Pacific Islander").
1399 my $ethnicity = shift;
1400 return unless $ethnicity;
1401 my $dbh = C4::Context->dbh;
1402 my $sth = $dbh->prepare("Select name from ethnicity where code = ?");
1403 $sth->execute($ethnicity);
1404 my $data = $sth->fetchrow_hashref;
1405 return $data->{'name'};
1406 } # sub fixEthnicity
1410 $dateofbirth,$date = &GetAge($date);
1412 this function return the borrowers age with the value of dateofbirth
1418 my ( $date, $date_ref ) = @_;
1420 if ( not defined $date_ref ) {
1421 $date_ref = sprintf( '%04d-%02d-%02d', Today() );
1424 my ( $year1, $month1, $day1 ) = split /-/, $date;
1425 my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
1427 my $age = $year2 - $year1;
1428 if ( $month1 . $day1 > $month2 . $day2 ) {
1435 =head2 get_institutions
1436 $insitutions = get_institutions();
1438 Just returns a list of all the borrowers of type I, borrownumber and name
1443 sub get_institutions {
1444 my $dbh = C4::Context->dbh();
1447 "SELECT borrowernumber,surname FROM borrowers WHERE categorycode=? ORDER BY surname"
1451 while ( my $data = $sth->fetchrow_hashref() ) {
1452 $orgs{ $data->{'borrowernumber'} } = $data;
1456 } # sub get_institutions
1458 =head2 add_member_orgs
1460 add_member_orgs($borrowernumber,$borrowernumbers);
1462 Takes a borrowernumber and a list of other borrowernumbers and inserts them into the borrowers_to_borrowers table
1467 sub add_member_orgs {
1468 my ( $borrowernumber, $otherborrowers ) = @_;
1469 my $dbh = C4::Context->dbh();
1471 "INSERT INTO borrowers_to_borrowers (borrower1,borrower2) VALUES (?,?)";
1472 my $sth = $dbh->prepare($query);
1473 foreach my $otherborrowernumber (@$otherborrowers) {
1474 $sth->execute( $borrowernumber, $otherborrowernumber );
1477 } # sub add_member_orgs
1479 =head2 GetCities (OUEST-PROVENCE)
1481 ($id_cityarrayref, $city_hashref) = &GetCities();
1483 Looks up the different city and zip in the database. Returns two
1484 elements: a reference-to-array, which lists the zip city
1485 codes, and a reference-to-hash, which maps the name of the city.
1486 WHERE =>OUEST PROVENCE OR EXTERIEUR
1492 #my ($type_city) = @_;
1493 my $dbh = C4::Context->dbh;
1494 my $query = qq|SELECT cityid,city_zipcode,city_name
1496 ORDER BY city_name|;
1497 my $sth = $dbh->prepare($query);
1499 #$sth->execute($type_city);
1503 # insert empty value to create a empty choice in cgi popup
1506 while ( my $data = $sth->fetchrow_hashref ) {
1507 push @id, $data->{'city_zipcode'}."|".$data->{'city_name'};
1508 $city{ $data->{'city_zipcode'}."|".$data->{'city_name'} } = $data->{'city_name'};
1511 #test to know if the table contain some records if no the function return nothing
1514 # all we have is the one blank row
1519 return ( \@id, \%city );
1523 =head2 GetSortDetails (OUEST-PROVENCE)
1525 ($lib) = &GetSortDetails($category,$sortvalue);
1527 Returns the authorized value details
1528 C<&$lib>return value of authorized value details
1529 C<&$sortvalue>this is the value of authorized value
1530 C<&$category>this is the value of authorized value category
1534 sub GetSortDetails {
1535 my ( $category, $sortvalue ) = @_;
1536 my $dbh = C4::Context->dbh;
1537 my $query = qq|SELECT lib
1538 FROM authorised_values
1540 AND authorised_value=? |;
1541 my $sth = $dbh->prepare($query);
1542 $sth->execute( $category, $sortvalue );
1543 my $lib = $sth->fetchrow;
1544 return ($lib) if ($lib);
1545 return ($sortvalue) unless ($lib);
1548 =head2 MoveMemberToDeleted
1550 $result = &MoveMemberToDeleted($borrowernumber);
1552 Copy the record from borrowers to deletedborrowers table.
1556 # FIXME: should do it in one SQL statement w/ subquery
1557 # Otherwise, we should return the @data on success
1559 sub MoveMemberToDeleted {
1560 my ($member) = shift or return;
1561 my $dbh = C4::Context->dbh;
1562 my $query = qq|SELECT *
1564 WHERE borrowernumber=?|;
1565 my $sth = $dbh->prepare($query);
1566 $sth->execute($member);
1567 my @data = $sth->fetchrow_array;
1568 (@data) or return; # if we got a bad borrowernumber, there's nothing to insert
1570 $dbh->prepare( "INSERT INTO deletedborrowers VALUES ("
1571 . ( "?," x ( scalar(@data) - 1 ) )
1573 $sth->execute(@data);
1578 DelMember($borrowernumber);
1580 This function remove directly a borrower whitout writing it on deleteborrower.
1581 + Deletes reserves for the borrower
1586 my $dbh = C4::Context->dbh;
1587 my $borrowernumber = shift;
1588 #warn "in delmember with $borrowernumber";
1589 return unless $borrowernumber; # borrowernumber is mandatory.
1591 my $query = qq|DELETE
1593 WHERE borrowernumber=?|;
1594 my $sth = $dbh->prepare($query);
1595 $sth->execute($borrowernumber);
1599 WHERE borrowernumber = ?
1601 $sth = $dbh->prepare($query);
1602 $sth->execute($borrowernumber);
1603 logaction("MEMBERS", "DELETE", $borrowernumber, "") if C4::Context->preference("BorrowersLog");
1607 =head2 ExtendMemberSubscriptionTo (OUEST-PROVENCE)
1609 $date = ExtendMemberSubscriptionTo($borrowerid, $date);
1611 Extending the subscription to a given date or to the expiry date calculated on ISO date.
1616 sub ExtendMemberSubscriptionTo {
1617 my ( $borrowerid,$date) = @_;
1618 my $dbh = C4::Context->dbh;
1619 my $borrower = GetMember('borrowernumber'=>$borrowerid);
1621 $date=POSIX::strftime("%Y-%m-%d",localtime());
1622 $date = GetExpiryDate( $borrower->{'categorycode'}, $date );
1624 my $sth = $dbh->do(<<EOF);
1626 SET dateexpiry='$date'
1627 WHERE borrowernumber='$borrowerid'
1629 # add enrolmentfee if needed
1630 $sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
1631 $sth->execute($borrower->{'categorycode'});
1632 my ($enrolmentfee) = $sth->fetchrow;
1633 if ($enrolmentfee && $enrolmentfee > 0) {
1634 # insert fee in patron debts
1635 manualinvoice($borrower->{'borrowernumber'}, '', '', 'A', $enrolmentfee);
1637 return $date if ($sth);
1641 =head2 GetRoadTypes (OUEST-PROVENCE)
1643 ($idroadtypearrayref, $roadttype_hashref) = &GetRoadTypes();
1645 Looks up the different road type . Returns two
1646 elements: a reference-to-array, which lists the id_roadtype
1647 codes, and a reference-to-hash, which maps the road type of the road .
1652 my $dbh = C4::Context->dbh;
1654 SELECT roadtypeid,road_type
1656 ORDER BY road_type|;
1657 my $sth = $dbh->prepare($query);
1662 # insert empty value to create a empty choice in cgi popup
1664 while ( my $data = $sth->fetchrow_hashref ) {
1666 push @id, $data->{'roadtypeid'};
1667 $roadtype{ $data->{'roadtypeid'} } = $data->{'road_type'};
1670 #test to know if the table contain some records if no the function return nothing
1677 return ( \@id, \%roadtype );
1683 =head2 GetTitles (OUEST-PROVENCE)
1685 ($borrowertitle)= &GetTitles();
1687 Looks up the different title . Returns array with all borrowers title
1692 my @borrowerTitle = split /,|\|/,C4::Context->preference('BorrowersTitles');
1693 unshift( @borrowerTitle, "" );
1694 my $count=@borrowerTitle;
1699 return ( \@borrowerTitle);
1703 =head2 GetPatronImage
1705 my ($imagedata, $dberror) = GetPatronImage($cardnumber);
1707 Returns the mimetype and binary image data of the image for the patron with the supplied cardnumber.
1711 sub GetPatronImage {
1712 my ($cardnumber) = @_;
1713 warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1714 my $dbh = C4::Context->dbh;
1715 my $query = 'SELECT mimetype, imagefile FROM patronimage WHERE cardnumber = ?';
1716 my $sth = $dbh->prepare($query);
1717 $sth->execute($cardnumber);
1718 my $imagedata = $sth->fetchrow_hashref;
1719 warn "Database error!" if $sth->errstr;
1720 return $imagedata, $sth->errstr;
1723 =head2 PutPatronImage
1725 PutPatronImage($cardnumber, $mimetype, $imgfile);
1727 Stores patron binary image data and mimetype in database.
1728 NOTE: This function is good for updating images as well as inserting new images in the database.
1732 sub PutPatronImage {
1733 my ($cardnumber, $mimetype, $imgfile) = @_;
1734 warn "Parameters passed in: Cardnumber=$cardnumber, Mimetype=$mimetype, " . ($imgfile ? "Imagefile" : "No Imagefile") if $debug;
1735 my $dbh = C4::Context->dbh;
1736 my $query = "INSERT INTO patronimage (cardnumber, mimetype, imagefile) VALUES (?,?,?) ON DUPLICATE KEY UPDATE imagefile = ?;";
1737 my $sth = $dbh->prepare($query);
1738 $sth->execute($cardnumber,$mimetype,$imgfile,$imgfile);
1739 warn "Error returned inserting $cardnumber.$mimetype." if $sth->errstr;
1740 return $sth->errstr;
1743 =head2 RmPatronImage
1745 my ($dberror) = RmPatronImage($cardnumber);
1747 Removes the image for the patron with the supplied cardnumber.
1752 my ($cardnumber) = @_;
1753 warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1754 my $dbh = C4::Context->dbh;
1755 my $query = "DELETE FROM patronimage WHERE cardnumber = ?;";
1756 my $sth = $dbh->prepare($query);
1757 $sth->execute($cardnumber);
1758 my $dberror = $sth->errstr;
1759 warn "Database error!" if $sth->errstr;
1763 =head2 GetRoadTypeDetails (OUEST-PROVENCE)
1765 ($roadtype) = &GetRoadTypeDetails($roadtypeid);
1767 Returns the description of roadtype
1768 C<&$roadtype>return description of road type
1769 C<&$roadtypeid>this is the value of roadtype s
1773 sub GetRoadTypeDetails {
1774 my ($roadtypeid) = @_;
1775 my $dbh = C4::Context->dbh;
1779 WHERE roadtypeid=?|;
1780 my $sth = $dbh->prepare($query);
1781 $sth->execute($roadtypeid);
1782 my $roadtype = $sth->fetchrow;
1786 =head2 GetBorrowersWhoHaveNotBorrowedSince
1788 &GetBorrowersWhoHaveNotBorrowedSince($date)
1790 this function get all borrowers who haven't borrowed since the date given on input arg.
1794 sub GetBorrowersWhoHaveNotBorrowedSince {
1795 ### 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.
1797 my $filterdate = shift||POSIX::strftime("%Y-%m-%d",localtime());
1798 my $filterbranch = shift ||
1799 ((C4::Context->preference('IndependantBranches')
1800 && C4::Context->userenv
1801 && C4::Context->userenv->{flags} % 2 !=1
1802 && C4::Context->userenv->{branch})
1803 ? C4::Context->userenv->{branch}
1805 my $dbh = C4::Context->dbh;
1807 SELECT borrowers.borrowernumber,max(issues.timestamp) as latestissue
1809 JOIN categories USING (categorycode)
1810 LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
1811 WHERE category_type <> 'S'
1814 if ($filterbranch && $filterbranch ne ""){
1815 $query.=" AND borrowers.branchcode= ?";
1816 push @query_params,$filterbranch;
1818 $query.=" GROUP BY borrowers.borrowernumber";
1820 $query.=" HAVING latestissue <? OR latestissue IS NULL";
1821 push @query_params,$filterdate;
1823 warn $query if $debug;
1824 my $sth = $dbh->prepare($query);
1825 if (scalar(@query_params)>0){
1826 $sth->execute(@query_params);
1833 while ( my $data = $sth->fetchrow_hashref ) {
1834 push @results, $data;
1839 =head2 GetBorrowersWhoHaveNeverBorrowed
1841 $results = &GetBorrowersWhoHaveNeverBorrowed
1843 this function get all borrowers who have never borrowed.
1845 I<$result> is a ref to an array which all elements are a hasref.
1849 sub GetBorrowersWhoHaveNeverBorrowed {
1850 my $filterbranch = shift ||
1851 ((C4::Context->preference('IndependantBranches')
1852 && C4::Context->userenv
1853 && C4::Context->userenv->{flags} % 2 !=1
1854 && C4::Context->userenv->{branch})
1855 ? C4::Context->userenv->{branch}
1857 my $dbh = C4::Context->dbh;
1859 SELECT borrowers.borrowernumber,max(timestamp) as latestissue
1861 LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
1862 WHERE issues.borrowernumber IS NULL
1865 if ($filterbranch && $filterbranch ne ""){
1866 $query.=" AND borrowers.branchcode= ?";
1867 push @query_params,$filterbranch;
1869 warn $query if $debug;
1871 my $sth = $dbh->prepare($query);
1872 if (scalar(@query_params)>0){
1873 $sth->execute(@query_params);
1880 while ( my $data = $sth->fetchrow_hashref ) {
1881 push @results, $data;
1886 =head2 GetBorrowersWithIssuesHistoryOlderThan
1888 $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
1890 this function get all borrowers who has an issue history older than I<$date> given on input arg.
1892 I<$result> is a ref to an array which all elements are a hashref.
1893 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
1897 sub GetBorrowersWithIssuesHistoryOlderThan {
1898 my $dbh = C4::Context->dbh;
1899 my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
1900 my $filterbranch = shift ||
1901 ((C4::Context->preference('IndependantBranches')
1902 && C4::Context->userenv
1903 && C4::Context->userenv->{flags} % 2 !=1
1904 && C4::Context->userenv->{branch})
1905 ? C4::Context->userenv->{branch}
1908 SELECT count(borrowernumber) as n,borrowernumber
1910 WHERE returndate < ?
1911 AND borrowernumber IS NOT NULL
1914 push @query_params, $date;
1916 $query.=" AND branchcode = ?";
1917 push @query_params, $filterbranch;
1919 $query.=" GROUP BY borrowernumber ";
1920 warn $query if $debug;
1921 my $sth = $dbh->prepare($query);
1922 $sth->execute(@query_params);
1925 while ( my $data = $sth->fetchrow_hashref ) {
1926 push @results, $data;
1931 =head2 GetBorrowersNamesAndLatestIssue
1933 $results = &GetBorrowersNamesAndLatestIssueList(@borrowernumbers)
1935 this function get borrowers Names and surnames and Issue information.
1937 I<@borrowernumbers> is an array which all elements are borrowernumbers.
1938 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
1942 sub GetBorrowersNamesAndLatestIssue {
1943 my $dbh = C4::Context->dbh;
1944 my @borrowernumbers=@_;
1946 SELECT surname,lastname, phone, email,max(timestamp)
1948 LEFT JOIN issues ON borrowers.borrowernumber=issues.borrowernumber
1949 GROUP BY borrowernumber
1951 my $sth = $dbh->prepare($query);
1953 my $results = $sth->fetchall_arrayref({});
1961 my $success = DebarMember( $borrowernumber );
1963 marks a Member as debarred, and therefore unable to checkout any more
1967 true on success, false on failure
1974 my $borrowernumber = shift;
1976 return unless defined $borrowernumber;
1977 return unless $borrowernumber =~ /^\d+$/;
1979 return ModMember( borrowernumber => $borrowernumber,
1988 AddMessage( $borrowernumber, $message_type, $message, $branchcode );
1990 Adds a message to the messages table for the given borrower.
2001 my ( $borrowernumber, $message_type, $message, $branchcode ) = @_;
2003 my $dbh = C4::Context->dbh;
2005 if ( ! ( $borrowernumber && $message_type && $message && $branchcode ) ) {
2009 my $query = "INSERT INTO messages ( borrowernumber, branchcode, message_type, message ) VALUES ( ?, ?, ?, ? )";
2010 my $sth = $dbh->prepare($query);
2011 $sth->execute( $borrowernumber, $branchcode, $message_type, $message );
2020 GetMessages( $borrowernumber, $type );
2022 $type is message type, B for borrower, or L for Librarian.
2023 Empty type returns all messages of any type.
2025 Returns all messages for the given borrowernumber
2032 my ( $borrowernumber, $type, $branchcode ) = @_;
2038 my $dbh = C4::Context->dbh;
2041 branches.branchname,
2043 DATE_FORMAT( message_date, '%m/%d/%Y' ) AS message_date_formatted,
2044 messages.branchcode LIKE '$branchcode' AS can_delete
2045 FROM messages, branches
2046 WHERE borrowernumber = ?
2047 AND message_type LIKE ?
2048 AND messages.branchcode = branches.branchcode
2049 ORDER BY message_date DESC";
2050 my $sth = $dbh->prepare($query);
2051 $sth->execute( $borrowernumber, $type ) ;
2054 while ( my $data = $sth->fetchrow_hashref ) {
2055 push @results, $data;
2065 GetMessagesCount( $borrowernumber, $type );
2067 $type is message type, B for borrower, or L for Librarian.
2068 Empty type returns all messages of any type.
2070 Returns the number of messages for the given borrowernumber
2076 sub GetMessagesCount {
2077 my ( $borrowernumber, $type, $branchcode ) = @_;
2083 my $dbh = C4::Context->dbh;
2085 my $query = "SELECT COUNT(*) as MsgCount FROM messages WHERE borrowernumber = ? AND message_type LIKE ?";
2086 my $sth = $dbh->prepare($query);
2087 $sth->execute( $borrowernumber, $type ) ;
2090 my $data = $sth->fetchrow_hashref;
2091 my $count = $data->{'MsgCount'};
2098 =head2 DeleteMessage
2102 DeleteMessage( $message_id );
2109 my ( $message_id ) = @_;
2111 my $dbh = C4::Context->dbh;
2113 my $query = "DELETE FROM messages WHERE message_id = ?";
2114 my $sth = $dbh->prepare($query);
2115 $sth->execute( $message_id );
2119 END { } # module clean-up code here (global destructor)