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
;
49 our (@ISA,@EXPORT,@EXPORT_OK,$debug);
51 use Module
::Load
::Conditional
qw( can_load );
52 if ( ! can_load
( modules
=> { 'Koha::NorwegianPatronDB' => undef } ) ) {
53 $debug && warn "Unable to load Koha::NorwegianPatronDB";
58 $debug = $ENV{DEBUG
} || 0;
66 &GetMemberIssuesAndFines
70 &GetFirstValidEmailAddress
71 &GetNoticeEmailAddress
73 &GetMemberAccountRecords
74 &GetBorNotifyAcctRecord
76 &GetBorrowersToExpunge
77 &GetBorrowersWhoHaveNeverBorrowed
78 &GetBorrowersWithIssuesHistoryOlderThan
80 &GetUpcomingMembershipExpires
113 C4::Members - Perl Module containing convenience functions for member handling
121 This module contains routines for adding, modifying and deleting members/patrons/borrowers
125 =head2 GetMemberDetails
127 ($borrower) = &GetMemberDetails($borrowernumber, $cardnumber);
129 Looks up a patron and returns information about him or her. If
130 C<$borrowernumber> is true (nonzero), C<&GetMemberDetails> looks
131 up the borrower by number; otherwise, it looks up the borrower by card
134 C<$borrower> is a reference-to-hash whose keys are the fields of the
135 borrowers table in the Koha database. In addition,
139 sub GetMemberDetails
{
140 my ( $borrowernumber, $cardnumber ) = @_;
141 my $dbh = C4
::Context
->dbh;
144 if ($borrowernumber) {
145 $sth = $dbh->prepare("
148 categories.description,
151 LEFT JOIN categories ON borrowers.categorycode=categories.categorycode
152 WHERE borrowernumber = ?
154 $sth->execute($borrowernumber);
156 elsif ($cardnumber) {
157 $sth = $dbh->prepare("
160 categories.description,
163 LEFT JOIN categories ON borrowers.categorycode = categories.categorycode
166 $sth->execute($cardnumber);
171 my $borrower = $sth->fetchrow_hashref;
172 return unless $borrower;
179 $flags = &patronflags($patron);
181 This function is not exported.
183 The following will be set where applicable:
184 $flags->{CHARGES}->{amount} Amount of debt
185 $flags->{CHARGES}->{noissues} Set if debt amount >$5.00 (or syspref noissuescharge)
186 $flags->{CHARGES}->{message} Message -- deprecated
188 $flags->{CREDITS}->{amount} Amount of credit
189 $flags->{CREDITS}->{message} Message -- deprecated
191 $flags->{ GNA } Patron has no valid address
192 $flags->{ GNA }->{noissues} Set for each GNA
193 $flags->{ GNA }->{message} "Borrower has no valid address" -- deprecated
195 $flags->{ LOST } Patron's card reported lost
196 $flags->{ LOST }->{noissues} Set for each LOST
197 $flags->{ LOST }->{message} Message -- deprecated
199 $flags->{DBARRED} Set if patron debarred, no access
200 $flags->{DBARRED}->{noissues} Set for each DBARRED
201 $flags->{DBARRED}->{message} Message -- deprecated
204 $flags->{ NOTES }->{message} The note itself. NOT deprecated
206 $flags->{ ODUES } Set if patron has overdue books.
207 $flags->{ ODUES }->{message} "Yes" -- deprecated
208 $flags->{ ODUES }->{itemlist} ref-to-array: list of overdue books
209 $flags->{ ODUES }->{itemlisttext} Text list of overdue items -- deprecated
211 $flags->{WAITING} Set if any of patron's reserves are available
212 $flags->{WAITING}->{message} Message -- deprecated
213 $flags->{WAITING}->{itemlist} ref-to-array: list of available items
217 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
218 overdue items. Its elements are references-to-hash, each describing an
219 overdue item. The keys are selected fields from the issues, biblio,
220 biblioitems, and items tables of the Koha database.
222 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
223 the overdue items, one per line. Deprecated.
225 =item C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
226 available items. Each element is a reference-to-hash whose keys are
227 fields from the reserves table of the Koha database.
231 All the "message" fields that include language generated in this function are deprecated,
232 because such strings belong properly in the display layer.
234 The "message" field that comes from the DB is OK.
238 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
239 # FIXME rename this function.
242 my ( $patroninformation) = @_;
243 my $dbh=C4
::Context
->dbh;
244 my ($balance, $owing) = GetMemberAccountBalance
( $patroninformation->{'borrowernumber'});
247 my $noissuescharge = C4
::Context
->preference("noissuescharge") || 5;
248 $flaginfo{'message'} = sprintf 'Patron owes %.02f', $owing;
249 $flaginfo{'amount'} = sprintf "%.02f", $owing;
250 if ( $owing > $noissuescharge && !C4
::Context
->preference("AllowFineOverride") ) {
251 $flaginfo{'noissues'} = 1;
253 $flags{'CHARGES'} = \
%flaginfo;
255 elsif ( $balance < 0 ) {
257 $flaginfo{'message'} = sprintf 'Patron has credit of %.02f', -$balance;
258 $flaginfo{'amount'} = sprintf "%.02f", $balance;
259 $flags{'CREDITS'} = \
%flaginfo;
262 # Check the debt of the guarntees of this patron
263 my $no_issues_charge_guarantees = C4
::Context
->preference("NoIssuesChargeGuarantees");
264 $no_issues_charge_guarantees = undef unless looks_like_number
( $no_issues_charge_guarantees );
265 if ( defined $no_issues_charge_guarantees ) {
266 my $p = Koha
::Patrons
->find( $patroninformation->{borrowernumber
} );
267 my @guarantees = $p->guarantees();
268 my $guarantees_non_issues_charges;
269 foreach my $g ( @guarantees ) {
270 my ( $b, $n, $o ) = C4
::Members
::GetMemberAccountBalance
( $g->id );
271 $guarantees_non_issues_charges += $n;
274 if ( $guarantees_non_issues_charges > $no_issues_charge_guarantees ) {
276 $flaginfo{'message'} = sprintf 'patron guarantees owe %.02f', $guarantees_non_issues_charges;
277 $flaginfo{'amount'} = $guarantees_non_issues_charges;
278 $flaginfo{'noissues'} = 1 unless C4
::Context
->preference("allowfineoverride");
279 $flags{'CHARGES_GUARANTEES'} = \
%flaginfo;
283 if ( $patroninformation->{'gonenoaddress'}
284 && $patroninformation->{'gonenoaddress'} == 1 )
287 $flaginfo{'message'} = 'Borrower has no valid address.';
288 $flaginfo{'noissues'} = 1;
289 $flags{'GNA'} = \
%flaginfo;
291 if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
293 $flaginfo{'message'} = 'Borrower\'s card reported lost.';
294 $flaginfo{'noissues'} = 1;
295 $flags{'LOST'} = \
%flaginfo;
297 if ( $patroninformation->{'debarred'} && check_date
( split( /-/, $patroninformation->{'debarred'} ) ) ) {
298 if ( Date_to_Days
(Date
::Calc
::Today
) < Date_to_Days
( split( /-/, $patroninformation->{'debarred'} ) ) ) {
300 $flaginfo{'debarredcomment'} = $patroninformation->{'debarredcomment'};
301 $flaginfo{'message'} = $patroninformation->{'debarredcomment'};
302 $flaginfo{'noissues'} = 1;
303 $flaginfo{'dateend'} = $patroninformation->{'debarred'};
304 $flags{'DBARRED'} = \
%flaginfo;
307 if ( $patroninformation->{'borrowernotes'}
308 && $patroninformation->{'borrowernotes'} )
311 $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
312 $flags{'NOTES'} = \
%flaginfo;
314 my ( $odues, $itemsoverdue ) = C4
::Overdues
::checkoverdues
($patroninformation->{'borrowernumber'});
315 if ( $odues && $odues > 0 ) {
317 $flaginfo{'message'} = "Yes";
318 $flaginfo{'itemlist'} = $itemsoverdue;
319 foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
322 $flaginfo{'itemlisttext'} .=
323 "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n"; # newline is display layer
325 $flags{'ODUES'} = \
%flaginfo;
327 my @itemswaiting = C4
::Reserves
::GetReservesFromBorrowernumber
( $patroninformation->{'borrowernumber'},'W' );
328 my $nowaiting = scalar @itemswaiting;
329 if ( $nowaiting > 0 ) {
331 $flaginfo{'message'} = "Reserved items available";
332 $flaginfo{'itemlist'} = \
@itemswaiting;
333 $flags{'WAITING'} = \
%flaginfo;
341 $borrower = &GetMember(%information);
343 Retrieve the first patron record meeting on criteria listed in the
344 C<%information> hash, which should contain one or more
345 pairs of borrowers column names and values, e.g.,
347 $borrower = GetMember(borrowernumber => id);
349 C<&GetBorrower> returns a reference-to-hash whose keys are the fields of
350 the C<borrowers> table in the Koha database.
352 FIXME: GetMember() is used throughout the code as a lookup
353 on a unique key such as the borrowernumber, but this meaning is not
354 enforced in the routine itself.
360 my ( %information ) = @_;
361 if (exists $information{borrowernumber
} && !defined $information{borrowernumber
}) {
362 #passing mysql's kohaadmin?? Makes no sense as a query
365 my $dbh = C4
::Context
->dbh;
367 q{SELECT borrowers.*, categories.category_type, categories.description
369 LEFT JOIN categories on borrowers.categorycode=categories.categorycode WHERE };
372 for (keys %information ) {
380 if (defined $information{$_}) {
382 push @values, $information{$_};
385 $select .= "$_ IS NULL";
388 $debug && warn $select, " ",values %information;
389 my $sth = $dbh->prepare("$select");
390 $sth->execute(@values);
391 my $data = $sth->fetchall_arrayref({});
392 #FIXME interface to this routine now allows generation of a result set
393 #so whole array should be returned but bowhere in the current code expects this
401 =head2 GetMemberIssuesAndFines
403 ($overdue_count, $issue_count, $total_fines) = &GetMemberIssuesAndFines($borrowernumber);
405 Returns aggregate data about items borrowed by the patron with the
406 given borrowernumber.
408 C<&GetMemberIssuesAndFines> returns a three-element array. C<$overdue_count> is the
409 number of overdue items the patron currently has borrowed. C<$issue_count> is the
410 number of books the patron currently has borrowed. C<$total_fines> is
411 the total fine currently due by the borrower.
416 sub GetMemberIssuesAndFines
{
417 my ( $borrowernumber ) = @_;
418 my $dbh = C4
::Context
->dbh;
419 my $query = "SELECT COUNT(*) FROM issues WHERE borrowernumber = ?";
421 $debug and warn $query."\n";
422 my $sth = $dbh->prepare($query);
423 $sth->execute($borrowernumber);
424 my $issue_count = $sth->fetchrow_arrayref->[0];
426 $sth = $dbh->prepare(
427 "SELECT COUNT(*) FROM issues
428 WHERE borrowernumber = ?
429 AND date_due < now()"
431 $sth->execute($borrowernumber);
432 my $overdue_count = $sth->fetchrow_arrayref->[0];
434 $sth = $dbh->prepare("SELECT SUM(amountoutstanding) FROM accountlines WHERE borrowernumber = ?");
435 $sth->execute($borrowernumber);
436 my $total_fines = $sth->fetchrow_arrayref->[0];
438 return ($overdue_count, $issue_count, $total_fines);
444 my $success = ModMember(borrowernumber => $borrowernumber,
445 [ field => value ]... );
447 Modify borrower's data. All date fields should ALREADY be in ISO format.
450 true on success, or false on failure
456 # test to know if you must update or not the borrower password
457 if (exists $data{password
}) {
458 if ($data{password
} eq '****' or $data{password
} eq '') {
459 delete $data{password
};
461 if ( C4
::Context
->preference('NorwegianPatronDBEnable') && C4
::Context
->preference('NorwegianPatronDBEnable') == 1 ) {
462 # Update the hashed PIN in borrower_sync.hashed_pin, before Koha hashes it
463 Koha
::NorwegianPatronDB
::NLUpdateHashedPIN
( $data{'borrowernumber'}, $data{password
} );
465 $data{password
} = hash_password
($data{password
});
469 my $old_categorycode = Koha
::Patrons
->find( $data{borrowernumber
} )->categorycode;
471 # get only the columns of a borrower
472 my $schema = Koha
::Database
->new()->schema;
473 my @columns = $schema->source('Borrower')->columns;
474 my $new_borrower = { map { join(' ', @columns) =~ /$_/ ?
( $_ => $data{$_} ) : () } keys(%data) };
476 $new_borrower->{dateofbirth
} ||= undef if exists $new_borrower->{dateofbirth
};
477 $new_borrower->{dateenrolled
} ||= undef if exists $new_borrower->{dateenrolled
};
478 $new_borrower->{dateexpiry
} ||= undef if exists $new_borrower->{dateexpiry
};
479 $new_borrower->{debarred
} ||= undef if exists $new_borrower->{debarred
};
480 $new_borrower->{sms_provider_id
} ||= undef if exists $new_borrower->{sms_provider_id
};
481 $new_borrower->{guarantorid
} ||= undef if exists $new_borrower->{guarantorid
};
483 my $patron = Koha
::Patrons
->find( $new_borrower->{borrowernumber
} );
485 delete $new_borrower->{userid
} if exists $new_borrower->{userid
} and not $new_borrower->{userid
};
487 my $execute_success = $patron->store if $patron->set($new_borrower);
489 if ($execute_success) { # only proceed if the update was a success
490 # If the patron changes to a category with enrollment fee, we add a fee
491 if ( $data{categorycode
} and $data{categorycode
} ne $old_categorycode ) {
492 if ( C4
::Context
->preference('FeeOnChangePatronCategory') ) {
493 $patron->add_enrolment_fee_if_needed;
497 # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
498 # cronjob will use for syncing with NL
499 if ( C4
::Context
->preference('NorwegianPatronDBEnable') && C4
::Context
->preference('NorwegianPatronDBEnable') == 1 ) {
500 my $borrowersync = Koha
::Database
->new->schema->resultset('BorrowerSync')->find({
501 'synctype' => 'norwegianpatrondb',
502 'borrowernumber' => $data{'borrowernumber'}
504 # Do not set to "edited" if syncstatus is "new". We need to sync as new before
505 # we can sync as changed. And the "new sync" will pick up all changes since
506 # the patron was created anyway.
507 if ( $borrowersync->syncstatus ne 'new' && $borrowersync->syncstatus ne 'delete' ) {
508 $borrowersync->update( { 'syncstatus' => 'edited' } );
510 # Set the value of 'sync'
511 $borrowersync->update( { 'sync' => $data{'sync'} } );
512 # Try to do the live sync
513 Koha
::NorwegianPatronDB
::NLSync
({ 'borrowernumber' => $data{'borrowernumber'} });
516 logaction
("MEMBERS", "MODIFY", $data{'borrowernumber'}, "UPDATE (executed w/ arg: $data{'borrowernumber'})") if C4
::Context
->preference("BorrowersLog");
518 return $execute_success;
523 $borrowernumber = &AddMember(%borrower);
525 insert new borrower into table
527 (%borrower keys are database columns. Database columns could be
528 different in different versions. Please look into database for correct
531 Returns the borrowernumber upon success
533 Returns as undef upon any db error without further processing
540 my $dbh = C4
::Context
->dbh;
541 my $schema = Koha
::Database
->new()->schema;
543 # generate a proper login if none provided
544 $data{'userid'} = Generate_Userid
( $data{'borrowernumber'}, $data{'firstname'}, $data{'surname'} )
545 if ( $data{'userid'} eq '' || !Check_Userid
( $data{'userid'} ) );
547 # add expiration date if it isn't already there
548 $data{dateexpiry
} ||= Koha
::Patron
::Categories
->find( $data{categorycode
} )->get_expiry_date;
550 # add enrollment date if it isn't already there
551 unless ( $data{'dateenrolled'} ) {
552 $data{'dateenrolled'} = output_pref
( { dt
=> dt_from_string
, dateonly
=> 1, dateformat
=> 'iso' } );
555 my $patron_category = $schema->resultset('Category')->find( $data{'categorycode'} );
557 $patron_category->default_privacy() eq 'default' ?
1
558 : $patron_category->default_privacy() eq 'never' ?
2
559 : $patron_category->default_privacy() eq 'forever' ?
0
562 $data{'privacy_guarantor_checkouts'} = 0 unless defined( $data{'privacy_guarantor_checkouts'} );
564 # Make a copy of the plain text password for later use
565 my $plain_text_password = $data{'password'};
567 # create a disabled account if no password provided
568 $data{'password'} = ($data{'password'})? hash_password
($data{'password'}) : '!';
570 # we don't want invalid dates in the db (mysql has a bad habit of inserting 0000-00-00
571 $data{'dateofbirth'} = undef if ( not $data{'dateofbirth'} );
572 $data{'debarred'} = undef if ( not $data{'debarred'} );
573 $data{'sms_provider_id'} = undef if ( not $data{'sms_provider_id'} );
575 # get only the columns of Borrower
576 # FIXME Do we really need this check?
577 my @columns = $schema->source('Borrower')->columns;
578 my $new_member = { map { join(' ',@columns) =~ /$_/ ?
( $_ => $data{$_} ) : () } keys(%data) } ;
580 delete $new_member->{borrowernumber
};
582 my $patron = Koha
::Patron
->new( $new_member )->store;
583 $data{borrowernumber
} = $patron->borrowernumber;
585 # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
586 # cronjob will use for syncing with NL
587 if ( exists $data{'borrowernumber'} && C4
::Context
->preference('NorwegianPatronDBEnable') && C4
::Context
->preference('NorwegianPatronDBEnable') == 1 ) {
588 Koha
::Database
->new->schema->resultset('BorrowerSync')->create({
589 'borrowernumber' => $data{'borrowernumber'},
590 'synctype' => 'norwegianpatrondb',
592 'syncstatus' => 'new',
593 'hashed_pin' => Koha
::NorwegianPatronDB
::NLEncryptPIN
( $plain_text_password ),
597 logaction
("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4
::Context
->preference("BorrowersLog");
599 $patron->add_enrolment_fee_if_needed;
601 return $data{borrowernumber
};
606 my $uniqueness = Check_Userid($userid,$borrowernumber);
608 $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 != '').
610 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.
613 0 for not unique (i.e. this $userid already exists)
614 1 for unique (i.e. this $userid does not exist, or this $userid/$borrowernumber combination already exists)
619 my ( $uid, $borrowernumber ) = @_;
621 return 0 unless ($uid); # userid is a unique column, we should assume NULL is not unique
623 return 0 if ( $uid eq C4
::Context
->config('user') );
625 my $rs = Koha
::Database
->new()->schema()->resultset('Borrower');
628 $params->{userid
} = $uid;
629 $params->{borrowernumber
} = { '!=' => $borrowernumber } if ($borrowernumber);
631 my $count = $rs->count( $params );
633 return $count ?
0 : 1;
636 =head2 Generate_Userid
638 my $newuid = Generate_Userid($borrowernumber, $firstname, $surname);
640 Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
642 $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.
645 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).
649 sub Generate_Userid
{
650 my ($borrowernumber, $firstname, $surname) = @_;
653 #The script will "do" the following code and increment the $offset until Check_Userid = 1 (i.e. until $newuid comes back as unique)
655 $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
656 $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
657 $newuid = lc(($firstname)?
"$firstname.$surname" : $surname);
658 $newuid = unac_string
('utf-8',$newuid);
659 $newuid .= $offset unless $offset == 0;
662 } while (!Check_Userid
($newuid,$borrowernumber));
667 =head2 fixup_cardnumber
669 Warning: The caller is responsible for locking the members table in write
670 mode, to avoid database corruption.
674 use vars
qw( @weightings );
675 my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
677 sub fixup_cardnumber {
678 my ($cardnumber) = @_;
679 my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;
681 # Find out whether member numbers should be generated
682 # automatically. Should be either "1" or something else.
683 # Defaults to "0", which is interpreted as "no".
685 # if ($cardnumber !~ /\S/ && $autonumber_members) {
686 ($autonumber_members) or return $cardnumber;
687 my $checkdigit = C4::Context->preference('checkdigit');
688 my $dbh = C4::Context->dbh;
689 if ( $checkdigit and $checkdigit eq 'katipo' ) {
691 # if checkdigit is selected, calculate katipo-style cardnumber.
692 # otherwise, just use the max()
693 # purpose: generate checksum'd member numbers.
694 # We'll assume we just got the max value of digits 2-8 of member #'s
695 # from the database and our job is to increment that by one,
696 # determine the 1st and 9th digits and return the full string.
697 my $sth = $dbh->prepare(
698 "select max(substring(borrowers.cardnumber,2,7)) as new_num from borrowers"
701 my $data = $sth->fetchrow_hashref;
702 $cardnumber = $data->{new_num};
703 if ( !$cardnumber ) { # If DB has no values,
704 $cardnumber = 1000000; # start at 1000000
710 for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
711 # read weightings, left to right, 1 char at a time
712 my $temp1 = $weightings[$i];
714 # sequence left to right, 1 char at a time
715 my $temp2 = substr( $cardnumber, $i, 1 );
717 # mult each char 1-7 by its corresponding weighting
718 $sum += $temp1 * $temp2;
721 my $rem = ( $sum % 11 );
722 $rem = 'X' if $rem == 10;
724 return "V$cardnumber$rem";
727 my $sth = $dbh->prepare(
728 'SELECT MAX( CAST( cardnumber AS SIGNED ) ) FROM borrowers WHERE cardnumber REGEXP "^-?[0-9]+$"'
731 my ($result) = $sth->fetchrow;
734 return $cardnumber; # just here as a fallback/reminder
737 =head2 GetPendingIssues
739 my $issues = &GetPendingIssues(@borrowernumber);
741 Looks up what the patron with the given borrowernumber has borrowed.
743 C<&GetPendingIssues> returns a
744 reference-to-array where each element is a reference-to-hash; the
745 keys are the fields from the C<issues>, C<biblio>, and C<items> tables.
746 The keys include C<biblioitems> fields except marc and marcxml.
750 sub GetPendingIssues {
751 my @borrowernumbers = @_;
753 unless (@borrowernumbers ) { # return a ref_to_array
754 return \@borrowernumbers; # to not cause surprise to caller
757 # Borrowers part of the query
759 for (my $i = 0; $i < @borrowernumbers; $i++) {
760 $bquery .= ' issues.borrowernumber = ?';
761 if ($i < $#borrowernumbers ) {
766 # must avoid biblioitems.* to prevent large marc and marcxml fields from killing performance
767 # FIXME: namespace collision: each table has "timestamp" fields. Which one is "timestamp" ?
768 # FIXME: circ/ciculation.pl tries to sort by timestamp!
769 # FIXME: namespace collision: other collisions possible.
770 # FIXME: most of this data isn't really being used by callers.
777 biblioitems.itemtype,
780 biblioitems.publicationyear,
781 biblioitems.publishercode,
782 biblioitems.volumedate,
783 biblioitems.volumedesc,
788 borrowers.cardnumber,
789 issues.timestamp AS timestamp,
790 issues.renewals AS renewals,
791 issues.borrowernumber AS borrowernumber,
792 items.renewals AS totalrenewals
794 LEFT JOIN items ON items.itemnumber = issues.itemnumber
795 LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
796 LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
797 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
800 ORDER BY issues.issuedate"
803 my $sth = C4::Context->dbh->prepare($query);
804 $sth->execute(@borrowernumbers);
805 my $data = $sth->fetchall_arrayref({});
806 my $today = dt_from_string;
808 if ($_->{issuedate}) {
809 $_->{issuedate} = dt_from_string($_->{issuedate}, 'sql');
811 $_->{date_due_sql} = $_->{date_due};
812 # FIXME no need to have this value
813 $_->{date_due} or next;
814 $_->{date_due_sql} = $_->{date_due};
815 # FIXME no need to have this value
816 $_->{date_due} = dt_from_string($_->{date_due}, 'sql');
817 if ( DateTime->compare($_->{date_due}, $today) == -1 ) {
826 $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
828 Looks up what the patron with the given borrowernumber has borrowed,
829 and sorts the results.
831 C<$sortkey> is the name of a field on which to sort the results. This
832 should be the name of a field in the C<issues>, C<biblio>,
833 C<biblioitems>, or C<items> table in the Koha database.
835 C<$limit> is the maximum number of results to return.
837 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
838 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
839 C<items> tables of the Koha database.
845 my ( $borrowernumber, $order, $limit ) = @_;
847 return unless $borrowernumber;
848 $order = 'date_due desc' unless $order;
850 my $dbh = C4::Context->dbh;
852 'SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
854 LEFT JOIN items on items.itemnumber=issues.itemnumber
855 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
856 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
857 WHERE borrowernumber=?
859 SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
861 LEFT JOIN items on items.itemnumber=old_issues.itemnumber
862 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
863 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
864 WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL
867 $query .= " limit $limit";
870 my $sth = $dbh->prepare($query);
871 $sth->execute( $borrowernumber, $borrowernumber );
872 return $sth->fetchall_arrayref( {} );
876 =head2 GetMemberAccountRecords
878 ($total, $acctlines, $count) = &GetMemberAccountRecords($borrowernumber);
880 Looks up accounting data for the patron with the given borrowernumber.
882 C<&GetMemberAccountRecords> returns a three-element array. C<$acctlines> is a
883 reference-to-array, where each element is a reference-to-hash; the
884 keys are the fields of the C<accountlines> table in the Koha database.
885 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
886 total amount outstanding for all of the account lines.
890 sub GetMemberAccountRecords {
891 my ($borrowernumber) = @_;
892 my $dbh = C4::Context->dbh;
898 WHERE borrowernumber=?);
899 $strsth.=" ORDER BY accountlines_id desc";
900 my $sth= $dbh->prepare( $strsth );
901 $sth->execute( $borrowernumber );
904 while ( my $data = $sth->fetchrow_hashref ) {
905 if ( $data->{itemnumber} ) {
906 my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
907 $data->{biblionumber} = $biblio->{biblionumber};
908 $data->{title} = $biblio->{title};
910 $acctlines[$numlines] = $data;
912 $total += sprintf "%.0f", 1000*$data->{amountoutstanding}; # convert float to integer to avoid round-off errors
915 return ( $total, \@acctlines,$numlines);
918 =head2 GetMemberAccountBalance
920 ($total_balance, $non_issue_balance, $other_charges) = &GetMemberAccountBalance($borrowernumber);
922 Calculates amount immediately owing by the patron - non-issue charges.
923 Based on GetMemberAccountRecords.
924 Charges exempt from non-issue are:
926 * Rent (rental) if RentalsInNoissuesCharge syspref is set to false
927 * Manual invoices if ManInvInNoissuesCharge syspref is set to false
931 sub GetMemberAccountBalance {
932 my ($borrowernumber) = @_;
934 my $ACCOUNT_TYPE_LENGTH = 5; # this is plain ridiculous...
937 push @not_fines, 'Res' unless C4::Context->preference('HoldsInNoissuesCharge');
938 push @not_fines, 'Rent' unless C4::Context->preference('RentalsInNoissuesCharge');
939 unless ( C4::Context->preference('ManInvInNoissuesCharge') ) {
940 my $dbh = C4::Context->dbh;
941 my $man_inv_types = $dbh->selectcol_arrayref(qq{SELECT authorised_value FROM authorised_values WHERE category = 'MANUAL_INV'});
942 push @not_fines, map substr($_, 0, $ACCOUNT_TYPE_LENGTH), @$man_inv_types;
944 my %not_fine = map {$_ => 1} @not_fines;
946 my ($total, $acctlines) = GetMemberAccountRecords($borrowernumber);
947 my $other_charges = 0;
948 foreach (@$acctlines) {
949 $other_charges += $_->{amountoutstanding} if $not_fine{ substr($_->{accounttype}, 0, $ACCOUNT_TYPE_LENGTH) };
952 return ( $total, $total - $other_charges, $other_charges);
955 =head2 GetBorNotifyAcctRecord
957 ($total, $acctlines, $count) = &GetBorNotifyAcctRecord($params,$notifyid);
959 Looks up accounting data for the patron with the given borrowernumber per file number.
961 C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a
962 reference-to-array, where each element is a reference-to-hash; the
963 keys are the fields of the C<accountlines> table in the Koha database.
964 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
965 total amount outstanding for all of the account lines.
969 sub GetBorNotifyAcctRecord {
970 my ( $borrowernumber, $notifyid ) = @_;
971 my $dbh = C4::Context->dbh;
974 my $sth = $dbh->prepare(
977 WHERE borrowernumber=?
979 AND amountoutstanding != '0'
980 ORDER BY notify_id,accounttype
983 $sth->execute( $borrowernumber, $notifyid );
985 while ( my $data = $sth->fetchrow_hashref ) {
986 if ( $data->{itemnumber} ) {
987 my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
988 $data->{biblionumber} = $biblio->{biblionumber};
989 $data->{title} = $biblio->{title};
991 $acctlines[$numlines] = $data;
993 $total += int(100 * $data->{'amountoutstanding'});
996 return ( $total, \@acctlines, $numlines );
999 sub checkcardnumber {
1000 my ( $cardnumber, $borrowernumber ) = @_;
1002 # If cardnumber is null, we assume they're allowed.
1003 return 0 unless defined $cardnumber;
1005 my $dbh = C4::Context->dbh;
1006 my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
1007 $query .= " AND borrowernumber <> ?" if ($borrowernumber);
1008 my $sth = $dbh->prepare($query);
1011 ( $borrowernumber ? $borrowernumber : () )
1014 return 1 if $sth->fetchrow_hashref;
1016 my ( $min_length, $max_length ) = get_cardnumber_length();
1018 if length $cardnumber > $max_length
1019 or length $cardnumber < $min_length;
1024 =head2 get_cardnumber_length
1026 my ($min, $max) = C4::Members::get_cardnumber_length()
1028 Returns the minimum and maximum length for patron cardnumbers as
1029 determined by the CardnumberLength system preference, the
1030 BorrowerMandatoryField system preference, and the width of the
1035 sub get_cardnumber_length {
1036 my ( $min, $max ) = ( 0, 16 ); # borrowers.cardnumber is a nullable varchar(16)
1037 $min = 1 if C4::Context->preference('BorrowerMandatoryField') =~ /cardnumber/;
1038 if ( my $cardnumber_length = C4::Context->preference('CardnumberLength') ) {
1039 # Is integer and length match
1040 if ( $cardnumber_length =~ m|^\d+$| ) {
1041 $min = $max = $cardnumber_length
1042 if $cardnumber_length >= $min
1043 and $cardnumber_length <= $max;
1045 # Else assuming it is a range
1046 elsif ( $cardnumber_length =~ m|(\d*),(\d*)| ) {
1047 $min = $1 if $1 and $min < $1;
1048 $max = $2 if $2 and $max > $2;
1052 my $borrower = Koha::Schema->resultset('Borrower');
1053 my $field_size = $borrower->result_source->column_info('cardnumber')->{size};
1054 $min = $field_size if $min > $field_size;
1055 return ( $min, $max );
1058 =head2 GetFirstValidEmailAddress
1060 $email = GetFirstValidEmailAddress($borrowernumber);
1062 Return the first valid email address for a borrower, given the borrowernumber. For now, the order
1063 is defined as email, emailpro, B_email. Returns the empty string if the borrower has no email
1068 sub GetFirstValidEmailAddress {
1069 my $borrowernumber = shift;
1070 my $dbh = C4::Context->dbh;
1071 my $sth = $dbh->prepare( "SELECT email, emailpro, B_email FROM borrowers where borrowernumber = ? ");
1072 $sth->execute( $borrowernumber );
1073 my $data = $sth->fetchrow_hashref;
1075 if ($data->{'email'}) {
1076 return $data->{'email'};
1077 } elsif ($data->{'emailpro'}) {
1078 return $data->{'emailpro'};
1079 } elsif ($data->{'B_email'}) {
1080 return $data->{'B_email'};
1086 =head2 GetNoticeEmailAddress
1088 $email = GetNoticeEmailAddress($borrowernumber);
1090 Return the email address of borrower used for notices, given the borrowernumber.
1091 Returns the empty string if no email address.
1095 sub GetNoticeEmailAddress {
1096 my $borrowernumber = shift;
1098 my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
1099 # if syspref is set to 'first valid' (value == OFF), look up email address
1100 if ( $which_address eq 'OFF' ) {
1101 return GetFirstValidEmailAddress($borrowernumber);
1103 # specified email address field
1104 my $dbh = C4::Context->dbh;
1105 my $sth = $dbh->prepare( qq{
1106 SELECT $which_address AS primaryemail
1108 WHERE borrowernumber=?
1110 $sth->execute($borrowernumber);
1111 my $data = $sth->fetchrow_hashref;
1112 return $data->{'primaryemail'} || '';
1115 =head2 GetUpcomingMembershipExpires
1117 my $expires = GetUpcomingMembershipExpires({
1118 branch => $branch, before => $before, after => $after,
1121 $branch is an optional branch code.
1122 $before/$after is an optional number of days before/after the date that
1123 is set by the preference MembershipExpiryDaysNotice.
1124 If the pref would be 14, before 2 and after 3, you will get all expires
1129 sub GetUpcomingMembershipExpires {
1130 my ( $params ) = @_;
1131 my $before = $params->{before} || 0;
1132 my $after = $params->{after} || 0;
1133 my $branch = $params->{branch};
1135 my $dbh = C4::Context->dbh;
1136 my $days = C4::Context->preference("MembershipExpiryDaysNotice") || 0;
1137 my $date1 = dt_from_string->add( days => $days - $before );
1138 my $date2 = dt_from_string->add( days => $days + $after );
1139 $date1= output_pref({ dt => $date1, dateformat => 'iso', dateonly => 1 });
1140 $date2= output_pref({ dt => $date2, dateformat => 'iso', dateonly => 1 });
1143 SELECT borrowers.*, categories.description,
1144 branches.branchname, branches.branchemail FROM borrowers
1145 LEFT JOIN branches USING (branchcode)
1146 LEFT JOIN categories USING (categorycode)
1149 $query.= 'WHERE branchcode=? AND dateexpiry BETWEEN ? AND ?';
1151 $query.= 'WHERE dateexpiry BETWEEN ? AND ?';
1154 my $sth = $dbh->prepare( $query );
1155 my @pars = $branch? ( $branch ): ();
1156 push @pars, $date1, $date2;
1157 $sth->execute( @pars );
1158 my $results = $sth->fetchall_arrayref( {} );
1162 =head2 GetBorrowersToExpunge
1164 $borrowers = &GetBorrowersToExpunge(
1165 not_borrowed_since => $not_borrowed_since,
1166 expired_before => $expired_before,
1167 category_code => $category_code,
1168 patron_list_id => $patron_list_id,
1169 branchcode => $branchcode
1172 This function get all borrowers based on the given criteria.
1176 sub GetBorrowersToExpunge {
1179 my $filterdate = $params->{'not_borrowed_since'};
1180 my $filterexpiry = $params->{'expired_before'};
1181 my $filterlastseen = $params->{'last_seen'};
1182 my $filtercategory = $params->{'category_code'};
1183 my $filterbranch = $params->{'branchcode'} ||
1184 ((C4::Context->preference('IndependentBranches')
1185 && C4::Context->userenv
1186 && !C4::Context->IsSuperLibrarian()
1187 && C4::Context->userenv->{branch})
1188 ? C4::Context->userenv->{branch}
1190 my $filterpatronlist = $params->{'patron_list_id'};
1192 my $dbh = C4::Context->dbh;
1194 SELECT borrowers.borrowernumber,
1195 MAX(old_issues.timestamp) AS latestissue,
1196 MAX(issues.timestamp) AS currentissue
1198 JOIN categories USING (categorycode)
1202 WHERE guarantorid IS NOT NULL
1203 AND guarantorid <> 0
1204 ) as tmp ON borrowers.borrowernumber=tmp.guarantorid
1205 LEFT JOIN old_issues USING (borrowernumber)
1206 LEFT JOIN issues USING (borrowernumber)|;
1207 if ( $filterpatronlist ){
1208 $query .= q| LEFT JOIN patron_list_patrons USING (borrowernumber)|;
1210 $query .= q| WHERE category_type <> 'S'
1211 AND tmp.guarantorid IS NULL
1214 if ( $filterbranch && $filterbranch ne "" ) {
1215 $query.= " AND borrowers.branchcode = ? ";
1216 push( @query_params, $filterbranch );
1218 if ( $filterexpiry ) {
1219 $query .= " AND dateexpiry < ? ";
1220 push( @query_params, $filterexpiry );
1222 if ( $filterlastseen ) {
1223 $query .= ' AND lastseen < ? ';
1224 push @query_params, $filterlastseen;
1226 if ( $filtercategory ) {
1227 $query .= " AND categorycode = ? ";
1228 push( @query_params, $filtercategory );
1230 if ( $filterpatronlist ){
1231 $query.=" AND patron_list_id = ? ";
1232 push( @query_params, $filterpatronlist );
1234 $query.=" GROUP BY borrowers.borrowernumber HAVING currentissue IS NULL ";
1235 if ( $filterdate ) {
1236 $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
1237 push @query_params,$filterdate;
1239 warn $query if $debug;
1241 my $sth = $dbh->prepare($query);
1242 if (scalar(@query_params)>0){
1243 $sth->execute(@query_params);
1250 while ( my $data = $sth->fetchrow_hashref ) {
1251 push @results, $data;
1256 =head2 GetBorrowersWhoHaveNeverBorrowed
1258 $results = &GetBorrowersWhoHaveNeverBorrowed
1260 This function get all borrowers who have never borrowed.
1262 I<$result> is a ref to an array which all elements are a hasref.
1266 sub GetBorrowersWhoHaveNeverBorrowed {
1267 my $filterbranch = shift ||
1268 ((C4::Context->preference('IndependentBranches')
1269 && C4::Context->userenv
1270 && !C4::Context->IsSuperLibrarian()
1271 && C4::Context->userenv->{branch})
1272 ? C4::Context->userenv->{branch}
1274 my $dbh = C4::Context->dbh;
1276 SELECT borrowers.borrowernumber,max(timestamp) as latestissue
1278 LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
1279 WHERE issues.borrowernumber IS NULL
1282 if ($filterbranch && $filterbranch ne ""){
1283 $query.=" AND borrowers.branchcode= ?";
1284 push @query_params,$filterbranch;
1286 warn $query if $debug;
1288 my $sth = $dbh->prepare($query);
1289 if (scalar(@query_params)>0){
1290 $sth->execute(@query_params);
1297 while ( my $data = $sth->fetchrow_hashref ) {
1298 push @results, $data;
1303 =head2 GetBorrowersWithIssuesHistoryOlderThan
1305 $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
1307 this function get all borrowers who has an issue history older than I<$date> given on input arg.
1309 I<$result> is a ref to an array which all elements are a hashref.
1310 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
1314 sub GetBorrowersWithIssuesHistoryOlderThan {
1315 my $dbh = C4::Context->dbh;
1316 my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
1317 my $filterbranch = shift ||
1318 ((C4::Context->preference('IndependentBranches')
1319 && C4::Context->userenv
1320 && !C4::Context->IsSuperLibrarian()
1321 && C4::Context->userenv->{branch})
1322 ? C4::Context->userenv->{branch}
1325 SELECT count(borrowernumber) as n,borrowernumber
1327 WHERE returndate < ?
1328 AND borrowernumber IS NOT NULL
1331 push @query_params, $date;
1333 $query.=" AND branchcode = ?";
1334 push @query_params, $filterbranch;
1336 $query.=" GROUP BY borrowernumber ";
1337 warn $query if $debug;
1338 my $sth = $dbh->prepare($query);
1339 $sth->execute(@query_params);
1342 while ( my $data = $sth->fetchrow_hashref ) {
1343 push @results, $data;
1350 IssueSlip($branchcode, $borrowernumber, $quickslip)
1352 Returns letter hash ( see C4::Letters::GetPreparedLetter )
1354 $quickslip is boolean, to indicate whether we want a quick slip
1356 IssueSlip populates ISSUESLIP and ISSUEQSLIP, and will make the following expansions:
1392 NOTE: Not all table fields are available, pleasee see GetPendingIssues for a list of available fields.
1397 my ($branch, $borrowernumber, $quickslip) = @_;
1399 # FIXME Check callers before removing this statement
1400 #return unless $borrowernumber;
1402 my @issues = @{ GetPendingIssues($borrowernumber) };
1404 for my $issue (@issues) {
1405 $issue->{date_due} = $issue->{date_due_sql};
1407 my $today = output_pref({ dt => dt_from_string, dateformat => 'iso', dateonly => 1 });
1408 if ( substr( $issue->{issuedate}, 0, 10 ) eq $today
1409 or substr( $issue->{lastreneweddate}, 0, 10 ) eq $today ) {
1415 # Sort on timestamp then on issuedate (useful for tests and could be if modified in a batch
1417 my $s = $b->{timestamp} <=> $a->{timestamp};
1419 $b->{issuedate} <=> $a->{issuedate} : $s;
1422 my ($letter_code, %repeat);
1424 $letter_code = 'ISSUEQSLIP';
1426 'checkedout' => [ map {
1429 'biblioitems' => $_,
1431 }, grep { $_->{'now
'} } @issues ],
1435 $letter_code = 'ISSUESLIP
';
1437 'checkedout
' => [ map {
1440 'biblioitems
' => $_,
1442 }, grep { !$_->{'overdue
'} } @issues ],
1444 'overdue
' => [ map {
1447 'biblioitems
' => $_,
1449 }, grep { $_->{'overdue
'} } @issues ],
1452 $_->{'timestamp
'} = $_->{'newdate
'};
1454 } @{ GetNewsToDisplay("slip",$branch) } ],
1458 return C4::Letters::GetPreparedLetter (
1459 module => 'circulation
',
1460 letter_code => $letter_code,
1461 branchcode => $branch,
1463 'branches
' => $branch,
1464 'borrowers
' => $borrowernumber,
1470 =head2 GetBorrowersWithEmail
1472 ([$borrnum,$userid], ...) = GetBorrowersWithEmail('me
@example.com
');
1474 This gets a list of users and their basic details from their email address.
1475 As it's possible
for multiple user to have the same email address
, it provides
1476 you with all of them
. If there is
no userid
for the user
, there will be an
1477 C
<undef> there
. An empty list will be returned
if there are
no matches
.
1481 sub GetBorrowersWithEmail
{
1484 my $dbh = C4
::Context
->dbh;
1486 my $query = "SELECT borrowernumber, userid FROM borrowers WHERE email=?";
1487 my $sth=$dbh->prepare($query);
1488 $sth->execute($email);
1490 while (my $ref = $sth->fetch) {
1493 die "Failure searching for borrowers by email address: $sth->errstr" if $sth->err;
1497 =head2 AddMember_Opac
1501 sub AddMember_Opac
{
1502 my ( %borrower ) = @_;
1504 $borrower{'categorycode'} //= C4
::Context
->preference('PatronSelfRegistrationDefaultCategory');
1505 if (not defined $borrower{'password'}){
1506 my $sr = new String
::Random
;
1507 $sr->{'A'} = [ 'A'..'Z', 'a'..'z' ];
1508 my $password = $sr->randpattern("AAAAAAAAAA");
1509 $borrower{'password'} = $password;
1512 $borrower{'cardnumber'} = fixup_cardnumber
( $borrower{'cardnumber'} );
1514 my $borrowernumber = AddMember
(%borrower);
1516 return ( $borrowernumber, $borrower{'password'} );
1519 =head2 DeleteExpiredOpacRegistrations
1521 Delete accounts that haven't been upgraded from the 'temporary' category
1522 Returns the number of removed patrons
1526 sub DeleteExpiredOpacRegistrations
{
1528 my $delay = C4
::Context
->preference('PatronSelfRegistrationExpireTemporaryAccountsDelay');
1529 my $category_code = C4
::Context
->preference('PatronSelfRegistrationDefaultCategory');
1531 return 0 if not $category_code or not defined $delay or $delay eq q
||;
1534 SELECT borrowernumber
1536 WHERE categorycode
= ? AND DATEDIFF
( NOW
(), dateenrolled
) > ?
|;
1538 my $dbh = C4
::Context
->dbh;
1539 my $sth = $dbh->prepare($query);
1540 $sth->execute( $category_code, $delay );
1542 while ( my ($borrowernumber) = $sth->fetchrow_array() ) {
1543 Koha
::Patrons
->find($borrowernumber)->delete;
1549 =head2 DeleteUnverifiedOpacRegistrations
1551 Delete all unverified self registrations in borrower_modifications,
1552 older than the specified number of days.
1556 sub DeleteUnverifiedOpacRegistrations
{
1558 my $dbh = C4
::Context
->dbh;
1560 DELETE FROM borrower_modifications
1561 WHERE borrowernumber
= 0 AND DATEDIFF
( NOW
(), timestamp
) > ?
|;
1562 my $cnt=$dbh->do($sql, undef, ($days) );
1563 return $cnt eq '0E0'?
0: $cnt;
1566 sub GetOverduesForPatron
{
1567 my ( $borrowernumber ) = @_;
1571 FROM issues, items, biblio, biblioitems
1572 WHERE items.itemnumber=issues.itemnumber
1573 AND biblio.biblionumber = items.biblionumber
1574 AND biblio.biblionumber = biblioitems.biblionumber
1575 AND issues.borrowernumber = ?
1576 AND date_due < NOW()
1579 my $sth = C4
::Context
->dbh->prepare( $sql );
1580 $sth->execute( $borrowernumber );
1582 return $sth->fetchall_arrayref({});
1585 END { } # module clean-up code here (global destructor)