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 List::MoreUtils qw( uniq );
31 use C4::Log; # logaction
37 use C4::Members::Attributes qw(SearchIdMatchingAttribute UpdateBorrowerAttribute);
38 use C4::NewsChannels; #get slip news
42 use Text::Unaccent qw( unac_string );
43 use Koha::AuthUtils qw(hash_password);
46 use Koha::List::Patron;
48 use Koha::Patron::Categories;
51 our (@ISA,@EXPORT,@EXPORT_OK,$debug);
53 use Module::Load::Conditional qw( can_load );
54 if ( ! can_load( modules => { 'Koha::NorwegianPatronDB' => undef } ) ) {
55 $debug && warn "Unable to load Koha::NorwegianPatronDB";
60 $debug = $ENV{DEBUG} || 0;
68 &GetBorrowersToExpunge
87 C4::Members - Perl Module containing convenience functions for member handling
95 This module contains routines for adding, modifying and deleting members/patrons/borrowers
101 $flags = &patronflags($patron);
103 This function is not exported.
105 The following will be set where applicable:
106 $flags->{CHARGES}->{amount} Amount of debt
107 $flags->{CHARGES}->{noissues} Set if debt amount >$5.00 (or syspref noissuescharge)
108 $flags->{CHARGES}->{message} Message -- deprecated
110 $flags->{CREDITS}->{amount} Amount of credit
111 $flags->{CREDITS}->{message} Message -- deprecated
113 $flags->{ GNA } Patron has no valid address
114 $flags->{ GNA }->{noissues} Set for each GNA
115 $flags->{ GNA }->{message} "Borrower has no valid address" -- deprecated
117 $flags->{ LOST } Patron's card reported lost
118 $flags->{ LOST }->{noissues} Set for each LOST
119 $flags->{ LOST }->{message} Message -- deprecated
121 $flags->{DBARRED} Set if patron debarred, no access
122 $flags->{DBARRED}->{noissues} Set for each DBARRED
123 $flags->{DBARRED}->{message} Message -- deprecated
126 $flags->{ NOTES }->{message} The note itself. NOT deprecated
128 $flags->{ ODUES } Set if patron has overdue books.
129 $flags->{ ODUES }->{message} "Yes" -- deprecated
130 $flags->{ ODUES }->{itemlist} ref-to-array: list of overdue books
131 $flags->{ ODUES }->{itemlisttext} Text list of overdue items -- deprecated
133 $flags->{WAITING} Set if any of patron's reserves are available
134 $flags->{WAITING}->{message} Message -- deprecated
135 $flags->{WAITING}->{itemlist} ref-to-array: list of available items
139 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
140 overdue items. Its elements are references-to-hash, each describing an
141 overdue item. The keys are selected fields from the issues, biblio,
142 biblioitems, and items tables of the Koha database.
144 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
145 the overdue items, one per line. Deprecated.
147 =item C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
148 available items. Each element is a reference-to-hash whose keys are
149 fields from the reserves table of the Koha database.
153 All the "message" fields that include language generated in this function are deprecated,
154 because such strings belong properly in the display layer.
156 The "message" field that comes from the DB is OK.
160 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
161 # FIXME rename this function.
162 # DEPRECATED Do not use this subroutine!
165 my ( $patroninformation) = @_;
166 my $dbh=C4::Context->dbh;
167 my $patron = Koha::Patrons->find( $patroninformation->{borrowernumber} );
168 my $account = $patron->account;
169 my $owing = $account->non_issues_charges;
172 my $noissuescharge = C4::Context->preference("noissuescharge") || 5;
173 $flaginfo{'message'} = sprintf 'Patron owes %.02f', $owing;
174 $flaginfo{'amount'} = sprintf "%.02f", $owing;
175 if ( $owing > $noissuescharge && !C4::Context->preference("AllowFineOverride") ) {
176 $flaginfo{'noissues'} = 1;
178 $flags{'CHARGES'} = \%flaginfo;
180 elsif ( ( my $balance = $account->balance ) < 0 ) {
182 $flaginfo{'message'} = sprintf 'Patron has credit of %.02f', -$balance;
183 $flaginfo{'amount'} = sprintf "%.02f", $balance;
184 $flags{'CREDITS'} = \%flaginfo;
187 # Check the debt of the guarntees of this patron
188 my $no_issues_charge_guarantees = C4::Context->preference("NoIssuesChargeGuarantees");
189 $no_issues_charge_guarantees = undef unless looks_like_number( $no_issues_charge_guarantees );
190 if ( defined $no_issues_charge_guarantees ) {
191 my $p = Koha::Patrons->find( $patroninformation->{borrowernumber} );
192 my @guarantees = $p->guarantees();
193 my $guarantees_non_issues_charges;
194 foreach my $g ( @guarantees ) {
195 $guarantees_non_issues_charges += $g->account->non_issues_charges;
198 if ( $guarantees_non_issues_charges > $no_issues_charge_guarantees ) {
200 $flaginfo{'message'} = sprintf 'patron guarantees owe %.02f', $guarantees_non_issues_charges;
201 $flaginfo{'amount'} = $guarantees_non_issues_charges;
202 $flaginfo{'noissues'} = 1 unless C4::Context->preference("allowfineoverride");
203 $flags{'CHARGES_GUARANTEES'} = \%flaginfo;
207 if ( $patroninformation->{'gonenoaddress'}
208 && $patroninformation->{'gonenoaddress'} == 1 )
211 $flaginfo{'message'} = 'Borrower has no valid address.';
212 $flaginfo{'noissues'} = 1;
213 $flags{'GNA'} = \%flaginfo;
215 if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
217 $flaginfo{'message'} = 'Borrower\'s card reported lost.';
218 $flaginfo{'noissues'} = 1;
219 $flags{'LOST'} = \%flaginfo;
221 if ( $patroninformation->{'debarred'} && check_date( split( /-/, $patroninformation->{'debarred'} ) ) ) {
222 if ( Date_to_Days(Date::Calc::Today) < Date_to_Days( split( /-/, $patroninformation->{'debarred'} ) ) ) {
224 $flaginfo{'debarredcomment'} = $patroninformation->{'debarredcomment'};
225 $flaginfo{'message'} = $patroninformation->{'debarredcomment'};
226 $flaginfo{'noissues'} = 1;
227 $flaginfo{'dateend'} = $patroninformation->{'debarred'};
228 $flags{'DBARRED'} = \%flaginfo;
231 if ( $patroninformation->{'borrowernotes'}
232 && $patroninformation->{'borrowernotes'} )
235 $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
236 $flags{'NOTES'} = \%flaginfo;
238 my ( $odues, $itemsoverdue ) = C4::Overdues::checkoverdues($patroninformation->{'borrowernumber'});
239 if ( $odues && $odues > 0 ) {
241 $flaginfo{'message'} = "Yes";
242 $flaginfo{'itemlist'} = $itemsoverdue;
243 foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
246 $flaginfo{'itemlisttext'} .=
247 "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n"; # newline is display layer
249 $flags{'ODUES'} = \%flaginfo;
252 my $waiting_holds = $patron->holds->search({ found => 'W' });
253 my $nowaiting = $waiting_holds->count;
254 if ( $nowaiting > 0 ) {
256 $flaginfo{'message'} = "Reserved items available";
257 $flaginfo{'itemlist'} = $waiting_holds->unblessed;
258 $flags{'WAITING'} = \%flaginfo;
265 $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
267 Looks up what the patron with the given borrowernumber has borrowed,
268 and sorts the results.
270 C<$sortkey> is the name of a field on which to sort the results. This
271 should be the name of a field in the C<issues>, C<biblio>,
272 C<biblioitems>, or C<items> table in the Koha database.
274 C<$limit> is the maximum number of results to return.
276 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
277 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
278 C<items> tables of the Koha database.
284 my ( $borrowernumber, $order, $limit ) = @_;
286 return unless $borrowernumber;
287 $order = 'date_due desc' unless $order;
289 my $dbh = C4::Context->dbh;
291 'SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
293 LEFT JOIN items on items.itemnumber=issues.itemnumber
294 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
295 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
296 WHERE borrowernumber=?
298 SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
300 LEFT JOIN items on items.itemnumber=old_issues.itemnumber
301 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
302 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
303 WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL
306 $query .= " limit $limit";
309 my $sth = $dbh->prepare($query);
310 $sth->execute( $borrowernumber, $borrowernumber );
311 return $sth->fetchall_arrayref( {} );
314 sub checkcardnumber {
315 my ( $cardnumber, $borrowernumber ) = @_;
317 # If cardnumber is null, we assume they're allowed.
318 return 0 unless defined $cardnumber;
320 my $dbh = C4::Context->dbh;
321 my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
322 $query .= " AND borrowernumber <> ?" if ($borrowernumber);
323 my $sth = $dbh->prepare($query);
326 ( $borrowernumber ? $borrowernumber : () )
329 return 1 if $sth->fetchrow_hashref;
331 my ( $min_length, $max_length ) = get_cardnumber_length();
333 if length $cardnumber > $max_length
334 or length $cardnumber < $min_length;
339 =head2 get_cardnumber_length
341 my ($min, $max) = C4::Members::get_cardnumber_length()
343 Returns the minimum and maximum length for patron cardnumbers as
344 determined by the CardnumberLength system preference, the
345 BorrowerMandatoryField system preference, and the width of the
350 sub get_cardnumber_length {
351 my $borrower = Koha::Schema->resultset('Borrower');
352 my $field_size = $borrower->result_source->column_info('cardnumber')->{size};
353 my ( $min, $max ) = ( 0, $field_size ); # borrowers.cardnumber is a nullable varchar(20)
354 $min = 1 if C4::Context->preference('BorrowerMandatoryField') =~ /cardnumber/;
355 if ( my $cardnumber_length = C4::Context->preference('CardnumberLength') ) {
356 # Is integer and length match
357 if ( $cardnumber_length =~ m|^\d+$| ) {
358 $min = $max = $cardnumber_length
359 if $cardnumber_length >= $min
360 and $cardnumber_length <= $max;
362 # Else assuming it is a range
363 elsif ( $cardnumber_length =~ m|(\d*),(\d*)| ) {
364 $min = $1 if $1 and $min < $1;
365 $max = $2 if $2 and $max > $2;
369 $min = $max if $min > $max;
370 return ( $min, $max );
373 =head2 GetBorrowersToExpunge
375 $borrowers = &GetBorrowersToExpunge(
376 not_borrowed_since => $not_borrowed_since,
377 expired_before => $expired_before,
378 category_code => $category_code,
379 patron_list_id => $patron_list_id,
380 branchcode => $branchcode
383 This function get all borrowers based on the given criteria.
387 sub GetBorrowersToExpunge {
390 my $filterdate = $params->{'not_borrowed_since'};
391 my $filterexpiry = $params->{'expired_before'};
392 my $filterlastseen = $params->{'last_seen'};
393 my $filtercategory = $params->{'category_code'};
394 my $filterbranch = $params->{'branchcode'} ||
395 ((C4::Context->preference('IndependentBranches')
396 && C4::Context->userenv
397 && !C4::Context->IsSuperLibrarian()
398 && C4::Context->userenv->{branch})
399 ? C4::Context->userenv->{branch}
401 my $filterpatronlist = $params->{'patron_list_id'};
403 my $dbh = C4::Context->dbh;
407 SELECT borrowers.borrowernumber,
408 MAX(old_issues.timestamp) AS latestissue,
409 MAX(issues.timestamp) AS currentissue
411 JOIN categories USING (categorycode)
415 WHERE guarantorid IS NOT NULL
417 ) as tmp ON borrowers.borrowernumber=tmp.guarantorid
418 LEFT JOIN old_issues USING (borrowernumber)
419 LEFT JOIN issues USING (borrowernumber)|;
420 if ( $filterpatronlist ){
421 $query .= q| LEFT JOIN patron_list_patrons USING (borrowernumber)|;
423 $query .= q| WHERE category_type <> 'S'
424 AND tmp.guarantorid IS NULL
427 if ( $filterbranch && $filterbranch ne "" ) {
428 $query.= " AND borrowers.branchcode = ? ";
429 push( @query_params, $filterbranch );
431 if ( $filterexpiry ) {
432 $query .= " AND dateexpiry < ? ";
433 push( @query_params, $filterexpiry );
435 if ( $filterlastseen ) {
436 $query .= ' AND lastseen < ? ';
437 push @query_params, $filterlastseen;
439 if ( $filtercategory ) {
440 $query .= " AND categorycode = ? ";
441 push( @query_params, $filtercategory );
443 if ( $filterpatronlist ){
444 $query.=" AND patron_list_id = ? ";
445 push( @query_params, $filterpatronlist );
447 $query .= " GROUP BY borrowers.borrowernumber";
449 ) xxx WHERE currentissue IS NULL|;
451 $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
452 push @query_params,$filterdate;
455 warn $query if $debug;
457 my $sth = $dbh->prepare($query);
458 if (scalar(@query_params)>0){
459 $sth->execute(@query_params);
466 while ( my $data = $sth->fetchrow_hashref ) {
467 push @results, $data;
474 IssueSlip($branchcode, $borrowernumber, $quickslip)
476 Returns letter hash ( see C4::Letters::GetPreparedLetter )
478 $quickslip is boolean, to indicate whether we want a quick slip
480 IssueSlip populates ISSUESLIP and ISSUEQSLIP, and will make the following expansions:
516 NOTE: Fields from tables issues, items, biblio and biblioitems are available
521 my ($branch, $borrowernumber, $quickslip) = @_;
523 # FIXME Check callers before removing this statement
524 #return unless $borrowernumber;
526 my $patron = Koha::Patrons->find( $borrowernumber );
527 return unless $patron;
529 my $pending_checkouts = $patron->pending_checkouts; # Should be $patron->checkouts->pending?
531 my ($letter_code, %repeat, %loops);
533 my $today_start = dt_from_string->set( hour => 0, minute => 0, second => 0 );
534 my $today_end = dt_from_string->set( hour => 23, minute => 59, second => 0 );
535 $today_start = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_start );
536 $today_end = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_end );
537 $letter_code = 'ISSUEQSLIP';
539 # issue date or lastreneweddate is today
540 my $todays_checkouts = $pending_checkouts->search(
544 '>=' => $today_start,
548 { '>=' => $today_start, '<=' => $today_end, }
553 while ( my $c = $todays_checkouts->next ) {
554 my $all = $c->unblessed_all_relateds;
564 checkedout => \@checkouts, # Historical syntax
567 issues => [ map { $_->{issues}{itemnumber} } @checkouts ], # TT syntax
571 my $today = Koha::Database->new->schema->storage->datetime_parser->format_datetime( dt_from_string );
572 # Checkouts due in the future
573 my $checkouts = $pending_checkouts->search({ date_due => { '>' => $today } });
574 my @checkouts; my @overdues;
575 while ( my $c = $checkouts->next ) {
576 my $all = $c->unblessed_all_relateds;
585 # Checkouts due in the past are overdues
586 my $overdues = $pending_checkouts->search({ date_due => { '<=' => $today } });
587 while ( my $o = $overdues->next ) {
588 my $all = $o->unblessed_all_relateds;
596 my $news = GetNewsToDisplay( "slip", $branch );
598 $_->{'timestamp'} = $_->{'newdate'};
601 $letter_code = 'ISSUESLIP';
603 checkedout => \@checkouts,
604 overdue => \@overdues,
608 issues => [ map { $_->{issues}{itemnumber} } @checkouts ],
609 overdues => [ map { $_->{issues}{itemnumber} } @overdues ],
610 opac_news => [ map { $_->{opac_news}{idnew} } @news ],
614 return C4::Letters::GetPreparedLetter (
615 module => 'circulation',
616 letter_code => $letter_code,
617 branchcode => $branch,
618 lang => $patron->lang,
620 'branches' => $branch,
621 'borrowers' => $borrowernumber,
628 =head2 DeleteExpiredOpacRegistrations
630 Delete accounts that haven't been upgraded from the 'temporary' category
631 Returns the number of removed patrons
635 sub DeleteExpiredOpacRegistrations {
637 my $delay = C4::Context->preference('PatronSelfRegistrationExpireTemporaryAccountsDelay');
638 my $category_code = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
640 return 0 if not $category_code or not defined $delay or $delay eq q||;
643 SELECT borrowernumber
645 WHERE categorycode = ? AND DATEDIFF( NOW(), dateenrolled ) > ? |;
647 my $dbh = C4::Context->dbh;
648 my $sth = $dbh->prepare($query);
649 $sth->execute( $category_code, $delay );
651 while ( my ($borrowernumber) = $sth->fetchrow_array() ) {
652 Koha::Patrons->find($borrowernumber)->delete;
658 =head2 DeleteUnverifiedOpacRegistrations
660 Delete all unverified self registrations in borrower_modifications,
661 older than the specified number of days.
665 sub DeleteUnverifiedOpacRegistrations {
667 my $dbh = C4::Context->dbh;
669 DELETE FROM borrower_modifications
670 WHERE borrowernumber = 0 AND DATEDIFF( NOW(), timestamp ) > ?|;
671 my $cnt=$dbh->do($sql, undef, ($days) );
672 return $cnt eq '0E0'? 0: $cnt;
675 END { } # module clean-up code here (global destructor)