3 # Copyright 2000-2003 Katipo Communications
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 2 of the License, or (at your option) any later
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
16 # You should have received a copy of the GNU General Public License along
17 # with Koha; if not, write to the Free Software Foundation, Inc.,
18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
22 #use warnings; FIXME - Bug 2505
24 use C4::Dates qw(format_date_in_iso);
25 use Digest::MD5 qw(md5_base64);
26 use Date::Calc qw/Today Add_Delta_YM/;
27 use C4::Log; # logaction
32 use C4::SQLHelper qw(InsertInTable UpdateInTable SearchInTable);
33 use C4::Members::Attributes qw(SearchIdMatchingAttribute);
35 our ($VERSION,@ISA,@EXPORT,@EXPORT_OK,$debug);
39 $debug = $ENV{DEBUG} || 0;
51 &GetMemberIssuesAndFines
71 &GetMemberAccountRecords
72 &GetBorNotifyAcctRecord
76 &GetBorrowercategoryList
78 &GetBorrowersWhoHaveNotBorrowedSince
79 &GetBorrowersWhoHaveNeverBorrowed
80 &GetBorrowersWithIssuesHistoryOlderThan
106 &ExtendMemberSubscriptionTo
124 C4::Members - Perl Module containing convenience functions for member handling
132 This module contains routines for adding, modifying and deleting members/patrons/borrowers
140 ($count, $borrowers) = &SearchMember($searchstring, $type,$category_type,$filter,$showallbranches);
144 Looks up patrons (borrowers) by name.
146 BUGFIX 499: C<$type> is now used to determine type of search.
147 if $type is "simple", search is performed on the first letter of the
150 $category_type is used to get a specified type of user.
151 (mainly adults when creating a child.)
153 C<$searchstring> is a space-separated list of search terms. Each term
154 must match the beginning a borrower's surname, first name, or other
157 C<$filter> is assumed to be a list of elements to filter results on
159 C<$showallbranches> is used in IndependantBranches Context to display all branches results.
161 C<&SearchMember> returns a two-element list. C<$borrowers> is a
162 reference-to-array; each element is a reference-to-hash, whose keys
163 are the fields of the C<borrowers> table in the Koha database.
164 C<$count> is the number of elements in C<$borrowers>.
169 #used by member enquiries from the intranet
171 my ($searchstring, $orderby, $type,$category_type,$filter,$showallbranches ) = @_;
172 my $dbh = C4::Context->dbh;
178 # this is used by circulation everytime a new borrowers cardnumber is scanned
179 # so we can check an exact match first, if that works return, otherwise do the rest
180 $query = "SELECT * FROM borrowers
181 LEFT JOIN categories ON borrowers.categorycode=categories.categorycode
183 my $sth = $dbh->prepare("$query WHERE cardnumber = ?");
184 $sth->execute($searchstring);
185 my $data = $sth->fetchall_arrayref({});
187 return ( scalar(@$data), $data );
190 if ( $type eq "simple" ) # simple search for one letter only
192 $query .= ($category_type ? " AND category_type = ".$dbh->quote($category_type) : "");
193 $query .= " WHERE (surname LIKE ? OR cardnumber like ?) ";
194 if (C4::Context->preference("IndependantBranches") && !$showallbranches){
195 if (C4::Context->userenv && C4::Context->userenv->{flags} % 2 !=1 && C4::Context->userenv->{'branch'}){
196 $query.=" AND borrowers.branchcode =".$dbh->quote(C4::Context->userenv->{'branch'}) unless (C4::Context->userenv->{'branch'} eq "insecure");
199 $query.=" ORDER BY $orderby";
200 @bind = ("$searchstring%","$searchstring");
202 else # advanced search looking in surname, firstname and othernames
204 @data = split( ' ', $searchstring );
207 if (C4::Context->preference("IndependantBranches") && !$showallbranches){
208 if (C4::Context->userenv && C4::Context->userenv->{flags} % 2 !=1 && C4::Context->userenv->{'branch'}){
209 $query.=" borrowers.branchcode =".$dbh->quote(C4::Context->userenv->{'branch'})." AND " unless (C4::Context->userenv->{'branch'} eq "insecure");
212 $query.="((surname LIKE ? OR surname LIKE ?
213 OR firstname LIKE ? OR firstname LIKE ?
214 OR othernames LIKE ? OR othernames LIKE ?)
216 ($category_type?" AND category_type = ".$dbh->quote($category_type):"");
218 "$data[0]%", "% $data[0]%", "$data[0]%", "% $data[0]%",
219 "$data[0]%", "% $data[0]%"
221 for ( my $i = 1 ; $i < $count ; $i++ ) {
222 $query = $query . " AND (" . " surname LIKE ? OR surname LIKE ?
223 OR firstname LIKE ? OR firstname LIKE ?
224 OR othernames LIKE ? OR othernames LIKE ?)";
226 "$data[$i]%", "% $data[$i]%", "$data[$i]%",
227 "% $data[$i]%", "$data[$i]%", "% $data[$i]%" );
231 $query = $query . ") OR cardnumber LIKE ? ";
232 push( @bind, $searchstring );
233 $query .= "order by $orderby";
238 $sth = $dbh->prepare($query);
240 $debug and print STDERR "Q $orderby : $query\n";
241 $sth->execute(@bind);
243 $data = $sth->fetchall_arrayref({});
245 return ( scalar(@$data), $data );
252 $borrowers_result_array_ref = &Search($filter,$orderby, $limit, $columns_out, $search_on_fields,$searchtype);
256 Looks up patrons (borrowers) on filter.
258 BUGFIX 499: C<$type> is now used to determine type of search.
259 if $type is "simple", search is performed on the first letter of the
262 $category_type is used to get a specified type of user.
263 (mainly adults when creating a child.)
266 - a space-separated list of search terms. Implicit AND is done on them
267 - a hash ref containing fieldnames associated with queried value
268 - an array ref combining the two previous elements Implicit OR is done between each array element
271 C<$orderby> is an arrayref of hashref. Contains the name of the field and 0 or 1 depending if order is ascending or descending
273 C<$limit> is there to allow limiting number of results returned
275 C<&columns_out> is an array ref to the fieldnames you want to see in the result list
277 C<&search_on_fields> is an array ref to the fieldnames you want to limit search on when you are using string search
279 C<&searchtype> is a string telling the type of search you want todo : start_with, exact or contains are allowed
284 my ($filter,$orderby, $limit, $columns_out, $search_on_fields,$searchtype) = @_;
286 if (ref($filter) eq "ARRAY"){
287 push @filters,@$filter;
290 push @filters,$filter;
292 if (C4::Context->preference('ExtendedPatronAttributes')) {
293 my $matching_records = C4::Members::Attributes::SearchIdMatchingAttribute($filter);
294 push @filters,@$matching_records;
296 $searchtype||="start_with";
297 my $data=SearchInTable("borrowers",\@filters,$orderby,$limit,$columns_out,$search_on_fields,$searchtype);
302 =head2 GetMemberDetails
304 ($borrower) = &GetMemberDetails($borrowernumber, $cardnumber);
306 Looks up a patron and returns information about him or her. If
307 C<$borrowernumber> is true (nonzero), C<&GetMemberDetails> looks
308 up the borrower by number; otherwise, it looks up the borrower by card
311 C<$borrower> is a reference-to-hash whose keys are the fields of the
312 borrowers table in the Koha database. In addition,
313 C<$borrower-E<gt>{flags}> is a hash giving more detailed information
314 about the patron. Its keys act as flags :
316 if $borrower->{flags}->{LOST} {
317 # Patron's card was reported lost
320 If the state of a flag means that the patron should not be
321 allowed to borrow any more books, then it will have a C<noissues> key
324 See patronflags for more details.
326 C<$borrower-E<gt>{authflags}> is a hash giving more detailed information
327 about the top-level permissions flags set for the borrower. For example,
328 if a user has the "editcatalogue" permission,
329 C<$borrower-E<gt>{authflags}-E<gt>{editcatalogue}> will exist and have
334 sub GetMemberDetails {
335 my ( $borrowernumber, $cardnumber ) = @_;
336 my $dbh = C4::Context->dbh;
339 if ($borrowernumber) {
340 $sth = $dbh->prepare("select borrowers.*,category_type,categories.description from borrowers left join categories on borrowers.categorycode=categories.categorycode where borrowernumber=?");
341 $sth->execute($borrowernumber);
343 elsif ($cardnumber) {
344 $sth = $dbh->prepare("select borrowers.*,category_type,categories.description from borrowers left join categories on borrowers.categorycode=categories.categorycode where cardnumber=?");
345 $sth->execute($cardnumber);
350 my $borrower = $sth->fetchrow_hashref;
351 my ($amount) = GetMemberAccountRecords( $borrowernumber);
352 $borrower->{'amountoutstanding'} = $amount;
353 # FIXME - patronflags calls GetMemberAccountRecords... just have patronflags return $amount
354 my $flags = patronflags( $borrower);
357 $sth = $dbh->prepare("select bit,flag from userflags");
359 while ( my ( $bit, $flag ) = $sth->fetchrow ) {
360 if ( $borrower->{'flags'} && $borrower->{'flags'} & 2**$bit ) {
361 $accessflagshash->{$flag} = 1;
364 $borrower->{'flags'} = $flags;
365 $borrower->{'authflags'} = $accessflagshash;
367 # find out how long the membership lasts
370 "select enrolmentperiod from categories where categorycode = ?");
371 $sth->execute( $borrower->{'categorycode'} );
372 my $enrolment = $sth->fetchrow;
373 $borrower->{'enrolmentperiod'} = $enrolment;
374 return ($borrower); #, $flags, $accessflagshash);
379 $flags = &patronflags($patron);
381 This function is not exported.
383 The following will be set where applicable:
384 $flags->{CHARGES}->{amount} Amount of debt
385 $flags->{CHARGES}->{noissues} Set if debt amount >$5.00 (or syspref noissuescharge)
386 $flags->{CHARGES}->{message} Message -- deprecated
388 $flags->{CREDITS}->{amount} Amount of credit
389 $flags->{CREDITS}->{message} Message -- deprecated
391 $flags->{ GNA } Patron has no valid address
392 $flags->{ GNA }->{noissues} Set for each GNA
393 $flags->{ GNA }->{message} "Borrower has no valid address" -- deprecated
395 $flags->{ LOST } Patron's card reported lost
396 $flags->{ LOST }->{noissues} Set for each LOST
397 $flags->{ LOST }->{message} Message -- deprecated
399 $flags->{DBARRED} Set if patron debarred, no access
400 $flags->{DBARRED}->{noissues} Set for each DBARRED
401 $flags->{DBARRED}->{message} Message -- deprecated
404 $flags->{ NOTES }->{message} The note itself. NOT deprecated
406 $flags->{ ODUES } Set if patron has overdue books.
407 $flags->{ ODUES }->{message} "Yes" -- deprecated
408 $flags->{ ODUES }->{itemlist} ref-to-array: list of overdue books
409 $flags->{ ODUES }->{itemlisttext} Text list of overdue items -- deprecated
411 $flags->{WAITING} Set if any of patron's reserves are available
412 $flags->{WAITING}->{message} Message -- deprecated
413 $flags->{WAITING}->{itemlist} ref-to-array: list of available items
417 C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
418 overdue items. Its elements are references-to-hash, each describing an
419 overdue item. The keys are selected fields from the issues, biblio,
420 biblioitems, and items tables of the Koha database.
422 C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
423 the overdue items, one per line. Deprecated.
425 C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
426 available items. Each element is a reference-to-hash whose keys are
427 fields from the reserves table of the Koha database.
431 All the "message" fields that include language generated in this function are deprecated,
432 because such strings belong properly in the display layer.
434 The "message" field that comes from the DB is OK.
438 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
439 # FIXME rename this function.
442 my ( $patroninformation) = @_;
443 my $dbh=C4::Context->dbh;
444 my ($amount) = GetMemberAccountRecords( $patroninformation->{'borrowernumber'});
447 my $noissuescharge = C4::Context->preference("noissuescharge") || 5;
448 $flaginfo{'message'} = sprintf "Patron owes \$%.02f", $amount;
449 $flaginfo{'amount'} = sprintf "%.02f", $amount;
450 if ( $amount > $noissuescharge ) {
451 $flaginfo{'noissues'} = 1;
453 $flags{'CHARGES'} = \%flaginfo;
455 elsif ( $amount < 0 ) {
457 $flaginfo{'message'} = sprintf "Patron has credit of \$%.02f", -$amount;
458 $flaginfo{'amount'} = sprintf "%.02f", $amount;
459 $flags{'CREDITS'} = \%flaginfo;
461 if ( $patroninformation->{'gonenoaddress'}
462 && $patroninformation->{'gonenoaddress'} == 1 )
465 $flaginfo{'message'} = 'Borrower has no valid address.';
466 $flaginfo{'noissues'} = 1;
467 $flags{'GNA'} = \%flaginfo;
469 if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
471 $flaginfo{'message'} = 'Borrower\'s card reported lost.';
472 $flaginfo{'noissues'} = 1;
473 $flags{'LOST'} = \%flaginfo;
475 if ( $patroninformation->{'debarred'}
476 && $patroninformation->{'debarred'} == 1 )
479 $flaginfo{'message'} = 'Borrower is Debarred.';
480 $flaginfo{'noissues'} = 1;
481 $flags{'DBARRED'} = \%flaginfo;
483 if ( $patroninformation->{'borrowernotes'}
484 && $patroninformation->{'borrowernotes'} )
487 $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
488 $flags{'NOTES'} = \%flaginfo;
490 my ( $odues, $itemsoverdue ) = checkoverdues($patroninformation->{'borrowernumber'});
493 $flaginfo{'message'} = "Yes";
494 $flaginfo{'itemlist'} = $itemsoverdue;
495 foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
498 $flaginfo{'itemlisttext'} .=
499 "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n"; # newline is display layer
501 $flags{'ODUES'} = \%flaginfo;
503 my @itemswaiting = C4::Reserves::GetReservesFromBorrowernumber( $patroninformation->{'borrowernumber'},'W' );
504 my $nowaiting = scalar @itemswaiting;
505 if ( $nowaiting > 0 ) {
507 $flaginfo{'message'} = "Reserved items available";
508 $flaginfo{'itemlist'} = \@itemswaiting;
509 $flags{'WAITING'} = \%flaginfo;
517 $borrower = &GetMember(%information);
519 Retrieve the first patron record meeting on criteria listed in the
520 C<%information> hash, which should contain one or more
521 pairs of borrowers column names and values, e.g.,
523 $borrower = GetMember(borrowernumber => id);
525 C<&GetBorrower> returns a reference-to-hash whose keys are the fields of
526 the C<borrowers> table in the Koha database.
528 FIXME: GetMember() is used throughout the code as a lookup
529 on a unique key such as the borrowernumber, but this meaning is not
530 enforced in the routine itself.
536 my ( %information ) = @_;
537 if (exists $information{borrowernumber} && !defined $information{borrowernumber}) {
538 #passing mysql's kohaadmin?? Makes no sense as a query
541 my $dbh = C4::Context->dbh;
543 q{SELECT borrowers.*, categories.category_type, categories.description
545 LEFT JOIN categories on borrowers.categorycode=categories.categorycode WHERE };
548 for (keys %information ) {
556 if (defined $information{$_}) {
558 push @values, $information{$_};
561 $select .= "$_ IS NULL";
564 $debug && warn $select, " ",values %information;
565 my $sth = $dbh->prepare("$select");
566 $sth->execute(map{$information{$_}} keys %information);
567 my $data = $sth->fetchall_arrayref({});
568 #FIXME interface to this routine now allows generation of a result set
569 #so whole array should be returned but bowhere in the current code expects this
578 =head2 IsMemberBlocked
582 my $blocked = IsMemberBlocked( $borrowernumber );
584 return the status, and the number of day or documents, depends his punishment
587 -1 if the user have overdue returns
588 1 if the user is punished X days
589 0 if the user is authorised to loan
595 sub IsMemberBlocked {
596 my $borrowernumber = shift;
597 my $dbh = C4::Context->dbh;
598 # if he have late issues
599 my $sth = $dbh->prepare(
600 "SELECT COUNT(*) as latedocs
602 WHERE borrowernumber = ?
603 AND date_due < now()"
605 $sth->execute($borrowernumber);
606 my $latedocs = $sth->fetchrow_hashref->{'latedocs'};
608 return (-1, $latedocs) if $latedocs > 0;
612 ADDDATE(returndate, finedays * DATEDIFF(returndate,date_due) ) AS blockingdate,
613 DATEDIFF(ADDDATE(returndate, finedays * DATEDIFF(returndate,date_due)),NOW()) AS blockedcount
616 # or if he must wait to loan
617 if(C4::Context->preference("item-level_itypes")){
619 qq{ LEFT JOIN items ON (items.itemnumber=old_issues.itemnumber)
620 LEFT JOIN issuingrules ON (issuingrules.itemtype=items.itype)}
623 qq{ LEFT JOIN items ON (items.itemnumber=old_issues.itemnumber)
624 LEFT JOIN biblioitems ON (biblioitems.biblioitemnumber=items.biblioitemnumber)
625 LEFT JOIN issuingrules ON (issuingrules.itemtype=biblioitems.itemtype) };
628 qq{ WHERE finedays IS NOT NULL
629 AND date_due < returndate
630 AND borrowernumber = ?
631 ORDER BY blockingdate DESC, blockedcount DESC
633 $sth=$dbh->prepare($strsth);
634 $sth->execute($borrowernumber);
635 my $row = $sth->fetchrow_hashref;
636 my $blockeddate = $row->{'blockeddate'};
637 my $blockedcount = $row->{'blockedcount'};
639 return (1, $blockedcount) if $blockedcount > 0;
644 =head2 GetMemberIssuesAndFines
646 ($overdue_count, $issue_count, $total_fines) = &GetMemberIssuesAndFines($borrowernumber);
648 Returns aggregate data about items borrowed by the patron with the
649 given borrowernumber.
651 C<&GetMemberIssuesAndFines> returns a three-element array. C<$overdue_count> is the
652 number of overdue items the patron currently has borrowed. C<$issue_count> is the
653 number of books the patron currently has borrowed. C<$total_fines> is
654 the total fine currently due by the borrower.
659 sub GetMemberIssuesAndFines {
660 my ( $borrowernumber ) = @_;
661 my $dbh = C4::Context->dbh;
662 my $query = "SELECT COUNT(*) FROM issues WHERE borrowernumber = ?";
664 $debug and warn $query."\n";
665 my $sth = $dbh->prepare($query);
666 $sth->execute($borrowernumber);
667 my $issue_count = $sth->fetchrow_arrayref->[0];
669 $sth = $dbh->prepare(
670 "SELECT COUNT(*) FROM issues
671 WHERE borrowernumber = ?
672 AND date_due < now()"
674 $sth->execute($borrowernumber);
675 my $overdue_count = $sth->fetchrow_arrayref->[0];
677 $sth = $dbh->prepare("SELECT SUM(amountoutstanding) FROM accountlines WHERE borrowernumber = ?");
678 $sth->execute($borrowernumber);
679 my $total_fines = $sth->fetchrow_arrayref->[0];
681 return ($overdue_count, $issue_count, $total_fines);
685 return @{C4::Context->dbh->selectcol_arrayref("SHOW columns from borrowers")};
694 my $success = ModMember(borrowernumber => $borrowernumber, [ field => value ]... );
696 Modify borrower's data. All date fields should ALREADY be in ISO format.
699 true on success, or false on failure
706 # test to know if you must update or not the borrower password
707 if (exists $data{password}) {
708 if ($data{password} eq '****' or $data{password} eq '') {
709 delete $data{password};
711 $data{password} = md5_base64($data{password});
714 my $execute_success=UpdateInTable("borrowers",\%data);
715 # ok if its an adult (type) it may have borrowers that depend on it as a guarantor
716 # so when we update information for an adult we should check for guarantees and update the relevant part
717 # of their records, ie addresses and phone numbers
718 my $borrowercategory= GetBorrowercategory( $data{'category_type'} );
719 if ( exists $borrowercategory->{'category_type'} && $borrowercategory->{'category_type'} eq ('A' || 'S') ) {
720 # is adult check guarantees;
721 UpdateGuarantees(%data);
723 logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "UPDATE (executed w/ arg: $data{'borrowernumber'})")
724 if C4::Context->preference("BorrowersLog");
726 return $execute_success;
734 $borrowernumber = &AddMember(%borrower);
736 insert new borrower into table
737 Returns the borrowernumber
744 my $dbh = C4::Context->dbh;
745 $data{'password'} = '!' if (not $data{'password'} and $data{'userid'});
746 $data{'password'} = md5_base64( $data{'password'} ) if $data{'password'};
747 $data{'borrowernumber'}=InsertInTable("borrowers",\%data);
748 # mysql_insertid is probably bad. not necessarily accurate and mysql-specific at best.
749 logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
751 # check for enrollment fee & add it if needed
752 my $sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
753 $sth->execute($data{'categorycode'});
754 my ($enrolmentfee) = $sth->fetchrow;
755 if ($enrolmentfee && $enrolmentfee > 0) {
756 # insert fee in patron debts
757 manualinvoice($data{'borrowernumber'}, '', '', 'A', $enrolmentfee);
759 return $data{'borrowernumber'};
764 my ($uid,$member) = @_;
765 my $dbh = C4::Context->dbh;
766 # Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
767 # Then we need to tell the user and have them create a new one.
770 "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
771 $sth->execute( $uid, $member );
772 if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
780 sub Generate_Userid {
781 my ($borrowernumber, $firstname, $surname) = @_;
785 $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
786 $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
787 $newuid = lc("$firstname.$surname");
788 $newuid .= $offset unless $offset == 0;
791 } while (!Check_Userid($newuid,$borrowernumber));
797 my ( $uid, $member, $digest ) = @_;
798 my $dbh = C4::Context->dbh;
800 #Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
801 #Then we need to tell the user and have them create a new one.
805 "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
806 $sth->execute( $uid, $member );
807 if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
811 #Everything is good so we can update the information.
814 "update borrowers set userid=?, password=? where borrowernumber=?");
815 $sth->execute( $uid, $digest, $member );
819 logaction("MEMBERS", "CHANGE PASS", $member, "") if C4::Context->preference("BorrowersLog");
825 =head2 fixup_cardnumber
827 Warning: The caller is responsible for locking the members table in write
828 mode, to avoid database corruption.
832 use vars qw( @weightings );
833 my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
835 sub fixup_cardnumber ($) {
836 my ($cardnumber) = @_;
837 my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;
839 # Find out whether member numbers should be generated
840 # automatically. Should be either "1" or something else.
841 # Defaults to "0", which is interpreted as "no".
843 # if ($cardnumber !~ /\S/ && $autonumber_members) {
844 ($autonumber_members) or return $cardnumber;
845 my $checkdigit = C4::Context->preference('checkdigit');
846 my $dbh = C4::Context->dbh;
847 if ( $checkdigit and $checkdigit eq 'katipo' ) {
849 # if checkdigit is selected, calculate katipo-style cardnumber.
850 # otherwise, just use the max()
851 # purpose: generate checksum'd member numbers.
852 # We'll assume we just got the max value of digits 2-8 of member #'s
853 # from the database and our job is to increment that by one,
854 # determine the 1st and 9th digits and return the full string.
855 my $sth = $dbh->prepare(
856 "select max(substring(borrowers.cardnumber,2,7)) as new_num from borrowers"
859 my $data = $sth->fetchrow_hashref;
860 $cardnumber = $data->{new_num};
861 if ( !$cardnumber ) { # If DB has no values,
862 $cardnumber = 1000000; # start at 1000000
868 for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
869 # read weightings, left to right, 1 char at a time
870 my $temp1 = $weightings[$i];
872 # sequence left to right, 1 char at a time
873 my $temp2 = substr( $cardnumber, $i, 1 );
875 # mult each char 1-7 by its corresponding weighting
876 $sum += $temp1 * $temp2;
879 my $rem = ( $sum % 11 );
880 $rem = 'X' if $rem == 10;
882 return "V$cardnumber$rem";
885 # MODIFIED BY JF: mysql4.1 allows casting as an integer, which is probably
886 # better. I'll leave the original in in case it needs to be changed for you
887 # my $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers");
888 my $sth = $dbh->prepare(
889 "select max(cast(cardnumber as signed)) from borrowers"
892 my ($result) = $sth->fetchrow;
895 return $cardnumber; # just here as a fallback/reminder
900 ($num_children, $children_arrayref) = &GetGuarantees($parent_borrno);
901 $child0_cardno = $children_arrayref->[0]{"cardnumber"};
902 $child0_borrno = $children_arrayref->[0]{"borrowernumber"};
904 C<&GetGuarantees> takes a borrower number (e.g., that of a patron
905 with children) and looks up the borrowers who are guaranteed by that
906 borrower (i.e., the patron's children).
908 C<&GetGuarantees> returns two values: an integer giving the number of
909 borrowers guaranteed by C<$parent_borrno>, and a reference to an array
910 of references to hash, which gives the actual results.
916 my ($borrowernumber) = @_;
917 my $dbh = C4::Context->dbh;
920 "select cardnumber,borrowernumber, firstname, surname from borrowers where guarantorid=?"
922 $sth->execute($borrowernumber);
925 my $data = $sth->fetchall_arrayref({});
926 return ( scalar(@$data), $data );
929 =head2 UpdateGuarantees
931 &UpdateGuarantees($parent_borrno);
934 C<&UpdateGuarantees> borrower data for an adult and updates all the guarantees
935 with the modified information
940 sub UpdateGuarantees {
942 my $dbh = C4::Context->dbh;
943 my ( $count, $guarantees ) = GetGuarantees( $data{'borrowernumber'} );
944 for ( my $i = 0 ; $i < $count ; $i++ ) {
947 # It looks like the $i is only being returned to handle walking through
948 # the array, which is probably better done as a foreach loop.
950 my $guaquery = qq|UPDATE borrowers
951 SET address='$data{'address'}',fax='$data{'fax'}',
952 B_city='$data{'B_city'}',mobile='$data{'mobile'}',city='$data{'city'}',phone='$data{'phone'}'
953 WHERE borrowernumber='$guarantees->[$i]->{'borrowernumber'}'
955 my $sth3 = $dbh->prepare($guaquery);
959 =head2 GetPendingIssues
961 my $issues = &GetPendingIssues($borrowernumber);
963 Looks up what the patron with the given borrowernumber has borrowed.
965 C<&GetPendingIssues> returns a
966 reference-to-array where each element is a reference-to-hash; the
967 keys are the fields from the C<issues>, C<biblio>, and C<items> tables.
968 The keys include C<biblioitems> fields except marc and marcxml.
973 sub GetPendingIssues {
974 my ($borrowernumber) = @_;
975 # must avoid biblioitems.* to prevent large marc and marcxml fields from killing performance
976 # FIXME: namespace collision: each table has "timestamp" fields. Which one is "timestamp" ?
977 # FIXME: circ/ciculation.pl tries to sort by timestamp!
978 # FIXME: C4::Print::printslip tries to sort by timestamp!
979 # FIXME: namespace collision: other collisions possible.
980 # FIXME: most of this data isn't really being used by callers.
981 my $sth = C4::Context->dbh->prepare(
987 biblioitems.itemtype,
990 biblioitems.publicationyear,
991 biblioitems.publishercode,
992 biblioitems.volumedate,
993 biblioitems.volumedesc,
996 issues.timestamp AS timestamp,
997 issues.renewals AS renewals,
998 items.renewals AS totalrenewals
1000 LEFT JOIN items ON items.itemnumber = issues.itemnumber
1001 LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
1002 LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
1005 ORDER BY issues.issuedate"
1007 $sth->execute($borrowernumber);
1008 my $data = $sth->fetchall_arrayref({});
1009 my $today = C4::Dates->new->output('iso');
1011 $_->{date_due} or next;
1012 ($_->{date_due} lt $today) and $_->{overdue} = 1;
1019 $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
1021 Looks up what the patron with the given borrowernumber has borrowed,
1022 and sorts the results.
1024 C<$sortkey> is the name of a field on which to sort the results. This
1025 should be the name of a field in the C<issues>, C<biblio>,
1026 C<biblioitems>, or C<items> table in the Koha database.
1028 C<$limit> is the maximum number of results to return.
1030 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
1031 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
1032 C<items> tables of the Koha database.
1038 my ( $borrowernumber, $order, $limit ) = @_;
1040 #FIXME: sanity-check order and limit
1041 my $dbh = C4::Context->dbh;
1043 "SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1045 LEFT JOIN items on items.itemnumber=issues.itemnumber
1046 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1047 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1048 WHERE borrowernumber=?
1050 SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1052 LEFT JOIN items on items.itemnumber=old_issues.itemnumber
1053 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1054 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1055 WHERE borrowernumber=?
1057 if ( $limit != 0 ) {
1058 $query .= " limit $limit";
1061 my $sth = $dbh->prepare($query);
1062 $sth->execute($borrowernumber, $borrowernumber);
1065 while ( my $data = $sth->fetchrow_hashref ) {
1066 push @result, $data;
1073 =head2 GetMemberAccountRecords
1075 ($total, $acctlines, $count) = &GetMemberAccountRecords($borrowernumber);
1077 Looks up accounting data for the patron with the given borrowernumber.
1079 C<&GetMemberAccountRecords> returns a three-element array. C<$acctlines> is a
1080 reference-to-array, where each element is a reference-to-hash; the
1081 keys are the fields of the C<accountlines> table in the Koha database.
1082 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1083 total amount outstanding for all of the account lines.
1088 sub GetMemberAccountRecords {
1089 my ($borrowernumber,$date) = @_;
1090 my $dbh = C4::Context->dbh;
1096 WHERE borrowernumber=?);
1097 my @bind = ($borrowernumber);
1098 if ($date && $date ne ''){
1099 $strsth.=" AND date < ? ";
1102 $strsth.=" ORDER BY date desc,timestamp DESC";
1103 my $sth= $dbh->prepare( $strsth );
1104 $sth->execute( @bind );
1106 while ( my $data = $sth->fetchrow_hashref ) {
1107 my $biblio = GetBiblioFromItemNumber($data->{itemnumber}) if $data->{itemnumber};
1108 $data->{biblionumber} = $biblio->{biblionumber};
1109 $data->{title} = $biblio->{title};
1110 $acctlines[$numlines] = $data;
1112 $total += int(1000 * $data->{'amountoutstanding'}); # convert float to integer to avoid round-off errors
1115 return ( $total, \@acctlines,$numlines);
1118 =head2 GetBorNotifyAcctRecord
1120 ($count, $acctlines, $total) = &GetBorNotifyAcctRecord($params,$notifyid);
1122 Looks up accounting data for the patron with the given borrowernumber per file number.
1124 (FIXME - I'm not at all sure what this is about.)
1126 C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a
1127 reference-to-array, where each element is a reference-to-hash; the
1128 keys are the fields of the C<accountlines> table in the Koha database.
1129 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1130 total amount outstanding for all of the account lines.
1134 sub GetBorNotifyAcctRecord {
1135 my ( $borrowernumber, $notifyid ) = @_;
1136 my $dbh = C4::Context->dbh;
1139 my $sth = $dbh->prepare(
1142 WHERE borrowernumber=?
1144 AND amountoutstanding != '0'
1145 ORDER BY notify_id,accounttype
1147 # 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')
1149 $sth->execute( $borrowernumber, $notifyid );
1151 while ( my $data = $sth->fetchrow_hashref ) {
1152 $acctlines[$numlines] = $data;
1154 $total += int(100 * $data->{'amountoutstanding'});
1157 return ( $total, \@acctlines, $numlines );
1160 =head2 checkuniquemember (OUEST-PROVENCE)
1162 ($result,$categorycode) = &checkuniquemember($collectivity,$surname,$firstname,$dateofbirth);
1164 Checks that a member exists or not in the database.
1166 C<&result> is nonzero (=exist) or 0 (=does not exist)
1167 C<&categorycode> is from categorycode table
1168 C<&collectivity> is 1 (= we add a collectivity) or 0 (= we add a physical member)
1169 C<&surname> is the surname
1170 C<&firstname> is the firstname (only if collectivity=0)
1171 C<&dateofbirth> is the date of birth in ISO format (only if collectivity=0)
1175 # FIXME: This function is not legitimate. Multiple patrons might have the same first/last name and birthdate.
1176 # This is especially true since first name is not even a required field.
1178 sub checkuniquemember {
1179 my ( $collectivity, $surname, $firstname, $dateofbirth ) = @_;
1180 my $dbh = C4::Context->dbh;
1181 my $request = ($collectivity) ?
1182 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? " :
1184 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=? and dateofbirth=?" :
1185 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=?";
1186 my $sth = $dbh->prepare($request);
1187 if ($collectivity) {
1188 $sth->execute( uc($surname) );
1189 } elsif($dateofbirth){
1190 $sth->execute( uc($surname), ucfirst($firstname), $dateofbirth );
1192 $sth->execute( uc($surname), ucfirst($firstname));
1194 my @data = $sth->fetchrow;
1195 ( $data[0] ) and return $data[0], $data[1];
1199 sub checkcardnumber {
1200 my ($cardnumber,$borrowernumber) = @_;
1201 my $dbh = C4::Context->dbh;
1202 my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
1203 $query .= " AND borrowernumber <> ?" if ($borrowernumber);
1204 my $sth = $dbh->prepare($query);
1205 if ($borrowernumber) {
1206 $sth->execute($cardnumber,$borrowernumber);
1208 $sth->execute($cardnumber);
1210 if (my $data= $sth->fetchrow_hashref()){
1219 =head2 getzipnamecity (OUEST-PROVENCE)
1221 take all info from table city for the fields city and zip
1222 check for the name and the zip code of the city selected
1226 sub getzipnamecity {
1228 my $dbh = C4::Context->dbh;
1231 "select city_name,city_zipcode from cities where cityid=? ");
1232 $sth->execute($cityid);
1233 my @data = $sth->fetchrow;
1234 return $data[0], $data[1];
1238 =head2 getdcity (OUEST-PROVENCE)
1240 recover cityid with city_name condition
1245 my ($city_name) = @_;
1246 my $dbh = C4::Context->dbh;
1247 my $sth = $dbh->prepare("select cityid from cities where city_name=? ");
1248 $sth->execute($city_name);
1249 my $data = $sth->fetchrow;
1254 =head2 GetExpiryDate
1256 $expirydate = GetExpiryDate($categorycode, $dateenrolled);
1258 Calculate expiry date given a categorycode and starting date. Date argument must be in ISO format.
1259 Return date is also in ISO format.
1264 my ( $categorycode, $dateenrolled ) = @_;
1266 if ($categorycode) {
1267 my $dbh = C4::Context->dbh;
1268 my $sth = $dbh->prepare("SELECT enrolmentperiod,enrolmentperioddate FROM categories WHERE categorycode=?");
1269 $sth->execute($categorycode);
1270 $enrolments = $sth->fetchrow_hashref;
1272 # die "GetExpiryDate: for enrollmentperiod $enrolmentperiod (category '$categorycode') starting $dateenrolled.\n";
1273 my @date = split (/-/,$dateenrolled);
1274 if($enrolments->{enrolmentperiod}){
1275 return sprintf("%04d-%02d-%02d", Add_Delta_YM(@date,0,$enrolments->{enrolmentperiod}));
1277 return $enrolments->{enrolmentperioddate};
1281 =head2 checkuserpassword (OUEST-PROVENCE)
1283 check for the password and login are not used
1284 return the number of record
1285 0=> NOT USED 1=> USED
1289 sub checkuserpassword {
1290 my ( $borrowernumber, $userid, $password ) = @_;
1291 $password = md5_base64($password);
1292 my $dbh = C4::Context->dbh;
1295 "Select count(*) from borrowers where borrowernumber !=? and userid =? and password=? "
1297 $sth->execute( $borrowernumber, $userid, $password );
1298 my $number_rows = $sth->fetchrow;
1299 return $number_rows;
1303 =head2 GetborCatFromCatType
1305 ($codes_arrayref, $labels_hashref) = &GetborCatFromCatType();
1307 Looks up the different types of borrowers in the database. Returns two
1308 elements: a reference-to-array, which lists the borrower category
1309 codes, and a reference-to-hash, which maps the borrower category codes
1310 to category descriptions.
1315 sub GetborCatFromCatType {
1316 my ( $category_type, $action ) = @_;
1317 # FIXME - This API seems both limited and dangerous.
1318 my $dbh = C4::Context->dbh;
1319 my $request = qq| SELECT categorycode,description
1322 ORDER BY categorycode|;
1323 my $sth = $dbh->prepare($request);
1325 $sth->execute($category_type);
1334 while ( my $data = $sth->fetchrow_hashref ) {
1335 push @codes, $data->{'categorycode'};
1336 $labels{ $data->{'categorycode'} } = $data->{'description'};
1338 return ( \@codes, \%labels );
1341 =head2 GetBorrowercategory
1343 $hashref = &GetBorrowercategory($categorycode);
1345 Given the borrower's category code, the function returns the corresponding
1346 data hashref for a comprehensive information display.
1348 $arrayref_hashref = &GetBorrowercategory;
1349 If no category code provided, the function returns all the categories.
1353 sub GetBorrowercategory {
1355 my $dbh = C4::Context->dbh;
1359 "SELECT description,dateofbirthrequired,upperagelimit,category_type
1361 WHERE categorycode = ?"
1363 $sth->execute($catcode);
1365 $sth->fetchrow_hashref;
1369 } # sub getborrowercategory
1371 =head2 GetBorrowercategoryList
1373 $arrayref_hashref = &GetBorrowercategoryList;
1374 If no category code provided, the function returns all the categories.
1378 sub GetBorrowercategoryList {
1379 my $dbh = C4::Context->dbh;
1384 ORDER BY description"
1388 $sth->fetchall_arrayref({});
1390 } # sub getborrowercategory
1392 =head2 ethnicitycategories
1394 ($codes_arrayref, $labels_hashref) = ðnicitycategories();
1396 Looks up the different ethnic types in the database. Returns two
1397 elements: a reference-to-array, which lists the ethnicity codes, and a
1398 reference-to-hash, which maps the ethnicity codes to ethnicity
1405 sub ethnicitycategories {
1406 my $dbh = C4::Context->dbh;
1407 my $sth = $dbh->prepare("Select code,name from ethnicity order by name");
1411 while ( my $data = $sth->fetchrow_hashref ) {
1412 push @codes, $data->{'code'};
1413 $labels{ $data->{'code'} } = $data->{'name'};
1415 return ( \@codes, \%labels );
1420 $ethn_name = &fixEthnicity($ethn_code);
1422 Takes an ethnicity code (e.g., "european" or "pi") and returns the
1423 corresponding descriptive name from the C<ethnicity> table in the
1424 Koha database ("European" or "Pacific Islander").
1431 my $ethnicity = shift;
1432 return unless $ethnicity;
1433 my $dbh = C4::Context->dbh;
1434 my $sth = $dbh->prepare("Select name from ethnicity where code = ?");
1435 $sth->execute($ethnicity);
1436 my $data = $sth->fetchrow_hashref;
1437 return $data->{'name'};
1438 } # sub fixEthnicity
1442 $dateofbirth,$date = &GetAge($date);
1444 this function return the borrowers age with the value of dateofbirth
1450 my ( $date, $date_ref ) = @_;
1452 if ( not defined $date_ref ) {
1453 $date_ref = sprintf( '%04d-%02d-%02d', Today() );
1456 my ( $year1, $month1, $day1 ) = split /-/, $date;
1457 my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
1459 my $age = $year2 - $year1;
1460 if ( $month1 . $day1 > $month2 . $day2 ) {
1467 =head2 get_institutions
1468 $insitutions = get_institutions();
1470 Just returns a list of all the borrowers of type I, borrownumber and name
1475 sub get_institutions {
1476 my $dbh = C4::Context->dbh();
1479 "SELECT borrowernumber,surname FROM borrowers WHERE categorycode=? ORDER BY surname"
1483 while ( my $data = $sth->fetchrow_hashref() ) {
1484 $orgs{ $data->{'borrowernumber'} } = $data;
1488 } # sub get_institutions
1490 =head2 add_member_orgs
1492 add_member_orgs($borrowernumber,$borrowernumbers);
1494 Takes a borrowernumber and a list of other borrowernumbers and inserts them into the borrowers_to_borrowers table
1499 sub add_member_orgs {
1500 my ( $borrowernumber, $otherborrowers ) = @_;
1501 my $dbh = C4::Context->dbh();
1503 "INSERT INTO borrowers_to_borrowers (borrower1,borrower2) VALUES (?,?)";
1504 my $sth = $dbh->prepare($query);
1505 foreach my $otherborrowernumber (@$otherborrowers) {
1506 $sth->execute( $borrowernumber, $otherborrowernumber );
1509 } # sub add_member_orgs
1511 =head2 GetCities (OUEST-PROVENCE)
1513 ($id_cityarrayref, $city_hashref) = &GetCities();
1515 Looks up the different city and zip in the database. Returns two
1516 elements: a reference-to-array, which lists the zip city
1517 codes, and a reference-to-hash, which maps the name of the city.
1518 WHERE =>OUEST PROVENCE OR EXTERIEUR
1524 #my ($type_city) = @_;
1525 my $dbh = C4::Context->dbh;
1526 my $query = qq|SELECT cityid,city_zipcode,city_name
1528 ORDER BY city_name|;
1529 my $sth = $dbh->prepare($query);
1531 #$sth->execute($type_city);
1535 # insert empty value to create a empty choice in cgi popup
1538 while ( my $data = $sth->fetchrow_hashref ) {
1539 push @id, $data->{'city_zipcode'}."|".$data->{'city_name'};
1540 $city{ $data->{'city_zipcode'}."|".$data->{'city_name'} } = $data->{'city_name'} . " " . $data->{'city_zipcode'};
1543 #test to know if the table contain some records if no the function return nothing
1546 # all we have is the one blank row
1551 return ( \@id, \%city );
1555 =head2 GetSortDetails (OUEST-PROVENCE)
1557 ($lib) = &GetSortDetails($category,$sortvalue);
1559 Returns the authorized value details
1560 C<&$lib>return value of authorized value details
1561 C<&$sortvalue>this is the value of authorized value
1562 C<&$category>this is the value of authorized value category
1566 sub GetSortDetails {
1567 my ( $category, $sortvalue ) = @_;
1568 my $dbh = C4::Context->dbh;
1569 my $query = qq|SELECT lib
1570 FROM authorised_values
1572 AND authorised_value=? |;
1573 my $sth = $dbh->prepare($query);
1574 $sth->execute( $category, $sortvalue );
1575 my $lib = $sth->fetchrow;
1576 return ($lib) if ($lib);
1577 return ($sortvalue) unless ($lib);
1580 =head2 MoveMemberToDeleted
1582 $result = &MoveMemberToDeleted($borrowernumber);
1584 Copy the record from borrowers to deletedborrowers table.
1588 # FIXME: should do it in one SQL statement w/ subquery
1589 # Otherwise, we should return the @data on success
1591 sub MoveMemberToDeleted {
1592 my ($member) = shift or return;
1593 my $dbh = C4::Context->dbh;
1594 my $query = qq|SELECT *
1596 WHERE borrowernumber=?|;
1597 my $sth = $dbh->prepare($query);
1598 $sth->execute($member);
1599 my @data = $sth->fetchrow_array;
1600 (@data) or return; # if we got a bad borrowernumber, there's nothing to insert
1602 $dbh->prepare( "INSERT INTO deletedborrowers VALUES ("
1603 . ( "?," x ( scalar(@data) - 1 ) )
1605 $sth->execute(@data);
1610 DelMember($borrowernumber);
1612 This function remove directly a borrower whitout writing it on deleteborrower.
1613 + Deletes reserves for the borrower
1618 my $dbh = C4::Context->dbh;
1619 my $borrowernumber = shift;
1620 #warn "in delmember with $borrowernumber";
1621 return unless $borrowernumber; # borrowernumber is mandatory.
1623 my $query = qq|DELETE
1625 WHERE borrowernumber=?|;
1626 my $sth = $dbh->prepare($query);
1627 $sth->execute($borrowernumber);
1631 WHERE borrowernumber = ?
1633 $sth = $dbh->prepare($query);
1634 $sth->execute($borrowernumber);
1635 logaction("MEMBERS", "DELETE", $borrowernumber, "") if C4::Context->preference("BorrowersLog");
1639 =head2 ExtendMemberSubscriptionTo (OUEST-PROVENCE)
1641 $date = ExtendMemberSubscriptionTo($borrowerid, $date);
1643 Extending the subscription to a given date or to the expiry date calculated on ISO date.
1648 sub ExtendMemberSubscriptionTo {
1649 my ( $borrowerid,$date) = @_;
1650 my $dbh = C4::Context->dbh;
1651 my $borrower = GetMember('borrowernumber'=>$borrowerid);
1653 $date=POSIX::strftime("%Y-%m-%d",localtime());
1654 $date = GetExpiryDate( $borrower->{'categorycode'}, $date );
1656 my $sth = $dbh->do(<<EOF);
1658 SET dateexpiry='$date'
1659 WHERE borrowernumber='$borrowerid'
1661 # add enrolmentfee if needed
1662 $sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
1663 $sth->execute($borrower->{'categorycode'});
1664 my ($enrolmentfee) = $sth->fetchrow;
1665 if ($enrolmentfee && $enrolmentfee > 0) {
1666 # insert fee in patron debts
1667 manualinvoice($borrower->{'borrowernumber'}, '', '', 'A', $enrolmentfee);
1669 return $date if ($sth);
1673 =head2 GetRoadTypes (OUEST-PROVENCE)
1675 ($idroadtypearrayref, $roadttype_hashref) = &GetRoadTypes();
1677 Looks up the different road type . Returns two
1678 elements: a reference-to-array, which lists the id_roadtype
1679 codes, and a reference-to-hash, which maps the road type of the road .
1684 my $dbh = C4::Context->dbh;
1686 SELECT roadtypeid,road_type
1688 ORDER BY road_type|;
1689 my $sth = $dbh->prepare($query);
1694 # insert empty value to create a empty choice in cgi popup
1696 while ( my $data = $sth->fetchrow_hashref ) {
1698 push @id, $data->{'roadtypeid'};
1699 $roadtype{ $data->{'roadtypeid'} } = $data->{'road_type'};
1702 #test to know if the table contain some records if no the function return nothing
1709 return ( \@id, \%roadtype );
1715 =head2 GetTitles (OUEST-PROVENCE)
1717 ($borrowertitle)= &GetTitles();
1719 Looks up the different title . Returns array with all borrowers title
1724 my @borrowerTitle = split (/,|\|/,C4::Context->preference('BorrowersTitles'));
1725 unshift( @borrowerTitle, "" );
1726 my $count=@borrowerTitle;
1731 return ( \@borrowerTitle);
1735 =head2 GetPatronImage
1737 my ($imagedata, $dberror) = GetPatronImage($cardnumber);
1739 Returns the mimetype and binary image data of the image for the patron with the supplied cardnumber.
1743 sub GetPatronImage {
1744 my ($cardnumber) = @_;
1745 warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1746 my $dbh = C4::Context->dbh;
1747 my $query = 'SELECT mimetype, imagefile FROM patronimage WHERE cardnumber = ?';
1748 my $sth = $dbh->prepare($query);
1749 $sth->execute($cardnumber);
1750 my $imagedata = $sth->fetchrow_hashref;
1751 warn "Database error!" if $sth->errstr;
1752 return $imagedata, $sth->errstr;
1755 =head2 PutPatronImage
1757 PutPatronImage($cardnumber, $mimetype, $imgfile);
1759 Stores patron binary image data and mimetype in database.
1760 NOTE: This function is good for updating images as well as inserting new images in the database.
1764 sub PutPatronImage {
1765 my ($cardnumber, $mimetype, $imgfile) = @_;
1766 warn "Parameters passed in: Cardnumber=$cardnumber, Mimetype=$mimetype, " . ($imgfile ? "Imagefile" : "No Imagefile") if $debug;
1767 my $dbh = C4::Context->dbh;
1768 my $query = "INSERT INTO patronimage (cardnumber, mimetype, imagefile) VALUES (?,?,?) ON DUPLICATE KEY UPDATE imagefile = ?;";
1769 my $sth = $dbh->prepare($query);
1770 $sth->execute($cardnumber,$mimetype,$imgfile,$imgfile);
1771 warn "Error returned inserting $cardnumber.$mimetype." if $sth->errstr;
1772 return $sth->errstr;
1775 =head2 RmPatronImage
1777 my ($dberror) = RmPatronImage($cardnumber);
1779 Removes the image for the patron with the supplied cardnumber.
1784 my ($cardnumber) = @_;
1785 warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1786 my $dbh = C4::Context->dbh;
1787 my $query = "DELETE FROM patronimage WHERE cardnumber = ?;";
1788 my $sth = $dbh->prepare($query);
1789 $sth->execute($cardnumber);
1790 my $dberror = $sth->errstr;
1791 warn "Database error!" if $sth->errstr;
1795 =head2 GetRoadTypeDetails (OUEST-PROVENCE)
1797 ($roadtype) = &GetRoadTypeDetails($roadtypeid);
1799 Returns the description of roadtype
1800 C<&$roadtype>return description of road type
1801 C<&$roadtypeid>this is the value of roadtype s
1805 sub GetRoadTypeDetails {
1806 my ($roadtypeid) = @_;
1807 my $dbh = C4::Context->dbh;
1811 WHERE roadtypeid=?|;
1812 my $sth = $dbh->prepare($query);
1813 $sth->execute($roadtypeid);
1814 my $roadtype = $sth->fetchrow;
1818 =head2 GetBorrowersWhoHaveNotBorrowedSince
1820 &GetBorrowersWhoHaveNotBorrowedSince($date)
1822 this function get all borrowers who haven't borrowed since the date given on input arg.
1826 sub GetBorrowersWhoHaveNotBorrowedSince {
1827 my $filterdate = shift||POSIX::strftime("%Y-%m-%d",localtime());
1828 my $filterexpiry = shift;
1829 my $filterbranch = shift ||
1830 ((C4::Context->preference('IndependantBranches')
1831 && C4::Context->userenv
1832 && C4::Context->userenv->{flags} % 2 !=1
1833 && C4::Context->userenv->{branch})
1834 ? C4::Context->userenv->{branch}
1836 my $dbh = C4::Context->dbh;
1838 SELECT borrowers.borrowernumber,
1839 max(old_issues.timestamp) as latestissue,
1840 max(issues.timestamp) as currentissue
1842 JOIN categories USING (categorycode)
1843 LEFT JOIN old_issues USING (borrowernumber)
1844 LEFT JOIN issues USING (borrowernumber)
1845 WHERE category_type <> 'S'
1846 AND borrowernumber NOT IN (SELECT guarantorid FROM borrowers WHERE guarantorid IS NOT NULL AND guarantorid <> 0)
1849 if ($filterbranch && $filterbranch ne ""){
1850 $query.=" AND borrowers.branchcode= ?";
1851 push @query_params,$filterbranch;
1854 $query .= " AND dateexpiry < ? ";
1855 push @query_params,$filterdate;
1857 $query.=" GROUP BY borrowers.borrowernumber";
1859 $query.=" HAVING (latestissue < ? OR latestissue IS NULL)
1860 AND currentissue IS NULL";
1861 push @query_params,$filterdate;
1863 warn $query if $debug;
1864 my $sth = $dbh->prepare($query);
1865 if (scalar(@query_params)>0){
1866 $sth->execute(@query_params);
1873 while ( my $data = $sth->fetchrow_hashref ) {
1874 push @results, $data;
1879 =head2 GetBorrowersWhoHaveNeverBorrowed
1881 $results = &GetBorrowersWhoHaveNeverBorrowed
1883 this function get all borrowers who have never borrowed.
1885 I<$result> is a ref to an array which all elements are a hasref.
1889 sub GetBorrowersWhoHaveNeverBorrowed {
1890 my $filterbranch = shift ||
1891 ((C4::Context->preference('IndependantBranches')
1892 && C4::Context->userenv
1893 && C4::Context->userenv->{flags} % 2 !=1
1894 && C4::Context->userenv->{branch})
1895 ? C4::Context->userenv->{branch}
1897 my $dbh = C4::Context->dbh;
1899 SELECT borrowers.borrowernumber,max(timestamp) as latestissue
1901 LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
1902 WHERE issues.borrowernumber IS NULL
1905 if ($filterbranch && $filterbranch ne ""){
1906 $query.=" AND borrowers.branchcode= ?";
1907 push @query_params,$filterbranch;
1909 warn $query if $debug;
1911 my $sth = $dbh->prepare($query);
1912 if (scalar(@query_params)>0){
1913 $sth->execute(@query_params);
1920 while ( my $data = $sth->fetchrow_hashref ) {
1921 push @results, $data;
1926 =head2 GetBorrowersWithIssuesHistoryOlderThan
1928 $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
1930 this function get all borrowers who has an issue history older than I<$date> given on input arg.
1932 I<$result> is a ref to an array which all elements are a hashref.
1933 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
1937 sub GetBorrowersWithIssuesHistoryOlderThan {
1938 my $dbh = C4::Context->dbh;
1939 my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
1940 my $filterbranch = shift ||
1941 ((C4::Context->preference('IndependantBranches')
1942 && C4::Context->userenv
1943 && C4::Context->userenv->{flags} % 2 !=1
1944 && C4::Context->userenv->{branch})
1945 ? C4::Context->userenv->{branch}
1948 SELECT count(borrowernumber) as n,borrowernumber
1950 WHERE returndate < ?
1951 AND borrowernumber IS NOT NULL
1954 push @query_params, $date;
1956 $query.=" AND branchcode = ?";
1957 push @query_params, $filterbranch;
1959 $query.=" GROUP BY borrowernumber ";
1960 warn $query if $debug;
1961 my $sth = $dbh->prepare($query);
1962 $sth->execute(@query_params);
1965 while ( my $data = $sth->fetchrow_hashref ) {
1966 push @results, $data;
1971 =head2 GetBorrowersNamesAndLatestIssue
1973 $results = &GetBorrowersNamesAndLatestIssueList(@borrowernumbers)
1975 this function get borrowers Names and surnames and Issue information.
1977 I<@borrowernumbers> is an array which all elements are borrowernumbers.
1978 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
1982 sub GetBorrowersNamesAndLatestIssue {
1983 my $dbh = C4::Context->dbh;
1984 my @borrowernumbers=@_;
1986 SELECT surname,lastname, phone, email,max(timestamp)
1988 LEFT JOIN issues ON borrowers.borrowernumber=issues.borrowernumber
1989 GROUP BY borrowernumber
1991 my $sth = $dbh->prepare($query);
1993 my $results = $sth->fetchall_arrayref({});
2001 my $success = DebarMember( $borrowernumber );
2003 marks a Member as debarred, and therefore unable to checkout any more
2007 true on success, false on failure
2014 my $borrowernumber = shift;
2016 return unless defined $borrowernumber;
2017 return unless $borrowernumber =~ /^\d+$/;
2019 return ModMember( borrowernumber => $borrowernumber,
2028 AddMessage( $borrowernumber, $message_type, $message, $branchcode );
2030 Adds a message to the messages table for the given borrower.
2041 my ( $borrowernumber, $message_type, $message, $branchcode ) = @_;
2043 my $dbh = C4::Context->dbh;
2045 if ( ! ( $borrowernumber && $message_type && $message && $branchcode ) ) {
2049 my $query = "INSERT INTO messages ( borrowernumber, branchcode, message_type, message ) VALUES ( ?, ?, ?, ? )";
2050 my $sth = $dbh->prepare($query);
2051 $sth->execute( $borrowernumber, $branchcode, $message_type, $message );
2060 GetMessages( $borrowernumber, $type );
2062 $type is message type, B for borrower, or L for Librarian.
2063 Empty type returns all messages of any type.
2065 Returns all messages for the given borrowernumber
2072 my ( $borrowernumber, $type, $branchcode ) = @_;
2078 my $dbh = C4::Context->dbh;
2081 branches.branchname,
2083 DATE_FORMAT( message_date, '%m/%d/%Y' ) AS message_date_formatted,
2084 messages.branchcode LIKE '$branchcode' AS can_delete
2085 FROM messages, branches
2086 WHERE borrowernumber = ?
2087 AND message_type LIKE ?
2088 AND messages.branchcode = branches.branchcode
2089 ORDER BY message_date DESC";
2090 my $sth = $dbh->prepare($query);
2091 $sth->execute( $borrowernumber, $type ) ;
2094 while ( my $data = $sth->fetchrow_hashref ) {
2095 push @results, $data;
2105 GetMessagesCount( $borrowernumber, $type );
2107 $type is message type, B for borrower, or L for Librarian.
2108 Empty type returns all messages of any type.
2110 Returns the number of messages for the given borrowernumber
2116 sub GetMessagesCount {
2117 my ( $borrowernumber, $type, $branchcode ) = @_;
2123 my $dbh = C4::Context->dbh;
2125 my $query = "SELECT COUNT(*) as MsgCount FROM messages WHERE borrowernumber = ? AND message_type LIKE ?";
2126 my $sth = $dbh->prepare($query);
2127 $sth->execute( $borrowernumber, $type ) ;
2130 my $data = $sth->fetchrow_hashref;
2131 my $count = $data->{'MsgCount'};
2138 =head2 DeleteMessage
2142 DeleteMessage( $message_id );
2149 my ( $message_id ) = @_;
2151 my $dbh = C4::Context->dbh;
2153 my $query = "DELETE FROM messages WHERE message_id = ?";
2154 my $sth = $dbh->prepare($query);
2155 $sth->execute( $message_id );
2159 END { } # module clean-up code here (global destructor)