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>.
24 #use warnings; FIXME - Bug 2505
26 use String::Random qw( random_string );
27 use Scalar::Util qw( looks_like_number );
28 use Date::Calc qw/Today check_date Date_to_Days/;
29 use List::MoreUtils qw( uniq );
31 use C4::Log; # logaction
37 use C4::Members::Attributes qw(SearchIdMatchingAttribute UpdateBorrowerAttribute);
38 use C4::NewsChannels; #get slip news
42 use Koha::AuthUtils qw(hash_password);
45 use Koha::List::Patron;
47 use Koha::Patron::Categories;
49 our (@ISA,@EXPORT,@EXPORT_OK,$debug);
52 $debug = $ENV{DEBUG} || 0;
60 &GetBorrowersToExpunge
79 C4::Members - Perl Module containing convenience functions for member handling
87 This module contains routines for adding, modifying and deleting members/patrons/borrowers
93 $flags = &patronflags($patron);
95 This function is not exported.
97 The following will be set where applicable:
98 $flags->{CHARGES}->{amount} Amount of debt
99 $flags->{CHARGES}->{noissues} Set if debt amount >$5.00 (or syspref noissuescharge)
100 $flags->{CHARGES}->{message} Message -- deprecated
102 $flags->{CREDITS}->{amount} Amount of credit
103 $flags->{CREDITS}->{message} Message -- deprecated
105 $flags->{ GNA } Patron has no valid address
106 $flags->{ GNA }->{noissues} Set for each GNA
107 $flags->{ GNA }->{message} "Borrower has no valid address" -- deprecated
109 $flags->{ LOST } Patron's card reported lost
110 $flags->{ LOST }->{noissues} Set for each LOST
111 $flags->{ LOST }->{message} Message -- deprecated
113 $flags->{DBARRED} Set if patron debarred, no access
114 $flags->{DBARRED}->{noissues} Set for each DBARRED
115 $flags->{DBARRED}->{message} Message -- deprecated
118 $flags->{ NOTES }->{message} The note itself. NOT deprecated
120 $flags->{ ODUES } Set if patron has overdue books.
121 $flags->{ ODUES }->{message} "Yes" -- deprecated
122 $flags->{ ODUES }->{itemlist} ref-to-array: list of overdue books
123 $flags->{ ODUES }->{itemlisttext} Text list of overdue items -- deprecated
125 $flags->{WAITING} Set if any of patron's reserves are available
126 $flags->{WAITING}->{message} Message -- deprecated
127 $flags->{WAITING}->{itemlist} ref-to-array: list of available items
131 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
132 overdue items. Its elements are references-to-hash, each describing an
133 overdue item. The keys are selected fields from the issues, biblio,
134 biblioitems, and items tables of the Koha database.
136 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
137 the overdue items, one per line. Deprecated.
139 =item C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
140 available items. Each element is a reference-to-hash whose keys are
141 fields from the reserves table of the Koha database.
145 All the "message" fields that include language generated in this function are deprecated,
146 because such strings belong properly in the display layer.
148 The "message" field that comes from the DB is OK.
152 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
153 # FIXME rename this function.
154 # DEPRECATED Do not use this subroutine!
157 my ( $patroninformation) = @_;
158 my $dbh=C4::Context->dbh;
159 my $patron = Koha::Patrons->find( $patroninformation->{borrowernumber} );
160 my $account = $patron->account;
161 my $owing = $account->non_issues_charges;
164 my $noissuescharge = C4::Context->preference("noissuescharge") || 5;
165 $flaginfo{'message'} = sprintf 'Patron owes %.02f', $owing;
166 $flaginfo{'amount'} = sprintf "%.02f", $owing;
167 if ( $owing > $noissuescharge && !C4::Context->preference("AllowFineOverride") ) {
168 $flaginfo{'noissues'} = 1;
170 $flags{'CHARGES'} = \%flaginfo;
172 elsif ( ( my $balance = $account->balance ) < 0 ) {
174 $flaginfo{'message'} = sprintf 'Patron has credit of %.02f', -$balance;
175 $flaginfo{'amount'} = sprintf "%.02f", $balance;
176 $flags{'CREDITS'} = \%flaginfo;
179 # Check the debt of the guarntees of this patron
180 my $no_issues_charge_guarantees = C4::Context->preference("NoIssuesChargeGuarantees");
181 $no_issues_charge_guarantees = undef unless looks_like_number( $no_issues_charge_guarantees );
182 if ( defined $no_issues_charge_guarantees ) {
183 my $p = Koha::Patrons->find( $patroninformation->{borrowernumber} );
184 my @guarantees = $p->guarantees();
185 my $guarantees_non_issues_charges;
186 foreach my $g ( @guarantees ) {
187 $guarantees_non_issues_charges += $g->account->non_issues_charges;
190 if ( $guarantees_non_issues_charges > $no_issues_charge_guarantees ) {
192 $flaginfo{'message'} = sprintf 'patron guarantees owe %.02f', $guarantees_non_issues_charges;
193 $flaginfo{'amount'} = $guarantees_non_issues_charges;
194 $flaginfo{'noissues'} = 1 unless C4::Context->preference("allowfineoverride");
195 $flags{'CHARGES_GUARANTEES'} = \%flaginfo;
199 if ( $patroninformation->{'gonenoaddress'}
200 && $patroninformation->{'gonenoaddress'} == 1 )
203 $flaginfo{'message'} = 'Borrower has no valid address.';
204 $flaginfo{'noissues'} = 1;
205 $flags{'GNA'} = \%flaginfo;
207 if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
209 $flaginfo{'message'} = 'Borrower\'s card reported lost.';
210 $flaginfo{'noissues'} = 1;
211 $flags{'LOST'} = \%flaginfo;
213 if ( $patroninformation->{'debarred'} && check_date( split( /-/, $patroninformation->{'debarred'} ) ) ) {
214 if ( Date_to_Days(Date::Calc::Today) < Date_to_Days( split( /-/, $patroninformation->{'debarred'} ) ) ) {
216 $flaginfo{'debarredcomment'} = $patroninformation->{'debarredcomment'};
217 $flaginfo{'message'} = $patroninformation->{'debarredcomment'};
218 $flaginfo{'noissues'} = 1;
219 $flaginfo{'dateend'} = $patroninformation->{'debarred'};
220 $flags{'DBARRED'} = \%flaginfo;
223 if ( $patroninformation->{'borrowernotes'}
224 && $patroninformation->{'borrowernotes'} )
227 $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
228 $flags{'NOTES'} = \%flaginfo;
230 my ( $odues, $itemsoverdue ) = C4::Overdues::checkoverdues($patroninformation->{'borrowernumber'});
231 if ( $odues && $odues > 0 ) {
233 $flaginfo{'message'} = "Yes";
234 $flaginfo{'itemlist'} = $itemsoverdue;
235 foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
238 $flaginfo{'itemlisttext'} .=
239 "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n"; # newline is display layer
241 $flags{'ODUES'} = \%flaginfo;
244 my $waiting_holds = $patron->holds->search({ found => 'W' });
245 my $nowaiting = $waiting_holds->count;
246 if ( $nowaiting > 0 ) {
248 $flaginfo{'message'} = "Reserved items available";
249 $flaginfo{'itemlist'} = $waiting_holds->unblessed;
250 $flags{'WAITING'} = \%flaginfo;
257 $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
259 Looks up what the patron with the given borrowernumber has borrowed,
260 and sorts the results.
262 C<$sortkey> is the name of a field on which to sort the results. This
263 should be the name of a field in the C<issues>, C<biblio>,
264 C<biblioitems>, or C<items> table in the Koha database.
266 C<$limit> is the maximum number of results to return.
268 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
269 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
270 C<items> tables of the Koha database.
276 my ( $borrowernumber, $order, $limit ) = @_;
278 return unless $borrowernumber;
279 $order = 'date_due desc' unless $order;
281 my $dbh = C4::Context->dbh;
283 'SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
285 LEFT JOIN items on items.itemnumber=issues.itemnumber
286 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
287 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
288 WHERE borrowernumber=?
290 SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
292 LEFT JOIN items on items.itemnumber=old_issues.itemnumber
293 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
294 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
295 WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL
298 $query .= " limit $limit";
301 my $sth = $dbh->prepare($query);
302 $sth->execute( $borrowernumber, $borrowernumber );
303 return $sth->fetchall_arrayref( {} );
306 sub checkcardnumber {
307 my ( $cardnumber, $borrowernumber ) = @_;
309 # If cardnumber is null, we assume they're allowed.
310 return 0 unless defined $cardnumber;
312 my $dbh = C4::Context->dbh;
313 my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
314 $query .= " AND borrowernumber <> ?" if ($borrowernumber);
315 my $sth = $dbh->prepare($query);
318 ( $borrowernumber ? $borrowernumber : () )
321 return 1 if $sth->fetchrow_hashref;
323 my ( $min_length, $max_length ) = get_cardnumber_length();
325 if length $cardnumber > $max_length
326 or length $cardnumber < $min_length;
331 =head2 get_cardnumber_length
333 my ($min, $max) = C4::Members::get_cardnumber_length()
335 Returns the minimum and maximum length for patron cardnumbers as
336 determined by the CardnumberLength system preference, the
337 BorrowerMandatoryField system preference, and the width of the
342 sub get_cardnumber_length {
343 my $borrower = Koha::Database->new->schema->resultset('Borrower');
344 my $field_size = $borrower->result_source->column_info('cardnumber')->{size};
345 my ( $min, $max ) = ( 0, $field_size ); # borrowers.cardnumber is a nullable varchar(20)
346 $min = 1 if C4::Context->preference('BorrowerMandatoryField') =~ /cardnumber/;
347 if ( my $cardnumber_length = C4::Context->preference('CardnumberLength') ) {
348 # Is integer and length match
349 if ( $cardnumber_length =~ m|^\d+$| ) {
350 $min = $max = $cardnumber_length
351 if $cardnumber_length >= $min
352 and $cardnumber_length <= $max;
354 # Else assuming it is a range
355 elsif ( $cardnumber_length =~ m|(\d*),(\d*)| ) {
356 $min = $1 if $1 and $min < $1;
357 $max = $2 if $2 and $max > $2;
361 $min = $max if $min > $max;
362 return ( $min, $max );
365 =head2 GetBorrowersToExpunge
367 $borrowers = &GetBorrowersToExpunge(
368 not_borrowed_since => $not_borrowed_since,
369 expired_before => $expired_before,
370 category_code => $category_code,
371 patron_list_id => $patron_list_id,
372 branchcode => $branchcode
375 This function get all borrowers based on the given criteria.
379 sub GetBorrowersToExpunge {
382 my $filterdate = $params->{'not_borrowed_since'};
383 my $filterexpiry = $params->{'expired_before'};
384 my $filterlastseen = $params->{'last_seen'};
385 my $filtercategory = $params->{'category_code'};
386 my $filterbranch = $params->{'branchcode'} ||
387 ((C4::Context->preference('IndependentBranches')
388 && C4::Context->userenv
389 && !C4::Context->IsSuperLibrarian()
390 && C4::Context->userenv->{branch})
391 ? C4::Context->userenv->{branch}
393 my $filterpatronlist = $params->{'patron_list_id'};
395 my $dbh = C4::Context->dbh;
399 SELECT borrowers.borrowernumber,
400 MAX(old_issues.timestamp) AS latestissue,
401 MAX(issues.timestamp) AS currentissue
403 JOIN categories USING (categorycode)
407 WHERE guarantorid IS NOT NULL
409 ) as tmp ON borrowers.borrowernumber=tmp.guarantorid
410 LEFT JOIN old_issues USING (borrowernumber)
411 LEFT JOIN issues USING (borrowernumber)|;
412 if ( $filterpatronlist ){
413 $query .= q| LEFT JOIN patron_list_patrons USING (borrowernumber)|;
415 $query .= q| WHERE category_type <> 'S'
416 AND tmp.guarantorid IS NULL
419 if ( $filterbranch && $filterbranch ne "" ) {
420 $query.= " AND borrowers.branchcode = ? ";
421 push( @query_params, $filterbranch );
423 if ( $filterexpiry ) {
424 $query .= " AND dateexpiry < ? ";
425 push( @query_params, $filterexpiry );
427 if ( $filterlastseen ) {
428 $query .= ' AND lastseen < ? ';
429 push @query_params, $filterlastseen;
431 if ( $filtercategory ) {
432 $query .= " AND categorycode = ? ";
433 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 warn $query if $debug;
449 my $sth = $dbh->prepare($query);
450 if (scalar(@query_params)>0){
451 $sth->execute(@query_params);
458 while ( my $data = $sth->fetchrow_hashref ) {
459 push @results, $data;
466 IssueSlip($branchcode, $borrowernumber, $quickslip)
468 Returns letter hash ( see C4::Letters::GetPreparedLetter )
470 $quickslip is boolean, to indicate whether we want a quick slip
472 IssueSlip populates ISSUESLIP and ISSUEQSLIP, and will make the following expansions:
508 NOTE: Fields from tables issues, items, biblio and biblioitems are available
513 my ($branch, $borrowernumber, $quickslip) = @_;
515 # FIXME Check callers before removing this statement
516 #return unless $borrowernumber;
518 my $patron = Koha::Patrons->find( $borrowernumber );
519 return unless $patron;
521 my $pending_checkouts = $patron->pending_checkouts; # Should be $patron->checkouts->pending?
523 my ($letter_code, %repeat, %loops);
525 my $today_start = dt_from_string->set( hour => 0, minute => 0, second => 0 );
526 my $today_end = dt_from_string->set( hour => 23, minute => 59, second => 0 );
527 $today_start = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_start );
528 $today_end = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_end );
529 $letter_code = 'ISSUEQSLIP';
531 # issue date or lastreneweddate is today
532 my $todays_checkouts = $pending_checkouts->search(
536 '>=' => $today_start,
540 { '>=' => $today_start, '<=' => $today_end, }
545 while ( my $c = $todays_checkouts->next ) {
546 my $all = $c->unblessed_all_relateds;
556 checkedout => \@checkouts, # Historical syntax
559 issues => [ map { $_->{issues}{itemnumber} } @checkouts ], # TT syntax
563 my $today = Koha::Database->new->schema->storage->datetime_parser->format_datetime( dt_from_string );
564 # Checkouts due in the future
565 my $checkouts = $pending_checkouts->search({ date_due => { '>' => $today } });
566 my @checkouts; my @overdues;
567 while ( my $c = $checkouts->next ) {
568 my $all = $c->unblessed_all_relateds;
577 # Checkouts due in the past are overdues
578 my $overdues = $pending_checkouts->search({ date_due => { '<=' => $today } });
579 while ( my $o = $overdues->next ) {
580 my $all = $o->unblessed_all_relateds;
588 my $news = GetNewsToDisplay( "slip", $branch );
590 $_->{'timestamp'} = $_->{'newdate'};
593 $letter_code = 'ISSUESLIP';
595 checkedout => \@checkouts,
596 overdue => \@overdues,
600 issues => [ map { $_->{issues}{itemnumber} } @checkouts ],
601 overdues => [ map { $_->{issues}{itemnumber} } @overdues ],
602 opac_news => [ map { $_->{opac_news}{idnew} } @news ],
606 return C4::Letters::GetPreparedLetter (
607 module => 'circulation',
608 letter_code => $letter_code,
609 branchcode => $branch,
610 lang => $patron->lang,
612 'branches' => $branch,
613 'borrowers' => $borrowernumber,
620 =head2 DeleteExpiredOpacRegistrations
622 Delete accounts that haven't been upgraded from the 'temporary' category
623 Returns the number of removed patrons
627 sub DeleteExpiredOpacRegistrations {
629 my $delay = C4::Context->preference('PatronSelfRegistrationExpireTemporaryAccountsDelay');
630 my $category_code = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
632 return 0 if not $category_code or not defined $delay or $delay eq q||;
635 SELECT borrowernumber
637 WHERE categorycode = ? AND DATEDIFF( NOW(), dateenrolled ) > ? |;
639 my $dbh = C4::Context->dbh;
640 my $sth = $dbh->prepare($query);
641 $sth->execute( $category_code, $delay );
643 while ( my ($borrowernumber) = $sth->fetchrow_array() ) {
644 Koha::Patrons->find($borrowernumber)->delete;
650 =head2 DeleteUnverifiedOpacRegistrations
652 Delete all unverified self registrations in borrower_modifications,
653 older than the specified number of days.
657 sub DeleteUnverifiedOpacRegistrations {
659 my $dbh = C4::Context->dbh;
661 DELETE FROM borrower_modifications
662 WHERE borrowernumber = 0 AND DATEDIFF( NOW(), timestamp ) > ?|;
663 my $cnt=$dbh->do($sql, undef, ($days) );
664 return $cnt eq '0E0'? 0: $cnt;
667 END { } # module clean-up code here (global destructor)