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>.
25 use String::Random qw( random_string );
26 use Scalar::Util qw( looks_like_number );
27 use Date::Calc qw/Today check_date Date_to_Days/;
28 use List::MoreUtils qw( uniq );
30 use C4::Log; # logaction
36 use C4::NewsChannels; #get slip news
40 use Koha::AuthUtils qw(hash_password);
43 use Koha::List::Patron;
45 use Koha::Patron::Categories;
47 our (@ISA,@EXPORT,@EXPORT_OK,$debug);
50 $debug = $ENV{DEBUG} || 0;
58 &GetBorrowersToExpunge
72 C4::Members - Perl Module containing convenience functions for member handling
80 This module contains routines for adding, modifying and deleting members/patrons/borrowers
86 $flags = &patronflags($patron);
88 This function is not exported.
90 The following will be set where applicable:
91 $flags->{CHARGES}->{amount} Amount of debt
92 $flags->{CHARGES}->{noissues} Set if debt amount >$5.00 (or syspref noissuescharge)
93 $flags->{CHARGES}->{message} Message -- deprecated
95 $flags->{CREDITS}->{amount} Amount of credit
96 $flags->{CREDITS}->{message} Message -- deprecated
98 $flags->{ GNA } Patron has no valid address
99 $flags->{ GNA }->{noissues} Set for each GNA
100 $flags->{ GNA }->{message} "Borrower has no valid address" -- deprecated
102 $flags->{ LOST } Patron's card reported lost
103 $flags->{ LOST }->{noissues} Set for each LOST
104 $flags->{ LOST }->{message} Message -- deprecated
106 $flags->{DBARRED} Set if patron debarred, no access
107 $flags->{DBARRED}->{noissues} Set for each DBARRED
108 $flags->{DBARRED}->{message} Message -- deprecated
111 $flags->{ NOTES }->{message} The note itself. NOT deprecated
113 $flags->{ ODUES } Set if patron has overdue books.
114 $flags->{ ODUES }->{message} "Yes" -- deprecated
115 $flags->{ ODUES }->{itemlist} ref-to-array: list of overdue books
116 $flags->{ ODUES }->{itemlisttext} Text list of overdue items -- deprecated
118 $flags->{WAITING} Set if any of patron's reserves are available
119 $flags->{WAITING}->{message} Message -- deprecated
120 $flags->{WAITING}->{itemlist} ref-to-array: list of available items
124 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
125 overdue items. Its elements are references-to-hash, each describing an
126 overdue item. The keys are selected fields from the issues, biblio,
127 biblioitems, and items tables of the Koha database.
129 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
130 the overdue items, one per line. Deprecated.
132 =item C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
133 available items. Each element is a reference-to-hash whose keys are
134 fields from the reserves table of the Koha database.
138 All the "message" fields that include language generated in this function are deprecated,
139 because such strings belong properly in the display layer.
141 The "message" field that comes from the DB is OK.
145 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
146 # FIXME rename this function.
147 # DEPRECATED Do not use this subroutine!
150 my ( $patroninformation) = @_;
151 my $dbh=C4::Context->dbh;
152 my $patron = Koha::Patrons->find( $patroninformation->{borrowernumber} );
153 my $account = $patron->account;
154 my $owing = $account->non_issues_charges;
157 my $noissuescharge = C4::Context->preference("noissuescharge") || 5;
158 $flaginfo{'message'} = sprintf 'Patron owes %.02f', $owing;
159 $flaginfo{'amount'} = sprintf "%.02f", $owing;
160 if ( $owing > $noissuescharge && !C4::Context->preference("AllowFineOverride") ) {
161 $flaginfo{'noissues'} = 1;
163 $flags{'CHARGES'} = \%flaginfo;
165 elsif ( ( my $balance = $account->balance ) < 0 ) {
167 $flaginfo{'message'} = sprintf 'Patron has credit of %.02f', -$balance;
168 $flaginfo{'amount'} = sprintf "%.02f", $balance;
169 $flags{'CREDITS'} = \%flaginfo;
172 # Check the debt of the guarntees of this patron
173 my $no_issues_charge_guarantees = C4::Context->preference("NoIssuesChargeGuarantees");
174 $no_issues_charge_guarantees = undef unless looks_like_number( $no_issues_charge_guarantees );
175 if ( defined $no_issues_charge_guarantees ) {
176 my $p = Koha::Patrons->find( $patroninformation->{borrowernumber} );
177 my @guarantees = map { $_->guarantee } $p->guarantee_relationships;
178 my $guarantees_non_issues_charges;
179 foreach my $g ( @guarantees ) {
180 $guarantees_non_issues_charges += $g->account->non_issues_charges;
183 if ( $guarantees_non_issues_charges > $no_issues_charge_guarantees ) {
185 $flaginfo{'message'} = sprintf 'patron guarantees owe %.02f', $guarantees_non_issues_charges;
186 $flaginfo{'amount'} = $guarantees_non_issues_charges;
187 $flaginfo{'noissues'} = 1 unless C4::Context->preference("allowfineoverride");
188 $flags{'CHARGES_GUARANTEES'} = \%flaginfo;
192 if ( $patroninformation->{'gonenoaddress'}
193 && $patroninformation->{'gonenoaddress'} == 1 )
196 $flaginfo{'message'} = 'Borrower has no valid address.';
197 $flaginfo{'noissues'} = 1;
198 $flags{'GNA'} = \%flaginfo;
200 if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
202 $flaginfo{'message'} = 'Borrower\'s card reported lost.';
203 $flaginfo{'noissues'} = 1;
204 $flags{'LOST'} = \%flaginfo;
206 if ( $patroninformation->{'debarred'} && check_date( split( /-/, $patroninformation->{'debarred'} ) ) ) {
207 if ( Date_to_Days(Date::Calc::Today) < Date_to_Days( split( /-/, $patroninformation->{'debarred'} ) ) ) {
209 $flaginfo{'debarredcomment'} = $patroninformation->{'debarredcomment'};
210 $flaginfo{'message'} = $patroninformation->{'debarredcomment'};
211 $flaginfo{'noissues'} = 1;
212 $flaginfo{'dateend'} = $patroninformation->{'debarred'};
213 $flags{'DBARRED'} = \%flaginfo;
216 if ( $patroninformation->{'borrowernotes'}
217 && $patroninformation->{'borrowernotes'} )
220 $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
221 $flags{'NOTES'} = \%flaginfo;
223 my ( $odues, $itemsoverdue ) = C4::Overdues::checkoverdues($patroninformation->{'borrowernumber'});
224 if ( $odues && $odues > 0 ) {
226 $flaginfo{'message'} = "Yes";
227 $flaginfo{'itemlist'} = $itemsoverdue;
228 foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
231 $flaginfo{'itemlisttext'} .=
232 "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n"; # newline is display layer
234 $flags{'ODUES'} = \%flaginfo;
237 my $waiting_holds = $patron->holds->search({ found => 'W' });
238 my $nowaiting = $waiting_holds->count;
239 if ( $nowaiting > 0 ) {
241 $flaginfo{'message'} = "Reserved items available";
242 $flaginfo{'itemlist'} = $waiting_holds->unblessed;
243 $flags{'WAITING'} = \%flaginfo;
250 $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
252 Looks up what the patron with the given borrowernumber has borrowed,
253 and sorts the results.
255 C<$sortkey> is the name of a field on which to sort the results. This
256 should be the name of a field in the C<issues>, C<biblio>,
257 C<biblioitems>, or C<items> table in the Koha database.
259 C<$limit> is the maximum number of results to return.
261 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
262 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
263 C<items> tables of the Koha database.
269 my ( $borrowernumber, $order, $limit ) = @_;
271 return unless $borrowernumber;
272 $order = 'date_due desc' unless $order;
274 my $dbh = C4::Context->dbh;
276 'SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
278 LEFT JOIN items on items.itemnumber=issues.itemnumber
279 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
280 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
281 WHERE borrowernumber=?
283 SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
285 LEFT JOIN items on items.itemnumber=old_issues.itemnumber
286 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
287 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
288 WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL
291 $query .= " limit $limit";
294 my $sth = $dbh->prepare($query);
295 $sth->execute( $borrowernumber, $borrowernumber );
296 return $sth->fetchall_arrayref( {} );
299 sub checkcardnumber {
300 my ( $cardnumber, $borrowernumber ) = @_;
302 # If cardnumber is null, we assume they're allowed.
303 return 0 unless defined $cardnumber;
305 my $dbh = C4::Context->dbh;
306 my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
307 $query .= " AND borrowernumber <> ?" if ($borrowernumber);
308 my $sth = $dbh->prepare($query);
311 ( $borrowernumber ? $borrowernumber : () )
314 return 1 if $sth->fetchrow_hashref;
316 my ( $min_length, $max_length ) = get_cardnumber_length();
318 if length $cardnumber > $max_length
319 or length $cardnumber < $min_length;
324 =head2 get_cardnumber_length
326 my ($min, $max) = C4::Members::get_cardnumber_length()
328 Returns the minimum and maximum length for patron cardnumbers as
329 determined by the CardnumberLength system preference, the
330 BorrowerMandatoryField system preference, and the width of the
335 sub get_cardnumber_length {
336 my $borrower = Koha::Database->new->schema->resultset('Borrower');
337 my $field_size = $borrower->result_source->column_info('cardnumber')->{size};
338 my ( $min, $max ) = ( 0, $field_size ); # borrowers.cardnumber is a nullable varchar(20)
339 $min = 1 if C4::Context->preference('BorrowerMandatoryField') =~ /cardnumber/;
340 if ( my $cardnumber_length = C4::Context->preference('CardnumberLength') ) {
341 # Is integer and length match
342 if ( $cardnumber_length =~ m|^\d+$| ) {
343 $min = $max = $cardnumber_length
344 if $cardnumber_length >= $min
345 and $cardnumber_length <= $max;
347 # Else assuming it is a range
348 elsif ( $cardnumber_length =~ m|(\d*),(\d*)| ) {
349 $min = $1 if $1 and $min < $1;
350 $max = $2 if $2 and $max > $2;
354 $min = $max if $min > $max;
355 return ( $min, $max );
358 =head2 GetBorrowersToExpunge
360 $borrowers = &GetBorrowersToExpunge(
361 not_borrowed_since => $not_borrowed_since,
362 expired_before => $expired_before,
363 category_code => $category_code,
364 patron_list_id => $patron_list_id,
365 branchcode => $branchcode
368 This function get all borrowers based on the given criteria.
372 sub GetBorrowersToExpunge {
375 my $filterdate = $params->{'not_borrowed_since'};
376 my $filterexpiry = $params->{'expired_before'};
377 my $filterlastseen = $params->{'last_seen'};
378 my $filtercategory = $params->{'category_code'};
379 my $filterbranch = $params->{'branchcode'} ||
380 ((C4::Context->preference('IndependentBranches')
381 && C4::Context->userenv
382 && !C4::Context->IsSuperLibrarian()
383 && C4::Context->userenv->{branch})
384 ? C4::Context->userenv->{branch}
386 my $filterpatronlist = $params->{'patron_list_id'};
388 my $dbh = C4::Context->dbh;
392 SELECT borrowers.borrowernumber,
393 MAX(old_issues.timestamp) AS latestissue,
394 MAX(issues.timestamp) AS currentissue
396 JOIN categories USING (categorycode)
399 FROM borrower_relationships
400 WHERE guarantor_id IS NOT NULL
401 AND guarantor_id <> 0
402 ) as tmp ON borrowers.borrowernumber=tmp.guarantor_id
403 LEFT JOIN old_issues USING (borrowernumber)
404 LEFT JOIN issues USING (borrowernumber)|;
405 if ( $filterpatronlist ){
406 $query .= q| LEFT JOIN patron_list_patrons USING (borrowernumber)|;
408 $query .= q| WHERE category_type <> 'S'
409 AND tmp.guarantor_id IS NULL
412 if ( $filterbranch && $filterbranch ne "" ) {
413 $query.= " AND borrowers.branchcode = ? ";
414 push( @query_params, $filterbranch );
416 if ( $filterexpiry ) {
417 $query .= " AND dateexpiry < ? ";
418 push( @query_params, $filterexpiry );
420 if ( $filterlastseen ) {
421 $query .= ' AND lastseen < ? ';
422 push @query_params, $filterlastseen;
424 if ( $filtercategory ) {
425 $query .= " AND categorycode = ? ";
426 push( @query_params, $filtercategory );
428 if ( $filterpatronlist ){
429 $query.=" AND patron_list_id = ? ";
430 push( @query_params, $filterpatronlist );
432 $query .= " GROUP BY borrowers.borrowernumber";
434 ) xxx WHERE currentissue IS NULL|;
436 $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
437 push @query_params,$filterdate;
440 if ( my $anonymous_patron = C4::Context->preference("AnonymousPatron") ) {
441 $query .= q{ AND borrowernumber != ? };
442 push( @query_params, $anonymous_patron );
445 warn $query if $debug;
447 my $sth = $dbh->prepare($query);
448 if (scalar(@query_params)>0){
449 $sth->execute(@query_params);
456 while ( my $data = $sth->fetchrow_hashref ) {
457 push @results, $data;
464 IssueSlip($branchcode, $borrowernumber, $quickslip)
466 Returns letter hash ( see C4::Letters::GetPreparedLetter )
468 $quickslip is boolean, to indicate whether we want a quick slip
470 IssueSlip populates ISSUESLIP and ISSUEQSLIP, and will make the following expansions:
506 NOTE: Fields from tables issues, items, biblio and biblioitems are available
511 my ($branch, $borrowernumber, $quickslip) = @_;
513 # FIXME Check callers before removing this statement
514 #return unless $borrowernumber;
516 my $patron = Koha::Patrons->find( $borrowernumber );
517 return unless $patron;
519 my $pending_checkouts = $patron->pending_checkouts; # Should be $patron->checkouts->pending?
521 my ($letter_code, %repeat, %loops);
523 my $today_start = dt_from_string->set( hour => 0, minute => 0, second => 0 );
524 my $today_end = dt_from_string->set( hour => 23, minute => 59, second => 0 );
525 $today_start = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_start );
526 $today_end = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_end );
527 $letter_code = 'ISSUEQSLIP';
529 # issue date or lastreneweddate is today
530 my $todays_checkouts = $pending_checkouts->search(
534 '>=' => $today_start,
538 { '>=' => $today_start, '<=' => $today_end, }
543 while ( my $c = $todays_checkouts->next ) {
544 my $all = $c->unblessed_all_relateds;
554 checkedout => \@checkouts, # Historical syntax
557 issues => [ map { $_->{issues}{itemnumber} } @checkouts ], # TT syntax
561 my $today = Koha::Database->new->schema->storage->datetime_parser->format_datetime( dt_from_string );
562 # Checkouts due in the future
563 my $checkouts = $pending_checkouts->search({ date_due => { '>' => $today } });
564 my @checkouts; my @overdues;
565 while ( my $c = $checkouts->next ) {
566 my $all = $c->unblessed_all_relateds;
575 # Checkouts due in the past are overdues
576 my $overdues = $pending_checkouts->search({ date_due => { '<=' => $today } });
577 while ( my $o = $overdues->next ) {
578 my $all = $o->unblessed_all_relateds;
586 my $news = GetNewsToDisplay( "slip", $branch );
588 $_->{'timestamp'} = $_->{'newdate'};
591 $letter_code = 'ISSUESLIP';
593 checkedout => \@checkouts,
594 overdue => \@overdues,
598 issues => [ map { $_->{issues}{itemnumber} } @checkouts ],
599 overdues => [ map { $_->{issues}{itemnumber} } @overdues ],
600 opac_news => [ map { $_->{opac_news}{idnew} } @news ],
604 return C4::Letters::GetPreparedLetter (
605 module => 'circulation',
606 letter_code => $letter_code,
607 branchcode => $branch,
608 lang => $patron->lang,
610 'branches' => $branch,
611 'borrowers' => $borrowernumber,
618 =head2 DeleteExpiredOpacRegistrations
620 Delete accounts that haven't been upgraded from the 'temporary' category
621 Returns the number of removed patrons
625 sub DeleteExpiredOpacRegistrations {
627 my $delay = C4::Context->preference('PatronSelfRegistrationExpireTemporaryAccountsDelay');
628 my $category_code = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
630 return 0 if not $category_code or not defined $delay or $delay eq q||;
631 my $date_enrolled = dt_from_string();
632 $date_enrolled->subtract( days => $delay );
634 my $registrations_to_del = Koha::Patrons->search({
635 dateenrolled => {'<=' => $date_enrolled->ymd},
636 categorycode => $category_code,
640 while ( my $registration = $registrations_to_del->next() ) {
641 next if $registration->checkouts->count || $registration->account->balance;
642 $registration->delete;
648 =head2 DeleteUnverifiedOpacRegistrations
650 Delete all unverified self registrations in borrower_modifications,
651 older than the specified number of days.
655 sub DeleteUnverifiedOpacRegistrations {
657 my $dbh = C4::Context->dbh;
659 DELETE FROM borrower_modifications
660 WHERE borrowernumber = 0 AND DATEDIFF( NOW(), timestamp ) > ?|;
661 my $cnt=$dbh->do($sql, undef, ($days) );
662 return $cnt eq '0E0'? 0: $cnt;
665 END { } # module clean-up code here (global destructor)