3 # Copyright 2000-2003 Katipo Communications
4 # Copyright 2010 BibLibre
5 # Parts Copyright 2010 Catalyst IT
7 # This file is part of Koha.
9 # Koha is free software; you can redistribute it and/or modify it under the
10 # terms of the GNU General Public License as published by the Free Software
11 # Foundation; either version 2 of the License, or (at your option) any later
14 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
15 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
16 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
18 # You should have received a copy of the GNU General Public License along
19 # with Koha; if not, write to the Free Software Foundation, Inc.,
20 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
24 #use warnings; FIXME - Bug 2505
26 use C4::Dates qw(format_date_in_iso);
27 use Digest::MD5 qw(md5_base64);
28 use Date::Calc qw/Today Add_Delta_YM check_date Date_to_Days/;
29 use C4::Log; # logaction
34 use C4::SQLHelper qw(InsertInTable UpdateInTable SearchInTable);
35 use C4::Members::Attributes qw(SearchIdMatchingAttribute);
37 our ($VERSION,@ISA,@EXPORT,@EXPORT_OK,$debug);
41 $debug = $ENV{DEBUG} || 0;
53 &GetMemberIssuesAndFines
61 &GetFirstValidEmailAddress
74 &GetHideLostItemsPreference
77 &GetMemberAccountRecords
78 &GetBorNotifyAcctRecord
82 &GetBorrowercategoryList
84 &GetBorrowersWhoHaveNotBorrowedSince
85 &GetBorrowersWhoHaveNeverBorrowed
86 &GetBorrowersWithIssuesHistoryOlderThan
113 &ExtendMemberSubscriptionTo
131 C4::Members - Perl Module containing convenience functions for member handling
139 This module contains routines for adding, modifying and deleting members/patrons/borrowers
145 $borrowers_result_array_ref = &Search($filter,$orderby, $limit,
146 $columns_out, $search_on_fields,$searchtype);
148 Looks up patrons (borrowers) on filter. A wrapper for SearchInTable('borrowers').
150 For C<$filter>, C<$orderby>, C<$limit>, C<&columns_out>, C<&search_on_fields> and C<&searchtype>
151 refer to C4::SQLHelper:SearchInTable().
153 Special C<$filter> key '' is effectively expanded to search on surname firstname othernamescw
154 and cardnumber unless C<&search_on_fields> is defined
158 $borrowers = Search('abcd', 'cardnumber');
160 $borrowers = Search({''=>'abcd', category_type=>'I'}, 'surname');
164 sub _express_member_find {
167 # this is used by circulation everytime a new borrowers cardnumber is scanned
168 # so we can check an exact match first, if that works return, otherwise do the rest
169 my $dbh = C4::Context->dbh;
170 my $query = "SELECT borrowernumber FROM borrowers WHERE cardnumber = ?";
171 if ( my $borrowernumber = $dbh->selectrow_array($query, undef, $filter) ) {
172 return( {"borrowernumber"=>$borrowernumber} );
175 my ($search_on_fields, $searchtype);
176 if ( length($filter) == 1 ) {
177 $search_on_fields = [ qw(surname) ];
178 $searchtype = 'start_with';
180 $search_on_fields = [ qw(surname firstname othernames cardnumber) ];
181 $searchtype = 'contain';
184 return (undef, $search_on_fields, $searchtype);
188 my ( $filter, $orderby, $limit, $columns_out, $search_on_fields, $searchtype ) = @_;
193 if ( my $fr = ref $filter ) {
194 if ( $fr eq "HASH" ) {
195 if ( my $search_string = $filter->{''} ) {
196 my ($member_filter, $member_search_on_fields, $member_searchtype) = _express_member_find($search_string);
197 if ($member_filter) {
198 $filter = $member_filter;
201 $search_on_fields ||= $member_search_on_fields;
202 $searchtype ||= $member_searchtype;
207 $search_string = $filter;
211 $search_string = $filter;
212 my ($member_filter, $member_search_on_fields, $member_searchtype) = _express_member_find($search_string);
213 if ($member_filter) {
214 $filter = $member_filter;
217 $search_on_fields ||= $member_search_on_fields;
218 $searchtype ||= $member_searchtype;
222 if ( !$found_borrower && C4::Context->preference('ExtendedPatronAttributes') && $search_string ) {
223 my $matching_records = C4::Members::Attributes::SearchIdMatchingAttribute($search_string);
224 if(scalar(@$matching_records)>0) {
225 if ( my $fr = ref $filter ) {
226 if ( $fr eq "HASH" ) {
228 $filter = [ $filter ];
230 push @$filter, { %f, "borrowernumber"=>$$matching_records };
233 push @$filter, {"borrowernumber"=>$matching_records};
237 $filter = [ $filter ];
238 push @$filter, {"borrowernumber"=>$matching_records};
243 # $showallbranches was not used at the time SearchMember() was mainstreamed into Search().
244 # Mentioning for the reference
246 if ( C4::Context->preference("IndependantBranches") ) { # && !$showallbranches){
247 if ( my $userenv = C4::Context->userenv ) {
248 my $branch = $userenv->{'branch'};
249 if ( ($userenv->{flags} % 2 !=1) &&
250 $branch && $branch ne "insecure" ){
252 if (my $fr = ref $filter) {
253 if ( $fr eq "HASH" ) {
254 $filter->{branchcode} = $branch;
258 $_ = { '' => $_ } unless ref $_;
259 $_->{branchcode} = $branch;
264 $filter = { '' => $filter, branchcode => $branch };
270 if ($found_borrower) {
271 $searchtype = "exact";
273 $searchtype ||= "start_with";
275 return SearchInTable( "borrowers", $filter, $orderby, $limit, $columns_out, $search_on_fields, $searchtype );
278 =head2 GetMemberDetails
280 ($borrower) = &GetMemberDetails($borrowernumber, $cardnumber);
282 Looks up a patron and returns information about him or her. If
283 C<$borrowernumber> is true (nonzero), C<&GetMemberDetails> looks
284 up the borrower by number; otherwise, it looks up the borrower by card
287 C<$borrower> is a reference-to-hash whose keys are the fields of the
288 borrowers table in the Koha database. In addition,
289 C<$borrower-E<gt>{flags}> is a hash giving more detailed information
290 about the patron. Its keys act as flags :
292 if $borrower->{flags}->{LOST} {
293 # Patron's card was reported lost
296 If the state of a flag means that the patron should not be
297 allowed to borrow any more books, then it will have a C<noissues> key
300 See patronflags for more details.
302 C<$borrower-E<gt>{authflags}> is a hash giving more detailed information
303 about the top-level permissions flags set for the borrower. For example,
304 if a user has the "editcatalogue" permission,
305 C<$borrower-E<gt>{authflags}-E<gt>{editcatalogue}> will exist and have
310 sub GetMemberDetails {
311 my ( $borrowernumber, $cardnumber ) = @_;
312 my $dbh = C4::Context->dbh;
315 if ($borrowernumber) {
316 $sth = $dbh->prepare("SELECT borrowers.*,category_type,categories.description,reservefee,enrolmentperiod FROM borrowers LEFT JOIN categories ON borrowers.categorycode=categories.categorycode WHERE borrowernumber=?");
317 $sth->execute($borrowernumber);
319 elsif ($cardnumber) {
320 $sth = $dbh->prepare("SELECT borrowers.*,category_type,categories.description,reservefee,enrolmentperiod FROM borrowers LEFT JOIN categories ON borrowers.categorycode=categories.categorycode WHERE cardnumber=?");
321 $sth->execute($cardnumber);
326 my $borrower = $sth->fetchrow_hashref;
327 my ($amount) = GetMemberAccountRecords( $borrowernumber);
328 $borrower->{'amountoutstanding'} = $amount;
329 # FIXME - patronflags calls GetMemberAccountRecords... just have patronflags return $amount
330 my $flags = patronflags( $borrower);
333 $sth = $dbh->prepare("select bit,flag from userflags");
335 while ( my ( $bit, $flag ) = $sth->fetchrow ) {
336 if ( $borrower->{'flags'} && $borrower->{'flags'} & 2**$bit ) {
337 $accessflagshash->{$flag} = 1;
340 $borrower->{'flags'} = $flags;
341 $borrower->{'authflags'} = $accessflagshash;
343 # For the purposes of making templates easier, we'll define a
344 # 'showname' which is the alternate form the user's first name if
345 # 'other name' is defined.
346 if ($borrower->{category_type} eq 'I') {
347 $borrower->{'showname'} = $borrower->{'othernames'};
348 $borrower->{'showname'} .= " $borrower->{'firstname'}" if $borrower->{'firstname'};
350 $borrower->{'showname'} = $borrower->{'firstname'};
353 return ($borrower); #, $flags, $accessflagshash);
358 $flags = &patronflags($patron);
360 This function is not exported.
362 The following will be set where applicable:
363 $flags->{CHARGES}->{amount} Amount of debt
364 $flags->{CHARGES}->{noissues} Set if debt amount >$5.00 (or syspref noissuescharge)
365 $flags->{CHARGES}->{message} Message -- deprecated
367 $flags->{CREDITS}->{amount} Amount of credit
368 $flags->{CREDITS}->{message} Message -- deprecated
370 $flags->{ GNA } Patron has no valid address
371 $flags->{ GNA }->{noissues} Set for each GNA
372 $flags->{ GNA }->{message} "Borrower has no valid address" -- deprecated
374 $flags->{ LOST } Patron's card reported lost
375 $flags->{ LOST }->{noissues} Set for each LOST
376 $flags->{ LOST }->{message} Message -- deprecated
378 $flags->{DBARRED} Set if patron debarred, no access
379 $flags->{DBARRED}->{noissues} Set for each DBARRED
380 $flags->{DBARRED}->{message} Message -- deprecated
383 $flags->{ NOTES }->{message} The note itself. NOT deprecated
385 $flags->{ ODUES } Set if patron has overdue books.
386 $flags->{ ODUES }->{message} "Yes" -- deprecated
387 $flags->{ ODUES }->{itemlist} ref-to-array: list of overdue books
388 $flags->{ ODUES }->{itemlisttext} Text list of overdue items -- deprecated
390 $flags->{WAITING} Set if any of patron's reserves are available
391 $flags->{WAITING}->{message} Message -- deprecated
392 $flags->{WAITING}->{itemlist} ref-to-array: list of available items
396 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
397 overdue items. Its elements are references-to-hash, each describing an
398 overdue item. The keys are selected fields from the issues, biblio,
399 biblioitems, and items tables of the Koha database.
401 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
402 the overdue items, one per line. Deprecated.
404 =item C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
405 available items. Each element is a reference-to-hash whose keys are
406 fields from the reserves table of the Koha database.
410 All the "message" fields that include language generated in this function are deprecated,
411 because such strings belong properly in the display layer.
413 The "message" field that comes from the DB is OK.
417 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
418 # FIXME rename this function.
421 my ( $patroninformation) = @_;
422 my $dbh=C4::Context->dbh;
423 my ($amount) = GetMemberAccountRecords( $patroninformation->{'borrowernumber'});
426 my $noissuescharge = C4::Context->preference("noissuescharge") || 5;
427 $flaginfo{'message'} = sprintf "Patron owes \$%.02f", $amount;
428 $flaginfo{'amount'} = sprintf "%.02f", $amount;
429 if ( $amount > $noissuescharge && !C4::Context->preference("AllowFineOverride") ) {
430 $flaginfo{'noissues'} = 1;
432 $flags{'CHARGES'} = \%flaginfo;
434 elsif ( $amount < 0 ) {
436 $flaginfo{'message'} = sprintf "Patron has credit of \$%.02f", -$amount;
437 $flaginfo{'amount'} = sprintf "%.02f", $amount;
438 $flags{'CREDITS'} = \%flaginfo;
440 if ( $patroninformation->{'gonenoaddress'}
441 && $patroninformation->{'gonenoaddress'} == 1 )
444 $flaginfo{'message'} = 'Borrower has no valid address.';
445 $flaginfo{'noissues'} = 1;
446 $flags{'GNA'} = \%flaginfo;
448 if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
450 $flaginfo{'message'} = 'Borrower\'s card reported lost.';
451 $flaginfo{'noissues'} = 1;
452 $flags{'LOST'} = \%flaginfo;
454 if ( $patroninformation->{'debarred'} && check_date( split( /-/, $patroninformation->{'debarred'} ) ) ) {
455 if ( Date_to_Days(Date::Calc::Today) < Date_to_Days( split( /-/, $patroninformation->{'debarred'} ) ) ) {
457 $flaginfo{'debarredcomment'} = $patroninformation->{'debarredcomment'};
458 $flaginfo{'message'} = $patroninformation->{'debarredcomment'};
459 $flaginfo{'noissues'} = 1;
460 $flaginfo{'dateend'} = $patroninformation->{'debarred'};
461 $flags{'DBARRED'} = \%flaginfo;
464 if ( $patroninformation->{'borrowernotes'}
465 && $patroninformation->{'borrowernotes'} )
468 $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
469 $flags{'NOTES'} = \%flaginfo;
471 my ( $odues, $itemsoverdue ) = checkoverdues($patroninformation->{'borrowernumber'});
472 if ( $odues && $odues > 0 ) {
474 $flaginfo{'message'} = "Yes";
475 $flaginfo{'itemlist'} = $itemsoverdue;
476 foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
479 $flaginfo{'itemlisttext'} .=
480 "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n"; # newline is display layer
482 $flags{'ODUES'} = \%flaginfo;
484 my @itemswaiting = C4::Reserves::GetReservesFromBorrowernumber( $patroninformation->{'borrowernumber'},'W' );
485 my $nowaiting = scalar @itemswaiting;
486 if ( $nowaiting > 0 ) {
488 $flaginfo{'message'} = "Reserved items available";
489 $flaginfo{'itemlist'} = \@itemswaiting;
490 $flags{'WAITING'} = \%flaginfo;
498 $borrower = &GetMember(%information);
500 Retrieve the first patron record meeting on criteria listed in the
501 C<%information> hash, which should contain one or more
502 pairs of borrowers column names and values, e.g.,
504 $borrower = GetMember(borrowernumber => id);
506 C<&GetBorrower> returns a reference-to-hash whose keys are the fields of
507 the C<borrowers> table in the Koha database.
509 FIXME: GetMember() is used throughout the code as a lookup
510 on a unique key such as the borrowernumber, but this meaning is not
511 enforced in the routine itself.
517 my ( %information ) = @_;
518 if (exists $information{borrowernumber} && !defined $information{borrowernumber}) {
519 #passing mysql's kohaadmin?? Makes no sense as a query
522 my $dbh = C4::Context->dbh;
524 q{SELECT borrowers.*, categories.category_type, categories.description
526 LEFT JOIN categories on borrowers.categorycode=categories.categorycode WHERE };
529 for (keys %information ) {
537 if (defined $information{$_}) {
539 push @values, $information{$_};
542 $select .= "$_ IS NULL";
545 $debug && warn $select, " ",values %information;
546 my $sth = $dbh->prepare("$select");
547 $sth->execute(map{$information{$_}} keys %information);
548 my $data = $sth->fetchall_arrayref({});
549 #FIXME interface to this routine now allows generation of a result set
550 #so whole array should be returned but bowhere in the current code expects this
558 =head2 GetMemberRelatives
560 @borrowernumbers = GetMemberRelatives($borrowernumber);
562 C<GetMemberRelatives> returns a borrowersnumber's list of guarantor/guarantees of the member given in parameter
565 sub GetMemberRelatives {
566 my $borrowernumber = shift;
567 my $dbh = C4::Context->dbh;
571 my $query = "SELECT guarantorid FROM borrowers WHERE borrowernumber=?";
572 my $sth = $dbh->prepare($query);
573 $sth->execute($borrowernumber);
574 my $data = $sth->fetchrow_arrayref();
575 push @glist, $data->[0] if $data->[0];
576 my $guarantor = $data->[0] if $data->[0];
579 $query = "SELECT borrowernumber FROM borrowers WHERE guarantorid=?";
580 $sth = $dbh->prepare($query);
581 $sth->execute($borrowernumber);
582 while ($data = $sth->fetchrow_arrayref()) {
583 push @glist, $data->[0];
586 # Getting sibling guarantees
588 $query = "SELECT borrowernumber FROM borrowers WHERE guarantorid=?";
589 $sth = $dbh->prepare($query);
590 $sth->execute($guarantor);
591 while ($data = $sth->fetchrow_arrayref()) {
592 push @glist, $data->[0] if ($data->[0] != $borrowernumber);
599 =head2 IsMemberBlocked
601 my ($block_status, $count) = IsMemberBlocked( $borrowernumber );
603 Returns whether a patron has overdue items that may result
604 in a block or whether the patron has active fine days
605 that would block circulation privileges.
607 C<$block_status> can have the following values:
609 1 if the patron has outstanding fine days, in which case C<$count> is the number of them
611 -1 if the patron has overdue items, in which case C<$count> is the number of them
613 0 if the patron has no overdue items or outstanding fine days, in which case C<$count> is 0
615 Outstanding fine days are checked before current overdue items
618 FIXME: this needs to be split into two functions; a potential block
619 based on the number of current overdue items could be orthogonal
620 to a block based on whether the patron has any fine days accrued.
624 sub IsMemberBlocked {
625 my $borrowernumber = shift;
626 my $dbh = C4::Context->dbh;
628 my $blockeddate = CheckBorrowerDebarred($borrowernumber);
630 return ( 1, $blockeddate ) if $blockeddate;
632 # if he have late issues
633 my $sth = $dbh->prepare(
634 "SELECT COUNT(*) as latedocs
636 WHERE borrowernumber = ?
637 AND date_due < curdate()"
639 $sth->execute($borrowernumber);
640 my $latedocs = $sth->fetchrow_hashref->{'latedocs'};
642 return ( -1, $latedocs ) if $latedocs > 0;
647 =head2 GetMemberIssuesAndFines
649 ($overdue_count, $issue_count, $total_fines) = &GetMemberIssuesAndFines($borrowernumber);
651 Returns aggregate data about items borrowed by the patron with the
652 given borrowernumber.
654 C<&GetMemberIssuesAndFines> returns a three-element array. C<$overdue_count> is the
655 number of overdue items the patron currently has borrowed. C<$issue_count> is the
656 number of books the patron currently has borrowed. C<$total_fines> is
657 the total fine currently due by the borrower.
662 sub GetMemberIssuesAndFines {
663 my ( $borrowernumber ) = @_;
664 my $dbh = C4::Context->dbh;
665 my $query = "SELECT COUNT(*) FROM issues WHERE borrowernumber = ?";
667 $debug and warn $query."\n";
668 my $sth = $dbh->prepare($query);
669 $sth->execute($borrowernumber);
670 my $issue_count = $sth->fetchrow_arrayref->[0];
672 $sth = $dbh->prepare(
673 "SELECT COUNT(*) FROM issues
674 WHERE borrowernumber = ?
675 AND date_due < curdate()"
677 $sth->execute($borrowernumber);
678 my $overdue_count = $sth->fetchrow_arrayref->[0];
680 $sth = $dbh->prepare("SELECT SUM(amountoutstanding) FROM accountlines WHERE borrowernumber = ?");
681 $sth->execute($borrowernumber);
682 my $total_fines = $sth->fetchrow_arrayref->[0];
684 return ($overdue_count, $issue_count, $total_fines);
688 return @{C4::Context->dbh->selectcol_arrayref("SHOW columns from borrowers")};
693 my $success = ModMember(borrowernumber => $borrowernumber,
694 [ field => value ]... );
696 Modify borrower's data. All date fields should ALREADY be in ISO format.
699 true on success, or false on failure
705 # test to know if you must update or not the borrower password
706 if (exists $data{password}) {
707 if ($data{password} eq '****' or $data{password} eq '') {
708 delete $data{password};
710 $data{password} = md5_base64($data{password});
713 my $execute_success=UpdateInTable("borrowers",\%data);
714 if ($execute_success) { # only proceed if the update was a success
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'})") if C4::Context->preference("BorrowersLog");
725 return $execute_success;
731 $borrowernumber = &AddMember(%borrower);
733 insert new borrower into table
734 Returns the borrowernumber upon success
736 Returns as undef upon any db error without further processing
743 my $dbh = C4::Context->dbh;
744 # generate a proper login if none provided
745 $data{'userid'} = Generate_Userid($data{'borrowernumber'}, $data{'firstname'}, $data{'surname'}) if $data{'userid'} eq '';
746 # create a disabled account if no password provided
747 $data{'password'} = ($data{'password'})? md5_base64($data{'password'}) : '!';
748 $data{'borrowernumber'}=InsertInTable("borrowers",\%data);
749 # mysql_insertid is probably bad. not necessarily accurate and mysql-specific at best.
750 logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
752 # check for enrollment fee & add it if needed
753 my $sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
754 $sth->execute($data{'categorycode'});
755 my ($enrolmentfee) = $sth->fetchrow;
757 warn sprintf('Database returned the following error: %s', $sth->errstr);
760 if ($enrolmentfee && $enrolmentfee > 0) {
761 # insert fee in patron debts
762 manualinvoice($data{'borrowernumber'}, '', '', 'A', $enrolmentfee);
765 return $data{'borrowernumber'};
770 my ($uid,$member) = @_;
771 my $dbh = C4::Context->dbh;
772 # Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
773 # Then we need to tell the user and have them create a new one.
776 "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
777 $sth->execute( $uid, $member );
778 if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
786 sub Generate_Userid {
787 my ($borrowernumber, $firstname, $surname) = @_;
791 $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
792 $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
793 $newuid = lc(($firstname)? "$firstname.$surname" : $surname);
794 $newuid .= $offset unless $offset == 0;
797 } while (!Check_Userid($newuid,$borrowernumber));
803 my ( $uid, $member, $digest ) = @_;
804 my $dbh = C4::Context->dbh;
806 #Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
807 #Then we need to tell the user and have them create a new one.
811 "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
812 $sth->execute( $uid, $member );
813 if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
817 #Everything is good so we can update the information.
820 "update borrowers set userid=?, password=? where borrowernumber=?");
821 $sth->execute( $uid, $digest, $member );
825 logaction("MEMBERS", "CHANGE PASS", $member, "") if C4::Context->preference("BorrowersLog");
831 =head2 fixup_cardnumber
833 Warning: The caller is responsible for locking the members table in write
834 mode, to avoid database corruption.
838 use vars qw( @weightings );
839 my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
841 sub fixup_cardnumber ($) {
842 my ($cardnumber) = @_;
843 my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;
845 # Find out whether member numbers should be generated
846 # automatically. Should be either "1" or something else.
847 # Defaults to "0", which is interpreted as "no".
849 # if ($cardnumber !~ /\S/ && $autonumber_members) {
850 ($autonumber_members) or return $cardnumber;
851 my $checkdigit = C4::Context->preference('checkdigit');
852 my $dbh = C4::Context->dbh;
853 if ( $checkdigit and $checkdigit eq 'katipo' ) {
855 # if checkdigit is selected, calculate katipo-style cardnumber.
856 # otherwise, just use the max()
857 # purpose: generate checksum'd member numbers.
858 # We'll assume we just got the max value of digits 2-8 of member #'s
859 # from the database and our job is to increment that by one,
860 # determine the 1st and 9th digits and return the full string.
861 my $sth = $dbh->prepare(
862 "select max(substring(borrowers.cardnumber,2,7)) as new_num from borrowers"
865 my $data = $sth->fetchrow_hashref;
866 $cardnumber = $data->{new_num};
867 if ( !$cardnumber ) { # If DB has no values,
868 $cardnumber = 1000000; # start at 1000000
874 for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
875 # read weightings, left to right, 1 char at a time
876 my $temp1 = $weightings[$i];
878 # sequence left to right, 1 char at a time
879 my $temp2 = substr( $cardnumber, $i, 1 );
881 # mult each char 1-7 by its corresponding weighting
882 $sum += $temp1 * $temp2;
885 my $rem = ( $sum % 11 );
886 $rem = 'X' if $rem == 10;
888 return "V$cardnumber$rem";
891 # MODIFIED BY JF: mysql4.1 allows casting as an integer, which is probably
892 # better. I'll leave the original in in case it needs to be changed for you
893 # my $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers");
894 my $sth = $dbh->prepare(
895 "select max(cast(cardnumber as signed)) from borrowers"
898 my ($result) = $sth->fetchrow;
901 return $cardnumber; # just here as a fallback/reminder
906 ($num_children, $children_arrayref) = &GetGuarantees($parent_borrno);
907 $child0_cardno = $children_arrayref->[0]{"cardnumber"};
908 $child0_borrno = $children_arrayref->[0]{"borrowernumber"};
910 C<&GetGuarantees> takes a borrower number (e.g., that of a patron
911 with children) and looks up the borrowers who are guaranteed by that
912 borrower (i.e., the patron's children).
914 C<&GetGuarantees> returns two values: an integer giving the number of
915 borrowers guaranteed by C<$parent_borrno>, and a reference to an array
916 of references to hash, which gives the actual results.
922 my ($borrowernumber) = @_;
923 my $dbh = C4::Context->dbh;
926 "select cardnumber,borrowernumber, firstname, surname from borrowers where guarantorid=?"
928 $sth->execute($borrowernumber);
931 my $data = $sth->fetchall_arrayref({});
932 return ( scalar(@$data), $data );
935 =head2 UpdateGuarantees
937 &UpdateGuarantees($parent_borrno);
940 C<&UpdateGuarantees> borrower data for an adult and updates all the guarantees
941 with the modified information
946 sub UpdateGuarantees {
948 my $dbh = C4::Context->dbh;
949 my ( $count, $guarantees ) = GetGuarantees( $data{'borrowernumber'} );
950 foreach my $guarantee (@$guarantees){
951 my $guaquery = qq|UPDATE borrowers
952 SET address=?,fax=?,B_city=?,mobile=?,city=?,phone=?
953 WHERE borrowernumber=?
955 my $sth = $dbh->prepare($guaquery);
956 $sth->execute($data{'address'},$data{'fax'},$data{'B_city'},$data{'mobile'},$data{'city'},$data{'phone'},$guarantee->{'borrowernumber'});
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 @borrowernumbers = @_;
976 unless (@borrowernumbers ) { # return a ref_to_array
977 return \@borrowernumbers; # to not cause surprise to caller
980 # Borrowers part of the query
982 for (my $i = 0; $i < @borrowernumbers; $i++) {
983 $bquery .= ' issues.borrowernumber = ?';
984 if ($i < $#borrowernumbers ) {
989 # must avoid biblioitems.* to prevent large marc and marcxml fields from killing performance
990 # FIXME: namespace collision: each table has "timestamp" fields. Which one is "timestamp" ?
991 # FIXME: circ/ciculation.pl tries to sort by timestamp!
992 # FIXME: C4::Print::printslip tries to sort by timestamp!
993 # FIXME: namespace collision: other collisions possible.
994 # FIXME: most of this data isn't really being used by callers.
1001 biblioitems.itemtype,
1004 biblioitems.publicationyear,
1005 biblioitems.publishercode,
1006 biblioitems.volumedate,
1007 biblioitems.volumedesc,
1010 borrowers.firstname,
1012 borrowers.cardnumber,
1013 issues.timestamp AS timestamp,
1014 issues.renewals AS renewals,
1015 issues.borrowernumber AS borrowernumber,
1016 items.renewals AS totalrenewals
1018 LEFT JOIN items ON items.itemnumber = issues.itemnumber
1019 LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
1020 LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
1021 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
1024 ORDER BY issues.issuedate"
1027 my $sth = C4::Context->dbh->prepare($query);
1028 $sth->execute(@borrowernumbers);
1029 my $data = $sth->fetchall_arrayref({});
1030 my $today = C4::Dates->new->output('iso');
1031 foreach (@{$data}) {
1032 if ($_->{date_due} and $_->{date_due} lt $today) {
1041 $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
1043 Looks up what the patron with the given borrowernumber has borrowed,
1044 and sorts the results.
1046 C<$sortkey> is the name of a field on which to sort the results. This
1047 should be the name of a field in the C<issues>, C<biblio>,
1048 C<biblioitems>, or C<items> table in the Koha database.
1050 C<$limit> is the maximum number of results to return.
1052 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
1053 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
1054 C<items> tables of the Koha database.
1060 my ( $borrowernumber, $order, $limit ) = @_;
1062 #FIXME: sanity-check order and limit
1063 my $dbh = C4::Context->dbh;
1065 "SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1067 LEFT JOIN items on items.itemnumber=issues.itemnumber
1068 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1069 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1070 WHERE borrowernumber=?
1072 SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1074 LEFT JOIN items on items.itemnumber=old_issues.itemnumber
1075 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1076 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1077 WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL
1079 if ( $limit != 0 ) {
1080 $query .= " limit $limit";
1083 my $sth = $dbh->prepare($query);
1084 $sth->execute($borrowernumber, $borrowernumber);
1087 while ( my $data = $sth->fetchrow_hashref ) {
1088 push @result, $data;
1095 =head2 GetMemberAccountRecords
1097 ($total, $acctlines, $count) = &GetMemberAccountRecords($borrowernumber);
1099 Looks up accounting data for the patron with the given borrowernumber.
1101 C<&GetMemberAccountRecords> returns a three-element array. C<$acctlines> is a
1102 reference-to-array, where each element is a reference-to-hash; the
1103 keys are the fields of the C<accountlines> table in the Koha database.
1104 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1105 total amount outstanding for all of the account lines.
1110 sub GetMemberAccountRecords {
1111 my ($borrowernumber,$date) = @_;
1112 my $dbh = C4::Context->dbh;
1118 WHERE borrowernumber=?);
1119 my @bind = ($borrowernumber);
1120 if ($date && $date ne ''){
1121 $strsth.=" AND date < ? ";
1124 $strsth.=" ORDER BY date desc,timestamp DESC";
1125 my $sth= $dbh->prepare( $strsth );
1126 $sth->execute( @bind );
1128 while ( my $data = $sth->fetchrow_hashref ) {
1129 if ( $data->{itemnumber} ) {
1130 my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
1131 $data->{biblionumber} = $biblio->{biblionumber};
1132 $data->{title} = $biblio->{title};
1134 $acctlines[$numlines] = $data;
1136 $total += int(1000 * $data->{'amountoutstanding'}); # convert float to integer to avoid round-off errors
1139 return ( $total, \@acctlines,$numlines);
1142 =head2 GetBorNotifyAcctRecord
1144 ($total, $acctlines, $count) = &GetBorNotifyAcctRecord($params,$notifyid);
1146 Looks up accounting data for the patron with the given borrowernumber per file number.
1148 C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a
1149 reference-to-array, where each element is a reference-to-hash; the
1150 keys are the fields of the C<accountlines> table in the Koha database.
1151 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1152 total amount outstanding for all of the account lines.
1156 sub GetBorNotifyAcctRecord {
1157 my ( $borrowernumber, $notifyid ) = @_;
1158 my $dbh = C4::Context->dbh;
1161 my $sth = $dbh->prepare(
1164 WHERE borrowernumber=?
1166 AND amountoutstanding != '0'
1167 ORDER BY notify_id,accounttype
1170 $sth->execute( $borrowernumber, $notifyid );
1172 while ( my $data = $sth->fetchrow_hashref ) {
1173 $acctlines[$numlines] = $data;
1175 $total += int(100 * $data->{'amountoutstanding'});
1178 return ( $total, \@acctlines, $numlines );
1181 =head2 checkuniquemember (OUEST-PROVENCE)
1183 ($result,$categorycode) = &checkuniquemember($collectivity,$surname,$firstname,$dateofbirth);
1185 Checks that a member exists or not in the database.
1187 C<&result> is nonzero (=exist) or 0 (=does not exist)
1188 C<&categorycode> is from categorycode table
1189 C<&collectivity> is 1 (= we add a collectivity) or 0 (= we add a physical member)
1190 C<&surname> is the surname
1191 C<&firstname> is the firstname (only if collectivity=0)
1192 C<&dateofbirth> is the date of birth in ISO format (only if collectivity=0)
1196 # FIXME: This function is not legitimate. Multiple patrons might have the same first/last name and birthdate.
1197 # This is especially true since first name is not even a required field.
1199 sub checkuniquemember {
1200 my ( $collectivity, $surname, $firstname, $dateofbirth ) = @_;
1201 my $dbh = C4::Context->dbh;
1202 my $request = ($collectivity) ?
1203 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? " :
1205 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=? and dateofbirth=?" :
1206 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=?";
1207 my $sth = $dbh->prepare($request);
1208 if ($collectivity) {
1209 $sth->execute( uc($surname) );
1210 } elsif($dateofbirth){
1211 $sth->execute( uc($surname), ucfirst($firstname), $dateofbirth );
1213 $sth->execute( uc($surname), ucfirst($firstname));
1215 my @data = $sth->fetchrow;
1216 ( $data[0] ) and return $data[0], $data[1];
1220 sub checkcardnumber {
1221 my ($cardnumber,$borrowernumber) = @_;
1222 # If cardnumber is null, we assume they're allowed.
1223 return 0 if !defined($cardnumber);
1224 my $dbh = C4::Context->dbh;
1225 my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
1226 $query .= " AND borrowernumber <> ?" if ($borrowernumber);
1227 my $sth = $dbh->prepare($query);
1228 if ($borrowernumber) {
1229 $sth->execute($cardnumber,$borrowernumber);
1231 $sth->execute($cardnumber);
1233 if (my $data= $sth->fetchrow_hashref()){
1242 =head2 getzipnamecity (OUEST-PROVENCE)
1244 take all info from table city for the fields city and zip
1245 check for the name and the zip code of the city selected
1249 sub getzipnamecity {
1251 my $dbh = C4::Context->dbh;
1254 "select city_name,city_state,city_zipcode,city_country from cities where cityid=? ");
1255 $sth->execute($cityid);
1256 my @data = $sth->fetchrow;
1257 return $data[0], $data[1], $data[2], $data[3];
1261 =head2 getdcity (OUEST-PROVENCE)
1263 recover cityid with city_name condition
1268 my ($city_name) = @_;
1269 my $dbh = C4::Context->dbh;
1270 my $sth = $dbh->prepare("select cityid from cities where city_name=? ");
1271 $sth->execute($city_name);
1272 my $data = $sth->fetchrow;
1276 =head2 GetFirstValidEmailAddress
1278 $email = GetFirstValidEmailAddress($borrowernumber);
1280 Return the first valid email address for a borrower, given the borrowernumber. For now, the order
1281 is defined as email, emailpro, B_email. Returns the empty string if the borrower has no email
1286 sub GetFirstValidEmailAddress {
1287 my $borrowernumber = shift;
1288 my $dbh = C4::Context->dbh;
1289 my $sth = $dbh->prepare( "SELECT email, emailpro, B_email FROM borrowers where borrowernumber = ? ");
1290 $sth->execute( $borrowernumber );
1291 my $data = $sth->fetchrow_hashref;
1293 if ($data->{'email'}) {
1294 return $data->{'email'};
1295 } elsif ($data->{'emailpro'}) {
1296 return $data->{'emailpro'};
1297 } elsif ($data->{'B_email'}) {
1298 return $data->{'B_email'};
1304 =head2 GetExpiryDate
1306 $expirydate = GetExpiryDate($categorycode, $dateenrolled);
1308 Calculate expiry date given a categorycode and starting date. Date argument must be in ISO format.
1309 Return date is also in ISO format.
1314 my ( $categorycode, $dateenrolled ) = @_;
1316 if ($categorycode) {
1317 my $dbh = C4::Context->dbh;
1318 my $sth = $dbh->prepare("SELECT enrolmentperiod,enrolmentperioddate FROM categories WHERE categorycode=?");
1319 $sth->execute($categorycode);
1320 $enrolments = $sth->fetchrow_hashref;
1322 # die "GetExpiryDate: for enrollmentperiod $enrolmentperiod (category '$categorycode') starting $dateenrolled.\n";
1323 my @date = split (/-/,$dateenrolled);
1324 if($enrolments->{enrolmentperiod}){
1325 return sprintf("%04d-%02d-%02d", Add_Delta_YM(@date,0,$enrolments->{enrolmentperiod}));
1327 return $enrolments->{enrolmentperioddate};
1331 =head2 checkuserpassword (OUEST-PROVENCE)
1333 check for the password and login are not used
1334 return the number of record
1335 0=> NOT USED 1=> USED
1339 sub checkuserpassword {
1340 my ( $borrowernumber, $userid, $password ) = @_;
1341 $password = md5_base64($password);
1342 my $dbh = C4::Context->dbh;
1345 "Select count(*) from borrowers where borrowernumber !=? and userid =? and password=? "
1347 $sth->execute( $borrowernumber, $userid, $password );
1348 my $number_rows = $sth->fetchrow;
1349 return $number_rows;
1353 =head2 GetborCatFromCatType
1355 ($codes_arrayref, $labels_hashref) = &GetborCatFromCatType();
1357 Looks up the different types of borrowers in the database. Returns two
1358 elements: a reference-to-array, which lists the borrower category
1359 codes, and a reference-to-hash, which maps the borrower category codes
1360 to category descriptions.
1365 sub GetborCatFromCatType {
1366 my ( $category_type, $action ) = @_;
1367 # FIXME - This API seems both limited and dangerous.
1368 my $dbh = C4::Context->dbh;
1369 my $request = qq| SELECT categorycode,description
1372 ORDER BY categorycode|;
1373 my $sth = $dbh->prepare($request);
1375 $sth->execute($category_type);
1384 while ( my $data = $sth->fetchrow_hashref ) {
1385 push @codes, $data->{'categorycode'};
1386 $labels{ $data->{'categorycode'} } = $data->{'description'};
1388 return ( \@codes, \%labels );
1391 =head2 GetBorrowercategory
1393 $hashref = &GetBorrowercategory($categorycode);
1395 Given the borrower's category code, the function returns the corresponding
1396 data hashref for a comprehensive information display.
1398 $arrayref_hashref = &GetBorrowercategory;
1400 If no category code provided, the function returns all the categories.
1404 sub GetBorrowercategory {
1406 my $dbh = C4::Context->dbh;
1410 "SELECT description,dateofbirthrequired,upperagelimit,category_type
1412 WHERE categorycode = ?"
1414 $sth->execute($catcode);
1416 $sth->fetchrow_hashref;
1420 } # sub getborrowercategory
1422 =head2 GetBorrowercategoryList
1424 $arrayref_hashref = &GetBorrowercategoryList;
1425 If no category code provided, the function returns all the categories.
1429 sub GetBorrowercategoryList {
1430 my $dbh = C4::Context->dbh;
1435 ORDER BY description"
1439 $sth->fetchall_arrayref({});
1441 } # sub getborrowercategory
1443 =head2 ethnicitycategories
1445 ($codes_arrayref, $labels_hashref) = ðnicitycategories();
1447 Looks up the different ethnic types in the database. Returns two
1448 elements: a reference-to-array, which lists the ethnicity codes, and a
1449 reference-to-hash, which maps the ethnicity codes to ethnicity
1456 sub ethnicitycategories {
1457 my $dbh = C4::Context->dbh;
1458 my $sth = $dbh->prepare("Select code,name from ethnicity order by name");
1462 while ( my $data = $sth->fetchrow_hashref ) {
1463 push @codes, $data->{'code'};
1464 $labels{ $data->{'code'} } = $data->{'name'};
1466 return ( \@codes, \%labels );
1471 $ethn_name = &fixEthnicity($ethn_code);
1473 Takes an ethnicity code (e.g., "european" or "pi") and returns the
1474 corresponding descriptive name from the C<ethnicity> table in the
1475 Koha database ("European" or "Pacific Islander").
1482 my $ethnicity = shift;
1483 return unless $ethnicity;
1484 my $dbh = C4::Context->dbh;
1485 my $sth = $dbh->prepare("Select name from ethnicity where code = ?");
1486 $sth->execute($ethnicity);
1487 my $data = $sth->fetchrow_hashref;
1488 return $data->{'name'};
1489 } # sub fixEthnicity
1493 $dateofbirth,$date = &GetAge($date);
1495 this function return the borrowers age with the value of dateofbirth
1501 my ( $date, $date_ref ) = @_;
1503 if ( not defined $date_ref ) {
1504 $date_ref = sprintf( '%04d-%02d-%02d', Today() );
1507 my ( $year1, $month1, $day1 ) = split /-/, $date;
1508 my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
1510 my $age = $year2 - $year1;
1511 if ( $month1 . $day1 > $month2 . $day2 ) {
1518 =head2 get_institutions
1520 $insitutions = get_institutions();
1522 Just returns a list of all the borrowers of type I, borrownumber and name
1527 sub get_institutions {
1528 my $dbh = C4::Context->dbh();
1531 "SELECT borrowernumber,surname FROM borrowers WHERE categorycode=? ORDER BY surname"
1535 while ( my $data = $sth->fetchrow_hashref() ) {
1536 $orgs{ $data->{'borrowernumber'} } = $data;
1540 } # sub get_institutions
1542 =head2 add_member_orgs
1544 add_member_orgs($borrowernumber,$borrowernumbers);
1546 Takes a borrowernumber and a list of other borrowernumbers and inserts them into the borrowers_to_borrowers table
1551 sub add_member_orgs {
1552 my ( $borrowernumber, $otherborrowers ) = @_;
1553 my $dbh = C4::Context->dbh();
1555 "INSERT INTO borrowers_to_borrowers (borrower1,borrower2) VALUES (?,?)";
1556 my $sth = $dbh->prepare($query);
1557 foreach my $otherborrowernumber (@$otherborrowers) {
1558 $sth->execute( $borrowernumber, $otherborrowernumber );
1561 } # sub add_member_orgs
1565 $cityarrayref = GetCities();
1567 Returns an array_ref of the entries in the cities table
1568 If there are entries in the table an empty row is returned
1569 This is currently only used to populate a popup in memberentry
1575 my $dbh = C4::Context->dbh;
1576 my $city_arr = $dbh->selectall_arrayref(
1577 q|SELECT cityid,city_zipcode,city_name,city_state,city_country FROM cities ORDER BY city_name|,
1579 if ( @{$city_arr} ) {
1580 unshift @{$city_arr}, {
1581 city_zipcode => q{},
1585 city_country => q{},
1592 =head2 GetSortDetails (OUEST-PROVENCE)
1594 ($lib) = &GetSortDetails($category,$sortvalue);
1596 Returns the authorized value details
1597 C<&$lib>return value of authorized value details
1598 C<&$sortvalue>this is the value of authorized value
1599 C<&$category>this is the value of authorized value category
1603 sub GetSortDetails {
1604 my ( $category, $sortvalue ) = @_;
1605 my $dbh = C4::Context->dbh;
1606 my $query = qq|SELECT lib
1607 FROM authorised_values
1609 AND authorised_value=? |;
1610 my $sth = $dbh->prepare($query);
1611 $sth->execute( $category, $sortvalue );
1612 my $lib = $sth->fetchrow;
1613 return ($lib) if ($lib);
1614 return ($sortvalue) unless ($lib);
1617 =head2 MoveMemberToDeleted
1619 $result = &MoveMemberToDeleted($borrowernumber);
1621 Copy the record from borrowers to deletedborrowers table.
1625 # FIXME: should do it in one SQL statement w/ subquery
1626 # Otherwise, we should return the @data on success
1628 sub MoveMemberToDeleted {
1629 my ($member) = shift or return;
1630 my $dbh = C4::Context->dbh;
1631 my $query = qq|SELECT *
1633 WHERE borrowernumber=?|;
1634 my $sth = $dbh->prepare($query);
1635 $sth->execute($member);
1636 my @data = $sth->fetchrow_array;
1637 (@data) or return; # if we got a bad borrowernumber, there's nothing to insert
1639 $dbh->prepare( "INSERT INTO deletedborrowers VALUES ("
1640 . ( "?," x ( scalar(@data) - 1 ) )
1642 $sth->execute(@data);
1647 DelMember($borrowernumber);
1649 This function remove directly a borrower whitout writing it on deleteborrower.
1650 + Deletes reserves for the borrower
1655 my $dbh = C4::Context->dbh;
1656 my $borrowernumber = shift;
1657 #warn "in delmember with $borrowernumber";
1658 return unless $borrowernumber; # borrowernumber is mandatory.
1660 my $query = qq|DELETE
1662 WHERE borrowernumber=?|;
1663 my $sth = $dbh->prepare($query);
1664 $sth->execute($borrowernumber);
1668 WHERE borrowernumber = ?
1670 $sth = $dbh->prepare($query);
1671 $sth->execute($borrowernumber);
1672 logaction("MEMBERS", "DELETE", $borrowernumber, "") if C4::Context->preference("BorrowersLog");
1676 =head2 ExtendMemberSubscriptionTo (OUEST-PROVENCE)
1678 $date = ExtendMemberSubscriptionTo($borrowerid, $date);
1680 Extending the subscription to a given date or to the expiry date calculated on ISO date.
1685 sub ExtendMemberSubscriptionTo {
1686 my ( $borrowerid,$date) = @_;
1687 my $dbh = C4::Context->dbh;
1688 my $borrower = GetMember('borrowernumber'=>$borrowerid);
1690 $date=POSIX::strftime("%Y-%m-%d",localtime());
1691 $date = GetExpiryDate( $borrower->{'categorycode'}, $date );
1693 my $sth = $dbh->do(<<EOF);
1695 SET dateexpiry='$date'
1696 WHERE borrowernumber='$borrowerid'
1698 # add enrolmentfee if needed
1699 $sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
1700 $sth->execute($borrower->{'categorycode'});
1701 my ($enrolmentfee) = $sth->fetchrow;
1702 if ($enrolmentfee && $enrolmentfee > 0) {
1703 # insert fee in patron debts
1704 manualinvoice($borrower->{'borrowernumber'}, '', '', 'A', $enrolmentfee);
1706 logaction("MEMBERS", "RENEW", $borrower->{'borrowernumber'}, "Membership renewed")if C4::Context->preference("BorrowersLog");
1707 return $date if ($sth);
1711 =head2 GetRoadTypes (OUEST-PROVENCE)
1713 ($idroadtypearrayref, $roadttype_hashref) = &GetRoadTypes();
1715 Looks up the different road type . Returns two
1716 elements: a reference-to-array, which lists the id_roadtype
1717 codes, and a reference-to-hash, which maps the road type of the road .
1722 my $dbh = C4::Context->dbh;
1724 SELECT roadtypeid,road_type
1726 ORDER BY road_type|;
1727 my $sth = $dbh->prepare($query);
1732 # insert empty value to create a empty choice in cgi popup
1734 while ( my $data = $sth->fetchrow_hashref ) {
1736 push @id, $data->{'roadtypeid'};
1737 $roadtype{ $data->{'roadtypeid'} } = $data->{'road_type'};
1740 #test to know if the table contain some records if no the function return nothing
1747 return ( \@id, \%roadtype );
1753 =head2 GetTitles (OUEST-PROVENCE)
1755 ($borrowertitle)= &GetTitles();
1757 Looks up the different title . Returns array with all borrowers title
1762 my @borrowerTitle = split (/,|\|/,C4::Context->preference('BorrowersTitles'));
1763 unshift( @borrowerTitle, "" );
1764 my $count=@borrowerTitle;
1769 return ( \@borrowerTitle);
1773 =head2 GetPatronImage
1775 my ($imagedata, $dberror) = GetPatronImage($cardnumber);
1777 Returns the mimetype and binary image data of the image for the patron with the supplied cardnumber.
1781 sub GetPatronImage {
1782 my ($cardnumber) = @_;
1783 warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1784 my $dbh = C4::Context->dbh;
1785 my $query = 'SELECT mimetype, imagefile FROM patronimage WHERE cardnumber = ?';
1786 my $sth = $dbh->prepare($query);
1787 $sth->execute($cardnumber);
1788 my $imagedata = $sth->fetchrow_hashref;
1789 warn "Database error!" if $sth->errstr;
1790 return $imagedata, $sth->errstr;
1793 =head2 PutPatronImage
1795 PutPatronImage($cardnumber, $mimetype, $imgfile);
1797 Stores patron binary image data and mimetype in database.
1798 NOTE: This function is good for updating images as well as inserting new images in the database.
1802 sub PutPatronImage {
1803 my ($cardnumber, $mimetype, $imgfile) = @_;
1804 warn "Parameters passed in: Cardnumber=$cardnumber, Mimetype=$mimetype, " . ($imgfile ? "Imagefile" : "No Imagefile") if $debug;
1805 my $dbh = C4::Context->dbh;
1806 my $query = "INSERT INTO patronimage (cardnumber, mimetype, imagefile) VALUES (?,?,?) ON DUPLICATE KEY UPDATE imagefile = ?;";
1807 my $sth = $dbh->prepare($query);
1808 $sth->execute($cardnumber,$mimetype,$imgfile,$imgfile);
1809 warn "Error returned inserting $cardnumber.$mimetype." if $sth->errstr;
1810 return $sth->errstr;
1813 =head2 RmPatronImage
1815 my ($dberror) = RmPatronImage($cardnumber);
1817 Removes the image for the patron with the supplied cardnumber.
1822 my ($cardnumber) = @_;
1823 warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1824 my $dbh = C4::Context->dbh;
1825 my $query = "DELETE FROM patronimage WHERE cardnumber = ?;";
1826 my $sth = $dbh->prepare($query);
1827 $sth->execute($cardnumber);
1828 my $dberror = $sth->errstr;
1829 warn "Database error!" if $sth->errstr;
1833 =head2 GetHideLostItemsPreference
1835 $hidelostitemspref = &GetHideLostItemsPreference($borrowernumber);
1837 Returns the HideLostItems preference for the patron category of the supplied borrowernumber
1838 C<&$hidelostitemspref>return value of function, 0 or 1
1842 sub GetHideLostItemsPreference {
1843 my ($borrowernumber) = @_;
1844 my $dbh = C4::Context->dbh;
1845 my $query = "SELECT hidelostitems FROM borrowers,categories WHERE borrowers.categorycode = categories.categorycode AND borrowernumber = ?";
1846 my $sth = $dbh->prepare($query);
1847 $sth->execute($borrowernumber);
1848 my $hidelostitems = $sth->fetchrow;
1849 return $hidelostitems;
1852 =head2 GetRoadTypeDetails (OUEST-PROVENCE)
1854 ($roadtype) = &GetRoadTypeDetails($roadtypeid);
1856 Returns the description of roadtype
1857 C<&$roadtype>return description of road type
1858 C<&$roadtypeid>this is the value of roadtype s
1862 sub GetRoadTypeDetails {
1863 my ($roadtypeid) = @_;
1864 my $dbh = C4::Context->dbh;
1868 WHERE roadtypeid=?|;
1869 my $sth = $dbh->prepare($query);
1870 $sth->execute($roadtypeid);
1871 my $roadtype = $sth->fetchrow;
1875 =head2 GetBorrowersWhoHaveNotBorrowedSince
1877 &GetBorrowersWhoHaveNotBorrowedSince($date)
1879 this function get all borrowers who haven't borrowed since the date given on input arg.
1883 sub GetBorrowersWhoHaveNotBorrowedSince {
1884 my $filterdate = shift||POSIX::strftime("%Y-%m-%d",localtime());
1885 my $filterexpiry = shift;
1886 my $filterbranch = shift ||
1887 ((C4::Context->preference('IndependantBranches')
1888 && C4::Context->userenv
1889 && C4::Context->userenv->{flags} % 2 !=1
1890 && C4::Context->userenv->{branch})
1891 ? C4::Context->userenv->{branch}
1893 my $dbh = C4::Context->dbh;
1895 SELECT borrowers.borrowernumber,
1896 max(old_issues.timestamp) as latestissue,
1897 max(issues.timestamp) as currentissue
1899 JOIN categories USING (categorycode)
1900 LEFT JOIN old_issues USING (borrowernumber)
1901 LEFT JOIN issues USING (borrowernumber)
1902 WHERE category_type <> 'S'
1903 AND borrowernumber NOT IN (SELECT guarantorid FROM borrowers WHERE guarantorid IS NOT NULL AND guarantorid <> 0)
1906 if ($filterbranch && $filterbranch ne ""){
1907 $query.=" AND borrowers.branchcode= ?";
1908 push @query_params,$filterbranch;
1911 $query .= " AND dateexpiry < ? ";
1912 push @query_params,$filterdate;
1914 $query.=" GROUP BY borrowers.borrowernumber";
1916 $query.=" HAVING (latestissue < ? OR latestissue IS NULL)
1917 AND currentissue IS NULL";
1918 push @query_params,$filterdate;
1920 warn $query if $debug;
1921 my $sth = $dbh->prepare($query);
1922 if (scalar(@query_params)>0){
1923 $sth->execute(@query_params);
1930 while ( my $data = $sth->fetchrow_hashref ) {
1931 push @results, $data;
1936 =head2 GetBorrowersWhoHaveNeverBorrowed
1938 $results = &GetBorrowersWhoHaveNeverBorrowed
1940 This function get all borrowers who have never borrowed.
1942 I<$result> is a ref to an array which all elements are a hasref.
1946 sub GetBorrowersWhoHaveNeverBorrowed {
1947 my $filterbranch = shift ||
1948 ((C4::Context->preference('IndependantBranches')
1949 && C4::Context->userenv
1950 && C4::Context->userenv->{flags} % 2 !=1
1951 && C4::Context->userenv->{branch})
1952 ? C4::Context->userenv->{branch}
1954 my $dbh = C4::Context->dbh;
1956 SELECT borrowers.borrowernumber,max(timestamp) as latestissue
1958 LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
1959 WHERE issues.borrowernumber IS NULL
1962 if ($filterbranch && $filterbranch ne ""){
1963 $query.=" AND borrowers.branchcode= ?";
1964 push @query_params,$filterbranch;
1966 warn $query if $debug;
1968 my $sth = $dbh->prepare($query);
1969 if (scalar(@query_params)>0){
1970 $sth->execute(@query_params);
1977 while ( my $data = $sth->fetchrow_hashref ) {
1978 push @results, $data;
1983 =head2 GetBorrowersWithIssuesHistoryOlderThan
1985 $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
1987 this function get all borrowers who has an issue history older than I<$date> given on input arg.
1989 I<$result> is a ref to an array which all elements are a hashref.
1990 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
1994 sub GetBorrowersWithIssuesHistoryOlderThan {
1995 my $dbh = C4::Context->dbh;
1996 my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
1997 my $filterbranch = shift ||
1998 ((C4::Context->preference('IndependantBranches')
1999 && C4::Context->userenv
2000 && C4::Context->userenv->{flags} % 2 !=1
2001 && C4::Context->userenv->{branch})
2002 ? C4::Context->userenv->{branch}
2005 SELECT count(borrowernumber) as n,borrowernumber
2007 WHERE returndate < ?
2008 AND borrowernumber IS NOT NULL
2011 push @query_params, $date;
2013 $query.=" AND branchcode = ?";
2014 push @query_params, $filterbranch;
2016 $query.=" GROUP BY borrowernumber ";
2017 warn $query if $debug;
2018 my $sth = $dbh->prepare($query);
2019 $sth->execute(@query_params);
2022 while ( my $data = $sth->fetchrow_hashref ) {
2023 push @results, $data;
2028 =head2 GetBorrowersNamesAndLatestIssue
2030 $results = &GetBorrowersNamesAndLatestIssueList(@borrowernumbers)
2032 this function get borrowers Names and surnames and Issue information.
2034 I<@borrowernumbers> is an array which all elements are borrowernumbers.
2035 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2039 sub GetBorrowersNamesAndLatestIssue {
2040 my $dbh = C4::Context->dbh;
2041 my @borrowernumbers=@_;
2043 SELECT surname,lastname, phone, email,max(timestamp)
2045 LEFT JOIN issues ON borrowers.borrowernumber=issues.borrowernumber
2046 GROUP BY borrowernumber
2048 my $sth = $dbh->prepare($query);
2050 my $results = $sth->fetchall_arrayref({});
2056 my $success = DebarMember( $borrowernumber, $todate );
2058 marks a Member as debarred, and therefore unable to checkout any more
2062 true on success, false on failure
2067 my $borrowernumber = shift;
2070 return unless defined $borrowernumber;
2071 return unless $borrowernumber =~ /^\d+$/;
2074 borrowernumber => $borrowernumber,
2084 my $success = ModPrivacy( $borrowernumber, $privacy );
2086 Update the privacy of a patron.
2089 true on success, false on failure
2096 my $borrowernumber = shift;
2097 my $privacy = shift;
2098 return unless defined $borrowernumber;
2099 return unless $borrowernumber =~ /^\d+$/;
2101 return ModMember( borrowernumber => $borrowernumber,
2102 privacy => $privacy );
2107 AddMessage( $borrowernumber, $message_type, $message, $branchcode );
2109 Adds a message to the messages table for the given borrower.
2118 my ( $borrowernumber, $message_type, $message, $branchcode ) = @_;
2120 my $dbh = C4::Context->dbh;
2122 if ( ! ( $borrowernumber && $message_type && $message && $branchcode ) ) {
2126 my $query = "INSERT INTO messages ( borrowernumber, branchcode, message_type, message ) VALUES ( ?, ?, ?, ? )";
2127 my $sth = $dbh->prepare($query);
2128 $sth->execute( $borrowernumber, $branchcode, $message_type, $message );
2135 GetMessages( $borrowernumber, $type );
2137 $type is message type, B for borrower, or L for Librarian.
2138 Empty type returns all messages of any type.
2140 Returns all messages for the given borrowernumber
2145 my ( $borrowernumber, $type, $branchcode ) = @_;
2151 my $dbh = C4::Context->dbh;
2154 branches.branchname,
2157 messages.branchcode LIKE '$branchcode' AS can_delete
2158 FROM messages, branches
2159 WHERE borrowernumber = ?
2160 AND message_type LIKE ?
2161 AND messages.branchcode = branches.branchcode
2162 ORDER BY message_date DESC";
2163 my $sth = $dbh->prepare($query);
2164 $sth->execute( $borrowernumber, $type ) ;
2167 while ( my $data = $sth->fetchrow_hashref ) {
2168 my $d = C4::Dates->new( $data->{message_date}, 'iso' );
2169 $data->{message_date_formatted} = $d->output;
2170 push @results, $data;
2178 GetMessagesCount( $borrowernumber, $type );
2180 $type is message type, B for borrower, or L for Librarian.
2181 Empty type returns all messages of any type.
2183 Returns the number of messages for the given borrowernumber
2187 sub GetMessagesCount {
2188 my ( $borrowernumber, $type, $branchcode ) = @_;
2194 my $dbh = C4::Context->dbh;
2196 my $query = "SELECT COUNT(*) as MsgCount FROM messages WHERE borrowernumber = ? AND message_type LIKE ?";
2197 my $sth = $dbh->prepare($query);
2198 $sth->execute( $borrowernumber, $type ) ;
2201 my $data = $sth->fetchrow_hashref;
2202 my $count = $data->{'MsgCount'};
2209 =head2 DeleteMessage
2211 DeleteMessage( $message_id );
2216 my ( $message_id ) = @_;
2218 my $dbh = C4::Context->dbh;
2220 my $query = "DELETE FROM messages WHERE message_id = ?";
2221 my $sth = $dbh->prepare($query);
2222 $sth->execute( $message_id );
2226 END { } # module clean-up code here (global destructor)