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 Digest::MD5 qw(md5_base64);
28 use String::Random qw( random_string );
29 use Date::Calc qw/Today Add_Delta_YM check_date Date_to_Days/;
30 use C4::Log; # logaction
36 use C4::SQLHelper qw(InsertInTable UpdateInTable SearchInTable);
37 use C4::Members::Attributes qw(SearchIdMatchingAttribute);
38 use C4::NewsChannels; #get slip news
40 use DateTime::Format::DateParse;
42 use Text::Unaccent qw( unac_string );
44 our ($VERSION,@ISA,@EXPORT,@EXPORT_OK,$debug);
47 $VERSION = 3.07.00.049;
48 $debug = $ENV{DEBUG} || 0;
60 &GetMemberIssuesAndFines
68 &GetFirstValidEmailAddress
69 &GetNoticeEmailAddress
82 &GetHideLostItemsPreference
85 &GetMemberAccountRecords
86 &GetBorNotifyAcctRecord
90 GetBorrowerCategorycode
91 &GetBorrowercategoryList
93 &GetBorrowersToExpunge
94 &GetBorrowersWhoHaveNeverBorrowed
95 &GetBorrowersWithIssuesHistoryOlderThan
105 GetBorrowersWithEmail
126 &ExtendMemberSubscriptionTo
144 C4::Members - Perl Module containing convenience functions for member handling
152 This module contains routines for adding, modifying and deleting members/patrons/borrowers
158 $borrowers_result_array_ref = &Search($filter,$orderby, $limit,
159 $columns_out, $search_on_fields,$searchtype);
161 Looks up patrons (borrowers) on filter. A wrapper for SearchInTable('borrowers').
163 For C<$filter>, C<$orderby>, C<$limit>, C<&columns_out>, C<&search_on_fields> and C<&searchtype>
164 refer to C4::SQLHelper:SearchInTable().
166 Special C<$filter> key '' is effectively expanded to search on surname firstname othernamescw
167 and cardnumber unless C<&search_on_fields> is defined
171 $borrowers = Search('abcd', 'cardnumber');
173 $borrowers = Search({''=>'abcd', category_type=>'I'}, 'surname');
177 sub _express_member_find {
180 # this is used by circulation everytime a new borrowers cardnumber is scanned
181 # so we can check an exact match first, if that works return, otherwise do the rest
182 my $dbh = C4::Context->dbh;
183 my $query = "SELECT borrowernumber FROM borrowers WHERE cardnumber = ?";
184 if ( my $borrowernumber = $dbh->selectrow_array($query, undef, $filter) ) {
185 return( {"borrowernumber"=>$borrowernumber} );
188 my ($search_on_fields, $searchtype);
189 if ( length($filter) == 1 ) {
190 $search_on_fields = [ qw(surname) ];
191 $searchtype = 'start_with';
193 $search_on_fields = [ qw(surname firstname othernames cardnumber) ];
194 $searchtype = 'contain';
197 return (undef, $search_on_fields, $searchtype);
201 my ( $filter, $orderby, $limit, $columns_out, $search_on_fields, $searchtype ) = @_;
206 if ( my $fr = ref $filter ) {
207 if ( $fr eq "HASH" ) {
208 if ( my $search_string = $filter->{''} ) {
209 my ($member_filter, $member_search_on_fields, $member_searchtype) = _express_member_find($search_string);
210 if ($member_filter) {
211 $filter = $member_filter;
214 $search_on_fields ||= $member_search_on_fields;
215 $searchtype ||= $member_searchtype;
220 $search_string = $filter;
224 $search_string = $filter;
225 my ($member_filter, $member_search_on_fields, $member_searchtype) = _express_member_find($search_string);
226 if ($member_filter) {
227 $filter = $member_filter;
230 $search_on_fields ||= $member_search_on_fields;
231 $searchtype ||= $member_searchtype;
235 if ( !$found_borrower && C4::Context->preference('ExtendedPatronAttributes') && $search_string ) {
236 my $matching_records = C4::Members::Attributes::SearchIdMatchingAttribute($search_string);
237 if(scalar(@$matching_records)>0) {
238 if ( my $fr = ref $filter ) {
239 if ( $fr eq "HASH" ) {
241 $filter = [ $filter ];
243 push @$filter, { %f, "borrowernumber"=>$$matching_records };
246 push @$filter, {"borrowernumber"=>$matching_records};
250 $filter = [ $filter ];
251 push @$filter, {"borrowernumber"=>$matching_records};
256 # $showallbranches was not used at the time SearchMember() was mainstreamed into Search().
257 # Mentioning for the reference
259 if ( C4::Context->preference("IndependentBranches") ) { # && !$showallbranches){
260 if ( my $userenv = C4::Context->userenv ) {
261 my $branch = $userenv->{'branch'};
262 if ( ($userenv->{flags} % 2 !=1) && $branch ){
263 if (my $fr = ref $filter) {
264 if ( $fr eq "HASH" ) {
265 $filter->{branchcode} = $branch;
269 $_ = { '' => $_ } unless ref $_;
270 $_->{branchcode} = $branch;
275 $filter = { '' => $filter, branchcode => $branch };
281 if ($found_borrower) {
282 $searchtype = "exact";
284 $searchtype ||= "start_with";
286 return SearchInTable( "borrowers", $filter, $orderby, $limit, $columns_out, $search_on_fields, $searchtype );
289 =head2 GetMemberDetails
291 ($borrower) = &GetMemberDetails($borrowernumber, $cardnumber);
293 Looks up a patron and returns information about him or her. If
294 C<$borrowernumber> is true (nonzero), C<&GetMemberDetails> looks
295 up the borrower by number; otherwise, it looks up the borrower by card
298 C<$borrower> is a reference-to-hash whose keys are the fields of the
299 borrowers table in the Koha database. In addition,
300 C<$borrower-E<gt>{flags}> is a hash giving more detailed information
301 about the patron. Its keys act as flags :
303 if $borrower->{flags}->{LOST} {
304 # Patron's card was reported lost
307 If the state of a flag means that the patron should not be
308 allowed to borrow any more books, then it will have a C<noissues> key
311 See patronflags for more details.
313 C<$borrower-E<gt>{authflags}> is a hash giving more detailed information
314 about the top-level permissions flags set for the borrower. For example,
315 if a user has the "editcatalogue" permission,
316 C<$borrower-E<gt>{authflags}-E<gt>{editcatalogue}> will exist and have
321 sub GetMemberDetails {
322 my ( $borrowernumber, $cardnumber ) = @_;
323 my $dbh = C4::Context->dbh;
326 if ($borrowernumber) {
327 $sth = $dbh->prepare("SELECT borrowers.*,category_type,categories.description,reservefee,enrolmentperiod FROM borrowers LEFT JOIN categories ON borrowers.categorycode=categories.categorycode WHERE borrowernumber=?");
328 $sth->execute($borrowernumber);
330 elsif ($cardnumber) {
331 $sth = $dbh->prepare("SELECT borrowers.*,category_type,categories.description,reservefee,enrolmentperiod FROM borrowers LEFT JOIN categories ON borrowers.categorycode=categories.categorycode WHERE cardnumber=?");
332 $sth->execute($cardnumber);
337 my $borrower = $sth->fetchrow_hashref;
338 my ($amount) = GetMemberAccountRecords( $borrowernumber);
339 $borrower->{'amountoutstanding'} = $amount;
340 # FIXME - patronflags calls GetMemberAccountRecords... just have patronflags return $amount
341 my $flags = patronflags( $borrower);
344 $sth = $dbh->prepare("select bit,flag from userflags");
346 while ( my ( $bit, $flag ) = $sth->fetchrow ) {
347 if ( $borrower->{'flags'} && $borrower->{'flags'} & 2**$bit ) {
348 $accessflagshash->{$flag} = 1;
351 $borrower->{'flags'} = $flags;
352 $borrower->{'authflags'} = $accessflagshash;
354 # For the purposes of making templates easier, we'll define a
355 # 'showname' which is the alternate form the user's first name if
356 # 'other name' is defined.
357 if ($borrower->{category_type} eq 'I') {
358 $borrower->{'showname'} = $borrower->{'othernames'};
359 $borrower->{'showname'} .= " $borrower->{'firstname'}" if $borrower->{'firstname'};
361 $borrower->{'showname'} = $borrower->{'firstname'};
364 return ($borrower); #, $flags, $accessflagshash);
369 $flags = &patronflags($patron);
371 This function is not exported.
373 The following will be set where applicable:
374 $flags->{CHARGES}->{amount} Amount of debt
375 $flags->{CHARGES}->{noissues} Set if debt amount >$5.00 (or syspref noissuescharge)
376 $flags->{CHARGES}->{message} Message -- deprecated
378 $flags->{CREDITS}->{amount} Amount of credit
379 $flags->{CREDITS}->{message} Message -- deprecated
381 $flags->{ GNA } Patron has no valid address
382 $flags->{ GNA }->{noissues} Set for each GNA
383 $flags->{ GNA }->{message} "Borrower has no valid address" -- deprecated
385 $flags->{ LOST } Patron's card reported lost
386 $flags->{ LOST }->{noissues} Set for each LOST
387 $flags->{ LOST }->{message} Message -- deprecated
389 $flags->{DBARRED} Set if patron debarred, no access
390 $flags->{DBARRED}->{noissues} Set for each DBARRED
391 $flags->{DBARRED}->{message} Message -- deprecated
394 $flags->{ NOTES }->{message} The note itself. NOT deprecated
396 $flags->{ ODUES } Set if patron has overdue books.
397 $flags->{ ODUES }->{message} "Yes" -- deprecated
398 $flags->{ ODUES }->{itemlist} ref-to-array: list of overdue books
399 $flags->{ ODUES }->{itemlisttext} Text list of overdue items -- deprecated
401 $flags->{WAITING} Set if any of patron's reserves are available
402 $flags->{WAITING}->{message} Message -- deprecated
403 $flags->{WAITING}->{itemlist} ref-to-array: list of available items
407 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
408 overdue items. Its elements are references-to-hash, each describing an
409 overdue item. The keys are selected fields from the issues, biblio,
410 biblioitems, and items tables of the Koha database.
412 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
413 the overdue items, one per line. Deprecated.
415 =item C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
416 available items. Each element is a reference-to-hash whose keys are
417 fields from the reserves table of the Koha database.
421 All the "message" fields that include language generated in this function are deprecated,
422 because such strings belong properly in the display layer.
424 The "message" field that comes from the DB is OK.
428 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
429 # FIXME rename this function.
432 my ( $patroninformation) = @_;
433 my $dbh=C4::Context->dbh;
434 my ($balance, $owing) = GetMemberAccountBalance( $patroninformation->{'borrowernumber'});
437 my $noissuescharge = C4::Context->preference("noissuescharge") || 5;
438 $flaginfo{'message'} = sprintf 'Patron owes %.02f', $owing;
439 $flaginfo{'amount'} = sprintf "%.02f", $owing;
440 if ( $owing > $noissuescharge && !C4::Context->preference("AllowFineOverride") ) {
441 $flaginfo{'noissues'} = 1;
443 $flags{'CHARGES'} = \%flaginfo;
445 elsif ( $balance < 0 ) {
447 $flaginfo{'message'} = sprintf 'Patron has credit of %.02f', -$balance;
448 $flaginfo{'amount'} = sprintf "%.02f", $balance;
449 $flags{'CREDITS'} = \%flaginfo;
451 if ( $patroninformation->{'gonenoaddress'}
452 && $patroninformation->{'gonenoaddress'} == 1 )
455 $flaginfo{'message'} = 'Borrower has no valid address.';
456 $flaginfo{'noissues'} = 1;
457 $flags{'GNA'} = \%flaginfo;
459 if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
461 $flaginfo{'message'} = 'Borrower\'s card reported lost.';
462 $flaginfo{'noissues'} = 1;
463 $flags{'LOST'} = \%flaginfo;
465 if ( $patroninformation->{'debarred'} && check_date( split( /-/, $patroninformation->{'debarred'} ) ) ) {
466 if ( Date_to_Days(Date::Calc::Today) < Date_to_Days( split( /-/, $patroninformation->{'debarred'} ) ) ) {
468 $flaginfo{'debarredcomment'} = $patroninformation->{'debarredcomment'};
469 $flaginfo{'message'} = $patroninformation->{'debarredcomment'};
470 $flaginfo{'noissues'} = 1;
471 $flaginfo{'dateend'} = $patroninformation->{'debarred'};
472 $flags{'DBARRED'} = \%flaginfo;
475 if ( $patroninformation->{'borrowernotes'}
476 && $patroninformation->{'borrowernotes'} )
479 $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
480 $flags{'NOTES'} = \%flaginfo;
482 my ( $odues, $itemsoverdue ) = C4::Overdues::checkoverdues($patroninformation->{'borrowernumber'});
483 if ( $odues && $odues > 0 ) {
485 $flaginfo{'message'} = "Yes";
486 $flaginfo{'itemlist'} = $itemsoverdue;
487 foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
490 $flaginfo{'itemlisttext'} .=
491 "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n"; # newline is display layer
493 $flags{'ODUES'} = \%flaginfo;
495 my @itemswaiting = C4::Reserves::GetReservesFromBorrowernumber( $patroninformation->{'borrowernumber'},'W' );
496 my $nowaiting = scalar @itemswaiting;
497 if ( $nowaiting > 0 ) {
499 $flaginfo{'message'} = "Reserved items available";
500 $flaginfo{'itemlist'} = \@itemswaiting;
501 $flags{'WAITING'} = \%flaginfo;
509 $borrower = &GetMember(%information);
511 Retrieve the first patron record meeting on criteria listed in the
512 C<%information> hash, which should contain one or more
513 pairs of borrowers column names and values, e.g.,
515 $borrower = GetMember(borrowernumber => id);
517 C<&GetBorrower> returns a reference-to-hash whose keys are the fields of
518 the C<borrowers> table in the Koha database.
520 FIXME: GetMember() is used throughout the code as a lookup
521 on a unique key such as the borrowernumber, but this meaning is not
522 enforced in the routine itself.
528 my ( %information ) = @_;
529 if (exists $information{borrowernumber} && !defined $information{borrowernumber}) {
530 #passing mysql's kohaadmin?? Makes no sense as a query
533 my $dbh = C4::Context->dbh;
535 q{SELECT borrowers.*, categories.category_type, categories.description
537 LEFT JOIN categories on borrowers.categorycode=categories.categorycode WHERE };
540 for (keys %information ) {
548 if (defined $information{$_}) {
550 push @values, $information{$_};
553 $select .= "$_ IS NULL";
556 $debug && warn $select, " ",values %information;
557 my $sth = $dbh->prepare("$select");
558 $sth->execute(map{$information{$_}} keys %information);
559 my $data = $sth->fetchall_arrayref({});
560 #FIXME interface to this routine now allows generation of a result set
561 #so whole array should be returned but bowhere in the current code expects this
569 =head2 GetMemberRelatives
571 @borrowernumbers = GetMemberRelatives($borrowernumber);
573 C<GetMemberRelatives> returns a borrowersnumber's list of guarantor/guarantees of the member given in parameter
576 sub GetMemberRelatives {
577 my $borrowernumber = shift;
578 my $dbh = C4::Context->dbh;
582 my $query = "SELECT guarantorid FROM borrowers WHERE borrowernumber=?";
583 my $sth = $dbh->prepare($query);
584 $sth->execute($borrowernumber);
585 my $data = $sth->fetchrow_arrayref();
586 push @glist, $data->[0] if $data->[0];
587 my $guarantor = $data->[0] ? $data->[0] : undef;
590 $query = "SELECT borrowernumber FROM borrowers WHERE guarantorid=?";
591 $sth = $dbh->prepare($query);
592 $sth->execute($borrowernumber);
593 while ($data = $sth->fetchrow_arrayref()) {
594 push @glist, $data->[0];
597 # Getting sibling guarantees
599 $query = "SELECT borrowernumber FROM borrowers WHERE guarantorid=?";
600 $sth = $dbh->prepare($query);
601 $sth->execute($guarantor);
602 while ($data = $sth->fetchrow_arrayref()) {
603 push @glist, $data->[0] if ($data->[0] != $borrowernumber);
610 =head2 IsMemberBlocked
612 my ($block_status, $count) = IsMemberBlocked( $borrowernumber );
614 Returns whether a patron has overdue items that may result
615 in a block or whether the patron has active fine days
616 that would block circulation privileges.
618 C<$block_status> can have the following values:
620 1 if the patron has outstanding fine days, in which case C<$count> is the number of them
622 -1 if the patron has overdue items, in which case C<$count> is the number of them
624 0 if the patron has no overdue items or outstanding fine days, in which case C<$count> is 0
626 Outstanding fine days are checked before current overdue items
629 FIXME: this needs to be split into two functions; a potential block
630 based on the number of current overdue items could be orthogonal
631 to a block based on whether the patron has any fine days accrued.
635 sub IsMemberBlocked {
636 my $borrowernumber = shift;
637 my $dbh = C4::Context->dbh;
639 my $blockeddate = CheckBorrowerDebarred($borrowernumber);
641 return ( 1, $blockeddate ) if $blockeddate;
643 # if he have late issues
644 my $sth = $dbh->prepare(
645 "SELECT COUNT(*) as latedocs
647 WHERE borrowernumber = ?
648 AND date_due < now()"
650 $sth->execute($borrowernumber);
651 my $latedocs = $sth->fetchrow_hashref->{'latedocs'};
653 return ( -1, $latedocs ) if $latedocs > 0;
658 =head2 GetMemberIssuesAndFines
660 ($overdue_count, $issue_count, $total_fines) = &GetMemberIssuesAndFines($borrowernumber);
662 Returns aggregate data about items borrowed by the patron with the
663 given borrowernumber.
665 C<&GetMemberIssuesAndFines> returns a three-element array. C<$overdue_count> is the
666 number of overdue items the patron currently has borrowed. C<$issue_count> is the
667 number of books the patron currently has borrowed. C<$total_fines> is
668 the total fine currently due by the borrower.
673 sub GetMemberIssuesAndFines {
674 my ( $borrowernumber ) = @_;
675 my $dbh = C4::Context->dbh;
676 my $query = "SELECT COUNT(*) FROM issues WHERE borrowernumber = ?";
678 $debug and warn $query."\n";
679 my $sth = $dbh->prepare($query);
680 $sth->execute($borrowernumber);
681 my $issue_count = $sth->fetchrow_arrayref->[0];
683 $sth = $dbh->prepare(
684 "SELECT COUNT(*) FROM issues
685 WHERE borrowernumber = ?
686 AND date_due < now()"
688 $sth->execute($borrowernumber);
689 my $overdue_count = $sth->fetchrow_arrayref->[0];
691 $sth = $dbh->prepare("SELECT SUM(amountoutstanding) FROM accountlines WHERE borrowernumber = ?");
692 $sth->execute($borrowernumber);
693 my $total_fines = $sth->fetchrow_arrayref->[0];
695 return ($overdue_count, $issue_count, $total_fines);
706 my @borrower_columns = C4::Member->columns;
710 The array of borrowers' table columns on success.
711 An empty array on failure.
715 This runs significantly faster than the previous code while
716 being mostly SQL-agnostic.
722 # Pure ANSI SQL goodness.
723 my $sql = 'SELECT * FROM borrowers WHERE 1=0;';
725 # Get the database handle.
726 my $dbh = C4::Context->dbh;
728 # Run the SQL statement to load STH's readonly properties.
729 my $sth = $dbh->prepare($sql);
730 my $rv = $sth->execute();
732 # This only fails if the table doesn't exist.
733 # This will always be called AFTER an install or upgrade,
734 # so borrowers will exist!
736 if ($sth->{NUM_OF_FIELDS}>0) {
737 @data = @{$sth->{NAME}};
748 my $success = ModMember(borrowernumber => $borrowernumber,
749 [ field => value ]... );
751 Modify borrower's data. All date fields should ALREADY be in ISO format.
754 true on success, or false on failure
760 # test to know if you must update or not the borrower password
761 if (exists $data{password}) {
762 if ($data{password} eq '****' or $data{password} eq '') {
763 delete $data{password};
765 $data{password} = md5_base64($data{password});
768 my $execute_success=UpdateInTable("borrowers",\%data);
769 if ($execute_success) { # only proceed if the update was a success
770 # ok if its an adult (type) it may have borrowers that depend on it as a guarantor
771 # so when we update information for an adult we should check for guarantees and update the relevant part
772 # of their records, ie addresses and phone numbers
773 my $borrowercategory= GetBorrowercategory( $data{'category_type'} );
774 if ( exists $borrowercategory->{'category_type'} && $borrowercategory->{'category_type'} eq ('A' || 'S') ) {
775 # is adult check guarantees;
776 UpdateGuarantees(%data);
778 logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "UPDATE (executed w/ arg: $data{'borrowernumber'})") if C4::Context->preference("BorrowersLog");
780 return $execute_success;
786 $borrowernumber = &AddMember(%borrower);
788 insert new borrower into table
789 Returns the borrowernumber upon success
791 Returns as undef upon any db error without further processing
798 my $dbh = C4::Context->dbh;
800 # generate a proper login if none provided
801 $data{'userid'} = Generate_Userid($data{'borrowernumber'}, $data{'firstname'}, $data{'surname'}) if $data{'userid'} eq '';
803 # add expiration date if it isn't already there
804 unless ( $data{'dateexpiry'} ) {
805 $data{'dateexpiry'} = GetExpiryDate( $data{'categorycode'}, C4::Dates->new()->output("iso") );
808 # add enrollment date if it isn't already there
809 unless ( $data{'dateenrolled'} ) {
810 $data{'dateenrolled'} = C4::Dates->new()->output("iso");
813 # create a disabled account if no password provided
814 $data{'password'} = ($data{'password'})? md5_base64($data{'password'}) : '!';
815 $data{'borrowernumber'}=InsertInTable("borrowers",\%data);
818 # mysql_insertid is probably bad. not necessarily accurate and mysql-specific at best.
819 logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
821 # check for enrollment fee & add it if needed
822 my $sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
823 $sth->execute($data{'categorycode'});
824 my ($enrolmentfee) = $sth->fetchrow;
826 warn sprintf('Database returned the following error: %s', $sth->errstr);
829 if ($enrolmentfee && $enrolmentfee > 0) {
830 # insert fee in patron debts
831 manualinvoice($data{'borrowernumber'}, '', '', 'A', $enrolmentfee);
834 return $data{'borrowernumber'};
839 my $uniqueness = Check_Userid($userid,$borrowernumber);
841 $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 != '').
843 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.
846 0 for not unique (i.e. this $userid already exists)
847 1 for unique (i.e. this $userid does not exist, or this $userid/$borrowernumber combination already exists)
852 my ($uid,$member) = @_;
853 my $dbh = C4::Context->dbh;
856 "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
857 $sth->execute( $uid, $member );
858 if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
866 =head2 Generate_Userid
868 my $newuid = Generate_Userid($borrowernumber, $firstname, $surname);
870 Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
872 $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.
875 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).
879 sub Generate_Userid {
880 my ($borrowernumber, $firstname, $surname) = @_;
883 #The script will "do" the following code and increment the $offset until Check_Userid = 1 (i.e. until $newuid comes back as unique)
885 $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
886 $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
887 $newuid = lc(($firstname)? "$firstname.$surname" : $surname);
888 $newuid = unac_string('utf-8',$newuid);
889 $newuid .= $offset unless $offset == 0;
892 } while (!Check_Userid($newuid,$borrowernumber));
898 my ( $uid, $member, $digest ) = @_;
899 my $dbh = C4::Context->dbh;
901 #Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
902 #Then we need to tell the user and have them create a new one.
906 "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
907 $sth->execute( $uid, $member );
908 if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
912 #Everything is good so we can update the information.
915 "update borrowers set userid=?, password=? where borrowernumber=?");
916 $sth->execute( $uid, $digest, $member );
920 logaction("MEMBERS", "CHANGE PASS", $member, "") if C4::Context->preference("BorrowersLog");
926 =head2 fixup_cardnumber
928 Warning: The caller is responsible for locking the members table in write
929 mode, to avoid database corruption.
933 use vars qw( @weightings );
934 my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
936 sub fixup_cardnumber {
937 my ($cardnumber) = @_;
938 my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;
940 # Find out whether member numbers should be generated
941 # automatically. Should be either "1" or something else.
942 # Defaults to "0", which is interpreted as "no".
944 # if ($cardnumber !~ /\S/ && $autonumber_members) {
945 ($autonumber_members) or return $cardnumber;
946 my $checkdigit = C4::Context->preference('checkdigit');
947 my $dbh = C4::Context->dbh;
948 if ( $checkdigit and $checkdigit eq 'katipo' ) {
950 # if checkdigit is selected, calculate katipo-style cardnumber.
951 # otherwise, just use the max()
952 # purpose: generate checksum'd member numbers.
953 # We'll assume we just got the max value of digits 2-8 of member #'s
954 # from the database and our job is to increment that by one,
955 # determine the 1st and 9th digits and return the full string.
956 my $sth = $dbh->prepare(
957 "select max(substring(borrowers.cardnumber,2,7)) as new_num from borrowers"
960 my $data = $sth->fetchrow_hashref;
961 $cardnumber = $data->{new_num};
962 if ( !$cardnumber ) { # If DB has no values,
963 $cardnumber = 1000000; # start at 1000000
969 for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
970 # read weightings, left to right, 1 char at a time
971 my $temp1 = $weightings[$i];
973 # sequence left to right, 1 char at a time
974 my $temp2 = substr( $cardnumber, $i, 1 );
976 # mult each char 1-7 by its corresponding weighting
977 $sum += $temp1 * $temp2;
980 my $rem = ( $sum % 11 );
981 $rem = 'X' if $rem == 10;
983 return "V$cardnumber$rem";
986 my $sth = $dbh->prepare(
987 'SELECT MAX( CAST( cardnumber AS SIGNED ) ) FROM borrowers WHERE cardnumber REGEXP "^-?[0-9]+$"'
990 my ($result) = $sth->fetchrow;
993 return $cardnumber; # just here as a fallback/reminder
998 ($num_children, $children_arrayref) = &GetGuarantees($parent_borrno);
999 $child0_cardno = $children_arrayref->[0]{"cardnumber"};
1000 $child0_borrno = $children_arrayref->[0]{"borrowernumber"};
1002 C<&GetGuarantees> takes a borrower number (e.g., that of a patron
1003 with children) and looks up the borrowers who are guaranteed by that
1004 borrower (i.e., the patron's children).
1006 C<&GetGuarantees> returns two values: an integer giving the number of
1007 borrowers guaranteed by C<$parent_borrno>, and a reference to an array
1008 of references to hash, which gives the actual results.
1014 my ($borrowernumber) = @_;
1015 my $dbh = C4::Context->dbh;
1018 "select cardnumber,borrowernumber, firstname, surname from borrowers where guarantorid=?"
1020 $sth->execute($borrowernumber);
1023 my $data = $sth->fetchall_arrayref({});
1024 return ( scalar(@$data), $data );
1027 =head2 UpdateGuarantees
1029 &UpdateGuarantees($parent_borrno);
1032 C<&UpdateGuarantees> borrower data for an adult and updates all the guarantees
1033 with the modified information
1038 sub UpdateGuarantees {
1040 my $dbh = C4::Context->dbh;
1041 my ( $count, $guarantees ) = GetGuarantees( $data{'borrowernumber'} );
1042 foreach my $guarantee (@$guarantees){
1043 my $guaquery = qq|UPDATE borrowers
1044 SET address=?,fax=?,B_city=?,mobile=?,city=?,phone=?
1045 WHERE borrowernumber=?
1047 my $sth = $dbh->prepare($guaquery);
1048 $sth->execute($data{'address'},$data{'fax'},$data{'B_city'},$data{'mobile'},$data{'city'},$data{'phone'},$guarantee->{'borrowernumber'});
1051 =head2 GetPendingIssues
1053 my $issues = &GetPendingIssues(@borrowernumber);
1055 Looks up what the patron with the given borrowernumber has borrowed.
1057 C<&GetPendingIssues> returns a
1058 reference-to-array where each element is a reference-to-hash; the
1059 keys are the fields from the C<issues>, C<biblio>, and C<items> tables.
1060 The keys include C<biblioitems> fields except marc and marcxml.
1065 sub GetPendingIssues {
1066 my @borrowernumbers = @_;
1068 unless (@borrowernumbers ) { # return a ref_to_array
1069 return \@borrowernumbers; # to not cause surprise to caller
1072 # Borrowers part of the query
1074 for (my $i = 0; $i < @borrowernumbers; $i++) {
1075 $bquery .= ' issues.borrowernumber = ?';
1076 if ($i < $#borrowernumbers ) {
1081 # must avoid biblioitems.* to prevent large marc and marcxml fields from killing performance
1082 # FIXME: namespace collision: each table has "timestamp" fields. Which one is "timestamp" ?
1083 # FIXME: circ/ciculation.pl tries to sort by timestamp!
1084 # FIXME: namespace collision: other collisions possible.
1085 # FIXME: most of this data isn't really being used by callers.
1092 biblioitems.itemtype,
1095 biblioitems.publicationyear,
1096 biblioitems.publishercode,
1097 biblioitems.volumedate,
1098 biblioitems.volumedesc,
1101 borrowers.firstname,
1103 borrowers.cardnumber,
1104 issues.timestamp AS timestamp,
1105 issues.renewals AS renewals,
1106 issues.borrowernumber AS borrowernumber,
1107 items.renewals AS totalrenewals
1109 LEFT JOIN items ON items.itemnumber = issues.itemnumber
1110 LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
1111 LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
1112 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
1115 ORDER BY issues.issuedate"
1118 my $sth = C4::Context->dbh->prepare($query);
1119 $sth->execute(@borrowernumbers);
1120 my $data = $sth->fetchall_arrayref({});
1121 my $tz = C4::Context->tz();
1122 my $today = DateTime->now( time_zone => $tz);
1123 foreach (@{$data}) {
1124 if ($_->{issuedate}) {
1125 $_->{issuedate} = dt_from_string($_->{issuedate}, 'sql');
1127 $_->{date_due} or next;
1128 $_->{date_due} = DateTime::Format::DateParse->parse_datetime($_->{date_due}, $tz->name());
1129 if ( DateTime->compare($_->{date_due}, $today) == -1 ) {
1138 $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
1140 Looks up what the patron with the given borrowernumber has borrowed,
1141 and sorts the results.
1143 C<$sortkey> is the name of a field on which to sort the results. This
1144 should be the name of a field in the C<issues>, C<biblio>,
1145 C<biblioitems>, or C<items> table in the Koha database.
1147 C<$limit> is the maximum number of results to return.
1149 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
1150 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
1151 C<items> tables of the Koha database.
1157 my ( $borrowernumber, $order, $limit ) = @_;
1159 my $dbh = C4::Context->dbh;
1161 'SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1163 LEFT JOIN items on items.itemnumber=issues.itemnumber
1164 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1165 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1166 WHERE borrowernumber=?
1168 SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1170 LEFT JOIN items on items.itemnumber=old_issues.itemnumber
1171 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1172 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1173 WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL
1174 order by ' . $order;
1176 $query .= " limit $limit";
1179 my $sth = $dbh->prepare($query);
1180 $sth->execute( $borrowernumber, $borrowernumber );
1181 return $sth->fetchall_arrayref( {} );
1185 =head2 GetMemberAccountRecords
1187 ($total, $acctlines, $count) = &GetMemberAccountRecords($borrowernumber);
1189 Looks up accounting data for the patron with the given borrowernumber.
1191 C<&GetMemberAccountRecords> returns a three-element array. C<$acctlines> is a
1192 reference-to-array, where each element is a reference-to-hash; the
1193 keys are the fields of the C<accountlines> table in the Koha database.
1194 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1195 total amount outstanding for all of the account lines.
1199 sub GetMemberAccountRecords {
1200 my ($borrowernumber) = @_;
1201 my $dbh = C4::Context->dbh;
1207 WHERE borrowernumber=?);
1208 $strsth.=" ORDER BY date desc,timestamp DESC";
1209 my $sth= $dbh->prepare( $strsth );
1210 $sth->execute( $borrowernumber );
1213 while ( my $data = $sth->fetchrow_hashref ) {
1214 if ( $data->{itemnumber} ) {
1215 my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
1216 $data->{biblionumber} = $biblio->{biblionumber};
1217 $data->{title} = $biblio->{title};
1219 $acctlines[$numlines] = $data;
1221 $total += int(1000 * $data->{'amountoutstanding'}); # convert float to integer to avoid round-off errors
1224 return ( $total, \@acctlines,$numlines);
1227 =head2 GetMemberAccountBalance
1229 ($total_balance, $non_issue_balance, $other_charges) = &GetMemberAccountBalance($borrowernumber);
1231 Calculates amount immediately owing by the patron - non-issue charges.
1232 Based on GetMemberAccountRecords.
1233 Charges exempt from non-issue are:
1235 * Rent (rental) if RentalsInNoissuesCharge syspref is set to false
1236 * Manual invoices if ManInvInNoissuesCharge syspref is set to false
1240 sub GetMemberAccountBalance {
1241 my ($borrowernumber) = @_;
1243 my $ACCOUNT_TYPE_LENGTH = 5; # this is plain ridiculous...
1245 my @not_fines = ('Res');
1246 push @not_fines, 'Rent' unless C4::Context->preference('RentalsInNoissuesCharge');
1247 unless ( C4::Context->preference('ManInvInNoissuesCharge') ) {
1248 my $dbh = C4::Context->dbh;
1249 my $man_inv_types = $dbh->selectcol_arrayref(qq{SELECT authorised_value FROM authorised_values WHERE category = 'MANUAL_INV'});
1250 push @not_fines, map substr($_, 0, $ACCOUNT_TYPE_LENGTH), @$man_inv_types;
1252 my %not_fine = map {$_ => 1} @not_fines;
1254 my ($total, $acctlines) = GetMemberAccountRecords($borrowernumber);
1255 my $other_charges = 0;
1256 foreach (@$acctlines) {
1257 $other_charges += $_->{amountoutstanding} if $not_fine{ substr($_->{accounttype}, 0, $ACCOUNT_TYPE_LENGTH) };
1260 return ( $total, $total - $other_charges, $other_charges);
1263 =head2 GetBorNotifyAcctRecord
1265 ($total, $acctlines, $count) = &GetBorNotifyAcctRecord($params,$notifyid);
1267 Looks up accounting data for the patron with the given borrowernumber per file number.
1269 C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a
1270 reference-to-array, where each element is a reference-to-hash; the
1271 keys are the fields of the C<accountlines> table in the Koha database.
1272 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1273 total amount outstanding for all of the account lines.
1277 sub GetBorNotifyAcctRecord {
1278 my ( $borrowernumber, $notifyid ) = @_;
1279 my $dbh = C4::Context->dbh;
1282 my $sth = $dbh->prepare(
1285 WHERE borrowernumber=?
1287 AND amountoutstanding != '0'
1288 ORDER BY notify_id,accounttype
1291 $sth->execute( $borrowernumber, $notifyid );
1293 while ( my $data = $sth->fetchrow_hashref ) {
1294 if ( $data->{itemnumber} ) {
1295 my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
1296 $data->{biblionumber} = $biblio->{biblionumber};
1297 $data->{title} = $biblio->{title};
1299 $acctlines[$numlines] = $data;
1301 $total += int(100 * $data->{'amountoutstanding'});
1304 return ( $total, \@acctlines, $numlines );
1307 =head2 checkuniquemember (OUEST-PROVENCE)
1309 ($result,$categorycode) = &checkuniquemember($collectivity,$surname,$firstname,$dateofbirth);
1311 Checks that a member exists or not in the database.
1313 C<&result> is nonzero (=exist) or 0 (=does not exist)
1314 C<&categorycode> is from categorycode table
1315 C<&collectivity> is 1 (= we add a collectivity) or 0 (= we add a physical member)
1316 C<&surname> is the surname
1317 C<&firstname> is the firstname (only if collectivity=0)
1318 C<&dateofbirth> is the date of birth in ISO format (only if collectivity=0)
1322 # FIXME: This function is not legitimate. Multiple patrons might have the same first/last name and birthdate.
1323 # This is especially true since first name is not even a required field.
1325 sub checkuniquemember {
1326 my ( $collectivity, $surname, $firstname, $dateofbirth ) = @_;
1327 my $dbh = C4::Context->dbh;
1328 my $request = ($collectivity) ?
1329 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? " :
1331 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=? and dateofbirth=?" :
1332 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=?";
1333 my $sth = $dbh->prepare($request);
1334 if ($collectivity) {
1335 $sth->execute( uc($surname) );
1336 } elsif($dateofbirth){
1337 $sth->execute( uc($surname), ucfirst($firstname), $dateofbirth );
1339 $sth->execute( uc($surname), ucfirst($firstname));
1341 my @data = $sth->fetchrow;
1342 ( $data[0] ) and return $data[0], $data[1];
1346 sub checkcardnumber {
1347 my ($cardnumber,$borrowernumber) = @_;
1348 # If cardnumber is null, we assume they're allowed.
1349 return 0 if !defined($cardnumber);
1350 my $dbh = C4::Context->dbh;
1351 my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
1352 $query .= " AND borrowernumber <> ?" if ($borrowernumber);
1353 my $sth = $dbh->prepare($query);
1354 if ($borrowernumber) {
1355 $sth->execute($cardnumber,$borrowernumber);
1357 $sth->execute($cardnumber);
1359 if (my $data= $sth->fetchrow_hashref()){
1368 =head2 getzipnamecity (OUEST-PROVENCE)
1370 take all info from table city for the fields city and zip
1371 check for the name and the zip code of the city selected
1375 sub getzipnamecity {
1377 my $dbh = C4::Context->dbh;
1380 "select city_name,city_state,city_zipcode,city_country from cities where cityid=? ");
1381 $sth->execute($cityid);
1382 my @data = $sth->fetchrow;
1383 return $data[0], $data[1], $data[2], $data[3];
1387 =head2 getdcity (OUEST-PROVENCE)
1389 recover cityid with city_name condition
1394 my ($city_name) = @_;
1395 my $dbh = C4::Context->dbh;
1396 my $sth = $dbh->prepare("select cityid from cities where city_name=? ");
1397 $sth->execute($city_name);
1398 my $data = $sth->fetchrow;
1402 =head2 GetFirstValidEmailAddress
1404 $email = GetFirstValidEmailAddress($borrowernumber);
1406 Return the first valid email address for a borrower, given the borrowernumber. For now, the order
1407 is defined as email, emailpro, B_email. Returns the empty string if the borrower has no email
1412 sub GetFirstValidEmailAddress {
1413 my $borrowernumber = shift;
1414 my $dbh = C4::Context->dbh;
1415 my $sth = $dbh->prepare( "SELECT email, emailpro, B_email FROM borrowers where borrowernumber = ? ");
1416 $sth->execute( $borrowernumber );
1417 my $data = $sth->fetchrow_hashref;
1419 if ($data->{'email'}) {
1420 return $data->{'email'};
1421 } elsif ($data->{'emailpro'}) {
1422 return $data->{'emailpro'};
1423 } elsif ($data->{'B_email'}) {
1424 return $data->{'B_email'};
1430 =head2 GetNoticeEmailAddress
1432 $email = GetNoticeEmailAddress($borrowernumber);
1434 Return the email address of borrower used for notices, given the borrowernumber.
1435 Returns the empty string if no email address.
1439 sub GetNoticeEmailAddress {
1440 my $borrowernumber = shift;
1442 my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
1443 # if syspref is set to 'first valid' (value == OFF), look up email address
1444 if ( $which_address eq 'OFF' ) {
1445 return GetFirstValidEmailAddress($borrowernumber);
1447 # specified email address field
1448 my $dbh = C4::Context->dbh;
1449 my $sth = $dbh->prepare( qq{
1450 SELECT $which_address AS primaryemail
1452 WHERE borrowernumber=?
1454 $sth->execute($borrowernumber);
1455 my $data = $sth->fetchrow_hashref;
1456 return $data->{'primaryemail'} || '';
1459 =head2 GetExpiryDate
1461 $expirydate = GetExpiryDate($categorycode, $dateenrolled);
1463 Calculate expiry date given a categorycode and starting date. Date argument must be in ISO format.
1464 Return date is also in ISO format.
1469 my ( $categorycode, $dateenrolled ) = @_;
1471 if ($categorycode) {
1472 my $dbh = C4::Context->dbh;
1473 my $sth = $dbh->prepare("SELECT enrolmentperiod,enrolmentperioddate FROM categories WHERE categorycode=?");
1474 $sth->execute($categorycode);
1475 $enrolments = $sth->fetchrow_hashref;
1477 # die "GetExpiryDate: for enrollmentperiod $enrolmentperiod (category '$categorycode') starting $dateenrolled.\n";
1478 my @date = split (/-/,$dateenrolled);
1479 if($enrolments->{enrolmentperiod}){
1480 return sprintf("%04d-%02d-%02d", Add_Delta_YM(@date,0,$enrolments->{enrolmentperiod}));
1482 return $enrolments->{enrolmentperioddate};
1486 =head2 checkuserpassword (OUEST-PROVENCE)
1488 check for the password and login are not used
1489 return the number of record
1490 0=> NOT USED 1=> USED
1494 sub checkuserpassword {
1495 my ( $borrowernumber, $userid, $password ) = @_;
1496 $password = md5_base64($password);
1497 my $dbh = C4::Context->dbh;
1500 "Select count(*) from borrowers where borrowernumber !=? and userid =? and password=? "
1502 $sth->execute( $borrowernumber, $userid, $password );
1503 my $number_rows = $sth->fetchrow;
1504 return $number_rows;
1508 =head2 GetborCatFromCatType
1510 ($codes_arrayref, $labels_hashref) = &GetborCatFromCatType();
1512 Looks up the different types of borrowers in the database. Returns two
1513 elements: a reference-to-array, which lists the borrower category
1514 codes, and a reference-to-hash, which maps the borrower category codes
1515 to category descriptions.
1520 sub GetborCatFromCatType {
1521 my ( $category_type, $action, $no_branch_limit ) = @_;
1523 my $branch_limit = $no_branch_limit
1525 : C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1527 # FIXME - This API seems both limited and dangerous.
1528 my $dbh = C4::Context->dbh;
1531 SELECT categories.categorycode, categories.description
1535 LEFT JOIN categories_branches ON categories.categorycode = categories_branches.categorycode
1538 $request .= " $action ";
1539 $request .= " AND (branchcode = ? OR branchcode IS NULL) GROUP BY description" if $branch_limit;
1541 $request .= " WHERE branchcode = ? OR branchcode IS NULL GROUP BY description" if $branch_limit;
1543 $request .= " ORDER BY categorycode";
1545 my $sth = $dbh->prepare($request);
1547 $action ? $category_type : (),
1548 $branch_limit ? $branch_limit : ()
1554 while ( my $data = $sth->fetchrow_hashref ) {
1555 push @codes, $data->{'categorycode'};
1556 $labels{ $data->{'categorycode'} } = $data->{'description'};
1559 return ( \@codes, \%labels );
1562 =head2 GetBorrowercategory
1564 $hashref = &GetBorrowercategory($categorycode);
1566 Given the borrower's category code, the function returns the corresponding
1567 data hashref for a comprehensive information display.
1571 sub GetBorrowercategory {
1573 my $dbh = C4::Context->dbh;
1577 "SELECT description,dateofbirthrequired,upperagelimit,category_type
1579 WHERE categorycode = ?"
1581 $sth->execute($catcode);
1583 $sth->fetchrow_hashref;
1587 } # sub getborrowercategory
1590 =head2 GetBorrowerCategorycode
1592 $categorycode = &GetBorrowerCategoryCode( $borrowernumber );
1594 Given the borrowernumber, the function returns the corresponding categorycode
1597 sub GetBorrowerCategorycode {
1598 my ( $borrowernumber ) = @_;
1599 my $dbh = C4::Context->dbh;
1600 my $sth = $dbh->prepare( qq{
1603 WHERE borrowernumber = ?
1605 $sth->execute( $borrowernumber );
1606 return $sth->fetchrow;
1609 =head2 GetBorrowercategoryList
1611 $arrayref_hashref = &GetBorrowercategoryList;
1612 If no category code provided, the function returns all the categories.
1616 sub GetBorrowercategoryList {
1617 my $no_branch_limit = @_ ? shift : 0;
1618 my $branch_limit = $no_branch_limit
1620 : C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1621 my $dbh = C4::Context->dbh;
1622 my $query = "SELECT categories.* FROM categories";
1624 LEFT JOIN categories_branches ON categories.categorycode = categories_branches.categorycode
1625 WHERE branchcode = ? OR branchcode IS NULL GROUP BY description
1627 $query .= " ORDER BY description";
1628 my $sth = $dbh->prepare( $query );
1629 $sth->execute( $branch_limit ? $branch_limit : () );
1630 my $data = $sth->fetchall_arrayref( {} );
1633 } # sub getborrowercategory
1635 =head2 ethnicitycategories
1637 ($codes_arrayref, $labels_hashref) = ðnicitycategories();
1639 Looks up the different ethnic types in the database. Returns two
1640 elements: a reference-to-array, which lists the ethnicity codes, and a
1641 reference-to-hash, which maps the ethnicity codes to ethnicity
1648 sub ethnicitycategories {
1649 my $dbh = C4::Context->dbh;
1650 my $sth = $dbh->prepare("Select code,name from ethnicity order by name");
1654 while ( my $data = $sth->fetchrow_hashref ) {
1655 push @codes, $data->{'code'};
1656 $labels{ $data->{'code'} } = $data->{'name'};
1658 return ( \@codes, \%labels );
1663 $ethn_name = &fixEthnicity($ethn_code);
1665 Takes an ethnicity code (e.g., "european" or "pi") and returns the
1666 corresponding descriptive name from the C<ethnicity> table in the
1667 Koha database ("European" or "Pacific Islander").
1674 my $ethnicity = shift;
1675 return unless $ethnicity;
1676 my $dbh = C4::Context->dbh;
1677 my $sth = $dbh->prepare("Select name from ethnicity where code = ?");
1678 $sth->execute($ethnicity);
1679 my $data = $sth->fetchrow_hashref;
1680 return $data->{'name'};
1681 } # sub fixEthnicity
1685 $dateofbirth,$date = &GetAge($date);
1687 this function return the borrowers age with the value of dateofbirth
1693 my ( $date, $date_ref ) = @_;
1695 if ( not defined $date_ref ) {
1696 $date_ref = sprintf( '%04d-%02d-%02d', Today() );
1699 my ( $year1, $month1, $day1 ) = split /-/, $date;
1700 my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
1702 my $age = $year2 - $year1;
1703 if ( $month1 . $day1 > $month2 . $day2 ) {
1710 =head2 get_institutions
1712 $insitutions = get_institutions();
1714 Just returns a list of all the borrowers of type I, borrownumber and name
1719 sub get_institutions {
1720 my $dbh = C4::Context->dbh();
1723 "SELECT borrowernumber,surname FROM borrowers WHERE categorycode=? ORDER BY surname"
1727 while ( my $data = $sth->fetchrow_hashref() ) {
1728 $orgs{ $data->{'borrowernumber'} } = $data;
1732 } # sub get_institutions
1734 =head2 add_member_orgs
1736 add_member_orgs($borrowernumber,$borrowernumbers);
1738 Takes a borrowernumber and a list of other borrowernumbers and inserts them into the borrowers_to_borrowers table
1743 sub add_member_orgs {
1744 my ( $borrowernumber, $otherborrowers ) = @_;
1745 my $dbh = C4::Context->dbh();
1747 "INSERT INTO borrowers_to_borrowers (borrower1,borrower2) VALUES (?,?)";
1748 my $sth = $dbh->prepare($query);
1749 foreach my $otherborrowernumber (@$otherborrowers) {
1750 $sth->execute( $borrowernumber, $otherborrowernumber );
1753 } # sub add_member_orgs
1757 $cityarrayref = GetCities();
1759 Returns an array_ref of the entries in the cities table
1760 If there are entries in the table an empty row is returned
1761 This is currently only used to populate a popup in memberentry
1767 my $dbh = C4::Context->dbh;
1768 my $city_arr = $dbh->selectall_arrayref(
1769 q|SELECT cityid,city_zipcode,city_name,city_state,city_country FROM cities ORDER BY city_name|,
1771 if ( @{$city_arr} ) {
1772 unshift @{$city_arr}, {
1773 city_zipcode => q{},
1777 city_country => q{},
1784 =head2 GetSortDetails (OUEST-PROVENCE)
1786 ($lib) = &GetSortDetails($category,$sortvalue);
1788 Returns the authorized value details
1789 C<&$lib>return value of authorized value details
1790 C<&$sortvalue>this is the value of authorized value
1791 C<&$category>this is the value of authorized value category
1795 sub GetSortDetails {
1796 my ( $category, $sortvalue ) = @_;
1797 my $dbh = C4::Context->dbh;
1798 my $query = qq|SELECT lib
1799 FROM authorised_values
1801 AND authorised_value=? |;
1802 my $sth = $dbh->prepare($query);
1803 $sth->execute( $category, $sortvalue );
1804 my $lib = $sth->fetchrow;
1805 return ($lib) if ($lib);
1806 return ($sortvalue) unless ($lib);
1809 =head2 MoveMemberToDeleted
1811 $result = &MoveMemberToDeleted($borrowernumber);
1813 Copy the record from borrowers to deletedborrowers table.
1817 # FIXME: should do it in one SQL statement w/ subquery
1818 # Otherwise, we should return the @data on success
1820 sub MoveMemberToDeleted {
1821 my ($member) = shift or return;
1822 my $dbh = C4::Context->dbh;
1823 my $query = qq|SELECT *
1825 WHERE borrowernumber=?|;
1826 my $sth = $dbh->prepare($query);
1827 $sth->execute($member);
1828 my @data = $sth->fetchrow_array;
1829 (@data) or return; # if we got a bad borrowernumber, there's nothing to insert
1831 $dbh->prepare( "INSERT INTO deletedborrowers VALUES ("
1832 . ( "?," x ( scalar(@data) - 1 ) )
1834 $sth->execute(@data);
1839 DelMember($borrowernumber);
1841 This function remove directly a borrower whitout writing it on deleteborrower.
1842 + Deletes reserves for the borrower
1847 my $dbh = C4::Context->dbh;
1848 my $borrowernumber = shift;
1849 #warn "in delmember with $borrowernumber";
1850 return unless $borrowernumber; # borrowernumber is mandatory.
1852 my $query = qq|DELETE
1854 WHERE borrowernumber=?|;
1855 my $sth = $dbh->prepare($query);
1856 $sth->execute($borrowernumber);
1860 WHERE borrowernumber = ?
1862 $sth = $dbh->prepare($query);
1863 $sth->execute($borrowernumber);
1864 logaction("MEMBERS", "DELETE", $borrowernumber, "") if C4::Context->preference("BorrowersLog");
1868 =head2 ExtendMemberSubscriptionTo (OUEST-PROVENCE)
1870 $date = ExtendMemberSubscriptionTo($borrowerid, $date);
1872 Extending the subscription to a given date or to the expiry date calculated on ISO date.
1877 sub ExtendMemberSubscriptionTo {
1878 my ( $borrowerid,$date) = @_;
1879 my $dbh = C4::Context->dbh;
1880 my $borrower = GetMember('borrowernumber'=>$borrowerid);
1882 $date = (C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry') ?
1883 C4::Dates->new($borrower->{'dateexpiry'}, 'iso')->output("iso") :
1884 C4::Dates->new()->output("iso");
1885 $date = GetExpiryDate( $borrower->{'categorycode'}, $date );
1887 my $sth = $dbh->do(<<EOF);
1889 SET dateexpiry='$date'
1890 WHERE borrowernumber='$borrowerid'
1892 # add enrolmentfee if needed
1893 $sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
1894 $sth->execute($borrower->{'categorycode'});
1895 my ($enrolmentfee) = $sth->fetchrow;
1896 if ($enrolmentfee && $enrolmentfee > 0) {
1897 # insert fee in patron debts
1898 manualinvoice($borrower->{'borrowernumber'}, '', '', 'A', $enrolmentfee);
1900 logaction("MEMBERS", "RENEW", $borrower->{'borrowernumber'}, "Membership renewed")if C4::Context->preference("BorrowersLog");
1901 return $date if ($sth);
1905 =head2 GetRoadTypes (OUEST-PROVENCE)
1907 ($idroadtypearrayref, $roadttype_hashref) = &GetRoadTypes();
1909 Looks up the different road type . Returns two
1910 elements: a reference-to-array, which lists the id_roadtype
1911 codes, and a reference-to-hash, which maps the road type of the road .
1916 my $dbh = C4::Context->dbh;
1918 SELECT roadtypeid,road_type
1920 ORDER BY road_type|;
1921 my $sth = $dbh->prepare($query);
1926 # insert empty value to create a empty choice in cgi popup
1928 while ( my $data = $sth->fetchrow_hashref ) {
1930 push @id, $data->{'roadtypeid'};
1931 $roadtype{ $data->{'roadtypeid'} } = $data->{'road_type'};
1934 #test to know if the table contain some records if no the function return nothing
1941 return ( \@id, \%roadtype );
1947 =head2 GetTitles (OUEST-PROVENCE)
1949 ($borrowertitle)= &GetTitles();
1951 Looks up the different title . Returns array with all borrowers title
1956 my @borrowerTitle = split (/,|\|/,C4::Context->preference('BorrowersTitles'));
1957 unshift( @borrowerTitle, "" );
1958 my $count=@borrowerTitle;
1963 return ( \@borrowerTitle);
1967 =head2 GetPatronImage
1969 my ($imagedata, $dberror) = GetPatronImage($cardnumber);
1971 Returns the mimetype and binary image data of the image for the patron with the supplied cardnumber.
1975 sub GetPatronImage {
1976 my ($cardnumber) = @_;
1977 warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1978 my $dbh = C4::Context->dbh;
1979 my $query = 'SELECT mimetype, imagefile FROM patronimage WHERE cardnumber = ?';
1980 my $sth = $dbh->prepare($query);
1981 $sth->execute($cardnumber);
1982 my $imagedata = $sth->fetchrow_hashref;
1983 warn "Database error!" if $sth->errstr;
1984 return $imagedata, $sth->errstr;
1987 =head2 PutPatronImage
1989 PutPatronImage($cardnumber, $mimetype, $imgfile);
1991 Stores patron binary image data and mimetype in database.
1992 NOTE: This function is good for updating images as well as inserting new images in the database.
1996 sub PutPatronImage {
1997 my ($cardnumber, $mimetype, $imgfile) = @_;
1998 warn "Parameters passed in: Cardnumber=$cardnumber, Mimetype=$mimetype, " . ($imgfile ? "Imagefile" : "No Imagefile") if $debug;
1999 my $dbh = C4::Context->dbh;
2000 my $query = "INSERT INTO patronimage (cardnumber, mimetype, imagefile) VALUES (?,?,?) ON DUPLICATE KEY UPDATE imagefile = ?;";
2001 my $sth = $dbh->prepare($query);
2002 $sth->execute($cardnumber,$mimetype,$imgfile,$imgfile);
2003 warn "Error returned inserting $cardnumber.$mimetype." if $sth->errstr;
2004 return $sth->errstr;
2007 =head2 RmPatronImage
2009 my ($dberror) = RmPatronImage($cardnumber);
2011 Removes the image for the patron with the supplied cardnumber.
2016 my ($cardnumber) = @_;
2017 warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
2018 my $dbh = C4::Context->dbh;
2019 my $query = "DELETE FROM patronimage WHERE cardnumber = ?;";
2020 my $sth = $dbh->prepare($query);
2021 $sth->execute($cardnumber);
2022 my $dberror = $sth->errstr;
2023 warn "Database error!" if $sth->errstr;
2027 =head2 GetHideLostItemsPreference
2029 $hidelostitemspref = &GetHideLostItemsPreference($borrowernumber);
2031 Returns the HideLostItems preference for the patron category of the supplied borrowernumber
2032 C<&$hidelostitemspref>return value of function, 0 or 1
2036 sub GetHideLostItemsPreference {
2037 my ($borrowernumber) = @_;
2038 my $dbh = C4::Context->dbh;
2039 my $query = "SELECT hidelostitems FROM borrowers,categories WHERE borrowers.categorycode = categories.categorycode AND borrowernumber = ?";
2040 my $sth = $dbh->prepare($query);
2041 $sth->execute($borrowernumber);
2042 my $hidelostitems = $sth->fetchrow;
2043 return $hidelostitems;
2046 =head2 GetRoadTypeDetails (OUEST-PROVENCE)
2048 ($roadtype) = &GetRoadTypeDetails($roadtypeid);
2050 Returns the description of roadtype
2051 C<&$roadtype>return description of road type
2052 C<&$roadtypeid>this is the value of roadtype s
2056 sub GetRoadTypeDetails {
2057 my ($roadtypeid) = @_;
2058 my $dbh = C4::Context->dbh;
2062 WHERE roadtypeid=?|;
2063 my $sth = $dbh->prepare($query);
2064 $sth->execute($roadtypeid);
2065 my $roadtype = $sth->fetchrow;
2069 =head2 GetBorrowersToExpunge
2071 $borrowers = &GetBorrowersToExpunge(
2072 not_borrowered_since => $not_borrowered_since,
2073 expired_before => $expired_before,
2074 category_code => $category_code,
2075 branchcode => $branchcode
2078 This function get all borrowers based on the given criteria.
2082 sub GetBorrowersToExpunge {
2085 my $filterdate = $params->{'not_borrowered_since'};
2086 my $filterexpiry = $params->{'expired_before'};
2087 my $filtercategory = $params->{'category_code'};
2088 my $filterbranch = $params->{'branchcode'} ||
2089 ((C4::Context->preference('IndependentBranches')
2090 && C4::Context->userenv
2091 && C4::Context->userenv->{flags} % 2 !=1
2092 && C4::Context->userenv->{branch})
2093 ? C4::Context->userenv->{branch}
2096 my $dbh = C4::Context->dbh;
2098 SELECT borrowers.borrowernumber,
2099 MAX(old_issues.timestamp) AS latestissue,
2100 MAX(issues.timestamp) AS currentissue
2102 JOIN categories USING (categorycode)
2103 LEFT JOIN old_issues USING (borrowernumber)
2104 LEFT JOIN issues USING (borrowernumber)
2105 WHERE category_type <> 'S'
2106 AND borrowernumber NOT IN (SELECT guarantorid FROM borrowers WHERE guarantorid IS NOT NULL AND guarantorid <> 0)
2109 if ( $filterbranch && $filterbranch ne "" ) {
2110 $query.= " AND borrowers.branchcode = ? ";
2111 push( @query_params, $filterbranch );
2113 if ( $filterexpiry ) {
2114 $query .= " AND dateexpiry < ? ";
2115 push( @query_params, $filterexpiry );
2117 if ( $filtercategory ) {
2118 $query .= " AND categorycode = ? ";
2119 push( @query_params, $filtercategory );
2121 $query.=" GROUP BY borrowers.borrowernumber HAVING currentissue IS NULL ";
2122 if ( $filterdate ) {
2123 $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
2124 push @query_params,$filterdate;
2126 warn $query if $debug;
2128 my $sth = $dbh->prepare($query);
2129 if (scalar(@query_params)>0){
2130 $sth->execute(@query_params);
2137 while ( my $data = $sth->fetchrow_hashref ) {
2138 push @results, $data;
2143 =head2 GetBorrowersWhoHaveNeverBorrowed
2145 $results = &GetBorrowersWhoHaveNeverBorrowed
2147 This function get all borrowers who have never borrowed.
2149 I<$result> is a ref to an array which all elements are a hasref.
2153 sub GetBorrowersWhoHaveNeverBorrowed {
2154 my $filterbranch = shift ||
2155 ((C4::Context->preference('IndependentBranches')
2156 && C4::Context->userenv
2157 && C4::Context->userenv->{flags} % 2 !=1
2158 && C4::Context->userenv->{branch})
2159 ? C4::Context->userenv->{branch}
2161 my $dbh = C4::Context->dbh;
2163 SELECT borrowers.borrowernumber,max(timestamp) as latestissue
2165 LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
2166 WHERE issues.borrowernumber IS NULL
2169 if ($filterbranch && $filterbranch ne ""){
2170 $query.=" AND borrowers.branchcode= ?";
2171 push @query_params,$filterbranch;
2173 warn $query if $debug;
2175 my $sth = $dbh->prepare($query);
2176 if (scalar(@query_params)>0){
2177 $sth->execute(@query_params);
2184 while ( my $data = $sth->fetchrow_hashref ) {
2185 push @results, $data;
2190 =head2 GetBorrowersWithIssuesHistoryOlderThan
2192 $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
2194 this function get all borrowers who has an issue history older than I<$date> given on input arg.
2196 I<$result> is a ref to an array which all elements are a hashref.
2197 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2201 sub GetBorrowersWithIssuesHistoryOlderThan {
2202 my $dbh = C4::Context->dbh;
2203 my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
2204 my $filterbranch = shift ||
2205 ((C4::Context->preference('IndependentBranches')
2206 && C4::Context->userenv
2207 && C4::Context->userenv->{flags} % 2 !=1
2208 && C4::Context->userenv->{branch})
2209 ? C4::Context->userenv->{branch}
2212 SELECT count(borrowernumber) as n,borrowernumber
2214 WHERE returndate < ?
2215 AND borrowernumber IS NOT NULL
2218 push @query_params, $date;
2220 $query.=" AND branchcode = ?";
2221 push @query_params, $filterbranch;
2223 $query.=" GROUP BY borrowernumber ";
2224 warn $query if $debug;
2225 my $sth = $dbh->prepare($query);
2226 $sth->execute(@query_params);
2229 while ( my $data = $sth->fetchrow_hashref ) {
2230 push @results, $data;
2235 =head2 GetBorrowersNamesAndLatestIssue
2237 $results = &GetBorrowersNamesAndLatestIssueList(@borrowernumbers)
2239 this function get borrowers Names and surnames and Issue information.
2241 I<@borrowernumbers> is an array which all elements are borrowernumbers.
2242 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2246 sub GetBorrowersNamesAndLatestIssue {
2247 my $dbh = C4::Context->dbh;
2248 my @borrowernumbers=@_;
2250 SELECT surname,lastname, phone, email,max(timestamp)
2252 LEFT JOIN issues ON borrowers.borrowernumber=issues.borrowernumber
2253 GROUP BY borrowernumber
2255 my $sth = $dbh->prepare($query);
2257 my $results = $sth->fetchall_arrayref({});
2263 my $success = DebarMember( $borrowernumber, $todate );
2265 marks a Member as debarred, and therefore unable to checkout any more
2269 true on success, false on failure
2274 my $borrowernumber = shift;
2277 return unless defined $borrowernumber;
2278 return unless $borrowernumber =~ /^\d+$/;
2281 borrowernumber => $borrowernumber,
2291 my $success = ModPrivacy( $borrowernumber, $privacy );
2293 Update the privacy of a patron.
2296 true on success, false on failure
2303 my $borrowernumber = shift;
2304 my $privacy = shift;
2305 return unless defined $borrowernumber;
2306 return unless $borrowernumber =~ /^\d+$/;
2308 return ModMember( borrowernumber => $borrowernumber,
2309 privacy => $privacy );
2314 AddMessage( $borrowernumber, $message_type, $message, $branchcode );
2316 Adds a message to the messages table for the given borrower.
2325 my ( $borrowernumber, $message_type, $message, $branchcode ) = @_;
2327 my $dbh = C4::Context->dbh;
2329 if ( ! ( $borrowernumber && $message_type && $message && $branchcode ) ) {
2333 my $query = "INSERT INTO messages ( borrowernumber, branchcode, message_type, message ) VALUES ( ?, ?, ?, ? )";
2334 my $sth = $dbh->prepare($query);
2335 $sth->execute( $borrowernumber, $branchcode, $message_type, $message );
2336 logaction("MEMBERS", "ADDCIRCMESSAGE", $borrowernumber, $message) if C4::Context->preference("BorrowersLog");
2342 GetMessages( $borrowernumber, $type );
2344 $type is message type, B for borrower, or L for Librarian.
2345 Empty type returns all messages of any type.
2347 Returns all messages for the given borrowernumber
2352 my ( $borrowernumber, $type, $branchcode ) = @_;
2358 my $dbh = C4::Context->dbh;
2361 branches.branchname,
2364 messages.branchcode LIKE '$branchcode' AS can_delete
2365 FROM messages, branches
2366 WHERE borrowernumber = ?
2367 AND message_type LIKE ?
2368 AND messages.branchcode = branches.branchcode
2369 ORDER BY message_date DESC";
2370 my $sth = $dbh->prepare($query);
2371 $sth->execute( $borrowernumber, $type ) ;
2374 while ( my $data = $sth->fetchrow_hashref ) {
2375 my $d = C4::Dates->new( $data->{message_date}, 'iso' );
2376 $data->{message_date_formatted} = $d->output;
2377 push @results, $data;
2385 GetMessagesCount( $borrowernumber, $type );
2387 $type is message type, B for borrower, or L for Librarian.
2388 Empty type returns all messages of any type.
2390 Returns the number of messages for the given borrowernumber
2394 sub GetMessagesCount {
2395 my ( $borrowernumber, $type, $branchcode ) = @_;
2401 my $dbh = C4::Context->dbh;
2403 my $query = "SELECT COUNT(*) as MsgCount FROM messages WHERE borrowernumber = ? AND message_type LIKE ?";
2404 my $sth = $dbh->prepare($query);
2405 $sth->execute( $borrowernumber, $type ) ;
2408 my $data = $sth->fetchrow_hashref;
2409 my $count = $data->{'MsgCount'};
2416 =head2 DeleteMessage
2418 DeleteMessage( $message_id );
2423 my ( $message_id ) = @_;
2425 my $dbh = C4::Context->dbh;
2426 my $query = "SELECT * FROM messages WHERE message_id = ?";
2427 my $sth = $dbh->prepare($query);
2428 $sth->execute( $message_id );
2429 my $message = $sth->fetchrow_hashref();
2431 $query = "DELETE FROM messages WHERE message_id = ?";
2432 $sth = $dbh->prepare($query);
2433 $sth->execute( $message_id );
2434 logaction("MEMBERS", "DELCIRCMESSAGE", $message->{'borrowernumber'}, $message->{'message'}) if C4::Context->preference("BorrowersLog");
2439 IssueSlip($branchcode, $borrowernumber, $quickslip)
2441 Returns letter hash ( see C4::Letters::GetPreparedLetter )
2443 $quickslip is boolean, to indicate whether we want a quick slip
2448 my ($branch, $borrowernumber, $quickslip) = @_;
2450 # return unless ( C4::Context->boolean_preference('printcirculationslips') );
2452 my $now = POSIX::strftime("%Y-%m-%d", localtime);
2454 my $issueslist = GetPendingIssues($borrowernumber);
2455 foreach my $it (@$issueslist){
2456 if ((substr $it->{'issuedate'}, 0, 10) eq $now || (substr $it->{'lastreneweddate'}, 0, 10) eq $now) {
2459 elsif ((substr $it->{'date_due'}, 0, 10) le $now) {
2460 $it->{'overdue'} = 1;
2462 my $dt = dt_from_string( $it->{'date_due'} );
2463 $it->{'date_due'} = output_pref( $dt );;
2465 my @issues = sort { $b->{'timestamp'} <=> $a->{'timestamp'} } @$issueslist;
2467 my ($letter_code, %repeat);
2469 $letter_code = 'ISSUEQSLIP';
2471 'checkedout' => [ map {
2475 }, grep { $_->{'now'} } @issues ],
2479 $letter_code = 'ISSUESLIP';
2481 'checkedout' => [ map {
2485 }, grep { !$_->{'overdue'} } @issues ],
2487 'overdue' => [ map {
2491 }, grep { $_->{'overdue'} } @issues ],
2494 $_->{'timestamp'} = $_->{'newdate'};
2496 } @{ GetNewsToDisplay("slip") } ],
2500 return C4::Letters::GetPreparedLetter (
2501 module => 'circulation',
2502 letter_code => $letter_code,
2503 branchcode => $branch,
2505 'branches' => $branch,
2506 'borrowers' => $borrowernumber,
2512 =head2 GetBorrowersWithEmail
2514 ([$borrnum,$userid], ...) = GetBorrowersWithEmail('me@example.com');
2516 This gets a list of users and their basic details from their email address.
2517 As it's possible for multiple user to have the same email address, it provides
2518 you with all of them. If there is no userid for the user, there will be an
2519 C<undef> there. An empty list will be returned if there are no matches.
2523 sub GetBorrowersWithEmail {
2526 my $dbh = C4::Context->dbh;
2528 my $query = "SELECT borrowernumber, userid FROM borrowers WHERE email=?";
2529 my $sth=$dbh->prepare($query);
2530 $sth->execute($email);
2532 while (my $ref = $sth->fetch) {
2535 die "Failure searching for borrowers by email address: $sth->errstr" if $sth->err;
2539 sub AddMember_Opac {
2540 my ( %borrower ) = @_;
2542 $borrower{'categorycode'} = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
2544 my $sr = new String::Random;
2545 $sr->{'A'} = [ 'A'..'Z', 'a'..'z' ];
2546 my $password = $sr->randpattern("AAAAAAAAAA");
2547 $borrower{'password'} = $password;
2549 $borrower{'cardnumber'} = fixup_cardnumber();
2551 my $borrowernumber = AddMember(%borrower);
2553 return ( $borrowernumber, $password );
2556 END { } # module clean-up code here (global destructor)