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);
58 DeleteUnverifiedOpacRegistrations
59 DeleteExpiredOpacRegistrations
65 C4::Members - Perl Module containing convenience functions for member handling
73 This module contains routines for adding, modifying and deleting members/patrons/borrowers
79 $flags = &patronflags($patron);
81 This function is not exported.
83 The following will be set where applicable:
84 $flags->{CHARGES}->{amount} Amount of debt
85 $flags->{CHARGES}->{noissues} Set if debt amount >$5.00 (or syspref noissuescharge)
86 $flags->{CHARGES}->{message} Message -- deprecated
88 $flags->{CREDITS}->{amount} Amount of credit
89 $flags->{CREDITS}->{message} Message -- deprecated
91 $flags->{ GNA } Patron has no valid address
92 $flags->{ GNA }->{noissues} Set for each GNA
93 $flags->{ GNA }->{message} "Borrower has no valid address" -- deprecated
95 $flags->{ LOST } Patron's card reported lost
96 $flags->{ LOST }->{noissues} Set for each LOST
97 $flags->{ LOST }->{message} Message -- deprecated
99 $flags->{DBARRED} Set if patron debarred, no access
100 $flags->{DBARRED}->{noissues} Set for each DBARRED
101 $flags->{DBARRED}->{message} Message -- deprecated
104 $flags->{ NOTES }->{message} The note itself. NOT deprecated
106 $flags->{ ODUES } Set if patron has overdue books.
107 $flags->{ ODUES }->{message} "Yes" -- deprecated
108 $flags->{ ODUES }->{itemlist} ref-to-array: list of overdue books
109 $flags->{ ODUES }->{itemlisttext} Text list of overdue items -- deprecated
111 $flags->{WAITING} Set if any of patron's reserves are available
112 $flags->{WAITING}->{message} Message -- deprecated
113 $flags->{WAITING}->{itemlist} ref-to-array: list of available items
117 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
118 overdue items. Its elements are references-to-hash, each describing an
119 overdue item. The keys are selected fields from the issues, biblio,
120 biblioitems, and items tables of the Koha database.
122 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
123 the overdue items, one per line. Deprecated.
125 =item C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
126 available items. Each element is a reference-to-hash whose keys are
127 fields from the reserves table of the Koha database.
131 All the "message" fields that include language generated in this function are deprecated,
132 because such strings belong properly in the display layer.
134 The "message" field that comes from the DB is OK.
138 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
139 # FIXME rename this function.
140 # DEPRECATED Do not use this subroutine!
143 my ( $patroninformation) = @_;
144 my $dbh=C4::Context->dbh;
145 my $patron = Koha::Patrons->find( $patroninformation->{borrowernumber} );
146 my $account = $patron->account;
147 my $owing = $account->non_issues_charges;
150 my $noissuescharge = C4::Context->preference("noissuescharge") || 5;
151 $flaginfo{'message'} = sprintf 'Patron owes %.02f', $owing;
152 $flaginfo{'amount'} = sprintf "%.02f", $owing;
153 if ( $owing > $noissuescharge && !C4::Context->preference("AllowFineOverride") ) {
154 $flaginfo{'noissues'} = 1;
156 $flags{'CHARGES'} = \%flaginfo;
158 elsif ( ( my $balance = $account->balance ) < 0 ) {
160 $flaginfo{'message'} = sprintf 'Patron has credit of %.02f', -$balance;
161 $flaginfo{'amount'} = sprintf "%.02f", $balance;
162 $flags{'CREDITS'} = \%flaginfo;
165 # Check the debt of the guarntees of this patron
166 my $no_issues_charge_guarantees = C4::Context->preference("NoIssuesChargeGuarantees");
167 $no_issues_charge_guarantees = undef unless looks_like_number( $no_issues_charge_guarantees );
168 if ( defined $no_issues_charge_guarantees ) {
169 my $p = Koha::Patrons->find( $patroninformation->{borrowernumber} );
170 my @guarantees = map { $_->guarantee } $p->guarantee_relationships;
171 my $guarantees_non_issues_charges = 0;
172 foreach my $g ( @guarantees ) {
173 $guarantees_non_issues_charges += $g->account->non_issues_charges;
176 if ( $guarantees_non_issues_charges > $no_issues_charge_guarantees ) {
178 $flaginfo{'message'} = sprintf 'patron guarantees owe %.02f', $guarantees_non_issues_charges;
179 $flaginfo{'amount'} = $guarantees_non_issues_charges;
180 $flaginfo{'noissues'} = 1 unless C4::Context->preference("allowfineoverride");
181 $flags{'CHARGES_GUARANTEES'} = \%flaginfo;
185 if ( $patroninformation->{'gonenoaddress'}
186 && $patroninformation->{'gonenoaddress'} == 1 )
189 $flaginfo{'message'} = 'Borrower has no valid address.';
190 $flaginfo{'noissues'} = 1;
191 $flags{'GNA'} = \%flaginfo;
193 if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
195 $flaginfo{'message'} = 'Borrower\'s card reported lost.';
196 $flaginfo{'noissues'} = 1;
197 $flags{'LOST'} = \%flaginfo;
199 if ( $patroninformation->{'debarred'} && check_date( split( /-/, $patroninformation->{'debarred'} ) ) ) {
200 if ( Date_to_Days(Date::Calc::Today) < Date_to_Days( split( /-/, $patroninformation->{'debarred'} ) ) ) {
202 $flaginfo{'debarredcomment'} = $patroninformation->{'debarredcomment'};
203 $flaginfo{'message'} = $patroninformation->{'debarredcomment'};
204 $flaginfo{'noissues'} = 1;
205 $flaginfo{'dateend'} = $patroninformation->{'debarred'};
206 $flags{'DBARRED'} = \%flaginfo;
209 if ( $patroninformation->{'borrowernotes'}
210 && $patroninformation->{'borrowernotes'} )
213 $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
214 $flags{'NOTES'} = \%flaginfo;
216 my ( $odues, $itemsoverdue ) = C4::Overdues::checkoverdues($patroninformation->{'borrowernumber'});
217 if ( $odues && $odues > 0 ) {
219 $flaginfo{'message'} = "Yes";
220 $flaginfo{'itemlist'} = $itemsoverdue;
221 foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
224 $flaginfo{'itemlisttext'} .=
225 "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n"; # newline is display layer
227 $flags{'ODUES'} = \%flaginfo;
230 my $waiting_holds = $patron->holds->search({ found => 'W' });
231 my $nowaiting = $waiting_holds->count;
232 if ( $nowaiting > 0 ) {
234 $flaginfo{'message'} = "Reserved items available";
235 $flaginfo{'itemlist'} = $waiting_holds->unblessed;
236 $flags{'WAITING'} = \%flaginfo;
243 $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
245 Looks up what the patron with the given borrowernumber has borrowed,
246 and sorts the results.
248 C<$sortkey> is the name of a field on which to sort the results. This
249 should be the name of a field in the C<issues>, C<biblio>,
250 C<biblioitems>, or C<items> table in the Koha database.
252 C<$limit> is the maximum number of results to return.
254 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
255 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
256 C<items> tables of the Koha database.
262 my ( $borrowernumber, $order, $limit ) = @_;
264 return unless $borrowernumber;
265 $order = 'date_due desc' unless $order;
267 my $dbh = C4::Context->dbh;
269 'SELECT issues.*, items.*, biblio.*, biblioitems.*, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp,borrowers.firstname,borrowers.surname
271 LEFT JOIN items on items.itemnumber=issues.itemnumber
272 LEFT JOIN borrowers on borrowers.borrowernumber=issues.issuer_id
273 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
274 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
275 WHERE issues.borrowernumber=?
277 SELECT old_issues.*, items.*, biblio.*, biblioitems.*, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp,borrowers.firstname,borrowers.surname
279 LEFT JOIN items on items.itemnumber=old_issues.itemnumber
280 LEFT JOIN borrowers on borrowers.borrowernumber=old_issues.issuer_id
281 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
282 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
283 WHERE old_issues.borrowernumber=? AND old_issues.itemnumber IS NOT NULL
286 $query .= " limit $limit";
289 my $sth = $dbh->prepare($query);
290 $sth->execute( $borrowernumber, $borrowernumber );
291 return $sth->fetchall_arrayref( {} );
294 sub checkcardnumber {
295 my ( $cardnumber, $borrowernumber ) = @_;
297 # If cardnumber is null, we assume they're allowed.
298 return 0 unless defined $cardnumber;
300 my $dbh = C4::Context->dbh;
301 my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
302 $query .= " AND borrowernumber <> ?" if ($borrowernumber);
303 my $sth = $dbh->prepare($query);
306 ( $borrowernumber ? $borrowernumber : () )
309 return 1 if $sth->fetchrow_hashref;
311 my ( $min_length, $max_length ) = get_cardnumber_length();
313 if length $cardnumber > $max_length
314 or length $cardnumber < $min_length;
319 =head2 get_cardnumber_length
321 my ($min, $max) = C4::Members::get_cardnumber_length()
323 Returns the minimum and maximum length for patron cardnumbers as
324 determined by the CardnumberLength system preference, the
325 BorrowerMandatoryField system preference, and the width of the
330 sub get_cardnumber_length {
331 my $borrower = Koha::Database->new->schema->resultset('Borrower');
332 my $field_size = $borrower->result_source->column_info('cardnumber')->{size};
333 my ( $min, $max ) = ( 0, $field_size ); # borrowers.cardnumber is a nullable varchar(20)
334 $min = 1 if C4::Context->preference('BorrowerMandatoryField') =~ /cardnumber/;
335 if ( my $cardnumber_length = C4::Context->preference('CardnumberLength') ) {
336 # Is integer and length match
337 if ( $cardnumber_length =~ m|^\d+$| ) {
338 $min = $max = $cardnumber_length
339 if $cardnumber_length >= $min
340 and $cardnumber_length <= $max;
342 # Else assuming it is a range
343 elsif ( $cardnumber_length =~ m|(\d*),(\d*)| ) {
344 $min = $1 if $1 and $min < $1;
345 $max = $2 if $2 and $max > $2;
349 $min = $max if $min > $max;
350 return ( $min, $max );
353 =head2 GetBorrowersToExpunge
355 $borrowers = &GetBorrowersToExpunge(
356 not_borrowed_since => $not_borrowed_since,
357 expired_before => $expired_before,
358 category_code => \@category_code,
359 patron_list_id => $patron_list_id,
360 branchcode => $branchcode
363 This function get all borrowers based on the given criteria.
367 sub GetBorrowersToExpunge {
370 my $filterdate = $params->{'not_borrowed_since'};
371 my $filterexpiry = $params->{'expired_before'};
372 my $filterlastseen = $params->{'last_seen'};
373 my $filtercategory = $params->{'category_code'};
374 my $filterbranch = $params->{'branchcode'} ||
375 ((C4::Context->preference('IndependentBranches')
376 && C4::Context->userenv
377 && !C4::Context->IsSuperLibrarian()
378 && C4::Context->userenv->{branch})
379 ? C4::Context->userenv->{branch}
381 my $filterpatronlist = $params->{'patron_list_id'};
383 my $dbh = C4::Context->dbh;
387 SELECT borrowers.borrowernumber,
388 MAX(old_issues.timestamp) AS latestissue,
389 MAX(issues.timestamp) AS currentissue
391 JOIN categories USING (categorycode)
394 FROM borrower_relationships
395 WHERE guarantor_id IS NOT NULL
396 AND guarantor_id <> 0
397 ) as tmp ON borrowers.borrowernumber=tmp.guarantor_id
398 LEFT JOIN old_issues USING (borrowernumber)
399 LEFT JOIN issues USING (borrowernumber)|;
400 if ( $filterpatronlist ){
401 $query .= q| LEFT JOIN patron_list_patrons USING (borrowernumber)|;
403 $query .= q| WHERE category_type <> 'S'
404 AND ( borrowers.flags IS NULL OR borrowers.flags = 0 )
405 AND tmp.guarantor_id IS NULL
408 if ( $filterbranch && $filterbranch ne "" ) {
409 $query.= " AND borrowers.branchcode = ? ";
410 push( @query_params, $filterbranch );
412 if ( $filterexpiry ) {
413 $query .= " AND dateexpiry < ? ";
414 push( @query_params, $filterexpiry );
416 if ( $filterlastseen ) {
417 $query .= ' AND lastseen < ? ';
418 push @query_params, $filterlastseen;
420 if ( $filtercategory ) {
421 if (ref($filtercategory) ne 'ARRAY' ) {
422 $filtercategory = [ $filtercategory ];
424 if ( @$filtercategory ) {
425 $query .= " AND categorycode IN (" . join(',', ('?') x @$filtercategory) . ") ";
426 push( @query_params, @$filtercategory );
429 if ( $filterpatronlist ){
430 $query.=" AND patron_list_id = ? ";
431 push( @query_params, $filterpatronlist );
433 $query .= " GROUP BY borrowers.borrowernumber";
435 ) xxx WHERE currentissue IS NULL|;
437 $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
438 push @query_params,$filterdate;
441 if ( my $anonymous_patron = C4::Context->preference("AnonymousPatron") ) {
442 $query .= q{ AND borrowernumber != ? };
443 push( @query_params, $anonymous_patron );
446 my $sth = $dbh->prepare($query);
447 if (scalar(@query_params)>0){
448 $sth->execute(@query_params);
455 while ( my $data = $sth->fetchrow_hashref ) {
456 push @results, $data;
463 IssueSlip($branchcode, $borrowernumber, $quickslip)
465 Returns letter hash ( see C4::Letters::GetPreparedLetter )
467 $quickslip is boolean, to indicate whether we want a quick slip
469 IssueSlip populates ISSUESLIP and ISSUEQSLIP, and will make the following expansions:
493 <<additional_contents.*>>
505 NOTE: Fields from tables issues, items, biblio and biblioitems are available
510 my ($branch, $borrowernumber, $quickslip) = @_;
512 # FIXME Check callers before removing this statement
513 #return unless $borrowernumber;
515 my $patron = Koha::Patrons->find( $borrowernumber );
516 return unless $patron;
518 my $pending_checkouts = $patron->pending_checkouts; # Should be $patron->checkouts->pending?
520 my ($letter_code, %repeat, %loops);
522 my $today_start = dt_from_string->set( hour => 0, minute => 0, second => 0 );
523 my $today_end = dt_from_string->set( hour => 23, minute => 59, second => 0 );
524 $today_start = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_start );
525 $today_end = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_end );
526 $letter_code = 'ISSUEQSLIP';
528 # issue date or lastreneweddate is today
529 my $todays_checkouts = $pending_checkouts->search(
533 '>=' => $today_start,
537 { '>=' => $today_start, '<=' => $today_end, }
542 while ( my $c = $todays_checkouts->next ) {
543 my $all = $c->unblessed_all_relateds;
553 checkedout => \@checkouts, # Historical syntax
556 issues => [ map { $_->{issues}{itemnumber} } @checkouts ], # TT syntax
560 my $today = Koha::Database->new->schema->storage->datetime_parser->format_datetime( dt_from_string );
561 # Checkouts due in the future
562 my $checkouts = $pending_checkouts->search({ date_due => { '>' => $today } });
563 my @checkouts; my @overdues;
564 while ( my $c = $checkouts->next ) {
565 my $all = $c->unblessed_all_relateds;
574 # Checkouts due in the past are overdues
575 my $overdues = $pending_checkouts->search({ date_due => { '<=' => $today } });
576 while ( my $o = $overdues->next ) {
577 my $all = $o->unblessed_all_relateds;
585 my $news = Koha::AdditionalContents->search_for_display(
589 lang => $patron->lang,
590 library_id => $branch,
594 while ( my $n = $news->next ) {
595 my $all = $n->unblessed_all_relateds;
597 # FIXME We keep newdate and timestamp for backward compatibility (from GetNewsToDisplay)
598 # But we should remove them and adjust the existing templates in a db rev
599 my $published_on_dt = output_pref({ dt => dt_from_string( $all->{published_on} ), dateonly => 1 });
600 $all->{newdate} = $published_on_dt;
601 $all->{timestamp} = $published_on_dt;
604 additional_contents => $all,
607 $letter_code = 'ISSUESLIP';
609 checkedout => \@checkouts,
610 overdue => \@overdues,
614 issues => [ map { $_->{issues}{itemnumber} } @checkouts ],
615 overdues => [ map { $_->{issues}{itemnumber} } @overdues ],
616 opac_news => [ map { $_->{additional_contents}{idnew} } @news ],
617 additional_contents => [ map { $_->{additional_contents}{idnew} } @news ],
621 return C4::Letters::GetPreparedLetter (
622 module => 'circulation',
623 letter_code => $letter_code,
624 branchcode => $branch,
625 lang => $patron->lang,
627 'branches' => $branch,
628 'borrowers' => $borrowernumber,
635 =head2 DeleteExpiredOpacRegistrations
637 Delete accounts that haven't been upgraded from the 'temporary' category
638 Returns the number of removed patrons
642 sub DeleteExpiredOpacRegistrations {
644 my $delay = C4::Context->preference('PatronSelfRegistrationExpireTemporaryAccountsDelay');
645 my $category_code = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
647 return 0 unless $category_code && $delay;
648 # DO NOT REMOVE test on delay here!
649 # Some libraries may not use a temporary category, but want to keep patrons.
650 # We should not delete patrons when the value is NULL, empty string or 0.
652 my $date_enrolled = dt_from_string();
653 $date_enrolled->subtract( days => $delay );
655 my $registrations_to_del = Koha::Patrons->search({
656 dateenrolled => {'<=' => $date_enrolled->ymd},
657 categorycode => $category_code,
661 while ( my $registration = $registrations_to_del->next() ) {
662 next if $registration->checkouts->count || $registration->account->balance;
663 $registration->delete;
669 =head2 DeleteUnverifiedOpacRegistrations
671 Delete all unverified self registrations in borrower_modifications,
672 older than the specified number of days.
676 sub DeleteUnverifiedOpacRegistrations {
678 my $dbh = C4::Context->dbh;
680 DELETE FROM borrower_modifications
681 WHERE borrowernumber = 0 AND DATEDIFF( NOW(), timestamp ) > ?|;
682 my $cnt=$dbh->do($sql, undef, ($days) );
683 return $cnt eq '0E0'? 0: $cnt;
686 END { } # module clean-up code here (global destructor)