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("IndependantBranches") ) { # && !$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);
699 return @{C4::Context->dbh->selectcol_arrayref("SHOW columns from borrowers")};
704 my $success = ModMember(borrowernumber => $borrowernumber,
705 [ field => value ]... );
707 Modify borrower's data. All date fields should ALREADY be in ISO format.
710 true on success, or false on failure
716 # test to know if you must update or not the borrower password
717 if (exists $data{password}) {
718 if ($data{password} eq '****' or $data{password} eq '') {
719 delete $data{password};
721 $data{password} = md5_base64($data{password});
724 my $old_categorycode = GetBorrowerCategorycode( $data{borrowernumber} );
725 my $execute_success=UpdateInTable("borrowers",\%data);
726 if ($execute_success) { # only proceed if the update was a success
727 # ok if its an adult (type) it may have borrowers that depend on it as a guarantor
728 # so when we update information for an adult we should check for guarantees and update the relevant part
729 # of their records, ie addresses and phone numbers
730 my $borrowercategory= GetBorrowercategory( $data{'category_type'} );
731 if ( exists $borrowercategory->{'category_type'} && $borrowercategory->{'category_type'} eq ('A' || 'S') ) {
732 # is adult check guarantees;
733 UpdateGuarantees(%data);
736 # If the patron changes to a category with enrollment fee, we add a fee
737 if ( $data{categorycode} and $data{categorycode} ne $old_categorycode ) {
738 AddEnrolmentFeeIfNeeded( $data{categorycode}, $data{borrowernumber} );
741 logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "UPDATE (executed w/ arg: $data{'borrowernumber'})") if C4::Context->preference("BorrowersLog");
743 return $execute_success;
748 $borrowernumber = &AddMember(%borrower);
750 insert new borrower into table
751 Returns the borrowernumber upon success
753 Returns as undef upon any db error without further processing
760 my $dbh = C4::Context->dbh;
762 # generate a proper login if none provided
763 $data{'userid'} = Generate_Userid($data{'borrowernumber'}, $data{'firstname'}, $data{'surname'}) if $data{'userid'} eq '';
765 # add expiration date if it isn't already there
766 unless ( $data{'dateexpiry'} ) {
767 $data{'dateexpiry'} = GetExpiryDate( $data{'categorycode'}, C4::Dates->new()->output("iso") );
770 # add enrollment date if it isn't already there
771 unless ( $data{'dateenrolled'} ) {
772 $data{'dateenrolled'} = C4::Dates->new()->output("iso");
775 # create a disabled account if no password provided
776 $data{'password'} = ($data{'password'})? md5_base64($data{'password'}) : '!';
777 $data{'borrowernumber'}=InsertInTable("borrowers",\%data);
780 # mysql_insertid is probably bad. not necessarily accurate and mysql-specific at best.
781 logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
783 AddEnrolmentFeeIfNeeded( $data{categorycode}, $data{borrowernumber} );
785 return $data{'borrowernumber'};
790 my $uniqueness = Check_Userid($userid,$borrowernumber);
792 $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 != '').
794 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.
797 0 for not unique (i.e. this $userid already exists)
798 1 for unique (i.e. this $userid does not exist, or this $userid/$borrowernumber combination already exists)
803 my ($uid,$member) = @_;
804 my $dbh = C4::Context->dbh;
807 "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
808 $sth->execute( $uid, $member );
809 if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
817 =head2 Generate_Userid
819 my $newuid = Generate_Userid($borrowernumber, $firstname, $surname);
821 Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
823 $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.
826 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).
830 sub Generate_Userid {
831 my ($borrowernumber, $firstname, $surname) = @_;
834 #The script will "do" the following code and increment the $offset until Check_Userid = 1 (i.e. until $newuid comes back as unique)
836 $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
837 $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
838 $newuid = lc(($firstname)? "$firstname.$surname" : $surname);
839 $newuid = unac_string('utf-8',$newuid);
840 $newuid .= $offset unless $offset == 0;
843 } while (!Check_Userid($newuid,$borrowernumber));
849 my ( $uid, $member, $digest ) = @_;
850 my $dbh = C4::Context->dbh;
852 #Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
853 #Then we need to tell the user and have them create a new one.
857 "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
858 $sth->execute( $uid, $member );
859 if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
863 #Everything is good so we can update the information.
866 "update borrowers set userid=?, password=? where borrowernumber=?");
867 $sth->execute( $uid, $digest, $member );
871 logaction("MEMBERS", "CHANGE PASS", $member, "") if C4::Context->preference("BorrowersLog");
877 =head2 fixup_cardnumber
879 Warning: The caller is responsible for locking the members table in write
880 mode, to avoid database corruption.
884 use vars qw( @weightings );
885 my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
887 sub fixup_cardnumber {
888 my ($cardnumber) = @_;
889 my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;
891 # Find out whether member numbers should be generated
892 # automatically. Should be either "1" or something else.
893 # Defaults to "0", which is interpreted as "no".
895 # if ($cardnumber !~ /\S/ && $autonumber_members) {
896 ($autonumber_members) or return $cardnumber;
897 my $checkdigit = C4::Context->preference('checkdigit');
898 my $dbh = C4::Context->dbh;
899 if ( $checkdigit and $checkdigit eq 'katipo' ) {
901 # if checkdigit is selected, calculate katipo-style cardnumber.
902 # otherwise, just use the max()
903 # purpose: generate checksum'd member numbers.
904 # We'll assume we just got the max value of digits 2-8 of member #'s
905 # from the database and our job is to increment that by one,
906 # determine the 1st and 9th digits and return the full string.
907 my $sth = $dbh->prepare(
908 "select max(substring(borrowers.cardnumber,2,7)) as new_num from borrowers"
911 my $data = $sth->fetchrow_hashref;
912 $cardnumber = $data->{new_num};
913 if ( !$cardnumber ) { # If DB has no values,
914 $cardnumber = 1000000; # start at 1000000
920 for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
921 # read weightings, left to right, 1 char at a time
922 my $temp1 = $weightings[$i];
924 # sequence left to right, 1 char at a time
925 my $temp2 = substr( $cardnumber, $i, 1 );
927 # mult each char 1-7 by its corresponding weighting
928 $sum += $temp1 * $temp2;
931 my $rem = ( $sum % 11 );
932 $rem = 'X' if $rem == 10;
934 return "V$cardnumber$rem";
937 my $sth = $dbh->prepare(
938 'SELECT MAX( CAST( cardnumber AS SIGNED ) ) FROM borrowers WHERE cardnumber REGEXP "^-?[0-9]+$"'
941 my ($result) = $sth->fetchrow;
944 return $cardnumber; # just here as a fallback/reminder
949 ($num_children, $children_arrayref) = &GetGuarantees($parent_borrno);
950 $child0_cardno = $children_arrayref->[0]{"cardnumber"};
951 $child0_borrno = $children_arrayref->[0]{"borrowernumber"};
953 C<&GetGuarantees> takes a borrower number (e.g., that of a patron
954 with children) and looks up the borrowers who are guaranteed by that
955 borrower (i.e., the patron's children).
957 C<&GetGuarantees> returns two values: an integer giving the number of
958 borrowers guaranteed by C<$parent_borrno>, and a reference to an array
959 of references to hash, which gives the actual results.
965 my ($borrowernumber) = @_;
966 my $dbh = C4::Context->dbh;
969 "select cardnumber,borrowernumber, firstname, surname from borrowers where guarantorid=?"
971 $sth->execute($borrowernumber);
974 my $data = $sth->fetchall_arrayref({});
975 return ( scalar(@$data), $data );
978 =head2 UpdateGuarantees
980 &UpdateGuarantees($parent_borrno);
983 C<&UpdateGuarantees> borrower data for an adult and updates all the guarantees
984 with the modified information
989 sub UpdateGuarantees {
991 my $dbh = C4::Context->dbh;
992 my ( $count, $guarantees ) = GetGuarantees( $data{'borrowernumber'} );
993 foreach my $guarantee (@$guarantees){
994 my $guaquery = qq|UPDATE borrowers
995 SET address=?,fax=?,B_city=?,mobile=?,city=?,phone=?
996 WHERE borrowernumber=?
998 my $sth = $dbh->prepare($guaquery);
999 $sth->execute($data{'address'},$data{'fax'},$data{'B_city'},$data{'mobile'},$data{'city'},$data{'phone'},$guarantee->{'borrowernumber'});
1002 =head2 GetPendingIssues
1004 my $issues = &GetPendingIssues(@borrowernumber);
1006 Looks up what the patron with the given borrowernumber has borrowed.
1008 C<&GetPendingIssues> returns a
1009 reference-to-array where each element is a reference-to-hash; the
1010 keys are the fields from the C<issues>, C<biblio>, and C<items> tables.
1011 The keys include C<biblioitems> fields except marc and marcxml.
1016 sub GetPendingIssues {
1017 my @borrowernumbers = @_;
1019 unless (@borrowernumbers ) { # return a ref_to_array
1020 return \@borrowernumbers; # to not cause surprise to caller
1023 # Borrowers part of the query
1025 for (my $i = 0; $i < @borrowernumbers; $i++) {
1026 $bquery .= ' issues.borrowernumber = ?';
1027 if ($i < $#borrowernumbers ) {
1032 # must avoid biblioitems.* to prevent large marc and marcxml fields from killing performance
1033 # FIXME: namespace collision: each table has "timestamp" fields. Which one is "timestamp" ?
1034 # FIXME: circ/ciculation.pl tries to sort by timestamp!
1035 # FIXME: namespace collision: other collisions possible.
1036 # FIXME: most of this data isn't really being used by callers.
1043 biblioitems.itemtype,
1046 biblioitems.publicationyear,
1047 biblioitems.publishercode,
1048 biblioitems.volumedate,
1049 biblioitems.volumedesc,
1052 borrowers.firstname,
1054 borrowers.cardnumber,
1055 issues.timestamp AS timestamp,
1056 issues.renewals AS renewals,
1057 issues.borrowernumber AS borrowernumber,
1058 items.renewals AS totalrenewals
1060 LEFT JOIN items ON items.itemnumber = issues.itemnumber
1061 LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
1062 LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
1063 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
1066 ORDER BY issues.issuedate"
1069 my $sth = C4::Context->dbh->prepare($query);
1070 $sth->execute(@borrowernumbers);
1071 my $data = $sth->fetchall_arrayref({});
1072 my $tz = C4::Context->tz();
1073 my $today = DateTime->now( time_zone => $tz);
1074 foreach (@{$data}) {
1075 if ($_->{issuedate}) {
1076 $_->{issuedate} = dt_from_string($_->{issuedate}, 'sql');
1078 $_->{date_due} or next;
1079 $_->{date_due} = DateTime::Format::DateParse->parse_datetime($_->{date_due}, $tz->name());
1080 if ( DateTime->compare($_->{date_due}, $today) == -1 ) {
1089 $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
1091 Looks up what the patron with the given borrowernumber has borrowed,
1092 and sorts the results.
1094 C<$sortkey> is the name of a field on which to sort the results. This
1095 should be the name of a field in the C<issues>, C<biblio>,
1096 C<biblioitems>, or C<items> table in the Koha database.
1098 C<$limit> is the maximum number of results to return.
1100 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
1101 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
1102 C<items> tables of the Koha database.
1108 my ( $borrowernumber, $order, $limit ) = @_;
1110 my $dbh = C4::Context->dbh;
1112 'SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1114 LEFT JOIN items on items.itemnumber=issues.itemnumber
1115 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1116 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1117 WHERE borrowernumber=?
1119 SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1121 LEFT JOIN items on items.itemnumber=old_issues.itemnumber
1122 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1123 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1124 WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL
1125 order by ' . $order;
1127 $query .= " limit $limit";
1130 my $sth = $dbh->prepare($query);
1131 $sth->execute( $borrowernumber, $borrowernumber );
1132 return $sth->fetchall_arrayref( {} );
1136 =head2 GetMemberAccountRecords
1138 ($total, $acctlines, $count) = &GetMemberAccountRecords($borrowernumber);
1140 Looks up accounting data for the patron with the given borrowernumber.
1142 C<&GetMemberAccountRecords> returns a three-element array. C<$acctlines> is a
1143 reference-to-array, where each element is a reference-to-hash; the
1144 keys are the fields of the C<accountlines> table in the Koha database.
1145 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1146 total amount outstanding for all of the account lines.
1150 sub GetMemberAccountRecords {
1151 my ($borrowernumber) = @_;
1152 my $dbh = C4::Context->dbh;
1158 WHERE borrowernumber=?);
1159 $strsth.=" ORDER BY date desc,timestamp DESC";
1160 my $sth= $dbh->prepare( $strsth );
1161 $sth->execute( $borrowernumber );
1164 while ( my $data = $sth->fetchrow_hashref ) {
1165 if ( $data->{itemnumber} ) {
1166 my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
1167 $data->{biblionumber} = $biblio->{biblionumber};
1168 $data->{title} = $biblio->{title};
1170 $acctlines[$numlines] = $data;
1172 $total += int(1000 * $data->{'amountoutstanding'}); # convert float to integer to avoid round-off errors
1175 return ( $total, \@acctlines,$numlines);
1178 =head2 GetMemberAccountBalance
1180 ($total_balance, $non_issue_balance, $other_charges) = &GetMemberAccountBalance($borrowernumber);
1182 Calculates amount immediately owing by the patron - non-issue charges.
1183 Based on GetMemberAccountRecords.
1184 Charges exempt from non-issue are:
1186 * Rent (rental) if RentalsInNoissuesCharge syspref is set to false
1187 * Manual invoices if ManInvInNoissuesCharge syspref is set to false
1191 sub GetMemberAccountBalance {
1192 my ($borrowernumber) = @_;
1194 my $ACCOUNT_TYPE_LENGTH = 5; # this is plain ridiculous...
1196 my @not_fines = ('Res');
1197 push @not_fines, 'Rent' unless C4::Context->preference('RentalsInNoissuesCharge');
1198 unless ( C4::Context->preference('ManInvInNoissuesCharge') ) {
1199 my $dbh = C4::Context->dbh;
1200 my $man_inv_types = $dbh->selectcol_arrayref(qq{SELECT authorised_value FROM authorised_values WHERE category = 'MANUAL_INV'});
1201 push @not_fines, map substr($_, 0, $ACCOUNT_TYPE_LENGTH), @$man_inv_types;
1203 my %not_fine = map {$_ => 1} @not_fines;
1205 my ($total, $acctlines) = GetMemberAccountRecords($borrowernumber);
1206 my $other_charges = 0;
1207 foreach (@$acctlines) {
1208 $other_charges += $_->{amountoutstanding} if $not_fine{ substr($_->{accounttype}, 0, $ACCOUNT_TYPE_LENGTH) };
1211 return ( $total, $total - $other_charges, $other_charges);
1214 =head2 GetBorNotifyAcctRecord
1216 ($total, $acctlines, $count) = &GetBorNotifyAcctRecord($params,$notifyid);
1218 Looks up accounting data for the patron with the given borrowernumber per file number.
1220 C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a
1221 reference-to-array, where each element is a reference-to-hash; the
1222 keys are the fields of the C<accountlines> table in the Koha database.
1223 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1224 total amount outstanding for all of the account lines.
1228 sub GetBorNotifyAcctRecord {
1229 my ( $borrowernumber, $notifyid ) = @_;
1230 my $dbh = C4::Context->dbh;
1233 my $sth = $dbh->prepare(
1236 WHERE borrowernumber=?
1238 AND amountoutstanding != '0'
1239 ORDER BY notify_id,accounttype
1242 $sth->execute( $borrowernumber, $notifyid );
1244 while ( my $data = $sth->fetchrow_hashref ) {
1245 if ( $data->{itemnumber} ) {
1246 my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
1247 $data->{biblionumber} = $biblio->{biblionumber};
1248 $data->{title} = $biblio->{title};
1250 $acctlines[$numlines] = $data;
1252 $total += int(100 * $data->{'amountoutstanding'});
1255 return ( $total, \@acctlines, $numlines );
1258 =head2 checkuniquemember (OUEST-PROVENCE)
1260 ($result,$categorycode) = &checkuniquemember($collectivity,$surname,$firstname,$dateofbirth);
1262 Checks that a member exists or not in the database.
1264 C<&result> is nonzero (=exist) or 0 (=does not exist)
1265 C<&categorycode> is from categorycode table
1266 C<&collectivity> is 1 (= we add a collectivity) or 0 (= we add a physical member)
1267 C<&surname> is the surname
1268 C<&firstname> is the firstname (only if collectivity=0)
1269 C<&dateofbirth> is the date of birth in ISO format (only if collectivity=0)
1273 # FIXME: This function is not legitimate. Multiple patrons might have the same first/last name and birthdate.
1274 # This is especially true since first name is not even a required field.
1276 sub checkuniquemember {
1277 my ( $collectivity, $surname, $firstname, $dateofbirth ) = @_;
1278 my $dbh = C4::Context->dbh;
1279 my $request = ($collectivity) ?
1280 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? " :
1282 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=? and dateofbirth=?" :
1283 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=?";
1284 my $sth = $dbh->prepare($request);
1285 if ($collectivity) {
1286 $sth->execute( uc($surname) );
1287 } elsif($dateofbirth){
1288 $sth->execute( uc($surname), ucfirst($firstname), $dateofbirth );
1290 $sth->execute( uc($surname), ucfirst($firstname));
1292 my @data = $sth->fetchrow;
1293 ( $data[0] ) and return $data[0], $data[1];
1297 sub checkcardnumber {
1298 my ($cardnumber,$borrowernumber) = @_;
1299 # If cardnumber is null, we assume they're allowed.
1300 return 0 if !defined($cardnumber);
1301 my $dbh = C4::Context->dbh;
1302 my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
1303 $query .= " AND borrowernumber <> ?" if ($borrowernumber);
1304 my $sth = $dbh->prepare($query);
1305 if ($borrowernumber) {
1306 $sth->execute($cardnumber,$borrowernumber);
1308 $sth->execute($cardnumber);
1310 if (my $data= $sth->fetchrow_hashref()){
1319 =head2 getzipnamecity (OUEST-PROVENCE)
1321 take all info from table city for the fields city and zip
1322 check for the name and the zip code of the city selected
1326 sub getzipnamecity {
1328 my $dbh = C4::Context->dbh;
1331 "select city_name,city_state,city_zipcode,city_country from cities where cityid=? ");
1332 $sth->execute($cityid);
1333 my @data = $sth->fetchrow;
1334 return $data[0], $data[1], $data[2], $data[3];
1338 =head2 getdcity (OUEST-PROVENCE)
1340 recover cityid with city_name condition
1345 my ($city_name) = @_;
1346 my $dbh = C4::Context->dbh;
1347 my $sth = $dbh->prepare("select cityid from cities where city_name=? ");
1348 $sth->execute($city_name);
1349 my $data = $sth->fetchrow;
1353 =head2 GetFirstValidEmailAddress
1355 $email = GetFirstValidEmailAddress($borrowernumber);
1357 Return the first valid email address for a borrower, given the borrowernumber. For now, the order
1358 is defined as email, emailpro, B_email. Returns the empty string if the borrower has no email
1363 sub GetFirstValidEmailAddress {
1364 my $borrowernumber = shift;
1365 my $dbh = C4::Context->dbh;
1366 my $sth = $dbh->prepare( "SELECT email, emailpro, B_email FROM borrowers where borrowernumber = ? ");
1367 $sth->execute( $borrowernumber );
1368 my $data = $sth->fetchrow_hashref;
1370 if ($data->{'email'}) {
1371 return $data->{'email'};
1372 } elsif ($data->{'emailpro'}) {
1373 return $data->{'emailpro'};
1374 } elsif ($data->{'B_email'}) {
1375 return $data->{'B_email'};
1381 =head2 GetNoticeEmailAddress
1383 $email = GetNoticeEmailAddress($borrowernumber);
1385 Return the email address of borrower used for notices, given the borrowernumber.
1386 Returns the empty string if no email address.
1390 sub GetNoticeEmailAddress {
1391 my $borrowernumber = shift;
1393 my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
1394 # if syspref is set to 'first valid' (value == OFF), look up email address
1395 if ( $which_address eq 'OFF' ) {
1396 return GetFirstValidEmailAddress($borrowernumber);
1398 # specified email address field
1399 my $dbh = C4::Context->dbh;
1400 my $sth = $dbh->prepare( qq{
1401 SELECT $which_address AS primaryemail
1403 WHERE borrowernumber=?
1405 $sth->execute($borrowernumber);
1406 my $data = $sth->fetchrow_hashref;
1407 return $data->{'primaryemail'} || '';
1410 =head2 GetExpiryDate
1412 $expirydate = GetExpiryDate($categorycode, $dateenrolled);
1414 Calculate expiry date given a categorycode and starting date. Date argument must be in ISO format.
1415 Return date is also in ISO format.
1420 my ( $categorycode, $dateenrolled ) = @_;
1422 if ($categorycode) {
1423 my $dbh = C4::Context->dbh;
1424 my $sth = $dbh->prepare("SELECT enrolmentperiod,enrolmentperioddate FROM categories WHERE categorycode=?");
1425 $sth->execute($categorycode);
1426 $enrolments = $sth->fetchrow_hashref;
1428 # die "GetExpiryDate: for enrollmentperiod $enrolmentperiod (category '$categorycode') starting $dateenrolled.\n";
1429 my @date = split (/-/,$dateenrolled);
1430 if($enrolments->{enrolmentperiod}){
1431 return sprintf("%04d-%02d-%02d", Add_Delta_YM(@date,0,$enrolments->{enrolmentperiod}));
1433 return $enrolments->{enrolmentperioddate};
1437 =head2 checkuserpassword (OUEST-PROVENCE)
1439 check for the password and login are not used
1440 return the number of record
1441 0=> NOT USED 1=> USED
1445 sub checkuserpassword {
1446 my ( $borrowernumber, $userid, $password ) = @_;
1447 $password = md5_base64($password);
1448 my $dbh = C4::Context->dbh;
1451 "Select count(*) from borrowers where borrowernumber !=? and userid =? and password=? "
1453 $sth->execute( $borrowernumber, $userid, $password );
1454 my $number_rows = $sth->fetchrow;
1455 return $number_rows;
1459 =head2 GetborCatFromCatType
1461 ($codes_arrayref, $labels_hashref) = &GetborCatFromCatType();
1463 Looks up the different types of borrowers in the database. Returns two
1464 elements: a reference-to-array, which lists the borrower category
1465 codes, and a reference-to-hash, which maps the borrower category codes
1466 to category descriptions.
1471 sub GetborCatFromCatType {
1472 my ( $category_type, $action, $no_branch_limit ) = @_;
1474 my $branch_limit = $no_branch_limit
1476 : C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1478 # FIXME - This API seems both limited and dangerous.
1479 my $dbh = C4::Context->dbh;
1482 SELECT categories.categorycode, categories.description
1486 LEFT JOIN categories_branches ON categories.categorycode = categories_branches.categorycode
1489 $request .= " $action ";
1490 $request .= " AND (branchcode = ? OR branchcode IS NULL) GROUP BY description" if $branch_limit;
1492 $request .= " WHERE branchcode = ? OR branchcode IS NULL GROUP BY description" if $branch_limit;
1494 $request .= " ORDER BY categorycode";
1496 my $sth = $dbh->prepare($request);
1498 $action ? $category_type : (),
1499 $branch_limit ? $branch_limit : ()
1505 while ( my $data = $sth->fetchrow_hashref ) {
1506 push @codes, $data->{'categorycode'};
1507 $labels{ $data->{'categorycode'} } = $data->{'description'};
1510 return ( \@codes, \%labels );
1513 =head2 GetBorrowercategory
1515 $hashref = &GetBorrowercategory($categorycode);
1517 Given the borrower's category code, the function returns the corresponding
1518 data hashref for a comprehensive information display.
1522 sub GetBorrowercategory {
1524 my $dbh = C4::Context->dbh;
1528 "SELECT description,dateofbirthrequired,upperagelimit,category_type
1530 WHERE categorycode = ?"
1532 $sth->execute($catcode);
1534 $sth->fetchrow_hashref;
1538 } # sub getborrowercategory
1541 =head2 GetBorrowerCategorycode
1543 $categorycode = &GetBorrowerCategoryCode( $borrowernumber );
1545 Given the borrowernumber, the function returns the corresponding categorycode
1548 sub GetBorrowerCategorycode {
1549 my ( $borrowernumber ) = @_;
1550 my $dbh = C4::Context->dbh;
1551 my $sth = $dbh->prepare( qq{
1554 WHERE borrowernumber = ?
1556 $sth->execute( $borrowernumber );
1557 return $sth->fetchrow;
1560 =head2 GetBorrowercategoryList
1562 $arrayref_hashref = &GetBorrowercategoryList;
1563 If no category code provided, the function returns all the categories.
1567 sub GetBorrowercategoryList {
1568 my $no_branch_limit = @_ ? shift : 0;
1569 my $branch_limit = $no_branch_limit
1571 : C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1572 my $dbh = C4::Context->dbh;
1573 my $query = "SELECT categories.* FROM categories";
1575 LEFT JOIN categories_branches ON categories.categorycode = categories_branches.categorycode
1576 WHERE branchcode = ? OR branchcode IS NULL GROUP BY description
1578 $query .= " ORDER BY description";
1579 my $sth = $dbh->prepare( $query );
1580 $sth->execute( $branch_limit ? $branch_limit : () );
1581 my $data = $sth->fetchall_arrayref( {} );
1584 } # sub getborrowercategory
1586 =head2 ethnicitycategories
1588 ($codes_arrayref, $labels_hashref) = ðnicitycategories();
1590 Looks up the different ethnic types in the database. Returns two
1591 elements: a reference-to-array, which lists the ethnicity codes, and a
1592 reference-to-hash, which maps the ethnicity codes to ethnicity
1599 sub ethnicitycategories {
1600 my $dbh = C4::Context->dbh;
1601 my $sth = $dbh->prepare("Select code,name from ethnicity order by name");
1605 while ( my $data = $sth->fetchrow_hashref ) {
1606 push @codes, $data->{'code'};
1607 $labels{ $data->{'code'} } = $data->{'name'};
1609 return ( \@codes, \%labels );
1614 $ethn_name = &fixEthnicity($ethn_code);
1616 Takes an ethnicity code (e.g., "european" or "pi") and returns the
1617 corresponding descriptive name from the C<ethnicity> table in the
1618 Koha database ("European" or "Pacific Islander").
1625 my $ethnicity = shift;
1626 return unless $ethnicity;
1627 my $dbh = C4::Context->dbh;
1628 my $sth = $dbh->prepare("Select name from ethnicity where code = ?");
1629 $sth->execute($ethnicity);
1630 my $data = $sth->fetchrow_hashref;
1631 return $data->{'name'};
1632 } # sub fixEthnicity
1636 $dateofbirth,$date = &GetAge($date);
1638 this function return the borrowers age with the value of dateofbirth
1644 my ( $date, $date_ref ) = @_;
1646 if ( not defined $date_ref ) {
1647 $date_ref = sprintf( '%04d-%02d-%02d', Today() );
1650 my ( $year1, $month1, $day1 ) = split /-/, $date;
1651 my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
1653 my $age = $year2 - $year1;
1654 if ( $month1 . $day1 > $month2 . $day2 ) {
1661 =head2 get_institutions
1663 $insitutions = get_institutions();
1665 Just returns a list of all the borrowers of type I, borrownumber and name
1670 sub get_institutions {
1671 my $dbh = C4::Context->dbh();
1674 "SELECT borrowernumber,surname FROM borrowers WHERE categorycode=? ORDER BY surname"
1678 while ( my $data = $sth->fetchrow_hashref() ) {
1679 $orgs{ $data->{'borrowernumber'} } = $data;
1683 } # sub get_institutions
1685 =head2 add_member_orgs
1687 add_member_orgs($borrowernumber,$borrowernumbers);
1689 Takes a borrowernumber and a list of other borrowernumbers and inserts them into the borrowers_to_borrowers table
1694 sub add_member_orgs {
1695 my ( $borrowernumber, $otherborrowers ) = @_;
1696 my $dbh = C4::Context->dbh();
1698 "INSERT INTO borrowers_to_borrowers (borrower1,borrower2) VALUES (?,?)";
1699 my $sth = $dbh->prepare($query);
1700 foreach my $otherborrowernumber (@$otherborrowers) {
1701 $sth->execute( $borrowernumber, $otherborrowernumber );
1704 } # sub add_member_orgs
1708 $cityarrayref = GetCities();
1710 Returns an array_ref of the entries in the cities table
1711 If there are entries in the table an empty row is returned
1712 This is currently only used to populate a popup in memberentry
1718 my $dbh = C4::Context->dbh;
1719 my $city_arr = $dbh->selectall_arrayref(
1720 q|SELECT cityid,city_zipcode,city_name,city_state,city_country FROM cities ORDER BY city_name|,
1722 if ( @{$city_arr} ) {
1723 unshift @{$city_arr}, {
1724 city_zipcode => q{},
1728 city_country => q{},
1735 =head2 GetSortDetails (OUEST-PROVENCE)
1737 ($lib) = &GetSortDetails($category,$sortvalue);
1739 Returns the authorized value details
1740 C<&$lib>return value of authorized value details
1741 C<&$sortvalue>this is the value of authorized value
1742 C<&$category>this is the value of authorized value category
1746 sub GetSortDetails {
1747 my ( $category, $sortvalue ) = @_;
1748 my $dbh = C4::Context->dbh;
1749 my $query = qq|SELECT lib
1750 FROM authorised_values
1752 AND authorised_value=? |;
1753 my $sth = $dbh->prepare($query);
1754 $sth->execute( $category, $sortvalue );
1755 my $lib = $sth->fetchrow;
1756 return ($lib) if ($lib);
1757 return ($sortvalue) unless ($lib);
1760 =head2 MoveMemberToDeleted
1762 $result = &MoveMemberToDeleted($borrowernumber);
1764 Copy the record from borrowers to deletedborrowers table.
1768 # FIXME: should do it in one SQL statement w/ subquery
1769 # Otherwise, we should return the @data on success
1771 sub MoveMemberToDeleted {
1772 my ($member) = shift or return;
1773 my $dbh = C4::Context->dbh;
1774 my $query = qq|SELECT *
1776 WHERE borrowernumber=?|;
1777 my $sth = $dbh->prepare($query);
1778 $sth->execute($member);
1779 my @data = $sth->fetchrow_array;
1780 (@data) or return; # if we got a bad borrowernumber, there's nothing to insert
1782 $dbh->prepare( "INSERT INTO deletedborrowers VALUES ("
1783 . ( "?," x ( scalar(@data) - 1 ) )
1785 $sth->execute(@data);
1790 DelMember($borrowernumber);
1792 This function remove directly a borrower whitout writing it on deleteborrower.
1793 + Deletes reserves for the borrower
1798 my $dbh = C4::Context->dbh;
1799 my $borrowernumber = shift;
1800 #warn "in delmember with $borrowernumber";
1801 return unless $borrowernumber; # borrowernumber is mandatory.
1803 my $query = qq|DELETE
1805 WHERE borrowernumber=?|;
1806 my $sth = $dbh->prepare($query);
1807 $sth->execute($borrowernumber);
1811 WHERE borrowernumber = ?
1813 $sth = $dbh->prepare($query);
1814 $sth->execute($borrowernumber);
1815 logaction("MEMBERS", "DELETE", $borrowernumber, "") if C4::Context->preference("BorrowersLog");
1819 =head2 ExtendMemberSubscriptionTo (OUEST-PROVENCE)
1821 $date = ExtendMemberSubscriptionTo($borrowerid, $date);
1823 Extending the subscription to a given date or to the expiry date calculated on ISO date.
1828 sub ExtendMemberSubscriptionTo {
1829 my ( $borrowerid,$date) = @_;
1830 my $dbh = C4::Context->dbh;
1831 my $borrower = GetMember('borrowernumber'=>$borrowerid);
1833 $date = (C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry') ?
1834 C4::Dates->new($borrower->{'dateexpiry'}, 'iso')->output("iso") :
1835 C4::Dates->new()->output("iso");
1836 $date = GetExpiryDate( $borrower->{'categorycode'}, $date );
1838 my $sth = $dbh->do(<<EOF);
1840 SET dateexpiry='$date'
1841 WHERE borrowernumber='$borrowerid'
1844 AddEnrolmentFeeIfNeeded( $borrower->{categorycode}, $borrower->{borrowernumber} );
1846 logaction("MEMBERS", "RENEW", $borrower->{'borrowernumber'}, "Membership renewed")if C4::Context->preference("BorrowersLog");
1847 return $date if ($sth);
1851 =head2 GetRoadTypes (OUEST-PROVENCE)
1853 ($idroadtypearrayref, $roadttype_hashref) = &GetRoadTypes();
1855 Looks up the different road type . Returns two
1856 elements: a reference-to-array, which lists the id_roadtype
1857 codes, and a reference-to-hash, which maps the road type of the road .
1862 my $dbh = C4::Context->dbh;
1864 SELECT roadtypeid,road_type
1866 ORDER BY road_type|;
1867 my $sth = $dbh->prepare($query);
1872 # insert empty value to create a empty choice in cgi popup
1874 while ( my $data = $sth->fetchrow_hashref ) {
1876 push @id, $data->{'roadtypeid'};
1877 $roadtype{ $data->{'roadtypeid'} } = $data->{'road_type'};
1880 #test to know if the table contain some records if no the function return nothing
1887 return ( \@id, \%roadtype );
1893 =head2 GetTitles (OUEST-PROVENCE)
1895 ($borrowertitle)= &GetTitles();
1897 Looks up the different title . Returns array with all borrowers title
1902 my @borrowerTitle = split (/,|\|/,C4::Context->preference('BorrowersTitles'));
1903 unshift( @borrowerTitle, "" );
1904 my $count=@borrowerTitle;
1909 return ( \@borrowerTitle);
1913 =head2 GetPatronImage
1915 my ($imagedata, $dberror) = GetPatronImage($cardnumber);
1917 Returns the mimetype and binary image data of the image for the patron with the supplied cardnumber.
1921 sub GetPatronImage {
1922 my ($cardnumber) = @_;
1923 warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1924 my $dbh = C4::Context->dbh;
1925 my $query = 'SELECT mimetype, imagefile FROM patronimage WHERE cardnumber = ?';
1926 my $sth = $dbh->prepare($query);
1927 $sth->execute($cardnumber);
1928 my $imagedata = $sth->fetchrow_hashref;
1929 warn "Database error!" if $sth->errstr;
1930 return $imagedata, $sth->errstr;
1933 =head2 PutPatronImage
1935 PutPatronImage($cardnumber, $mimetype, $imgfile);
1937 Stores patron binary image data and mimetype in database.
1938 NOTE: This function is good for updating images as well as inserting new images in the database.
1942 sub PutPatronImage {
1943 my ($cardnumber, $mimetype, $imgfile) = @_;
1944 warn "Parameters passed in: Cardnumber=$cardnumber, Mimetype=$mimetype, " . ($imgfile ? "Imagefile" : "No Imagefile") if $debug;
1945 my $dbh = C4::Context->dbh;
1946 my $query = "INSERT INTO patronimage (cardnumber, mimetype, imagefile) VALUES (?,?,?) ON DUPLICATE KEY UPDATE imagefile = ?;";
1947 my $sth = $dbh->prepare($query);
1948 $sth->execute($cardnumber,$mimetype,$imgfile,$imgfile);
1949 warn "Error returned inserting $cardnumber.$mimetype." if $sth->errstr;
1950 return $sth->errstr;
1953 =head2 RmPatronImage
1955 my ($dberror) = RmPatronImage($cardnumber);
1957 Removes the image for the patron with the supplied cardnumber.
1962 my ($cardnumber) = @_;
1963 warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1964 my $dbh = C4::Context->dbh;
1965 my $query = "DELETE FROM patronimage WHERE cardnumber = ?;";
1966 my $sth = $dbh->prepare($query);
1967 $sth->execute($cardnumber);
1968 my $dberror = $sth->errstr;
1969 warn "Database error!" if $sth->errstr;
1973 =head2 GetHideLostItemsPreference
1975 $hidelostitemspref = &GetHideLostItemsPreference($borrowernumber);
1977 Returns the HideLostItems preference for the patron category of the supplied borrowernumber
1978 C<&$hidelostitemspref>return value of function, 0 or 1
1982 sub GetHideLostItemsPreference {
1983 my ($borrowernumber) = @_;
1984 my $dbh = C4::Context->dbh;
1985 my $query = "SELECT hidelostitems FROM borrowers,categories WHERE borrowers.categorycode = categories.categorycode AND borrowernumber = ?";
1986 my $sth = $dbh->prepare($query);
1987 $sth->execute($borrowernumber);
1988 my $hidelostitems = $sth->fetchrow;
1989 return $hidelostitems;
1992 =head2 GetRoadTypeDetails (OUEST-PROVENCE)
1994 ($roadtype) = &GetRoadTypeDetails($roadtypeid);
1996 Returns the description of roadtype
1997 C<&$roadtype>return description of road type
1998 C<&$roadtypeid>this is the value of roadtype s
2002 sub GetRoadTypeDetails {
2003 my ($roadtypeid) = @_;
2004 my $dbh = C4::Context->dbh;
2008 WHERE roadtypeid=?|;
2009 my $sth = $dbh->prepare($query);
2010 $sth->execute($roadtypeid);
2011 my $roadtype = $sth->fetchrow;
2015 =head2 GetBorrowersToExpunge
2017 $borrowers = &GetBorrowersToExpunge(
2018 not_borrowered_since => $not_borrowered_since,
2019 expired_before => $expired_before,
2020 category_code => $category_code,
2021 branchcode => $branchcode
2024 This function get all borrowers based on the given criteria.
2028 sub GetBorrowersToExpunge {
2031 my $filterdate = $params->{'not_borrowered_since'};
2032 my $filterexpiry = $params->{'expired_before'};
2033 my $filtercategory = $params->{'category_code'};
2034 my $filterbranch = $params->{'branchcode'} ||
2035 ((C4::Context->preference('IndependantBranches')
2036 && C4::Context->userenv
2037 && C4::Context->userenv->{flags} % 2 !=1
2038 && C4::Context->userenv->{branch})
2039 ? C4::Context->userenv->{branch}
2042 my $dbh = C4::Context->dbh;
2044 SELECT borrowers.borrowernumber,
2045 MAX(old_issues.timestamp) AS latestissue,
2046 MAX(issues.timestamp) AS currentissue
2048 JOIN categories USING (categorycode)
2049 LEFT JOIN old_issues USING (borrowernumber)
2050 LEFT JOIN issues USING (borrowernumber)
2051 WHERE category_type <> 'S'
2052 AND borrowernumber NOT IN (SELECT guarantorid FROM borrowers WHERE guarantorid IS NOT NULL AND guarantorid <> 0)
2055 if ( $filterbranch && $filterbranch ne "" ) {
2056 $query.= " AND borrowers.branchcode = ? ";
2057 push( @query_params, $filterbranch );
2059 if ( $filterexpiry ) {
2060 $query .= " AND dateexpiry < ? ";
2061 push( @query_params, $filterexpiry );
2063 if ( $filtercategory ) {
2064 $query .= " AND categorycode = ? ";
2065 push( @query_params, $filtercategory );
2067 $query.=" GROUP BY borrowers.borrowernumber HAVING currentissue IS NULL ";
2068 if ( $filterdate ) {
2069 $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
2070 push @query_params,$filterdate;
2072 warn $query if $debug;
2074 my $sth = $dbh->prepare($query);
2075 if (scalar(@query_params)>0){
2076 $sth->execute(@query_params);
2083 while ( my $data = $sth->fetchrow_hashref ) {
2084 push @results, $data;
2089 =head2 GetBorrowersWhoHaveNeverBorrowed
2091 $results = &GetBorrowersWhoHaveNeverBorrowed
2093 This function get all borrowers who have never borrowed.
2095 I<$result> is a ref to an array which all elements are a hasref.
2099 sub GetBorrowersWhoHaveNeverBorrowed {
2100 my $filterbranch = shift ||
2101 ((C4::Context->preference('IndependantBranches')
2102 && C4::Context->userenv
2103 && C4::Context->userenv->{flags} % 2 !=1
2104 && C4::Context->userenv->{branch})
2105 ? C4::Context->userenv->{branch}
2107 my $dbh = C4::Context->dbh;
2109 SELECT borrowers.borrowernumber,max(timestamp) as latestissue
2111 LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
2112 WHERE issues.borrowernumber IS NULL
2115 if ($filterbranch && $filterbranch ne ""){
2116 $query.=" AND borrowers.branchcode= ?";
2117 push @query_params,$filterbranch;
2119 warn $query if $debug;
2121 my $sth = $dbh->prepare($query);
2122 if (scalar(@query_params)>0){
2123 $sth->execute(@query_params);
2130 while ( my $data = $sth->fetchrow_hashref ) {
2131 push @results, $data;
2136 =head2 GetBorrowersWithIssuesHistoryOlderThan
2138 $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
2140 this function get all borrowers who has an issue history older than I<$date> given on input arg.
2142 I<$result> is a ref to an array which all elements are a hashref.
2143 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2147 sub GetBorrowersWithIssuesHistoryOlderThan {
2148 my $dbh = C4::Context->dbh;
2149 my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
2150 my $filterbranch = shift ||
2151 ((C4::Context->preference('IndependantBranches')
2152 && C4::Context->userenv
2153 && C4::Context->userenv->{flags} % 2 !=1
2154 && C4::Context->userenv->{branch})
2155 ? C4::Context->userenv->{branch}
2158 SELECT count(borrowernumber) as n,borrowernumber
2160 WHERE returndate < ?
2161 AND borrowernumber IS NOT NULL
2164 push @query_params, $date;
2166 $query.=" AND branchcode = ?";
2167 push @query_params, $filterbranch;
2169 $query.=" GROUP BY borrowernumber ";
2170 warn $query if $debug;
2171 my $sth = $dbh->prepare($query);
2172 $sth->execute(@query_params);
2175 while ( my $data = $sth->fetchrow_hashref ) {
2176 push @results, $data;
2181 =head2 GetBorrowersNamesAndLatestIssue
2183 $results = &GetBorrowersNamesAndLatestIssueList(@borrowernumbers)
2185 this function get borrowers Names and surnames and Issue information.
2187 I<@borrowernumbers> is an array which all elements are borrowernumbers.
2188 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2192 sub GetBorrowersNamesAndLatestIssue {
2193 my $dbh = C4::Context->dbh;
2194 my @borrowernumbers=@_;
2196 SELECT surname,lastname, phone, email,max(timestamp)
2198 LEFT JOIN issues ON borrowers.borrowernumber=issues.borrowernumber
2199 GROUP BY borrowernumber
2201 my $sth = $dbh->prepare($query);
2203 my $results = $sth->fetchall_arrayref({});
2209 my $success = DebarMember( $borrowernumber, $todate );
2211 marks a Member as debarred, and therefore unable to checkout any more
2215 true on success, false on failure
2220 my $borrowernumber = shift;
2223 return unless defined $borrowernumber;
2224 return unless $borrowernumber =~ /^\d+$/;
2227 borrowernumber => $borrowernumber,
2237 my $success = ModPrivacy( $borrowernumber, $privacy );
2239 Update the privacy of a patron.
2242 true on success, false on failure
2249 my $borrowernumber = shift;
2250 my $privacy = shift;
2251 return unless defined $borrowernumber;
2252 return unless $borrowernumber =~ /^\d+$/;
2254 return ModMember( borrowernumber => $borrowernumber,
2255 privacy => $privacy );
2260 AddMessage( $borrowernumber, $message_type, $message, $branchcode );
2262 Adds a message to the messages table for the given borrower.
2271 my ( $borrowernumber, $message_type, $message, $branchcode ) = @_;
2273 my $dbh = C4::Context->dbh;
2275 if ( ! ( $borrowernumber && $message_type && $message && $branchcode ) ) {
2279 my $query = "INSERT INTO messages ( borrowernumber, branchcode, message_type, message ) VALUES ( ?, ?, ?, ? )";
2280 my $sth = $dbh->prepare($query);
2281 $sth->execute( $borrowernumber, $branchcode, $message_type, $message );
2282 logaction("MEMBERS", "ADDCIRCMESSAGE", $borrowernumber, $message) if C4::Context->preference("BorrowersLog");
2288 GetMessages( $borrowernumber, $type );
2290 $type is message type, B for borrower, or L for Librarian.
2291 Empty type returns all messages of any type.
2293 Returns all messages for the given borrowernumber
2298 my ( $borrowernumber, $type, $branchcode ) = @_;
2304 my $dbh = C4::Context->dbh;
2307 branches.branchname,
2310 messages.branchcode LIKE '$branchcode' AS can_delete
2311 FROM messages, branches
2312 WHERE borrowernumber = ?
2313 AND message_type LIKE ?
2314 AND messages.branchcode = branches.branchcode
2315 ORDER BY message_date DESC";
2316 my $sth = $dbh->prepare($query);
2317 $sth->execute( $borrowernumber, $type ) ;
2320 while ( my $data = $sth->fetchrow_hashref ) {
2321 my $d = C4::Dates->new( $data->{message_date}, 'iso' );
2322 $data->{message_date_formatted} = $d->output;
2323 push @results, $data;
2331 GetMessagesCount( $borrowernumber, $type );
2333 $type is message type, B for borrower, or L for Librarian.
2334 Empty type returns all messages of any type.
2336 Returns the number of messages for the given borrowernumber
2340 sub GetMessagesCount {
2341 my ( $borrowernumber, $type, $branchcode ) = @_;
2347 my $dbh = C4::Context->dbh;
2349 my $query = "SELECT COUNT(*) as MsgCount FROM messages WHERE borrowernumber = ? AND message_type LIKE ?";
2350 my $sth = $dbh->prepare($query);
2351 $sth->execute( $borrowernumber, $type ) ;
2354 my $data = $sth->fetchrow_hashref;
2355 my $count = $data->{'MsgCount'};
2362 =head2 DeleteMessage
2364 DeleteMessage( $message_id );
2369 my ( $message_id ) = @_;
2371 my $dbh = C4::Context->dbh;
2372 my $query = "SELECT * FROM messages WHERE message_id = ?";
2373 my $sth = $dbh->prepare($query);
2374 $sth->execute( $message_id );
2375 my $message = $sth->fetchrow_hashref();
2377 $query = "DELETE FROM messages WHERE message_id = ?";
2378 $sth = $dbh->prepare($query);
2379 $sth->execute( $message_id );
2380 logaction("MEMBERS", "DELCIRCMESSAGE", $message->{'borrowernumber'}, $message->{'message'}) if C4::Context->preference("BorrowersLog");
2385 IssueSlip($branchcode, $borrowernumber, $quickslip)
2387 Returns letter hash ( see C4::Letters::GetPreparedLetter )
2389 $quickslip is boolean, to indicate whether we want a quick slip
2394 my ($branch, $borrowernumber, $quickslip) = @_;
2396 # return unless ( C4::Context->boolean_preference('printcirculationslips') );
2398 my $now = POSIX::strftime("%Y-%m-%d", localtime);
2400 my $issueslist = GetPendingIssues($borrowernumber);
2401 foreach my $it (@$issueslist){
2402 if ((substr $it->{'issuedate'}, 0, 10) eq $now || (substr $it->{'lastreneweddate'}, 0, 10) eq $now) {
2405 elsif ((substr $it->{'date_due'}, 0, 10) le $now) {
2406 $it->{'overdue'} = 1;
2408 my $dt = dt_from_string( $it->{'date_due'} );
2409 $it->{'date_due'} = output_pref( $dt );;
2411 my @issues = sort { $b->{'timestamp'} <=> $a->{'timestamp'} } @$issueslist;
2413 my ($letter_code, %repeat);
2415 $letter_code = 'ISSUEQSLIP';
2417 'checkedout' => [ map {
2421 }, grep { $_->{'now'} } @issues ],
2425 $letter_code = 'ISSUESLIP';
2427 'checkedout' => [ map {
2431 }, grep { !$_->{'overdue'} } @issues ],
2433 'overdue' => [ map {
2437 }, grep { $_->{'overdue'} } @issues ],
2440 $_->{'timestamp'} = $_->{'newdate'};
2442 } @{ GetNewsToDisplay("slip") } ],
2446 return C4::Letters::GetPreparedLetter (
2447 module => 'circulation',
2448 letter_code => $letter_code,
2449 branchcode => $branch,
2451 'branches' => $branch,
2452 'borrowers' => $borrowernumber,
2458 =head2 GetBorrowersWithEmail
2460 ([$borrnum,$userid], ...) = GetBorrowersWithEmail('me@example.com');
2462 This gets a list of users and their basic details from their email address.
2463 As it's possible for multiple user to have the same email address, it provides
2464 you with all of them. If there is no userid for the user, there will be an
2465 C<undef> there. An empty list will be returned if there are no matches.
2469 sub GetBorrowersWithEmail {
2472 my $dbh = C4::Context->dbh;
2474 my $query = "SELECT borrowernumber, userid FROM borrowers WHERE email=?";
2475 my $sth=$dbh->prepare($query);
2476 $sth->execute($email);
2478 while (my $ref = $sth->fetch) {
2481 die "Failure searching for borrowers by email address: $sth->errstr" if $sth->err;
2485 sub AddMember_Opac {
2486 my ( %borrower ) = @_;
2488 $borrower{'categorycode'} = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
2490 my $sr = new String::Random;
2491 $sr->{'A'} = [ 'A'..'Z', 'a'..'z' ];
2492 my $password = $sr->randpattern("AAAAAAAAAA");
2493 $borrower{'password'} = $password;
2495 $borrower{'cardnumber'} = fixup_cardnumber();
2497 my $borrowernumber = AddMember(%borrower);
2499 return ( $borrowernumber, $password );
2502 =head2 AddEnrolmentFeeIfNeeded
2504 AddEnrolmentFeeIfNeeded( $borrower->{categorycode}, $borrower->{borrowernumber} );
2506 Add enrolment fee for a patron if needed.
2510 sub AddEnrolmentFeeIfNeeded {
2511 my ( $categorycode, $borrowernumber ) = @_;
2512 # check for enrollment fee & add it if needed
2513 my $dbh = C4::Context->dbh;
2514 my $sth = $dbh->prepare(q{
2517 WHERE categorycode=?
2519 $sth->execute( $categorycode );
2521 warn sprintf('Database returned the following error: %s', $sth->errstr);
2524 my ($enrolmentfee) = $sth->fetchrow;
2525 if ($enrolmentfee && $enrolmentfee > 0) {
2526 # insert fee in patron debts
2527 C4::Accounts::manualinvoice( $borrowernumber, '', '', 'A', $enrolmentfee );
2531 END { } # module clean-up code here (global destructor)