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 String::Random qw( random_string );
26 use Scalar::Util qw( looks_like_number );
27 use Date::Calc qw/Today check_date Date_to_Days/;
28 use List::MoreUtils qw( uniq );
30 use C4::Log; # logaction
36 use C4::NewsChannels; #get slip news
40 use Koha::AuthUtils qw(hash_password);
43 use Koha::List::Patron;
45 use Koha::Patron::Categories;
47 our (@ISA,@EXPORT,@EXPORT_OK);
57 &GetBorrowersToExpunge
71 C4::Members - Perl Module containing convenience functions for member handling
79 This module contains routines for adding, modifying and deleting members/patrons/borrowers
85 $flags = &patronflags($patron);
87 This function is not exported.
89 The following will be set where applicable:
90 $flags->{CHARGES}->{amount} Amount of debt
91 $flags->{CHARGES}->{noissues} Set if debt amount >$5.00 (or syspref noissuescharge)
92 $flags->{CHARGES}->{message} Message -- deprecated
94 $flags->{CREDITS}->{amount} Amount of credit
95 $flags->{CREDITS}->{message} Message -- deprecated
97 $flags->{ GNA } Patron has no valid address
98 $flags->{ GNA }->{noissues} Set for each GNA
99 $flags->{ GNA }->{message} "Borrower has no valid address" -- deprecated
101 $flags->{ LOST } Patron's card reported lost
102 $flags->{ LOST }->{noissues} Set for each LOST
103 $flags->{ LOST }->{message} Message -- deprecated
105 $flags->{DBARRED} Set if patron debarred, no access
106 $flags->{DBARRED}->{noissues} Set for each DBARRED
107 $flags->{DBARRED}->{message} Message -- deprecated
110 $flags->{ NOTES }->{message} The note itself. NOT deprecated
112 $flags->{ ODUES } Set if patron has overdue books.
113 $flags->{ ODUES }->{message} "Yes" -- deprecated
114 $flags->{ ODUES }->{itemlist} ref-to-array: list of overdue books
115 $flags->{ ODUES }->{itemlisttext} Text list of overdue items -- deprecated
117 $flags->{WAITING} Set if any of patron's reserves are available
118 $flags->{WAITING}->{message} Message -- deprecated
119 $flags->{WAITING}->{itemlist} ref-to-array: list of available items
123 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
124 overdue items. Its elements are references-to-hash, each describing an
125 overdue item. The keys are selected fields from the issues, biblio,
126 biblioitems, and items tables of the Koha database.
128 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
129 the overdue items, one per line. Deprecated.
131 =item C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
132 available items. Each element is a reference-to-hash whose keys are
133 fields from the reserves table of the Koha database.
137 All the "message" fields that include language generated in this function are deprecated,
138 because such strings belong properly in the display layer.
140 The "message" field that comes from the DB is OK.
144 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
145 # FIXME rename this function.
146 # DEPRECATED Do not use this subroutine!
149 my ( $patroninformation) = @_;
150 my $dbh=C4::Context->dbh;
151 my $patron = Koha::Patrons->find( $patroninformation->{borrowernumber} );
152 my $account = $patron->account;
153 my $owing = $account->non_issues_charges;
156 my $noissuescharge = C4::Context->preference("noissuescharge") || 5;
157 $flaginfo{'message'} = sprintf 'Patron owes %.02f', $owing;
158 $flaginfo{'amount'} = sprintf "%.02f", $owing;
159 if ( $owing > $noissuescharge && !C4::Context->preference("AllowFineOverride") ) {
160 $flaginfo{'noissues'} = 1;
162 $flags{'CHARGES'} = \%flaginfo;
164 elsif ( ( my $balance = $account->balance ) < 0 ) {
166 $flaginfo{'message'} = sprintf 'Patron has credit of %.02f', -$balance;
167 $flaginfo{'amount'} = sprintf "%.02f", $balance;
168 $flags{'CREDITS'} = \%flaginfo;
171 # Check the debt of the guarntees of this patron
172 my $no_issues_charge_guarantees = C4::Context->preference("NoIssuesChargeGuarantees");
173 $no_issues_charge_guarantees = undef unless looks_like_number( $no_issues_charge_guarantees );
174 if ( defined $no_issues_charge_guarantees ) {
175 my $p = Koha::Patrons->find( $patroninformation->{borrowernumber} );
176 my @guarantees = map { $_->guarantee } $p->guarantee_relationships;
177 my $guarantees_non_issues_charges = 0;
178 foreach my $g ( @guarantees ) {
179 $guarantees_non_issues_charges += $g->account->non_issues_charges;
182 if ( $guarantees_non_issues_charges > $no_issues_charge_guarantees ) {
184 $flaginfo{'message'} = sprintf 'patron guarantees owe %.02f', $guarantees_non_issues_charges;
185 $flaginfo{'amount'} = $guarantees_non_issues_charges;
186 $flaginfo{'noissues'} = 1 unless C4::Context->preference("allowfineoverride");
187 $flags{'CHARGES_GUARANTEES'} = \%flaginfo;
191 if ( $patroninformation->{'gonenoaddress'}
192 && $patroninformation->{'gonenoaddress'} == 1 )
195 $flaginfo{'message'} = 'Borrower has no valid address.';
196 $flaginfo{'noissues'} = 1;
197 $flags{'GNA'} = \%flaginfo;
199 if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
201 $flaginfo{'message'} = 'Borrower\'s card reported lost.';
202 $flaginfo{'noissues'} = 1;
203 $flags{'LOST'} = \%flaginfo;
205 if ( $patroninformation->{'debarred'} && check_date( split( /-/, $patroninformation->{'debarred'} ) ) ) {
206 if ( Date_to_Days(Date::Calc::Today) < Date_to_Days( split( /-/, $patroninformation->{'debarred'} ) ) ) {
208 $flaginfo{'debarredcomment'} = $patroninformation->{'debarredcomment'};
209 $flaginfo{'message'} = $patroninformation->{'debarredcomment'};
210 $flaginfo{'noissues'} = 1;
211 $flaginfo{'dateend'} = $patroninformation->{'debarred'};
212 $flags{'DBARRED'} = \%flaginfo;
215 if ( $patroninformation->{'borrowernotes'}
216 && $patroninformation->{'borrowernotes'} )
219 $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
220 $flags{'NOTES'} = \%flaginfo;
222 my ( $odues, $itemsoverdue ) = C4::Overdues::checkoverdues($patroninformation->{'borrowernumber'});
223 if ( $odues && $odues > 0 ) {
225 $flaginfo{'message'} = "Yes";
226 $flaginfo{'itemlist'} = $itemsoverdue;
227 foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
230 $flaginfo{'itemlisttext'} .=
231 "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n"; # newline is display layer
233 $flags{'ODUES'} = \%flaginfo;
236 my $waiting_holds = $patron->holds->search({ found => 'W' });
237 my $nowaiting = $waiting_holds->count;
238 if ( $nowaiting > 0 ) {
240 $flaginfo{'message'} = "Reserved items available";
241 $flaginfo{'itemlist'} = $waiting_holds->unblessed;
242 $flags{'WAITING'} = \%flaginfo;
249 $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
251 Looks up what the patron with the given borrowernumber has borrowed,
252 and sorts the results.
254 C<$sortkey> is the name of a field on which to sort the results. This
255 should be the name of a field in the C<issues>, C<biblio>,
256 C<biblioitems>, or C<items> table in the Koha database.
258 C<$limit> is the maximum number of results to return.
260 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
261 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
262 C<items> tables of the Koha database.
268 my ( $borrowernumber, $order, $limit ) = @_;
270 return unless $borrowernumber;
271 $order = 'date_due desc' unless $order;
273 my $dbh = C4::Context->dbh;
275 '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
277 LEFT JOIN items on items.itemnumber=issues.itemnumber
278 LEFT JOIN borrowers on borrowers.borrowernumber=issues.issuer_id
279 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
280 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
281 WHERE issues.borrowernumber=?
283 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
285 LEFT JOIN items on items.itemnumber=old_issues.itemnumber
286 LEFT JOIN borrowers on borrowers.borrowernumber=old_issues.issuer_id
287 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
288 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
289 WHERE old_issues.borrowernumber=? AND old_issues.itemnumber IS NOT NULL
292 $query .= " limit $limit";
295 my $sth = $dbh->prepare($query);
296 $sth->execute( $borrowernumber, $borrowernumber );
297 return $sth->fetchall_arrayref( {} );
300 sub checkcardnumber {
301 my ( $cardnumber, $borrowernumber ) = @_;
303 # If cardnumber is null, we assume they're allowed.
304 return 0 unless defined $cardnumber;
306 my $dbh = C4::Context->dbh;
307 my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
308 $query .= " AND borrowernumber <> ?" if ($borrowernumber);
309 my $sth = $dbh->prepare($query);
312 ( $borrowernumber ? $borrowernumber : () )
315 return 1 if $sth->fetchrow_hashref;
317 my ( $min_length, $max_length ) = get_cardnumber_length();
319 if length $cardnumber > $max_length
320 or length $cardnumber < $min_length;
325 =head2 get_cardnumber_length
327 my ($min, $max) = C4::Members::get_cardnumber_length()
329 Returns the minimum and maximum length for patron cardnumbers as
330 determined by the CardnumberLength system preference, the
331 BorrowerMandatoryField system preference, and the width of the
336 sub get_cardnumber_length {
337 my $borrower = Koha::Database->new->schema->resultset('Borrower');
338 my $field_size = $borrower->result_source->column_info('cardnumber')->{size};
339 my ( $min, $max ) = ( 0, $field_size ); # borrowers.cardnumber is a nullable varchar(20)
340 $min = 1 if C4::Context->preference('BorrowerMandatoryField') =~ /cardnumber/;
341 if ( my $cardnumber_length = C4::Context->preference('CardnumberLength') ) {
342 # Is integer and length match
343 if ( $cardnumber_length =~ m|^\d+$| ) {
344 $min = $max = $cardnumber_length
345 if $cardnumber_length >= $min
346 and $cardnumber_length <= $max;
348 # Else assuming it is a range
349 elsif ( $cardnumber_length =~ m|(\d*),(\d*)| ) {
350 $min = $1 if $1 and $min < $1;
351 $max = $2 if $2 and $max > $2;
355 $min = $max if $min > $max;
356 return ( $min, $max );
359 =head2 GetBorrowersToExpunge
361 $borrowers = &GetBorrowersToExpunge(
362 not_borrowed_since => $not_borrowed_since,
363 expired_before => $expired_before,
364 category_code => \@category_code,
365 patron_list_id => $patron_list_id,
366 branchcode => $branchcode
369 This function get all borrowers based on the given criteria.
373 sub GetBorrowersToExpunge {
376 my $filterdate = $params->{'not_borrowed_since'};
377 my $filterexpiry = $params->{'expired_before'};
378 my $filterlastseen = $params->{'last_seen'};
379 my $filtercategory = $params->{'category_code'};
380 my $filterbranch = $params->{'branchcode'} ||
381 ((C4::Context->preference('IndependentBranches')
382 && C4::Context->userenv
383 && !C4::Context->IsSuperLibrarian()
384 && C4::Context->userenv->{branch})
385 ? C4::Context->userenv->{branch}
387 my $filterpatronlist = $params->{'patron_list_id'};
389 my $dbh = C4::Context->dbh;
393 SELECT borrowers.borrowernumber,
394 MAX(old_issues.timestamp) AS latestissue,
395 MAX(issues.timestamp) AS currentissue
397 JOIN categories USING (categorycode)
400 FROM borrower_relationships
401 WHERE guarantor_id IS NOT NULL
402 AND guarantor_id <> 0
403 ) as tmp ON borrowers.borrowernumber=tmp.guarantor_id
404 LEFT JOIN old_issues USING (borrowernumber)
405 LEFT JOIN issues USING (borrowernumber)|;
406 if ( $filterpatronlist ){
407 $query .= q| LEFT JOIN patron_list_patrons USING (borrowernumber)|;
409 $query .= q| WHERE category_type <> 'S'
410 AND ( borrowers.flags IS NULL OR borrowers.flags = 0 )
411 AND tmp.guarantor_id IS NULL
414 if ( $filterbranch && $filterbranch ne "" ) {
415 $query.= " AND borrowers.branchcode = ? ";
416 push( @query_params, $filterbranch );
418 if ( $filterexpiry ) {
419 $query .= " AND dateexpiry < ? ";
420 push( @query_params, $filterexpiry );
422 if ( $filterlastseen ) {
423 $query .= ' AND lastseen < ? ';
424 push @query_params, $filterlastseen;
426 if ( $filtercategory ) {
427 if (ref($filtercategory) ne 'ARRAY' ) {
428 $filtercategory = [ $filtercategory ];
430 if ( @$filtercategory ) {
431 $query .= " AND categorycode IN (" . join(',', ('?') x @$filtercategory) . ") ";
432 push( @query_params, @$filtercategory );
435 if ( $filterpatronlist ){
436 $query.=" AND patron_list_id = ? ";
437 push( @query_params, $filterpatronlist );
439 $query .= " GROUP BY borrowers.borrowernumber";
441 ) xxx WHERE currentissue IS NULL|;
443 $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
444 push @query_params,$filterdate;
447 if ( my $anonymous_patron = C4::Context->preference("AnonymousPatron") ) {
448 $query .= q{ AND borrowernumber != ? };
449 push( @query_params, $anonymous_patron );
452 my $sth = $dbh->prepare($query);
453 if (scalar(@query_params)>0){
454 $sth->execute(@query_params);
461 while ( my $data = $sth->fetchrow_hashref ) {
462 push @results, $data;
469 IssueSlip($branchcode, $borrowernumber, $quickslip)
471 Returns letter hash ( see C4::Letters::GetPreparedLetter )
473 $quickslip is boolean, to indicate whether we want a quick slip
475 IssueSlip populates ISSUESLIP and ISSUEQSLIP, and will make the following expansions:
511 NOTE: Fields from tables issues, items, biblio and biblioitems are available
516 my ($branch, $borrowernumber, $quickslip) = @_;
518 # FIXME Check callers before removing this statement
519 #return unless $borrowernumber;
521 my $patron = Koha::Patrons->find( $borrowernumber );
522 return unless $patron;
524 my $pending_checkouts = $patron->pending_checkouts; # Should be $patron->checkouts->pending?
526 my ($letter_code, %repeat, %loops);
528 my $today_start = dt_from_string->set( hour => 0, minute => 0, second => 0 );
529 my $today_end = dt_from_string->set( hour => 23, minute => 59, second => 0 );
530 $today_start = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_start );
531 $today_end = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_end );
532 $letter_code = 'ISSUEQSLIP';
534 # issue date or lastreneweddate is today
535 my $todays_checkouts = $pending_checkouts->search(
539 '>=' => $today_start,
543 { '>=' => $today_start, '<=' => $today_end, }
548 while ( my $c = $todays_checkouts->next ) {
549 my $all = $c->unblessed_all_relateds;
559 checkedout => \@checkouts, # Historical syntax
562 issues => [ map { $_->{issues}{itemnumber} } @checkouts ], # TT syntax
566 my $today = Koha::Database->new->schema->storage->datetime_parser->format_datetime( dt_from_string );
567 # Checkouts due in the future
568 my $checkouts = $pending_checkouts->search({ date_due => { '>' => $today } });
569 my @checkouts; my @overdues;
570 while ( my $c = $checkouts->next ) {
571 my $all = $c->unblessed_all_relateds;
580 # Checkouts due in the past are overdues
581 my $overdues = $pending_checkouts->search({ date_due => { '<=' => $today } });
582 while ( my $o = $overdues->next ) {
583 my $all = $o->unblessed_all_relateds;
591 my $news = GetNewsToDisplay( "slip", $branch );
593 $_->{'timestamp'} = $_->{'newdate'};
596 $letter_code = 'ISSUESLIP';
598 checkedout => \@checkouts,
599 overdue => \@overdues,
603 issues => [ map { $_->{issues}{itemnumber} } @checkouts ],
604 overdues => [ map { $_->{issues}{itemnumber} } @overdues ],
605 opac_news => [ map { $_->{opac_news}{idnew} } @news ],
609 return C4::Letters::GetPreparedLetter (
610 module => 'circulation',
611 letter_code => $letter_code,
612 branchcode => $branch,
613 lang => $patron->lang,
615 'branches' => $branch,
616 'borrowers' => $borrowernumber,
623 =head2 DeleteExpiredOpacRegistrations
625 Delete accounts that haven't been upgraded from the 'temporary' category
626 Returns the number of removed patrons
630 sub DeleteExpiredOpacRegistrations {
632 my $delay = C4::Context->preference('PatronSelfRegistrationExpireTemporaryAccountsDelay');
633 my $category_code = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
635 return 0 if not $category_code or not defined $delay or $delay eq q||;
636 my $date_enrolled = dt_from_string();
637 $date_enrolled->subtract( days => $delay );
639 my $registrations_to_del = Koha::Patrons->search({
640 dateenrolled => {'<=' => $date_enrolled->ymd},
641 categorycode => $category_code,
645 while ( my $registration = $registrations_to_del->next() ) {
646 next if $registration->checkouts->count || $registration->account->balance;
647 $registration->delete;
653 =head2 DeleteUnverifiedOpacRegistrations
655 Delete all unverified self registrations in borrower_modifications,
656 older than the specified number of days.
660 sub DeleteUnverifiedOpacRegistrations {
662 my $dbh = C4::Context->dbh;
664 DELETE FROM borrower_modifications
665 WHERE borrowernumber = 0 AND DATEDIFF( NOW(), timestamp ) > ?|;
666 my $cnt=$dbh->do($sql, undef, ($days) );
667 return $cnt eq '0E0'? 0: $cnt;
670 END { } # module clean-up code here (global destructor)