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
10 # under the terms of the GNU General Public License as published by
11 # the Free Software Foundation; either version 3 of the License, or
12 # (at your option) any later version.
14 # Koha is distributed in the hope that it will be useful, but
15 # WITHOUT ANY WARRANTY; without even the implied warranty of
16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 # GNU General Public License for more details.
19 # You should have received a copy of the GNU General Public License
20 # along with Koha; if not, see <http://www.gnu.org/licenses>.
24 #use warnings; FIXME - Bug 2505
26 use String::Random qw( random_string );
27 use Scalar::Util qw( looks_like_number );
28 use Date::Calc qw/Today check_date Date_to_Days/;
29 use C4::Log; # logaction
35 use C4::Members::Attributes qw(SearchIdMatchingAttribute UpdateBorrowerAttribute);
36 use C4::NewsChannels; #get slip news
40 use Text::Unaccent qw( unac_string );
41 use Koha::AuthUtils qw(hash_password);
44 use Koha::List::Patron;
46 use Koha::Patron::Categories;
48 our (@ISA,@EXPORT,@EXPORT_OK,$debug);
50 use Module::Load::Conditional qw( can_load );
51 if ( ! can_load( modules => { 'Koha::NorwegianPatronDB' => undef } ) ) {
52 $debug && warn "Unable to load Koha::NorwegianPatronDB";
57 $debug = $ENV{DEBUG} || 0;
66 &GetMemberIssuesAndFines
70 &GetFirstValidEmailAddress
71 &GetNoticeEmailAddress
76 &GetHideLostItemsPreference
79 &GetMemberAccountRecords
80 &GetBorNotifyAcctRecord
82 GetBorrowerCategorycode
84 &GetBorrowersToExpunge
85 &GetBorrowersWhoHaveNeverBorrowed
86 &GetBorrowersWithIssuesHistoryOlderThan
88 &GetUpcomingMembershipExpires
113 &ExtendMemberSubscriptionTo
129 C4::Members - Perl Module containing convenience functions for member handling
137 This module contains routines for adding, modifying and deleting members/patrons/borrowers
141 =head2 GetMemberDetails
143 ($borrower) = &GetMemberDetails($borrowernumber, $cardnumber);
145 Looks up a patron and returns information about him or her. If
146 C<$borrowernumber> is true (nonzero), C<&GetMemberDetails> looks
147 up the borrower by number; otherwise, it looks up the borrower by card
150 C<$borrower> is a reference-to-hash whose keys are the fields of the
151 borrowers table in the Koha database. In addition,
152 C<$borrower-E<gt>{flags}> is a hash giving more detailed information
153 about the patron. Its keys act as flags :
155 if $borrower->{flags}->{LOST} {
156 # Patron's card was reported lost
159 If the state of a flag means that the patron should not be
160 allowed to borrow any more books, then it will have a C<noissues> key
163 See patronflags for more details.
165 C<$borrower-E<gt>{authflags}> is a hash giving more detailed information
166 about the top-level permissions flags set for the borrower. For example,
167 if a user has the "editcatalogue" permission,
168 C<$borrower-E<gt>{authflags}-E<gt>{editcatalogue}> will exist and have
173 sub GetMemberDetails {
174 my ( $borrowernumber, $cardnumber ) = @_;
175 my $dbh = C4::Context->dbh;
178 if ($borrowernumber) {
179 $sth = $dbh->prepare("
182 categories.description,
183 categories.BlockExpiredPatronOpacActions,
187 LEFT JOIN categories ON borrowers.categorycode=categories.categorycode
188 WHERE borrowernumber = ?
190 $sth->execute($borrowernumber);
192 elsif ($cardnumber) {
193 $sth = $dbh->prepare("
196 categories.description,
197 categories.BlockExpiredPatronOpacActions,
201 LEFT JOIN categories ON borrowers.categorycode = categories.categorycode
204 $sth->execute($cardnumber);
209 my $borrower = $sth->fetchrow_hashref;
210 return unless $borrower;
211 my ($amount) = GetMemberAccountRecords($borrower->{borrowernumber});
212 $borrower->{'amountoutstanding'} = $amount;
213 # FIXME - patronflags calls GetMemberAccountRecords... just have patronflags return $amount
214 my $flags = patronflags( $borrower);
217 $sth = $dbh->prepare("select bit,flag from userflags");
219 while ( my ( $bit, $flag ) = $sth->fetchrow ) {
220 if ( $borrower->{'flags'} && $borrower->{'flags'} & 2**$bit ) {
221 $accessflagshash->{$flag} = 1;
224 $borrower->{'flags'} = $flags;
225 $borrower->{'authflags'} = $accessflagshash;
227 # Handle setting the true behavior for BlockExpiredPatronOpacActions
228 $borrower->{'BlockExpiredPatronOpacActions'} =
229 C4::Context->preference('BlockExpiredPatronOpacActions')
230 if ( $borrower->{'BlockExpiredPatronOpacActions'} == -1 );
232 $borrower->{'is_expired'} = 0;
233 $borrower->{'is_expired'} = 1 if
234 defined($borrower->{dateexpiry}) &&
235 $borrower->{'dateexpiry'} ne '0000-00-00' &&
236 Date_to_Days( Today() ) >
237 Date_to_Days( split /-/, $borrower->{'dateexpiry'} );
239 return ($borrower); #, $flags, $accessflagshash);
244 $flags = &patronflags($patron);
246 This function is not exported.
248 The following will be set where applicable:
249 $flags->{CHARGES}->{amount} Amount of debt
250 $flags->{CHARGES}->{noissues} Set if debt amount >$5.00 (or syspref noissuescharge)
251 $flags->{CHARGES}->{message} Message -- deprecated
253 $flags->{CREDITS}->{amount} Amount of credit
254 $flags->{CREDITS}->{message} Message -- deprecated
256 $flags->{ GNA } Patron has no valid address
257 $flags->{ GNA }->{noissues} Set for each GNA
258 $flags->{ GNA }->{message} "Borrower has no valid address" -- deprecated
260 $flags->{ LOST } Patron's card reported lost
261 $flags->{ LOST }->{noissues} Set for each LOST
262 $flags->{ LOST }->{message} Message -- deprecated
264 $flags->{DBARRED} Set if patron debarred, no access
265 $flags->{DBARRED}->{noissues} Set for each DBARRED
266 $flags->{DBARRED}->{message} Message -- deprecated
269 $flags->{ NOTES }->{message} The note itself. NOT deprecated
271 $flags->{ ODUES } Set if patron has overdue books.
272 $flags->{ ODUES }->{message} "Yes" -- deprecated
273 $flags->{ ODUES }->{itemlist} ref-to-array: list of overdue books
274 $flags->{ ODUES }->{itemlisttext} Text list of overdue items -- deprecated
276 $flags->{WAITING} Set if any of patron's reserves are available
277 $flags->{WAITING}->{message} Message -- deprecated
278 $flags->{WAITING}->{itemlist} ref-to-array: list of available items
282 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
283 overdue items. Its elements are references-to-hash, each describing an
284 overdue item. The keys are selected fields from the issues, biblio,
285 biblioitems, and items tables of the Koha database.
287 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
288 the overdue items, one per line. Deprecated.
290 =item C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
291 available items. Each element is a reference-to-hash whose keys are
292 fields from the reserves table of the Koha database.
296 All the "message" fields that include language generated in this function are deprecated,
297 because such strings belong properly in the display layer.
299 The "message" field that comes from the DB is OK.
303 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
304 # FIXME rename this function.
307 my ( $patroninformation) = @_;
308 my $dbh=C4::Context->dbh;
309 my ($balance, $owing) = GetMemberAccountBalance( $patroninformation->{'borrowernumber'});
312 my $noissuescharge = C4::Context->preference("noissuescharge") || 5;
313 $flaginfo{'message'} = sprintf 'Patron owes %.02f', $owing;
314 $flaginfo{'amount'} = sprintf "%.02f", $owing;
315 if ( $owing > $noissuescharge && !C4::Context->preference("AllowFineOverride") ) {
316 $flaginfo{'noissues'} = 1;
318 $flags{'CHARGES'} = \%flaginfo;
320 elsif ( $balance < 0 ) {
322 $flaginfo{'message'} = sprintf 'Patron has credit of %.02f', -$balance;
323 $flaginfo{'amount'} = sprintf "%.02f", $balance;
324 $flags{'CREDITS'} = \%flaginfo;
327 # Check the debt of the guarntees of this patron
328 my $no_issues_charge_guarantees = C4::Context->preference("NoIssuesChargeGuarantees");
329 $no_issues_charge_guarantees = undef unless looks_like_number( $no_issues_charge_guarantees );
330 if ( defined $no_issues_charge_guarantees ) {
331 my $p = Koha::Patrons->find( $patroninformation->{borrowernumber} );
332 my @guarantees = $p->guarantees();
333 my $guarantees_non_issues_charges;
334 foreach my $g ( @guarantees ) {
335 my ( $b, $n, $o ) = C4::Members::GetMemberAccountBalance( $g->id );
336 $guarantees_non_issues_charges += $n;
339 if ( $guarantees_non_issues_charges > $no_issues_charge_guarantees ) {
341 $flaginfo{'message'} = sprintf 'patron guarantees owe %.02f', $guarantees_non_issues_charges;
342 $flaginfo{'amount'} = $guarantees_non_issues_charges;
343 $flaginfo{'noissues'} = 1 unless C4::Context->preference("allowfineoverride");
344 $flags{'CHARGES_GUARANTEES'} = \%flaginfo;
348 if ( $patroninformation->{'gonenoaddress'}
349 && $patroninformation->{'gonenoaddress'} == 1 )
352 $flaginfo{'message'} = 'Borrower has no valid address.';
353 $flaginfo{'noissues'} = 1;
354 $flags{'GNA'} = \%flaginfo;
356 if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
358 $flaginfo{'message'} = 'Borrower\'s card reported lost.';
359 $flaginfo{'noissues'} = 1;
360 $flags{'LOST'} = \%flaginfo;
362 if ( $patroninformation->{'debarred'} && check_date( split( /-/, $patroninformation->{'debarred'} ) ) ) {
363 if ( Date_to_Days(Date::Calc::Today) < Date_to_Days( split( /-/, $patroninformation->{'debarred'} ) ) ) {
365 $flaginfo{'debarredcomment'} = $patroninformation->{'debarredcomment'};
366 $flaginfo{'message'} = $patroninformation->{'debarredcomment'};
367 $flaginfo{'noissues'} = 1;
368 $flaginfo{'dateend'} = $patroninformation->{'debarred'};
369 $flags{'DBARRED'} = \%flaginfo;
372 if ( $patroninformation->{'borrowernotes'}
373 && $patroninformation->{'borrowernotes'} )
376 $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
377 $flags{'NOTES'} = \%flaginfo;
379 my ( $odues, $itemsoverdue ) = C4::Overdues::checkoverdues($patroninformation->{'borrowernumber'});
380 if ( $odues && $odues > 0 ) {
382 $flaginfo{'message'} = "Yes";
383 $flaginfo{'itemlist'} = $itemsoverdue;
384 foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
387 $flaginfo{'itemlisttext'} .=
388 "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n"; # newline is display layer
390 $flags{'ODUES'} = \%flaginfo;
392 my @itemswaiting = C4::Reserves::GetReservesFromBorrowernumber( $patroninformation->{'borrowernumber'},'W' );
393 my $nowaiting = scalar @itemswaiting;
394 if ( $nowaiting > 0 ) {
396 $flaginfo{'message'} = "Reserved items available";
397 $flaginfo{'itemlist'} = \@itemswaiting;
398 $flags{'WAITING'} = \%flaginfo;
406 $borrower = &GetMember(%information);
408 Retrieve the first patron record meeting on criteria listed in the
409 C<%information> hash, which should contain one or more
410 pairs of borrowers column names and values, e.g.,
412 $borrower = GetMember(borrowernumber => id);
414 C<&GetBorrower> returns a reference-to-hash whose keys are the fields of
415 the C<borrowers> table in the Koha database.
417 FIXME: GetMember() is used throughout the code as a lookup
418 on a unique key such as the borrowernumber, but this meaning is not
419 enforced in the routine itself.
425 my ( %information ) = @_;
426 if (exists $information{borrowernumber} && !defined $information{borrowernumber}) {
427 #passing mysql's kohaadmin?? Makes no sense as a query
430 my $dbh = C4::Context->dbh;
432 q{SELECT borrowers.*, categories.category_type, categories.description
434 LEFT JOIN categories on borrowers.categorycode=categories.categorycode WHERE };
437 for (keys %information ) {
445 if (defined $information{$_}) {
447 push @values, $information{$_};
450 $select .= "$_ IS NULL";
453 $debug && warn $select, " ",values %information;
454 my $sth = $dbh->prepare("$select");
455 $sth->execute(@values);
456 my $data = $sth->fetchall_arrayref({});
457 #FIXME interface to this routine now allows generation of a result set
458 #so whole array should be returned but bowhere in the current code expects this
466 =head2 IsMemberBlocked
468 my ($block_status, $count) = IsMemberBlocked( $borrowernumber );
470 Returns whether a patron is restricted or has overdue items that may result
471 in a block of circulation privileges.
473 C<$block_status> can have the following values:
475 1 if the patron is currently restricted, in which case
476 C<$count> is the expiration date (9999-12-31 for indefinite)
478 -1 if the patron has overdue items, in which case C<$count> is the number of them
480 0 if the patron has no overdue items or outstanding fine days, in which case C<$count> is 0
482 Existing active restrictions are checked before current overdue items.
486 sub IsMemberBlocked {
487 my $borrowernumber = shift;
488 my $dbh = C4::Context->dbh;
490 my $blockeddate = Koha::Patrons->find( $borrowernumber )->is_debarred;
492 return ( 1, $blockeddate ) if $blockeddate;
494 # if he have late issues
495 my $sth = $dbh->prepare(
496 "SELECT COUNT(*) as latedocs
498 WHERE borrowernumber = ?
499 AND date_due < now()"
501 $sth->execute($borrowernumber);
502 my $latedocs = $sth->fetchrow_hashref->{'latedocs'};
504 return ( -1, $latedocs ) if $latedocs > 0;
509 =head2 GetMemberIssuesAndFines
511 ($overdue_count, $issue_count, $total_fines) = &GetMemberIssuesAndFines($borrowernumber);
513 Returns aggregate data about items borrowed by the patron with the
514 given borrowernumber.
516 C<&GetMemberIssuesAndFines> returns a three-element array. C<$overdue_count> is the
517 number of overdue items the patron currently has borrowed. C<$issue_count> is the
518 number of books the patron currently has borrowed. C<$total_fines> is
519 the total fine currently due by the borrower.
524 sub GetMemberIssuesAndFines {
525 my ( $borrowernumber ) = @_;
526 my $dbh = C4::Context->dbh;
527 my $query = "SELECT COUNT(*) FROM issues WHERE borrowernumber = ?";
529 $debug and warn $query."\n";
530 my $sth = $dbh->prepare($query);
531 $sth->execute($borrowernumber);
532 my $issue_count = $sth->fetchrow_arrayref->[0];
534 $sth = $dbh->prepare(
535 "SELECT COUNT(*) FROM issues
536 WHERE borrowernumber = ?
537 AND date_due < now()"
539 $sth->execute($borrowernumber);
540 my $overdue_count = $sth->fetchrow_arrayref->[0];
542 $sth = $dbh->prepare("SELECT SUM(amountoutstanding) FROM accountlines WHERE borrowernumber = ?");
543 $sth->execute($borrowernumber);
544 my $total_fines = $sth->fetchrow_arrayref->[0];
546 return ($overdue_count, $issue_count, $total_fines);
552 my $success = ModMember(borrowernumber => $borrowernumber,
553 [ field => value ]... );
555 Modify borrower's data. All date fields should ALREADY be in ISO format.
558 true on success, or false on failure
564 # test to know if you must update or not the borrower password
565 if (exists $data{password}) {
566 if ($data{password} eq '****' or $data{password} eq '') {
567 delete $data{password};
569 if ( C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
570 # Update the hashed PIN in borrower_sync.hashed_pin, before Koha hashes it
571 Koha::NorwegianPatronDB::NLUpdateHashedPIN( $data{'borrowernumber'}, $data{password} );
573 $data{password} = hash_password($data{password});
577 my $old_categorycode = GetBorrowerCategorycode( $data{borrowernumber} );
579 # get only the columns of a borrower
580 my $schema = Koha::Database->new()->schema;
581 my @columns = $schema->source('Borrower')->columns;
582 my $new_borrower = { map { join(' ', @columns) =~ /$_/ ? ( $_ => $data{$_} ) : () } keys(%data) };
583 delete $new_borrower->{flags};
585 $new_borrower->{dateofbirth} ||= undef if exists $new_borrower->{dateofbirth};
586 $new_borrower->{dateenrolled} ||= undef if exists $new_borrower->{dateenrolled};
587 $new_borrower->{dateexpiry} ||= undef if exists $new_borrower->{dateexpiry};
588 $new_borrower->{debarred} ||= undef if exists $new_borrower->{debarred};
589 $new_borrower->{sms_provider_id} ||= undef if exists $new_borrower->{sms_provider_id};
591 my $rs = $schema->resultset('Borrower')->search({
592 borrowernumber => $new_borrower->{borrowernumber},
595 delete $new_borrower->{userid} if exists $new_borrower->{userid} and not $new_borrower->{userid};
597 my $execute_success = $rs->update($new_borrower);
598 if ($execute_success ne '0E0') { # only proceed if the update was a success
599 # If the patron changes to a category with enrollment fee, we add a fee
600 if ( $data{categorycode} and $data{categorycode} ne $old_categorycode ) {
601 if ( C4::Context->preference('FeeOnChangePatronCategory') ) {
602 AddEnrolmentFeeIfNeeded( $data{categorycode}, $data{borrowernumber} );
606 # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
607 # cronjob will use for syncing with NL
608 if ( C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
609 my $borrowersync = Koha::Database->new->schema->resultset('BorrowerSync')->find({
610 'synctype' => 'norwegianpatrondb',
611 'borrowernumber' => $data{'borrowernumber'}
613 # Do not set to "edited" if syncstatus is "new". We need to sync as new before
614 # we can sync as changed. And the "new sync" will pick up all changes since
615 # the patron was created anyway.
616 if ( $borrowersync->syncstatus ne 'new' && $borrowersync->syncstatus ne 'delete' ) {
617 $borrowersync->update( { 'syncstatus' => 'edited' } );
619 # Set the value of 'sync'
620 $borrowersync->update( { 'sync' => $data{'sync'} } );
621 # Try to do the live sync
622 Koha::NorwegianPatronDB::NLSync({ 'borrowernumber' => $data{'borrowernumber'} });
625 logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "UPDATE (executed w/ arg: $data{'borrowernumber'})") if C4::Context->preference("BorrowersLog");
627 return $execute_success;
632 $borrowernumber = &AddMember(%borrower);
634 insert new borrower into table
636 (%borrower keys are database columns. Database columns could be
637 different in different versions. Please look into database for correct
640 Returns the borrowernumber upon success
642 Returns as undef upon any db error without further processing
649 my $dbh = C4::Context->dbh;
650 my $schema = Koha::Database->new()->schema;
652 # generate a proper login if none provided
653 $data{'userid'} = Generate_Userid( $data{'borrowernumber'}, $data{'firstname'}, $data{'surname'} )
654 if ( $data{'userid'} eq '' || !Check_Userid( $data{'userid'} ) );
656 # add expiration date if it isn't already there
657 $data{dateexpiry} ||= Koha::Patron::Categories->find( $data{categorycode} )->get_expiry_date;
659 # add enrollment date if it isn't already there
660 unless ( $data{'dateenrolled'} ) {
661 $data{'dateenrolled'} = output_pref( { dt => dt_from_string, dateonly => 1, dateformat => 'iso' } );
664 my $patron_category = $schema->resultset('Category')->find( $data{'categorycode'} );
666 $patron_category->default_privacy() eq 'default' ? 1
667 : $patron_category->default_privacy() eq 'never' ? 2
668 : $patron_category->default_privacy() eq 'forever' ? 0
671 $data{'privacy_guarantor_checkouts'} = 0 unless defined( $data{'privacy_guarantor_checkouts'} );
673 # Make a copy of the plain text password for later use
674 my $plain_text_password = $data{'password'};
676 # create a disabled account if no password provided
677 $data{'password'} = ($data{'password'})? hash_password($data{'password'}) : '!';
679 # we don't want invalid dates in the db (mysql has a bad habit of inserting 0000-00-00
680 $data{'dateofbirth'} = undef if ( not $data{'dateofbirth'} );
681 $data{'debarred'} = undef if ( not $data{'debarred'} );
682 $data{'sms_provider_id'} = undef if ( not $data{'sms_provider_id'} );
684 # get only the columns of Borrower
685 my @columns = $schema->source('Borrower')->columns;
686 my $new_member = { map { join(' ',@columns) =~ /$_/ ? ( $_ => $data{$_} ) : () } keys(%data) } ;
687 $new_member->{checkprevcheckout} ||= 'inherit';
688 delete $new_member->{borrowernumber};
690 my $rs = $schema->resultset('Borrower');
691 $data{borrowernumber} = $rs->create($new_member)->id;
693 # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
694 # cronjob will use for syncing with NL
695 if ( exists $data{'borrowernumber'} && C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
696 Koha::Database->new->schema->resultset('BorrowerSync')->create({
697 'borrowernumber' => $data{'borrowernumber'},
698 'synctype' => 'norwegianpatrondb',
700 'syncstatus' => 'new',
701 'hashed_pin' => Koha::NorwegianPatronDB::NLEncryptPIN( $plain_text_password ),
705 # mysql_insertid is probably bad. not necessarily accurate and mysql-specific at best.
706 logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
708 AddEnrolmentFeeIfNeeded( $data{categorycode}, $data{borrowernumber} );
710 return $data{borrowernumber};
715 my $uniqueness = Check_Userid($userid,$borrowernumber);
717 $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 != '').
719 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.
722 0 for not unique (i.e. this $userid already exists)
723 1 for unique (i.e. this $userid does not exist, or this $userid/$borrowernumber combination already exists)
728 my ( $uid, $borrowernumber ) = @_;
730 return 0 unless ($uid); # userid is a unique column, we should assume NULL is not unique
732 return 0 if ( $uid eq C4::Context->config('user') );
734 my $rs = Koha::Database->new()->schema()->resultset('Borrower');
737 $params->{userid} = $uid;
738 $params->{borrowernumber} = { '!=' => $borrowernumber } if ($borrowernumber);
740 my $count = $rs->count( $params );
742 return $count ? 0 : 1;
745 =head2 Generate_Userid
747 my $newuid = Generate_Userid($borrowernumber, $firstname, $surname);
749 Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
751 $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.
754 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).
758 sub Generate_Userid {
759 my ($borrowernumber, $firstname, $surname) = @_;
762 #The script will "do" the following code and increment the $offset until Check_Userid = 1 (i.e. until $newuid comes back as unique)
764 $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
765 $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
766 $newuid = lc(($firstname)? "$firstname.$surname" : $surname);
767 $newuid = unac_string('utf-8',$newuid);
768 $newuid .= $offset unless $offset == 0;
771 } while (!Check_Userid($newuid,$borrowernumber));
776 =head2 fixup_cardnumber
778 Warning: The caller is responsible for locking the members table in write
779 mode, to avoid database corruption.
783 use vars qw( @weightings );
784 my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
786 sub fixup_cardnumber {
787 my ($cardnumber) = @_;
788 my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;
790 # Find out whether member numbers should be generated
791 # automatically. Should be either "1" or something else.
792 # Defaults to "0", which is interpreted as "no".
794 # if ($cardnumber !~ /\S/ && $autonumber_members) {
795 ($autonumber_members) or return $cardnumber;
796 my $checkdigit = C4::Context->preference('checkdigit');
797 my $dbh = C4::Context->dbh;
798 if ( $checkdigit and $checkdigit eq 'katipo' ) {
800 # if checkdigit is selected, calculate katipo-style cardnumber.
801 # otherwise, just use the max()
802 # purpose: generate checksum'd member numbers.
803 # We'll assume we just got the max value of digits 2-8 of member #'s
804 # from the database and our job is to increment that by one,
805 # determine the 1st and 9th digits and return the full string.
806 my $sth = $dbh->prepare(
807 "select max(substring(borrowers.cardnumber,2,7)) as new_num from borrowers"
810 my $data = $sth->fetchrow_hashref;
811 $cardnumber = $data->{new_num};
812 if ( !$cardnumber ) { # If DB has no values,
813 $cardnumber = 1000000; # start at 1000000
819 for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
820 # read weightings, left to right, 1 char at a time
821 my $temp1 = $weightings[$i];
823 # sequence left to right, 1 char at a time
824 my $temp2 = substr( $cardnumber, $i, 1 );
826 # mult each char 1-7 by its corresponding weighting
827 $sum += $temp1 * $temp2;
830 my $rem = ( $sum % 11 );
831 $rem = 'X' if $rem == 10;
833 return "V$cardnumber$rem";
836 my $sth = $dbh->prepare(
837 'SELECT MAX( CAST( cardnumber AS SIGNED ) ) FROM borrowers WHERE cardnumber REGEXP "^-?[0-9]+$"'
840 my ($result) = $sth->fetchrow;
843 return $cardnumber; # just here as a fallback/reminder
846 =head2 GetPendingIssues
848 my $issues = &GetPendingIssues(@borrowernumber);
850 Looks up what the patron with the given borrowernumber has borrowed.
852 C<&GetPendingIssues> returns a
853 reference-to-array where each element is a reference-to-hash; the
854 keys are the fields from the C<issues>, C<biblio>, and C<items> tables.
855 The keys include C<biblioitems> fields except marc and marcxml.
859 sub GetPendingIssues {
860 my @borrowernumbers = @_;
862 unless (@borrowernumbers ) { # return a ref_to_array
863 return \@borrowernumbers; # to not cause surprise to caller
866 # Borrowers part of the query
868 for (my $i = 0; $i < @borrowernumbers; $i++) {
869 $bquery .= ' issues.borrowernumber = ?';
870 if ($i < $#borrowernumbers ) {
875 # must avoid biblioitems.* to prevent large marc and marcxml fields from killing performance
876 # FIXME: namespace collision: each table has "timestamp" fields. Which one is "timestamp" ?
877 # FIXME: circ/ciculation.pl tries to sort by timestamp!
878 # FIXME: namespace collision: other collisions possible.
879 # FIXME: most of this data isn't really being used by callers.
886 biblioitems.itemtype,
889 biblioitems.publicationyear,
890 biblioitems.publishercode,
891 biblioitems.volumedate,
892 biblioitems.volumedesc,
897 borrowers.cardnumber,
898 issues.timestamp AS timestamp,
899 issues.renewals AS renewals,
900 issues.borrowernumber AS borrowernumber,
901 items.renewals AS totalrenewals
903 LEFT JOIN items ON items.itemnumber = issues.itemnumber
904 LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
905 LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
906 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
909 ORDER BY issues.issuedate"
912 my $sth = C4::Context->dbh->prepare($query);
913 $sth->execute(@borrowernumbers);
914 my $data = $sth->fetchall_arrayref({});
915 my $today = dt_from_string;
917 if ($_->{issuedate}) {
918 $_->{issuedate} = dt_from_string($_->{issuedate}, 'sql');
920 $_->{date_due_sql} = $_->{date_due};
921 # FIXME no need to have this value
922 $_->{date_due} or next;
923 $_->{date_due_sql} = $_->{date_due};
924 # FIXME no need to have this value
925 $_->{date_due} = dt_from_string($_->{date_due}, 'sql');
926 if ( DateTime->compare($_->{date_due}, $today) == -1 ) {
935 $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
937 Looks up what the patron with the given borrowernumber has borrowed,
938 and sorts the results.
940 C<$sortkey> is the name of a field on which to sort the results. This
941 should be the name of a field in the C<issues>, C<biblio>,
942 C<biblioitems>, or C<items> table in the Koha database.
944 C<$limit> is the maximum number of results to return.
946 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
947 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
948 C<items> tables of the Koha database.
954 my ( $borrowernumber, $order, $limit ) = @_;
956 return unless $borrowernumber;
957 $order = 'date_due desc' unless $order;
959 my $dbh = C4::Context->dbh;
961 'SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
963 LEFT JOIN items on items.itemnumber=issues.itemnumber
964 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
965 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
966 WHERE borrowernumber=?
968 SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
970 LEFT JOIN items on items.itemnumber=old_issues.itemnumber
971 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
972 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
973 WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL
976 $query .= " limit $limit";
979 my $sth = $dbh->prepare($query);
980 $sth->execute( $borrowernumber, $borrowernumber );
981 return $sth->fetchall_arrayref( {} );
985 =head2 GetMemberAccountRecords
987 ($total, $acctlines, $count) = &GetMemberAccountRecords($borrowernumber);
989 Looks up accounting data for the patron with the given borrowernumber.
991 C<&GetMemberAccountRecords> returns a three-element array. C<$acctlines> is a
992 reference-to-array, where each element is a reference-to-hash; the
993 keys are the fields of the C<accountlines> table in the Koha database.
994 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
995 total amount outstanding for all of the account lines.
999 sub GetMemberAccountRecords {
1000 my ($borrowernumber) = @_;
1001 my $dbh = C4::Context->dbh;
1007 WHERE borrowernumber=?);
1008 $strsth.=" ORDER BY accountlines_id desc";
1009 my $sth= $dbh->prepare( $strsth );
1010 $sth->execute( $borrowernumber );
1013 while ( my $data = $sth->fetchrow_hashref ) {
1014 if ( $data->{itemnumber} ) {
1015 my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
1016 $data->{biblionumber} = $biblio->{biblionumber};
1017 $data->{title} = $biblio->{title};
1019 $acctlines[$numlines] = $data;
1021 $total += sprintf "%.0f", 1000*$data->{amountoutstanding}; # convert float to integer to avoid round-off errors
1024 return ( $total, \@acctlines,$numlines);
1027 =head2 GetMemberAccountBalance
1029 ($total_balance, $non_issue_balance, $other_charges) = &GetMemberAccountBalance($borrowernumber);
1031 Calculates amount immediately owing by the patron - non-issue charges.
1032 Based on GetMemberAccountRecords.
1033 Charges exempt from non-issue are:
1035 * Rent (rental) if RentalsInNoissuesCharge syspref is set to false
1036 * Manual invoices if ManInvInNoissuesCharge syspref is set to false
1040 sub GetMemberAccountBalance {
1041 my ($borrowernumber) = @_;
1043 my $ACCOUNT_TYPE_LENGTH = 5; # this is plain ridiculous...
1046 push @not_fines, 'Res' unless C4::Context->preference('HoldsInNoissuesCharge');
1047 push @not_fines, 'Rent' unless C4::Context->preference('RentalsInNoissuesCharge');
1048 unless ( C4::Context->preference('ManInvInNoissuesCharge') ) {
1049 my $dbh = C4::Context->dbh;
1050 my $man_inv_types = $dbh->selectcol_arrayref(qq{SELECT authorised_value FROM authorised_values WHERE category = 'MANUAL_INV'});
1051 push @not_fines, map substr($_, 0, $ACCOUNT_TYPE_LENGTH), @$man_inv_types;
1053 my %not_fine = map {$_ => 1} @not_fines;
1055 my ($total, $acctlines) = GetMemberAccountRecords($borrowernumber);
1056 my $other_charges = 0;
1057 foreach (@$acctlines) {
1058 $other_charges += $_->{amountoutstanding} if $not_fine{ substr($_->{accounttype}, 0, $ACCOUNT_TYPE_LENGTH) };
1061 return ( $total, $total - $other_charges, $other_charges);
1064 =head2 GetBorNotifyAcctRecord
1066 ($total, $acctlines, $count) = &GetBorNotifyAcctRecord($params,$notifyid);
1068 Looks up accounting data for the patron with the given borrowernumber per file number.
1070 C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a
1071 reference-to-array, where each element is a reference-to-hash; the
1072 keys are the fields of the C<accountlines> table in the Koha database.
1073 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1074 total amount outstanding for all of the account lines.
1078 sub GetBorNotifyAcctRecord {
1079 my ( $borrowernumber, $notifyid ) = @_;
1080 my $dbh = C4::Context->dbh;
1083 my $sth = $dbh->prepare(
1086 WHERE borrowernumber=?
1088 AND amountoutstanding != '0'
1089 ORDER BY notify_id,accounttype
1092 $sth->execute( $borrowernumber, $notifyid );
1094 while ( my $data = $sth->fetchrow_hashref ) {
1095 if ( $data->{itemnumber} ) {
1096 my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
1097 $data->{biblionumber} = $biblio->{biblionumber};
1098 $data->{title} = $biblio->{title};
1100 $acctlines[$numlines] = $data;
1102 $total += int(100 * $data->{'amountoutstanding'});
1105 return ( $total, \@acctlines, $numlines );
1108 sub checkcardnumber {
1109 my ( $cardnumber, $borrowernumber ) = @_;
1111 # If cardnumber is null, we assume they're allowed.
1112 return 0 unless defined $cardnumber;
1114 my $dbh = C4::Context->dbh;
1115 my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
1116 $query .= " AND borrowernumber <> ?" if ($borrowernumber);
1117 my $sth = $dbh->prepare($query);
1120 ( $borrowernumber ? $borrowernumber : () )
1123 return 1 if $sth->fetchrow_hashref;
1125 my ( $min_length, $max_length ) = get_cardnumber_length();
1127 if length $cardnumber > $max_length
1128 or length $cardnumber < $min_length;
1133 =head2 get_cardnumber_length
1135 my ($min, $max) = C4::Members::get_cardnumber_length()
1137 Returns the minimum and maximum length for patron cardnumbers as
1138 determined by the CardnumberLength system preference, the
1139 BorrowerMandatoryField system preference, and the width of the
1144 sub get_cardnumber_length {
1145 my ( $min, $max ) = ( 0, 16 ); # borrowers.cardnumber is a nullable varchar(16)
1146 $min = 1 if C4::Context->preference('BorrowerMandatoryField') =~ /cardnumber/;
1147 if ( my $cardnumber_length = C4::Context->preference('CardnumberLength') ) {
1148 # Is integer and length match
1149 if ( $cardnumber_length =~ m|^\d+$| ) {
1150 $min = $max = $cardnumber_length
1151 if $cardnumber_length >= $min
1152 and $cardnumber_length <= $max;
1154 # Else assuming it is a range
1155 elsif ( $cardnumber_length =~ m|(\d*),(\d*)| ) {
1156 $min = $1 if $1 and $min < $1;
1157 $max = $2 if $2 and $max > $2;
1161 return ( $min, $max );
1164 =head2 GetFirstValidEmailAddress
1166 $email = GetFirstValidEmailAddress($borrowernumber);
1168 Return the first valid email address for a borrower, given the borrowernumber. For now, the order
1169 is defined as email, emailpro, B_email. Returns the empty string if the borrower has no email
1174 sub GetFirstValidEmailAddress {
1175 my $borrowernumber = shift;
1176 my $dbh = C4::Context->dbh;
1177 my $sth = $dbh->prepare( "SELECT email, emailpro, B_email FROM borrowers where borrowernumber = ? ");
1178 $sth->execute( $borrowernumber );
1179 my $data = $sth->fetchrow_hashref;
1181 if ($data->{'email'}) {
1182 return $data->{'email'};
1183 } elsif ($data->{'emailpro'}) {
1184 return $data->{'emailpro'};
1185 } elsif ($data->{'B_email'}) {
1186 return $data->{'B_email'};
1192 =head2 GetNoticeEmailAddress
1194 $email = GetNoticeEmailAddress($borrowernumber);
1196 Return the email address of borrower used for notices, given the borrowernumber.
1197 Returns the empty string if no email address.
1201 sub GetNoticeEmailAddress {
1202 my $borrowernumber = shift;
1204 my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
1205 # if syspref is set to 'first valid' (value == OFF), look up email address
1206 if ( $which_address eq 'OFF' ) {
1207 return GetFirstValidEmailAddress($borrowernumber);
1209 # specified email address field
1210 my $dbh = C4::Context->dbh;
1211 my $sth = $dbh->prepare( qq{
1212 SELECT $which_address AS primaryemail
1214 WHERE borrowernumber=?
1216 $sth->execute($borrowernumber);
1217 my $data = $sth->fetchrow_hashref;
1218 return $data->{'primaryemail'} || '';
1221 =head2 GetUpcomingMembershipExpires
1223 my $expires = GetUpcomingMembershipExpires({
1224 branch => $branch, before => $before, after => $after,
1227 $branch is an optional branch code.
1228 $before/$after is an optional number of days before/after the date that
1229 is set by the preference MembershipExpiryDaysNotice.
1230 If the pref would be 14, before 2 and after 3, you will get all expires
1235 sub GetUpcomingMembershipExpires {
1236 my ( $params ) = @_;
1237 my $before = $params->{before} || 0;
1238 my $after = $params->{after} || 0;
1239 my $branch = $params->{branch};
1241 my $dbh = C4::Context->dbh;
1242 my $days = C4::Context->preference("MembershipExpiryDaysNotice") || 0;
1243 my $date1 = dt_from_string->add( days => $days - $before );
1244 my $date2 = dt_from_string->add( days => $days + $after );
1245 $date1= output_pref({ dt => $date1, dateformat => 'iso', dateonly => 1 });
1246 $date2= output_pref({ dt => $date2, dateformat => 'iso', dateonly => 1 });
1249 SELECT borrowers.*, categories.description,
1250 branches.branchname, branches.branchemail FROM borrowers
1251 LEFT JOIN branches USING (branchcode)
1252 LEFT JOIN categories USING (categorycode)
1255 $query.= 'WHERE branchcode=? AND dateexpiry BETWEEN ? AND ?';
1257 $query.= 'WHERE dateexpiry BETWEEN ? AND ?';
1260 my $sth = $dbh->prepare( $query );
1261 my @pars = $branch? ( $branch ): ();
1262 push @pars, $date1, $date2;
1263 $sth->execute( @pars );
1264 my $results = $sth->fetchall_arrayref( {} );
1268 =head2 GetBorrowerCategorycode
1270 $categorycode = &GetBorrowerCategoryCode( $borrowernumber );
1272 Given the borrowernumber, the function returns the corresponding categorycode
1276 sub GetBorrowerCategorycode {
1277 my ( $borrowernumber ) = @_;
1278 my $dbh = C4::Context->dbh;
1279 my $sth = $dbh->prepare( qq{
1282 WHERE borrowernumber = ?
1284 $sth->execute( $borrowernumber );
1285 return $sth->fetchrow;
1290 $dateofbirth,$date = &GetAge($date);
1292 this function return the borrowers age with the value of dateofbirth
1298 my ( $date, $date_ref ) = @_;
1300 if ( not defined $date_ref ) {
1301 $date_ref = sprintf( '%04d-%02d-%02d', Today() );
1304 my ( $year1, $month1, $day1 ) = split /-/, $date;
1305 my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
1307 my $age = $year2 - $year1;
1308 if ( $month1 . $day1 > $month2 . $day2 ) {
1317 $borrower = C4::Members::SetAge($borrower, $datetimeduration);
1318 $borrower = C4::Members::SetAge($borrower, '0015-12-10');
1319 $borrower = C4::Members::SetAge($borrower, $datetimeduration, $datetime_reference);
1321 eval { $borrower = C4::Members::SetAge($borrower, '015-1-10'); };
1322 if ($@) {print $@;} #Catch a bad ISO Date or kill your script!
1324 This function sets the borrower's dateofbirth to match the given age.
1325 Optionally relative to the given $datetime_reference.
1327 @PARAM1 koha.borrowers-object
1328 @PARAM2 DateTime::Duration-object as the desired age
1329 OR a ISO 8601 Date. (To make the API more pleasant)
1330 @PARAM3 DateTime-object as the relative date, defaults to now().
1331 RETURNS The given borrower reference @PARAM1.
1332 DIES If there was an error with the ISO Date handling.
1338 my ( $borrower, $datetimeduration, $datetime_ref ) = @_;
1339 $datetime_ref = DateTime->now() unless $datetime_ref;
1341 if ($datetimeduration && ref $datetimeduration ne 'DateTime::Duration') {
1342 if ($datetimeduration =~ /^(\d{4})-(\d{2})-(\d{2})/) {
1343 $datetimeduration = DateTime::Duration->new(years => $1, months => $2, days => $3);
1346 die "C4::Members::SetAge($borrower, $datetimeduration), datetimeduration not a valid ISO 8601 Date!\n";
1350 my $new_datetime_ref = $datetime_ref->clone();
1351 $new_datetime_ref->subtract_duration( $datetimeduration );
1353 $borrower->{dateofbirth} = $new_datetime_ref->ymd();
1358 =head2 GetSortDetails (OUEST-PROVENCE)
1360 ($lib) = &GetSortDetails($category,$sortvalue);
1362 Returns the authorized value details
1363 C<&$lib>return value of authorized value details
1364 C<&$sortvalue>this is the value of authorized value
1365 C<&$category>this is the value of authorized value category
1369 sub GetSortDetails {
1370 my ( $category, $sortvalue ) = @_;
1371 my $dbh = C4::Context->dbh;
1372 my $query = qq|SELECT lib
1373 FROM authorised_values
1375 AND authorised_value=? |;
1376 my $sth = $dbh->prepare($query);
1377 $sth->execute( $category, $sortvalue );
1378 my $lib = $sth->fetchrow;
1379 return ($lib) if ($lib);
1380 return ($sortvalue) unless ($lib);
1383 =head2 MoveMemberToDeleted
1385 $result = &MoveMemberToDeleted($borrowernumber);
1387 Copy the record from borrowers to deletedborrowers table.
1388 The routine returns 1 for success, undef for failure.
1392 sub MoveMemberToDeleted {
1393 my ($member) = shift or return;
1395 my $schema = Koha::Database->new()->schema();
1396 my $borrowers_rs = $schema->resultset('Borrower');
1397 $borrowers_rs->result_class('DBIx::Class::ResultClass::HashRefInflator');
1398 my $borrower = $borrowers_rs->find($member);
1399 return unless $borrower;
1401 my $deleted = $schema->resultset('Deletedborrower')->create($borrower);
1403 return $deleted ? 1 : undef;
1408 DelMember($borrowernumber);
1410 This function remove directly a borrower whitout writing it on deleteborrower.
1411 + Deletes reserves for the borrower
1416 my $dbh = C4::Context->dbh;
1417 my $borrowernumber = shift;
1418 #warn "in delmember with $borrowernumber";
1419 return unless $borrowernumber; # borrowernumber is mandatory.
1420 # Delete Patron's holds
1421 my @holds = Koha::Holds->search({ borrowernumber => $borrowernumber });
1422 $_->delete for @holds;
1427 WHERE borrowernumber = ?
1429 my $sth = $dbh->prepare($query);
1430 $sth->execute($borrowernumber);
1431 logaction("MEMBERS", "DELETE", $borrowernumber, "") if C4::Context->preference("BorrowersLog");
1435 =head2 HandleDelBorrower
1437 HandleDelBorrower($borrower);
1439 When a member is deleted (DelMember in Members.pm), you should call me first.
1440 This routine deletes/moves lists and entries for the deleted member/borrower.
1441 Lists owned by the borrower are deleted, but entries from the borrower to
1442 other lists are kept.
1446 sub HandleDelBorrower {
1449 my $dbh = C4::Context->dbh;
1451 #Delete all lists and all shares of this borrower
1452 #Consistent with the approach Koha uses on deleting individual lists
1453 #Note that entries in virtualshelfcontents added by this borrower to
1454 #lists of others will be handled by a table constraint: the borrower
1455 #is set to NULL in those entries.
1456 $query="DELETE FROM virtualshelves WHERE owner=?";
1457 $dbh->do($query,undef,($borrower));
1460 #We could handle the above deletes via a constraint too.
1461 #But a new BZ report 11889 has been opened to discuss another approach.
1462 #Instead of deleting we could also disown lists (based on a pref).
1463 #In that way we could save shared and public lists.
1464 #The current table constraints support that idea now.
1465 #This pref should then govern the results of other routines/methods such as
1466 #Koha::Virtualshelf->new->delete too.
1469 =head2 ExtendMemberSubscriptionTo (OUEST-PROVENCE)
1471 $date = ExtendMemberSubscriptionTo($borrowerid, $date);
1473 Extending the subscription to a given date or to the expiry date calculated on ISO date.
1478 sub ExtendMemberSubscriptionTo {
1479 my ( $borrowerid,$date) = @_;
1480 my $dbh = C4::Context->dbh;
1481 my $borrower = GetMember('borrowernumber'=>$borrowerid);
1483 $date = (C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry') ?
1484 eval { output_pref( { dt => dt_from_string( $borrower->{'dateexpiry'} ), dateonly => 1, dateformat => 'iso' } ); }
1486 output_pref( { dt => dt_from_string, dateonly => 1, dateformat => 'iso' } );
1487 $date = Koha::Patron::Categories->find( $borrower->{categorycode} )->get_expiry_date( $date );
1489 my $sth = $dbh->do(<<EOF);
1491 SET dateexpiry='$date'
1492 WHERE borrowernumber='$borrowerid'
1495 AddEnrolmentFeeIfNeeded( $borrower->{categorycode}, $borrower->{borrowernumber} );
1497 logaction("MEMBERS", "RENEW", $borrower->{'borrowernumber'}, "Membership renewed")if C4::Context->preference("BorrowersLog");
1498 return $date if ($sth);
1502 =head2 GetHideLostItemsPreference
1504 $hidelostitemspref = &GetHideLostItemsPreference($borrowernumber);
1506 Returns the HideLostItems preference for the patron category of the supplied borrowernumber
1507 C<&$hidelostitemspref>return value of function, 0 or 1
1511 sub GetHideLostItemsPreference {
1512 my ($borrowernumber) = @_;
1513 my $dbh = C4::Context->dbh;
1514 my $query = "SELECT hidelostitems FROM borrowers,categories WHERE borrowers.categorycode = categories.categorycode AND borrowernumber = ?";
1515 my $sth = $dbh->prepare($query);
1516 $sth->execute($borrowernumber);
1517 my $hidelostitems = $sth->fetchrow;
1518 return $hidelostitems;
1521 =head2 GetBorrowersToExpunge
1523 $borrowers = &GetBorrowersToExpunge(
1524 not_borrowed_since => $not_borrowed_since,
1525 expired_before => $expired_before,
1526 category_code => $category_code,
1527 patron_list_id => $patron_list_id,
1528 branchcode => $branchcode
1531 This function get all borrowers based on the given criteria.
1535 sub GetBorrowersToExpunge {
1538 my $filterdate = $params->{'not_borrowed_since'};
1539 my $filterexpiry = $params->{'expired_before'};
1540 my $filtercategory = $params->{'category_code'};
1541 my $filterbranch = $params->{'branchcode'} ||
1542 ((C4::Context->preference('IndependentBranches')
1543 && C4::Context->userenv
1544 && !C4::Context->IsSuperLibrarian()
1545 && C4::Context->userenv->{branch})
1546 ? C4::Context->userenv->{branch}
1548 my $filterpatronlist = $params->{'patron_list_id'};
1550 my $dbh = C4::Context->dbh;
1552 SELECT borrowers.borrowernumber,
1553 MAX(old_issues.timestamp) AS latestissue,
1554 MAX(issues.timestamp) AS currentissue
1556 JOIN categories USING (categorycode)
1560 WHERE guarantorid IS NOT NULL
1561 AND guarantorid <> 0
1562 ) as tmp ON borrowers.borrowernumber=tmp.guarantorid
1563 LEFT JOIN old_issues USING (borrowernumber)
1564 LEFT JOIN issues USING (borrowernumber)|;
1565 if ( $filterpatronlist ){
1566 $query .= q| LEFT JOIN patron_list_patrons USING (borrowernumber)|;
1568 $query .= q| WHERE category_type <> 'S'
1569 AND tmp.guarantorid IS NULL
1572 if ( $filterbranch && $filterbranch ne "" ) {
1573 $query.= " AND borrowers.branchcode = ? ";
1574 push( @query_params, $filterbranch );
1576 if ( $filterexpiry ) {
1577 $query .= " AND dateexpiry < ? ";
1578 push( @query_params, $filterexpiry );
1580 if ( $filtercategory ) {
1581 $query .= " AND categorycode = ? ";
1582 push( @query_params, $filtercategory );
1584 if ( $filterpatronlist ){
1585 $query.=" AND patron_list_id = ? ";
1586 push( @query_params, $filterpatronlist );
1588 $query.=" GROUP BY borrowers.borrowernumber HAVING currentissue IS NULL ";
1589 if ( $filterdate ) {
1590 $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
1591 push @query_params,$filterdate;
1593 warn $query if $debug;
1595 my $sth = $dbh->prepare($query);
1596 if (scalar(@query_params)>0){
1597 $sth->execute(@query_params);
1604 while ( my $data = $sth->fetchrow_hashref ) {
1605 push @results, $data;
1610 =head2 GetBorrowersWhoHaveNeverBorrowed
1612 $results = &GetBorrowersWhoHaveNeverBorrowed
1614 This function get all borrowers who have never borrowed.
1616 I<$result> is a ref to an array which all elements are a hasref.
1620 sub GetBorrowersWhoHaveNeverBorrowed {
1621 my $filterbranch = shift ||
1622 ((C4::Context->preference('IndependentBranches')
1623 && C4::Context->userenv
1624 && !C4::Context->IsSuperLibrarian()
1625 && C4::Context->userenv->{branch})
1626 ? C4::Context->userenv->{branch}
1628 my $dbh = C4::Context->dbh;
1630 SELECT borrowers.borrowernumber,max(timestamp) as latestissue
1632 LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
1633 WHERE issues.borrowernumber IS NULL
1636 if ($filterbranch && $filterbranch ne ""){
1637 $query.=" AND borrowers.branchcode= ?";
1638 push @query_params,$filterbranch;
1640 warn $query if $debug;
1642 my $sth = $dbh->prepare($query);
1643 if (scalar(@query_params)>0){
1644 $sth->execute(@query_params);
1651 while ( my $data = $sth->fetchrow_hashref ) {
1652 push @results, $data;
1657 =head2 GetBorrowersWithIssuesHistoryOlderThan
1659 $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
1661 this function get all borrowers who has an issue history older than I<$date> given on input arg.
1663 I<$result> is a ref to an array which all elements are a hashref.
1664 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
1668 sub GetBorrowersWithIssuesHistoryOlderThan {
1669 my $dbh = C4::Context->dbh;
1670 my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
1671 my $filterbranch = shift ||
1672 ((C4::Context->preference('IndependentBranches')
1673 && C4::Context->userenv
1674 && !C4::Context->IsSuperLibrarian()
1675 && C4::Context->userenv->{branch})
1676 ? C4::Context->userenv->{branch}
1679 SELECT count(borrowernumber) as n,borrowernumber
1681 WHERE returndate < ?
1682 AND borrowernumber IS NOT NULL
1685 push @query_params, $date;
1687 $query.=" AND branchcode = ?";
1688 push @query_params, $filterbranch;
1690 $query.=" GROUP BY borrowernumber ";
1691 warn $query if $debug;
1692 my $sth = $dbh->prepare($query);
1693 $sth->execute(@query_params);
1696 while ( my $data = $sth->fetchrow_hashref ) {
1697 push @results, $data;
1704 IssueSlip($branchcode, $borrowernumber, $quickslip)
1706 Returns letter hash ( see C4::Letters::GetPreparedLetter )
1708 $quickslip is boolean, to indicate whether we want a quick slip
1710 IssueSlip populates ISSUESLIP and ISSUEQSLIP, and will make the following expansions:
1746 NOTE: Not all table fields are available, pleasee see GetPendingIssues for a list of available fields.
1751 my ($branch, $borrowernumber, $quickslip) = @_;
1753 # FIXME Check callers before removing this statement
1754 #return unless $borrowernumber;
1756 my @issues = @{ GetPendingIssues($borrowernumber) };
1758 for my $issue (@issues) {
1759 $issue->{date_due} = $issue->{date_due_sql};
1761 my $today = output_pref({ dt => dt_from_string, dateformat => 'iso', dateonly => 1 });
1762 if ( substr( $issue->{issuedate}, 0, 10 ) eq $today
1763 or substr( $issue->{lastreneweddate}, 0, 10 ) eq $today ) {
1769 # Sort on timestamp then on issuedate (useful for tests and could be if modified in a batch
1771 my $s = $b->{timestamp} <=> $a->{timestamp};
1773 $b->{issuedate} <=> $a->{issuedate} : $s;
1776 my ($letter_code, %repeat);
1778 $letter_code = 'ISSUEQSLIP';
1780 'checkedout' => [ map {
1783 'biblioitems' => $_,
1785 }, grep { $_->{'now'} } @issues ],
1789 $letter_code = 'ISSUESLIP';
1791 'checkedout' => [ map {
1794 'biblioitems' => $_,
1796 }, grep { !$_->{'overdue'} } @issues ],
1798 'overdue' => [ map {
1801 'biblioitems' => $_,
1803 }, grep { $_->{'overdue'} } @issues ],
1806 $_->{'timestamp'} = $_->{'newdate'};
1808 } @{ GetNewsToDisplay("slip",$branch) } ],
1812 return C4::Letters::GetPreparedLetter (
1813 module => 'circulation',
1814 letter_code => $letter_code,
1815 branchcode => $branch,
1817 'branches' => $branch,
1818 'borrowers' => $borrowernumber,
1824 =head2 GetBorrowersWithEmail
1826 ([$borrnum,$userid], ...) = GetBorrowersWithEmail('me@example.com');
1828 This gets a list of users and their basic details from their email address.
1829 As it's possible for multiple user to have the same email address, it provides
1830 you with all of them. If there is no userid for the user, there will be an
1831 C<undef> there. An empty list will be returned if there are no matches.
1835 sub GetBorrowersWithEmail {
1838 my $dbh = C4::Context->dbh;
1840 my $query = "SELECT borrowernumber, userid FROM borrowers WHERE email=?";
1841 my $sth=$dbh->prepare($query);
1842 $sth->execute($email);
1844 while (my $ref = $sth->fetch) {
1847 die "Failure searching for borrowers by email address: $sth->errstr" if $sth->err;
1851 =head2 AddMember_Opac
1855 sub AddMember_Opac {
1856 my ( %borrower ) = @_;
1858 $borrower{'categorycode'} //= C4::Context->preference('PatronSelfRegistrationDefaultCategory');
1859 if (not defined $borrower{'password'}){
1860 my $sr = new String::Random;
1861 $sr->{'A'} = [ 'A'..'Z', 'a'..'z' ];
1862 my $password = $sr->randpattern("AAAAAAAAAA");
1863 $borrower{'password'} = $password;
1866 $borrower{'cardnumber'} = fixup_cardnumber( $borrower{'cardnumber'} );
1868 my $borrowernumber = AddMember(%borrower);
1870 return ( $borrowernumber, $borrower{'password'} );
1873 =head2 AddEnrolmentFeeIfNeeded
1875 AddEnrolmentFeeIfNeeded( $borrower->{categorycode}, $borrower->{borrowernumber} );
1877 Add enrolment fee for a patron if needed.
1881 sub AddEnrolmentFeeIfNeeded {
1882 my ( $categorycode, $borrowernumber ) = @_;
1883 # check for enrollment fee & add it if needed
1884 my $dbh = C4::Context->dbh;
1885 my $sth = $dbh->prepare(q{
1888 WHERE categorycode=?
1890 $sth->execute( $categorycode );
1892 warn sprintf('Database returned the following error: %s', $sth->errstr);
1895 my ($enrolmentfee) = $sth->fetchrow;
1896 if ($enrolmentfee && $enrolmentfee > 0) {
1897 # insert fee in patron debts
1898 C4::Accounts::manualinvoice( $borrowernumber, '', '', 'A', $enrolmentfee );
1907 my ( $borrowernumber ) = @_;
1909 my $sql = "SELECT COUNT(*) FROM issues WHERE date_due < NOW() AND borrowernumber = ?";
1910 my $sth = C4::Context->dbh->prepare( $sql );
1911 $sth->execute( $borrowernumber );
1912 my ( $count ) = $sth->fetchrow_array();
1917 =head2 DeleteExpiredOpacRegistrations
1919 Delete accounts that haven't been upgraded from the 'temporary' category
1920 Returns the number of removed patrons
1924 sub DeleteExpiredOpacRegistrations {
1926 my $delay = C4::Context->preference('PatronSelfRegistrationExpireTemporaryAccountsDelay');
1927 my $category_code = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
1929 return 0 if not $category_code or not defined $delay or $delay eq q||;
1932 SELECT borrowernumber
1934 WHERE categorycode = ? AND DATEDIFF( NOW(), dateenrolled ) > ? |;
1936 my $dbh = C4::Context->dbh;
1937 my $sth = $dbh->prepare($query);
1938 $sth->execute( $category_code, $delay );
1940 while ( my ($borrowernumber) = $sth->fetchrow_array() ) {
1941 DelMember($borrowernumber);
1947 =head2 DeleteUnverifiedOpacRegistrations
1949 Delete all unverified self registrations in borrower_modifications,
1950 older than the specified number of days.
1954 sub DeleteUnverifiedOpacRegistrations {
1956 my $dbh = C4::Context->dbh;
1958 DELETE FROM borrower_modifications
1959 WHERE borrowernumber = 0 AND DATEDIFF( NOW(), timestamp ) > ?|;
1960 my $cnt=$dbh->do($sql, undef, ($days) );
1961 return $cnt eq '0E0'? 0: $cnt;
1964 sub GetOverduesForPatron {
1965 my ( $borrowernumber ) = @_;
1969 FROM issues, items, biblio, biblioitems
1970 WHERE items.itemnumber=issues.itemnumber
1971 AND biblio.biblionumber = items.biblionumber
1972 AND biblio.biblionumber = biblioitems.biblionumber
1973 AND issues.borrowernumber = ?
1974 AND date_due < NOW()
1977 my $sth = C4::Context->dbh->prepare( $sql );
1978 $sth->execute( $borrowernumber );
1980 return $sth->fetchall_arrayref({});
1983 END { } # module clean-up code here (global destructor)