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;
67 &GetFirstValidEmailAddress
68 &GetNoticeEmailAddress
70 &GetMemberAccountRecords
72 &GetBorrowersToExpunge
105 C4::Members - Perl Module containing convenience functions for member handling
113 This module contains routines for adding, modifying and deleting members/patrons/borrowers
119 $flags = &patronflags($patron);
121 This function is not exported.
123 The following will be set where applicable:
124 $flags->{CHARGES}->{amount} Amount of debt
125 $flags->{CHARGES}->{noissues} Set if debt amount >$5.00 (or syspref noissuescharge)
126 $flags->{CHARGES}->{message} Message -- deprecated
128 $flags->{CREDITS}->{amount} Amount of credit
129 $flags->{CREDITS}->{message} Message -- deprecated
131 $flags->{ GNA } Patron has no valid address
132 $flags->{ GNA }->{noissues} Set for each GNA
133 $flags->{ GNA }->{message} "Borrower has no valid address" -- deprecated
135 $flags->{ LOST } Patron's card reported lost
136 $flags->{ LOST }->{noissues} Set for each LOST
137 $flags->{ LOST }->{message} Message -- deprecated
139 $flags->{DBARRED} Set if patron debarred, no access
140 $flags->{DBARRED}->{noissues} Set for each DBARRED
141 $flags->{DBARRED}->{message} Message -- deprecated
144 $flags->{ NOTES }->{message} The note itself. NOT deprecated
146 $flags->{ ODUES } Set if patron has overdue books.
147 $flags->{ ODUES }->{message} "Yes" -- deprecated
148 $flags->{ ODUES }->{itemlist} ref-to-array: list of overdue books
149 $flags->{ ODUES }->{itemlisttext} Text list of overdue items -- deprecated
151 $flags->{WAITING} Set if any of patron's reserves are available
152 $flags->{WAITING}->{message} Message -- deprecated
153 $flags->{WAITING}->{itemlist} ref-to-array: list of available items
157 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
158 overdue items. Its elements are references-to-hash, each describing an
159 overdue item. The keys are selected fields from the issues, biblio,
160 biblioitems, and items tables of the Koha database.
162 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
163 the overdue items, one per line. Deprecated.
165 =item C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
166 available items. Each element is a reference-to-hash whose keys are
167 fields from the reserves table of the Koha database.
171 All the "message" fields that include language generated in this function are deprecated,
172 because such strings belong properly in the display layer.
174 The "message" field that comes from the DB is OK.
178 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
179 # FIXME rename this function.
182 my ( $patroninformation) = @_;
183 my $dbh=C4::Context->dbh;
184 my ($balance, $owing) = GetMemberAccountBalance( $patroninformation->{'borrowernumber'});
187 my $noissuescharge = C4::Context->preference("noissuescharge") || 5;
188 $flaginfo{'message'} = sprintf 'Patron owes %.02f', $owing;
189 $flaginfo{'amount'} = sprintf "%.02f", $owing;
190 if ( $owing > $noissuescharge && !C4::Context->preference("AllowFineOverride") ) {
191 $flaginfo{'noissues'} = 1;
193 $flags{'CHARGES'} = \%flaginfo;
195 elsif ( $balance < 0 ) {
197 $flaginfo{'message'} = sprintf 'Patron has credit of %.02f', -$balance;
198 $flaginfo{'amount'} = sprintf "%.02f", $balance;
199 $flags{'CREDITS'} = \%flaginfo;
202 # Check the debt of the guarntees of this patron
203 my $no_issues_charge_guarantees = C4::Context->preference("NoIssuesChargeGuarantees");
204 $no_issues_charge_guarantees = undef unless looks_like_number( $no_issues_charge_guarantees );
205 if ( defined $no_issues_charge_guarantees ) {
206 my $p = Koha::Patrons->find( $patroninformation->{borrowernumber} );
207 my @guarantees = $p->guarantees();
208 my $guarantees_non_issues_charges;
209 foreach my $g ( @guarantees ) {
210 my ( $b, $n, $o ) = C4::Members::GetMemberAccountBalance( $g->id );
211 $guarantees_non_issues_charges += $n;
214 if ( $guarantees_non_issues_charges > $no_issues_charge_guarantees ) {
216 $flaginfo{'message'} = sprintf 'patron guarantees owe %.02f', $guarantees_non_issues_charges;
217 $flaginfo{'amount'} = $guarantees_non_issues_charges;
218 $flaginfo{'noissues'} = 1 unless C4::Context->preference("allowfineoverride");
219 $flags{'CHARGES_GUARANTEES'} = \%flaginfo;
223 if ( $patroninformation->{'gonenoaddress'}
224 && $patroninformation->{'gonenoaddress'} == 1 )
227 $flaginfo{'message'} = 'Borrower has no valid address.';
228 $flaginfo{'noissues'} = 1;
229 $flags{'GNA'} = \%flaginfo;
231 if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
233 $flaginfo{'message'} = 'Borrower\'s card reported lost.';
234 $flaginfo{'noissues'} = 1;
235 $flags{'LOST'} = \%flaginfo;
237 if ( $patroninformation->{'debarred'} && check_date( split( /-/, $patroninformation->{'debarred'} ) ) ) {
238 if ( Date_to_Days(Date::Calc::Today) < Date_to_Days( split( /-/, $patroninformation->{'debarred'} ) ) ) {
240 $flaginfo{'debarredcomment'} = $patroninformation->{'debarredcomment'};
241 $flaginfo{'message'} = $patroninformation->{'debarredcomment'};
242 $flaginfo{'noissues'} = 1;
243 $flaginfo{'dateend'} = $patroninformation->{'debarred'};
244 $flags{'DBARRED'} = \%flaginfo;
247 if ( $patroninformation->{'borrowernotes'}
248 && $patroninformation->{'borrowernotes'} )
251 $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
252 $flags{'NOTES'} = \%flaginfo;
254 my ( $odues, $itemsoverdue ) = C4::Overdues::checkoverdues($patroninformation->{'borrowernumber'});
255 if ( $odues && $odues > 0 ) {
257 $flaginfo{'message'} = "Yes";
258 $flaginfo{'itemlist'} = $itemsoverdue;
259 foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
262 $flaginfo{'itemlisttext'} .=
263 "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n"; # newline is display layer
265 $flags{'ODUES'} = \%flaginfo;
268 my $patron = Koha::Patrons->find( $patroninformation->{borrowernumber} );
269 my $waiting_holds = $patron->holds->search({ found => 'W' });
270 my $nowaiting = $waiting_holds->count;
271 if ( $nowaiting > 0 ) {
273 $flaginfo{'message'} = "Reserved items available";
274 $flaginfo{'itemlist'} = $waiting_holds->unblessed;
275 $flags{'WAITING'} = \%flaginfo;
283 my $success = ModMember(borrowernumber => $borrowernumber,
284 [ field => value ]... );
286 Modify borrower's data. All date fields should ALREADY be in ISO format.
289 true on success, or false on failure
296 # trim whitespace from data which has some non-whitespace in it.
297 foreach my $field_name (keys(%data)) {
298 if ( defined $data{$field_name} && $data{$field_name} =~ /\S/ ) {
299 $data{$field_name} =~ s/^\s*|\s*$//g;
303 # test to know if you must update or not the borrower password
304 if (exists $data{password}) {
305 if ($data{password} eq '****' or $data{password} eq '') {
306 delete $data{password};
308 if ( C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
309 # Update the hashed PIN in borrower_sync.hashed_pin, before Koha hashes it
310 Koha::NorwegianPatronDB::NLUpdateHashedPIN( $data{'borrowernumber'}, $data{password} );
312 $data{password} = hash_password($data{password});
316 my $old_categorycode = Koha::Patrons->find( $data{borrowernumber} )->categorycode;
318 # get only the columns of a borrower
319 my $schema = Koha::Database->new()->schema;
320 my @columns = $schema->source('Borrower')->columns;
321 my $new_borrower = { map { join(' ', @columns) =~ /$_/ ? ( $_ => $data{$_} ) : () } keys(%data) };
323 $new_borrower->{dateofbirth} ||= undef if exists $new_borrower->{dateofbirth};
324 $new_borrower->{dateenrolled} ||= undef if exists $new_borrower->{dateenrolled};
325 $new_borrower->{dateexpiry} ||= undef if exists $new_borrower->{dateexpiry};
326 $new_borrower->{debarred} ||= undef if exists $new_borrower->{debarred};
327 $new_borrower->{sms_provider_id} ||= undef if exists $new_borrower->{sms_provider_id};
328 $new_borrower->{guarantorid} ||= undef if exists $new_borrower->{guarantorid};
330 my $patron = Koha::Patrons->find( $new_borrower->{borrowernumber} );
332 delete $new_borrower->{userid} if exists $new_borrower->{userid} and not $new_borrower->{userid};
334 my $execute_success = $patron->store if $patron->set($new_borrower);
336 if ($execute_success) { # only proceed if the update was a success
337 # If the patron changes to a category with enrollment fee, we add a fee
338 if ( $data{categorycode} and $data{categorycode} ne $old_categorycode ) {
339 if ( C4::Context->preference('FeeOnChangePatronCategory') ) {
340 $patron->add_enrolment_fee_if_needed;
344 # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
345 # cronjob will use for syncing with NL
346 if ( C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
347 my $borrowersync = Koha::Database->new->schema->resultset('BorrowerSync')->find({
348 'synctype' => 'norwegianpatrondb',
349 'borrowernumber' => $data{'borrowernumber'}
351 # Do not set to "edited" if syncstatus is "new". We need to sync as new before
352 # we can sync as changed. And the "new sync" will pick up all changes since
353 # the patron was created anyway.
354 if ( $borrowersync->syncstatus ne 'new' && $borrowersync->syncstatus ne 'delete' ) {
355 $borrowersync->update( { 'syncstatus' => 'edited' } );
357 # Set the value of 'sync'
358 $borrowersync->update( { 'sync' => $data{'sync'} } );
359 # Try to do the live sync
360 Koha::NorwegianPatronDB::NLSync({ 'borrowernumber' => $data{'borrowernumber'} });
363 logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "UPDATE (executed w/ arg: $data{'borrowernumber'})") if C4::Context->preference("BorrowersLog");
365 return $execute_success;
370 $borrowernumber = &AddMember(%borrower);
372 insert new borrower into table
374 (%borrower keys are database columns. Database columns could be
375 different in different versions. Please look into database for correct
378 Returns the borrowernumber upon success
380 Returns as undef upon any db error without further processing
387 my $dbh = C4::Context->dbh;
388 my $schema = Koha::Database->new()->schema;
390 my $category = Koha::Patron::Categories->find( $data{categorycode} );
392 Koha::Exceptions::BadParameter->throw(
393 error => 'Invalid parameter passed',
394 parameter => 'categorycode'
398 # trim whitespace from data which has some non-whitespace in it.
399 foreach my $field_name (keys(%data)) {
400 if ( defined $data{$field_name} && $data{$field_name} =~ /\S/ ) {
401 $data{$field_name} =~ s/^\s*|\s*$//g;
405 # generate a proper login if none provided
406 $data{'userid'} = Generate_Userid( $data{'borrowernumber'}, $data{'firstname'}, $data{'surname'} )
407 if ( $data{'userid'} eq '' || !Check_Userid( $data{'userid'} ) );
409 # add expiration date if it isn't already there
410 $data{dateexpiry} ||= $category->get_expiry_date;
412 # add enrollment date if it isn't already there
413 unless ( $data{'dateenrolled'} ) {
414 $data{'dateenrolled'} = output_pref( { dt => dt_from_string, dateonly => 1, dateformat => 'iso' } );
417 if ( C4::Context->preference("autoMemberNum") ) {
418 if ( not exists $data{cardnumber} or not defined $data{cardnumber} or $data{cardnumber} eq '' ) {
419 $data{cardnumber} = fixup_cardnumber( $data{cardnumber} );
424 $category->default_privacy() eq 'default' ? 1
425 : $category->default_privacy() eq 'never' ? 2
426 : $category->default_privacy() eq 'forever' ? 0
429 $data{'privacy_guarantor_checkouts'} = 0 unless defined( $data{'privacy_guarantor_checkouts'} );
431 # Make a copy of the plain text password for later use
432 my $plain_text_password = $data{'password'};
434 # create a disabled account if no password provided
435 $data{'password'} = ($data{'password'})? hash_password($data{'password'}) : '!';
437 # we don't want invalid dates in the db (mysql has a bad habit of inserting 0000-00-00
438 $data{'dateofbirth'} = undef if ( not $data{'dateofbirth'} );
439 $data{'debarred'} = undef if ( not $data{'debarred'} );
440 $data{'sms_provider_id'} = undef if ( not $data{'sms_provider_id'} );
441 $data{'guarantorid'} = undef if ( not $data{'guarantorid'} );
443 # get only the columns of Borrower
444 # FIXME Do we really need this check?
445 my @columns = $schema->source('Borrower')->columns;
446 my $new_member = { map { join(' ',@columns) =~ /$_/ ? ( $_ => $data{$_} ) : () } keys(%data) } ;
448 delete $new_member->{borrowernumber};
450 my $patron = Koha::Patron->new( $new_member )->store;
451 $data{borrowernumber} = $patron->borrowernumber;
453 # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
454 # cronjob will use for syncing with NL
455 if ( exists $data{'borrowernumber'} && C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
456 Koha::Database->new->schema->resultset('BorrowerSync')->create({
457 'borrowernumber' => $data{'borrowernumber'},
458 'synctype' => 'norwegianpatrondb',
460 'syncstatus' => 'new',
461 'hashed_pin' => Koha::NorwegianPatronDB::NLEncryptPIN( $plain_text_password ),
465 logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
467 $patron->add_enrolment_fee_if_needed;
469 return $data{borrowernumber};
474 my $uniqueness = Check_Userid($userid,$borrowernumber);
476 $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 != '').
478 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.
481 0 for not unique (i.e. this $userid already exists)
482 1 for unique (i.e. this $userid does not exist, or this $userid/$borrowernumber combination already exists)
487 my ( $uid, $borrowernumber ) = @_;
489 return 0 unless ($uid); # userid is a unique column, we should assume NULL is not unique
491 return 0 if ( $uid eq C4::Context->config('user') );
493 my $rs = Koha::Database->new()->schema()->resultset('Borrower');
496 $params->{userid} = $uid;
497 $params->{borrowernumber} = { '!=' => $borrowernumber } if ($borrowernumber);
499 my $count = $rs->count( $params );
501 return $count ? 0 : 1;
504 =head2 Generate_Userid
506 my $newuid = Generate_Userid($borrowernumber, $firstname, $surname);
508 Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
510 $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.
513 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).
517 sub Generate_Userid {
518 my ($borrowernumber, $firstname, $surname) = @_;
521 #The script will "do" the following code and increment the $offset until Check_Userid = 1 (i.e. until $newuid comes back as unique)
523 $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
524 $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
525 $newuid = lc(($firstname)? "$firstname.$surname" : $surname);
526 $newuid = unac_string('utf-8',$newuid);
527 $newuid .= $offset unless $offset == 0;
530 } while (!Check_Userid($newuid,$borrowernumber));
535 =head2 fixup_cardnumber
537 Warning: The caller is responsible for locking the members table in write
538 mode, to avoid database corruption.
542 use vars qw( @weightings );
543 my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
545 sub fixup_cardnumber {
546 my ($cardnumber) = @_;
547 my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;
549 # Find out whether member numbers should be generated
550 # automatically. Should be either "1" or something else.
551 # Defaults to "0", which is interpreted as "no".
553 # if ($cardnumber !~ /\S/ && $autonumber_members) {
554 ($autonumber_members) or return $cardnumber;
555 my $checkdigit = C4::Context->preference('checkdigit');
556 my $dbh = C4::Context->dbh;
557 if ( $checkdigit and $checkdigit eq 'katipo' ) {
559 # if checkdigit is selected, calculate katipo-style cardnumber.
560 # otherwise, just use the max()
561 # purpose: generate checksum'd member numbers.
562 # We'll assume we just got the max value of digits 2-8 of member #'s
563 # from the database and our job is to increment that by one,
564 # determine the 1st and 9th digits and return the full string.
565 my $sth = $dbh->prepare(
566 "select max(substring(borrowers.cardnumber,2,7)) as new_num from borrowers"
569 my $data = $sth->fetchrow_hashref;
570 $cardnumber = $data->{new_num};
571 if ( !$cardnumber ) { # If DB has no values,
572 $cardnumber = 1000000; # start at 1000000
578 for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
579 # read weightings, left to right, 1 char at a time
580 my $temp1 = $weightings[$i];
582 # sequence left to right, 1 char at a time
583 my $temp2 = substr( $cardnumber, $i, 1 );
585 # mult each char 1-7 by its corresponding weighting
586 $sum += $temp1 * $temp2;
589 my $rem = ( $sum % 11 );
590 $rem = 'X' if $rem == 10;
592 return "V$cardnumber$rem";
595 my $sth = $dbh->prepare(
596 'SELECT MAX( CAST( cardnumber AS SIGNED ) ) FROM borrowers WHERE cardnumber REGEXP "^-?[0-9]+$"'
599 my ($result) = $sth->fetchrow;
602 return $cardnumber; # just here as a fallback/reminder
605 =head2 GetPendingIssues
607 my $issues = &GetPendingIssues(@borrowernumber);
609 Looks up what the patron with the given borrowernumber has borrowed.
611 C<&GetPendingIssues> returns a
612 reference-to-array where each element is a reference-to-hash; the
613 keys are the fields from the C<issues>, C<biblio>, and C<items> tables.
614 The keys include C<biblioitems> fields.
618 sub GetPendingIssues {
619 my @borrowernumbers = @_;
621 unless (@borrowernumbers ) { # return a ref_to_array
622 return \@borrowernumbers; # to not cause surprise to caller
625 # Borrowers part of the query
627 for (my $i = 0; $i < @borrowernumbers; $i++) {
628 $bquery .= ' issues.borrowernumber = ?';
629 if ($i < $#borrowernumbers ) {
634 # FIXME: namespace collision: each table has "timestamp" fields. Which one is "timestamp" ?
635 # FIXME: circ/ciculation.pl tries to sort by timestamp!
636 # FIXME: namespace collision: other collisions possible.
637 # FIXME: most of this data isn't really being used by callers.
644 biblioitems.itemtype,
647 biblioitems.publicationyear,
648 biblioitems.publishercode,
649 biblioitems.volumedate,
650 biblioitems.volumedesc,
655 borrowers.cardnumber,
656 issues.timestamp AS timestamp,
657 issues.renewals AS renewals,
658 issues.borrowernumber AS borrowernumber,
659 items.renewals AS totalrenewals
661 LEFT JOIN items ON items.itemnumber = issues.itemnumber
662 LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
663 LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
664 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
667 ORDER BY issues.issuedate"
670 my $sth = C4::Context->dbh->prepare($query);
671 $sth->execute(@borrowernumbers);
672 my $data = $sth->fetchall_arrayref({});
673 my $today = dt_from_string;
675 if ($_->{issuedate}) {
676 $_->{issuedate} = dt_from_string($_->{issuedate}, 'sql');
678 $_->{date_due_sql} = $_->{date_due};
679 # FIXME no need to have this value
680 $_->{date_due} or next;
681 $_->{date_due_sql} = $_->{date_due};
682 # FIXME no need to have this value
683 $_->{date_due} = dt_from_string($_->{date_due}, 'sql');
684 if ( DateTime->compare($_->{date_due}, $today) == -1 ) {
693 $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
695 Looks up what the patron with the given borrowernumber has borrowed,
696 and sorts the results.
698 C<$sortkey> is the name of a field on which to sort the results. This
699 should be the name of a field in the C<issues>, C<biblio>,
700 C<biblioitems>, or C<items> table in the Koha database.
702 C<$limit> is the maximum number of results to return.
704 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
705 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
706 C<items> tables of the Koha database.
712 my ( $borrowernumber, $order, $limit ) = @_;
714 return unless $borrowernumber;
715 $order = 'date_due desc' unless $order;
717 my $dbh = C4::Context->dbh;
719 'SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
721 LEFT JOIN items on items.itemnumber=issues.itemnumber
722 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
723 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
724 WHERE borrowernumber=?
726 SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
728 LEFT JOIN items on items.itemnumber=old_issues.itemnumber
729 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
730 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
731 WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL
734 $query .= " limit $limit";
737 my $sth = $dbh->prepare($query);
738 $sth->execute( $borrowernumber, $borrowernumber );
739 return $sth->fetchall_arrayref( {} );
743 =head2 GetMemberAccountRecords
745 ($total, $acctlines, $count) = &GetMemberAccountRecords($borrowernumber);
747 Looks up accounting data for the patron with the given borrowernumber.
749 C<&GetMemberAccountRecords> returns a three-element array. C<$acctlines> is a
750 reference-to-array, where each element is a reference-to-hash; the
751 keys are the fields of the C<accountlines> table in the Koha database.
752 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
753 total amount outstanding for all of the account lines.
757 sub GetMemberAccountRecords {
758 my ($borrowernumber) = @_;
759 my $dbh = C4::Context->dbh;
765 WHERE borrowernumber=?);
766 $strsth.=" ORDER BY accountlines_id desc";
767 my $sth= $dbh->prepare( $strsth );
768 $sth->execute( $borrowernumber );
771 while ( my $data = $sth->fetchrow_hashref ) {
772 if ( $data->{itemnumber} ) {
773 my $item = Koha::Items->find( $data->{itemnumber} );
774 my $biblio = $item->biblio;
775 $data->{biblionumber} = $biblio->biblionumber;
776 $data->{title} = $biblio->title;
778 $acctlines[$numlines] = $data;
780 $total += sprintf "%.0f", 1000*$data->{amountoutstanding}; # convert float to integer to avoid round-off errors
783 return ( $total, \@acctlines,$numlines);
786 =head2 GetMemberAccountBalance
788 ($total_balance, $non_issue_balance, $other_charges) = &GetMemberAccountBalance($borrowernumber);
790 Calculates amount immediately owing by the patron - non-issue charges.
791 Based on GetMemberAccountRecords.
792 Charges exempt from non-issue are:
794 * Rent (rental) if RentalsInNoissuesCharge syspref is set to false
795 * Manual invoices if ManInvInNoissuesCharge syspref is set to false
799 sub GetMemberAccountBalance {
800 my ($borrowernumber) = @_;
802 my $ACCOUNT_TYPE_LENGTH = 5; # this is plain ridiculous...
805 push @not_fines, 'Res' unless C4::Context->preference('HoldsInNoissuesCharge');
806 push @not_fines, 'Rent' unless C4::Context->preference('RentalsInNoissuesCharge');
807 unless ( C4::Context->preference('ManInvInNoissuesCharge') ) {
808 my $dbh = C4::Context->dbh;
809 my $man_inv_types = $dbh->selectcol_arrayref(qq{SELECT authorised_value FROM authorised_values WHERE category = 'MANUAL_INV'});
810 push @not_fines, map substr($_, 0, $ACCOUNT_TYPE_LENGTH), @$man_inv_types;
812 my %not_fine = map {$_ => 1} @not_fines;
814 my ($total, $acctlines) = GetMemberAccountRecords($borrowernumber);
815 my $other_charges = 0;
816 foreach (@$acctlines) {
817 $other_charges += $_->{amountoutstanding} if $not_fine{ substr($_->{accounttype}, 0, $ACCOUNT_TYPE_LENGTH) };
820 return ( $total, $total - $other_charges, $other_charges);
823 sub checkcardnumber {
824 my ( $cardnumber, $borrowernumber ) = @_;
826 # If cardnumber is null, we assume they're allowed.
827 return 0 unless defined $cardnumber;
829 my $dbh = C4::Context->dbh;
830 my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
831 $query .= " AND borrowernumber <> ?" if ($borrowernumber);
832 my $sth = $dbh->prepare($query);
835 ( $borrowernumber ? $borrowernumber : () )
838 return 1 if $sth->fetchrow_hashref;
840 my ( $min_length, $max_length ) = get_cardnumber_length();
842 if length $cardnumber > $max_length
843 or length $cardnumber < $min_length;
848 =head2 get_cardnumber_length
850 my ($min, $max) = C4::Members::get_cardnumber_length()
852 Returns the minimum and maximum length for patron cardnumbers as
853 determined by the CardnumberLength system preference, the
854 BorrowerMandatoryField system preference, and the width of the
859 sub get_cardnumber_length {
860 my $borrower = Koha::Schema->resultset('Borrower');
861 my $field_size = $borrower->result_source->column_info('cardnumber')->{size};
862 my ( $min, $max ) = ( 0, $field_size ); # borrowers.cardnumber is a nullable varchar(20)
863 $min = 1 if C4::Context->preference('BorrowerMandatoryField') =~ /cardnumber/;
864 if ( my $cardnumber_length = C4::Context->preference('CardnumberLength') ) {
865 # Is integer and length match
866 if ( $cardnumber_length =~ m|^\d+$| ) {
867 $min = $max = $cardnumber_length
868 if $cardnumber_length >= $min
869 and $cardnumber_length <= $max;
871 # Else assuming it is a range
872 elsif ( $cardnumber_length =~ m|(\d*),(\d*)| ) {
873 $min = $1 if $1 and $min < $1;
874 $max = $2 if $2 and $max > $2;
878 $min = $max if $min > $max;
879 return ( $min, $max );
882 =head2 GetFirstValidEmailAddress
884 $email = GetFirstValidEmailAddress($borrowernumber);
886 Return the first valid email address for a borrower, given the borrowernumber. For now, the order
887 is defined as email, emailpro, B_email. Returns the empty string if the borrower has no email
892 sub GetFirstValidEmailAddress {
893 my $borrowernumber = shift;
895 my $borrower = Koha::Patrons->find( $borrowernumber );
897 return $borrower->first_valid_email_address();
900 =head2 GetNoticeEmailAddress
902 $email = GetNoticeEmailAddress($borrowernumber);
904 Return the email address of borrower used for notices, given the borrowernumber.
905 Returns the empty string if no email address.
909 sub GetNoticeEmailAddress {
910 my $borrowernumber = shift;
912 my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
913 # if syspref is set to 'first valid' (value == OFF), look up email address
914 if ( $which_address eq 'OFF' ) {
915 return GetFirstValidEmailAddress($borrowernumber);
917 # specified email address field
918 my $dbh = C4::Context->dbh;
919 my $sth = $dbh->prepare( qq{
920 SELECT $which_address AS primaryemail
922 WHERE borrowernumber=?
924 $sth->execute($borrowernumber);
925 my $data = $sth->fetchrow_hashref;
926 return $data->{'primaryemail'} || '';
929 =head2 GetBorrowersToExpunge
931 $borrowers = &GetBorrowersToExpunge(
932 not_borrowed_since => $not_borrowed_since,
933 expired_before => $expired_before,
934 category_code => $category_code,
935 patron_list_id => $patron_list_id,
936 branchcode => $branchcode
939 This function get all borrowers based on the given criteria.
943 sub GetBorrowersToExpunge {
946 my $filterdate = $params->{'not_borrowed_since'};
947 my $filterexpiry = $params->{'expired_before'};
948 my $filterlastseen = $params->{'last_seen'};
949 my $filtercategory = $params->{'category_code'};
950 my $filterbranch = $params->{'branchcode'} ||
951 ((C4::Context->preference('IndependentBranches')
952 && C4::Context->userenv
953 && !C4::Context->IsSuperLibrarian()
954 && C4::Context->userenv->{branch})
955 ? C4::Context->userenv->{branch}
957 my $filterpatronlist = $params->{'patron_list_id'};
959 my $dbh = C4::Context->dbh;
961 SELECT borrowers.borrowernumber,
962 MAX(old_issues.timestamp) AS latestissue,
963 MAX(issues.timestamp) AS currentissue
965 JOIN categories USING (categorycode)
969 WHERE guarantorid IS NOT NULL
971 ) as tmp ON borrowers.borrowernumber=tmp.guarantorid
972 LEFT JOIN old_issues USING (borrowernumber)
973 LEFT JOIN issues USING (borrowernumber)|;
974 if ( $filterpatronlist ){
975 $query .= q| LEFT JOIN patron_list_patrons USING (borrowernumber)|;
977 $query .= q| WHERE category_type <> 'S'
978 AND tmp.guarantorid IS NULL
981 if ( $filterbranch && $filterbranch ne "" ) {
982 $query.= " AND borrowers.branchcode = ? ";
983 push( @query_params, $filterbranch );
985 if ( $filterexpiry ) {
986 $query .= " AND dateexpiry < ? ";
987 push( @query_params, $filterexpiry );
989 if ( $filterlastseen ) {
990 $query .= ' AND lastseen < ? ';
991 push @query_params, $filterlastseen;
993 if ( $filtercategory ) {
994 $query .= " AND categorycode = ? ";
995 push( @query_params, $filtercategory );
997 if ( $filterpatronlist ){
998 $query.=" AND patron_list_id = ? ";
999 push( @query_params, $filterpatronlist );
1001 $query.=" GROUP BY borrowers.borrowernumber HAVING currentissue IS NULL ";
1002 if ( $filterdate ) {
1003 $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
1004 push @query_params,$filterdate;
1006 warn $query if $debug;
1008 my $sth = $dbh->prepare($query);
1009 if (scalar(@query_params)>0){
1010 $sth->execute(@query_params);
1017 while ( my $data = $sth->fetchrow_hashref ) {
1018 push @results, $data;
1025 IssueSlip($branchcode, $borrowernumber, $quickslip)
1027 Returns letter hash ( see C4::Letters::GetPreparedLetter )
1029 $quickslip is boolean, to indicate whether we want a quick slip
1031 IssueSlip populates ISSUESLIP and ISSUEQSLIP, and will make the following expansions:
1067 NOTE: Not all table fields are available, pleasee see GetPendingIssues for a list of available fields.
1072 my ($branch, $borrowernumber, $quickslip) = @_;
1074 # FIXME Check callers before removing this statement
1075 #return unless $borrowernumber;
1077 my $patron = Koha::Patrons->find( $borrowernumber );
1078 return unless $patron;
1080 my @issues = @{ GetPendingIssues($borrowernumber) };
1082 for my $issue (@issues) {
1083 $issue->{date_due} = $issue->{date_due_sql};
1085 my $today = output_pref({ dt => dt_from_string, dateformat => 'iso', dateonly => 1 });
1086 if ( substr( $issue->{issuedate}, 0, 10 ) eq $today
1087 or substr( $issue->{lastreneweddate}, 0, 10 ) eq $today ) {
1093 # Sort on timestamp then on issuedate then on issue_id
1094 # useful for tests and could be if modified in a batch
1096 $b->{timestamp} <=> $a->{timestamp}
1097 or $b->{issuedate} <=> $a->{issuedate}
1098 or $b->{issue_id} <=> $a->{issue_id}
1101 my ($letter_code, %repeat, %loops);
1103 $letter_code = 'ISSUEQSLIP';
1104 my @checkouts = map {
1107 'biblioitems' => $_,
1109 }, grep { $_->{'now'} } @issues;
1111 checkedout => \@checkouts, # History syntax
1114 issues => [ map { $_->{issues}{itemnumber} } @checkouts ], # TT syntax
1118 my @checkouts = map {
1121 'biblioitems' => $_,
1123 }, grep { !$_->{'overdue'} } @issues;
1124 my @overdues = map {
1127 'biblioitems' => $_,
1129 }, grep { $_->{'overdue'} } @issues;
1130 my $news = GetNewsToDisplay( "slip", $branch );
1132 $_->{'timestamp'} = $_->{'newdate'};
1135 $letter_code = 'ISSUESLIP';
1137 checkedout => \@checkouts,
1138 overdue => \@overdues,
1142 issues => [ map { $_->{issues}{itemnumber} } @checkouts ],
1143 overdues => [ map { $_->{issues}{itemnumber} } @overdues ],
1144 opac_news => [ map { $_->{opac_news}{idnew} } @news ],
1148 return C4::Letters::GetPreparedLetter (
1149 module => 'circulation',
1150 letter_code => $letter_code,
1151 branchcode => $branch,
1152 lang => $patron->lang,
1154 'branches' => $branch,
1155 'borrowers' => $borrowernumber,
1162 =head2 AddMember_Auto
1166 sub AddMember_Auto {
1167 my ( %borrower ) = @_;
1169 $borrower{'cardnumber'} ||= fixup_cardnumber();
1171 $borrower{'borrowernumber'} = AddMember(%borrower);
1173 return ( %borrower );
1176 =head2 AddMember_Opac
1180 sub AddMember_Opac {
1181 my ( %borrower ) = @_;
1183 $borrower{'categorycode'} //= C4::Context->preference('PatronSelfRegistrationDefaultCategory');
1184 if (not defined $borrower{'password'}){
1185 my $sr = new String::Random;
1186 $sr->{'A'} = [ 'A'..'Z', 'a'..'z' ];
1187 my $password = $sr->randpattern("AAAAAAAAAA");
1188 $borrower{'password'} = $password;
1191 %borrower = AddMember_Auto(%borrower);
1193 return ( $borrower{'borrowernumber'}, $borrower{'password'} );
1196 =head2 DeleteExpiredOpacRegistrations
1198 Delete accounts that haven't been upgraded from the 'temporary' category
1199 Returns the number of removed patrons
1203 sub DeleteExpiredOpacRegistrations {
1205 my $delay = C4::Context->preference('PatronSelfRegistrationExpireTemporaryAccountsDelay');
1206 my $category_code = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
1208 return 0 if not $category_code or not defined $delay or $delay eq q||;
1211 SELECT borrowernumber
1213 WHERE categorycode = ? AND DATEDIFF( NOW(), dateenrolled ) > ? |;
1215 my $dbh = C4::Context->dbh;
1216 my $sth = $dbh->prepare($query);
1217 $sth->execute( $category_code, $delay );
1219 while ( my ($borrowernumber) = $sth->fetchrow_array() ) {
1220 Koha::Patrons->find($borrowernumber)->delete;
1226 =head2 DeleteUnverifiedOpacRegistrations
1228 Delete all unverified self registrations in borrower_modifications,
1229 older than the specified number of days.
1233 sub DeleteUnverifiedOpacRegistrations {
1235 my $dbh = C4::Context->dbh;
1237 DELETE FROM borrower_modifications
1238 WHERE borrowernumber = 0 AND DATEDIFF( NOW(), timestamp ) > ?|;
1239 my $cnt=$dbh->do($sql, undef, ($days) );
1240 return $cnt eq '0E0'? 0: $cnt;
1243 sub GetOverduesForPatron {
1244 my ( $borrowernumber ) = @_;
1248 FROM issues, items, biblio, biblioitems
1249 WHERE items.itemnumber=issues.itemnumber
1250 AND biblio.biblionumber = items.biblionumber
1251 AND biblio.biblionumber = biblioitems.biblionumber
1252 AND issues.borrowernumber = ?
1253 AND date_due < NOW()
1256 my $sth = C4::Context->dbh->prepare( $sql );
1257 $sth->execute( $borrowernumber );
1259 return $sth->fetchall_arrayref({});
1262 END { } # module clean-up code here (global destructor)