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,
136 C<$borrower-E<gt>{flags}> is a hash giving more detailed information
137 about the patron. Its keys act as flags :
139 if $borrower->{flags}->{LOST} {
140 # Patron's card was reported lost
143 If the state of a flag means that the patron should not be
144 allowed to borrow any more books, then it will have a C<noissues> key
147 See patronflags for more details.
149 C<$borrower-E<gt>{authflags}> is a hash giving more detailed information
150 about the top-level permissions flags set for the borrower. For example,
151 if a user has the "editcatalogue" permission,
152 C<$borrower-E<gt>{authflags}-E<gt>{editcatalogue}> will exist and have
157 sub GetMemberDetails {
158 my ( $borrowernumber, $cardnumber ) = @_;
159 my $dbh = C4::Context->dbh;
162 if ($borrowernumber) {
163 $sth = $dbh->prepare("
166 categories.description,
170 LEFT JOIN categories ON borrowers.categorycode=categories.categorycode
171 WHERE borrowernumber = ?
173 $sth->execute($borrowernumber);
175 elsif ($cardnumber) {
176 $sth = $dbh->prepare("
179 categories.description,
183 LEFT JOIN categories ON borrowers.categorycode = categories.categorycode
186 $sth->execute($cardnumber);
191 my $borrower = $sth->fetchrow_hashref;
192 return unless $borrower;
193 my ($amount) = GetMemberAccountRecords($borrower->{borrowernumber});
194 $borrower->{'amountoutstanding'} = $amount;
195 # FIXME - patronflags calls GetMemberAccountRecords... just have patronflags return $amount
196 my $flags = patronflags( $borrower);
199 $sth = $dbh->prepare("select bit,flag from userflags");
201 while ( my ( $bit, $flag ) = $sth->fetchrow ) {
202 if ( $borrower->{'flags'} && $borrower->{'flags'} & 2**$bit ) {
203 $accessflagshash->{$flag} = 1;
206 $borrower->{'flags'} = $flags;
207 $borrower->{'authflags'} = $accessflagshash;
209 $borrower->{'is_expired'} = 0;
210 $borrower->{'is_expired'} = 1 if
211 defined($borrower->{dateexpiry}) &&
212 $borrower->{'dateexpiry'} ne '0000-00-00' &&
213 Date_to_Days( Today() ) >
214 Date_to_Days( split /-/, $borrower->{'dateexpiry'} );
216 return ($borrower); #, $flags, $accessflagshash);
221 $flags = &patronflags($patron);
223 This function is not exported.
225 The following will be set where applicable:
226 $flags->{CHARGES}->{amount} Amount of debt
227 $flags->{CHARGES}->{noissues} Set if debt amount >$5.00 (or syspref noissuescharge)
228 $flags->{CHARGES}->{message} Message -- deprecated
230 $flags->{CREDITS}->{amount} Amount of credit
231 $flags->{CREDITS}->{message} Message -- deprecated
233 $flags->{ GNA } Patron has no valid address
234 $flags->{ GNA }->{noissues} Set for each GNA
235 $flags->{ GNA }->{message} "Borrower has no valid address" -- deprecated
237 $flags->{ LOST } Patron's card reported lost
238 $flags->{ LOST }->{noissues} Set for each LOST
239 $flags->{ LOST }->{message} Message -- deprecated
241 $flags->{DBARRED} Set if patron debarred, no access
242 $flags->{DBARRED}->{noissues} Set for each DBARRED
243 $flags->{DBARRED}->{message} Message -- deprecated
246 $flags->{ NOTES }->{message} The note itself. NOT deprecated
248 $flags->{ ODUES } Set if patron has overdue books.
249 $flags->{ ODUES }->{message} "Yes" -- deprecated
250 $flags->{ ODUES }->{itemlist} ref-to-array: list of overdue books
251 $flags->{ ODUES }->{itemlisttext} Text list of overdue items -- deprecated
253 $flags->{WAITING} Set if any of patron's reserves are available
254 $flags->{WAITING}->{message} Message -- deprecated
255 $flags->{WAITING}->{itemlist} ref-to-array: list of available items
259 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
260 overdue items. Its elements are references-to-hash, each describing an
261 overdue item. The keys are selected fields from the issues, biblio,
262 biblioitems, and items tables of the Koha database.
264 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
265 the overdue items, one per line. Deprecated.
267 =item C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
268 available items. Each element is a reference-to-hash whose keys are
269 fields from the reserves table of the Koha database.
273 All the "message" fields that include language generated in this function are deprecated,
274 because such strings belong properly in the display layer.
276 The "message" field that comes from the DB is OK.
280 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
281 # FIXME rename this function.
284 my ( $patroninformation) = @_;
285 my $dbh=C4::Context->dbh;
286 my ($balance, $owing) = GetMemberAccountBalance( $patroninformation->{'borrowernumber'});
289 my $noissuescharge = C4::Context->preference("noissuescharge") || 5;
290 $flaginfo{'message'} = sprintf 'Patron owes %.02f', $owing;
291 $flaginfo{'amount'} = sprintf "%.02f", $owing;
292 if ( $owing > $noissuescharge && !C4::Context->preference("AllowFineOverride") ) {
293 $flaginfo{'noissues'} = 1;
295 $flags{'CHARGES'} = \%flaginfo;
297 elsif ( $balance < 0 ) {
299 $flaginfo{'message'} = sprintf 'Patron has credit of %.02f', -$balance;
300 $flaginfo{'amount'} = sprintf "%.02f", $balance;
301 $flags{'CREDITS'} = \%flaginfo;
304 # Check the debt of the guarntees of this patron
305 my $no_issues_charge_guarantees = C4::Context->preference("NoIssuesChargeGuarantees");
306 $no_issues_charge_guarantees = undef unless looks_like_number( $no_issues_charge_guarantees );
307 if ( defined $no_issues_charge_guarantees ) {
308 my $p = Koha::Patrons->find( $patroninformation->{borrowernumber} );
309 my @guarantees = $p->guarantees();
310 my $guarantees_non_issues_charges;
311 foreach my $g ( @guarantees ) {
312 my ( $b, $n, $o ) = C4::Members::GetMemberAccountBalance( $g->id );
313 $guarantees_non_issues_charges += $n;
316 if ( $guarantees_non_issues_charges > $no_issues_charge_guarantees ) {
318 $flaginfo{'message'} = sprintf 'patron guarantees owe %.02f', $guarantees_non_issues_charges;
319 $flaginfo{'amount'} = $guarantees_non_issues_charges;
320 $flaginfo{'noissues'} = 1 unless C4::Context->preference("allowfineoverride");
321 $flags{'CHARGES_GUARANTEES'} = \%flaginfo;
325 if ( $patroninformation->{'gonenoaddress'}
326 && $patroninformation->{'gonenoaddress'} == 1 )
329 $flaginfo{'message'} = 'Borrower has no valid address.';
330 $flaginfo{'noissues'} = 1;
331 $flags{'GNA'} = \%flaginfo;
333 if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
335 $flaginfo{'message'} = 'Borrower\'s card reported lost.';
336 $flaginfo{'noissues'} = 1;
337 $flags{'LOST'} = \%flaginfo;
339 if ( $patroninformation->{'debarred'} && check_date( split( /-/, $patroninformation->{'debarred'} ) ) ) {
340 if ( Date_to_Days(Date::Calc::Today) < Date_to_Days( split( /-/, $patroninformation->{'debarred'} ) ) ) {
342 $flaginfo{'debarredcomment'} = $patroninformation->{'debarredcomment'};
343 $flaginfo{'message'} = $patroninformation->{'debarredcomment'};
344 $flaginfo{'noissues'} = 1;
345 $flaginfo{'dateend'} = $patroninformation->{'debarred'};
346 $flags{'DBARRED'} = \%flaginfo;
349 if ( $patroninformation->{'borrowernotes'}
350 && $patroninformation->{'borrowernotes'} )
353 $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
354 $flags{'NOTES'} = \%flaginfo;
356 my ( $odues, $itemsoverdue ) = C4::Overdues::checkoverdues($patroninformation->{'borrowernumber'});
357 if ( $odues && $odues > 0 ) {
359 $flaginfo{'message'} = "Yes";
360 $flaginfo{'itemlist'} = $itemsoverdue;
361 foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
364 $flaginfo{'itemlisttext'} .=
365 "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n"; # newline is display layer
367 $flags{'ODUES'} = \%flaginfo;
369 my @itemswaiting = C4::Reserves::GetReservesFromBorrowernumber( $patroninformation->{'borrowernumber'},'W' );
370 my $nowaiting = scalar @itemswaiting;
371 if ( $nowaiting > 0 ) {
373 $flaginfo{'message'} = "Reserved items available";
374 $flaginfo{'itemlist'} = \@itemswaiting;
375 $flags{'WAITING'} = \%flaginfo;
383 $borrower = &GetMember(%information);
385 Retrieve the first patron record meeting on criteria listed in the
386 C<%information> hash, which should contain one or more
387 pairs of borrowers column names and values, e.g.,
389 $borrower = GetMember(borrowernumber => id);
391 C<&GetBorrower> returns a reference-to-hash whose keys are the fields of
392 the C<borrowers> table in the Koha database.
394 FIXME: GetMember() is used throughout the code as a lookup
395 on a unique key such as the borrowernumber, but this meaning is not
396 enforced in the routine itself.
402 my ( %information ) = @_;
403 if (exists $information{borrowernumber} && !defined $information{borrowernumber}) {
404 #passing mysql's kohaadmin?? Makes no sense as a query
407 my $dbh = C4::Context->dbh;
409 q{SELECT borrowers.*, categories.category_type, categories.description
411 LEFT JOIN categories on borrowers.categorycode=categories.categorycode WHERE };
414 for (keys %information ) {
422 if (defined $information{$_}) {
424 push @values, $information{$_};
427 $select .= "$_ IS NULL";
430 $debug && warn $select, " ",values %information;
431 my $sth = $dbh->prepare("$select");
432 $sth->execute(@values);
433 my $data = $sth->fetchall_arrayref({});
434 #FIXME interface to this routine now allows generation of a result set
435 #so whole array should be returned but bowhere in the current code expects this
443 =head2 GetMemberIssuesAndFines
445 ($overdue_count, $issue_count, $total_fines) = &GetMemberIssuesAndFines($borrowernumber);
447 Returns aggregate data about items borrowed by the patron with the
448 given borrowernumber.
450 C<&GetMemberIssuesAndFines> returns a three-element array. C<$overdue_count> is the
451 number of overdue items the patron currently has borrowed. C<$issue_count> is the
452 number of books the patron currently has borrowed. C<$total_fines> is
453 the total fine currently due by the borrower.
458 sub GetMemberIssuesAndFines {
459 my ( $borrowernumber ) = @_;
460 my $dbh = C4::Context->dbh;
461 my $query = "SELECT COUNT(*) FROM issues WHERE borrowernumber = ?";
463 $debug and warn $query."\n";
464 my $sth = $dbh->prepare($query);
465 $sth->execute($borrowernumber);
466 my $issue_count = $sth->fetchrow_arrayref->[0];
468 $sth = $dbh->prepare(
469 "SELECT COUNT(*) FROM issues
470 WHERE borrowernumber = ?
471 AND date_due < now()"
473 $sth->execute($borrowernumber);
474 my $overdue_count = $sth->fetchrow_arrayref->[0];
476 $sth = $dbh->prepare("SELECT SUM(amountoutstanding) FROM accountlines WHERE borrowernumber = ?");
477 $sth->execute($borrowernumber);
478 my $total_fines = $sth->fetchrow_arrayref->[0];
480 return ($overdue_count, $issue_count, $total_fines);
486 my $success = ModMember(borrowernumber => $borrowernumber,
487 [ field => value ]... );
489 Modify borrower's data. All date fields should ALREADY be in ISO format.
492 true on success, or false on failure
498 # test to know if you must update or not the borrower password
499 if (exists $data{password}) {
500 if ($data{password} eq '****' or $data{password} eq '') {
501 delete $data{password};
503 if ( C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
504 # Update the hashed PIN in borrower_sync.hashed_pin, before Koha hashes it
505 Koha::NorwegianPatronDB::NLUpdateHashedPIN( $data{'borrowernumber'}, $data{password} );
507 $data{password} = hash_password($data{password});
511 my $old_categorycode = Koha::Patrons->find( $data{borrowernumber} )->categorycode;
513 # get only the columns of a borrower
514 my $schema = Koha::Database->new()->schema;
515 my @columns = $schema->source('Borrower')->columns;
516 my $new_borrower = { map { join(' ', @columns) =~ /$_/ ? ( $_ => $data{$_} ) : () } keys(%data) };
517 delete $new_borrower->{flags};
519 $new_borrower->{dateofbirth} ||= undef if exists $new_borrower->{dateofbirth};
520 $new_borrower->{dateenrolled} ||= undef if exists $new_borrower->{dateenrolled};
521 $new_borrower->{dateexpiry} ||= undef if exists $new_borrower->{dateexpiry};
522 $new_borrower->{debarred} ||= undef if exists $new_borrower->{debarred};
523 $new_borrower->{sms_provider_id} ||= undef if exists $new_borrower->{sms_provider_id};
524 $new_borrower->{guarantorid} ||= undef if exists $new_borrower->{guarantorid};
526 my $patron = Koha::Patrons->find( $new_borrower->{borrowernumber} );
528 delete $new_borrower->{userid} if exists $new_borrower->{userid} and not $new_borrower->{userid};
530 my $execute_success = $patron->store if $patron->set($new_borrower);
532 if ($execute_success) { # only proceed if the update was a success
533 # If the patron changes to a category with enrollment fee, we add a fee
534 if ( $data{categorycode} and $data{categorycode} ne $old_categorycode ) {
535 if ( C4::Context->preference('FeeOnChangePatronCategory') ) {
536 $patron->add_enrolment_fee_if_needed;
540 # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
541 # cronjob will use for syncing with NL
542 if ( C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
543 my $borrowersync = Koha::Database->new->schema->resultset('BorrowerSync')->find({
544 'synctype' => 'norwegianpatrondb',
545 'borrowernumber' => $data{'borrowernumber'}
547 # Do not set to "edited" if syncstatus is "new". We need to sync as new before
548 # we can sync as changed. And the "new sync" will pick up all changes since
549 # the patron was created anyway.
550 if ( $borrowersync->syncstatus ne 'new' && $borrowersync->syncstatus ne 'delete' ) {
551 $borrowersync->update( { 'syncstatus' => 'edited' } );
553 # Set the value of 'sync'
554 $borrowersync->update( { 'sync' => $data{'sync'} } );
555 # Try to do the live sync
556 Koha::NorwegianPatronDB::NLSync({ 'borrowernumber' => $data{'borrowernumber'} });
559 logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "UPDATE (executed w/ arg: $data{'borrowernumber'})") if C4::Context->preference("BorrowersLog");
561 return $execute_success;
566 $borrowernumber = &AddMember(%borrower);
568 insert new borrower into table
570 (%borrower keys are database columns. Database columns could be
571 different in different versions. Please look into database for correct
574 Returns the borrowernumber upon success
576 Returns as undef upon any db error without further processing
583 my $dbh = C4::Context->dbh;
584 my $schema = Koha::Database->new()->schema;
586 # generate a proper login if none provided
587 $data{'userid'} = Generate_Userid( $data{'borrowernumber'}, $data{'firstname'}, $data{'surname'} )
588 if ( $data{'userid'} eq '' || !Check_Userid( $data{'userid'} ) );
590 # add expiration date if it isn't already there
591 $data{dateexpiry} ||= Koha::Patron::Categories->find( $data{categorycode} )->get_expiry_date;
593 # add enrollment date if it isn't already there
594 unless ( $data{'dateenrolled'} ) {
595 $data{'dateenrolled'} = output_pref( { dt => dt_from_string, dateonly => 1, dateformat => 'iso' } );
598 my $patron_category = $schema->resultset('Category')->find( $data{'categorycode'} );
600 $patron_category->default_privacy() eq 'default' ? 1
601 : $patron_category->default_privacy() eq 'never' ? 2
602 : $patron_category->default_privacy() eq 'forever' ? 0
605 $data{'privacy_guarantor_checkouts'} = 0 unless defined( $data{'privacy_guarantor_checkouts'} );
607 # Make a copy of the plain text password for later use
608 my $plain_text_password = $data{'password'};
610 # create a disabled account if no password provided
611 $data{'password'} = ($data{'password'})? hash_password($data{'password'}) : '!';
613 # we don't want invalid dates in the db (mysql has a bad habit of inserting 0000-00-00
614 $data{'dateofbirth'} = undef if ( not $data{'dateofbirth'} );
615 $data{'debarred'} = undef if ( not $data{'debarred'} );
616 $data{'sms_provider_id'} = undef if ( not $data{'sms_provider_id'} );
618 # get only the columns of Borrower
619 # FIXME Do we really need this check?
620 my @columns = $schema->source('Borrower')->columns;
621 my $new_member = { map { join(' ',@columns) =~ /$_/ ? ( $_ => $data{$_} ) : () } keys(%data) } ;
623 delete $new_member->{borrowernumber};
625 my $patron = Koha::Patron->new( $new_member )->store;
626 $data{borrowernumber} = $patron->borrowernumber;
628 # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
629 # cronjob will use for syncing with NL
630 if ( exists $data{'borrowernumber'} && C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
631 Koha::Database->new->schema->resultset('BorrowerSync')->create({
632 'borrowernumber' => $data{'borrowernumber'},
633 'synctype' => 'norwegianpatrondb',
635 'syncstatus' => 'new',
636 'hashed_pin' => Koha::NorwegianPatronDB::NLEncryptPIN( $plain_text_password ),
640 logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
642 $patron->add_enrolment_fee_if_needed;
644 return $data{borrowernumber};
649 my $uniqueness = Check_Userid($userid,$borrowernumber);
651 $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 != '').
653 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.
656 0 for not unique (i.e. this $userid already exists)
657 1 for unique (i.e. this $userid does not exist, or this $userid/$borrowernumber combination already exists)
662 my ( $uid, $borrowernumber ) = @_;
664 return 0 unless ($uid); # userid is a unique column, we should assume NULL is not unique
666 return 0 if ( $uid eq C4::Context->config('user') );
668 my $rs = Koha::Database->new()->schema()->resultset('Borrower');
671 $params->{userid} = $uid;
672 $params->{borrowernumber} = { '!=' => $borrowernumber } if ($borrowernumber);
674 my $count = $rs->count( $params );
676 return $count ? 0 : 1;
679 =head2 Generate_Userid
681 my $newuid = Generate_Userid($borrowernumber, $firstname, $surname);
683 Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
685 $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.
688 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).
692 sub Generate_Userid {
693 my ($borrowernumber, $firstname, $surname) = @_;
696 #The script will "do" the following code and increment the $offset until Check_Userid = 1 (i.e. until $newuid comes back as unique)
698 $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
699 $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
700 $newuid = lc(($firstname)? "$firstname.$surname" : $surname);
701 $newuid = unac_string('utf-8',$newuid);
702 $newuid .= $offset unless $offset == 0;
705 } while (!Check_Userid($newuid,$borrowernumber));
710 =head2 fixup_cardnumber
712 Warning: The caller is responsible for locking the members table in write
713 mode, to avoid database corruption.
717 use vars qw( @weightings );
718 my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
720 sub fixup_cardnumber {
721 my ($cardnumber) = @_;
722 my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;
724 # Find out whether member numbers should be generated
725 # automatically. Should be either "1" or something else.
726 # Defaults to "0", which is interpreted as "no".
728 # if ($cardnumber !~ /\S/ && $autonumber_members) {
729 ($autonumber_members) or return $cardnumber;
730 my $checkdigit = C4::Context->preference('checkdigit');
731 my $dbh = C4::Context->dbh;
732 if ( $checkdigit and $checkdigit eq 'katipo' ) {
734 # if checkdigit is selected, calculate katipo-style cardnumber.
735 # otherwise, just use the max()
736 # purpose: generate checksum'd member numbers.
737 # We'll assume we just got the max value of digits 2-8 of member #'s
738 # from the database and our job is to increment that by one,
739 # determine the 1st and 9th digits and return the full string.
740 my $sth = $dbh->prepare(
741 "select max(substring(borrowers.cardnumber,2,7)) as new_num from borrowers"
744 my $data = $sth->fetchrow_hashref;
745 $cardnumber = $data->{new_num};
746 if ( !$cardnumber ) { # If DB has no values,
747 $cardnumber = 1000000; # start at 1000000
753 for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
754 # read weightings, left to right, 1 char at a time
755 my $temp1 = $weightings[$i];
757 # sequence left to right, 1 char at a time
758 my $temp2 = substr( $cardnumber, $i, 1 );
760 # mult each char 1-7 by its corresponding weighting
761 $sum += $temp1 * $temp2;
764 my $rem = ( $sum % 11 );
765 $rem = 'X' if $rem == 10;
767 return "V$cardnumber$rem";
770 my $sth = $dbh->prepare(
771 'SELECT MAX( CAST( cardnumber AS SIGNED ) ) FROM borrowers WHERE cardnumber REGEXP "^-?[0-9]+$"'
774 my ($result) = $sth->fetchrow;
777 return $cardnumber; # just here as a fallback/reminder
780 =head2 GetPendingIssues
782 my $issues = &GetPendingIssues(@borrowernumber);
784 Looks up what the patron with the given borrowernumber has borrowed.
786 C<&GetPendingIssues> returns a
787 reference-to-array where each element is a reference-to-hash; the
788 keys are the fields from the C<issues>, C<biblio>, and C<items> tables.
789 The keys include C<biblioitems> fields except marc and marcxml.
793 sub GetPendingIssues {
794 my @borrowernumbers = @_;
796 unless (@borrowernumbers ) { # return a ref_to_array
797 return \@borrowernumbers; # to not cause surprise to caller
800 # Borrowers part of the query
802 for (my $i = 0; $i < @borrowernumbers; $i++) {
803 $bquery .= ' issues.borrowernumber = ?';
804 if ($i < $#borrowernumbers ) {
809 # must avoid biblioitems.* to prevent large marc and marcxml fields from killing performance
810 # FIXME: namespace collision: each table has "timestamp" fields. Which one is "timestamp" ?
811 # FIXME: circ/ciculation.pl tries to sort by timestamp!
812 # FIXME: namespace collision: other collisions possible.
813 # FIXME: most of this data isn't really being used by callers.
820 biblioitems.itemtype,
823 biblioitems.publicationyear,
824 biblioitems.publishercode,
825 biblioitems.volumedate,
826 biblioitems.volumedesc,
831 borrowers.cardnumber,
832 issues.timestamp AS timestamp,
833 issues.renewals AS renewals,
834 issues.borrowernumber AS borrowernumber,
835 items.renewals AS totalrenewals
837 LEFT JOIN items ON items.itemnumber = issues.itemnumber
838 LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
839 LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
840 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
843 ORDER BY issues.issuedate"
846 my $sth = C4::Context->dbh->prepare($query);
847 $sth->execute(@borrowernumbers);
848 my $data = $sth->fetchall_arrayref({});
849 my $today = dt_from_string;
851 if ($_->{issuedate}) {
852 $_->{issuedate} = dt_from_string($_->{issuedate}, 'sql');
854 $_->{date_due_sql} = $_->{date_due};
855 # FIXME no need to have this value
856 $_->{date_due} or next;
857 $_->{date_due_sql} = $_->{date_due};
858 # FIXME no need to have this value
859 $_->{date_due} = dt_from_string($_->{date_due}, 'sql');
860 if ( DateTime->compare($_->{date_due}, $today) == -1 ) {
869 $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
871 Looks up what the patron with the given borrowernumber has borrowed,
872 and sorts the results.
874 C<$sortkey> is the name of a field on which to sort the results. This
875 should be the name of a field in the C<issues>, C<biblio>,
876 C<biblioitems>, or C<items> table in the Koha database.
878 C<$limit> is the maximum number of results to return.
880 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
881 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
882 C<items> tables of the Koha database.
888 my ( $borrowernumber, $order, $limit ) = @_;
890 return unless $borrowernumber;
891 $order = 'date_due desc' unless $order;
893 my $dbh = C4::Context->dbh;
895 'SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
897 LEFT JOIN items on items.itemnumber=issues.itemnumber
898 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
899 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
900 WHERE borrowernumber=?
902 SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
904 LEFT JOIN items on items.itemnumber=old_issues.itemnumber
905 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
906 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
907 WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL
910 $query .= " limit $limit";
913 my $sth = $dbh->prepare($query);
914 $sth->execute( $borrowernumber, $borrowernumber );
915 return $sth->fetchall_arrayref( {} );
919 =head2 GetMemberAccountRecords
921 ($total, $acctlines, $count) = &GetMemberAccountRecords($borrowernumber);
923 Looks up accounting data for the patron with the given borrowernumber.
925 C<&GetMemberAccountRecords> returns a three-element array. C<$acctlines> is a
926 reference-to-array, where each element is a reference-to-hash; the
927 keys are the fields of the C<accountlines> table in the Koha database.
928 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
929 total amount outstanding for all of the account lines.
933 sub GetMemberAccountRecords {
934 my ($borrowernumber) = @_;
935 my $dbh = C4::Context->dbh;
941 WHERE borrowernumber=?);
942 $strsth.=" ORDER BY accountlines_id desc";
943 my $sth= $dbh->prepare( $strsth );
944 $sth->execute( $borrowernumber );
947 while ( my $data = $sth->fetchrow_hashref ) {
948 if ( $data->{itemnumber} ) {
949 my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
950 $data->{biblionumber} = $biblio->{biblionumber};
951 $data->{title} = $biblio->{title};
953 $acctlines[$numlines] = $data;
955 $total += sprintf "%.0f", 1000*$data->{amountoutstanding}; # convert float to integer to avoid round-off errors
958 return ( $total, \@acctlines,$numlines);
961 =head2 GetMemberAccountBalance
963 ($total_balance, $non_issue_balance, $other_charges) = &GetMemberAccountBalance($borrowernumber);
965 Calculates amount immediately owing by the patron - non-issue charges.
966 Based on GetMemberAccountRecords.
967 Charges exempt from non-issue are:
969 * Rent (rental) if RentalsInNoissuesCharge syspref is set to false
970 * Manual invoices if ManInvInNoissuesCharge syspref is set to false
974 sub GetMemberAccountBalance {
975 my ($borrowernumber) = @_;
977 my $ACCOUNT_TYPE_LENGTH = 5; # this is plain ridiculous...
980 push @not_fines, 'Res' unless C4::Context->preference('HoldsInNoissuesCharge');
981 push @not_fines, 'Rent' unless C4::Context->preference('RentalsInNoissuesCharge');
982 unless ( C4::Context->preference('ManInvInNoissuesCharge') ) {
983 my $dbh = C4::Context->dbh;
984 my $man_inv_types = $dbh->selectcol_arrayref(qq{SELECT authorised_value FROM authorised_values WHERE category = 'MANUAL_INV'});
985 push @not_fines, map substr($_, 0, $ACCOUNT_TYPE_LENGTH), @$man_inv_types;
987 my %not_fine = map {$_ => 1} @not_fines;
989 my ($total, $acctlines) = GetMemberAccountRecords($borrowernumber);
990 my $other_charges = 0;
991 foreach (@$acctlines) {
992 $other_charges += $_->{amountoutstanding} if $not_fine{ substr($_->{accounttype}, 0, $ACCOUNT_TYPE_LENGTH) };
995 return ( $total, $total - $other_charges, $other_charges);
998 =head2 GetBorNotifyAcctRecord
1000 ($total, $acctlines, $count) = &GetBorNotifyAcctRecord($params,$notifyid);
1002 Looks up accounting data for the patron with the given borrowernumber per file number.
1004 C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a
1005 reference-to-array, where each element is a reference-to-hash; the
1006 keys are the fields of the C<accountlines> table in the Koha database.
1007 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1008 total amount outstanding for all of the account lines.
1012 sub GetBorNotifyAcctRecord {
1013 my ( $borrowernumber, $notifyid ) = @_;
1014 my $dbh = C4::Context->dbh;
1017 my $sth = $dbh->prepare(
1020 WHERE borrowernumber=?
1022 AND amountoutstanding != '0'
1023 ORDER BY notify_id,accounttype
1026 $sth->execute( $borrowernumber, $notifyid );
1028 while ( my $data = $sth->fetchrow_hashref ) {
1029 if ( $data->{itemnumber} ) {
1030 my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
1031 $data->{biblionumber} = $biblio->{biblionumber};
1032 $data->{title} = $biblio->{title};
1034 $acctlines[$numlines] = $data;
1036 $total += int(100 * $data->{'amountoutstanding'});
1039 return ( $total, \@acctlines, $numlines );
1042 sub checkcardnumber {
1043 my ( $cardnumber, $borrowernumber ) = @_;
1045 # If cardnumber is null, we assume they're allowed.
1046 return 0 unless defined $cardnumber;
1048 my $dbh = C4::Context->dbh;
1049 my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
1050 $query .= " AND borrowernumber <> ?" if ($borrowernumber);
1051 my $sth = $dbh->prepare($query);
1054 ( $borrowernumber ? $borrowernumber : () )
1057 return 1 if $sth->fetchrow_hashref;
1059 my ( $min_length, $max_length ) = get_cardnumber_length();
1061 if length $cardnumber > $max_length
1062 or length $cardnumber < $min_length;
1067 =head2 get_cardnumber_length
1069 my ($min, $max) = C4::Members::get_cardnumber_length()
1071 Returns the minimum and maximum length for patron cardnumbers as
1072 determined by the CardnumberLength system preference, the
1073 BorrowerMandatoryField system preference, and the width of the
1078 sub get_cardnumber_length {
1079 my ( $min, $max ) = ( 0, 16 ); # borrowers.cardnumber is a nullable varchar(16)
1080 $min = 1 if C4::Context->preference('BorrowerMandatoryField') =~ /cardnumber/;
1081 if ( my $cardnumber_length = C4::Context->preference('CardnumberLength') ) {
1082 # Is integer and length match
1083 if ( $cardnumber_length =~ m|^\d+$| ) {
1084 $min = $max = $cardnumber_length
1085 if $cardnumber_length >= $min
1086 and $cardnumber_length <= $max;
1088 # Else assuming it is a range
1089 elsif ( $cardnumber_length =~ m|(\d*),(\d*)| ) {
1090 $min = $1 if $1 and $min < $1;
1091 $max = $2 if $2 and $max > $2;
1095 my $borrower = Koha::Schema->resultset('Borrower');
1096 my $field_size = $borrower->result_source->column_info('cardnumber')->{size};
1097 $min = $field_size if $min > $field_size;
1098 return ( $min, $max );
1101 =head2 GetFirstValidEmailAddress
1103 $email = GetFirstValidEmailAddress($borrowernumber);
1105 Return the first valid email address for a borrower, given the borrowernumber. For now, the order
1106 is defined as email, emailpro, B_email. Returns the empty string if the borrower has no email
1111 sub GetFirstValidEmailAddress {
1112 my $borrowernumber = shift;
1113 my $dbh = C4::Context->dbh;
1114 my $sth = $dbh->prepare( "SELECT email, emailpro, B_email FROM borrowers where borrowernumber = ? ");
1115 $sth->execute( $borrowernumber );
1116 my $data = $sth->fetchrow_hashref;
1118 if ($data->{'email'}) {
1119 return $data->{'email'};
1120 } elsif ($data->{'emailpro'}) {
1121 return $data->{'emailpro'};
1122 } elsif ($data->{'B_email'}) {
1123 return $data->{'B_email'};
1129 =head2 GetNoticeEmailAddress
1131 $email = GetNoticeEmailAddress($borrowernumber);
1133 Return the email address of borrower used for notices, given the borrowernumber.
1134 Returns the empty string if no email address.
1138 sub GetNoticeEmailAddress {
1139 my $borrowernumber = shift;
1141 my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
1142 # if syspref is set to 'first valid' (value == OFF), look up email address
1143 if ( $which_address eq 'OFF' ) {
1144 return GetFirstValidEmailAddress($borrowernumber);
1146 # specified email address field
1147 my $dbh = C4::Context->dbh;
1148 my $sth = $dbh->prepare( qq{
1149 SELECT $which_address AS primaryemail
1151 WHERE borrowernumber=?
1153 $sth->execute($borrowernumber);
1154 my $data = $sth->fetchrow_hashref;
1155 return $data->{'primaryemail'} || '';
1158 =head2 GetUpcomingMembershipExpires
1160 my $expires = GetUpcomingMembershipExpires({
1161 branch => $branch, before => $before, after => $after,
1164 $branch is an optional branch code.
1165 $before/$after is an optional number of days before/after the date that
1166 is set by the preference MembershipExpiryDaysNotice.
1167 If the pref would be 14, before 2 and after 3, you will get all expires
1172 sub GetUpcomingMembershipExpires {
1173 my ( $params ) = @_;
1174 my $before = $params->{before} || 0;
1175 my $after = $params->{after} || 0;
1176 my $branch = $params->{branch};
1178 my $dbh = C4::Context->dbh;
1179 my $days = C4::Context->preference("MembershipExpiryDaysNotice") || 0;
1180 my $date1 = dt_from_string->add( days => $days - $before );
1181 my $date2 = dt_from_string->add( days => $days + $after );
1182 $date1= output_pref({ dt => $date1, dateformat => 'iso', dateonly => 1 });
1183 $date2= output_pref({ dt => $date2, dateformat => 'iso', dateonly => 1 });
1186 SELECT borrowers.*, categories.description,
1187 branches.branchname, branches.branchemail FROM borrowers
1188 LEFT JOIN branches USING (branchcode)
1189 LEFT JOIN categories USING (categorycode)
1192 $query.= 'WHERE branchcode=? AND dateexpiry BETWEEN ? AND ?';
1194 $query.= 'WHERE dateexpiry BETWEEN ? AND ?';
1197 my $sth = $dbh->prepare( $query );
1198 my @pars = $branch? ( $branch ): ();
1199 push @pars, $date1, $date2;
1200 $sth->execute( @pars );
1201 my $results = $sth->fetchall_arrayref( {} );
1205 =head2 GetBorrowersToExpunge
1207 $borrowers = &GetBorrowersToExpunge(
1208 not_borrowed_since => $not_borrowed_since,
1209 expired_before => $expired_before,
1210 category_code => $category_code,
1211 patron_list_id => $patron_list_id,
1212 branchcode => $branchcode
1215 This function get all borrowers based on the given criteria.
1219 sub GetBorrowersToExpunge {
1222 my $filterdate = $params->{'not_borrowed_since'};
1223 my $filterexpiry = $params->{'expired_before'};
1224 my $filterlastseen = $params->{'last_seen'};
1225 my $filtercategory = $params->{'category_code'};
1226 my $filterbranch = $params->{'branchcode'} ||
1227 ((C4::Context->preference('IndependentBranches')
1228 && C4::Context->userenv
1229 && !C4::Context->IsSuperLibrarian()
1230 && C4::Context->userenv->{branch})
1231 ? C4::Context->userenv->{branch}
1233 my $filterpatronlist = $params->{'patron_list_id'};
1235 my $dbh = C4::Context->dbh;
1237 SELECT borrowers.borrowernumber,
1238 MAX(old_issues.timestamp) AS latestissue,
1239 MAX(issues.timestamp) AS currentissue
1241 JOIN categories USING (categorycode)
1245 WHERE guarantorid IS NOT NULL
1246 AND guarantorid <> 0
1247 ) as tmp ON borrowers.borrowernumber=tmp.guarantorid
1248 LEFT JOIN old_issues USING (borrowernumber)
1249 LEFT JOIN issues USING (borrowernumber)|;
1250 if ( $filterpatronlist ){
1251 $query .= q| LEFT JOIN patron_list_patrons USING (borrowernumber)|;
1253 $query .= q| WHERE category_type <> 'S'
1254 AND tmp.guarantorid IS NULL
1257 if ( $filterbranch && $filterbranch ne "" ) {
1258 $query.= " AND borrowers.branchcode = ? ";
1259 push( @query_params, $filterbranch );
1261 if ( $filterexpiry ) {
1262 $query .= " AND dateexpiry < ? ";
1263 push( @query_params, $filterexpiry );
1265 if ( $filterlastseen ) {
1266 $query .= ' AND lastseen < ? ';
1267 push @query_params, $filterlastseen;
1269 if ( $filtercategory ) {
1270 $query .= " AND categorycode = ? ";
1271 push( @query_params, $filtercategory );
1273 if ( $filterpatronlist ){
1274 $query.=" AND patron_list_id = ? ";
1275 push( @query_params, $filterpatronlist );
1277 $query.=" GROUP BY borrowers.borrowernumber HAVING currentissue IS NULL ";
1278 if ( $filterdate ) {
1279 $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
1280 push @query_params,$filterdate;
1282 warn $query if $debug;
1284 my $sth = $dbh->prepare($query);
1285 if (scalar(@query_params)>0){
1286 $sth->execute(@query_params);
1293 while ( my $data = $sth->fetchrow_hashref ) {
1294 push @results, $data;
1299 =head2 GetBorrowersWhoHaveNeverBorrowed
1301 $results = &GetBorrowersWhoHaveNeverBorrowed
1303 This function get all borrowers who have never borrowed.
1305 I<$result> is a ref to an array which all elements are a hasref.
1309 sub GetBorrowersWhoHaveNeverBorrowed {
1310 my $filterbranch = shift ||
1311 ((C4::Context->preference('IndependentBranches')
1312 && C4::Context->userenv
1313 && !C4::Context->IsSuperLibrarian()
1314 && C4::Context->userenv->{branch})
1315 ? C4::Context->userenv->{branch}
1317 my $dbh = C4::Context->dbh;
1319 SELECT borrowers.borrowernumber,max(timestamp) as latestissue
1321 LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
1322 WHERE issues.borrowernumber IS NULL
1325 if ($filterbranch && $filterbranch ne ""){
1326 $query.=" AND borrowers.branchcode= ?";
1327 push @query_params,$filterbranch;
1329 warn $query if $debug;
1331 my $sth = $dbh->prepare($query);
1332 if (scalar(@query_params)>0){
1333 $sth->execute(@query_params);
1340 while ( my $data = $sth->fetchrow_hashref ) {
1341 push @results, $data;
1346 =head2 GetBorrowersWithIssuesHistoryOlderThan
1348 $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
1350 this function get all borrowers who has an issue history older than I<$date> given on input arg.
1352 I<$result> is a ref to an array which all elements are a hashref.
1353 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
1357 sub GetBorrowersWithIssuesHistoryOlderThan {
1358 my $dbh = C4::Context->dbh;
1359 my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
1360 my $filterbranch = shift ||
1361 ((C4::Context->preference('IndependentBranches')
1362 && C4::Context->userenv
1363 && !C4::Context->IsSuperLibrarian()
1364 && C4::Context->userenv->{branch})
1365 ? C4::Context->userenv->{branch}
1368 SELECT count(borrowernumber) as n,borrowernumber
1370 WHERE returndate < ?
1371 AND borrowernumber IS NOT NULL
1374 push @query_params, $date;
1376 $query.=" AND branchcode = ?";
1377 push @query_params, $filterbranch;
1379 $query.=" GROUP BY borrowernumber ";
1380 warn $query if $debug;
1381 my $sth = $dbh->prepare($query);
1382 $sth->execute(@query_params);
1385 while ( my $data = $sth->fetchrow_hashref ) {
1386 push @results, $data;
1393 IssueSlip($branchcode, $borrowernumber, $quickslip)
1395 Returns letter hash ( see C4::Letters::GetPreparedLetter )
1397 $quickslip is boolean, to indicate whether we want a quick slip
1399 IssueSlip populates ISSUESLIP and ISSUEQSLIP, and will make the following expansions:
1435 NOTE: Not all table fields are available, pleasee see GetPendingIssues for a list of available fields.
1440 my ($branch, $borrowernumber, $quickslip) = @_;
1442 # FIXME Check callers before removing this statement
1443 #return unless $borrowernumber;
1445 my @issues = @{ GetPendingIssues($borrowernumber) };
1447 for my $issue (@issues) {
1448 $issue->{date_due} = $issue->{date_due_sql};
1450 my $today = output_pref({ dt => dt_from_string, dateformat => 'iso', dateonly => 1 });
1451 if ( substr( $issue->{issuedate}, 0, 10 ) eq $today
1452 or substr( $issue->{lastreneweddate}, 0, 10 ) eq $today ) {
1458 # Sort on timestamp then on issuedate (useful for tests and could be if modified in a batch
1460 my $s = $b->{timestamp} <=> $a->{timestamp};
1462 $b->{issuedate} <=> $a->{issuedate} : $s;
1465 my ($letter_code, %repeat);
1467 $letter_code = 'ISSUEQSLIP';
1469 'checkedout' => [ map {
1472 'biblioitems' => $_,
1474 }, grep { $_->{'now'} } @issues ],
1478 $letter_code = 'ISSUESLIP';
1480 'checkedout' => [ map {
1483 'biblioitems' => $_,
1485 }, grep { !$_->{'overdue'} } @issues ],
1487 'overdue' => [ map {
1490 'biblioitems' => $_,
1492 }, grep { $_->{'overdue'} } @issues ],
1495 $_->{'timestamp'} = $_->{'newdate'};
1497 } @{ GetNewsToDisplay("slip",$branch) } ],
1501 return C4::Letters::GetPreparedLetter (
1502 module => 'circulation',
1503 letter_code => $letter_code,
1504 branchcode => $branch,
1506 'branches' => $branch,
1507 'borrowers' => $borrowernumber,
1513 =head2 GetBorrowersWithEmail
1515 ([$borrnum,$userid], ...) = GetBorrowersWithEmail('me@example.com');
1517 This gets a list of users and their basic details from their email address.
1518 As it's possible for multiple user to have the same email address, it provides
1519 you with all of them. If there is no userid for the user, there will be an
1520 C<undef> there. An empty list will be returned if there are no matches.
1524 sub GetBorrowersWithEmail {
1527 my $dbh = C4::Context->dbh;
1529 my $query = "SELECT borrowernumber, userid FROM borrowers WHERE email=?";
1530 my $sth=$dbh->prepare($query);
1531 $sth->execute($email);
1533 while (my $ref = $sth->fetch) {
1536 die "Failure searching for borrowers by email address: $sth->errstr" if $sth->err;
1540 =head2 AddMember_Opac
1544 sub AddMember_Opac {
1545 my ( %borrower ) = @_;
1547 $borrower{'categorycode'} //= C4::Context->preference('PatronSelfRegistrationDefaultCategory');
1548 if (not defined $borrower{'password'}){
1549 my $sr = new String::Random;
1550 $sr->{'A'} = [ 'A'..'Z', 'a'..'z' ];
1551 my $password = $sr->randpattern("AAAAAAAAAA");
1552 $borrower{'password'} = $password;
1555 $borrower{'cardnumber'} = fixup_cardnumber( $borrower{'cardnumber'} );
1557 my $borrowernumber = AddMember(%borrower);
1559 return ( $borrowernumber, $borrower{'password'} );
1562 =head2 DeleteExpiredOpacRegistrations
1564 Delete accounts that haven't been upgraded from the 'temporary' category
1565 Returns the number of removed patrons
1569 sub DeleteExpiredOpacRegistrations {
1571 my $delay = C4::Context->preference('PatronSelfRegistrationExpireTemporaryAccountsDelay');
1572 my $category_code = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
1574 return 0 if not $category_code or not defined $delay or $delay eq q||;
1577 SELECT borrowernumber
1579 WHERE categorycode = ? AND DATEDIFF( NOW(), dateenrolled ) > ? |;
1581 my $dbh = C4::Context->dbh;
1582 my $sth = $dbh->prepare($query);
1583 $sth->execute( $category_code, $delay );
1585 while ( my ($borrowernumber) = $sth->fetchrow_array() ) {
1586 Koha::Patrons->find($borrowernumber)->delete;
1592 =head2 DeleteUnverifiedOpacRegistrations
1594 Delete all unverified self registrations in borrower_modifications,
1595 older than the specified number of days.
1599 sub DeleteUnverifiedOpacRegistrations {
1601 my $dbh = C4::Context->dbh;
1603 DELETE FROM borrower_modifications
1604 WHERE borrowernumber = 0 AND DATEDIFF( NOW(), timestamp ) > ?|;
1605 my $cnt=$dbh->do($sql, undef, ($days) );
1606 return $cnt eq '0E0'? 0: $cnt;
1609 sub GetOverduesForPatron {
1610 my ( $borrowernumber ) = @_;
1614 FROM issues, items, biblio, biblioitems
1615 WHERE items.itemnumber=issues.itemnumber
1616 AND biblio.biblionumber = items.biblionumber
1617 AND biblio.biblionumber = biblioitems.biblionumber
1618 AND issues.borrowernumber = ?
1619 AND date_due < NOW()
1622 my $sth = C4::Context->dbh->prepare( $sql );
1623 $sth->execute( $borrowernumber );
1625 return $sth->fetchall_arrayref({});
1628 END { } # module clean-up code here (global destructor)