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 &GetFirstValidEmailAddress
67 &GetNoticeEmailAddress
69 &GetMemberAccountRecords
70 &GetBorNotifyAcctRecord
72 &GetBorrowersToExpunge
104 C4::Members - Perl Module containing convenience functions for member handling
112 This module contains routines for adding, modifying and deleting members/patrons/borrowers
118 $flags = &patronflags($patron);
120 This function is not exported.
122 The following will be set where applicable:
123 $flags->{CHARGES}->{amount} Amount of debt
124 $flags->{CHARGES}->{noissues} Set if debt amount >$5.00 (or syspref noissuescharge)
125 $flags->{CHARGES}->{message} Message -- deprecated
127 $flags->{CREDITS}->{amount} Amount of credit
128 $flags->{CREDITS}->{message} Message -- deprecated
130 $flags->{ GNA } Patron has no valid address
131 $flags->{ GNA }->{noissues} Set for each GNA
132 $flags->{ GNA }->{message} "Borrower has no valid address" -- deprecated
134 $flags->{ LOST } Patron's card reported lost
135 $flags->{ LOST }->{noissues} Set for each LOST
136 $flags->{ LOST }->{message} Message -- deprecated
138 $flags->{DBARRED} Set if patron debarred, no access
139 $flags->{DBARRED}->{noissues} Set for each DBARRED
140 $flags->{DBARRED}->{message} Message -- deprecated
143 $flags->{ NOTES }->{message} The note itself. NOT deprecated
145 $flags->{ ODUES } Set if patron has overdue books.
146 $flags->{ ODUES }->{message} "Yes" -- deprecated
147 $flags->{ ODUES }->{itemlist} ref-to-array: list of overdue books
148 $flags->{ ODUES }->{itemlisttext} Text list of overdue items -- deprecated
150 $flags->{WAITING} Set if any of patron's reserves are available
151 $flags->{WAITING}->{message} Message -- deprecated
152 $flags->{WAITING}->{itemlist} ref-to-array: list of available items
156 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
157 overdue items. Its elements are references-to-hash, each describing an
158 overdue item. The keys are selected fields from the issues, biblio,
159 biblioitems, and items tables of the Koha database.
161 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
162 the overdue items, one per line. Deprecated.
164 =item C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
165 available items. Each element is a reference-to-hash whose keys are
166 fields from the reserves table of the Koha database.
170 All the "message" fields that include language generated in this function are deprecated,
171 because such strings belong properly in the display layer.
173 The "message" field that comes from the DB is OK.
177 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
178 # FIXME rename this function.
181 my ( $patroninformation) = @_;
182 my $dbh=C4::Context->dbh;
184 my $patron = Koha::Patrons->find( $patroninformation->{borrowernumber} );
185 my $account = $patron->account;
186 my $owing = $account->non_issues_charges;
190 my $noissuescharge = C4::Context->preference("noissuescharge") || 5;
191 $flaginfo{'message'} = sprintf 'Patron owes %.02f', $owing;
192 $flaginfo{'amount'} = sprintf "%.02f", $owing;
193 if ( $owing > $noissuescharge && !C4::Context->preference("AllowFineOverride") ) {
194 $flaginfo{'noissues'} = 1;
196 $flags{'CHARGES'} = \%flaginfo;
198 elsif ( ( my $balance = $account->balance ) < 0 ) {
200 $flaginfo{'message'} = sprintf 'Patron has credit of %.02f', -$balance;
201 $flaginfo{'amount'} = sprintf "%.02f", $balance;
202 $flags{'CREDITS'} = \%flaginfo;
205 # Check the debt of the guarntees of this patron
206 my $no_issues_charge_guarantees = C4::Context->preference("NoIssuesChargeGuarantees");
207 $no_issues_charge_guarantees = undef unless looks_like_number( $no_issues_charge_guarantees );
208 if ( defined $no_issues_charge_guarantees ) {
209 my $p = Koha::Patrons->find( $patroninformation->{borrowernumber} );
210 my @guarantees = $p->guarantees();
211 my $guarantees_non_issues_charges;
212 foreach my $g ( @guarantees ) {
213 my ( $b, $n, $o ) = C4::Members::GetMemberAccountBalance( $g->id );
214 $guarantees_non_issues_charges += $n;
217 if ( $guarantees_non_issues_charges > $no_issues_charge_guarantees ) {
219 $flaginfo{'message'} = sprintf 'patron guarantees owe %.02f', $guarantees_non_issues_charges;
220 $flaginfo{'amount'} = $guarantees_non_issues_charges;
221 $flaginfo{'noissues'} = 1 unless C4::Context->preference("allowfineoverride");
222 $flags{'CHARGES_GUARANTEES'} = \%flaginfo;
226 if ( $patroninformation->{'gonenoaddress'}
227 && $patroninformation->{'gonenoaddress'} == 1 )
230 $flaginfo{'message'} = 'Borrower has no valid address.';
231 $flaginfo{'noissues'} = 1;
232 $flags{'GNA'} = \%flaginfo;
234 if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
236 $flaginfo{'message'} = 'Borrower\'s card reported lost.';
237 $flaginfo{'noissues'} = 1;
238 $flags{'LOST'} = \%flaginfo;
240 if ( $patroninformation->{'debarred'} && check_date( split( /-/, $patroninformation->{'debarred'} ) ) ) {
241 if ( Date_to_Days(Date::Calc::Today) < Date_to_Days( split( /-/, $patroninformation->{'debarred'} ) ) ) {
243 $flaginfo{'debarredcomment'} = $patroninformation->{'debarredcomment'};
244 $flaginfo{'message'} = $patroninformation->{'debarredcomment'};
245 $flaginfo{'noissues'} = 1;
246 $flaginfo{'dateend'} = $patroninformation->{'debarred'};
247 $flags{'DBARRED'} = \%flaginfo;
250 if ( $patroninformation->{'borrowernotes'}
251 && $patroninformation->{'borrowernotes'} )
254 $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
255 $flags{'NOTES'} = \%flaginfo;
257 my ( $odues, $itemsoverdue ) = C4::Overdues::checkoverdues($patroninformation->{'borrowernumber'});
258 if ( $odues && $odues > 0 ) {
260 $flaginfo{'message'} = "Yes";
261 $flaginfo{'itemlist'} = $itemsoverdue;
262 foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
265 $flaginfo{'itemlisttext'} .=
266 "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n"; # newline is display layer
268 $flags{'ODUES'} = \%flaginfo;
271 my $patron = Koha::Patrons->find( $patroninformation->{borrowernumber} );
272 my $waiting_holds = $patron->holds->search({ found => 'W' });
273 my $nowaiting = $waiting_holds->count;
274 if ( $nowaiting > 0 ) {
276 $flaginfo{'message'} = "Reserved items available";
277 $flaginfo{'itemlist'} = $waiting_holds->unblessed;
278 $flags{'WAITING'} = \%flaginfo;
286 my $success = ModMember(borrowernumber => $borrowernumber,
287 [ field => value ]... );
289 Modify borrower's data. All date fields should ALREADY be in ISO format.
292 true on success, or false on failure
299 # trim whitespace from data which has some non-whitespace in it.
300 foreach my $field_name (keys(%data)) {
301 if ( defined $data{$field_name} && $data{$field_name} =~ /\S/ ) {
302 $data{$field_name} =~ s/^\s*|\s*$//g;
306 # test to know if you must update or not the borrower password
307 if (exists $data{password}) {
308 if ($data{password} eq '****' or $data{password} eq '') {
309 delete $data{password};
311 if ( C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
312 # Update the hashed PIN in borrower_sync.hashed_pin, before Koha hashes it
313 Koha::NorwegianPatronDB::NLUpdateHashedPIN( $data{'borrowernumber'}, $data{password} );
315 $data{password} = hash_password($data{password});
319 my $old_categorycode = Koha::Patrons->find( $data{borrowernumber} )->categorycode;
321 # get only the columns of a borrower
322 my $schema = Koha::Database->new()->schema;
323 my @columns = $schema->source('Borrower')->columns;
324 my $new_borrower = { map { join(' ', @columns) =~ /$_/ ? ( $_ => $data{$_} ) : () } keys(%data) };
326 $new_borrower->{dateofbirth} ||= undef if exists $new_borrower->{dateofbirth};
327 $new_borrower->{dateenrolled} ||= undef if exists $new_borrower->{dateenrolled};
328 $new_borrower->{dateexpiry} ||= undef if exists $new_borrower->{dateexpiry};
329 $new_borrower->{debarred} ||= undef if exists $new_borrower->{debarred};
330 $new_borrower->{sms_provider_id} ||= undef if exists $new_borrower->{sms_provider_id};
331 $new_borrower->{guarantorid} ||= undef if exists $new_borrower->{guarantorid};
333 my $patron = Koha::Patrons->find( $new_borrower->{borrowernumber} );
335 delete $new_borrower->{userid} if exists $new_borrower->{userid} and not $new_borrower->{userid};
337 my $execute_success = $patron->store if $patron->set($new_borrower);
339 if ($execute_success) { # only proceed if the update was a success
340 # If the patron changes to a category with enrollment fee, we add a fee
341 if ( $data{categorycode} and $data{categorycode} ne $old_categorycode ) {
342 if ( C4::Context->preference('FeeOnChangePatronCategory') ) {
343 $patron->add_enrolment_fee_if_needed;
347 # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
348 # cronjob will use for syncing with NL
349 if ( C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
350 my $borrowersync = Koha::Database->new->schema->resultset('BorrowerSync')->find({
351 'synctype' => 'norwegianpatrondb',
352 'borrowernumber' => $data{'borrowernumber'}
354 # Do not set to "edited" if syncstatus is "new". We need to sync as new before
355 # we can sync as changed. And the "new sync" will pick up all changes since
356 # the patron was created anyway.
357 if ( $borrowersync->syncstatus ne 'new' && $borrowersync->syncstatus ne 'delete' ) {
358 $borrowersync->update( { 'syncstatus' => 'edited' } );
360 # Set the value of 'sync'
361 $borrowersync->update( { 'sync' => $data{'sync'} } );
362 # Try to do the live sync
363 Koha::NorwegianPatronDB::NLSync({ 'borrowernumber' => $data{'borrowernumber'} });
366 logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "UPDATE (executed w/ arg: $data{'borrowernumber'})") if C4::Context->preference("BorrowersLog");
368 return $execute_success;
373 $borrowernumber = &AddMember(%borrower);
375 insert new borrower into table
377 (%borrower keys are database columns. Database columns could be
378 different in different versions. Please look into database for correct
381 Returns the borrowernumber upon success
383 Returns as undef upon any db error without further processing
390 my $dbh = C4::Context->dbh;
391 my $schema = Koha::Database->new()->schema;
393 # trim whitespace from data which has some non-whitespace in it.
394 foreach my $field_name (keys(%data)) {
395 if ( defined $data{$field_name} && $data{$field_name} =~ /\S/ ) {
396 $data{$field_name} =~ s/^\s*|\s*$//g;
400 # generate a proper login if none provided
401 $data{'userid'} = Generate_Userid( $data{'borrowernumber'}, $data{'firstname'}, $data{'surname'} )
402 if ( $data{'userid'} eq '' || !Check_Userid( $data{'userid'} ) );
404 # add expiration date if it isn't already there
405 $data{dateexpiry} ||= Koha::Patron::Categories->find( $data{categorycode} )->get_expiry_date;
407 # add enrollment date if it isn't already there
408 unless ( $data{'dateenrolled'} ) {
409 $data{'dateenrolled'} = output_pref( { dt => dt_from_string, dateonly => 1, dateformat => 'iso' } );
412 if ( C4::Context->preference("autoMemberNum") ) {
413 if ( not exists $data{cardnumber} or not defined $data{cardnumber} or $data{cardnumber} eq '' ) {
414 $data{cardnumber} = fixup_cardnumber( $data{cardnumber} );
418 my $patron_category = $schema->resultset('Category')->find( $data{'categorycode'} );
420 $patron_category->default_privacy() eq 'default' ? 1
421 : $patron_category->default_privacy() eq 'never' ? 2
422 : $patron_category->default_privacy() eq 'forever' ? 0
425 $data{'privacy_guarantor_checkouts'} = 0 unless defined( $data{'privacy_guarantor_checkouts'} );
427 # Make a copy of the plain text password for later use
428 my $plain_text_password = $data{'password'};
430 # create a disabled account if no password provided
431 $data{'password'} = ($data{'password'})? hash_password($data{'password'}) : '!';
433 # we don't want invalid dates in the db (mysql has a bad habit of inserting 0000-00-00
434 $data{'dateofbirth'} = undef if ( not $data{'dateofbirth'} );
435 $data{'debarred'} = undef if ( not $data{'debarred'} );
436 $data{'sms_provider_id'} = undef if ( not $data{'sms_provider_id'} );
437 $data{'guarantorid'} = undef if ( not $data{'guarantorid'} );
439 # get only the columns of Borrower
440 # FIXME Do we really need this check?
441 my @columns = $schema->source('Borrower')->columns;
442 my $new_member = { map { join(' ',@columns) =~ /$_/ ? ( $_ => $data{$_} ) : () } keys(%data) } ;
444 delete $new_member->{borrowernumber};
446 my $patron = Koha::Patron->new( $new_member )->store;
447 $data{borrowernumber} = $patron->borrowernumber;
449 # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
450 # cronjob will use for syncing with NL
451 if ( exists $data{'borrowernumber'} && C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
452 Koha::Database->new->schema->resultset('BorrowerSync')->create({
453 'borrowernumber' => $data{'borrowernumber'},
454 'synctype' => 'norwegianpatrondb',
456 'syncstatus' => 'new',
457 'hashed_pin' => Koha::NorwegianPatronDB::NLEncryptPIN( $plain_text_password ),
461 logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
463 $patron->add_enrolment_fee_if_needed;
465 return $data{borrowernumber};
470 my $uniqueness = Check_Userid($userid,$borrowernumber);
472 $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 != '').
474 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.
477 0 for not unique (i.e. this $userid already exists)
478 1 for unique (i.e. this $userid does not exist, or this $userid/$borrowernumber combination already exists)
483 my ( $uid, $borrowernumber ) = @_;
485 return 0 unless ($uid); # userid is a unique column, we should assume NULL is not unique
487 return 0 if ( $uid eq C4::Context->config('user') );
489 my $rs = Koha::Database->new()->schema()->resultset('Borrower');
492 $params->{userid} = $uid;
493 $params->{borrowernumber} = { '!=' => $borrowernumber } if ($borrowernumber);
495 my $count = $rs->count( $params );
497 return $count ? 0 : 1;
500 =head2 Generate_Userid
502 my $newuid = Generate_Userid($borrowernumber, $firstname, $surname);
504 Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
506 $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.
509 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).
513 sub Generate_Userid {
514 my ($borrowernumber, $firstname, $surname) = @_;
517 #The script will "do" the following code and increment the $offset until Check_Userid = 1 (i.e. until $newuid comes back as unique)
519 $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
520 $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
521 $newuid = lc(($firstname)? "$firstname.$surname" : $surname);
522 $newuid = unac_string('utf-8',$newuid);
523 $newuid .= $offset unless $offset == 0;
526 } while (!Check_Userid($newuid,$borrowernumber));
531 =head2 fixup_cardnumber
533 Warning: The caller is responsible for locking the members table in write
534 mode, to avoid database corruption.
538 use vars qw( @weightings );
539 my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
541 sub fixup_cardnumber {
542 my ($cardnumber) = @_;
543 my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;
545 # Find out whether member numbers should be generated
546 # automatically. Should be either "1" or something else.
547 # Defaults to "0", which is interpreted as "no".
549 # if ($cardnumber !~ /\S/ && $autonumber_members) {
550 ($autonumber_members) or return $cardnumber;
551 my $checkdigit = C4::Context->preference('checkdigit');
552 my $dbh = C4::Context->dbh;
553 if ( $checkdigit and $checkdigit eq 'katipo' ) {
555 # if checkdigit is selected, calculate katipo-style cardnumber.
556 # otherwise, just use the max()
557 # purpose: generate checksum'd member numbers.
558 # We'll assume we just got the max value of digits 2-8 of member #'s
559 # from the database and our job is to increment that by one,
560 # determine the 1st and 9th digits and return the full string.
561 my $sth = $dbh->prepare(
562 "select max(substring(borrowers.cardnumber,2,7)) as new_num from borrowers"
565 my $data = $sth->fetchrow_hashref;
566 $cardnumber = $data->{new_num};
567 if ( !$cardnumber ) { # If DB has no values,
568 $cardnumber = 1000000; # start at 1000000
574 for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
575 # read weightings, left to right, 1 char at a time
576 my $temp1 = $weightings[$i];
578 # sequence left to right, 1 char at a time
579 my $temp2 = substr( $cardnumber, $i, 1 );
581 # mult each char 1-7 by its corresponding weighting
582 $sum += $temp1 * $temp2;
585 my $rem = ( $sum % 11 );
586 $rem = 'X' if $rem == 10;
588 return "V$cardnumber$rem";
591 my $sth = $dbh->prepare(
592 'SELECT MAX( CAST( cardnumber AS SIGNED ) ) FROM borrowers WHERE cardnumber REGEXP "^-?[0-9]+$"'
595 my ($result) = $sth->fetchrow;
598 return $cardnumber; # just here as a fallback/reminder
601 =head2 GetPendingIssues
603 my $issues = &GetPendingIssues(@borrowernumber);
605 Looks up what the patron with the given borrowernumber has borrowed.
607 C<&GetPendingIssues> returns a
608 reference-to-array where each element is a reference-to-hash; the
609 keys are the fields from the C<issues>, C<biblio>, and C<items> tables.
610 The keys include C<biblioitems> fields.
614 sub GetPendingIssues {
615 my @borrowernumbers = @_;
617 unless (@borrowernumbers ) { # return a ref_to_array
618 return \@borrowernumbers; # to not cause surprise to caller
621 # Borrowers part of the query
623 for (my $i = 0; $i < @borrowernumbers; $i++) {
624 $bquery .= ' issues.borrowernumber = ?';
625 if ($i < $#borrowernumbers ) {
630 # FIXME: namespace collision: each table has "timestamp" fields. Which one is "timestamp" ?
631 # FIXME: circ/ciculation.pl tries to sort by timestamp!
632 # FIXME: namespace collision: other collisions possible.
633 # FIXME: most of this data isn't really being used by callers.
640 biblioitems.itemtype,
643 biblioitems.publicationyear,
644 biblioitems.publishercode,
645 biblioitems.volumedate,
646 biblioitems.volumedesc,
651 borrowers.cardnumber,
652 issues.timestamp AS timestamp,
653 issues.renewals AS renewals,
654 issues.borrowernumber AS borrowernumber,
655 items.renewals AS totalrenewals
657 LEFT JOIN items ON items.itemnumber = issues.itemnumber
658 LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
659 LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
660 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
663 ORDER BY issues.issuedate"
666 my $sth = C4::Context->dbh->prepare($query);
667 $sth->execute(@borrowernumbers);
668 my $data = $sth->fetchall_arrayref({});
669 my $today = dt_from_string;
671 if ($_->{issuedate}) {
672 $_->{issuedate} = dt_from_string($_->{issuedate}, 'sql');
674 $_->{date_due_sql} = $_->{date_due};
675 # FIXME no need to have this value
676 $_->{date_due} or next;
677 $_->{date_due_sql} = $_->{date_due};
678 # FIXME no need to have this value
679 $_->{date_due} = dt_from_string($_->{date_due}, 'sql');
680 if ( DateTime->compare($_->{date_due}, $today) == -1 ) {
689 $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
691 Looks up what the patron with the given borrowernumber has borrowed,
692 and sorts the results.
694 C<$sortkey> is the name of a field on which to sort the results. This
695 should be the name of a field in the C<issues>, C<biblio>,
696 C<biblioitems>, or C<items> table in the Koha database.
698 C<$limit> is the maximum number of results to return.
700 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
701 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
702 C<items> tables of the Koha database.
708 my ( $borrowernumber, $order, $limit ) = @_;
710 return unless $borrowernumber;
711 $order = 'date_due desc' unless $order;
713 my $dbh = C4::Context->dbh;
715 'SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
717 LEFT JOIN items on items.itemnumber=issues.itemnumber
718 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
719 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
720 WHERE borrowernumber=?
722 SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
724 LEFT JOIN items on items.itemnumber=old_issues.itemnumber
725 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
726 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
727 WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL
730 $query .= " limit $limit";
733 my $sth = $dbh->prepare($query);
734 $sth->execute( $borrowernumber, $borrowernumber );
735 return $sth->fetchall_arrayref( {} );
739 =head2 GetMemberAccountRecords
741 ($total, $acctlines, $count) = &GetMemberAccountRecords($borrowernumber);
743 Looks up accounting data for the patron with the given borrowernumber.
745 C<&GetMemberAccountRecords> returns a three-element array. C<$acctlines> is a
746 reference-to-array, where each element is a reference-to-hash; the
747 keys are the fields of the C<accountlines> table in the Koha database.
748 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
749 total amount outstanding for all of the account lines.
753 sub GetMemberAccountRecords {
754 my ($borrowernumber) = @_;
755 my $dbh = C4::Context->dbh;
761 WHERE borrowernumber=?);
762 $strsth.=" ORDER BY accountlines_id desc";
763 my $sth= $dbh->prepare( $strsth );
764 $sth->execute( $borrowernumber );
767 while ( my $data = $sth->fetchrow_hashref ) {
768 if ( $data->{itemnumber} ) {
769 my $item = Koha::Items->find( $data->{itemnumber} );
770 my $biblio = $item->biblio;
771 $data->{biblionumber} = $biblio->biblionumber;
772 $data->{title} = $biblio->title;
774 $acctlines[$numlines] = $data;
776 $total += sprintf "%.0f", 1000*$data->{amountoutstanding}; # convert float to integer to avoid round-off errors
779 return ( $total, \@acctlines,$numlines);
782 =head2 GetMemberAccountBalance
784 ($total_balance, $non_issue_balance, $other_charges) = &GetMemberAccountBalance($borrowernumber);
786 Calculates amount immediately owing by the patron - non-issue charges.
787 Based on GetMemberAccountRecords.
788 Charges exempt from non-issue are:
790 * Rent (rental) if RentalsInNoissuesCharge syspref is set to false
791 * Manual invoices if ManInvInNoissuesCharge syspref is set to false
795 sub GetMemberAccountBalance {
796 my ($borrowernumber) = @_;
798 my $ACCOUNT_TYPE_LENGTH = 5; # this is plain ridiculous...
801 push @not_fines, 'Res' unless C4::Context->preference('HoldsInNoissuesCharge');
802 push @not_fines, 'Rent' unless C4::Context->preference('RentalsInNoissuesCharge');
803 unless ( C4::Context->preference('ManInvInNoissuesCharge') ) {
804 my $dbh = C4::Context->dbh;
805 my $man_inv_types = $dbh->selectcol_arrayref(qq{SELECT authorised_value FROM authorised_values WHERE category = 'MANUAL_INV'});
806 push @not_fines, map substr($_, 0, $ACCOUNT_TYPE_LENGTH), @$man_inv_types;
808 my %not_fine = map {$_ => 1} @not_fines;
810 my ($total, $acctlines) = GetMemberAccountRecords($borrowernumber);
811 my $other_charges = 0;
812 foreach (@$acctlines) {
813 $other_charges += $_->{amountoutstanding} if $not_fine{ substr($_->{accounttype}, 0, $ACCOUNT_TYPE_LENGTH) };
816 return ( $total, $total - $other_charges, $other_charges);
819 =head2 GetBorNotifyAcctRecord
821 ($total, $acctlines, $count) = &GetBorNotifyAcctRecord($params,$notifyid);
823 Looks up accounting data for the patron with the given borrowernumber per file number.
825 C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a
826 reference-to-array, where each element is a reference-to-hash; the
827 keys are the fields of the C<accountlines> table in the Koha database.
828 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
829 total amount outstanding for all of the account lines.
833 sub GetBorNotifyAcctRecord {
834 my ( $borrowernumber, $notifyid ) = @_;
835 my $dbh = C4::Context->dbh;
838 my $sth = $dbh->prepare(
841 WHERE borrowernumber=?
843 AND amountoutstanding != '0'
844 ORDER BY notify_id,accounttype
847 $sth->execute( $borrowernumber, $notifyid );
849 while ( my $data = $sth->fetchrow_hashref ) {
850 if ( $data->{itemnumber} ) {
851 my $item = Koha::Items->find( $data->{itemnumber} );
852 my $biblio = $item->biblio;
853 $data->{biblionumber} = $biblio->biblionumber;
854 $data->{title} = $biblio->title;
856 $acctlines[$numlines] = $data;
858 $total += int(100 * $data->{'amountoutstanding'});
861 return ( $total, \@acctlines, $numlines );
864 sub checkcardnumber {
865 my ( $cardnumber, $borrowernumber ) = @_;
867 # If cardnumber is null, we assume they're allowed.
868 return 0 unless defined $cardnumber;
870 my $dbh = C4::Context->dbh;
871 my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
872 $query .= " AND borrowernumber <> ?" if ($borrowernumber);
873 my $sth = $dbh->prepare($query);
876 ( $borrowernumber ? $borrowernumber : () )
879 return 1 if $sth->fetchrow_hashref;
881 my ( $min_length, $max_length ) = get_cardnumber_length();
883 if length $cardnumber > $max_length
884 or length $cardnumber < $min_length;
889 =head2 get_cardnumber_length
891 my ($min, $max) = C4::Members::get_cardnumber_length()
893 Returns the minimum and maximum length for patron cardnumbers as
894 determined by the CardnumberLength system preference, the
895 BorrowerMandatoryField system preference, and the width of the
900 sub get_cardnumber_length {
901 my $borrower = Koha::Database->new->schema->resultset('Borrower');
902 my $field_size = $borrower->result_source->column_info('cardnumber')->{size};
903 my ( $min, $max ) = ( 0, $field_size ); # borrowers.cardnumber is a nullable varchar(20)
904 $min = 1 if C4::Context->preference('BorrowerMandatoryField') =~ /cardnumber/;
905 if ( my $cardnumber_length = C4::Context->preference('CardnumberLength') ) {
906 # Is integer and length match
907 if ( $cardnumber_length =~ m|^\d+$| ) {
908 $min = $max = $cardnumber_length
909 if $cardnumber_length >= $min
910 and $cardnumber_length <= $max;
912 # Else assuming it is a range
913 elsif ( $cardnumber_length =~ m|(\d*),(\d*)| ) {
914 $min = $1 if $1 and $min < $1;
915 $max = $2 if $2 and $max > $2;
919 $min = $max if $min > $max;
920 return ( $min, $max );
923 =head2 GetFirstValidEmailAddress
925 $email = GetFirstValidEmailAddress($borrowernumber);
927 Return the first valid email address for a borrower, given the borrowernumber. For now, the order
928 is defined as email, emailpro, B_email. Returns the empty string if the borrower has no email
933 sub GetFirstValidEmailAddress {
934 my $borrowernumber = shift;
936 my $borrower = Koha::Patrons->find( $borrowernumber );
938 return $borrower->first_valid_email_address();
941 =head2 GetNoticeEmailAddress
943 $email = GetNoticeEmailAddress($borrowernumber);
945 Return the email address of borrower used for notices, given the borrowernumber.
946 Returns the empty string if no email address.
950 sub GetNoticeEmailAddress {
951 my $borrowernumber = shift;
953 my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
954 # if syspref is set to 'first valid' (value == OFF), look up email address
955 if ( $which_address eq 'OFF' ) {
956 return GetFirstValidEmailAddress($borrowernumber);
958 # specified email address field
959 my $dbh = C4::Context->dbh;
960 my $sth = $dbh->prepare( qq{
961 SELECT $which_address AS primaryemail
963 WHERE borrowernumber=?
965 $sth->execute($borrowernumber);
966 my $data = $sth->fetchrow_hashref;
967 return $data->{'primaryemail'} || '';
970 =head2 GetBorrowersToExpunge
972 $borrowers = &GetBorrowersToExpunge(
973 not_borrowed_since => $not_borrowed_since,
974 expired_before => $expired_before,
975 category_code => $category_code,
976 patron_list_id => $patron_list_id,
977 branchcode => $branchcode
980 This function get all borrowers based on the given criteria.
984 sub GetBorrowersToExpunge {
987 my $filterdate = $params->{'not_borrowed_since'};
988 my $filterexpiry = $params->{'expired_before'};
989 my $filterlastseen = $params->{'last_seen'};
990 my $filtercategory = $params->{'category_code'};
991 my $filterbranch = $params->{'branchcode'} ||
992 ((C4::Context->preference('IndependentBranches')
993 && C4::Context->userenv
994 && !C4::Context->IsSuperLibrarian()
995 && C4::Context->userenv->{branch})
996 ? C4::Context->userenv->{branch}
998 my $filterpatronlist = $params->{'patron_list_id'};
1000 my $dbh = C4::Context->dbh;
1002 SELECT borrowers.borrowernumber,
1003 MAX(old_issues.timestamp) AS latestissue,
1004 MAX(issues.timestamp) AS currentissue
1006 JOIN categories USING (categorycode)
1010 WHERE guarantorid IS NOT NULL
1011 AND guarantorid <> 0
1012 ) as tmp ON borrowers.borrowernumber=tmp.guarantorid
1013 LEFT JOIN old_issues USING (borrowernumber)
1014 LEFT JOIN issues USING (borrowernumber)|;
1015 if ( $filterpatronlist ){
1016 $query .= q| LEFT JOIN patron_list_patrons USING (borrowernumber)|;
1018 $query .= q| WHERE category_type <> 'S'
1019 AND tmp.guarantorid IS NULL
1022 if ( $filterbranch && $filterbranch ne "" ) {
1023 $query.= " AND borrowers.branchcode = ? ";
1024 push( @query_params, $filterbranch );
1026 if ( $filterexpiry ) {
1027 $query .= " AND dateexpiry < ? ";
1028 push( @query_params, $filterexpiry );
1030 if ( $filterlastseen ) {
1031 $query .= ' AND lastseen < ? ';
1032 push @query_params, $filterlastseen;
1034 if ( $filtercategory ) {
1035 $query .= " AND categorycode = ? ";
1036 push( @query_params, $filtercategory );
1038 if ( $filterpatronlist ){
1039 $query.=" AND patron_list_id = ? ";
1040 push( @query_params, $filterpatronlist );
1042 $query.=" GROUP BY borrowers.borrowernumber HAVING currentissue IS NULL ";
1043 if ( $filterdate ) {
1044 $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
1045 push @query_params,$filterdate;
1047 warn $query if $debug;
1049 my $sth = $dbh->prepare($query);
1050 if (scalar(@query_params)>0){
1051 $sth->execute(@query_params);
1058 while ( my $data = $sth->fetchrow_hashref ) {
1059 push @results, $data;
1066 IssueSlip($branchcode, $borrowernumber, $quickslip)
1068 Returns letter hash ( see C4::Letters::GetPreparedLetter )
1070 $quickslip is boolean, to indicate whether we want a quick slip
1072 IssueSlip populates ISSUESLIP and ISSUEQSLIP, and will make the following expansions:
1108 NOTE: Not all table fields are available, pleasee see GetPendingIssues for a list of available fields.
1113 my ($branch, $borrowernumber, $quickslip) = @_;
1115 # FIXME Check callers before removing this statement
1116 #return unless $borrowernumber;
1118 my $patron = Koha::Patrons->find( $borrowernumber );
1119 return unless $patron;
1121 my @issues = @{ GetPendingIssues($borrowernumber) };
1123 for my $issue (@issues) {
1124 $issue->{date_due} = $issue->{date_due_sql};
1126 my $today = output_pref({ dt => dt_from_string, dateformat => 'iso', dateonly => 1 });
1127 if ( substr( $issue->{issuedate}, 0, 10 ) eq $today
1128 or substr( $issue->{lastreneweddate}, 0, 10 ) eq $today ) {
1134 # Sort on timestamp then on issuedate then on issue_id
1135 # useful for tests and could be if modified in a batch
1137 $b->{timestamp} <=> $a->{timestamp}
1138 or $b->{issuedate} <=> $a->{issuedate}
1139 or $b->{issue_id} <=> $a->{issue_id}
1142 my ($letter_code, %repeat, %loops);
1144 $letter_code = 'ISSUEQSLIP';
1145 my @checkouts = map {
1148 'biblioitems' => $_,
1150 }, grep { $_->{'now'} } @issues;
1152 checkedout => \@checkouts, # History syntax
1155 issues => [ map { $_->{issues}{itemnumber} } @checkouts ], # TT syntax
1159 my @checkouts = map {
1162 'biblioitems' => $_,
1164 }, grep { !$_->{'overdue'} } @issues;
1165 my @overdues = map {
1168 'biblioitems' => $_,
1170 }, grep { $_->{'overdue'} } @issues;
1171 my $news = GetNewsToDisplay( "slip", $branch );
1173 $_->{'timestamp'} = $_->{'newdate'};
1176 $letter_code = 'ISSUESLIP';
1178 checkedout => \@checkouts,
1179 overdue => \@overdues,
1183 issues => [ map { $_->{issues}{itemnumber} } @checkouts ],
1184 overdues => [ map { $_->{issues}{itemnumber} } @overdues ],
1185 opac_news => [ map { $_->{opac_news}{idnew} } @news ],
1189 return C4::Letters::GetPreparedLetter (
1190 module => 'circulation',
1191 letter_code => $letter_code,
1192 branchcode => $branch,
1193 lang => $patron->lang,
1195 'branches' => $branch,
1196 'borrowers' => $borrowernumber,
1203 =head2 AddMember_Auto
1207 sub AddMember_Auto {
1208 my ( %borrower ) = @_;
1210 $borrower{'cardnumber'} ||= fixup_cardnumber();
1212 $borrower{'borrowernumber'} = AddMember(%borrower);
1214 return ( %borrower );
1217 =head2 AddMember_Opac
1221 sub AddMember_Opac {
1222 my ( %borrower ) = @_;
1224 $borrower{'categorycode'} //= C4::Context->preference('PatronSelfRegistrationDefaultCategory');
1225 if (not defined $borrower{'password'}){
1226 my $sr = new String::Random;
1227 $sr->{'A'} = [ 'A'..'Z', 'a'..'z' ];
1228 my $password = $sr->randpattern("AAAAAAAAAA");
1229 $borrower{'password'} = $password;
1232 %borrower = AddMember_Auto(%borrower);
1234 return ( $borrower{'borrowernumber'}, $borrower{'password'} );
1237 =head2 DeleteExpiredOpacRegistrations
1239 Delete accounts that haven't been upgraded from the 'temporary' category
1240 Returns the number of removed patrons
1244 sub DeleteExpiredOpacRegistrations {
1246 my $delay = C4::Context->preference('PatronSelfRegistrationExpireTemporaryAccountsDelay');
1247 my $category_code = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
1249 return 0 if not $category_code or not defined $delay or $delay eq q||;
1252 SELECT borrowernumber
1254 WHERE categorycode = ? AND DATEDIFF( NOW(), dateenrolled ) > ? |;
1256 my $dbh = C4::Context->dbh;
1257 my $sth = $dbh->prepare($query);
1258 $sth->execute( $category_code, $delay );
1260 while ( my ($borrowernumber) = $sth->fetchrow_array() ) {
1261 Koha::Patrons->find($borrowernumber)->delete;
1267 =head2 DeleteUnverifiedOpacRegistrations
1269 Delete all unverified self registrations in borrower_modifications,
1270 older than the specified number of days.
1274 sub DeleteUnverifiedOpacRegistrations {
1276 my $dbh = C4::Context->dbh;
1278 DELETE FROM borrower_modifications
1279 WHERE borrowernumber = 0 AND DATEDIFF( NOW(), timestamp ) > ?|;
1280 my $cnt=$dbh->do($sql, undef, ($days) );
1281 return $cnt eq '0E0'? 0: $cnt;
1284 sub GetOverduesForPatron {
1285 my ( $borrowernumber ) = @_;
1289 FROM issues, items, biblio, biblioitems
1290 WHERE items.itemnumber=issues.itemnumber
1291 AND biblio.biblionumber = items.biblionumber
1292 AND biblio.biblionumber = biblioitems.biblionumber
1293 AND issues.borrowernumber = ?
1294 AND date_due < NOW()
1297 my $sth = C4::Context->dbh->prepare( $sql );
1298 $sth->execute( $borrowernumber );
1300 return $sth->fetchall_arrayref({});
1303 END { } # module clean-up code here (global destructor)