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 format_date);
27 use String::Random qw( random_string );
28 use Date::Calc qw/Today Add_Delta_YM check_date Date_to_Days/;
29 use C4::Log; # logaction
35 use C4::SQLHelper qw(InsertInTable UpdateInTable SearchInTable);
36 use C4::Members::Attributes qw(SearchIdMatchingAttribute);
37 use C4::NewsChannels; #get slip news
39 use DateTime::Format::DateParse;
41 use Koha::Borrower::Debarments qw(IsDebarred);
42 use Text::Unaccent qw( unac_string );
43 use Koha::AuthUtils qw(hash_password);
45 our ($VERSION,@ISA,@EXPORT,@EXPORT_OK,$debug);
48 $VERSION = 3.07.00.049;
49 $debug = $ENV{DEBUG} || 0;
61 &GetMemberIssuesAndFines
68 &GetFirstValidEmailAddress
69 &GetNoticeEmailAddress
80 &GetHideLostItemsPreference
83 &GetMemberAccountRecords
84 &GetBorNotifyAcctRecord
88 GetBorrowerCategorycode
89 &GetBorrowercategoryList
91 &GetBorrowersToExpunge
92 &GetBorrowersWhoHaveNeverBorrowed
93 &GetBorrowersWithIssuesHistoryOlderThan
103 GetBorrowersWithEmail
125 &ExtendMemberSubscriptionTo
143 C4::Members - Perl Module containing convenience functions for member handling
151 This module contains routines for adding, modifying and deleting members/patrons/borrowers
157 $borrowers_result_array_ref = &Search($filter,$orderby, $limit,
158 $columns_out, $search_on_fields,$searchtype);
160 Looks up patrons (borrowers) on filter. A wrapper for SearchInTable('borrowers').
162 For C<$filter>, C<$orderby>, C<$limit>, C<&columns_out>, C<&search_on_fields> and C<&searchtype>
163 refer to C4::SQLHelper:SearchInTable().
165 Special C<$filter> key '' is effectively expanded to search on surname firstname othernamescw
166 and cardnumber unless C<&search_on_fields> is defined
170 $borrowers = Search('abcd', 'cardnumber');
172 $borrowers = Search({''=>'abcd', category_type=>'I'}, 'surname');
176 sub _express_member_find {
179 # this is used by circulation everytime a new borrowers cardnumber is scanned
180 # so we can check an exact match first, if that works return, otherwise do the rest
181 my $dbh = C4::Context->dbh;
182 my $query = "SELECT borrowernumber FROM borrowers WHERE cardnumber = ?";
183 if ( my $borrowernumber = $dbh->selectrow_array($query, undef, $filter) ) {
184 return( {"borrowernumber"=>$borrowernumber} );
187 my ($search_on_fields, $searchtype);
188 if ( length($filter) == 1 ) {
189 $search_on_fields = [ qw(surname) ];
190 $searchtype = 'start_with';
192 $search_on_fields = [ qw(surname firstname othernames cardnumber) ];
193 $searchtype = 'contain';
196 return (undef, $search_on_fields, $searchtype);
200 my ( $filter, $orderby, $limit, $columns_out, $search_on_fields, $searchtype ) = @_;
205 if ( my $fr = ref $filter ) {
206 if ( $fr eq "HASH" ) {
207 if ( my $search_string = $filter->{''} ) {
208 my ($member_filter, $member_search_on_fields, $member_searchtype) = _express_member_find($search_string);
209 if ($member_filter) {
210 $filter = $member_filter;
213 $search_on_fields ||= $member_search_on_fields;
214 $searchtype ||= $member_searchtype;
219 $search_string = $filter;
223 $search_string = $filter;
224 my ($member_filter, $member_search_on_fields, $member_searchtype) = _express_member_find($search_string);
225 if ($member_filter) {
226 $filter = $member_filter;
229 $search_on_fields ||= $member_search_on_fields;
230 $searchtype ||= $member_searchtype;
234 if ( !$found_borrower && C4::Context->preference('ExtendedPatronAttributes') && $search_string ) {
235 my $matching_records = C4::Members::Attributes::SearchIdMatchingAttribute($search_string);
236 if(scalar(@$matching_records)>0) {
237 if ( my $fr = ref $filter ) {
238 if ( $fr eq "HASH" ) {
240 $filter = [ $filter ];
242 push @$filter, { %f, "borrowernumber"=>$$matching_records };
245 push @$filter, {"borrowernumber"=>$matching_records};
249 $filter = [ $filter ];
250 push @$filter, {"borrowernumber"=>$matching_records};
255 # $showallbranches was not used at the time SearchMember() was mainstreamed into Search().
256 # Mentioning for the reference
258 if ( C4::Context->preference("IndependentBranches") ) { # && !$showallbranches){
259 if ( my $userenv = C4::Context->userenv ) {
260 my $branch = $userenv->{'branch'};
261 if ( !C4::Context->IsSuperLibrarian() && $branch ){
262 if (my $fr = ref $filter) {
263 if ( $fr eq "HASH" ) {
264 $filter->{branchcode} = $branch;
268 $_ = { '' => $_ } unless ref $_;
269 $_->{branchcode} = $branch;
274 $filter = { '' => $filter, branchcode => $branch };
280 if ($found_borrower) {
281 $searchtype = "exact";
283 $searchtype ||= "start_with";
285 return SearchInTable( "borrowers", $filter, $orderby, $limit, $columns_out, $search_on_fields, $searchtype );
288 =head2 GetMemberDetails
290 ($borrower) = &GetMemberDetails($borrowernumber, $cardnumber);
292 Looks up a patron and returns information about him or her. If
293 C<$borrowernumber> is true (nonzero), C<&GetMemberDetails> looks
294 up the borrower by number; otherwise, it looks up the borrower by card
297 C<$borrower> is a reference-to-hash whose keys are the fields of the
298 borrowers table in the Koha database. In addition,
299 C<$borrower-E<gt>{flags}> is a hash giving more detailed information
300 about the patron. Its keys act as flags :
302 if $borrower->{flags}->{LOST} {
303 # Patron's card was reported lost
306 If the state of a flag means that the patron should not be
307 allowed to borrow any more books, then it will have a C<noissues> key
310 See patronflags for more details.
312 C<$borrower-E<gt>{authflags}> is a hash giving more detailed information
313 about the top-level permissions flags set for the borrower. For example,
314 if a user has the "editcatalogue" permission,
315 C<$borrower-E<gt>{authflags}-E<gt>{editcatalogue}> will exist and have
320 sub GetMemberDetails {
321 my ( $borrowernumber, $cardnumber ) = @_;
322 my $dbh = C4::Context->dbh;
325 if ($borrowernumber) {
326 $sth = $dbh->prepare("SELECT borrowers.*,category_type,categories.description,reservefee,enrolmentperiod FROM borrowers LEFT JOIN categories ON borrowers.categorycode=categories.categorycode WHERE borrowernumber=?");
327 $sth->execute($borrowernumber);
329 elsif ($cardnumber) {
330 $sth = $dbh->prepare("SELECT borrowers.*,category_type,categories.description,reservefee,enrolmentperiod FROM borrowers LEFT JOIN categories ON borrowers.categorycode=categories.categorycode WHERE cardnumber=?");
331 $sth->execute($cardnumber);
336 my $borrower = $sth->fetchrow_hashref;
337 my ($amount) = GetMemberAccountRecords( $borrowernumber);
338 $borrower->{'amountoutstanding'} = $amount;
339 # FIXME - patronflags calls GetMemberAccountRecords... just have patronflags return $amount
340 my $flags = patronflags( $borrower);
343 $sth = $dbh->prepare("select bit,flag from userflags");
345 while ( my ( $bit, $flag ) = $sth->fetchrow ) {
346 if ( $borrower->{'flags'} && $borrower->{'flags'} & 2**$bit ) {
347 $accessflagshash->{$flag} = 1;
350 $borrower->{'flags'} = $flags;
351 $borrower->{'authflags'} = $accessflagshash;
353 # For the purposes of making templates easier, we'll define a
354 # 'showname' which is the alternate form the user's first name if
355 # 'other name' is defined.
356 if ($borrower->{category_type} eq 'I') {
357 $borrower->{'showname'} = $borrower->{'othernames'};
358 $borrower->{'showname'} .= " $borrower->{'firstname'}" if $borrower->{'firstname'};
360 $borrower->{'showname'} = $borrower->{'firstname'};
363 return ($borrower); #, $flags, $accessflagshash);
368 $flags = &patronflags($patron);
370 This function is not exported.
372 The following will be set where applicable:
373 $flags->{CHARGES}->{amount} Amount of debt
374 $flags->{CHARGES}->{noissues} Set if debt amount >$5.00 (or syspref noissuescharge)
375 $flags->{CHARGES}->{message} Message -- deprecated
377 $flags->{CREDITS}->{amount} Amount of credit
378 $flags->{CREDITS}->{message} Message -- deprecated
380 $flags->{ GNA } Patron has no valid address
381 $flags->{ GNA }->{noissues} Set for each GNA
382 $flags->{ GNA }->{message} "Borrower has no valid address" -- deprecated
384 $flags->{ LOST } Patron's card reported lost
385 $flags->{ LOST }->{noissues} Set for each LOST
386 $flags->{ LOST }->{message} Message -- deprecated
388 $flags->{DBARRED} Set if patron debarred, no access
389 $flags->{DBARRED}->{noissues} Set for each DBARRED
390 $flags->{DBARRED}->{message} Message -- deprecated
393 $flags->{ NOTES }->{message} The note itself. NOT deprecated
395 $flags->{ ODUES } Set if patron has overdue books.
396 $flags->{ ODUES }->{message} "Yes" -- deprecated
397 $flags->{ ODUES }->{itemlist} ref-to-array: list of overdue books
398 $flags->{ ODUES }->{itemlisttext} Text list of overdue items -- deprecated
400 $flags->{WAITING} Set if any of patron's reserves are available
401 $flags->{WAITING}->{message} Message -- deprecated
402 $flags->{WAITING}->{itemlist} ref-to-array: list of available items
406 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
407 overdue items. Its elements are references-to-hash, each describing an
408 overdue item. The keys are selected fields from the issues, biblio,
409 biblioitems, and items tables of the Koha database.
411 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
412 the overdue items, one per line. Deprecated.
414 =item C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
415 available items. Each element is a reference-to-hash whose keys are
416 fields from the reserves table of the Koha database.
420 All the "message" fields that include language generated in this function are deprecated,
421 because such strings belong properly in the display layer.
423 The "message" field that comes from the DB is OK.
427 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
428 # FIXME rename this function.
431 my ( $patroninformation) = @_;
432 my $dbh=C4::Context->dbh;
433 my ($balance, $owing) = GetMemberAccountBalance( $patroninformation->{'borrowernumber'});
436 my $noissuescharge = C4::Context->preference("noissuescharge") || 5;
437 $flaginfo{'message'} = sprintf 'Patron owes %.02f', $owing;
438 $flaginfo{'amount'} = sprintf "%.02f", $owing;
439 if ( $owing > $noissuescharge && !C4::Context->preference("AllowFineOverride") ) {
440 $flaginfo{'noissues'} = 1;
442 $flags{'CHARGES'} = \%flaginfo;
444 elsif ( $balance < 0 ) {
446 $flaginfo{'message'} = sprintf 'Patron has credit of %.02f', -$balance;
447 $flaginfo{'amount'} = sprintf "%.02f", $balance;
448 $flags{'CREDITS'} = \%flaginfo;
450 if ( $patroninformation->{'gonenoaddress'}
451 && $patroninformation->{'gonenoaddress'} == 1 )
454 $flaginfo{'message'} = 'Borrower has no valid address.';
455 $flaginfo{'noissues'} = 1;
456 $flags{'GNA'} = \%flaginfo;
458 if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
460 $flaginfo{'message'} = 'Borrower\'s card reported lost.';
461 $flaginfo{'noissues'} = 1;
462 $flags{'LOST'} = \%flaginfo;
464 if ( $patroninformation->{'debarred'} && check_date( split( /-/, $patroninformation->{'debarred'} ) ) ) {
465 if ( Date_to_Days(Date::Calc::Today) < Date_to_Days( split( /-/, $patroninformation->{'debarred'} ) ) ) {
467 $flaginfo{'debarredcomment'} = $patroninformation->{'debarredcomment'};
468 $flaginfo{'message'} = $patroninformation->{'debarredcomment'};
469 $flaginfo{'noissues'} = 1;
470 $flaginfo{'dateend'} = $patroninformation->{'debarred'};
471 $flags{'DBARRED'} = \%flaginfo;
474 if ( $patroninformation->{'borrowernotes'}
475 && $patroninformation->{'borrowernotes'} )
478 $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
479 $flags{'NOTES'} = \%flaginfo;
481 my ( $odues, $itemsoverdue ) = C4::Overdues::checkoverdues($patroninformation->{'borrowernumber'});
482 if ( $odues && $odues > 0 ) {
484 $flaginfo{'message'} = "Yes";
485 $flaginfo{'itemlist'} = $itemsoverdue;
486 foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
489 $flaginfo{'itemlisttext'} .=
490 "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n"; # newline is display layer
492 $flags{'ODUES'} = \%flaginfo;
494 my @itemswaiting = C4::Reserves::GetReservesFromBorrowernumber( $patroninformation->{'borrowernumber'},'W' );
495 my $nowaiting = scalar @itemswaiting;
496 if ( $nowaiting > 0 ) {
498 $flaginfo{'message'} = "Reserved items available";
499 $flaginfo{'itemlist'} = \@itemswaiting;
500 $flags{'WAITING'} = \%flaginfo;
508 $borrower = &GetMember(%information);
510 Retrieve the first patron record meeting on criteria listed in the
511 C<%information> hash, which should contain one or more
512 pairs of borrowers column names and values, e.g.,
514 $borrower = GetMember(borrowernumber => id);
516 C<&GetBorrower> returns a reference-to-hash whose keys are the fields of
517 the C<borrowers> table in the Koha database.
519 FIXME: GetMember() is used throughout the code as a lookup
520 on a unique key such as the borrowernumber, but this meaning is not
521 enforced in the routine itself.
527 my ( %information ) = @_;
528 if (exists $information{borrowernumber} && !defined $information{borrowernumber}) {
529 #passing mysql's kohaadmin?? Makes no sense as a query
532 my $dbh = C4::Context->dbh;
534 q{SELECT borrowers.*, categories.category_type, categories.description
536 LEFT JOIN categories on borrowers.categorycode=categories.categorycode WHERE };
539 for (keys %information ) {
547 if (defined $information{$_}) {
549 push @values, $information{$_};
552 $select .= "$_ IS NULL";
555 $debug && warn $select, " ",values %information;
556 my $sth = $dbh->prepare("$select");
557 $sth->execute(map{$information{$_}} keys %information);
558 my $data = $sth->fetchall_arrayref({});
559 #FIXME interface to this routine now allows generation of a result set
560 #so whole array should be returned but bowhere in the current code expects this
568 =head2 GetMemberRelatives
570 @borrowernumbers = GetMemberRelatives($borrowernumber);
572 C<GetMemberRelatives> returns a borrowersnumber's list of guarantor/guarantees of the member given in parameter
575 sub GetMemberRelatives {
576 my $borrowernumber = shift;
577 my $dbh = C4::Context->dbh;
581 my $query = "SELECT guarantorid FROM borrowers WHERE borrowernumber=?";
582 my $sth = $dbh->prepare($query);
583 $sth->execute($borrowernumber);
584 my $data = $sth->fetchrow_arrayref();
585 push @glist, $data->[0] if $data->[0];
586 my $guarantor = $data->[0] ? $data->[0] : undef;
589 $query = "SELECT borrowernumber FROM borrowers WHERE guarantorid=?";
590 $sth = $dbh->prepare($query);
591 $sth->execute($borrowernumber);
592 while ($data = $sth->fetchrow_arrayref()) {
593 push @glist, $data->[0];
596 # Getting sibling guarantees
598 $query = "SELECT borrowernumber FROM borrowers WHERE guarantorid=?";
599 $sth = $dbh->prepare($query);
600 $sth->execute($guarantor);
601 while ($data = $sth->fetchrow_arrayref()) {
602 push @glist, $data->[0] if ($data->[0] != $borrowernumber);
609 =head2 IsMemberBlocked
611 my ($block_status, $count) = IsMemberBlocked( $borrowernumber );
613 Returns whether a patron has overdue items that may result
614 in a block or whether the patron has active fine days
615 that would block circulation privileges.
617 C<$block_status> can have the following values:
619 1 if the patron has outstanding fine days, in which case C<$count> is the number of them
621 -1 if the patron has overdue items, in which case C<$count> is the number of them
623 0 if the patron has no overdue items or outstanding fine days, in which case C<$count> is 0
625 Outstanding fine days are checked before current overdue items
628 FIXME: this needs to be split into two functions; a potential block
629 based on the number of current overdue items could be orthogonal
630 to a block based on whether the patron has any fine days accrued.
634 sub IsMemberBlocked {
635 my $borrowernumber = shift;
636 my $dbh = C4::Context->dbh;
638 my $blockeddate = Koha::Borrower::Debarments::IsDebarred($borrowernumber);
640 return ( 1, $blockeddate ) if $blockeddate;
642 # if he have late issues
643 my $sth = $dbh->prepare(
644 "SELECT COUNT(*) as latedocs
646 WHERE borrowernumber = ?
647 AND date_due < now()"
649 $sth->execute($borrowernumber);
650 my $latedocs = $sth->fetchrow_hashref->{'latedocs'};
652 return ( -1, $latedocs ) if $latedocs > 0;
657 =head2 GetMemberIssuesAndFines
659 ($overdue_count, $issue_count, $total_fines) = &GetMemberIssuesAndFines($borrowernumber);
661 Returns aggregate data about items borrowed by the patron with the
662 given borrowernumber.
664 C<&GetMemberIssuesAndFines> returns a three-element array. C<$overdue_count> is the
665 number of overdue items the patron currently has borrowed. C<$issue_count> is the
666 number of books the patron currently has borrowed. C<$total_fines> is
667 the total fine currently due by the borrower.
672 sub GetMemberIssuesAndFines {
673 my ( $borrowernumber ) = @_;
674 my $dbh = C4::Context->dbh;
675 my $query = "SELECT COUNT(*) FROM issues WHERE borrowernumber = ?";
677 $debug and warn $query."\n";
678 my $sth = $dbh->prepare($query);
679 $sth->execute($borrowernumber);
680 my $issue_count = $sth->fetchrow_arrayref->[0];
682 $sth = $dbh->prepare(
683 "SELECT COUNT(*) FROM issues
684 WHERE borrowernumber = ?
685 AND date_due < now()"
687 $sth->execute($borrowernumber);
688 my $overdue_count = $sth->fetchrow_arrayref->[0];
690 $sth = $dbh->prepare("SELECT SUM(amountoutstanding) FROM accountlines WHERE borrowernumber = ?");
691 $sth->execute($borrowernumber);
692 my $total_fines = $sth->fetchrow_arrayref->[0];
694 return ($overdue_count, $issue_count, $total_fines);
700 my @columns = C4::Member::columns();
702 Returns an array of borrowers' table columns on success,
703 and an empty array on failure.
709 # Pure ANSI SQL goodness.
710 my $sql = 'SELECT * FROM borrowers WHERE 1=0;';
712 # Get the database handle.
713 my $dbh = C4::Context->dbh;
715 # Run the SQL statement to load STH's readonly properties.
716 my $sth = $dbh->prepare($sql);
717 my $rv = $sth->execute();
719 # This only fails if the table doesn't exist.
720 # This will always be called AFTER an install or upgrade,
721 # so borrowers will exist!
723 if ($sth->{NUM_OF_FIELDS}>0) {
724 @data = @{$sth->{NAME}};
735 my $success = ModMember(borrowernumber => $borrowernumber,
736 [ field => value ]... );
738 Modify borrower's data. All date fields should ALREADY be in ISO format.
741 true on success, or false on failure
747 # test to know if you must update or not the borrower password
748 if (exists $data{password}) {
749 if ($data{password} eq '****' or $data{password} eq '') {
750 delete $data{password};
752 $data{password} = hash_password($data{password});
755 my $old_categorycode = GetBorrowerCategorycode( $data{borrowernumber} );
756 my $execute_success=UpdateInTable("borrowers",\%data);
757 if ($execute_success) { # only proceed if the update was a success
758 # ok if its an adult (type) it may have borrowers that depend on it as a guarantor
759 # so when we update information for an adult we should check for guarantees and update the relevant part
760 # of their records, ie addresses and phone numbers
761 my $borrowercategory= GetBorrowercategory( $data{'category_type'} );
762 if ( exists $borrowercategory->{'category_type'} && $borrowercategory->{'category_type'} eq ('A' || 'S') ) {
763 # is adult check guarantees;
764 UpdateGuarantees(%data);
767 # If the patron changes to a category with enrollment fee, we add a fee
768 if ( $data{categorycode} and $data{categorycode} ne $old_categorycode ) {
769 AddEnrolmentFeeIfNeeded( $data{categorycode}, $data{borrowernumber} );
772 logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "UPDATE (executed w/ arg: $data{'borrowernumber'})") if C4::Context->preference("BorrowersLog");
774 return $execute_success;
779 $borrowernumber = &AddMember(%borrower);
781 insert new borrower into table
782 Returns the borrowernumber upon success
784 Returns as undef upon any db error without further processing
791 my $dbh = C4::Context->dbh;
793 # generate a proper login if none provided
794 $data{'userid'} = Generate_Userid($data{'borrowernumber'}, $data{'firstname'}, $data{'surname'}) if $data{'userid'} eq '';
796 # add expiration date if it isn't already there
797 unless ( $data{'dateexpiry'} ) {
798 $data{'dateexpiry'} = GetExpiryDate( $data{'categorycode'}, C4::Dates->new()->output("iso") );
801 # add enrollment date if it isn't already there
802 unless ( $data{'dateenrolled'} ) {
803 $data{'dateenrolled'} = C4::Dates->new()->output("iso");
806 # create a disabled account if no password provided
807 $data{'password'} = ($data{'password'})? hash_password($data{'password'}) : '!';
808 $data{'borrowernumber'}=InsertInTable("borrowers",\%data);
810 # mysql_insertid is probably bad. not necessarily accurate and mysql-specific at best.
811 logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
813 AddEnrolmentFeeIfNeeded( $data{categorycode}, $data{borrowernumber} );
815 return $data{'borrowernumber'};
820 my $uniqueness = Check_Userid($userid,$borrowernumber);
822 $borrowernumber is optional (i.e. it can contain a blank value). If $userid is passed with a blank $borrowernumber variable, the database will be checked for all instances of that userid (i.e. userid=? AND borrowernumber != '').
824 If $borrowernumber is provided, the database will be checked for every instance of that userid coupled with a different borrower(number) than the one provided.
827 0 for not unique (i.e. this $userid already exists)
828 1 for unique (i.e. this $userid does not exist, or this $userid/$borrowernumber combination already exists)
833 my ($uid,$member) = @_;
834 my $dbh = C4::Context->dbh;
837 "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
838 $sth->execute( $uid, $member );
839 if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
847 =head2 Generate_Userid
849 my $newuid = Generate_Userid($borrowernumber, $firstname, $surname);
851 Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
853 $borrowernumber is optional (i.e. it can contain a blank value). A value is passed when generating a new userid for an existing borrower. When a new userid is created for a new borrower, a blank value is passed to this sub.
856 new userid ($firstname.$surname if there is a $firstname, or $surname if there is no value in $firstname) plus offset (0 if the $newuid is unique, or a higher numeric value if Check_Userid finds an existing match for the $newuid in the database).
860 sub Generate_Userid {
861 my ($borrowernumber, $firstname, $surname) = @_;
864 #The script will "do" the following code and increment the $offset until Check_Userid = 1 (i.e. until $newuid comes back as unique)
866 $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
867 $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
868 $newuid = lc(($firstname)? "$firstname.$surname" : $surname);
869 $newuid = unac_string('utf-8',$newuid);
870 $newuid .= $offset unless $offset == 0;
873 } while (!Check_Userid($newuid,$borrowernumber));
879 my ( $uid, $member, $digest ) = @_;
880 my $dbh = C4::Context->dbh;
882 #Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
883 #Then we need to tell the user and have them create a new one.
887 "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
888 $sth->execute( $uid, $member );
889 if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
893 #Everything is good so we can update the information.
896 "update borrowers set userid=?, password=? where borrowernumber=?");
897 $sth->execute( $uid, $digest, $member );
901 logaction("MEMBERS", "CHANGE PASS", $member, "") if C4::Context->preference("BorrowersLog");
907 =head2 fixup_cardnumber
909 Warning: The caller is responsible for locking the members table in write
910 mode, to avoid database corruption.
914 use vars qw( @weightings );
915 my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
917 sub fixup_cardnumber {
918 my ($cardnumber) = @_;
919 my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;
921 # Find out whether member numbers should be generated
922 # automatically. Should be either "1" or something else.
923 # Defaults to "0", which is interpreted as "no".
925 # if ($cardnumber !~ /\S/ && $autonumber_members) {
926 ($autonumber_members) or return $cardnumber;
927 my $checkdigit = C4::Context->preference('checkdigit');
928 my $dbh = C4::Context->dbh;
929 if ( $checkdigit and $checkdigit eq 'katipo' ) {
931 # if checkdigit is selected, calculate katipo-style cardnumber.
932 # otherwise, just use the max()
933 # purpose: generate checksum'd member numbers.
934 # We'll assume we just got the max value of digits 2-8 of member #'s
935 # from the database and our job is to increment that by one,
936 # determine the 1st and 9th digits and return the full string.
937 my $sth = $dbh->prepare(
938 "select max(substring(borrowers.cardnumber,2,7)) as new_num from borrowers"
941 my $data = $sth->fetchrow_hashref;
942 $cardnumber = $data->{new_num};
943 if ( !$cardnumber ) { # If DB has no values,
944 $cardnumber = 1000000; # start at 1000000
950 for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
951 # read weightings, left to right, 1 char at a time
952 my $temp1 = $weightings[$i];
954 # sequence left to right, 1 char at a time
955 my $temp2 = substr( $cardnumber, $i, 1 );
957 # mult each char 1-7 by its corresponding weighting
958 $sum += $temp1 * $temp2;
961 my $rem = ( $sum % 11 );
962 $rem = 'X' if $rem == 10;
964 return "V$cardnumber$rem";
967 my $sth = $dbh->prepare(
968 'SELECT MAX( CAST( cardnumber AS SIGNED ) ) FROM borrowers WHERE cardnumber REGEXP "^-?[0-9]+$"'
971 my ($result) = $sth->fetchrow;
974 return $cardnumber; # just here as a fallback/reminder
979 ($num_children, $children_arrayref) = &GetGuarantees($parent_borrno);
980 $child0_cardno = $children_arrayref->[0]{"cardnumber"};
981 $child0_borrno = $children_arrayref->[0]{"borrowernumber"};
983 C<&GetGuarantees> takes a borrower number (e.g., that of a patron
984 with children) and looks up the borrowers who are guaranteed by that
985 borrower (i.e., the patron's children).
987 C<&GetGuarantees> returns two values: an integer giving the number of
988 borrowers guaranteed by C<$parent_borrno>, and a reference to an array
989 of references to hash, which gives the actual results.
995 my ($borrowernumber) = @_;
996 my $dbh = C4::Context->dbh;
999 "select cardnumber,borrowernumber, firstname, surname from borrowers where guarantorid=?"
1001 $sth->execute($borrowernumber);
1004 my $data = $sth->fetchall_arrayref({});
1005 return ( scalar(@$data), $data );
1008 =head2 UpdateGuarantees
1010 &UpdateGuarantees($parent_borrno);
1013 C<&UpdateGuarantees> borrower data for an adult and updates all the guarantees
1014 with the modified information
1019 sub UpdateGuarantees {
1021 my $dbh = C4::Context->dbh;
1022 my ( $count, $guarantees ) = GetGuarantees( $data{'borrowernumber'} );
1023 foreach my $guarantee (@$guarantees){
1024 my $guaquery = qq|UPDATE borrowers
1025 SET address=?,fax=?,B_city=?,mobile=?,city=?,phone=?
1026 WHERE borrowernumber=?
1028 my $sth = $dbh->prepare($guaquery);
1029 $sth->execute($data{'address'},$data{'fax'},$data{'B_city'},$data{'mobile'},$data{'city'},$data{'phone'},$guarantee->{'borrowernumber'});
1032 =head2 GetPendingIssues
1034 my $issues = &GetPendingIssues(@borrowernumber);
1036 Looks up what the patron with the given borrowernumber has borrowed.
1038 C<&GetPendingIssues> returns a
1039 reference-to-array where each element is a reference-to-hash; the
1040 keys are the fields from the C<issues>, C<biblio>, and C<items> tables.
1041 The keys include C<biblioitems> fields except marc and marcxml.
1046 sub GetPendingIssues {
1047 my @borrowernumbers = @_;
1049 unless (@borrowernumbers ) { # return a ref_to_array
1050 return \@borrowernumbers; # to not cause surprise to caller
1053 # Borrowers part of the query
1055 for (my $i = 0; $i < @borrowernumbers; $i++) {
1056 $bquery .= ' issues.borrowernumber = ?';
1057 if ($i < $#borrowernumbers ) {
1062 # must avoid biblioitems.* to prevent large marc and marcxml fields from killing performance
1063 # FIXME: namespace collision: each table has "timestamp" fields. Which one is "timestamp" ?
1064 # FIXME: circ/ciculation.pl tries to sort by timestamp!
1065 # FIXME: namespace collision: other collisions possible.
1066 # FIXME: most of this data isn't really being used by callers.
1073 biblioitems.itemtype,
1076 biblioitems.publicationyear,
1077 biblioitems.publishercode,
1078 biblioitems.volumedate,
1079 biblioitems.volumedesc,
1082 borrowers.firstname,
1084 borrowers.cardnumber,
1085 issues.timestamp AS timestamp,
1086 issues.renewals AS renewals,
1087 issues.borrowernumber AS borrowernumber,
1088 items.renewals AS totalrenewals
1090 LEFT JOIN items ON items.itemnumber = issues.itemnumber
1091 LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
1092 LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
1093 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
1096 ORDER BY issues.issuedate"
1099 my $sth = C4::Context->dbh->prepare($query);
1100 $sth->execute(@borrowernumbers);
1101 my $data = $sth->fetchall_arrayref({});
1102 my $tz = C4::Context->tz();
1103 my $today = DateTime->now( time_zone => $tz);
1104 foreach (@{$data}) {
1105 if ($_->{issuedate}) {
1106 $_->{issuedate} = dt_from_string($_->{issuedate}, 'sql');
1108 $_->{date_due} or next;
1109 $_->{date_due} = DateTime::Format::DateParse->parse_datetime($_->{date_due}, $tz->name());
1110 if ( DateTime->compare($_->{date_due}, $today) == -1 ) {
1119 $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
1121 Looks up what the patron with the given borrowernumber has borrowed,
1122 and sorts the results.
1124 C<$sortkey> is the name of a field on which to sort the results. This
1125 should be the name of a field in the C<issues>, C<biblio>,
1126 C<biblioitems>, or C<items> table in the Koha database.
1128 C<$limit> is the maximum number of results to return.
1130 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
1131 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
1132 C<items> tables of the Koha database.
1138 my ( $borrowernumber, $order, $limit ) = @_;
1140 my $dbh = C4::Context->dbh;
1142 'SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1144 LEFT JOIN items on items.itemnumber=issues.itemnumber
1145 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1146 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1147 WHERE borrowernumber=?
1149 SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1151 LEFT JOIN items on items.itemnumber=old_issues.itemnumber
1152 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1153 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1154 WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL
1155 order by ' . $order;
1157 $query .= " limit $limit";
1160 my $sth = $dbh->prepare($query);
1161 $sth->execute( $borrowernumber, $borrowernumber );
1162 return $sth->fetchall_arrayref( {} );
1166 =head2 GetMemberAccountRecords
1168 ($total, $acctlines, $count) = &GetMemberAccountRecords($borrowernumber);
1170 Looks up accounting data for the patron with the given borrowernumber.
1172 C<&GetMemberAccountRecords> returns a three-element array. C<$acctlines> is a
1173 reference-to-array, where each element is a reference-to-hash; the
1174 keys are the fields of the C<accountlines> table in the Koha database.
1175 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1176 total amount outstanding for all of the account lines.
1180 sub GetMemberAccountRecords {
1181 my ($borrowernumber) = @_;
1182 my $dbh = C4::Context->dbh;
1188 WHERE borrowernumber=?);
1189 $strsth.=" ORDER BY date desc,timestamp DESC";
1190 my $sth= $dbh->prepare( $strsth );
1191 $sth->execute( $borrowernumber );
1194 while ( my $data = $sth->fetchrow_hashref ) {
1195 if ( $data->{itemnumber} ) {
1196 my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
1197 $data->{biblionumber} = $biblio->{biblionumber};
1198 $data->{title} = $biblio->{title};
1200 $acctlines[$numlines] = $data;
1202 $total += int(1000 * $data->{'amountoutstanding'}); # convert float to integer to avoid round-off errors
1205 return ( $total, \@acctlines,$numlines);
1208 =head2 GetMemberAccountBalance
1210 ($total_balance, $non_issue_balance, $other_charges) = &GetMemberAccountBalance($borrowernumber);
1212 Calculates amount immediately owing by the patron - non-issue charges.
1213 Based on GetMemberAccountRecords.
1214 Charges exempt from non-issue are:
1216 * Rent (rental) if RentalsInNoissuesCharge syspref is set to false
1217 * Manual invoices if ManInvInNoissuesCharge syspref is set to false
1221 sub GetMemberAccountBalance {
1222 my ($borrowernumber) = @_;
1224 my $ACCOUNT_TYPE_LENGTH = 5; # this is plain ridiculous...
1226 my @not_fines = ('Res');
1227 push @not_fines, 'Rent' unless C4::Context->preference('RentalsInNoissuesCharge');
1228 unless ( C4::Context->preference('ManInvInNoissuesCharge') ) {
1229 my $dbh = C4::Context->dbh;
1230 my $man_inv_types = $dbh->selectcol_arrayref(qq{SELECT authorised_value FROM authorised_values WHERE category = 'MANUAL_INV'});
1231 push @not_fines, map substr($_, 0, $ACCOUNT_TYPE_LENGTH), @$man_inv_types;
1233 my %not_fine = map {$_ => 1} @not_fines;
1235 my ($total, $acctlines) = GetMemberAccountRecords($borrowernumber);
1236 my $other_charges = 0;
1237 foreach (@$acctlines) {
1238 $other_charges += $_->{amountoutstanding} if $not_fine{ substr($_->{accounttype}, 0, $ACCOUNT_TYPE_LENGTH) };
1241 return ( $total, $total - $other_charges, $other_charges);
1244 =head2 GetBorNotifyAcctRecord
1246 ($total, $acctlines, $count) = &GetBorNotifyAcctRecord($params,$notifyid);
1248 Looks up accounting data for the patron with the given borrowernumber per file number.
1250 C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a
1251 reference-to-array, where each element is a reference-to-hash; the
1252 keys are the fields of the C<accountlines> table in the Koha database.
1253 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1254 total amount outstanding for all of the account lines.
1258 sub GetBorNotifyAcctRecord {
1259 my ( $borrowernumber, $notifyid ) = @_;
1260 my $dbh = C4::Context->dbh;
1263 my $sth = $dbh->prepare(
1266 WHERE borrowernumber=?
1268 AND amountoutstanding != '0'
1269 ORDER BY notify_id,accounttype
1272 $sth->execute( $borrowernumber, $notifyid );
1274 while ( my $data = $sth->fetchrow_hashref ) {
1275 if ( $data->{itemnumber} ) {
1276 my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
1277 $data->{biblionumber} = $biblio->{biblionumber};
1278 $data->{title} = $biblio->{title};
1280 $acctlines[$numlines] = $data;
1282 $total += int(100 * $data->{'amountoutstanding'});
1285 return ( $total, \@acctlines, $numlines );
1288 =head2 checkuniquemember (OUEST-PROVENCE)
1290 ($result,$categorycode) = &checkuniquemember($collectivity,$surname,$firstname,$dateofbirth);
1292 Checks that a member exists or not in the database.
1294 C<&result> is nonzero (=exist) or 0 (=does not exist)
1295 C<&categorycode> is from categorycode table
1296 C<&collectivity> is 1 (= we add a collectivity) or 0 (= we add a physical member)
1297 C<&surname> is the surname
1298 C<&firstname> is the firstname (only if collectivity=0)
1299 C<&dateofbirth> is the date of birth in ISO format (only if collectivity=0)
1303 # FIXME: This function is not legitimate. Multiple patrons might have the same first/last name and birthdate.
1304 # This is especially true since first name is not even a required field.
1306 sub checkuniquemember {
1307 my ( $collectivity, $surname, $firstname, $dateofbirth ) = @_;
1308 my $dbh = C4::Context->dbh;
1309 my $request = ($collectivity) ?
1310 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? " :
1312 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=? and dateofbirth=?" :
1313 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=?";
1314 my $sth = $dbh->prepare($request);
1315 if ($collectivity) {
1316 $sth->execute( uc($surname) );
1317 } elsif($dateofbirth){
1318 $sth->execute( uc($surname), ucfirst($firstname), $dateofbirth );
1320 $sth->execute( uc($surname), ucfirst($firstname));
1322 my @data = $sth->fetchrow;
1323 ( $data[0] ) and return $data[0], $data[1];
1327 sub checkcardnumber {
1328 my ( $cardnumber, $borrowernumber ) = @_;
1330 # If cardnumber is null, we assume they're allowed.
1331 return 0 unless defined $cardnumber;
1333 my $dbh = C4::Context->dbh;
1334 my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
1335 $query .= " AND borrowernumber <> ?" if ($borrowernumber);
1336 my $sth = $dbh->prepare($query);
1339 ( $borrowernumber ? $borrowernumber : () )
1342 return 1 if $sth->fetchrow_hashref;
1344 my ( $min_length, $max_length ) = get_cardnumber_length();
1346 if length $cardnumber > $max_length
1347 or length $cardnumber < $min_length;
1352 sub get_cardnumber_length {
1353 my ( $min, $max ) = ( 1, 16 ); # borrowers.cardnumber is a varchar(16)
1354 if ( my $cardnumber_length = C4::Context->preference('CardnumberLength') ) {
1355 # Is integer and length match
1356 if ( $cardnumber_length =~ m|^\d+$| ) {
1357 $min = $max = $cardnumber_length
1358 if $cardnumber_length >= $min
1359 and $cardnumber_length <= $max;
1361 # Else assuming it is a range
1362 elsif ( $cardnumber_length =~ m|(\d*),(\d*)| ) {
1363 $min = $1 if $1 and $min < $1;
1364 $max = $2 if $2 and $max > $2;
1368 return ( $min, $max );
1371 =head2 getzipnamecity (OUEST-PROVENCE)
1373 take all info from table city for the fields city and zip
1374 check for the name and the zip code of the city selected
1378 sub getzipnamecity {
1380 my $dbh = C4::Context->dbh;
1383 "select city_name,city_state,city_zipcode,city_country from cities where cityid=? ");
1384 $sth->execute($cityid);
1385 my @data = $sth->fetchrow;
1386 return $data[0], $data[1], $data[2], $data[3];
1390 =head2 getdcity (OUEST-PROVENCE)
1392 recover cityid with city_name condition
1397 my ($city_name) = @_;
1398 my $dbh = C4::Context->dbh;
1399 my $sth = $dbh->prepare("select cityid from cities where city_name=? ");
1400 $sth->execute($city_name);
1401 my $data = $sth->fetchrow;
1405 =head2 GetFirstValidEmailAddress
1407 $email = GetFirstValidEmailAddress($borrowernumber);
1409 Return the first valid email address for a borrower, given the borrowernumber. For now, the order
1410 is defined as email, emailpro, B_email. Returns the empty string if the borrower has no email
1415 sub GetFirstValidEmailAddress {
1416 my $borrowernumber = shift;
1417 my $dbh = C4::Context->dbh;
1418 my $sth = $dbh->prepare( "SELECT email, emailpro, B_email FROM borrowers where borrowernumber = ? ");
1419 $sth->execute( $borrowernumber );
1420 my $data = $sth->fetchrow_hashref;
1422 if ($data->{'email'}) {
1423 return $data->{'email'};
1424 } elsif ($data->{'emailpro'}) {
1425 return $data->{'emailpro'};
1426 } elsif ($data->{'B_email'}) {
1427 return $data->{'B_email'};
1433 =head2 GetNoticeEmailAddress
1435 $email = GetNoticeEmailAddress($borrowernumber);
1437 Return the email address of borrower used for notices, given the borrowernumber.
1438 Returns the empty string if no email address.
1442 sub GetNoticeEmailAddress {
1443 my $borrowernumber = shift;
1445 my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
1446 # if syspref is set to 'first valid' (value == OFF), look up email address
1447 if ( $which_address eq 'OFF' ) {
1448 return GetFirstValidEmailAddress($borrowernumber);
1450 # specified email address field
1451 my $dbh = C4::Context->dbh;
1452 my $sth = $dbh->prepare( qq{
1453 SELECT $which_address AS primaryemail
1455 WHERE borrowernumber=?
1457 $sth->execute($borrowernumber);
1458 my $data = $sth->fetchrow_hashref;
1459 return $data->{'primaryemail'} || '';
1462 =head2 GetExpiryDate
1464 $expirydate = GetExpiryDate($categorycode, $dateenrolled);
1466 Calculate expiry date given a categorycode and starting date. Date argument must be in ISO format.
1467 Return date is also in ISO format.
1472 my ( $categorycode, $dateenrolled ) = @_;
1474 if ($categorycode) {
1475 my $dbh = C4::Context->dbh;
1476 my $sth = $dbh->prepare("SELECT enrolmentperiod,enrolmentperioddate FROM categories WHERE categorycode=?");
1477 $sth->execute($categorycode);
1478 $enrolments = $sth->fetchrow_hashref;
1480 # die "GetExpiryDate: for enrollmentperiod $enrolmentperiod (category '$categorycode') starting $dateenrolled.\n";
1481 my @date = split (/-/,$dateenrolled);
1482 if($enrolments->{enrolmentperiod}){
1483 return sprintf("%04d-%02d-%02d", Add_Delta_YM(@date,0,$enrolments->{enrolmentperiod}));
1485 return $enrolments->{enrolmentperioddate};
1489 =head2 GetborCatFromCatType
1491 ($codes_arrayref, $labels_hashref) = &GetborCatFromCatType();
1493 Looks up the different types of borrowers in the database. Returns two
1494 elements: a reference-to-array, which lists the borrower category
1495 codes, and a reference-to-hash, which maps the borrower category codes
1496 to category descriptions.
1501 sub GetborCatFromCatType {
1502 my ( $category_type, $action, $no_branch_limit ) = @_;
1504 my $branch_limit = $no_branch_limit
1506 : C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1508 # FIXME - This API seems both limited and dangerous.
1509 my $dbh = C4::Context->dbh;
1512 SELECT categories.categorycode, categories.description
1516 LEFT JOIN categories_branches ON categories.categorycode = categories_branches.categorycode
1519 $request .= " $action ";
1520 $request .= " AND (branchcode = ? OR branchcode IS NULL) GROUP BY description" if $branch_limit;
1522 $request .= " WHERE branchcode = ? OR branchcode IS NULL GROUP BY description" if $branch_limit;
1524 $request .= " ORDER BY categorycode";
1526 my $sth = $dbh->prepare($request);
1528 $action ? $category_type : (),
1529 $branch_limit ? $branch_limit : ()
1535 while ( my $data = $sth->fetchrow_hashref ) {
1536 push @codes, $data->{'categorycode'};
1537 $labels{ $data->{'categorycode'} } = $data->{'description'};
1540 return ( \@codes, \%labels );
1543 =head2 GetBorrowercategory
1545 $hashref = &GetBorrowercategory($categorycode);
1547 Given the borrower's category code, the function returns the corresponding
1548 data hashref for a comprehensive information display.
1552 sub GetBorrowercategory {
1554 my $dbh = C4::Context->dbh;
1558 "SELECT description,dateofbirthrequired,upperagelimit,category_type
1560 WHERE categorycode = ?"
1562 $sth->execute($catcode);
1564 $sth->fetchrow_hashref;
1568 } # sub getborrowercategory
1571 =head2 GetBorrowerCategorycode
1573 $categorycode = &GetBorrowerCategoryCode( $borrowernumber );
1575 Given the borrowernumber, the function returns the corresponding categorycode
1578 sub GetBorrowerCategorycode {
1579 my ( $borrowernumber ) = @_;
1580 my $dbh = C4::Context->dbh;
1581 my $sth = $dbh->prepare( qq{
1584 WHERE borrowernumber = ?
1586 $sth->execute( $borrowernumber );
1587 return $sth->fetchrow;
1590 =head2 GetBorrowercategoryList
1592 $arrayref_hashref = &GetBorrowercategoryList;
1593 If no category code provided, the function returns all the categories.
1597 sub GetBorrowercategoryList {
1598 my $no_branch_limit = @_ ? shift : 0;
1599 my $branch_limit = $no_branch_limit
1601 : C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1602 my $dbh = C4::Context->dbh;
1603 my $query = "SELECT categories.* FROM categories";
1605 LEFT JOIN categories_branches ON categories.categorycode = categories_branches.categorycode
1606 WHERE branchcode = ? OR branchcode IS NULL GROUP BY description
1608 $query .= " ORDER BY description";
1609 my $sth = $dbh->prepare( $query );
1610 $sth->execute( $branch_limit ? $branch_limit : () );
1611 my $data = $sth->fetchall_arrayref( {} );
1614 } # sub getborrowercategory
1616 =head2 ethnicitycategories
1618 ($codes_arrayref, $labels_hashref) = ðnicitycategories();
1620 Looks up the different ethnic types in the database. Returns two
1621 elements: a reference-to-array, which lists the ethnicity codes, and a
1622 reference-to-hash, which maps the ethnicity codes to ethnicity
1629 sub ethnicitycategories {
1630 my $dbh = C4::Context->dbh;
1631 my $sth = $dbh->prepare("Select code,name from ethnicity order by name");
1635 while ( my $data = $sth->fetchrow_hashref ) {
1636 push @codes, $data->{'code'};
1637 $labels{ $data->{'code'} } = $data->{'name'};
1639 return ( \@codes, \%labels );
1644 $ethn_name = &fixEthnicity($ethn_code);
1646 Takes an ethnicity code (e.g., "european" or "pi") and returns the
1647 corresponding descriptive name from the C<ethnicity> table in the
1648 Koha database ("European" or "Pacific Islander").
1655 my $ethnicity = shift;
1656 return unless $ethnicity;
1657 my $dbh = C4::Context->dbh;
1658 my $sth = $dbh->prepare("Select name from ethnicity where code = ?");
1659 $sth->execute($ethnicity);
1660 my $data = $sth->fetchrow_hashref;
1661 return $data->{'name'};
1662 } # sub fixEthnicity
1666 $dateofbirth,$date = &GetAge($date);
1668 this function return the borrowers age with the value of dateofbirth
1674 my ( $date, $date_ref ) = @_;
1676 if ( not defined $date_ref ) {
1677 $date_ref = sprintf( '%04d-%02d-%02d', Today() );
1680 my ( $year1, $month1, $day1 ) = split /-/, $date;
1681 my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
1683 my $age = $year2 - $year1;
1684 if ( $month1 . $day1 > $month2 . $day2 ) {
1693 $cityarrayref = GetCities();
1695 Returns an array_ref of the entries in the cities table
1696 If there are entries in the table an empty row is returned
1697 This is currently only used to populate a popup in memberentry
1703 my $dbh = C4::Context->dbh;
1704 my $city_arr = $dbh->selectall_arrayref(
1705 q|SELECT cityid,city_zipcode,city_name,city_state,city_country FROM cities ORDER BY city_name|,
1707 if ( @{$city_arr} ) {
1708 unshift @{$city_arr}, {
1709 city_zipcode => q{},
1713 city_country => q{},
1720 =head2 GetSortDetails (OUEST-PROVENCE)
1722 ($lib) = &GetSortDetails($category,$sortvalue);
1724 Returns the authorized value details
1725 C<&$lib>return value of authorized value details
1726 C<&$sortvalue>this is the value of authorized value
1727 C<&$category>this is the value of authorized value category
1731 sub GetSortDetails {
1732 my ( $category, $sortvalue ) = @_;
1733 my $dbh = C4::Context->dbh;
1734 my $query = qq|SELECT lib
1735 FROM authorised_values
1737 AND authorised_value=? |;
1738 my $sth = $dbh->prepare($query);
1739 $sth->execute( $category, $sortvalue );
1740 my $lib = $sth->fetchrow;
1741 return ($lib) if ($lib);
1742 return ($sortvalue) unless ($lib);
1745 =head2 MoveMemberToDeleted
1747 $result = &MoveMemberToDeleted($borrowernumber);
1749 Copy the record from borrowers to deletedborrowers table.
1753 # FIXME: should do it in one SQL statement w/ subquery
1754 # Otherwise, we should return the @data on success
1756 sub MoveMemberToDeleted {
1757 my ($member) = shift or return;
1758 my $dbh = C4::Context->dbh;
1759 my $query = qq|SELECT *
1761 WHERE borrowernumber=?|;
1762 my $sth = $dbh->prepare($query);
1763 $sth->execute($member);
1764 my @data = $sth->fetchrow_array;
1765 (@data) or return; # if we got a bad borrowernumber, there's nothing to insert
1767 $dbh->prepare( "INSERT INTO deletedborrowers VALUES ("
1768 . ( "?," x ( scalar(@data) - 1 ) )
1770 $sth->execute(@data);
1775 DelMember($borrowernumber);
1777 This function remove directly a borrower whitout writing it on deleteborrower.
1778 + Deletes reserves for the borrower
1783 my $dbh = C4::Context->dbh;
1784 my $borrowernumber = shift;
1785 #warn "in delmember with $borrowernumber";
1786 return unless $borrowernumber; # borrowernumber is mandatory.
1788 my $query = qq|DELETE
1790 WHERE borrowernumber=?|;
1791 my $sth = $dbh->prepare($query);
1792 $sth->execute($borrowernumber);
1796 WHERE borrowernumber = ?
1798 $sth = $dbh->prepare($query);
1799 $sth->execute($borrowernumber);
1800 logaction("MEMBERS", "DELETE", $borrowernumber, "") if C4::Context->preference("BorrowersLog");
1804 =head2 ExtendMemberSubscriptionTo (OUEST-PROVENCE)
1806 $date = ExtendMemberSubscriptionTo($borrowerid, $date);
1808 Extending the subscription to a given date or to the expiry date calculated on ISO date.
1813 sub ExtendMemberSubscriptionTo {
1814 my ( $borrowerid,$date) = @_;
1815 my $dbh = C4::Context->dbh;
1816 my $borrower = GetMember('borrowernumber'=>$borrowerid);
1818 $date = (C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry') ?
1819 C4::Dates->new($borrower->{'dateexpiry'}, 'iso')->output("iso") :
1820 C4::Dates->new()->output("iso");
1821 $date = GetExpiryDate( $borrower->{'categorycode'}, $date );
1823 my $sth = $dbh->do(<<EOF);
1825 SET dateexpiry='$date'
1826 WHERE borrowernumber='$borrowerid'
1829 AddEnrolmentFeeIfNeeded( $borrower->{categorycode}, $borrower->{borrowernumber} );
1831 logaction("MEMBERS", "RENEW", $borrower->{'borrowernumber'}, "Membership renewed")if C4::Context->preference("BorrowersLog");
1832 return $date if ($sth);
1836 =head2 GetTitles (OUEST-PROVENCE)
1838 ($borrowertitle)= &GetTitles();
1840 Looks up the different title . Returns array with all borrowers title
1845 my @borrowerTitle = split (/,|\|/,C4::Context->preference('BorrowersTitles'));
1846 unshift( @borrowerTitle, "" );
1847 my $count=@borrowerTitle;
1852 return ( \@borrowerTitle);
1856 =head2 GetPatronImage
1858 my ($imagedata, $dberror) = GetPatronImage($borrowernumber);
1860 Returns the mimetype and binary image data of the image for the patron with the supplied borrowernumber.
1864 sub GetPatronImage {
1865 my ($borrowernumber) = @_;
1866 warn "Borrowernumber passed to GetPatronImage is $borrowernumber" if $debug;
1867 my $dbh = C4::Context->dbh;
1868 my $query = 'SELECT mimetype, imagefile FROM patronimage WHERE borrowernumber = ?';
1869 my $sth = $dbh->prepare($query);
1870 $sth->execute($borrowernumber);
1871 my $imagedata = $sth->fetchrow_hashref;
1872 warn "Database error!" if $sth->errstr;
1873 return $imagedata, $sth->errstr;
1876 =head2 PutPatronImage
1878 PutPatronImage($cardnumber, $mimetype, $imgfile);
1880 Stores patron binary image data and mimetype in database.
1881 NOTE: This function is good for updating images as well as inserting new images in the database.
1885 sub PutPatronImage {
1886 my ($cardnumber, $mimetype, $imgfile) = @_;
1887 warn "Parameters passed in: Cardnumber=$cardnumber, Mimetype=$mimetype, " . ($imgfile ? "Imagefile" : "No Imagefile") if $debug;
1888 my $dbh = C4::Context->dbh;
1889 my $query = "INSERT INTO patronimage (borrowernumber, mimetype, imagefile) VALUES ( ( SELECT borrowernumber from borrowers WHERE cardnumber = ? ),?,?) ON DUPLICATE KEY UPDATE imagefile = ?;";
1890 my $sth = $dbh->prepare($query);
1891 $sth->execute($cardnumber,$mimetype,$imgfile,$imgfile);
1892 warn "Error returned inserting $cardnumber.$mimetype." if $sth->errstr;
1893 return $sth->errstr;
1896 =head2 RmPatronImage
1898 my ($dberror) = RmPatronImage($borrowernumber);
1900 Removes the image for the patron with the supplied borrowernumber.
1905 my ($borrowernumber) = @_;
1906 warn "Borrowernumber passed to GetPatronImage is $borrowernumber" if $debug;
1907 my $dbh = C4::Context->dbh;
1908 my $query = "DELETE FROM patronimage WHERE borrowernumber = ?;";
1909 my $sth = $dbh->prepare($query);
1910 $sth->execute($borrowernumber);
1911 my $dberror = $sth->errstr;
1912 warn "Database error!" if $sth->errstr;
1916 =head2 GetHideLostItemsPreference
1918 $hidelostitemspref = &GetHideLostItemsPreference($borrowernumber);
1920 Returns the HideLostItems preference for the patron category of the supplied borrowernumber
1921 C<&$hidelostitemspref>return value of function, 0 or 1
1925 sub GetHideLostItemsPreference {
1926 my ($borrowernumber) = @_;
1927 my $dbh = C4::Context->dbh;
1928 my $query = "SELECT hidelostitems FROM borrowers,categories WHERE borrowers.categorycode = categories.categorycode AND borrowernumber = ?";
1929 my $sth = $dbh->prepare($query);
1930 $sth->execute($borrowernumber);
1931 my $hidelostitems = $sth->fetchrow;
1932 return $hidelostitems;
1935 =head2 GetBorrowersToExpunge
1937 $borrowers = &GetBorrowersToExpunge(
1938 not_borrowered_since => $not_borrowered_since,
1939 expired_before => $expired_before,
1940 category_code => $category_code,
1941 branchcode => $branchcode
1944 This function get all borrowers based on the given criteria.
1948 sub GetBorrowersToExpunge {
1951 my $filterdate = $params->{'not_borrowered_since'};
1952 my $filterexpiry = $params->{'expired_before'};
1953 my $filtercategory = $params->{'category_code'};
1954 my $filterbranch = $params->{'branchcode'} ||
1955 ((C4::Context->preference('IndependentBranches')
1956 && C4::Context->userenv
1957 && !C4::Context->IsSuperLibrarian()
1958 && C4::Context->userenv->{branch})
1959 ? C4::Context->userenv->{branch}
1962 my $dbh = C4::Context->dbh;
1964 SELECT borrowers.borrowernumber,
1965 MAX(old_issues.timestamp) AS latestissue,
1966 MAX(issues.timestamp) AS currentissue
1968 JOIN categories USING (categorycode)
1969 LEFT JOIN old_issues USING (borrowernumber)
1970 LEFT JOIN issues USING (borrowernumber)
1971 WHERE category_type <> 'S'
1972 AND borrowernumber NOT IN (SELECT guarantorid FROM borrowers WHERE guarantorid IS NOT NULL AND guarantorid <> 0)
1975 if ( $filterbranch && $filterbranch ne "" ) {
1976 $query.= " AND borrowers.branchcode = ? ";
1977 push( @query_params, $filterbranch );
1979 if ( $filterexpiry ) {
1980 $query .= " AND dateexpiry < ? ";
1981 push( @query_params, $filterexpiry );
1983 if ( $filtercategory ) {
1984 $query .= " AND categorycode = ? ";
1985 push( @query_params, $filtercategory );
1987 $query.=" GROUP BY borrowers.borrowernumber HAVING currentissue IS NULL ";
1988 if ( $filterdate ) {
1989 $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
1990 push @query_params,$filterdate;
1992 warn $query if $debug;
1994 my $sth = $dbh->prepare($query);
1995 if (scalar(@query_params)>0){
1996 $sth->execute(@query_params);
2003 while ( my $data = $sth->fetchrow_hashref ) {
2004 push @results, $data;
2009 =head2 GetBorrowersWhoHaveNeverBorrowed
2011 $results = &GetBorrowersWhoHaveNeverBorrowed
2013 This function get all borrowers who have never borrowed.
2015 I<$result> is a ref to an array which all elements are a hasref.
2019 sub GetBorrowersWhoHaveNeverBorrowed {
2020 my $filterbranch = shift ||
2021 ((C4::Context->preference('IndependentBranches')
2022 && C4::Context->userenv
2023 && !C4::Context->IsSuperLibrarian()
2024 && C4::Context->userenv->{branch})
2025 ? C4::Context->userenv->{branch}
2027 my $dbh = C4::Context->dbh;
2029 SELECT borrowers.borrowernumber,max(timestamp) as latestissue
2031 LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
2032 WHERE issues.borrowernumber IS NULL
2035 if ($filterbranch && $filterbranch ne ""){
2036 $query.=" AND borrowers.branchcode= ?";
2037 push @query_params,$filterbranch;
2039 warn $query if $debug;
2041 my $sth = $dbh->prepare($query);
2042 if (scalar(@query_params)>0){
2043 $sth->execute(@query_params);
2050 while ( my $data = $sth->fetchrow_hashref ) {
2051 push @results, $data;
2056 =head2 GetBorrowersWithIssuesHistoryOlderThan
2058 $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
2060 this function get all borrowers who has an issue history older than I<$date> given on input arg.
2062 I<$result> is a ref to an array which all elements are a hashref.
2063 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2067 sub GetBorrowersWithIssuesHistoryOlderThan {
2068 my $dbh = C4::Context->dbh;
2069 my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
2070 my $filterbranch = shift ||
2071 ((C4::Context->preference('IndependentBranches')
2072 && C4::Context->userenv
2073 && !C4::Context->IsSuperLibrarian()
2074 && C4::Context->userenv->{branch})
2075 ? C4::Context->userenv->{branch}
2078 SELECT count(borrowernumber) as n,borrowernumber
2080 WHERE returndate < ?
2081 AND borrowernumber IS NOT NULL
2084 push @query_params, $date;
2086 $query.=" AND branchcode = ?";
2087 push @query_params, $filterbranch;
2089 $query.=" GROUP BY borrowernumber ";
2090 warn $query if $debug;
2091 my $sth = $dbh->prepare($query);
2092 $sth->execute(@query_params);
2095 while ( my $data = $sth->fetchrow_hashref ) {
2096 push @results, $data;
2101 =head2 GetBorrowersNamesAndLatestIssue
2103 $results = &GetBorrowersNamesAndLatestIssueList(@borrowernumbers)
2105 this function get borrowers Names and surnames and Issue information.
2107 I<@borrowernumbers> is an array which all elements are borrowernumbers.
2108 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2112 sub GetBorrowersNamesAndLatestIssue {
2113 my $dbh = C4::Context->dbh;
2114 my @borrowernumbers=@_;
2116 SELECT surname,lastname, phone, email,max(timestamp)
2118 LEFT JOIN issues ON borrowers.borrowernumber=issues.borrowernumber
2119 GROUP BY borrowernumber
2121 my $sth = $dbh->prepare($query);
2123 my $results = $sth->fetchall_arrayref({});
2131 my $success = ModPrivacy( $borrowernumber, $privacy );
2133 Update the privacy of a patron.
2136 true on success, false on failure
2143 my $borrowernumber = shift;
2144 my $privacy = shift;
2145 return unless defined $borrowernumber;
2146 return unless $borrowernumber =~ /^\d+$/;
2148 return ModMember( borrowernumber => $borrowernumber,
2149 privacy => $privacy );
2154 AddMessage( $borrowernumber, $message_type, $message, $branchcode );
2156 Adds a message to the messages table for the given borrower.
2165 my ( $borrowernumber, $message_type, $message, $branchcode ) = @_;
2167 my $dbh = C4::Context->dbh;
2169 if ( ! ( $borrowernumber && $message_type && $message && $branchcode ) ) {
2173 my $query = "INSERT INTO messages ( borrowernumber, branchcode, message_type, message ) VALUES ( ?, ?, ?, ? )";
2174 my $sth = $dbh->prepare($query);
2175 $sth->execute( $borrowernumber, $branchcode, $message_type, $message );
2176 logaction("MEMBERS", "ADDCIRCMESSAGE", $borrowernumber, $message) if C4::Context->preference("BorrowersLog");
2182 GetMessages( $borrowernumber, $type );
2184 $type is message type, B for borrower, or L for Librarian.
2185 Empty type returns all messages of any type.
2187 Returns all messages for the given borrowernumber
2192 my ( $borrowernumber, $type, $branchcode ) = @_;
2198 my $dbh = C4::Context->dbh;
2201 branches.branchname,
2204 messages.branchcode LIKE '$branchcode' AS can_delete
2205 FROM messages, branches
2206 WHERE borrowernumber = ?
2207 AND message_type LIKE ?
2208 AND messages.branchcode = branches.branchcode
2209 ORDER BY message_date DESC";
2210 my $sth = $dbh->prepare($query);
2211 $sth->execute( $borrowernumber, $type ) ;
2214 while ( my $data = $sth->fetchrow_hashref ) {
2215 my $d = C4::Dates->new( $data->{message_date}, 'iso' );
2216 $data->{message_date_formatted} = $d->output;
2217 push @results, $data;
2225 GetMessagesCount( $borrowernumber, $type );
2227 $type is message type, B for borrower, or L for Librarian.
2228 Empty type returns all messages of any type.
2230 Returns the number of messages for the given borrowernumber
2234 sub GetMessagesCount {
2235 my ( $borrowernumber, $type, $branchcode ) = @_;
2241 my $dbh = C4::Context->dbh;
2243 my $query = "SELECT COUNT(*) as MsgCount FROM messages WHERE borrowernumber = ? AND message_type LIKE ?";
2244 my $sth = $dbh->prepare($query);
2245 $sth->execute( $borrowernumber, $type ) ;
2248 my $data = $sth->fetchrow_hashref;
2249 my $count = $data->{'MsgCount'};
2256 =head2 DeleteMessage
2258 DeleteMessage( $message_id );
2263 my ( $message_id ) = @_;
2265 my $dbh = C4::Context->dbh;
2266 my $query = "SELECT * FROM messages WHERE message_id = ?";
2267 my $sth = $dbh->prepare($query);
2268 $sth->execute( $message_id );
2269 my $message = $sth->fetchrow_hashref();
2271 $query = "DELETE FROM messages WHERE message_id = ?";
2272 $sth = $dbh->prepare($query);
2273 $sth->execute( $message_id );
2274 logaction("MEMBERS", "DELCIRCMESSAGE", $message->{'borrowernumber'}, $message->{'message'}) if C4::Context->preference("BorrowersLog");
2279 IssueSlip($branchcode, $borrowernumber, $quickslip)
2281 Returns letter hash ( see C4::Letters::GetPreparedLetter )
2283 $quickslip is boolean, to indicate whether we want a quick slip
2288 my ($branch, $borrowernumber, $quickslip) = @_;
2290 # return unless ( C4::Context->boolean_preference('printcirculationslips') );
2292 my $now = POSIX::strftime("%Y-%m-%d", localtime);
2294 my $issueslist = GetPendingIssues($borrowernumber);
2295 foreach my $it (@$issueslist){
2296 if ((substr $it->{'issuedate'}, 0, 10) eq $now || (substr $it->{'lastreneweddate'}, 0, 10) eq $now) {
2299 elsif ((substr $it->{'date_due'}, 0, 10) le $now) {
2300 $it->{'overdue'} = 1;
2302 my $dt = dt_from_string( $it->{'date_due'} );
2303 $it->{'date_due'} = output_pref( $dt );;
2305 my @issues = sort { $b->{'timestamp'} <=> $a->{'timestamp'} } @$issueslist;
2307 my ($letter_code, %repeat);
2309 $letter_code = 'ISSUEQSLIP';
2311 'checkedout' => [ map {
2315 }, grep { $_->{'now'} } @issues ],
2319 $letter_code = 'ISSUESLIP';
2321 'checkedout' => [ map {
2325 }, grep { !$_->{'overdue'} } @issues ],
2327 'overdue' => [ map {
2331 }, grep { $_->{'overdue'} } @issues ],
2334 $_->{'timestamp'} = $_->{'newdate'};
2336 } @{ GetNewsToDisplay("slip") } ],
2340 return C4::Letters::GetPreparedLetter (
2341 module => 'circulation',
2342 letter_code => $letter_code,
2343 branchcode => $branch,
2345 'branches' => $branch,
2346 'borrowers' => $borrowernumber,
2352 =head2 GetBorrowersWithEmail
2354 ([$borrnum,$userid], ...) = GetBorrowersWithEmail('me@example.com');
2356 This gets a list of users and their basic details from their email address.
2357 As it's possible for multiple user to have the same email address, it provides
2358 you with all of them. If there is no userid for the user, there will be an
2359 C<undef> there. An empty list will be returned if there are no matches.
2363 sub GetBorrowersWithEmail {
2366 my $dbh = C4::Context->dbh;
2368 my $query = "SELECT borrowernumber, userid FROM borrowers WHERE email=?";
2369 my $sth=$dbh->prepare($query);
2370 $sth->execute($email);
2372 while (my $ref = $sth->fetch) {
2375 die "Failure searching for borrowers by email address: $sth->errstr" if $sth->err;
2379 sub AddMember_Opac {
2380 my ( %borrower ) = @_;
2382 $borrower{'categorycode'} = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
2384 my $sr = new String::Random;
2385 $sr->{'A'} = [ 'A'..'Z', 'a'..'z' ];
2386 my $password = $sr->randpattern("AAAAAAAAAA");
2387 $borrower{'password'} = $password;
2389 $borrower{'cardnumber'} = fixup_cardnumber();
2391 my $borrowernumber = AddMember(%borrower);
2393 return ( $borrowernumber, $password );
2396 =head2 AddEnrolmentFeeIfNeeded
2398 AddEnrolmentFeeIfNeeded( $borrower->{categorycode}, $borrower->{borrowernumber} );
2400 Add enrolment fee for a patron if needed.
2404 sub AddEnrolmentFeeIfNeeded {
2405 my ( $categorycode, $borrowernumber ) = @_;
2406 # check for enrollment fee & add it if needed
2407 my $dbh = C4::Context->dbh;
2408 my $sth = $dbh->prepare(q{
2411 WHERE categorycode=?
2413 $sth->execute( $categorycode );
2415 warn sprintf('Database returned the following error: %s', $sth->errstr);
2418 my ($enrolmentfee) = $sth->fetchrow;
2419 if ($enrolmentfee && $enrolmentfee > 0) {
2420 # insert fee in patron debts
2421 C4::Accounts::manualinvoice( $borrowernumber, '', '', 'A', $enrolmentfee );
2426 my ( $borrowernumber ) = @_;
2428 my $sql = "SELECT COUNT(*) FROM issues WHERE date_due < NOW() AND borrowernumber = ?";
2429 my $sth = C4::Context->dbh->prepare( $sql );
2430 $sth->execute( $borrowernumber );
2431 my ( $count ) = $sth->fetchrow_array();
2436 END { } # module clean-up code here (global destructor)