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);
49 DeleteUnverifiedOpacRegistrations
50 DeleteExpiredOpacRegistrations
56 C4::Members - Perl Module containing convenience functions for member handling
64 This module contains routines for adding, modifying and deleting members/patrons/borrowers
70 $flags = &patronflags($patron);
72 This function is not exported.
74 The following will be set where applicable:
75 $flags->{CHARGES}->{amount} Amount of debt
76 $flags->{CHARGES}->{noissues} Set if debt amount >$5.00 (or syspref noissuescharge)
77 $flags->{CHARGES}->{message} Message -- deprecated
79 $flags->{CREDITS}->{amount} Amount of credit
80 $flags->{CREDITS}->{message} Message -- deprecated
82 $flags->{ GNA } Patron has no valid address
83 $flags->{ GNA }->{noissues} Set for each GNA
84 $flags->{ GNA }->{message} "Borrower has no valid address" -- deprecated
86 $flags->{ LOST } Patron's card reported lost
87 $flags->{ LOST }->{noissues} Set for each LOST
88 $flags->{ LOST }->{message} Message -- deprecated
90 $flags->{DBARRED} Set if patron debarred, no access
91 $flags->{DBARRED}->{noissues} Set for each DBARRED
92 $flags->{DBARRED}->{message} Message -- deprecated
95 $flags->{ NOTES }->{message} The note itself. NOT deprecated
97 $flags->{ ODUES } Set if patron has overdue books.
98 $flags->{ ODUES }->{message} "Yes" -- deprecated
99 $flags->{ ODUES }->{itemlist} ref-to-array: list of overdue books
100 $flags->{ ODUES }->{itemlisttext} Text list of overdue items -- deprecated
102 $flags->{WAITING} Set if any of patron's reserves are available
103 $flags->{WAITING}->{message} Message -- deprecated
104 $flags->{WAITING}->{itemlist} ref-to-array: list of available items
108 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
109 overdue items. Its elements are references-to-hash, each describing an
110 overdue item. The keys are selected fields from the issues, biblio,
111 biblioitems, and items tables of the Koha database.
113 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
114 the overdue items, one per line. Deprecated.
116 =item C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
117 available items. Each element is a reference-to-hash whose keys are
118 fields from the reserves table of the Koha database.
122 All the "message" fields that include language generated in this function are deprecated,
123 because such strings belong properly in the display layer.
125 The "message" field that comes from the DB is OK.
129 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
130 # FIXME rename this function.
131 # DEPRECATED Do not use this subroutine!
134 my ( $patroninformation) = @_;
135 my $dbh=C4::Context->dbh;
136 my $patron = Koha::Patrons->find( $patroninformation->{borrowernumber} );
137 my $account = $patron->account;
138 my $owing = $account->non_issues_charges;
141 my $noissuescharge = C4::Context->preference("noissuescharge") || 5;
142 $flaginfo{'message'} = sprintf 'Patron owes %.02f', $owing;
143 $flaginfo{'amount'} = sprintf "%.02f", $owing;
144 if ( $owing > $noissuescharge && !C4::Context->preference("AllowFineOverride") ) {
145 $flaginfo{'noissues'} = 1;
147 $flags{'CHARGES'} = \%flaginfo;
149 elsif ( ( my $balance = $account->balance ) < 0 ) {
151 $flaginfo{'message'} = sprintf 'Patron has credit of %.02f', -$balance;
152 $flaginfo{'amount'} = sprintf "%.02f", $balance;
153 $flags{'CREDITS'} = \%flaginfo;
156 # Check the debt of the guarntees of this patron
157 my $no_issues_charge_guarantees = C4::Context->preference("NoIssuesChargeGuarantees");
158 $no_issues_charge_guarantees = undef unless looks_like_number( $no_issues_charge_guarantees );
159 if ( defined $no_issues_charge_guarantees ) {
160 my $p = Koha::Patrons->find( $patroninformation->{borrowernumber} );
161 my @guarantees = map { $_->guarantee } $p->guarantee_relationships->as_list;
162 my $guarantees_non_issues_charges = 0;
163 foreach my $g ( @guarantees ) {
164 $guarantees_non_issues_charges += $g->account->non_issues_charges;
167 if ( $guarantees_non_issues_charges > $no_issues_charge_guarantees ) {
169 $flaginfo{'message'} = sprintf 'patron guarantees owe %.02f', $guarantees_non_issues_charges;
170 $flaginfo{'amount'} = $guarantees_non_issues_charges;
171 $flaginfo{'noissues'} = 1 unless C4::Context->preference("allowfineoverride");
172 $flags{'CHARGES_GUARANTEES'} = \%flaginfo;
176 if ( $patroninformation->{'gonenoaddress'}
177 && $patroninformation->{'gonenoaddress'} == 1 )
180 $flaginfo{'message'} = 'Borrower has no valid address.';
181 $flaginfo{'noissues'} = 1;
182 $flags{'GNA'} = \%flaginfo;
184 if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
186 $flaginfo{'message'} = 'Borrower\'s card reported lost.';
187 $flaginfo{'noissues'} = 1;
188 $flags{'LOST'} = \%flaginfo;
190 if ( $patroninformation->{'debarred'} && check_date( split( /-/, $patroninformation->{'debarred'} ) ) ) {
191 if ( Date_to_Days(Date::Calc::Today) < Date_to_Days( split( /-/, $patroninformation->{'debarred'} ) ) ) {
193 $flaginfo{'debarredcomment'} = $patroninformation->{'debarredcomment'};
194 $flaginfo{'message'} = $patroninformation->{'debarredcomment'};
195 $flaginfo{'noissues'} = 1;
196 $flaginfo{'dateend'} = $patroninformation->{'debarred'};
197 $flags{'DBARRED'} = \%flaginfo;
200 if ( $patroninformation->{'borrowernotes'}
201 && $patroninformation->{'borrowernotes'} )
204 $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
205 $flags{'NOTES'} = \%flaginfo;
207 my ( $odues, $itemsoverdue ) = C4::Overdues::checkoverdues($patroninformation->{'borrowernumber'});
208 if ( $odues && $odues > 0 ) {
210 $flaginfo{'message'} = "Yes";
211 $flaginfo{'itemlist'} = $itemsoverdue;
212 foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
215 $flaginfo{'itemlisttext'} .=
216 "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n"; # newline is display layer
218 $flags{'ODUES'} = \%flaginfo;
221 my $waiting_holds = $patron->holds->search({ found => 'W' });
222 my $nowaiting = $waiting_holds->count;
223 if ( $nowaiting > 0 ) {
225 $flaginfo{'message'} = "Reserved items available";
226 $flaginfo{'itemlist'} = $waiting_holds->unblessed;
227 $flags{'WAITING'} = \%flaginfo;
232 =head2 GetBorrowersToExpunge
234 $borrowers = &GetBorrowersToExpunge(
235 not_borrowed_since => $not_borrowed_since,
236 expired_before => $expired_before,
237 category_code => \@category_code,
238 patron_list_id => $patron_list_id,
239 branchcode => $branchcode
242 This function get all borrowers based on the given criteria.
246 sub GetBorrowersToExpunge {
249 my $filterdate = $params->{'not_borrowed_since'};
250 my $filterexpiry = $params->{'expired_before'};
251 my $filterlastseen = $params->{'last_seen'};
252 my $filtercategory = $params->{'category_code'};
253 my $filterbranch = $params->{'branchcode'} ||
254 ((C4::Context->preference('IndependentBranches')
255 && C4::Context->userenv
256 && !C4::Context->IsSuperLibrarian()
257 && C4::Context->userenv->{branch})
258 ? C4::Context->userenv->{branch}
260 my $filterpatronlist = $params->{'patron_list_id'};
262 my $dbh = C4::Context->dbh;
266 SELECT borrowers.borrowernumber,
267 MAX(old_issues.timestamp) AS latestissue,
268 MAX(issues.timestamp) AS currentissue
270 JOIN categories USING (categorycode)
273 FROM borrower_relationships
274 WHERE guarantor_id IS NOT NULL
275 AND guarantor_id <> 0
276 ) as tmp ON borrowers.borrowernumber=tmp.guarantor_id
277 LEFT JOIN old_issues USING (borrowernumber)
278 LEFT JOIN issues USING (borrowernumber)|;
279 if ( $filterpatronlist ){
280 $query .= q| LEFT JOIN patron_list_patrons USING (borrowernumber)|;
282 $query .= q| WHERE category_type <> 'S'
283 AND ( borrowers.flags IS NULL OR borrowers.flags = 0 )
284 AND tmp.guarantor_id IS NULL
285 AND borrowers.protected = 0
288 if ( $filterbranch && $filterbranch ne "" ) {
289 $query.= " AND borrowers.branchcode = ? ";
290 push( @query_params, $filterbranch );
292 if ( $filterexpiry ) {
293 $query .= " AND dateexpiry < ? ";
294 push( @query_params, $filterexpiry );
296 if ( $filterlastseen ) {
297 $query .= ' AND lastseen < ? ';
298 push @query_params, $filterlastseen;
300 if ( $filtercategory ) {
301 if (ref($filtercategory) ne 'ARRAY' ) {
302 $filtercategory = [ $filtercategory ];
304 if ( @$filtercategory ) {
305 $query .= " AND categorycode IN (" . join(',', ('?') x @$filtercategory) . ") ";
306 push( @query_params, @$filtercategory );
309 if ( $filterpatronlist ){
310 $query.=" AND patron_list_id = ? ";
311 push( @query_params, $filterpatronlist );
313 $query .= " GROUP BY borrowers.borrowernumber";
315 ) xxx WHERE currentissue IS NULL|;
317 $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
318 push @query_params,$filterdate;
321 if ( my $anonymous_patron = C4::Context->preference("AnonymousPatron") ) {
322 $query .= q{ AND borrowernumber != ? };
323 push( @query_params, $anonymous_patron );
326 my $sth = $dbh->prepare($query);
327 if (scalar(@query_params)>0){
328 $sth->execute(@query_params);
335 while ( my $data = $sth->fetchrow_hashref ) {
336 push @results, $data;
343 IssueSlip($branchcode, $borrowernumber, $quickslip)
345 Returns letter hash ( see C4::Letters::GetPreparedLetter )
347 $quickslip is boolean, to indicate whether we want a quick slip
349 IssueSlip populates ISSUESLIP and ISSUEQSLIP, and will make the following expansions:
373 <<additional_contents.*>>
385 NOTE: Fields from tables issues, items, biblio and biblioitems are available
390 my ($branch, $borrowernumber, $quickslip) = @_;
392 # FIXME Check callers before removing this statement
393 #return unless $borrowernumber;
395 my $patron = Koha::Patrons->find( $borrowernumber );
396 return unless $patron;
398 my $pending_checkouts = $patron->pending_checkouts; # Should be $patron->checkouts->pending?
400 my ($letter_code, %repeat, %loops);
402 my $today_start = dt_from_string->set( hour => 0, minute => 0, second => 0 );
403 my $today_end = dt_from_string->set( hour => 23, minute => 59, second => 0 );
404 $today_start = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_start );
405 $today_end = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_end );
406 $letter_code = 'ISSUEQSLIP';
408 # issue date or lastreneweddate is today
409 my $todays_checkouts = $pending_checkouts->search(
413 '>=' => $today_start,
417 { '>=' => $today_start, '<=' => $today_end, }
422 while ( my $c = $todays_checkouts->next ) {
423 my $all = $c->unblessed_all_relateds;
433 checkedout => \@checkouts, # Historical syntax
436 issues => [ map { $_->{issues}{itemnumber} } @checkouts ], # TT syntax
440 my $today = Koha::Database->new->schema->storage->datetime_parser->format_datetime( dt_from_string );
441 # Checkouts due in the future
442 my $checkouts = $pending_checkouts->search({ date_due => { '>' => $today } });
443 my @checkouts; my @overdues;
444 while ( my $c = $checkouts->next ) {
445 my $all = $c->unblessed_all_relateds;
454 # Checkouts due in the past are overdues
455 my $overdues = $pending_checkouts->search({ date_due => { '<=' => $today } });
456 while ( my $o = $overdues->next ) {
457 my $all = $o->unblessed_all_relateds;
465 my @news_ids = Koha::AdditionalContents->search_for_display(
469 lang => $patron->lang,
470 library_id => $branch,
473 $letter_code = 'ISSUESLIP';
475 checkedout => \@checkouts,
476 overdue => \@overdues,
479 issues => [ map { $_->{issues}{itemnumber} } @checkouts ],
480 overdues => [ map { $_->{issues}{itemnumber} } @overdues ],
481 opac_news => \@news_ids,
482 additional_contents => \@news_ids,
486 return C4::Letters::GetPreparedLetter (
487 module => 'circulation',
488 letter_code => $letter_code,
489 branchcode => $branch,
490 lang => $patron->lang,
492 'branches' => $branch,
493 'borrowers' => $borrowernumber,
500 =head2 DeleteExpiredOpacRegistrations
502 Delete accounts that haven't been upgraded from the 'temporary' category
503 Returns the number of removed patrons
507 sub DeleteExpiredOpacRegistrations {
509 my $delay = C4::Context->preference('PatronSelfRegistrationExpireTemporaryAccountsDelay');
510 my $category_code = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
512 return 0 unless $category_code && $delay;
513 # DO NOT REMOVE test on delay here!
514 # Some libraries may not use a temporary category, but want to keep patrons.
515 # We should not delete patrons when the value is NULL, empty string or 0.
517 my $date_enrolled = dt_from_string();
518 $date_enrolled->subtract( days => $delay );
520 my $registrations_to_del = Koha::Patrons->search({
521 dateenrolled => {'<=' => $date_enrolled->ymd},
522 categorycode => $category_code,
526 while ( my $registration = $registrations_to_del->next() ) {
527 next if $registration->checkouts->count || $registration->account->balance;
528 $registration->delete;
534 =head2 DeleteUnverifiedOpacRegistrations
536 Delete all unverified self registrations in borrower_modifications,
537 older than the specified number of days.
541 sub DeleteUnverifiedOpacRegistrations {
543 my $dbh = C4::Context->dbh;
545 DELETE FROM borrower_modifications
546 WHERE borrowernumber = 0 AND DATEDIFF( NOW(), timestamp ) > ?|;
547 my $cnt=$dbh->do($sql, undef, ($days) );
548 return $cnt eq '0E0'? 0: $cnt;
551 END { } # module clean-up code here (global destructor)