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
287 if ( $filterbranch && $filterbranch ne "" ) {
288 $query.= " AND borrowers.branchcode = ? ";
289 push( @query_params, $filterbranch );
291 if ( $filterexpiry ) {
292 $query .= " AND dateexpiry < ? ";
293 push( @query_params, $filterexpiry );
295 if ( $filterlastseen ) {
296 $query .= ' AND lastseen < ? ';
297 push @query_params, $filterlastseen;
299 if ( $filtercategory ) {
300 if (ref($filtercategory) ne 'ARRAY' ) {
301 $filtercategory = [ $filtercategory ];
303 if ( @$filtercategory ) {
304 $query .= " AND categorycode IN (" . join(',', ('?') x @$filtercategory) . ") ";
305 push( @query_params, @$filtercategory );
308 if ( $filterpatronlist ){
309 $query.=" AND patron_list_id = ? ";
310 push( @query_params, $filterpatronlist );
312 $query .= " GROUP BY borrowers.borrowernumber";
314 ) xxx WHERE currentissue IS NULL|;
316 $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
317 push @query_params,$filterdate;
320 if ( my $anonymous_patron = C4::Context->preference("AnonymousPatron") ) {
321 $query .= q{ AND borrowernumber != ? };
322 push( @query_params, $anonymous_patron );
325 my $sth = $dbh->prepare($query);
326 if (scalar(@query_params)>0){
327 $sth->execute(@query_params);
334 while ( my $data = $sth->fetchrow_hashref ) {
335 push @results, $data;
342 IssueSlip($branchcode, $borrowernumber, $quickslip)
344 Returns letter hash ( see C4::Letters::GetPreparedLetter )
346 $quickslip is boolean, to indicate whether we want a quick slip
348 IssueSlip populates ISSUESLIP and ISSUEQSLIP, and will make the following expansions:
372 <<additional_contents.*>>
384 NOTE: Fields from tables issues, items, biblio and biblioitems are available
389 my ($branch, $borrowernumber, $quickslip) = @_;
391 # FIXME Check callers before removing this statement
392 #return unless $borrowernumber;
394 my $patron = Koha::Patrons->find( $borrowernumber );
395 return unless $patron;
397 my $pending_checkouts = $patron->pending_checkouts; # Should be $patron->checkouts->pending?
399 my ($letter_code, %repeat, %loops);
401 my $today_start = dt_from_string->set( hour => 0, minute => 0, second => 0 );
402 my $today_end = dt_from_string->set( hour => 23, minute => 59, second => 0 );
403 $today_start = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_start );
404 $today_end = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_end );
405 $letter_code = 'ISSUEQSLIP';
407 # issue date or lastreneweddate is today
408 my $todays_checkouts = $pending_checkouts->search(
412 '>=' => $today_start,
416 { '>=' => $today_start, '<=' => $today_end, }
421 while ( my $c = $todays_checkouts->next ) {
422 my $all = $c->unblessed_all_relateds;
432 checkedout => \@checkouts, # Historical syntax
435 issues => [ map { $_->{issues}{itemnumber} } @checkouts ], # TT syntax
439 my $today = Koha::Database->new->schema->storage->datetime_parser->format_datetime( dt_from_string );
440 # Checkouts due in the future
441 my $checkouts = $pending_checkouts->search({ date_due => { '>' => $today } });
442 my @checkouts; my @overdues;
443 while ( my $c = $checkouts->next ) {
444 my $all = $c->unblessed_all_relateds;
453 # Checkouts due in the past are overdues
454 my $overdues = $pending_checkouts->search({ date_due => { '<=' => $today } });
455 while ( my $o = $overdues->next ) {
456 my $all = $o->unblessed_all_relateds;
464 my @news_ids = Koha::AdditionalContents->search_for_display(
468 lang => $patron->lang,
469 library_id => $branch,
472 $letter_code = 'ISSUESLIP';
474 checkedout => \@checkouts,
475 overdue => \@overdues,
478 issues => [ map { $_->{issues}{itemnumber} } @checkouts ],
479 overdues => [ map { $_->{issues}{itemnumber} } @overdues ],
480 opac_news => \@news_ids,
481 additional_contents => \@news_ids,
485 return C4::Letters::GetPreparedLetter (
486 module => 'circulation',
487 letter_code => $letter_code,
488 branchcode => $branch,
489 lang => $patron->lang,
491 'branches' => $branch,
492 'borrowers' => $borrowernumber,
499 =head2 DeleteExpiredOpacRegistrations
501 Delete accounts that haven't been upgraded from the 'temporary' category
502 Returns the number of removed patrons
506 sub DeleteExpiredOpacRegistrations {
508 my $delay = C4::Context->preference('PatronSelfRegistrationExpireTemporaryAccountsDelay');
509 my $category_code = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
511 return 0 unless $category_code && $delay;
512 # DO NOT REMOVE test on delay here!
513 # Some libraries may not use a temporary category, but want to keep patrons.
514 # We should not delete patrons when the value is NULL, empty string or 0.
516 my $date_enrolled = dt_from_string();
517 $date_enrolled->subtract( days => $delay );
519 my $registrations_to_del = Koha::Patrons->search({
520 dateenrolled => {'<=' => $date_enrolled->ymd},
521 categorycode => $category_code,
525 while ( my $registration = $registrations_to_del->next() ) {
526 next if $registration->checkouts->count || $registration->account->balance;
527 $registration->delete;
533 =head2 DeleteUnverifiedOpacRegistrations
535 Delete all unverified self registrations in borrower_modifications,
536 older than the specified number of days.
540 sub DeleteUnverifiedOpacRegistrations {
542 my $dbh = C4::Context->dbh;
544 DELETE FROM borrower_modifications
545 WHERE borrowernumber = 0 AND DATEDIFF( NOW(), timestamp ) > ?|;
546 my $cnt=$dbh->do($sql, undef, ($days) );
547 return $cnt eq '0E0'? 0: $cnt;
550 END { } # module clean-up code here (global destructor)