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("
329 categories.description,
330 categories.BlockExpiredPatronOpacActions,
334 LEFT JOIN categories ON borrowers.categorycode=categories.categorycode
335 WHERE borrowernumber = ?
337 $sth->execute($borrowernumber);
339 elsif ($cardnumber) {
340 $sth = $dbh->prepare("
343 categories.description,
344 categories.BlockExpiredPatronOpacActions,
348 LEFT JOIN categories ON borrowers.categorycode = categories.categorycode
351 $sth->execute($cardnumber);
356 my $borrower = $sth->fetchrow_hashref;
357 my ($amount) = GetMemberAccountRecords( $borrowernumber);
358 $borrower->{'amountoutstanding'} = $amount;
359 # FIXME - patronflags calls GetMemberAccountRecords... just have patronflags return $amount
360 my $flags = patronflags( $borrower);
363 $sth = $dbh->prepare("select bit,flag from userflags");
365 while ( my ( $bit, $flag ) = $sth->fetchrow ) {
366 if ( $borrower->{'flags'} && $borrower->{'flags'} & 2**$bit ) {
367 $accessflagshash->{$flag} = 1;
370 $borrower->{'flags'} = $flags;
371 $borrower->{'authflags'} = $accessflagshash;
373 # For the purposes of making templates easier, we'll define a
374 # 'showname' which is the alternate form the user's first name if
375 # 'other name' is defined.
376 if ($borrower->{category_type} eq 'I') {
377 $borrower->{'showname'} = $borrower->{'othernames'};
378 $borrower->{'showname'} .= " $borrower->{'firstname'}" if $borrower->{'firstname'};
380 $borrower->{'showname'} = $borrower->{'firstname'};
383 return ($borrower); #, $flags, $accessflagshash);
388 $flags = &patronflags($patron);
390 This function is not exported.
392 The following will be set where applicable:
393 $flags->{CHARGES}->{amount} Amount of debt
394 $flags->{CHARGES}->{noissues} Set if debt amount >$5.00 (or syspref noissuescharge)
395 $flags->{CHARGES}->{message} Message -- deprecated
397 $flags->{CREDITS}->{amount} Amount of credit
398 $flags->{CREDITS}->{message} Message -- deprecated
400 $flags->{ GNA } Patron has no valid address
401 $flags->{ GNA }->{noissues} Set for each GNA
402 $flags->{ GNA }->{message} "Borrower has no valid address" -- deprecated
404 $flags->{ LOST } Patron's card reported lost
405 $flags->{ LOST }->{noissues} Set for each LOST
406 $flags->{ LOST }->{message} Message -- deprecated
408 $flags->{DBARRED} Set if patron debarred, no access
409 $flags->{DBARRED}->{noissues} Set for each DBARRED
410 $flags->{DBARRED}->{message} Message -- deprecated
413 $flags->{ NOTES }->{message} The note itself. NOT deprecated
415 $flags->{ ODUES } Set if patron has overdue books.
416 $flags->{ ODUES }->{message} "Yes" -- deprecated
417 $flags->{ ODUES }->{itemlist} ref-to-array: list of overdue books
418 $flags->{ ODUES }->{itemlisttext} Text list of overdue items -- deprecated
420 $flags->{WAITING} Set if any of patron's reserves are available
421 $flags->{WAITING}->{message} Message -- deprecated
422 $flags->{WAITING}->{itemlist} ref-to-array: list of available items
426 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
427 overdue items. Its elements are references-to-hash, each describing an
428 overdue item. The keys are selected fields from the issues, biblio,
429 biblioitems, and items tables of the Koha database.
431 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
432 the overdue items, one per line. Deprecated.
434 =item C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
435 available items. Each element is a reference-to-hash whose keys are
436 fields from the reserves table of the Koha database.
440 All the "message" fields that include language generated in this function are deprecated,
441 because such strings belong properly in the display layer.
443 The "message" field that comes from the DB is OK.
447 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
448 # FIXME rename this function.
451 my ( $patroninformation) = @_;
452 my $dbh=C4::Context->dbh;
453 my ($balance, $owing) = GetMemberAccountBalance( $patroninformation->{'borrowernumber'});
456 my $noissuescharge = C4::Context->preference("noissuescharge") || 5;
457 $flaginfo{'message'} = sprintf 'Patron owes %.02f', $owing;
458 $flaginfo{'amount'} = sprintf "%.02f", $owing;
459 if ( $owing > $noissuescharge && !C4::Context->preference("AllowFineOverride") ) {
460 $flaginfo{'noissues'} = 1;
462 $flags{'CHARGES'} = \%flaginfo;
464 elsif ( $balance < 0 ) {
466 $flaginfo{'message'} = sprintf 'Patron has credit of %.02f', -$balance;
467 $flaginfo{'amount'} = sprintf "%.02f", $balance;
468 $flags{'CREDITS'} = \%flaginfo;
470 if ( $patroninformation->{'gonenoaddress'}
471 && $patroninformation->{'gonenoaddress'} == 1 )
474 $flaginfo{'message'} = 'Borrower has no valid address.';
475 $flaginfo{'noissues'} = 1;
476 $flags{'GNA'} = \%flaginfo;
478 if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
480 $flaginfo{'message'} = 'Borrower\'s card reported lost.';
481 $flaginfo{'noissues'} = 1;
482 $flags{'LOST'} = \%flaginfo;
484 if ( $patroninformation->{'debarred'} && check_date( split( /-/, $patroninformation->{'debarred'} ) ) ) {
485 if ( Date_to_Days(Date::Calc::Today) < Date_to_Days( split( /-/, $patroninformation->{'debarred'} ) ) ) {
487 $flaginfo{'debarredcomment'} = $patroninformation->{'debarredcomment'};
488 $flaginfo{'message'} = $patroninformation->{'debarredcomment'};
489 $flaginfo{'noissues'} = 1;
490 $flaginfo{'dateend'} = $patroninformation->{'debarred'};
491 $flags{'DBARRED'} = \%flaginfo;
494 if ( $patroninformation->{'borrowernotes'}
495 && $patroninformation->{'borrowernotes'} )
498 $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
499 $flags{'NOTES'} = \%flaginfo;
501 my ( $odues, $itemsoverdue ) = C4::Overdues::checkoverdues($patroninformation->{'borrowernumber'});
502 if ( $odues && $odues > 0 ) {
504 $flaginfo{'message'} = "Yes";
505 $flaginfo{'itemlist'} = $itemsoverdue;
506 foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
509 $flaginfo{'itemlisttext'} .=
510 "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n"; # newline is display layer
512 $flags{'ODUES'} = \%flaginfo;
514 my @itemswaiting = C4::Reserves::GetReservesFromBorrowernumber( $patroninformation->{'borrowernumber'},'W' );
515 my $nowaiting = scalar @itemswaiting;
516 if ( $nowaiting > 0 ) {
518 $flaginfo{'message'} = "Reserved items available";
519 $flaginfo{'itemlist'} = \@itemswaiting;
520 $flags{'WAITING'} = \%flaginfo;
528 $borrower = &GetMember(%information);
530 Retrieve the first patron record meeting on criteria listed in the
531 C<%information> hash, which should contain one or more
532 pairs of borrowers column names and values, e.g.,
534 $borrower = GetMember(borrowernumber => id);
536 C<&GetBorrower> returns a reference-to-hash whose keys are the fields of
537 the C<borrowers> table in the Koha database.
539 FIXME: GetMember() is used throughout the code as a lookup
540 on a unique key such as the borrowernumber, but this meaning is not
541 enforced in the routine itself.
547 my ( %information ) = @_;
548 if (exists $information{borrowernumber} && !defined $information{borrowernumber}) {
549 #passing mysql's kohaadmin?? Makes no sense as a query
552 my $dbh = C4::Context->dbh;
554 q{SELECT borrowers.*, categories.category_type, categories.description
556 LEFT JOIN categories on borrowers.categorycode=categories.categorycode WHERE };
559 for (keys %information ) {
567 if (defined $information{$_}) {
569 push @values, $information{$_};
572 $select .= "$_ IS NULL";
575 $debug && warn $select, " ",values %information;
576 my $sth = $dbh->prepare("$select");
577 $sth->execute(map{$information{$_}} keys %information);
578 my $data = $sth->fetchall_arrayref({});
579 #FIXME interface to this routine now allows generation of a result set
580 #so whole array should be returned but bowhere in the current code expects this
588 =head2 GetMemberRelatives
590 @borrowernumbers = GetMemberRelatives($borrowernumber);
592 C<GetMemberRelatives> returns a borrowersnumber's list of guarantor/guarantees of the member given in parameter
595 sub GetMemberRelatives {
596 my $borrowernumber = shift;
597 my $dbh = C4::Context->dbh;
601 my $query = "SELECT guarantorid FROM borrowers WHERE borrowernumber=?";
602 my $sth = $dbh->prepare($query);
603 $sth->execute($borrowernumber);
604 my $data = $sth->fetchrow_arrayref();
605 push @glist, $data->[0] if $data->[0];
606 my $guarantor = $data->[0] ? $data->[0] : undef;
609 $query = "SELECT borrowernumber FROM borrowers WHERE guarantorid=?";
610 $sth = $dbh->prepare($query);
611 $sth->execute($borrowernumber);
612 while ($data = $sth->fetchrow_arrayref()) {
613 push @glist, $data->[0];
616 # Getting sibling guarantees
618 $query = "SELECT borrowernumber FROM borrowers WHERE guarantorid=?";
619 $sth = $dbh->prepare($query);
620 $sth->execute($guarantor);
621 while ($data = $sth->fetchrow_arrayref()) {
622 push @glist, $data->[0] if ($data->[0] != $borrowernumber);
629 =head2 IsMemberBlocked
631 my ($block_status, $count) = IsMemberBlocked( $borrowernumber );
633 Returns whether a patron has overdue items that may result
634 in a block or whether the patron has active fine days
635 that would block circulation privileges.
637 C<$block_status> can have the following values:
639 1 if the patron has outstanding fine days, in which case C<$count> is the number of them
641 -1 if the patron has overdue items, in which case C<$count> is the number of them
643 0 if the patron has no overdue items or outstanding fine days, in which case C<$count> is 0
645 Outstanding fine days are checked before current overdue items
648 FIXME: this needs to be split into two functions; a potential block
649 based on the number of current overdue items could be orthogonal
650 to a block based on whether the patron has any fine days accrued.
654 sub IsMemberBlocked {
655 my $borrowernumber = shift;
656 my $dbh = C4::Context->dbh;
658 my $blockeddate = Koha::Borrower::Debarments::IsDebarred($borrowernumber);
660 return ( 1, $blockeddate ) if $blockeddate;
662 # if he have late issues
663 my $sth = $dbh->prepare(
664 "SELECT COUNT(*) as latedocs
666 WHERE borrowernumber = ?
667 AND date_due < now()"
669 $sth->execute($borrowernumber);
670 my $latedocs = $sth->fetchrow_hashref->{'latedocs'};
672 return ( -1, $latedocs ) if $latedocs > 0;
677 =head2 GetMemberIssuesAndFines
679 ($overdue_count, $issue_count, $total_fines) = &GetMemberIssuesAndFines($borrowernumber);
681 Returns aggregate data about items borrowed by the patron with the
682 given borrowernumber.
684 C<&GetMemberIssuesAndFines> returns a three-element array. C<$overdue_count> is the
685 number of overdue items the patron currently has borrowed. C<$issue_count> is the
686 number of books the patron currently has borrowed. C<$total_fines> is
687 the total fine currently due by the borrower.
692 sub GetMemberIssuesAndFines {
693 my ( $borrowernumber ) = @_;
694 my $dbh = C4::Context->dbh;
695 my $query = "SELECT COUNT(*) FROM issues WHERE borrowernumber = ?";
697 $debug and warn $query."\n";
698 my $sth = $dbh->prepare($query);
699 $sth->execute($borrowernumber);
700 my $issue_count = $sth->fetchrow_arrayref->[0];
702 $sth = $dbh->prepare(
703 "SELECT COUNT(*) FROM issues
704 WHERE borrowernumber = ?
705 AND date_due < now()"
707 $sth->execute($borrowernumber);
708 my $overdue_count = $sth->fetchrow_arrayref->[0];
710 $sth = $dbh->prepare("SELECT SUM(amountoutstanding) FROM accountlines WHERE borrowernumber = ?");
711 $sth->execute($borrowernumber);
712 my $total_fines = $sth->fetchrow_arrayref->[0];
714 return ($overdue_count, $issue_count, $total_fines);
720 my @columns = C4::Member::columns();
722 Returns an array of borrowers' table columns on success,
723 and an empty array on failure.
729 # Pure ANSI SQL goodness.
730 my $sql = 'SELECT * FROM borrowers WHERE 1=0;';
732 # Get the database handle.
733 my $dbh = C4::Context->dbh;
735 # Run the SQL statement to load STH's readonly properties.
736 my $sth = $dbh->prepare($sql);
737 my $rv = $sth->execute();
739 # This only fails if the table doesn't exist.
740 # This will always be called AFTER an install or upgrade,
741 # so borrowers will exist!
743 if ($sth->{NUM_OF_FIELDS}>0) {
744 @data = @{$sth->{NAME}};
755 my $success = ModMember(borrowernumber => $borrowernumber,
756 [ field => value ]... );
758 Modify borrower's data. All date fields should ALREADY be in ISO format.
761 true on success, or false on failure
767 # test to know if you must update or not the borrower password
768 if (exists $data{password}) {
769 if ($data{password} eq '****' or $data{password} eq '') {
770 delete $data{password};
772 $data{password} = hash_password($data{password});
775 my $old_categorycode = GetBorrowerCategorycode( $data{borrowernumber} );
776 my $execute_success=UpdateInTable("borrowers",\%data);
777 if ($execute_success) { # only proceed if the update was a success
778 # ok if its an adult (type) it may have borrowers that depend on it as a guarantor
779 # so when we update information for an adult we should check for guarantees and update the relevant part
780 # of their records, ie addresses and phone numbers
781 my $borrowercategory= GetBorrowercategory( $data{'category_type'} );
782 if ( exists $borrowercategory->{'category_type'} && $borrowercategory->{'category_type'} eq ('A' || 'S') ) {
783 # is adult check guarantees;
784 UpdateGuarantees(%data);
787 # If the patron changes to a category with enrollment fee, we add a fee
788 if ( $data{categorycode} and $data{categorycode} ne $old_categorycode ) {
789 AddEnrolmentFeeIfNeeded( $data{categorycode}, $data{borrowernumber} );
792 logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "UPDATE (executed w/ arg: $data{'borrowernumber'})") if C4::Context->preference("BorrowersLog");
794 return $execute_success;
799 $borrowernumber = &AddMember(%borrower);
801 insert new borrower into table
802 Returns the borrowernumber upon success
804 Returns as undef upon any db error without further processing
811 my $dbh = C4::Context->dbh;
813 # generate a proper login if none provided
814 $data{'userid'} = Generate_Userid($data{'borrowernumber'}, $data{'firstname'}, $data{'surname'}) if $data{'userid'} eq '';
816 # add expiration date if it isn't already there
817 unless ( $data{'dateexpiry'} ) {
818 $data{'dateexpiry'} = GetExpiryDate( $data{'categorycode'}, C4::Dates->new()->output("iso") );
821 # add enrollment date if it isn't already there
822 unless ( $data{'dateenrolled'} ) {
823 $data{'dateenrolled'} = C4::Dates->new()->output("iso");
826 # create a disabled account if no password provided
827 $data{'password'} = ($data{'password'})? hash_password($data{'password'}) : '!';
828 $data{'borrowernumber'}=InsertInTable("borrowers",\%data);
830 # mysql_insertid is probably bad. not necessarily accurate and mysql-specific at best.
831 logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
833 AddEnrolmentFeeIfNeeded( $data{categorycode}, $data{borrowernumber} );
835 return $data{'borrowernumber'};
840 my $uniqueness = Check_Userid($userid,$borrowernumber);
842 $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 != '').
844 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.
847 0 for not unique (i.e. this $userid already exists)
848 1 for unique (i.e. this $userid does not exist, or this $userid/$borrowernumber combination already exists)
853 my ($uid,$member) = @_;
854 my $dbh = C4::Context->dbh;
857 "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
858 $sth->execute( $uid, $member );
859 if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
867 =head2 Generate_Userid
869 my $newuid = Generate_Userid($borrowernumber, $firstname, $surname);
871 Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
873 $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.
876 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).
880 sub Generate_Userid {
881 my ($borrowernumber, $firstname, $surname) = @_;
884 #The script will "do" the following code and increment the $offset until Check_Userid = 1 (i.e. until $newuid comes back as unique)
886 $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
887 $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
888 $newuid = lc(($firstname)? "$firstname.$surname" : $surname);
889 $newuid = unac_string('utf-8',$newuid);
890 $newuid .= $offset unless $offset == 0;
893 } while (!Check_Userid($newuid,$borrowernumber));
899 my ( $uid, $member, $digest ) = @_;
900 my $dbh = C4::Context->dbh;
902 #Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
903 #Then we need to tell the user and have them create a new one.
907 "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
908 $sth->execute( $uid, $member );
909 if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
913 #Everything is good so we can update the information.
916 "update borrowers set userid=?, password=? where borrowernumber=?");
917 $sth->execute( $uid, $digest, $member );
921 logaction("MEMBERS", "CHANGE PASS", $member, "") if C4::Context->preference("BorrowersLog");
927 =head2 fixup_cardnumber
929 Warning: The caller is responsible for locking the members table in write
930 mode, to avoid database corruption.
934 use vars qw( @weightings );
935 my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
937 sub fixup_cardnumber {
938 my ($cardnumber) = @_;
939 my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;
941 # Find out whether member numbers should be generated
942 # automatically. Should be either "1" or something else.
943 # Defaults to "0", which is interpreted as "no".
945 # if ($cardnumber !~ /\S/ && $autonumber_members) {
946 ($autonumber_members) or return $cardnumber;
947 my $checkdigit = C4::Context->preference('checkdigit');
948 my $dbh = C4::Context->dbh;
949 if ( $checkdigit and $checkdigit eq 'katipo' ) {
951 # if checkdigit is selected, calculate katipo-style cardnumber.
952 # otherwise, just use the max()
953 # purpose: generate checksum'd member numbers.
954 # We'll assume we just got the max value of digits 2-8 of member #'s
955 # from the database and our job is to increment that by one,
956 # determine the 1st and 9th digits and return the full string.
957 my $sth = $dbh->prepare(
958 "select max(substring(borrowers.cardnumber,2,7)) as new_num from borrowers"
961 my $data = $sth->fetchrow_hashref;
962 $cardnumber = $data->{new_num};
963 if ( !$cardnumber ) { # If DB has no values,
964 $cardnumber = 1000000; # start at 1000000
970 for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
971 # read weightings, left to right, 1 char at a time
972 my $temp1 = $weightings[$i];
974 # sequence left to right, 1 char at a time
975 my $temp2 = substr( $cardnumber, $i, 1 );
977 # mult each char 1-7 by its corresponding weighting
978 $sum += $temp1 * $temp2;
981 my $rem = ( $sum % 11 );
982 $rem = 'X' if $rem == 10;
984 return "V$cardnumber$rem";
987 my $sth = $dbh->prepare(
988 'SELECT MAX( CAST( cardnumber AS SIGNED ) ) FROM borrowers WHERE cardnumber REGEXP "^-?[0-9]+$"'
991 my ($result) = $sth->fetchrow;
994 return $cardnumber; # just here as a fallback/reminder
999 ($num_children, $children_arrayref) = &GetGuarantees($parent_borrno);
1000 $child0_cardno = $children_arrayref->[0]{"cardnumber"};
1001 $child0_borrno = $children_arrayref->[0]{"borrowernumber"};
1003 C<&GetGuarantees> takes a borrower number (e.g., that of a patron
1004 with children) and looks up the borrowers who are guaranteed by that
1005 borrower (i.e., the patron's children).
1007 C<&GetGuarantees> returns two values: an integer giving the number of
1008 borrowers guaranteed by C<$parent_borrno>, and a reference to an array
1009 of references to hash, which gives the actual results.
1015 my ($borrowernumber) = @_;
1016 my $dbh = C4::Context->dbh;
1019 "select cardnumber,borrowernumber, firstname, surname from borrowers where guarantorid=?"
1021 $sth->execute($borrowernumber);
1024 my $data = $sth->fetchall_arrayref({});
1025 return ( scalar(@$data), $data );
1028 =head2 UpdateGuarantees
1030 &UpdateGuarantees($parent_borrno);
1033 C<&UpdateGuarantees> borrower data for an adult and updates all the guarantees
1034 with the modified information
1039 sub UpdateGuarantees {
1041 my $dbh = C4::Context->dbh;
1042 my ( $count, $guarantees ) = GetGuarantees( $data{'borrowernumber'} );
1043 foreach my $guarantee (@$guarantees){
1044 my $guaquery = qq|UPDATE borrowers
1045 SET address=?,fax=?,B_city=?,mobile=?,city=?,phone=?
1046 WHERE borrowernumber=?
1048 my $sth = $dbh->prepare($guaquery);
1049 $sth->execute($data{'address'},$data{'fax'},$data{'B_city'},$data{'mobile'},$data{'city'},$data{'phone'},$guarantee->{'borrowernumber'});
1052 =head2 GetPendingIssues
1054 my $issues = &GetPendingIssues(@borrowernumber);
1056 Looks up what the patron with the given borrowernumber has borrowed.
1058 C<&GetPendingIssues> returns a
1059 reference-to-array where each element is a reference-to-hash; the
1060 keys are the fields from the C<issues>, C<biblio>, and C<items> tables.
1061 The keys include C<biblioitems> fields except marc and marcxml.
1066 sub GetPendingIssues {
1067 my @borrowernumbers = @_;
1069 unless (@borrowernumbers ) { # return a ref_to_array
1070 return \@borrowernumbers; # to not cause surprise to caller
1073 # Borrowers part of the query
1075 for (my $i = 0; $i < @borrowernumbers; $i++) {
1076 $bquery .= ' issues.borrowernumber = ?';
1077 if ($i < $#borrowernumbers ) {
1082 # must avoid biblioitems.* to prevent large marc and marcxml fields from killing performance
1083 # FIXME: namespace collision: each table has "timestamp" fields. Which one is "timestamp" ?
1084 # FIXME: circ/ciculation.pl tries to sort by timestamp!
1085 # FIXME: namespace collision: other collisions possible.
1086 # FIXME: most of this data isn't really being used by callers.
1093 biblioitems.itemtype,
1096 biblioitems.publicationyear,
1097 biblioitems.publishercode,
1098 biblioitems.volumedate,
1099 biblioitems.volumedesc,
1102 borrowers.firstname,
1104 borrowers.cardnumber,
1105 issues.timestamp AS timestamp,
1106 issues.renewals AS renewals,
1107 issues.borrowernumber AS borrowernumber,
1108 items.renewals AS totalrenewals
1110 LEFT JOIN items ON items.itemnumber = issues.itemnumber
1111 LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
1112 LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
1113 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
1116 ORDER BY issues.issuedate"
1119 my $sth = C4::Context->dbh->prepare($query);
1120 $sth->execute(@borrowernumbers);
1121 my $data = $sth->fetchall_arrayref({});
1122 my $tz = C4::Context->tz();
1123 my $today = DateTime->now( time_zone => $tz);
1124 foreach (@{$data}) {
1125 if ($_->{issuedate}) {
1126 $_->{issuedate} = dt_from_string($_->{issuedate}, 'sql');
1128 $_->{date_due} or next;
1129 $_->{date_due} = DateTime::Format::DateParse->parse_datetime($_->{date_due}, $tz->name());
1130 if ( DateTime->compare($_->{date_due}, $today) == -1 ) {
1139 $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
1141 Looks up what the patron with the given borrowernumber has borrowed,
1142 and sorts the results.
1144 C<$sortkey> is the name of a field on which to sort the results. This
1145 should be the name of a field in the C<issues>, C<biblio>,
1146 C<biblioitems>, or C<items> table in the Koha database.
1148 C<$limit> is the maximum number of results to return.
1150 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
1151 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
1152 C<items> tables of the Koha database.
1158 my ( $borrowernumber, $order, $limit ) = @_;
1160 my $dbh = C4::Context->dbh;
1162 'SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1164 LEFT JOIN items on items.itemnumber=issues.itemnumber
1165 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1166 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1167 WHERE borrowernumber=?
1169 SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1171 LEFT JOIN items on items.itemnumber=old_issues.itemnumber
1172 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1173 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1174 WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL
1175 order by ' . $order;
1177 $query .= " limit $limit";
1180 my $sth = $dbh->prepare($query);
1181 $sth->execute( $borrowernumber, $borrowernumber );
1182 return $sth->fetchall_arrayref( {} );
1186 =head2 GetMemberAccountRecords
1188 ($total, $acctlines, $count) = &GetMemberAccountRecords($borrowernumber);
1190 Looks up accounting data for the patron with the given borrowernumber.
1192 C<&GetMemberAccountRecords> returns a three-element array. C<$acctlines> is a
1193 reference-to-array, where each element is a reference-to-hash; the
1194 keys are the fields of the C<accountlines> table in the Koha database.
1195 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1196 total amount outstanding for all of the account lines.
1200 sub GetMemberAccountRecords {
1201 my ($borrowernumber) = @_;
1202 my $dbh = C4::Context->dbh;
1208 WHERE borrowernumber=?);
1209 $strsth.=" ORDER BY date desc,timestamp DESC";
1210 my $sth= $dbh->prepare( $strsth );
1211 $sth->execute( $borrowernumber );
1214 while ( my $data = $sth->fetchrow_hashref ) {
1215 if ( $data->{itemnumber} ) {
1216 my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
1217 $data->{biblionumber} = $biblio->{biblionumber};
1218 $data->{title} = $biblio->{title};
1220 $acctlines[$numlines] = $data;
1222 $total += int(1000 * $data->{'amountoutstanding'}); # convert float to integer to avoid round-off errors
1225 return ( $total, \@acctlines,$numlines);
1228 =head2 GetMemberAccountBalance
1230 ($total_balance, $non_issue_balance, $other_charges) = &GetMemberAccountBalance($borrowernumber);
1232 Calculates amount immediately owing by the patron - non-issue charges.
1233 Based on GetMemberAccountRecords.
1234 Charges exempt from non-issue are:
1236 * Rent (rental) if RentalsInNoissuesCharge syspref is set to false
1237 * Manual invoices if ManInvInNoissuesCharge syspref is set to false
1241 sub GetMemberAccountBalance {
1242 my ($borrowernumber) = @_;
1244 my $ACCOUNT_TYPE_LENGTH = 5; # this is plain ridiculous...
1246 my @not_fines = ('Res');
1247 push @not_fines, 'Rent' unless C4::Context->preference('RentalsInNoissuesCharge');
1248 unless ( C4::Context->preference('ManInvInNoissuesCharge') ) {
1249 my $dbh = C4::Context->dbh;
1250 my $man_inv_types = $dbh->selectcol_arrayref(qq{SELECT authorised_value FROM authorised_values WHERE category = 'MANUAL_INV'});
1251 push @not_fines, map substr($_, 0, $ACCOUNT_TYPE_LENGTH), @$man_inv_types;
1253 my %not_fine = map {$_ => 1} @not_fines;
1255 my ($total, $acctlines) = GetMemberAccountRecords($borrowernumber);
1256 my $other_charges = 0;
1257 foreach (@$acctlines) {
1258 $other_charges += $_->{amountoutstanding} if $not_fine{ substr($_->{accounttype}, 0, $ACCOUNT_TYPE_LENGTH) };
1261 return ( $total, $total - $other_charges, $other_charges);
1264 =head2 GetBorNotifyAcctRecord
1266 ($total, $acctlines, $count) = &GetBorNotifyAcctRecord($params,$notifyid);
1268 Looks up accounting data for the patron with the given borrowernumber per file number.
1270 C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a
1271 reference-to-array, where each element is a reference-to-hash; the
1272 keys are the fields of the C<accountlines> table in the Koha database.
1273 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1274 total amount outstanding for all of the account lines.
1278 sub GetBorNotifyAcctRecord {
1279 my ( $borrowernumber, $notifyid ) = @_;
1280 my $dbh = C4::Context->dbh;
1283 my $sth = $dbh->prepare(
1286 WHERE borrowernumber=?
1288 AND amountoutstanding != '0'
1289 ORDER BY notify_id,accounttype
1292 $sth->execute( $borrowernumber, $notifyid );
1294 while ( my $data = $sth->fetchrow_hashref ) {
1295 if ( $data->{itemnumber} ) {
1296 my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
1297 $data->{biblionumber} = $biblio->{biblionumber};
1298 $data->{title} = $biblio->{title};
1300 $acctlines[$numlines] = $data;
1302 $total += int(100 * $data->{'amountoutstanding'});
1305 return ( $total, \@acctlines, $numlines );
1308 =head2 checkuniquemember (OUEST-PROVENCE)
1310 ($result,$categorycode) = &checkuniquemember($collectivity,$surname,$firstname,$dateofbirth);
1312 Checks that a member exists or not in the database.
1314 C<&result> is nonzero (=exist) or 0 (=does not exist)
1315 C<&categorycode> is from categorycode table
1316 C<&collectivity> is 1 (= we add a collectivity) or 0 (= we add a physical member)
1317 C<&surname> is the surname
1318 C<&firstname> is the firstname (only if collectivity=0)
1319 C<&dateofbirth> is the date of birth in ISO format (only if collectivity=0)
1323 # FIXME: This function is not legitimate. Multiple patrons might have the same first/last name and birthdate.
1324 # This is especially true since first name is not even a required field.
1326 sub checkuniquemember {
1327 my ( $collectivity, $surname, $firstname, $dateofbirth ) = @_;
1328 my $dbh = C4::Context->dbh;
1329 my $request = ($collectivity) ?
1330 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? " :
1332 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=? and dateofbirth=?" :
1333 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=?";
1334 my $sth = $dbh->prepare($request);
1335 if ($collectivity) {
1336 $sth->execute( uc($surname) );
1337 } elsif($dateofbirth){
1338 $sth->execute( uc($surname), ucfirst($firstname), $dateofbirth );
1340 $sth->execute( uc($surname), ucfirst($firstname));
1342 my @data = $sth->fetchrow;
1343 ( $data[0] ) and return $data[0], $data[1];
1347 sub checkcardnumber {
1348 my ( $cardnumber, $borrowernumber ) = @_;
1350 # If cardnumber is null, we assume they're allowed.
1351 return 0 unless defined $cardnumber;
1353 my $dbh = C4::Context->dbh;
1354 my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
1355 $query .= " AND borrowernumber <> ?" if ($borrowernumber);
1356 my $sth = $dbh->prepare($query);
1359 ( $borrowernumber ? $borrowernumber : () )
1362 return 1 if $sth->fetchrow_hashref;
1364 my ( $min_length, $max_length ) = get_cardnumber_length();
1366 if length $cardnumber > $max_length
1367 or length $cardnumber < $min_length;
1372 =head2 get_cardnumber_length
1374 my ($min, $max) = C4::Members::get_cardnumber_length()
1376 Returns the minimum and maximum length for patron cardnumbers as
1377 determined by the CardnumberLength system preference, the
1378 BorrowerMandatoryField system preference, and the width of the
1383 sub get_cardnumber_length {
1384 my ( $min, $max ) = ( 0, 16 ); # borrowers.cardnumber is a nullable varchar(16)
1385 $min = 1 if C4::Context->preference('BorrowerMandatoryField') =~ /cardnumber/;
1386 if ( my $cardnumber_length = C4::Context->preference('CardnumberLength') ) {
1387 # Is integer and length match
1388 if ( $cardnumber_length =~ m|^\d+$| ) {
1389 $min = $max = $cardnumber_length
1390 if $cardnumber_length >= $min
1391 and $cardnumber_length <= $max;
1393 # Else assuming it is a range
1394 elsif ( $cardnumber_length =~ m|(\d*),(\d*)| ) {
1395 $min = $1 if $1 and $min < $1;
1396 $max = $2 if $2 and $max > $2;
1400 return ( $min, $max );
1403 =head2 getzipnamecity (OUEST-PROVENCE)
1405 take all info from table city for the fields city and zip
1406 check for the name and the zip code of the city selected
1410 sub getzipnamecity {
1412 my $dbh = C4::Context->dbh;
1415 "select city_name,city_state,city_zipcode,city_country from cities where cityid=? ");
1416 $sth->execute($cityid);
1417 my @data = $sth->fetchrow;
1418 return $data[0], $data[1], $data[2], $data[3];
1422 =head2 getdcity (OUEST-PROVENCE)
1424 recover cityid with city_name condition
1429 my ($city_name) = @_;
1430 my $dbh = C4::Context->dbh;
1431 my $sth = $dbh->prepare("select cityid from cities where city_name=? ");
1432 $sth->execute($city_name);
1433 my $data = $sth->fetchrow;
1437 =head2 GetFirstValidEmailAddress
1439 $email = GetFirstValidEmailAddress($borrowernumber);
1441 Return the first valid email address for a borrower, given the borrowernumber. For now, the order
1442 is defined as email, emailpro, B_email. Returns the empty string if the borrower has no email
1447 sub GetFirstValidEmailAddress {
1448 my $borrowernumber = shift;
1449 my $dbh = C4::Context->dbh;
1450 my $sth = $dbh->prepare( "SELECT email, emailpro, B_email FROM borrowers where borrowernumber = ? ");
1451 $sth->execute( $borrowernumber );
1452 my $data = $sth->fetchrow_hashref;
1454 if ($data->{'email'}) {
1455 return $data->{'email'};
1456 } elsif ($data->{'emailpro'}) {
1457 return $data->{'emailpro'};
1458 } elsif ($data->{'B_email'}) {
1459 return $data->{'B_email'};
1465 =head2 GetNoticeEmailAddress
1467 $email = GetNoticeEmailAddress($borrowernumber);
1469 Return the email address of borrower used for notices, given the borrowernumber.
1470 Returns the empty string if no email address.
1474 sub GetNoticeEmailAddress {
1475 my $borrowernumber = shift;
1477 my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
1478 # if syspref is set to 'first valid' (value == OFF), look up email address
1479 if ( $which_address eq 'OFF' ) {
1480 return GetFirstValidEmailAddress($borrowernumber);
1482 # specified email address field
1483 my $dbh = C4::Context->dbh;
1484 my $sth = $dbh->prepare( qq{
1485 SELECT $which_address AS primaryemail
1487 WHERE borrowernumber=?
1489 $sth->execute($borrowernumber);
1490 my $data = $sth->fetchrow_hashref;
1491 return $data->{'primaryemail'} || '';
1494 =head2 GetExpiryDate
1496 $expirydate = GetExpiryDate($categorycode, $dateenrolled);
1498 Calculate expiry date given a categorycode and starting date. Date argument must be in ISO format.
1499 Return date is also in ISO format.
1504 my ( $categorycode, $dateenrolled ) = @_;
1506 if ($categorycode) {
1507 my $dbh = C4::Context->dbh;
1508 my $sth = $dbh->prepare("SELECT enrolmentperiod,enrolmentperioddate FROM categories WHERE categorycode=?");
1509 $sth->execute($categorycode);
1510 $enrolments = $sth->fetchrow_hashref;
1512 # die "GetExpiryDate: for enrollmentperiod $enrolmentperiod (category '$categorycode') starting $dateenrolled.\n";
1513 my @date = split (/-/,$dateenrolled);
1514 if($enrolments->{enrolmentperiod}){
1515 return sprintf("%04d-%02d-%02d", Add_Delta_YM(@date,0,$enrolments->{enrolmentperiod}));
1517 return $enrolments->{enrolmentperioddate};
1521 =head2 GetborCatFromCatType
1523 ($codes_arrayref, $labels_hashref) = &GetborCatFromCatType();
1525 Looks up the different types of borrowers in the database. Returns two
1526 elements: a reference-to-array, which lists the borrower category
1527 codes, and a reference-to-hash, which maps the borrower category codes
1528 to category descriptions.
1533 sub GetborCatFromCatType {
1534 my ( $category_type, $action, $no_branch_limit ) = @_;
1536 my $branch_limit = $no_branch_limit
1538 : C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1540 # FIXME - This API seems both limited and dangerous.
1541 my $dbh = C4::Context->dbh;
1544 SELECT categories.categorycode, categories.description
1548 LEFT JOIN categories_branches ON categories.categorycode = categories_branches.categorycode
1551 $request .= " $action ";
1552 $request .= " AND (branchcode = ? OR branchcode IS NULL) GROUP BY description" if $branch_limit;
1554 $request .= " WHERE branchcode = ? OR branchcode IS NULL GROUP BY description" if $branch_limit;
1556 $request .= " ORDER BY categorycode";
1558 my $sth = $dbh->prepare($request);
1560 $action ? $category_type : (),
1561 $branch_limit ? $branch_limit : ()
1567 while ( my $data = $sth->fetchrow_hashref ) {
1568 push @codes, $data->{'categorycode'};
1569 $labels{ $data->{'categorycode'} } = $data->{'description'};
1572 return ( \@codes, \%labels );
1575 =head2 GetBorrowercategory
1577 $hashref = &GetBorrowercategory($categorycode);
1579 Given the borrower's category code, the function returns the corresponding
1580 data hashref for a comprehensive information display.
1584 sub GetBorrowercategory {
1586 my $dbh = C4::Context->dbh;
1590 "SELECT description,dateofbirthrequired,upperagelimit,category_type
1592 WHERE categorycode = ?"
1594 $sth->execute($catcode);
1596 $sth->fetchrow_hashref;
1600 } # sub getborrowercategory
1603 =head2 GetBorrowerCategorycode
1605 $categorycode = &GetBorrowerCategoryCode( $borrowernumber );
1607 Given the borrowernumber, the function returns the corresponding categorycode
1610 sub GetBorrowerCategorycode {
1611 my ( $borrowernumber ) = @_;
1612 my $dbh = C4::Context->dbh;
1613 my $sth = $dbh->prepare( qq{
1616 WHERE borrowernumber = ?
1618 $sth->execute( $borrowernumber );
1619 return $sth->fetchrow;
1622 =head2 GetBorrowercategoryList
1624 $arrayref_hashref = &GetBorrowercategoryList;
1625 If no category code provided, the function returns all the categories.
1629 sub GetBorrowercategoryList {
1630 my $no_branch_limit = @_ ? shift : 0;
1631 my $branch_limit = $no_branch_limit
1633 : C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1634 my $dbh = C4::Context->dbh;
1635 my $query = "SELECT categories.* FROM categories";
1637 LEFT JOIN categories_branches ON categories.categorycode = categories_branches.categorycode
1638 WHERE branchcode = ? OR branchcode IS NULL GROUP BY description
1640 $query .= " ORDER BY description";
1641 my $sth = $dbh->prepare( $query );
1642 $sth->execute( $branch_limit ? $branch_limit : () );
1643 my $data = $sth->fetchall_arrayref( {} );
1646 } # sub getborrowercategory
1648 =head2 ethnicitycategories
1650 ($codes_arrayref, $labels_hashref) = ðnicitycategories();
1652 Looks up the different ethnic types in the database. Returns two
1653 elements: a reference-to-array, which lists the ethnicity codes, and a
1654 reference-to-hash, which maps the ethnicity codes to ethnicity
1661 sub ethnicitycategories {
1662 my $dbh = C4::Context->dbh;
1663 my $sth = $dbh->prepare("Select code,name from ethnicity order by name");
1667 while ( my $data = $sth->fetchrow_hashref ) {
1668 push @codes, $data->{'code'};
1669 $labels{ $data->{'code'} } = $data->{'name'};
1671 return ( \@codes, \%labels );
1676 $ethn_name = &fixEthnicity($ethn_code);
1678 Takes an ethnicity code (e.g., "european" or "pi") and returns the
1679 corresponding descriptive name from the C<ethnicity> table in the
1680 Koha database ("European" or "Pacific Islander").
1687 my $ethnicity = shift;
1688 return unless $ethnicity;
1689 my $dbh = C4::Context->dbh;
1690 my $sth = $dbh->prepare("Select name from ethnicity where code = ?");
1691 $sth->execute($ethnicity);
1692 my $data = $sth->fetchrow_hashref;
1693 return $data->{'name'};
1694 } # sub fixEthnicity
1698 $dateofbirth,$date = &GetAge($date);
1700 this function return the borrowers age with the value of dateofbirth
1706 my ( $date, $date_ref ) = @_;
1708 if ( not defined $date_ref ) {
1709 $date_ref = sprintf( '%04d-%02d-%02d', Today() );
1712 my ( $year1, $month1, $day1 ) = split /-/, $date;
1713 my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
1715 my $age = $year2 - $year1;
1716 if ( $month1 . $day1 > $month2 . $day2 ) {
1725 $cityarrayref = GetCities();
1727 Returns an array_ref of the entries in the cities table
1728 If there are entries in the table an empty row is returned
1729 This is currently only used to populate a popup in memberentry
1735 my $dbh = C4::Context->dbh;
1736 my $city_arr = $dbh->selectall_arrayref(
1737 q|SELECT cityid,city_zipcode,city_name,city_state,city_country FROM cities ORDER BY city_name|,
1739 if ( @{$city_arr} ) {
1740 unshift @{$city_arr}, {
1741 city_zipcode => q{},
1745 city_country => q{},
1752 =head2 GetSortDetails (OUEST-PROVENCE)
1754 ($lib) = &GetSortDetails($category,$sortvalue);
1756 Returns the authorized value details
1757 C<&$lib>return value of authorized value details
1758 C<&$sortvalue>this is the value of authorized value
1759 C<&$category>this is the value of authorized value category
1763 sub GetSortDetails {
1764 my ( $category, $sortvalue ) = @_;
1765 my $dbh = C4::Context->dbh;
1766 my $query = qq|SELECT lib
1767 FROM authorised_values
1769 AND authorised_value=? |;
1770 my $sth = $dbh->prepare($query);
1771 $sth->execute( $category, $sortvalue );
1772 my $lib = $sth->fetchrow;
1773 return ($lib) if ($lib);
1774 return ($sortvalue) unless ($lib);
1777 =head2 MoveMemberToDeleted
1779 $result = &MoveMemberToDeleted($borrowernumber);
1781 Copy the record from borrowers to deletedborrowers table.
1785 # FIXME: should do it in one SQL statement w/ subquery
1786 # Otherwise, we should return the @data on success
1788 sub MoveMemberToDeleted {
1789 my ($member) = shift or return;
1790 my $dbh = C4::Context->dbh;
1791 my $query = qq|SELECT *
1793 WHERE borrowernumber=?|;
1794 my $sth = $dbh->prepare($query);
1795 $sth->execute($member);
1796 my @data = $sth->fetchrow_array;
1797 (@data) or return; # if we got a bad borrowernumber, there's nothing to insert
1799 $dbh->prepare( "INSERT INTO deletedborrowers VALUES ("
1800 . ( "?," x ( scalar(@data) - 1 ) )
1802 $sth->execute(@data);
1807 DelMember($borrowernumber);
1809 This function remove directly a borrower whitout writing it on deleteborrower.
1810 + Deletes reserves for the borrower
1815 my $dbh = C4::Context->dbh;
1816 my $borrowernumber = shift;
1817 #warn "in delmember with $borrowernumber";
1818 return unless $borrowernumber; # borrowernumber is mandatory.
1820 my $query = qq|DELETE
1822 WHERE borrowernumber=?|;
1823 my $sth = $dbh->prepare($query);
1824 $sth->execute($borrowernumber);
1828 WHERE borrowernumber = ?
1830 $sth = $dbh->prepare($query);
1831 $sth->execute($borrowernumber);
1832 logaction("MEMBERS", "DELETE", $borrowernumber, "") if C4::Context->preference("BorrowersLog");
1836 =head2 ExtendMemberSubscriptionTo (OUEST-PROVENCE)
1838 $date = ExtendMemberSubscriptionTo($borrowerid, $date);
1840 Extending the subscription to a given date or to the expiry date calculated on ISO date.
1845 sub ExtendMemberSubscriptionTo {
1846 my ( $borrowerid,$date) = @_;
1847 my $dbh = C4::Context->dbh;
1848 my $borrower = GetMember('borrowernumber'=>$borrowerid);
1850 $date = (C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry') ?
1851 C4::Dates->new($borrower->{'dateexpiry'}, 'iso')->output("iso") :
1852 C4::Dates->new()->output("iso");
1853 $date = GetExpiryDate( $borrower->{'categorycode'}, $date );
1855 my $sth = $dbh->do(<<EOF);
1857 SET dateexpiry='$date'
1858 WHERE borrowernumber='$borrowerid'
1861 AddEnrolmentFeeIfNeeded( $borrower->{categorycode}, $borrower->{borrowernumber} );
1863 logaction("MEMBERS", "RENEW", $borrower->{'borrowernumber'}, "Membership renewed")if C4::Context->preference("BorrowersLog");
1864 return $date if ($sth);
1868 =head2 GetTitles (OUEST-PROVENCE)
1870 ($borrowertitle)= &GetTitles();
1872 Looks up the different title . Returns array with all borrowers title
1877 my @borrowerTitle = split (/,|\|/,C4::Context->preference('BorrowersTitles'));
1878 unshift( @borrowerTitle, "" );
1879 my $count=@borrowerTitle;
1884 return ( \@borrowerTitle);
1888 =head2 GetPatronImage
1890 my ($imagedata, $dberror) = GetPatronImage($borrowernumber);
1892 Returns the mimetype and binary image data of the image for the patron with the supplied borrowernumber.
1896 sub GetPatronImage {
1897 my ($borrowernumber) = @_;
1898 warn "Borrowernumber passed to GetPatronImage is $borrowernumber" if $debug;
1899 my $dbh = C4::Context->dbh;
1900 my $query = 'SELECT mimetype, imagefile FROM patronimage WHERE borrowernumber = ?';
1901 my $sth = $dbh->prepare($query);
1902 $sth->execute($borrowernumber);
1903 my $imagedata = $sth->fetchrow_hashref;
1904 warn "Database error!" if $sth->errstr;
1905 return $imagedata, $sth->errstr;
1908 =head2 PutPatronImage
1910 PutPatronImage($cardnumber, $mimetype, $imgfile);
1912 Stores patron binary image data and mimetype in database.
1913 NOTE: This function is good for updating images as well as inserting new images in the database.
1917 sub PutPatronImage {
1918 my ($cardnumber, $mimetype, $imgfile) = @_;
1919 warn "Parameters passed in: Cardnumber=$cardnumber, Mimetype=$mimetype, " . ($imgfile ? "Imagefile" : "No Imagefile") if $debug;
1920 my $dbh = C4::Context->dbh;
1921 my $query = "INSERT INTO patronimage (borrowernumber, mimetype, imagefile) VALUES ( ( SELECT borrowernumber from borrowers WHERE cardnumber = ? ),?,?) ON DUPLICATE KEY UPDATE imagefile = ?;";
1922 my $sth = $dbh->prepare($query);
1923 $sth->execute($cardnumber,$mimetype,$imgfile,$imgfile);
1924 warn "Error returned inserting $cardnumber.$mimetype." if $sth->errstr;
1925 return $sth->errstr;
1928 =head2 RmPatronImage
1930 my ($dberror) = RmPatronImage($borrowernumber);
1932 Removes the image for the patron with the supplied borrowernumber.
1937 my ($borrowernumber) = @_;
1938 warn "Borrowernumber passed to GetPatronImage is $borrowernumber" if $debug;
1939 my $dbh = C4::Context->dbh;
1940 my $query = "DELETE FROM patronimage WHERE borrowernumber = ?;";
1941 my $sth = $dbh->prepare($query);
1942 $sth->execute($borrowernumber);
1943 my $dberror = $sth->errstr;
1944 warn "Database error!" if $sth->errstr;
1948 =head2 GetHideLostItemsPreference
1950 $hidelostitemspref = &GetHideLostItemsPreference($borrowernumber);
1952 Returns the HideLostItems preference for the patron category of the supplied borrowernumber
1953 C<&$hidelostitemspref>return value of function, 0 or 1
1957 sub GetHideLostItemsPreference {
1958 my ($borrowernumber) = @_;
1959 my $dbh = C4::Context->dbh;
1960 my $query = "SELECT hidelostitems FROM borrowers,categories WHERE borrowers.categorycode = categories.categorycode AND borrowernumber = ?";
1961 my $sth = $dbh->prepare($query);
1962 $sth->execute($borrowernumber);
1963 my $hidelostitems = $sth->fetchrow;
1964 return $hidelostitems;
1967 =head2 GetBorrowersToExpunge
1969 $borrowers = &GetBorrowersToExpunge(
1970 not_borrowered_since => $not_borrowered_since,
1971 expired_before => $expired_before,
1972 category_code => $category_code,
1973 branchcode => $branchcode
1976 This function get all borrowers based on the given criteria.
1980 sub GetBorrowersToExpunge {
1983 my $filterdate = $params->{'not_borrowered_since'};
1984 my $filterexpiry = $params->{'expired_before'};
1985 my $filtercategory = $params->{'category_code'};
1986 my $filterbranch = $params->{'branchcode'} ||
1987 ((C4::Context->preference('IndependentBranches')
1988 && C4::Context->userenv
1989 && !C4::Context->IsSuperLibrarian()
1990 && C4::Context->userenv->{branch})
1991 ? C4::Context->userenv->{branch}
1994 my $dbh = C4::Context->dbh;
1996 SELECT borrowers.borrowernumber,
1997 MAX(old_issues.timestamp) AS latestissue,
1998 MAX(issues.timestamp) AS currentissue
2000 JOIN categories USING (categorycode)
2001 LEFT JOIN old_issues USING (borrowernumber)
2002 LEFT JOIN issues USING (borrowernumber)
2003 WHERE category_type <> 'S'
2004 AND borrowernumber NOT IN (SELECT guarantorid FROM borrowers WHERE guarantorid IS NOT NULL AND guarantorid <> 0)
2007 if ( $filterbranch && $filterbranch ne "" ) {
2008 $query.= " AND borrowers.branchcode = ? ";
2009 push( @query_params, $filterbranch );
2011 if ( $filterexpiry ) {
2012 $query .= " AND dateexpiry < ? ";
2013 push( @query_params, $filterexpiry );
2015 if ( $filtercategory ) {
2016 $query .= " AND categorycode = ? ";
2017 push( @query_params, $filtercategory );
2019 $query.=" GROUP BY borrowers.borrowernumber HAVING currentissue IS NULL ";
2020 if ( $filterdate ) {
2021 $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
2022 push @query_params,$filterdate;
2024 warn $query if $debug;
2026 my $sth = $dbh->prepare($query);
2027 if (scalar(@query_params)>0){
2028 $sth->execute(@query_params);
2035 while ( my $data = $sth->fetchrow_hashref ) {
2036 push @results, $data;
2041 =head2 GetBorrowersWhoHaveNeverBorrowed
2043 $results = &GetBorrowersWhoHaveNeverBorrowed
2045 This function get all borrowers who have never borrowed.
2047 I<$result> is a ref to an array which all elements are a hasref.
2051 sub GetBorrowersWhoHaveNeverBorrowed {
2052 my $filterbranch = shift ||
2053 ((C4::Context->preference('IndependentBranches')
2054 && C4::Context->userenv
2055 && !C4::Context->IsSuperLibrarian()
2056 && C4::Context->userenv->{branch})
2057 ? C4::Context->userenv->{branch}
2059 my $dbh = C4::Context->dbh;
2061 SELECT borrowers.borrowernumber,max(timestamp) as latestissue
2063 LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
2064 WHERE issues.borrowernumber IS NULL
2067 if ($filterbranch && $filterbranch ne ""){
2068 $query.=" AND borrowers.branchcode= ?";
2069 push @query_params,$filterbranch;
2071 warn $query if $debug;
2073 my $sth = $dbh->prepare($query);
2074 if (scalar(@query_params)>0){
2075 $sth->execute(@query_params);
2082 while ( my $data = $sth->fetchrow_hashref ) {
2083 push @results, $data;
2088 =head2 GetBorrowersWithIssuesHistoryOlderThan
2090 $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
2092 this function get all borrowers who has an issue history older than I<$date> given on input arg.
2094 I<$result> is a ref to an array which all elements are a hashref.
2095 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2099 sub GetBorrowersWithIssuesHistoryOlderThan {
2100 my $dbh = C4::Context->dbh;
2101 my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
2102 my $filterbranch = shift ||
2103 ((C4::Context->preference('IndependentBranches')
2104 && C4::Context->userenv
2105 && !C4::Context->IsSuperLibrarian()
2106 && C4::Context->userenv->{branch})
2107 ? C4::Context->userenv->{branch}
2110 SELECT count(borrowernumber) as n,borrowernumber
2112 WHERE returndate < ?
2113 AND borrowernumber IS NOT NULL
2116 push @query_params, $date;
2118 $query.=" AND branchcode = ?";
2119 push @query_params, $filterbranch;
2121 $query.=" GROUP BY borrowernumber ";
2122 warn $query if $debug;
2123 my $sth = $dbh->prepare($query);
2124 $sth->execute(@query_params);
2127 while ( my $data = $sth->fetchrow_hashref ) {
2128 push @results, $data;
2133 =head2 GetBorrowersNamesAndLatestIssue
2135 $results = &GetBorrowersNamesAndLatestIssueList(@borrowernumbers)
2137 this function get borrowers Names and surnames and Issue information.
2139 I<@borrowernumbers> is an array which all elements are borrowernumbers.
2140 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2144 sub GetBorrowersNamesAndLatestIssue {
2145 my $dbh = C4::Context->dbh;
2146 my @borrowernumbers=@_;
2148 SELECT surname,lastname, phone, email,max(timestamp)
2150 LEFT JOIN issues ON borrowers.borrowernumber=issues.borrowernumber
2151 GROUP BY borrowernumber
2153 my $sth = $dbh->prepare($query);
2155 my $results = $sth->fetchall_arrayref({});
2163 my $success = ModPrivacy( $borrowernumber, $privacy );
2165 Update the privacy of a patron.
2168 true on success, false on failure
2175 my $borrowernumber = shift;
2176 my $privacy = shift;
2177 return unless defined $borrowernumber;
2178 return unless $borrowernumber =~ /^\d+$/;
2180 return ModMember( borrowernumber => $borrowernumber,
2181 privacy => $privacy );
2186 AddMessage( $borrowernumber, $message_type, $message, $branchcode );
2188 Adds a message to the messages table for the given borrower.
2197 my ( $borrowernumber, $message_type, $message, $branchcode ) = @_;
2199 my $dbh = C4::Context->dbh;
2201 if ( ! ( $borrowernumber && $message_type && $message && $branchcode ) ) {
2205 my $query = "INSERT INTO messages ( borrowernumber, branchcode, message_type, message ) VALUES ( ?, ?, ?, ? )";
2206 my $sth = $dbh->prepare($query);
2207 $sth->execute( $borrowernumber, $branchcode, $message_type, $message );
2208 logaction("MEMBERS", "ADDCIRCMESSAGE", $borrowernumber, $message) if C4::Context->preference("BorrowersLog");
2214 GetMessages( $borrowernumber, $type );
2216 $type is message type, B for borrower, or L for Librarian.
2217 Empty type returns all messages of any type.
2219 Returns all messages for the given borrowernumber
2224 my ( $borrowernumber, $type, $branchcode ) = @_;
2230 my $dbh = C4::Context->dbh;
2233 branches.branchname,
2236 messages.branchcode LIKE '$branchcode' AS can_delete
2237 FROM messages, branches
2238 WHERE borrowernumber = ?
2239 AND message_type LIKE ?
2240 AND messages.branchcode = branches.branchcode
2241 ORDER BY message_date DESC";
2242 my $sth = $dbh->prepare($query);
2243 $sth->execute( $borrowernumber, $type ) ;
2246 while ( my $data = $sth->fetchrow_hashref ) {
2247 my $d = C4::Dates->new( $data->{message_date}, 'iso' );
2248 $data->{message_date_formatted} = $d->output;
2249 push @results, $data;
2257 GetMessagesCount( $borrowernumber, $type );
2259 $type is message type, B for borrower, or L for Librarian.
2260 Empty type returns all messages of any type.
2262 Returns the number of messages for the given borrowernumber
2266 sub GetMessagesCount {
2267 my ( $borrowernumber, $type, $branchcode ) = @_;
2273 my $dbh = C4::Context->dbh;
2275 my $query = "SELECT COUNT(*) as MsgCount FROM messages WHERE borrowernumber = ? AND message_type LIKE ?";
2276 my $sth = $dbh->prepare($query);
2277 $sth->execute( $borrowernumber, $type ) ;
2280 my $data = $sth->fetchrow_hashref;
2281 my $count = $data->{'MsgCount'};
2288 =head2 DeleteMessage
2290 DeleteMessage( $message_id );
2295 my ( $message_id ) = @_;
2297 my $dbh = C4::Context->dbh;
2298 my $query = "SELECT * FROM messages WHERE message_id = ?";
2299 my $sth = $dbh->prepare($query);
2300 $sth->execute( $message_id );
2301 my $message = $sth->fetchrow_hashref();
2303 $query = "DELETE FROM messages WHERE message_id = ?";
2304 $sth = $dbh->prepare($query);
2305 $sth->execute( $message_id );
2306 logaction("MEMBERS", "DELCIRCMESSAGE", $message->{'borrowernumber'}, $message->{'message'}) if C4::Context->preference("BorrowersLog");
2311 IssueSlip($branchcode, $borrowernumber, $quickslip)
2313 Returns letter hash ( see C4::Letters::GetPreparedLetter )
2315 $quickslip is boolean, to indicate whether we want a quick slip
2320 my ($branch, $borrowernumber, $quickslip) = @_;
2322 # return unless ( C4::Context->boolean_preference('printcirculationslips') );
2324 my $now = POSIX::strftime("%Y-%m-%d", localtime);
2326 my $issueslist = GetPendingIssues($borrowernumber);
2327 foreach my $it (@$issueslist){
2328 if ((substr $it->{'issuedate'}, 0, 10) eq $now || (substr $it->{'lastreneweddate'}, 0, 10) eq $now) {
2331 elsif ((substr $it->{'date_due'}, 0, 10) le $now) {
2332 $it->{'overdue'} = 1;
2334 my $dt = dt_from_string( $it->{'date_due'} );
2335 $it->{'date_due'} = output_pref( $dt );;
2337 my @issues = sort { $b->{'timestamp'} <=> $a->{'timestamp'} } @$issueslist;
2339 my ($letter_code, %repeat);
2341 $letter_code = 'ISSUEQSLIP';
2343 'checkedout' => [ map {
2347 }, grep { $_->{'now'} } @issues ],
2351 $letter_code = 'ISSUESLIP';
2353 'checkedout' => [ map {
2357 }, grep { !$_->{'overdue'} } @issues ],
2359 'overdue' => [ map {
2363 }, grep { $_->{'overdue'} } @issues ],
2366 $_->{'timestamp'} = $_->{'newdate'};
2368 } @{ GetNewsToDisplay("slip",$branch) } ],
2372 return C4::Letters::GetPreparedLetter (
2373 module => 'circulation',
2374 letter_code => $letter_code,
2375 branchcode => $branch,
2377 'branches' => $branch,
2378 'borrowers' => $borrowernumber,
2384 =head2 GetBorrowersWithEmail
2386 ([$borrnum,$userid], ...) = GetBorrowersWithEmail('me@example.com');
2388 This gets a list of users and their basic details from their email address.
2389 As it's possible for multiple user to have the same email address, it provides
2390 you with all of them. If there is no userid for the user, there will be an
2391 C<undef> there. An empty list will be returned if there are no matches.
2395 sub GetBorrowersWithEmail {
2398 my $dbh = C4::Context->dbh;
2400 my $query = "SELECT borrowernumber, userid FROM borrowers WHERE email=?";
2401 my $sth=$dbh->prepare($query);
2402 $sth->execute($email);
2404 while (my $ref = $sth->fetch) {
2407 die "Failure searching for borrowers by email address: $sth->errstr" if $sth->err;
2411 sub AddMember_Opac {
2412 my ( %borrower ) = @_;
2414 $borrower{'categorycode'} = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
2416 my $sr = new String::Random;
2417 $sr->{'A'} = [ 'A'..'Z', 'a'..'z' ];
2418 my $password = $sr->randpattern("AAAAAAAAAA");
2419 $borrower{'password'} = $password;
2421 $borrower{'cardnumber'} = fixup_cardnumber();
2423 my $borrowernumber = AddMember(%borrower);
2425 return ( $borrowernumber, $password );
2428 =head2 AddEnrolmentFeeIfNeeded
2430 AddEnrolmentFeeIfNeeded( $borrower->{categorycode}, $borrower->{borrowernumber} );
2432 Add enrolment fee for a patron if needed.
2436 sub AddEnrolmentFeeIfNeeded {
2437 my ( $categorycode, $borrowernumber ) = @_;
2438 # check for enrollment fee & add it if needed
2439 my $dbh = C4::Context->dbh;
2440 my $sth = $dbh->prepare(q{
2443 WHERE categorycode=?
2445 $sth->execute( $categorycode );
2447 warn sprintf('Database returned the following error: %s', $sth->errstr);
2450 my ($enrolmentfee) = $sth->fetchrow;
2451 if ($enrolmentfee && $enrolmentfee > 0) {
2452 # insert fee in patron debts
2453 C4::Accounts::manualinvoice( $borrowernumber, '', '', 'A', $enrolmentfee );
2458 my ( $borrowernumber ) = @_;
2460 my $sql = "SELECT COUNT(*) FROM issues WHERE date_due < NOW() AND borrowernumber = ?";
2461 my $sth = C4::Context->dbh->prepare( $sql );
2462 $sth->execute( $borrowernumber );
2463 my ( $count ) = $sth->fetchrow_array();
2468 END { } # module clean-up code here (global destructor)