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);
51 DeleteUnverifiedOpacRegistrations
52 DeleteExpiredOpacRegistrations
58 C4::Members - Perl Module containing convenience functions for member handling
66 This module contains routines for adding, modifying and deleting members/patrons/borrowers
72 $flags = &patronflags($patron);
74 This function is not exported.
76 The following will be set where applicable:
77 $flags->{CHARGES}->{amount} Amount of debt
78 $flags->{CHARGES}->{noissues} Set if debt amount >$5.00 (or syspref noissuescharge)
79 $flags->{CHARGES}->{message} Message -- deprecated
81 $flags->{CREDITS}->{amount} Amount of credit
82 $flags->{CREDITS}->{message} Message -- deprecated
84 $flags->{ GNA } Patron has no valid address
85 $flags->{ GNA }->{noissues} Set for each GNA
86 $flags->{ GNA }->{message} "Borrower has no valid address" -- deprecated
88 $flags->{ LOST } Patron's card reported lost
89 $flags->{ LOST }->{noissues} Set for each LOST
90 $flags->{ LOST }->{message} Message -- deprecated
92 $flags->{DBARRED} Set if patron debarred, no access
93 $flags->{DBARRED}->{noissues} Set for each DBARRED
94 $flags->{DBARRED}->{message} Message -- deprecated
97 $flags->{ NOTES }->{message} The note itself. NOT deprecated
99 $flags->{ ODUES } Set if patron has overdue books.
100 $flags->{ ODUES }->{message} "Yes" -- deprecated
101 $flags->{ ODUES }->{itemlist} ref-to-array: list of overdue books
102 $flags->{ ODUES }->{itemlisttext} Text list of overdue items -- deprecated
104 $flags->{WAITING} Set if any of patron's reserves are available
105 $flags->{WAITING}->{message} Message -- deprecated
106 $flags->{WAITING}->{itemlist} ref-to-array: list of available items
110 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
111 overdue items. Its elements are references-to-hash, each describing an
112 overdue item. The keys are selected fields from the issues, biblio,
113 biblioitems, and items tables of the Koha database.
115 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
116 the overdue items, one per line. Deprecated.
118 =item C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
119 available items. Each element is a reference-to-hash whose keys are
120 fields from the reserves table of the Koha database.
124 All the "message" fields that include language generated in this function are deprecated,
125 because such strings belong properly in the display layer.
127 The "message" field that comes from the DB is OK.
131 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
132 # FIXME rename this function.
133 # DEPRECATED Do not use this subroutine!
136 my ( $patroninformation) = @_;
137 my $dbh=C4::Context->dbh;
138 my $patron = Koha::Patrons->find( $patroninformation->{borrowernumber} );
139 my $account = $patron->account;
140 my $owing = $account->non_issues_charges;
143 my $noissuescharge = C4::Context->preference("noissuescharge") || 5;
144 $flaginfo{'message'} = sprintf 'Patron owes %.02f', $owing;
145 $flaginfo{'amount'} = sprintf "%.02f", $owing;
146 if ( $owing > $noissuescharge && !C4::Context->preference("AllowFineOverride") ) {
147 $flaginfo{'noissues'} = 1;
149 $flags{'CHARGES'} = \%flaginfo;
151 elsif ( ( my $balance = $account->balance ) < 0 ) {
153 $flaginfo{'message'} = sprintf 'Patron has credit of %.02f', -$balance;
154 $flaginfo{'amount'} = sprintf "%.02f", $balance;
155 $flags{'CREDITS'} = \%flaginfo;
158 # Check the debt of the guarntees of this patron
159 my $no_issues_charge_guarantees = C4::Context->preference("NoIssuesChargeGuarantees");
160 $no_issues_charge_guarantees = undef unless looks_like_number( $no_issues_charge_guarantees );
161 if ( defined $no_issues_charge_guarantees ) {
162 my $p = Koha::Patrons->find( $patroninformation->{borrowernumber} );
163 my @guarantees = map { $_->guarantee } $p->guarantee_relationships->as_list;
164 my $guarantees_non_issues_charges = 0;
165 foreach my $g ( @guarantees ) {
166 $guarantees_non_issues_charges += $g->account->non_issues_charges;
169 if ( $guarantees_non_issues_charges > $no_issues_charge_guarantees ) {
171 $flaginfo{'message'} = sprintf 'patron guarantees owe %.02f', $guarantees_non_issues_charges;
172 $flaginfo{'amount'} = $guarantees_non_issues_charges;
173 $flaginfo{'noissues'} = 1 unless C4::Context->preference("allowfineoverride");
174 $flags{'CHARGES_GUARANTEES'} = \%flaginfo;
178 if ( $patroninformation->{'gonenoaddress'}
179 && $patroninformation->{'gonenoaddress'} == 1 )
182 $flaginfo{'message'} = 'Borrower has no valid address.';
183 $flaginfo{'noissues'} = 1;
184 $flags{'GNA'} = \%flaginfo;
186 if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
188 $flaginfo{'message'} = 'Borrower\'s card reported lost.';
189 $flaginfo{'noissues'} = 1;
190 $flags{'LOST'} = \%flaginfo;
192 if ( $patroninformation->{'debarred'} && check_date( split( /-/, $patroninformation->{'debarred'} ) ) ) {
193 if ( Date_to_Days(Date::Calc::Today) < Date_to_Days( split( /-/, $patroninformation->{'debarred'} ) ) ) {
195 $flaginfo{'debarredcomment'} = $patroninformation->{'debarredcomment'};
196 $flaginfo{'message'} = $patroninformation->{'debarredcomment'};
197 $flaginfo{'noissues'} = 1;
198 $flaginfo{'dateend'} = $patroninformation->{'debarred'};
199 $flags{'DBARRED'} = \%flaginfo;
202 if ( $patroninformation->{'borrowernotes'}
203 && $patroninformation->{'borrowernotes'} )
206 $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
207 $flags{'NOTES'} = \%flaginfo;
209 my ( $odues, $itemsoverdue ) = C4::Overdues::checkoverdues($patroninformation->{'borrowernumber'});
210 if ( $odues && $odues > 0 ) {
212 $flaginfo{'message'} = "Yes";
213 $flaginfo{'itemlist'} = $itemsoverdue;
214 foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
217 $flaginfo{'itemlisttext'} .=
218 "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n"; # newline is display layer
220 $flags{'ODUES'} = \%flaginfo;
223 my $waiting_holds = $patron->holds->search({ found => 'W' });
224 my $nowaiting = $waiting_holds->count;
225 if ( $nowaiting > 0 ) {
227 $flaginfo{'message'} = "Reserved items available";
228 $flaginfo{'itemlist'} = $waiting_holds->unblessed;
229 $flags{'WAITING'} = \%flaginfo;
236 $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
238 Looks up what the patron with the given borrowernumber has borrowed,
239 and sorts the results.
241 C<$sortkey> is the name of a field on which to sort the results. This
242 should be the name of a field in the C<issues>, C<biblio>,
243 C<biblioitems>, or C<items> table in the Koha database.
245 C<$limit> is the maximum number of results to return.
247 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
248 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
249 C<items> tables of the Koha database.
255 my ( $borrowernumber, $order, $limit ) = @_;
257 return unless $borrowernumber;
258 $order = 'date_due desc' unless $order;
260 my $dbh = C4::Context->dbh;
262 '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
264 LEFT JOIN items on items.itemnumber=issues.itemnumber
265 LEFT JOIN borrowers on borrowers.borrowernumber=issues.issuer_id
266 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
267 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
268 WHERE issues.borrowernumber=?
270 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
272 LEFT JOIN items on items.itemnumber=old_issues.itemnumber
273 LEFT JOIN borrowers on borrowers.borrowernumber=old_issues.issuer_id
274 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
275 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
276 WHERE old_issues.borrowernumber=? AND old_issues.itemnumber IS NOT NULL
279 $query .= " limit $limit";
282 my $sth = $dbh->prepare($query);
283 $sth->execute( $borrowernumber, $borrowernumber );
284 return $sth->fetchall_arrayref( {} );
287 =head2 GetBorrowersToExpunge
289 $borrowers = &GetBorrowersToExpunge(
290 not_borrowed_since => $not_borrowed_since,
291 expired_before => $expired_before,
292 category_code => \@category_code,
293 patron_list_id => $patron_list_id,
294 branchcode => $branchcode
297 This function get all borrowers based on the given criteria.
301 sub GetBorrowersToExpunge {
304 my $filterdate = $params->{'not_borrowed_since'};
305 my $filterexpiry = $params->{'expired_before'};
306 my $filterlastseen = $params->{'last_seen'};
307 my $filtercategory = $params->{'category_code'};
308 my $filterbranch = $params->{'branchcode'} ||
309 ((C4::Context->preference('IndependentBranches')
310 && C4::Context->userenv
311 && !C4::Context->IsSuperLibrarian()
312 && C4::Context->userenv->{branch})
313 ? C4::Context->userenv->{branch}
315 my $filterpatronlist = $params->{'patron_list_id'};
317 my $dbh = C4::Context->dbh;
321 SELECT borrowers.borrowernumber,
322 MAX(old_issues.timestamp) AS latestissue,
323 MAX(issues.timestamp) AS currentissue
325 JOIN categories USING (categorycode)
328 FROM borrower_relationships
329 WHERE guarantor_id IS NOT NULL
330 AND guarantor_id <> 0
331 ) as tmp ON borrowers.borrowernumber=tmp.guarantor_id
332 LEFT JOIN old_issues USING (borrowernumber)
333 LEFT JOIN issues USING (borrowernumber)|;
334 if ( $filterpatronlist ){
335 $query .= q| LEFT JOIN patron_list_patrons USING (borrowernumber)|;
337 $query .= q| WHERE category_type <> 'S'
338 AND ( borrowers.flags IS NULL OR borrowers.flags = 0 )
339 AND tmp.guarantor_id IS NULL
342 if ( $filterbranch && $filterbranch ne "" ) {
343 $query.= " AND borrowers.branchcode = ? ";
344 push( @query_params, $filterbranch );
346 if ( $filterexpiry ) {
347 $query .= " AND dateexpiry < ? ";
348 push( @query_params, $filterexpiry );
350 if ( $filterlastseen ) {
351 $query .= ' AND lastseen < ? ';
352 push @query_params, $filterlastseen;
354 if ( $filtercategory ) {
355 if (ref($filtercategory) ne 'ARRAY' ) {
356 $filtercategory = [ $filtercategory ];
358 if ( @$filtercategory ) {
359 $query .= " AND categorycode IN (" . join(',', ('?') x @$filtercategory) . ") ";
360 push( @query_params, @$filtercategory );
363 if ( $filterpatronlist ){
364 $query.=" AND patron_list_id = ? ";
365 push( @query_params, $filterpatronlist );
367 $query .= " GROUP BY borrowers.borrowernumber";
369 ) xxx WHERE currentissue IS NULL|;
371 $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
372 push @query_params,$filterdate;
375 if ( my $anonymous_patron = C4::Context->preference("AnonymousPatron") ) {
376 $query .= q{ AND borrowernumber != ? };
377 push( @query_params, $anonymous_patron );
380 my $sth = $dbh->prepare($query);
381 if (scalar(@query_params)>0){
382 $sth->execute(@query_params);
389 while ( my $data = $sth->fetchrow_hashref ) {
390 push @results, $data;
397 IssueSlip($branchcode, $borrowernumber, $quickslip)
399 Returns letter hash ( see C4::Letters::GetPreparedLetter )
401 $quickslip is boolean, to indicate whether we want a quick slip
403 IssueSlip populates ISSUESLIP and ISSUEQSLIP, and will make the following expansions:
427 <<additional_contents.*>>
439 NOTE: Fields from tables issues, items, biblio and biblioitems are available
444 my ($branch, $borrowernumber, $quickslip) = @_;
446 # FIXME Check callers before removing this statement
447 #return unless $borrowernumber;
449 my $patron = Koha::Patrons->find( $borrowernumber );
450 return unless $patron;
452 my $pending_checkouts = $patron->pending_checkouts; # Should be $patron->checkouts->pending?
454 my ($letter_code, %repeat, %loops);
456 my $today_start = dt_from_string->set( hour => 0, minute => 0, second => 0 );
457 my $today_end = dt_from_string->set( hour => 23, minute => 59, second => 0 );
458 $today_start = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_start );
459 $today_end = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_end );
460 $letter_code = 'ISSUEQSLIP';
462 # issue date or lastreneweddate is today
463 my $todays_checkouts = $pending_checkouts->search(
467 '>=' => $today_start,
471 { '>=' => $today_start, '<=' => $today_end, }
476 while ( my $c = $todays_checkouts->next ) {
477 my $all = $c->unblessed_all_relateds;
487 checkedout => \@checkouts, # Historical syntax
490 issues => [ map { $_->{issues}{itemnumber} } @checkouts ], # TT syntax
494 my $today = Koha::Database->new->schema->storage->datetime_parser->format_datetime( dt_from_string );
495 # Checkouts due in the future
496 my $checkouts = $pending_checkouts->search({ date_due => { '>' => $today } });
497 my @checkouts; my @overdues;
498 while ( my $c = $checkouts->next ) {
499 my $all = $c->unblessed_all_relateds;
508 # Checkouts due in the past are overdues
509 my $overdues = $pending_checkouts->search({ date_due => { '<=' => $today } });
510 while ( my $o = $overdues->next ) {
511 my $all = $o->unblessed_all_relateds;
519 my $news = Koha::AdditionalContents->search_for_display(
523 lang => $patron->lang,
524 library_id => $branch,
528 while ( my $n = $news->next ) {
529 my $all = $n->unblessed_all_relateds;
531 # FIXME We keep newdate and timestamp for backward compatibility (from GetNewsToDisplay)
532 # But we should remove them and adjust the existing templates in a db rev
533 # FIXME This must be formatted in the notice template
534 my $published_on_dt = output_pref({ dt => dt_from_string( $all->{published_on} ), dateonly => 1 });
535 $all->{newdate} = $published_on_dt;
536 $all->{timestamp} = $published_on_dt;
539 additional_contents => $all,
542 $letter_code = 'ISSUESLIP';
544 checkedout => \@checkouts,
545 overdue => \@overdues,
549 issues => [ map { $_->{issues}{itemnumber} } @checkouts ],
550 overdues => [ map { $_->{issues}{itemnumber} } @overdues ],
551 opac_news => [ map { $_->{additional_contents}{idnew} } @news ],
552 additional_contents => [ map { $_->{additional_contents}{idnew} } @news ],
556 return C4::Letters::GetPreparedLetter (
557 module => 'circulation',
558 letter_code => $letter_code,
559 branchcode => $branch,
560 lang => $patron->lang,
562 'branches' => $branch,
563 'borrowers' => $borrowernumber,
570 =head2 DeleteExpiredOpacRegistrations
572 Delete accounts that haven't been upgraded from the 'temporary' category
573 Returns the number of removed patrons
577 sub DeleteExpiredOpacRegistrations {
579 my $delay = C4::Context->preference('PatronSelfRegistrationExpireTemporaryAccountsDelay');
580 my $category_code = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
582 return 0 unless $category_code && $delay;
583 # DO NOT REMOVE test on delay here!
584 # Some libraries may not use a temporary category, but want to keep patrons.
585 # We should not delete patrons when the value is NULL, empty string or 0.
587 my $date_enrolled = dt_from_string();
588 $date_enrolled->subtract( days => $delay );
590 my $registrations_to_del = Koha::Patrons->search({
591 dateenrolled => {'<=' => $date_enrolled->ymd},
592 categorycode => $category_code,
596 while ( my $registration = $registrations_to_del->next() ) {
597 next if $registration->checkouts->count || $registration->account->balance;
598 $registration->delete;
604 =head2 DeleteUnverifiedOpacRegistrations
606 Delete all unverified self registrations in borrower_modifications,
607 older than the specified number of days.
611 sub DeleteUnverifiedOpacRegistrations {
613 my $dbh = C4::Context->dbh;
615 DELETE FROM borrower_modifications
616 WHERE borrowernumber = 0 AND DATEDIFF( NOW(), timestamp ) > ?|;
617 my $cnt=$dbh->do($sql, undef, ($days) );
618 return $cnt eq '0E0'? 0: $cnt;
621 END { } # module clean-up code here (global destructor)