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 Scalar::Util qw( looks_like_number );
26 use Date::Calc qw( check_date Date_to_Days );
27 use C4::Overdues qw( checkoverdues );
30 use C4::Letters qw( GetPreparedLetter );
33 use Koha::DateUtils qw( dt_from_string output_pref );
36 use Koha::AdditionalContents;
38 use Koha::Patron::Categories;
40 our (@ISA, @EXPORT_OK);
54 DeleteUnverifiedOpacRegistrations
55 DeleteExpiredOpacRegistrations
61 C4::Members - Perl Module containing convenience functions for member handling
69 This module contains routines for adding, modifying and deleting members/patrons/borrowers
75 $flags = &patronflags($patron);
77 This function is not exported.
79 The following will be set where applicable:
80 $flags->{CHARGES}->{amount} Amount of debt
81 $flags->{CHARGES}->{noissues} Set if debt amount >$5.00 (or syspref noissuescharge)
82 $flags->{CHARGES}->{message} Message -- deprecated
84 $flags->{CREDITS}->{amount} Amount of credit
85 $flags->{CREDITS}->{message} Message -- deprecated
87 $flags->{ GNA } Patron has no valid address
88 $flags->{ GNA }->{noissues} Set for each GNA
89 $flags->{ GNA }->{message} "Borrower has no valid address" -- deprecated
91 $flags->{ LOST } Patron's card reported lost
92 $flags->{ LOST }->{noissues} Set for each LOST
93 $flags->{ LOST }->{message} Message -- deprecated
95 $flags->{DBARRED} Set if patron debarred, no access
96 $flags->{DBARRED}->{noissues} Set for each DBARRED
97 $flags->{DBARRED}->{message} Message -- deprecated
100 $flags->{ NOTES }->{message} The note itself. NOT deprecated
102 $flags->{ ODUES } Set if patron has overdue books.
103 $flags->{ ODUES }->{message} "Yes" -- deprecated
104 $flags->{ ODUES }->{itemlist} ref-to-array: list of overdue books
105 $flags->{ ODUES }->{itemlisttext} Text list of overdue items -- deprecated
107 $flags->{WAITING} Set if any of patron's reserves are available
108 $flags->{WAITING}->{message} Message -- deprecated
109 $flags->{WAITING}->{itemlist} ref-to-array: list of available items
113 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
114 overdue items. Its elements are references-to-hash, each describing an
115 overdue item. The keys are selected fields from the issues, biblio,
116 biblioitems, and items tables of the Koha database.
118 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
119 the overdue items, one per line. Deprecated.
121 =item C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
122 available items. Each element is a reference-to-hash whose keys are
123 fields from the reserves table of the Koha database.
127 All the "message" fields that include language generated in this function are deprecated,
128 because such strings belong properly in the display layer.
130 The "message" field that comes from the DB is OK.
134 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
135 # FIXME rename this function.
136 # DEPRECATED Do not use this subroutine!
139 my ( $patroninformation) = @_;
140 my $dbh=C4::Context->dbh;
141 my $patron = Koha::Patrons->find( $patroninformation->{borrowernumber} );
142 my $account = $patron->account;
143 my $owing = $account->non_issues_charges;
146 my $noissuescharge = C4::Context->preference("noissuescharge") || 5;
147 $flaginfo{'message'} = sprintf 'Patron owes %.02f', $owing;
148 $flaginfo{'amount'} = sprintf "%.02f", $owing;
149 if ( $owing > $noissuescharge && !C4::Context->preference("AllowFineOverride") ) {
150 $flaginfo{'noissues'} = 1;
152 $flags{'CHARGES'} = \%flaginfo;
154 elsif ( ( my $balance = $account->balance ) < 0 ) {
156 $flaginfo{'message'} = sprintf 'Patron has credit of %.02f', -$balance;
157 $flaginfo{'amount'} = sprintf "%.02f", $balance;
158 $flags{'CREDITS'} = \%flaginfo;
161 # Check the debt of the guarntees of this patron
162 my $no_issues_charge_guarantees = C4::Context->preference("NoIssuesChargeGuarantees");
163 $no_issues_charge_guarantees = undef unless looks_like_number( $no_issues_charge_guarantees );
164 if ( defined $no_issues_charge_guarantees ) {
165 my $p = Koha::Patrons->find( $patroninformation->{borrowernumber} );
166 my @guarantees = map { $_->guarantee } $p->guarantee_relationships->as_list;
167 my $guarantees_non_issues_charges = 0;
168 foreach my $g ( @guarantees ) {
169 $guarantees_non_issues_charges += $g->account->non_issues_charges;
172 if ( $guarantees_non_issues_charges > $no_issues_charge_guarantees ) {
174 $flaginfo{'message'} = sprintf 'patron guarantees owe %.02f', $guarantees_non_issues_charges;
175 $flaginfo{'amount'} = $guarantees_non_issues_charges;
176 $flaginfo{'noissues'} = 1 unless C4::Context->preference("allowfineoverride");
177 $flags{'CHARGES_GUARANTEES'} = \%flaginfo;
181 if ( $patroninformation->{'gonenoaddress'}
182 && $patroninformation->{'gonenoaddress'} == 1 )
185 $flaginfo{'message'} = 'Borrower has no valid address.';
186 $flaginfo{'noissues'} = 1;
187 $flags{'GNA'} = \%flaginfo;
189 if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
191 $flaginfo{'message'} = 'Borrower\'s card reported lost.';
192 $flaginfo{'noissues'} = 1;
193 $flags{'LOST'} = \%flaginfo;
195 if ( $patroninformation->{'debarred'} && check_date( split( /-/, $patroninformation->{'debarred'} ) ) ) {
196 if ( Date_to_Days(Date::Calc::Today) < Date_to_Days( split( /-/, $patroninformation->{'debarred'} ) ) ) {
198 $flaginfo{'debarredcomment'} = $patroninformation->{'debarredcomment'};
199 $flaginfo{'message'} = $patroninformation->{'debarredcomment'};
200 $flaginfo{'noissues'} = 1;
201 $flaginfo{'dateend'} = $patroninformation->{'debarred'};
202 $flags{'DBARRED'} = \%flaginfo;
205 if ( $patroninformation->{'borrowernotes'}
206 && $patroninformation->{'borrowernotes'} )
209 $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
210 $flags{'NOTES'} = \%flaginfo;
212 my ( $odues, $itemsoverdue ) = C4::Overdues::checkoverdues($patroninformation->{'borrowernumber'});
213 if ( $odues && $odues > 0 ) {
215 $flaginfo{'message'} = "Yes";
216 $flaginfo{'itemlist'} = $itemsoverdue;
217 foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
220 $flaginfo{'itemlisttext'} .=
221 "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n"; # newline is display layer
223 $flags{'ODUES'} = \%flaginfo;
226 my $waiting_holds = $patron->holds->search({ found => 'W' });
227 my $nowaiting = $waiting_holds->count;
228 if ( $nowaiting > 0 ) {
230 $flaginfo{'message'} = "Reserved items available";
231 $flaginfo{'itemlist'} = $waiting_holds->unblessed;
232 $flags{'WAITING'} = \%flaginfo;
239 $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
241 Looks up what the patron with the given borrowernumber has borrowed,
242 and sorts the results.
244 C<$sortkey> is the name of a field on which to sort the results. This
245 should be the name of a field in the C<issues>, C<biblio>,
246 C<biblioitems>, or C<items> table in the Koha database.
248 C<$limit> is the maximum number of results to return.
250 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
251 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
252 C<items> tables of the Koha database.
258 my ( $borrowernumber, $order, $limit ) = @_;
260 return unless $borrowernumber;
261 $order = 'date_due desc' unless $order;
263 my $dbh = C4::Context->dbh;
265 'SELECT issues.*, items.*, biblio.*, biblioitems.*, issues.timestamp as issuestimestamp, issues.renewals_count AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp,borrowers.firstname,borrowers.surname
267 LEFT JOIN items on items.itemnumber=issues.itemnumber
268 LEFT JOIN borrowers on borrowers.borrowernumber=issues.issuer_id
269 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
270 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
271 WHERE issues.borrowernumber=?
273 SELECT old_issues.*, items.*, biblio.*, biblioitems.*, old_issues.timestamp as issuestimestamp, old_issues.renewals_count AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp,borrowers.firstname,borrowers.surname
275 LEFT JOIN items on items.itemnumber=old_issues.itemnumber
276 LEFT JOIN borrowers on borrowers.borrowernumber=old_issues.issuer_id
277 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
278 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
279 WHERE old_issues.borrowernumber=? AND old_issues.itemnumber IS NOT NULL
282 $query .= " limit $limit";
285 my $sth = $dbh->prepare($query);
286 $sth->execute( $borrowernumber, $borrowernumber );
287 return $sth->fetchall_arrayref( {} );
290 sub checkcardnumber {
291 my ( $cardnumber, $borrowernumber ) = @_;
293 # If cardnumber is null, we assume they're allowed.
294 return 0 unless defined $cardnumber;
296 my $dbh = C4::Context->dbh;
297 my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
298 $query .= " AND borrowernumber <> ?" if ($borrowernumber);
299 my $sth = $dbh->prepare($query);
302 ( $borrowernumber ? $borrowernumber : () )
305 return 1 if $sth->fetchrow_hashref;
307 my ( $min_length, $max_length ) = get_cardnumber_length();
309 if length $cardnumber > $max_length
310 or length $cardnumber < $min_length;
315 =head2 get_cardnumber_length
317 my ($min, $max) = C4::Members::get_cardnumber_length()
319 Returns the minimum and maximum length for patron cardnumbers as
320 determined by the CardnumberLength system preference, the
321 BorrowerMandatoryField system preference, and the width of the
326 sub get_cardnumber_length {
327 my $borrower = Koha::Database->new->schema->resultset('Borrower');
328 my $field_size = $borrower->result_source->column_info('cardnumber')->{size};
329 my ( $min, $max ) = ( 0, $field_size ); # borrowers.cardnumber is a nullable varchar(20)
330 $min = 1 if C4::Context->preference('BorrowerMandatoryField') =~ /cardnumber/;
331 if ( my $cardnumber_length = C4::Context->preference('CardnumberLength') ) {
332 # Is integer and length match
333 if ( $cardnumber_length =~ m|^\d+$| ) {
334 $min = $max = $cardnumber_length
335 if $cardnumber_length >= $min
336 and $cardnumber_length <= $max;
338 # Else assuming it is a range
339 elsif ( $cardnumber_length =~ m|(\d*),(\d*)| ) {
340 $min = $1 if $1 and $min < $1;
341 $max = $2 if $2 and $max > $2;
345 $min = $max if $min > $max;
346 return ( $min, $max );
349 =head2 GetBorrowersToExpunge
351 $borrowers = &GetBorrowersToExpunge(
352 not_borrowed_since => $not_borrowed_since,
353 expired_before => $expired_before,
354 category_code => \@category_code,
355 patron_list_id => $patron_list_id,
356 branchcode => $branchcode
359 This function get all borrowers based on the given criteria.
363 sub GetBorrowersToExpunge {
366 my $filterdate = $params->{'not_borrowed_since'};
367 my $filterexpiry = $params->{'expired_before'};
368 my $filterlastseen = $params->{'last_seen'};
369 my $filtercategory = $params->{'category_code'};
370 my $filterbranch = $params->{'branchcode'} ||
371 ((C4::Context->preference('IndependentBranches')
372 && C4::Context->userenv
373 && !C4::Context->IsSuperLibrarian()
374 && C4::Context->userenv->{branch})
375 ? C4::Context->userenv->{branch}
377 my $filterpatronlist = $params->{'patron_list_id'};
379 my $dbh = C4::Context->dbh;
383 SELECT borrowers.borrowernumber,
384 MAX(old_issues.timestamp) AS latestissue,
385 MAX(issues.timestamp) AS currentissue
387 JOIN categories USING (categorycode)
390 FROM borrower_relationships
391 WHERE guarantor_id IS NOT NULL
392 AND guarantor_id <> 0
393 ) as tmp ON borrowers.borrowernumber=tmp.guarantor_id
394 LEFT JOIN old_issues USING (borrowernumber)
395 LEFT JOIN issues USING (borrowernumber)|;
396 if ( $filterpatronlist ){
397 $query .= q| LEFT JOIN patron_list_patrons USING (borrowernumber)|;
399 $query .= q| WHERE category_type <> 'S'
400 AND ( borrowers.flags IS NULL OR borrowers.flags = 0 )
401 AND tmp.guarantor_id IS NULL
404 if ( $filterbranch && $filterbranch ne "" ) {
405 $query.= " AND borrowers.branchcode = ? ";
406 push( @query_params, $filterbranch );
408 if ( $filterexpiry ) {
409 $query .= " AND dateexpiry < ? ";
410 push( @query_params, $filterexpiry );
412 if ( $filterlastseen ) {
413 $query .= ' AND lastseen < ? ';
414 push @query_params, $filterlastseen;
416 if ( $filtercategory ) {
417 if (ref($filtercategory) ne 'ARRAY' ) {
418 $filtercategory = [ $filtercategory ];
420 if ( @$filtercategory ) {
421 $query .= " AND categorycode IN (" . join(',', ('?') x @$filtercategory) . ") ";
422 push( @query_params, @$filtercategory );
425 if ( $filterpatronlist ){
426 $query.=" AND patron_list_id = ? ";
427 push( @query_params, $filterpatronlist );
429 $query .= " GROUP BY borrowers.borrowernumber";
431 ) xxx WHERE currentissue IS NULL|;
433 $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
434 push @query_params,$filterdate;
437 if ( my $anonymous_patron = C4::Context->preference("AnonymousPatron") ) {
438 $query .= q{ AND borrowernumber != ? };
439 push( @query_params, $anonymous_patron );
442 my $sth = $dbh->prepare($query);
443 if (scalar(@query_params)>0){
444 $sth->execute(@query_params);
451 while ( my $data = $sth->fetchrow_hashref ) {
452 push @results, $data;
459 IssueSlip($branchcode, $borrowernumber, $quickslip)
461 Returns letter hash ( see C4::Letters::GetPreparedLetter )
463 $quickslip is boolean, to indicate whether we want a quick slip
465 IssueSlip populates ISSUESLIP and ISSUEQSLIP, and will make the following expansions:
489 <<additional_contents.*>>
501 NOTE: Fields from tables issues, items, biblio and biblioitems are available
506 my ($branch, $borrowernumber, $quickslip) = @_;
508 # FIXME Check callers before removing this statement
509 #return unless $borrowernumber;
511 my $patron = Koha::Patrons->find( $borrowernumber );
512 return unless $patron;
514 my $pending_checkouts = $patron->pending_checkouts; # Should be $patron->checkouts->pending?
516 my ($letter_code, %repeat, %loops);
518 my $today_start = dt_from_string->set( hour => 0, minute => 0, second => 0 );
519 my $today_end = dt_from_string->set( hour => 23, minute => 59, second => 0 );
520 $today_start = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_start );
521 $today_end = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_end );
522 $letter_code = 'ISSUEQSLIP';
524 # issue date or lastreneweddate is today
525 my $todays_checkouts = $pending_checkouts->search(
529 '>=' => $today_start,
533 { '>=' => $today_start, '<=' => $today_end, }
538 while ( my $c = $todays_checkouts->next ) {
539 my $all = $c->unblessed_all_relateds;
549 checkedout => \@checkouts, # Historical syntax
552 issues => [ map { $_->{issues}{itemnumber} } @checkouts ], # TT syntax
556 my $today = Koha::Database->new->schema->storage->datetime_parser->format_datetime( dt_from_string );
557 # Checkouts due in the future
558 my $checkouts = $pending_checkouts->search({ date_due => { '>' => $today } });
559 my @checkouts; my @overdues;
560 while ( my $c = $checkouts->next ) {
561 my $all = $c->unblessed_all_relateds;
570 # Checkouts due in the past are overdues
571 my $overdues = $pending_checkouts->search({ date_due => { '<=' => $today } });
572 while ( my $o = $overdues->next ) {
573 my $all = $o->unblessed_all_relateds;
581 my $news = Koha::AdditionalContents->search_for_display(
585 lang => $patron->lang,
586 library_id => $branch,
590 while ( my $n = $news->next ) {
591 my $all = $n->unblessed_all_relateds;
593 # FIXME We keep newdate and timestamp for backward compatibility (from GetNewsToDisplay)
594 # But we should remove them and adjust the existing templates in a db rev
595 # FIXME This must be formatted in the notice template
596 my $published_on_dt = output_pref({ dt => dt_from_string( $all->{published_on} ), dateonly => 1 });
597 $all->{newdate} = $published_on_dt;
598 $all->{timestamp} = $published_on_dt;
601 additional_contents => $all,
604 $letter_code = 'ISSUESLIP';
606 checkedout => \@checkouts,
607 overdue => \@overdues,
611 issues => [ map { $_->{issues}{itemnumber} } @checkouts ],
612 overdues => [ map { $_->{issues}{itemnumber} } @overdues ],
613 opac_news => [ map { $_->{additional_contents}{idnew} } @news ],
614 additional_contents => [ map { $_->{additional_contents}{idnew} } @news ],
618 return C4::Letters::GetPreparedLetter (
619 module => 'circulation',
620 letter_code => $letter_code,
621 branchcode => $branch,
622 lang => $patron->lang,
624 'branches' => $branch,
625 'borrowers' => $borrowernumber,
632 =head2 DeleteExpiredOpacRegistrations
634 Delete accounts that haven't been upgraded from the 'temporary' category
635 Returns the number of removed patrons
639 sub DeleteExpiredOpacRegistrations {
641 my $delay = C4::Context->preference('PatronSelfRegistrationExpireTemporaryAccountsDelay');
642 my $category_code = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
644 return 0 unless $category_code && $delay;
645 # DO NOT REMOVE test on delay here!
646 # Some libraries may not use a temporary category, but want to keep patrons.
647 # We should not delete patrons when the value is NULL, empty string or 0.
649 my $date_enrolled = dt_from_string();
650 $date_enrolled->subtract( days => $delay );
652 my $registrations_to_del = Koha::Patrons->search({
653 dateenrolled => {'<=' => $date_enrolled->ymd},
654 categorycode => $category_code,
658 while ( my $registration = $registrations_to_del->next() ) {
659 next if $registration->checkouts->count || $registration->account->balance;
660 $registration->delete;
666 =head2 DeleteUnverifiedOpacRegistrations
668 Delete all unverified self registrations in borrower_modifications,
669 older than the specified number of days.
673 sub DeleteUnverifiedOpacRegistrations {
675 my $dbh = C4::Context->dbh;
677 DELETE FROM borrower_modifications
678 WHERE borrowernumber = 0 AND DATEDIFF( NOW(), timestamp ) > ?|;
679 my $cnt=$dbh->do($sql, undef, ($days) );
680 return $cnt eq '0E0'? 0: $cnt;
683 END { } # module clean-up code here (global destructor)