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
128 C4::Members - Perl Module containing convenience functions for member handling
136 This module contains routines for adding, modifying and deleting members/patrons/borrowers
140 =head2 GetMemberDetails
142 ($borrower) = &GetMemberDetails($borrowernumber, $cardnumber);
144 Looks up a patron and returns information about him or her. If
145 C<$borrowernumber> is true (nonzero), C<&GetMemberDetails> looks
146 up the borrower by number; otherwise, it looks up the borrower by card
149 C<$borrower> is a reference-to-hash whose keys are the fields of the
150 borrowers table in the Koha database. In addition,
151 C<$borrower-E<gt>{flags}> is a hash giving more detailed information
152 about the patron. Its keys act as flags :
154 if $borrower->{flags}->{LOST} {
155 # Patron's card was reported lost
158 If the state of a flag means that the patron should not be
159 allowed to borrow any more books, then it will have a C<noissues> key
162 See patronflags for more details.
164 C<$borrower-E<gt>{authflags}> is a hash giving more detailed information
165 about the top-level permissions flags set for the borrower. For example,
166 if a user has the "editcatalogue" permission,
167 C<$borrower-E<gt>{authflags}-E<gt>{editcatalogue}> will exist and have
172 sub GetMemberDetails {
173 my ( $borrowernumber, $cardnumber ) = @_;
174 my $dbh = C4::Context->dbh;
177 if ($borrowernumber) {
178 $sth = $dbh->prepare("
181 categories.description,
182 categories.BlockExpiredPatronOpacActions,
186 LEFT JOIN categories ON borrowers.categorycode=categories.categorycode
187 WHERE borrowernumber = ?
189 $sth->execute($borrowernumber);
191 elsif ($cardnumber) {
192 $sth = $dbh->prepare("
195 categories.description,
196 categories.BlockExpiredPatronOpacActions,
200 LEFT JOIN categories ON borrowers.categorycode = categories.categorycode
203 $sth->execute($cardnumber);
208 my $borrower = $sth->fetchrow_hashref;
209 return unless $borrower;
210 my ($amount) = GetMemberAccountRecords($borrower->{borrowernumber});
211 $borrower->{'amountoutstanding'} = $amount;
212 # FIXME - patronflags calls GetMemberAccountRecords... just have patronflags return $amount
213 my $flags = patronflags( $borrower);
216 $sth = $dbh->prepare("select bit,flag from userflags");
218 while ( my ( $bit, $flag ) = $sth->fetchrow ) {
219 if ( $borrower->{'flags'} && $borrower->{'flags'} & 2**$bit ) {
220 $accessflagshash->{$flag} = 1;
223 $borrower->{'flags'} = $flags;
224 $borrower->{'authflags'} = $accessflagshash;
226 # Handle setting the true behavior for BlockExpiredPatronOpacActions
227 $borrower->{'BlockExpiredPatronOpacActions'} =
228 C4::Context->preference('BlockExpiredPatronOpacActions')
229 if ( $borrower->{'BlockExpiredPatronOpacActions'} == -1 );
231 $borrower->{'is_expired'} = 0;
232 $borrower->{'is_expired'} = 1 if
233 defined($borrower->{dateexpiry}) &&
234 $borrower->{'dateexpiry'} ne '0000-00-00' &&
235 Date_to_Days( Today() ) >
236 Date_to_Days( split /-/, $borrower->{'dateexpiry'} );
238 return ($borrower); #, $flags, $accessflagshash);
243 $flags = &patronflags($patron);
245 This function is not exported.
247 The following will be set where applicable:
248 $flags->{CHARGES}->{amount} Amount of debt
249 $flags->{CHARGES}->{noissues} Set if debt amount >$5.00 (or syspref noissuescharge)
250 $flags->{CHARGES}->{message} Message -- deprecated
252 $flags->{CREDITS}->{amount} Amount of credit
253 $flags->{CREDITS}->{message} Message -- deprecated
255 $flags->{ GNA } Patron has no valid address
256 $flags->{ GNA }->{noissues} Set for each GNA
257 $flags->{ GNA }->{message} "Borrower has no valid address" -- deprecated
259 $flags->{ LOST } Patron's card reported lost
260 $flags->{ LOST }->{noissues} Set for each LOST
261 $flags->{ LOST }->{message} Message -- deprecated
263 $flags->{DBARRED} Set if patron debarred, no access
264 $flags->{DBARRED}->{noissues} Set for each DBARRED
265 $flags->{DBARRED}->{message} Message -- deprecated
268 $flags->{ NOTES }->{message} The note itself. NOT deprecated
270 $flags->{ ODUES } Set if patron has overdue books.
271 $flags->{ ODUES }->{message} "Yes" -- deprecated
272 $flags->{ ODUES }->{itemlist} ref-to-array: list of overdue books
273 $flags->{ ODUES }->{itemlisttext} Text list of overdue items -- deprecated
275 $flags->{WAITING} Set if any of patron's reserves are available
276 $flags->{WAITING}->{message} Message -- deprecated
277 $flags->{WAITING}->{itemlist} ref-to-array: list of available items
281 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
282 overdue items. Its elements are references-to-hash, each describing an
283 overdue item. The keys are selected fields from the issues, biblio,
284 biblioitems, and items tables of the Koha database.
286 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
287 the overdue items, one per line. Deprecated.
289 =item C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
290 available items. Each element is a reference-to-hash whose keys are
291 fields from the reserves table of the Koha database.
295 All the "message" fields that include language generated in this function are deprecated,
296 because such strings belong properly in the display layer.
298 The "message" field that comes from the DB is OK.
302 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
303 # FIXME rename this function.
306 my ( $patroninformation) = @_;
307 my $dbh=C4::Context->dbh;
308 my ($balance, $owing) = GetMemberAccountBalance( $patroninformation->{'borrowernumber'});
311 my $noissuescharge = C4::Context->preference("noissuescharge") || 5;
312 $flaginfo{'message'} = sprintf 'Patron owes %.02f', $owing;
313 $flaginfo{'amount'} = sprintf "%.02f", $owing;
314 if ( $owing > $noissuescharge && !C4::Context->preference("AllowFineOverride") ) {
315 $flaginfo{'noissues'} = 1;
317 $flags{'CHARGES'} = \%flaginfo;
319 elsif ( $balance < 0 ) {
321 $flaginfo{'message'} = sprintf 'Patron has credit of %.02f', -$balance;
322 $flaginfo{'amount'} = sprintf "%.02f", $balance;
323 $flags{'CREDITS'} = \%flaginfo;
326 # Check the debt of the guarntees of this patron
327 my $no_issues_charge_guarantees = C4::Context->preference("NoIssuesChargeGuarantees");
328 $no_issues_charge_guarantees = undef unless looks_like_number( $no_issues_charge_guarantees );
329 if ( defined $no_issues_charge_guarantees ) {
330 my $p = Koha::Patrons->find( $patroninformation->{borrowernumber} );
331 my @guarantees = $p->guarantees();
332 my $guarantees_non_issues_charges;
333 foreach my $g ( @guarantees ) {
334 my ( $b, $n, $o ) = C4::Members::GetMemberAccountBalance( $g->id );
335 $guarantees_non_issues_charges += $n;
338 if ( $guarantees_non_issues_charges > $no_issues_charge_guarantees ) {
340 $flaginfo{'message'} = sprintf 'patron guarantees owe %.02f', $guarantees_non_issues_charges;
341 $flaginfo{'amount'} = $guarantees_non_issues_charges;
342 $flaginfo{'noissues'} = 1 unless C4::Context->preference("allowfineoverride");
343 $flags{'CHARGES_GUARANTEES'} = \%flaginfo;
347 if ( $patroninformation->{'gonenoaddress'}
348 && $patroninformation->{'gonenoaddress'} == 1 )
351 $flaginfo{'message'} = 'Borrower has no valid address.';
352 $flaginfo{'noissues'} = 1;
353 $flags{'GNA'} = \%flaginfo;
355 if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
357 $flaginfo{'message'} = 'Borrower\'s card reported lost.';
358 $flaginfo{'noissues'} = 1;
359 $flags{'LOST'} = \%flaginfo;
361 if ( $patroninformation->{'debarred'} && check_date( split( /-/, $patroninformation->{'debarred'} ) ) ) {
362 if ( Date_to_Days(Date::Calc::Today) < Date_to_Days( split( /-/, $patroninformation->{'debarred'} ) ) ) {
364 $flaginfo{'debarredcomment'} = $patroninformation->{'debarredcomment'};
365 $flaginfo{'message'} = $patroninformation->{'debarredcomment'};
366 $flaginfo{'noissues'} = 1;
367 $flaginfo{'dateend'} = $patroninformation->{'debarred'};
368 $flags{'DBARRED'} = \%flaginfo;
371 if ( $patroninformation->{'borrowernotes'}
372 && $patroninformation->{'borrowernotes'} )
375 $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
376 $flags{'NOTES'} = \%flaginfo;
378 my ( $odues, $itemsoverdue ) = C4::Overdues::checkoverdues($patroninformation->{'borrowernumber'});
379 if ( $odues && $odues > 0 ) {
381 $flaginfo{'message'} = "Yes";
382 $flaginfo{'itemlist'} = $itemsoverdue;
383 foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
386 $flaginfo{'itemlisttext'} .=
387 "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n"; # newline is display layer
389 $flags{'ODUES'} = \%flaginfo;
391 my @itemswaiting = C4::Reserves::GetReservesFromBorrowernumber( $patroninformation->{'borrowernumber'},'W' );
392 my $nowaiting = scalar @itemswaiting;
393 if ( $nowaiting > 0 ) {
395 $flaginfo{'message'} = "Reserved items available";
396 $flaginfo{'itemlist'} = \@itemswaiting;
397 $flags{'WAITING'} = \%flaginfo;
405 $borrower = &GetMember(%information);
407 Retrieve the first patron record meeting on criteria listed in the
408 C<%information> hash, which should contain one or more
409 pairs of borrowers column names and values, e.g.,
411 $borrower = GetMember(borrowernumber => id);
413 C<&GetBorrower> returns a reference-to-hash whose keys are the fields of
414 the C<borrowers> table in the Koha database.
416 FIXME: GetMember() is used throughout the code as a lookup
417 on a unique key such as the borrowernumber, but this meaning is not
418 enforced in the routine itself.
424 my ( %information ) = @_;
425 if (exists $information{borrowernumber} && !defined $information{borrowernumber}) {
426 #passing mysql's kohaadmin?? Makes no sense as a query
429 my $dbh = C4::Context->dbh;
431 q{SELECT borrowers.*, categories.category_type, categories.description
433 LEFT JOIN categories on borrowers.categorycode=categories.categorycode WHERE };
436 for (keys %information ) {
444 if (defined $information{$_}) {
446 push @values, $information{$_};
449 $select .= "$_ IS NULL";
452 $debug && warn $select, " ",values %information;
453 my $sth = $dbh->prepare("$select");
454 $sth->execute(@values);
455 my $data = $sth->fetchall_arrayref({});
456 #FIXME interface to this routine now allows generation of a result set
457 #so whole array should be returned but bowhere in the current code expects this
465 =head2 IsMemberBlocked
467 my ($block_status, $count) = IsMemberBlocked( $borrowernumber );
469 Returns whether a patron is restricted or has overdue items that may result
470 in a block of circulation privileges.
472 C<$block_status> can have the following values:
474 1 if the patron is currently restricted, in which case
475 C<$count> is the expiration date (9999-12-31 for indefinite)
477 -1 if the patron has overdue items, in which case C<$count> is the number of them
479 0 if the patron has no overdue items or outstanding fine days, in which case C<$count> is 0
481 Existing active restrictions are checked before current overdue items.
485 sub IsMemberBlocked {
486 my $borrowernumber = shift;
487 my $dbh = C4::Context->dbh;
489 my $blockeddate = Koha::Patrons->find( $borrowernumber )->is_debarred;
491 return ( 1, $blockeddate ) if $blockeddate;
493 # if he have late issues
494 my $sth = $dbh->prepare(
495 "SELECT COUNT(*) as latedocs
497 WHERE borrowernumber = ?
498 AND date_due < now()"
500 $sth->execute($borrowernumber);
501 my $latedocs = $sth->fetchrow_hashref->{'latedocs'};
503 return ( -1, $latedocs ) if $latedocs > 0;
508 =head2 GetMemberIssuesAndFines
510 ($overdue_count, $issue_count, $total_fines) = &GetMemberIssuesAndFines($borrowernumber);
512 Returns aggregate data about items borrowed by the patron with the
513 given borrowernumber.
515 C<&GetMemberIssuesAndFines> returns a three-element array. C<$overdue_count> is the
516 number of overdue items the patron currently has borrowed. C<$issue_count> is the
517 number of books the patron currently has borrowed. C<$total_fines> is
518 the total fine currently due by the borrower.
523 sub GetMemberIssuesAndFines {
524 my ( $borrowernumber ) = @_;
525 my $dbh = C4::Context->dbh;
526 my $query = "SELECT COUNT(*) FROM issues WHERE borrowernumber = ?";
528 $debug and warn $query."\n";
529 my $sth = $dbh->prepare($query);
530 $sth->execute($borrowernumber);
531 my $issue_count = $sth->fetchrow_arrayref->[0];
533 $sth = $dbh->prepare(
534 "SELECT COUNT(*) FROM issues
535 WHERE borrowernumber = ?
536 AND date_due < now()"
538 $sth->execute($borrowernumber);
539 my $overdue_count = $sth->fetchrow_arrayref->[0];
541 $sth = $dbh->prepare("SELECT SUM(amountoutstanding) FROM accountlines WHERE borrowernumber = ?");
542 $sth->execute($borrowernumber);
543 my $total_fines = $sth->fetchrow_arrayref->[0];
545 return ($overdue_count, $issue_count, $total_fines);
551 my $success = ModMember(borrowernumber => $borrowernumber,
552 [ field => value ]... );
554 Modify borrower's data. All date fields should ALREADY be in ISO format.
557 true on success, or false on failure
563 # test to know if you must update or not the borrower password
564 if (exists $data{password}) {
565 if ($data{password} eq '****' or $data{password} eq '') {
566 delete $data{password};
568 if ( C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
569 # Update the hashed PIN in borrower_sync.hashed_pin, before Koha hashes it
570 Koha::NorwegianPatronDB::NLUpdateHashedPIN( $data{'borrowernumber'}, $data{password} );
572 $data{password} = hash_password($data{password});
576 my $old_categorycode = GetBorrowerCategorycode( $data{borrowernumber} );
578 # get only the columns of a borrower
579 my $schema = Koha::Database->new()->schema;
580 my @columns = $schema->source('Borrower')->columns;
581 my $new_borrower = { map { join(' ', @columns) =~ /$_/ ? ( $_ => $data{$_} ) : () } keys(%data) };
582 delete $new_borrower->{flags};
584 $new_borrower->{dateofbirth} ||= undef if exists $new_borrower->{dateofbirth};
585 $new_borrower->{dateenrolled} ||= undef if exists $new_borrower->{dateenrolled};
586 $new_borrower->{dateexpiry} ||= undef if exists $new_borrower->{dateexpiry};
587 $new_borrower->{debarred} ||= undef if exists $new_borrower->{debarred};
588 $new_borrower->{sms_provider_id} ||= undef if exists $new_borrower->{sms_provider_id};
590 my $rs = $schema->resultset('Borrower')->search({
591 borrowernumber => $new_borrower->{borrowernumber},
594 delete $new_borrower->{userid} if exists $new_borrower->{userid} and not $new_borrower->{userid};
596 my $execute_success = $rs->update($new_borrower);
597 if ($execute_success ne '0E0') { # only proceed if the update was a success
598 # If the patron changes to a category with enrollment fee, we add a fee
599 if ( $data{categorycode} and $data{categorycode} ne $old_categorycode ) {
600 if ( C4::Context->preference('FeeOnChangePatronCategory') ) {
601 AddEnrolmentFeeIfNeeded( $data{categorycode}, $data{borrowernumber} );
605 # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
606 # cronjob will use for syncing with NL
607 if ( C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
608 my $borrowersync = Koha::Database->new->schema->resultset('BorrowerSync')->find({
609 'synctype' => 'norwegianpatrondb',
610 'borrowernumber' => $data{'borrowernumber'}
612 # Do not set to "edited" if syncstatus is "new". We need to sync as new before
613 # we can sync as changed. And the "new sync" will pick up all changes since
614 # the patron was created anyway.
615 if ( $borrowersync->syncstatus ne 'new' && $borrowersync->syncstatus ne 'delete' ) {
616 $borrowersync->update( { 'syncstatus' => 'edited' } );
618 # Set the value of 'sync'
619 $borrowersync->update( { 'sync' => $data{'sync'} } );
620 # Try to do the live sync
621 Koha::NorwegianPatronDB::NLSync({ 'borrowernumber' => $data{'borrowernumber'} });
624 logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "UPDATE (executed w/ arg: $data{'borrowernumber'})") if C4::Context->preference("BorrowersLog");
626 return $execute_success;
631 $borrowernumber = &AddMember(%borrower);
633 insert new borrower into table
635 (%borrower keys are database columns. Database columns could be
636 different in different versions. Please look into database for correct
639 Returns the borrowernumber upon success
641 Returns as undef upon any db error without further processing
648 my $dbh = C4::Context->dbh;
649 my $schema = Koha::Database->new()->schema;
651 # generate a proper login if none provided
652 $data{'userid'} = Generate_Userid( $data{'borrowernumber'}, $data{'firstname'}, $data{'surname'} )
653 if ( $data{'userid'} eq '' || !Check_Userid( $data{'userid'} ) );
655 # add expiration date if it isn't already there
656 $data{dateexpiry} ||= Koha::Patron::Categories->find( $data{categorycode} )->get_expiry_date;
658 # add enrollment date if it isn't already there
659 unless ( $data{'dateenrolled'} ) {
660 $data{'dateenrolled'} = output_pref( { dt => dt_from_string, dateonly => 1, dateformat => 'iso' } );
663 my $patron_category = $schema->resultset('Category')->find( $data{'categorycode'} );
665 $patron_category->default_privacy() eq 'default' ? 1
666 : $patron_category->default_privacy() eq 'never' ? 2
667 : $patron_category->default_privacy() eq 'forever' ? 0
670 $data{'privacy_guarantor_checkouts'} = 0 unless defined( $data{'privacy_guarantor_checkouts'} );
672 # Make a copy of the plain text password for later use
673 my $plain_text_password = $data{'password'};
675 # create a disabled account if no password provided
676 $data{'password'} = ($data{'password'})? hash_password($data{'password'}) : '!';
678 # we don't want invalid dates in the db (mysql has a bad habit of inserting 0000-00-00
679 $data{'dateofbirth'} = undef if ( not $data{'dateofbirth'} );
680 $data{'debarred'} = undef if ( not $data{'debarred'} );
681 $data{'sms_provider_id'} = undef if ( not $data{'sms_provider_id'} );
683 # get only the columns of Borrower
684 my @columns = $schema->source('Borrower')->columns;
685 my $new_member = { map { join(' ',@columns) =~ /$_/ ? ( $_ => $data{$_} ) : () } keys(%data) } ;
686 $new_member->{checkprevcheckout} ||= 'inherit';
687 delete $new_member->{borrowernumber};
689 my $rs = $schema->resultset('Borrower');
690 $data{borrowernumber} = $rs->create($new_member)->id;
692 # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
693 # cronjob will use for syncing with NL
694 if ( exists $data{'borrowernumber'} && C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
695 Koha::Database->new->schema->resultset('BorrowerSync')->create({
696 'borrowernumber' => $data{'borrowernumber'},
697 'synctype' => 'norwegianpatrondb',
699 'syncstatus' => 'new',
700 'hashed_pin' => Koha::NorwegianPatronDB::NLEncryptPIN( $plain_text_password ),
704 # mysql_insertid is probably bad. not necessarily accurate and mysql-specific at best.
705 logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
707 AddEnrolmentFeeIfNeeded( $data{categorycode}, $data{borrowernumber} );
709 return $data{borrowernumber};
714 my $uniqueness = Check_Userid($userid,$borrowernumber);
716 $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 != '').
718 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.
721 0 for not unique (i.e. this $userid already exists)
722 1 for unique (i.e. this $userid does not exist, or this $userid/$borrowernumber combination already exists)
727 my ( $uid, $borrowernumber ) = @_;
729 return 0 unless ($uid); # userid is a unique column, we should assume NULL is not unique
731 return 0 if ( $uid eq C4::Context->config('user') );
733 my $rs = Koha::Database->new()->schema()->resultset('Borrower');
736 $params->{userid} = $uid;
737 $params->{borrowernumber} = { '!=' => $borrowernumber } if ($borrowernumber);
739 my $count = $rs->count( $params );
741 return $count ? 0 : 1;
744 =head2 Generate_Userid
746 my $newuid = Generate_Userid($borrowernumber, $firstname, $surname);
748 Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
750 $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.
753 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).
757 sub Generate_Userid {
758 my ($borrowernumber, $firstname, $surname) = @_;
761 #The script will "do" the following code and increment the $offset until Check_Userid = 1 (i.e. until $newuid comes back as unique)
763 $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
764 $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
765 $newuid = lc(($firstname)? "$firstname.$surname" : $surname);
766 $newuid = unac_string('utf-8',$newuid);
767 $newuid .= $offset unless $offset == 0;
770 } while (!Check_Userid($newuid,$borrowernumber));
775 =head2 fixup_cardnumber
777 Warning: The caller is responsible for locking the members table in write
778 mode, to avoid database corruption.
782 use vars qw( @weightings );
783 my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
785 sub fixup_cardnumber {
786 my ($cardnumber) = @_;
787 my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;
789 # Find out whether member numbers should be generated
790 # automatically. Should be either "1" or something else.
791 # Defaults to "0", which is interpreted as "no".
793 # if ($cardnumber !~ /\S/ && $autonumber_members) {
794 ($autonumber_members) or return $cardnumber;
795 my $checkdigit = C4::Context->preference('checkdigit');
796 my $dbh = C4::Context->dbh;
797 if ( $checkdigit and $checkdigit eq 'katipo' ) {
799 # if checkdigit is selected, calculate katipo-style cardnumber.
800 # otherwise, just use the max()
801 # purpose: generate checksum'd member numbers.
802 # We'll assume we just got the max value of digits 2-8 of member #'s
803 # from the database and our job is to increment that by one,
804 # determine the 1st and 9th digits and return the full string.
805 my $sth = $dbh->prepare(
806 "select max(substring(borrowers.cardnumber,2,7)) as new_num from borrowers"
809 my $data = $sth->fetchrow_hashref;
810 $cardnumber = $data->{new_num};
811 if ( !$cardnumber ) { # If DB has no values,
812 $cardnumber = 1000000; # start at 1000000
818 for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
819 # read weightings, left to right, 1 char at a time
820 my $temp1 = $weightings[$i];
822 # sequence left to right, 1 char at a time
823 my $temp2 = substr( $cardnumber, $i, 1 );
825 # mult each char 1-7 by its corresponding weighting
826 $sum += $temp1 * $temp2;
829 my $rem = ( $sum % 11 );
830 $rem = 'X' if $rem == 10;
832 return "V$cardnumber$rem";
835 my $sth = $dbh->prepare(
836 'SELECT MAX( CAST( cardnumber AS SIGNED ) ) FROM borrowers WHERE cardnumber REGEXP "^-?[0-9]+$"'
839 my ($result) = $sth->fetchrow;
842 return $cardnumber; # just here as a fallback/reminder
845 =head2 GetPendingIssues
847 my $issues = &GetPendingIssues(@borrowernumber);
849 Looks up what the patron with the given borrowernumber has borrowed.
851 C<&GetPendingIssues> returns a
852 reference-to-array where each element is a reference-to-hash; the
853 keys are the fields from the C<issues>, C<biblio>, and C<items> tables.
854 The keys include C<biblioitems> fields except marc and marcxml.
858 sub GetPendingIssues {
859 my @borrowernumbers = @_;
861 unless (@borrowernumbers ) { # return a ref_to_array
862 return \@borrowernumbers; # to not cause surprise to caller
865 # Borrowers part of the query
867 for (my $i = 0; $i < @borrowernumbers; $i++) {
868 $bquery .= ' issues.borrowernumber = ?';
869 if ($i < $#borrowernumbers ) {
874 # must avoid biblioitems.* to prevent large marc and marcxml fields from killing performance
875 # FIXME: namespace collision: each table has "timestamp" fields. Which one is "timestamp" ?
876 # FIXME: circ/ciculation.pl tries to sort by timestamp!
877 # FIXME: namespace collision: other collisions possible.
878 # FIXME: most of this data isn't really being used by callers.
885 biblioitems.itemtype,
888 biblioitems.publicationyear,
889 biblioitems.publishercode,
890 biblioitems.volumedate,
891 biblioitems.volumedesc,
896 borrowers.cardnumber,
897 issues.timestamp AS timestamp,
898 issues.renewals AS renewals,
899 issues.borrowernumber AS borrowernumber,
900 items.renewals AS totalrenewals
902 LEFT JOIN items ON items.itemnumber = issues.itemnumber
903 LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
904 LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
905 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
908 ORDER BY issues.issuedate"
911 my $sth = C4::Context->dbh->prepare($query);
912 $sth->execute(@borrowernumbers);
913 my $data = $sth->fetchall_arrayref({});
914 my $today = dt_from_string;
916 if ($_->{issuedate}) {
917 $_->{issuedate} = dt_from_string($_->{issuedate}, 'sql');
919 $_->{date_due_sql} = $_->{date_due};
920 # FIXME no need to have this value
921 $_->{date_due} or next;
922 $_->{date_due_sql} = $_->{date_due};
923 # FIXME no need to have this value
924 $_->{date_due} = dt_from_string($_->{date_due}, 'sql');
925 if ( DateTime->compare($_->{date_due}, $today) == -1 ) {
934 $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
936 Looks up what the patron with the given borrowernumber has borrowed,
937 and sorts the results.
939 C<$sortkey> is the name of a field on which to sort the results. This
940 should be the name of a field in the C<issues>, C<biblio>,
941 C<biblioitems>, or C<items> table in the Koha database.
943 C<$limit> is the maximum number of results to return.
945 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
946 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
947 C<items> tables of the Koha database.
953 my ( $borrowernumber, $order, $limit ) = @_;
955 return unless $borrowernumber;
956 $order = 'date_due desc' unless $order;
958 my $dbh = C4::Context->dbh;
960 'SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
962 LEFT JOIN items on items.itemnumber=issues.itemnumber
963 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
964 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
965 WHERE borrowernumber=?
967 SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
969 LEFT JOIN items on items.itemnumber=old_issues.itemnumber
970 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
971 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
972 WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL
975 $query .= " limit $limit";
978 my $sth = $dbh->prepare($query);
979 $sth->execute( $borrowernumber, $borrowernumber );
980 return $sth->fetchall_arrayref( {} );
984 =head2 GetMemberAccountRecords
986 ($total, $acctlines, $count) = &GetMemberAccountRecords($borrowernumber);
988 Looks up accounting data for the patron with the given borrowernumber.
990 C<&GetMemberAccountRecords> returns a three-element array. C<$acctlines> is a
991 reference-to-array, where each element is a reference-to-hash; the
992 keys are the fields of the C<accountlines> table in the Koha database.
993 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
994 total amount outstanding for all of the account lines.
998 sub GetMemberAccountRecords {
999 my ($borrowernumber) = @_;
1000 my $dbh = C4::Context->dbh;
1006 WHERE borrowernumber=?);
1007 $strsth.=" ORDER BY accountlines_id desc";
1008 my $sth= $dbh->prepare( $strsth );
1009 $sth->execute( $borrowernumber );
1012 while ( my $data = $sth->fetchrow_hashref ) {
1013 if ( $data->{itemnumber} ) {
1014 my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
1015 $data->{biblionumber} = $biblio->{biblionumber};
1016 $data->{title} = $biblio->{title};
1018 $acctlines[$numlines] = $data;
1020 $total += sprintf "%.0f", 1000*$data->{amountoutstanding}; # convert float to integer to avoid round-off errors
1023 return ( $total, \@acctlines,$numlines);
1026 =head2 GetMemberAccountBalance
1028 ($total_balance, $non_issue_balance, $other_charges) = &GetMemberAccountBalance($borrowernumber);
1030 Calculates amount immediately owing by the patron - non-issue charges.
1031 Based on GetMemberAccountRecords.
1032 Charges exempt from non-issue are:
1034 * Rent (rental) if RentalsInNoissuesCharge syspref is set to false
1035 * Manual invoices if ManInvInNoissuesCharge syspref is set to false
1039 sub GetMemberAccountBalance {
1040 my ($borrowernumber) = @_;
1042 my $ACCOUNT_TYPE_LENGTH = 5; # this is plain ridiculous...
1045 push @not_fines, 'Res' unless C4::Context->preference('HoldsInNoissuesCharge');
1046 push @not_fines, 'Rent' unless C4::Context->preference('RentalsInNoissuesCharge');
1047 unless ( C4::Context->preference('ManInvInNoissuesCharge') ) {
1048 my $dbh = C4::Context->dbh;
1049 my $man_inv_types = $dbh->selectcol_arrayref(qq{SELECT authorised_value FROM authorised_values WHERE category = 'MANUAL_INV'});
1050 push @not_fines, map substr($_, 0, $ACCOUNT_TYPE_LENGTH), @$man_inv_types;
1052 my %not_fine = map {$_ => 1} @not_fines;
1054 my ($total, $acctlines) = GetMemberAccountRecords($borrowernumber);
1055 my $other_charges = 0;
1056 foreach (@$acctlines) {
1057 $other_charges += $_->{amountoutstanding} if $not_fine{ substr($_->{accounttype}, 0, $ACCOUNT_TYPE_LENGTH) };
1060 return ( $total, $total - $other_charges, $other_charges);
1063 =head2 GetBorNotifyAcctRecord
1065 ($total, $acctlines, $count) = &GetBorNotifyAcctRecord($params,$notifyid);
1067 Looks up accounting data for the patron with the given borrowernumber per file number.
1069 C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a
1070 reference-to-array, where each element is a reference-to-hash; the
1071 keys are the fields of the C<accountlines> table in the Koha database.
1072 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1073 total amount outstanding for all of the account lines.
1077 sub GetBorNotifyAcctRecord {
1078 my ( $borrowernumber, $notifyid ) = @_;
1079 my $dbh = C4::Context->dbh;
1082 my $sth = $dbh->prepare(
1085 WHERE borrowernumber=?
1087 AND amountoutstanding != '0'
1088 ORDER BY notify_id,accounttype
1091 $sth->execute( $borrowernumber, $notifyid );
1093 while ( my $data = $sth->fetchrow_hashref ) {
1094 if ( $data->{itemnumber} ) {
1095 my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
1096 $data->{biblionumber} = $biblio->{biblionumber};
1097 $data->{title} = $biblio->{title};
1099 $acctlines[$numlines] = $data;
1101 $total += int(100 * $data->{'amountoutstanding'});
1104 return ( $total, \@acctlines, $numlines );
1107 sub checkcardnumber {
1108 my ( $cardnumber, $borrowernumber ) = @_;
1110 # If cardnumber is null, we assume they're allowed.
1111 return 0 unless defined $cardnumber;
1113 my $dbh = C4::Context->dbh;
1114 my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
1115 $query .= " AND borrowernumber <> ?" if ($borrowernumber);
1116 my $sth = $dbh->prepare($query);
1119 ( $borrowernumber ? $borrowernumber : () )
1122 return 1 if $sth->fetchrow_hashref;
1124 my ( $min_length, $max_length ) = get_cardnumber_length();
1126 if length $cardnumber > $max_length
1127 or length $cardnumber < $min_length;
1132 =head2 get_cardnumber_length
1134 my ($min, $max) = C4::Members::get_cardnumber_length()
1136 Returns the minimum and maximum length for patron cardnumbers as
1137 determined by the CardnumberLength system preference, the
1138 BorrowerMandatoryField system preference, and the width of the
1143 sub get_cardnumber_length {
1144 my ( $min, $max ) = ( 0, 16 ); # borrowers.cardnumber is a nullable varchar(16)
1145 $min = 1 if C4::Context->preference('BorrowerMandatoryField') =~ /cardnumber/;
1146 if ( my $cardnumber_length = C4::Context->preference('CardnumberLength') ) {
1147 # Is integer and length match
1148 if ( $cardnumber_length =~ m|^\d+$| ) {
1149 $min = $max = $cardnumber_length
1150 if $cardnumber_length >= $min
1151 and $cardnumber_length <= $max;
1153 # Else assuming it is a range
1154 elsif ( $cardnumber_length =~ m|(\d*),(\d*)| ) {
1155 $min = $1 if $1 and $min < $1;
1156 $max = $2 if $2 and $max > $2;
1160 return ( $min, $max );
1163 =head2 GetFirstValidEmailAddress
1165 $email = GetFirstValidEmailAddress($borrowernumber);
1167 Return the first valid email address for a borrower, given the borrowernumber. For now, the order
1168 is defined as email, emailpro, B_email. Returns the empty string if the borrower has no email
1173 sub GetFirstValidEmailAddress {
1174 my $borrowernumber = shift;
1175 my $dbh = C4::Context->dbh;
1176 my $sth = $dbh->prepare( "SELECT email, emailpro, B_email FROM borrowers where borrowernumber = ? ");
1177 $sth->execute( $borrowernumber );
1178 my $data = $sth->fetchrow_hashref;
1180 if ($data->{'email'}) {
1181 return $data->{'email'};
1182 } elsif ($data->{'emailpro'}) {
1183 return $data->{'emailpro'};
1184 } elsif ($data->{'B_email'}) {
1185 return $data->{'B_email'};
1191 =head2 GetNoticeEmailAddress
1193 $email = GetNoticeEmailAddress($borrowernumber);
1195 Return the email address of borrower used for notices, given the borrowernumber.
1196 Returns the empty string if no email address.
1200 sub GetNoticeEmailAddress {
1201 my $borrowernumber = shift;
1203 my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
1204 # if syspref is set to 'first valid' (value == OFF), look up email address
1205 if ( $which_address eq 'OFF' ) {
1206 return GetFirstValidEmailAddress($borrowernumber);
1208 # specified email address field
1209 my $dbh = C4::Context->dbh;
1210 my $sth = $dbh->prepare( qq{
1211 SELECT $which_address AS primaryemail
1213 WHERE borrowernumber=?
1215 $sth->execute($borrowernumber);
1216 my $data = $sth->fetchrow_hashref;
1217 return $data->{'primaryemail'} || '';
1220 =head2 GetUpcomingMembershipExpires
1222 my $expires = GetUpcomingMembershipExpires({
1223 branch => $branch, before => $before, after => $after,
1226 $branch is an optional branch code.
1227 $before/$after is an optional number of days before/after the date that
1228 is set by the preference MembershipExpiryDaysNotice.
1229 If the pref would be 14, before 2 and after 3, you will get all expires
1234 sub GetUpcomingMembershipExpires {
1235 my ( $params ) = @_;
1236 my $before = $params->{before} || 0;
1237 my $after = $params->{after} || 0;
1238 my $branch = $params->{branch};
1240 my $dbh = C4::Context->dbh;
1241 my $days = C4::Context->preference("MembershipExpiryDaysNotice") || 0;
1242 my $date1 = dt_from_string->add( days => $days - $before );
1243 my $date2 = dt_from_string->add( days => $days + $after );
1244 $date1= output_pref({ dt => $date1, dateformat => 'iso', dateonly => 1 });
1245 $date2= output_pref({ dt => $date2, dateformat => 'iso', dateonly => 1 });
1248 SELECT borrowers.*, categories.description,
1249 branches.branchname, branches.branchemail FROM borrowers
1250 LEFT JOIN branches USING (branchcode)
1251 LEFT JOIN categories USING (categorycode)
1254 $query.= 'WHERE branchcode=? AND dateexpiry BETWEEN ? AND ?';
1256 $query.= 'WHERE dateexpiry BETWEEN ? AND ?';
1259 my $sth = $dbh->prepare( $query );
1260 my @pars = $branch? ( $branch ): ();
1261 push @pars, $date1, $date2;
1262 $sth->execute( @pars );
1263 my $results = $sth->fetchall_arrayref( {} );
1267 =head2 GetBorrowerCategorycode
1269 $categorycode = &GetBorrowerCategoryCode( $borrowernumber );
1271 Given the borrowernumber, the function returns the corresponding categorycode
1275 sub GetBorrowerCategorycode {
1276 my ( $borrowernumber ) = @_;
1277 my $dbh = C4::Context->dbh;
1278 my $sth = $dbh->prepare( qq{
1281 WHERE borrowernumber = ?
1283 $sth->execute( $borrowernumber );
1284 return $sth->fetchrow;
1289 $dateofbirth,$date = &GetAge($date);
1291 this function return the borrowers age with the value of dateofbirth
1297 my ( $date, $date_ref ) = @_;
1299 if ( not defined $date_ref ) {
1300 $date_ref = sprintf( '%04d-%02d-%02d', Today() );
1303 my ( $year1, $month1, $day1 ) = split /-/, $date;
1304 my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
1306 my $age = $year2 - $year1;
1307 if ( $month1 . $day1 > $month2 . $day2 ) {
1316 $borrower = C4::Members::SetAge($borrower, $datetimeduration);
1317 $borrower = C4::Members::SetAge($borrower, '0015-12-10');
1318 $borrower = C4::Members::SetAge($borrower, $datetimeduration, $datetime_reference);
1320 eval { $borrower = C4::Members::SetAge($borrower, '015-1-10'); };
1321 if ($@) {print $@;} #Catch a bad ISO Date or kill your script!
1323 This function sets the borrower's dateofbirth to match the given age.
1324 Optionally relative to the given $datetime_reference.
1326 @PARAM1 koha.borrowers-object
1327 @PARAM2 DateTime::Duration-object as the desired age
1328 OR a ISO 8601 Date. (To make the API more pleasant)
1329 @PARAM3 DateTime-object as the relative date, defaults to now().
1330 RETURNS The given borrower reference @PARAM1.
1331 DIES If there was an error with the ISO Date handling.
1337 my ( $borrower, $datetimeduration, $datetime_ref ) = @_;
1338 $datetime_ref = DateTime->now() unless $datetime_ref;
1340 if ($datetimeduration && ref $datetimeduration ne 'DateTime::Duration') {
1341 if ($datetimeduration =~ /^(\d{4})-(\d{2})-(\d{2})/) {
1342 $datetimeduration = DateTime::Duration->new(years => $1, months => $2, days => $3);
1345 die "C4::Members::SetAge($borrower, $datetimeduration), datetimeduration not a valid ISO 8601 Date!\n";
1349 my $new_datetime_ref = $datetime_ref->clone();
1350 $new_datetime_ref->subtract_duration( $datetimeduration );
1352 $borrower->{dateofbirth} = $new_datetime_ref->ymd();
1357 =head2 GetSortDetails (OUEST-PROVENCE)
1359 ($lib) = &GetSortDetails($category,$sortvalue);
1361 Returns the authorized value details
1362 C<&$lib>return value of authorized value details
1363 C<&$sortvalue>this is the value of authorized value
1364 C<&$category>this is the value of authorized value category
1368 sub GetSortDetails {
1369 my ( $category, $sortvalue ) = @_;
1370 my $dbh = C4::Context->dbh;
1371 my $query = qq|SELECT lib
1372 FROM authorised_values
1374 AND authorised_value=? |;
1375 my $sth = $dbh->prepare($query);
1376 $sth->execute( $category, $sortvalue );
1377 my $lib = $sth->fetchrow;
1378 return ($lib) if ($lib);
1379 return ($sortvalue) unless ($lib);
1382 =head2 MoveMemberToDeleted
1384 $result = &MoveMemberToDeleted($borrowernumber);
1386 Copy the record from borrowers to deletedborrowers table.
1387 The routine returns 1 for success, undef for failure.
1391 sub MoveMemberToDeleted {
1392 my ($member) = shift or return;
1394 my $schema = Koha::Database->new()->schema();
1395 my $borrowers_rs = $schema->resultset('Borrower');
1396 $borrowers_rs->result_class('DBIx::Class::ResultClass::HashRefInflator');
1397 my $borrower = $borrowers_rs->find($member);
1398 return unless $borrower;
1400 my $deleted = $schema->resultset('Deletedborrower')->create($borrower);
1402 return $deleted ? 1 : undef;
1407 DelMember($borrowernumber);
1409 This function remove directly a borrower whitout writing it on deleteborrower.
1410 + Deletes reserves for the borrower
1415 my $dbh = C4::Context->dbh;
1416 my $borrowernumber = shift;
1417 #warn "in delmember with $borrowernumber";
1418 return unless $borrowernumber; # borrowernumber is mandatory.
1419 # Delete Patron's holds
1420 my @holds = Koha::Holds->search({ borrowernumber => $borrowernumber });
1421 $_->delete for @holds;
1426 WHERE borrowernumber = ?
1428 my $sth = $dbh->prepare($query);
1429 $sth->execute($borrowernumber);
1430 logaction("MEMBERS", "DELETE", $borrowernumber, "") if C4::Context->preference("BorrowersLog");
1434 =head2 HandleDelBorrower
1436 HandleDelBorrower($borrower);
1438 When a member is deleted (DelMember in Members.pm), you should call me first.
1439 This routine deletes/moves lists and entries for the deleted member/borrower.
1440 Lists owned by the borrower are deleted, but entries from the borrower to
1441 other lists are kept.
1445 sub HandleDelBorrower {
1448 my $dbh = C4::Context->dbh;
1450 #Delete all lists and all shares of this borrower
1451 #Consistent with the approach Koha uses on deleting individual lists
1452 #Note that entries in virtualshelfcontents added by this borrower to
1453 #lists of others will be handled by a table constraint: the borrower
1454 #is set to NULL in those entries.
1455 $query="DELETE FROM virtualshelves WHERE owner=?";
1456 $dbh->do($query,undef,($borrower));
1459 #We could handle the above deletes via a constraint too.
1460 #But a new BZ report 11889 has been opened to discuss another approach.
1461 #Instead of deleting we could also disown lists (based on a pref).
1462 #In that way we could save shared and public lists.
1463 #The current table constraints support that idea now.
1464 #This pref should then govern the results of other routines/methods such as
1465 #Koha::Virtualshelf->new->delete too.
1468 =head2 GetHideLostItemsPreference
1470 $hidelostitemspref = &GetHideLostItemsPreference($borrowernumber);
1472 Returns the HideLostItems preference for the patron category of the supplied borrowernumber
1473 C<&$hidelostitemspref>return value of function, 0 or 1
1477 sub GetHideLostItemsPreference {
1478 my ($borrowernumber) = @_;
1479 my $dbh = C4::Context->dbh;
1480 my $query = "SELECT hidelostitems FROM borrowers,categories WHERE borrowers.categorycode = categories.categorycode AND borrowernumber = ?";
1481 my $sth = $dbh->prepare($query);
1482 $sth->execute($borrowernumber);
1483 my $hidelostitems = $sth->fetchrow;
1484 return $hidelostitems;
1487 =head2 GetBorrowersToExpunge
1489 $borrowers = &GetBorrowersToExpunge(
1490 not_borrowed_since => $not_borrowed_since,
1491 expired_before => $expired_before,
1492 category_code => $category_code,
1493 patron_list_id => $patron_list_id,
1494 branchcode => $branchcode
1497 This function get all borrowers based on the given criteria.
1501 sub GetBorrowersToExpunge {
1504 my $filterdate = $params->{'not_borrowed_since'};
1505 my $filterexpiry = $params->{'expired_before'};
1506 my $filtercategory = $params->{'category_code'};
1507 my $filterbranch = $params->{'branchcode'} ||
1508 ((C4::Context->preference('IndependentBranches')
1509 && C4::Context->userenv
1510 && !C4::Context->IsSuperLibrarian()
1511 && C4::Context->userenv->{branch})
1512 ? C4::Context->userenv->{branch}
1514 my $filterpatronlist = $params->{'patron_list_id'};
1516 my $dbh = C4::Context->dbh;
1518 SELECT borrowers.borrowernumber,
1519 MAX(old_issues.timestamp) AS latestissue,
1520 MAX(issues.timestamp) AS currentissue
1522 JOIN categories USING (categorycode)
1526 WHERE guarantorid IS NOT NULL
1527 AND guarantorid <> 0
1528 ) as tmp ON borrowers.borrowernumber=tmp.guarantorid
1529 LEFT JOIN old_issues USING (borrowernumber)
1530 LEFT JOIN issues USING (borrowernumber)|;
1531 if ( $filterpatronlist ){
1532 $query .= q| LEFT JOIN patron_list_patrons USING (borrowernumber)|;
1534 $query .= q| WHERE category_type <> 'S'
1535 AND tmp.guarantorid IS NULL
1538 if ( $filterbranch && $filterbranch ne "" ) {
1539 $query.= " AND borrowers.branchcode = ? ";
1540 push( @query_params, $filterbranch );
1542 if ( $filterexpiry ) {
1543 $query .= " AND dateexpiry < ? ";
1544 push( @query_params, $filterexpiry );
1546 if ( $filtercategory ) {
1547 $query .= " AND categorycode = ? ";
1548 push( @query_params, $filtercategory );
1550 if ( $filterpatronlist ){
1551 $query.=" AND patron_list_id = ? ";
1552 push( @query_params, $filterpatronlist );
1554 $query.=" GROUP BY borrowers.borrowernumber HAVING currentissue IS NULL ";
1555 if ( $filterdate ) {
1556 $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
1557 push @query_params,$filterdate;
1559 warn $query if $debug;
1561 my $sth = $dbh->prepare($query);
1562 if (scalar(@query_params)>0){
1563 $sth->execute(@query_params);
1570 while ( my $data = $sth->fetchrow_hashref ) {
1571 push @results, $data;
1576 =head2 GetBorrowersWhoHaveNeverBorrowed
1578 $results = &GetBorrowersWhoHaveNeverBorrowed
1580 This function get all borrowers who have never borrowed.
1582 I<$result> is a ref to an array which all elements are a hasref.
1586 sub GetBorrowersWhoHaveNeverBorrowed {
1587 my $filterbranch = shift ||
1588 ((C4::Context->preference('IndependentBranches')
1589 && C4::Context->userenv
1590 && !C4::Context->IsSuperLibrarian()
1591 && C4::Context->userenv->{branch})
1592 ? C4::Context->userenv->{branch}
1594 my $dbh = C4::Context->dbh;
1596 SELECT borrowers.borrowernumber,max(timestamp) as latestissue
1598 LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
1599 WHERE issues.borrowernumber IS NULL
1602 if ($filterbranch && $filterbranch ne ""){
1603 $query.=" AND borrowers.branchcode= ?";
1604 push @query_params,$filterbranch;
1606 warn $query if $debug;
1608 my $sth = $dbh->prepare($query);
1609 if (scalar(@query_params)>0){
1610 $sth->execute(@query_params);
1617 while ( my $data = $sth->fetchrow_hashref ) {
1618 push @results, $data;
1623 =head2 GetBorrowersWithIssuesHistoryOlderThan
1625 $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
1627 this function get all borrowers who has an issue history older than I<$date> given on input arg.
1629 I<$result> is a ref to an array which all elements are a hashref.
1630 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
1634 sub GetBorrowersWithIssuesHistoryOlderThan {
1635 my $dbh = C4::Context->dbh;
1636 my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
1637 my $filterbranch = shift ||
1638 ((C4::Context->preference('IndependentBranches')
1639 && C4::Context->userenv
1640 && !C4::Context->IsSuperLibrarian()
1641 && C4::Context->userenv->{branch})
1642 ? C4::Context->userenv->{branch}
1645 SELECT count(borrowernumber) as n,borrowernumber
1647 WHERE returndate < ?
1648 AND borrowernumber IS NOT NULL
1651 push @query_params, $date;
1653 $query.=" AND branchcode = ?";
1654 push @query_params, $filterbranch;
1656 $query.=" GROUP BY borrowernumber ";
1657 warn $query if $debug;
1658 my $sth = $dbh->prepare($query);
1659 $sth->execute(@query_params);
1662 while ( my $data = $sth->fetchrow_hashref ) {
1663 push @results, $data;
1670 IssueSlip($branchcode, $borrowernumber, $quickslip)
1672 Returns letter hash ( see C4::Letters::GetPreparedLetter )
1674 $quickslip is boolean, to indicate whether we want a quick slip
1676 IssueSlip populates ISSUESLIP and ISSUEQSLIP, and will make the following expansions:
1712 NOTE: Not all table fields are available, pleasee see GetPendingIssues for a list of available fields.
1717 my ($branch, $borrowernumber, $quickslip) = @_;
1719 # FIXME Check callers before removing this statement
1720 #return unless $borrowernumber;
1722 my @issues = @{ GetPendingIssues($borrowernumber) };
1724 for my $issue (@issues) {
1725 $issue->{date_due} = $issue->{date_due_sql};
1727 my $today = output_pref({ dt => dt_from_string, dateformat => 'iso', dateonly => 1 });
1728 if ( substr( $issue->{issuedate}, 0, 10 ) eq $today
1729 or substr( $issue->{lastreneweddate}, 0, 10 ) eq $today ) {
1735 # Sort on timestamp then on issuedate (useful for tests and could be if modified in a batch
1737 my $s = $b->{timestamp} <=> $a->{timestamp};
1739 $b->{issuedate} <=> $a->{issuedate} : $s;
1742 my ($letter_code, %repeat);
1744 $letter_code = 'ISSUEQSLIP';
1746 'checkedout' => [ map {
1749 'biblioitems' => $_,
1751 }, grep { $_->{'now'} } @issues ],
1755 $letter_code = 'ISSUESLIP';
1757 'checkedout' => [ map {
1760 'biblioitems' => $_,
1762 }, grep { !$_->{'overdue'} } @issues ],
1764 'overdue' => [ map {
1767 'biblioitems' => $_,
1769 }, grep { $_->{'overdue'} } @issues ],
1772 $_->{'timestamp'} = $_->{'newdate'};
1774 } @{ GetNewsToDisplay("slip",$branch) } ],
1778 return C4::Letters::GetPreparedLetter (
1779 module => 'circulation',
1780 letter_code => $letter_code,
1781 branchcode => $branch,
1783 'branches' => $branch,
1784 'borrowers' => $borrowernumber,
1790 =head2 GetBorrowersWithEmail
1792 ([$borrnum,$userid], ...) = GetBorrowersWithEmail('me@example.com');
1794 This gets a list of users and their basic details from their email address.
1795 As it's possible for multiple user to have the same email address, it provides
1796 you with all of them. If there is no userid for the user, there will be an
1797 C<undef> there. An empty list will be returned if there are no matches.
1801 sub GetBorrowersWithEmail {
1804 my $dbh = C4::Context->dbh;
1806 my $query = "SELECT borrowernumber, userid FROM borrowers WHERE email=?";
1807 my $sth=$dbh->prepare($query);
1808 $sth->execute($email);
1810 while (my $ref = $sth->fetch) {
1813 die "Failure searching for borrowers by email address: $sth->errstr" if $sth->err;
1817 =head2 AddMember_Opac
1821 sub AddMember_Opac {
1822 my ( %borrower ) = @_;
1824 $borrower{'categorycode'} //= C4::Context->preference('PatronSelfRegistrationDefaultCategory');
1825 if (not defined $borrower{'password'}){
1826 my $sr = new String::Random;
1827 $sr->{'A'} = [ 'A'..'Z', 'a'..'z' ];
1828 my $password = $sr->randpattern("AAAAAAAAAA");
1829 $borrower{'password'} = $password;
1832 $borrower{'cardnumber'} = fixup_cardnumber( $borrower{'cardnumber'} );
1834 my $borrowernumber = AddMember(%borrower);
1836 return ( $borrowernumber, $borrower{'password'} );
1839 =head2 AddEnrolmentFeeIfNeeded
1841 AddEnrolmentFeeIfNeeded( $borrower->{categorycode}, $borrower->{borrowernumber} );
1843 Add enrolment fee for a patron if needed.
1847 sub AddEnrolmentFeeIfNeeded {
1848 my ( $categorycode, $borrowernumber ) = @_;
1849 # check for enrollment fee & add it if needed
1850 my $dbh = C4::Context->dbh;
1851 my $sth = $dbh->prepare(q{
1854 WHERE categorycode=?
1856 $sth->execute( $categorycode );
1858 warn sprintf('Database returned the following error: %s', $sth->errstr);
1861 my ($enrolmentfee) = $sth->fetchrow;
1862 if ($enrolmentfee && $enrolmentfee > 0) {
1863 # insert fee in patron debts
1864 C4::Accounts::manualinvoice( $borrowernumber, '', '', 'A', $enrolmentfee );
1873 my ( $borrowernumber ) = @_;
1875 my $sql = "SELECT COUNT(*) FROM issues WHERE date_due < NOW() AND borrowernumber = ?";
1876 my $sth = C4::Context->dbh->prepare( $sql );
1877 $sth->execute( $borrowernumber );
1878 my ( $count ) = $sth->fetchrow_array();
1883 =head2 DeleteExpiredOpacRegistrations
1885 Delete accounts that haven't been upgraded from the 'temporary' category
1886 Returns the number of removed patrons
1890 sub DeleteExpiredOpacRegistrations {
1892 my $delay = C4::Context->preference('PatronSelfRegistrationExpireTemporaryAccountsDelay');
1893 my $category_code = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
1895 return 0 if not $category_code or not defined $delay or $delay eq q||;
1898 SELECT borrowernumber
1900 WHERE categorycode = ? AND DATEDIFF( NOW(), dateenrolled ) > ? |;
1902 my $dbh = C4::Context->dbh;
1903 my $sth = $dbh->prepare($query);
1904 $sth->execute( $category_code, $delay );
1906 while ( my ($borrowernumber) = $sth->fetchrow_array() ) {
1907 DelMember($borrowernumber);
1913 =head2 DeleteUnverifiedOpacRegistrations
1915 Delete all unverified self registrations in borrower_modifications,
1916 older than the specified number of days.
1920 sub DeleteUnverifiedOpacRegistrations {
1922 my $dbh = C4::Context->dbh;
1924 DELETE FROM borrower_modifications
1925 WHERE borrowernumber = 0 AND DATEDIFF( NOW(), timestamp ) > ?|;
1926 my $cnt=$dbh->do($sql, undef, ($days) );
1927 return $cnt eq '0E0'? 0: $cnt;
1930 sub GetOverduesForPatron {
1931 my ( $borrowernumber ) = @_;
1935 FROM issues, items, biblio, biblioitems
1936 WHERE items.itemnumber=issues.itemnumber
1937 AND biblio.biblionumber = items.biblionumber
1938 AND biblio.biblionumber = biblioitems.biblionumber
1939 AND issues.borrowernumber = ?
1940 AND date_due < NOW()
1943 my $sth = C4::Context->dbh->prepare( $sql );
1944 $sth->execute( $borrowernumber );
1946 return $sth->fetchall_arrayref({});
1949 END { } # module clean-up code here (global destructor)