Bug 15395: Allow correct handling of plural translation
[koha.git] / C4 / Members.pm
blob9fcc7336957b17b4635ca1140e585a2e75b3fcbc
1 package C4::Members;
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>.
23 use strict;
24 #use warnings; FIXME - Bug 2505
25 use C4::Context;
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 );
30 use JSON qw(to_json);
31 use C4::Log; # logaction
32 use C4::Overdues;
33 use C4::Reserves;
34 use C4::Accounts;
35 use C4::Biblio;
36 use C4::Letters;
37 use C4::Members::Attributes qw(SearchIdMatchingAttribute UpdateBorrowerAttribute);
38 use C4::NewsChannels; #get slip news
39 use DateTime;
40 use Koha::Database;
41 use Koha::DateUtils;
42 use Text::Unaccent qw( unac_string );
43 use Koha::AuthUtils qw(hash_password);
44 use Koha::Database;
45 use Koha::Holds;
46 use Koha::List::Patron;
47 use Koha::Patrons;
48 use Koha::Patron::Categories;
50 our (@ISA,@EXPORT,@EXPORT_OK,$debug);
52 BEGIN {
53 $debug = $ENV{DEBUG} || 0;
54 require Exporter;
55 @ISA = qw(Exporter);
56 #Get data
57 push @EXPORT, qw(
59 &GetAllIssues
61 &GetBorrowersToExpunge
63 &IssueSlip
66 #Modify data
67 push @EXPORT, qw(
68 &changepassword
71 #Check data
72 push @EXPORT, qw(
73 &checkuserpassword
74 &checkcardnumber
78 =head1 NAME
80 C4::Members - Perl Module containing convenience functions for member handling
82 =head1 SYNOPSIS
84 use C4::Members;
86 =head1 DESCRIPTION
88 This module contains routines for adding, modifying and deleting members/patrons/borrowers
90 =head1 FUNCTIONS
92 =head2 patronflags
94 $flags = &patronflags($patron);
96 This function is not exported.
98 The following will be set where applicable:
99 $flags->{CHARGES}->{amount} Amount of debt
100 $flags->{CHARGES}->{noissues} Set if debt amount >$5.00 (or syspref noissuescharge)
101 $flags->{CHARGES}->{message} Message -- deprecated
103 $flags->{CREDITS}->{amount} Amount of credit
104 $flags->{CREDITS}->{message} Message -- deprecated
106 $flags->{ GNA } Patron has no valid address
107 $flags->{ GNA }->{noissues} Set for each GNA
108 $flags->{ GNA }->{message} "Borrower has no valid address" -- deprecated
110 $flags->{ LOST } Patron's card reported lost
111 $flags->{ LOST }->{noissues} Set for each LOST
112 $flags->{ LOST }->{message} Message -- deprecated
114 $flags->{DBARRED} Set if patron debarred, no access
115 $flags->{DBARRED}->{noissues} Set for each DBARRED
116 $flags->{DBARRED}->{message} Message -- deprecated
118 $flags->{ NOTES }
119 $flags->{ NOTES }->{message} The note itself. NOT deprecated
121 $flags->{ ODUES } Set if patron has overdue books.
122 $flags->{ ODUES }->{message} "Yes" -- deprecated
123 $flags->{ ODUES }->{itemlist} ref-to-array: list of overdue books
124 $flags->{ ODUES }->{itemlisttext} Text list of overdue items -- deprecated
126 $flags->{WAITING} Set if any of patron's reserves are available
127 $flags->{WAITING}->{message} Message -- deprecated
128 $flags->{WAITING}->{itemlist} ref-to-array: list of available items
130 =over
132 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
133 overdue items. Its elements are references-to-hash, each describing an
134 overdue item. The keys are selected fields from the issues, biblio,
135 biblioitems, and items tables of the Koha database.
137 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
138 the overdue items, one per line. Deprecated.
140 =item C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
141 available items. Each element is a reference-to-hash whose keys are
142 fields from the reserves table of the Koha database.
144 =back
146 All the "message" fields that include language generated in this function are deprecated,
147 because such strings belong properly in the display layer.
149 The "message" field that comes from the DB is OK.
151 =cut
153 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
154 # FIXME rename this function.
155 # DEPRECATED Do not use this subroutine!
156 sub patronflags {
157 my %flags;
158 my ( $patroninformation) = @_;
159 my $dbh=C4::Context->dbh;
160 my $patron = Koha::Patrons->find( $patroninformation->{borrowernumber} );
161 my $account = $patron->account;
162 my $owing = $account->non_issues_charges;
163 if ( $owing > 0 ) {
164 my %flaginfo;
165 my $noissuescharge = C4::Context->preference("noissuescharge") || 5;
166 $flaginfo{'message'} = sprintf 'Patron owes %.02f', $owing;
167 $flaginfo{'amount'} = sprintf "%.02f", $owing;
168 if ( $owing > $noissuescharge && !C4::Context->preference("AllowFineOverride") ) {
169 $flaginfo{'noissues'} = 1;
171 $flags{'CHARGES'} = \%flaginfo;
173 elsif ( ( my $balance = $account->balance ) < 0 ) {
174 my %flaginfo;
175 $flaginfo{'message'} = sprintf 'Patron has credit of %.02f', -$balance;
176 $flaginfo{'amount'} = sprintf "%.02f", $balance;
177 $flags{'CREDITS'} = \%flaginfo;
180 # Check the debt of the guarntees of this patron
181 my $no_issues_charge_guarantees = C4::Context->preference("NoIssuesChargeGuarantees");
182 $no_issues_charge_guarantees = undef unless looks_like_number( $no_issues_charge_guarantees );
183 if ( defined $no_issues_charge_guarantees ) {
184 my $p = Koha::Patrons->find( $patroninformation->{borrowernumber} );
185 my @guarantees = $p->guarantees();
186 my $guarantees_non_issues_charges;
187 foreach my $g ( @guarantees ) {
188 $guarantees_non_issues_charges += $g->account->non_issues_charges;
191 if ( $guarantees_non_issues_charges > $no_issues_charge_guarantees ) {
192 my %flaginfo;
193 $flaginfo{'message'} = sprintf 'patron guarantees owe %.02f', $guarantees_non_issues_charges;
194 $flaginfo{'amount'} = $guarantees_non_issues_charges;
195 $flaginfo{'noissues'} = 1 unless C4::Context->preference("allowfineoverride");
196 $flags{'CHARGES_GUARANTEES'} = \%flaginfo;
200 if ( $patroninformation->{'gonenoaddress'}
201 && $patroninformation->{'gonenoaddress'} == 1 )
203 my %flaginfo;
204 $flaginfo{'message'} = 'Borrower has no valid address.';
205 $flaginfo{'noissues'} = 1;
206 $flags{'GNA'} = \%flaginfo;
208 if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
209 my %flaginfo;
210 $flaginfo{'message'} = 'Borrower\'s card reported lost.';
211 $flaginfo{'noissues'} = 1;
212 $flags{'LOST'} = \%flaginfo;
214 if ( $patroninformation->{'debarred'} && check_date( split( /-/, $patroninformation->{'debarred'} ) ) ) {
215 if ( Date_to_Days(Date::Calc::Today) < Date_to_Days( split( /-/, $patroninformation->{'debarred'} ) ) ) {
216 my %flaginfo;
217 $flaginfo{'debarredcomment'} = $patroninformation->{'debarredcomment'};
218 $flaginfo{'message'} = $patroninformation->{'debarredcomment'};
219 $flaginfo{'noissues'} = 1;
220 $flaginfo{'dateend'} = $patroninformation->{'debarred'};
221 $flags{'DBARRED'} = \%flaginfo;
224 if ( $patroninformation->{'borrowernotes'}
225 && $patroninformation->{'borrowernotes'} )
227 my %flaginfo;
228 $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
229 $flags{'NOTES'} = \%flaginfo;
231 my ( $odues, $itemsoverdue ) = C4::Overdues::checkoverdues($patroninformation->{'borrowernumber'});
232 if ( $odues && $odues > 0 ) {
233 my %flaginfo;
234 $flaginfo{'message'} = "Yes";
235 $flaginfo{'itemlist'} = $itemsoverdue;
236 foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
237 @$itemsoverdue )
239 $flaginfo{'itemlisttext'} .=
240 "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n"; # newline is display layer
242 $flags{'ODUES'} = \%flaginfo;
245 my $waiting_holds = $patron->holds->search({ found => 'W' });
246 my $nowaiting = $waiting_holds->count;
247 if ( $nowaiting > 0 ) {
248 my %flaginfo;
249 $flaginfo{'message'} = "Reserved items available";
250 $flaginfo{'itemlist'} = $waiting_holds->unblessed;
251 $flags{'WAITING'} = \%flaginfo;
253 return ( \%flags );
256 =head2 GetAllIssues
258 $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
260 Looks up what the patron with the given borrowernumber has borrowed,
261 and sorts the results.
263 C<$sortkey> is the name of a field on which to sort the results. This
264 should be the name of a field in the C<issues>, C<biblio>,
265 C<biblioitems>, or C<items> table in the Koha database.
267 C<$limit> is the maximum number of results to return.
269 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
270 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
271 C<items> tables of the Koha database.
273 =cut
276 sub GetAllIssues {
277 my ( $borrowernumber, $order, $limit ) = @_;
279 return unless $borrowernumber;
280 $order = 'date_due desc' unless $order;
282 my $dbh = C4::Context->dbh;
283 my $query =
284 'SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
285 FROM issues
286 LEFT JOIN items on items.itemnumber=issues.itemnumber
287 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
288 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
289 WHERE borrowernumber=?
290 UNION ALL
291 SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
292 FROM old_issues
293 LEFT JOIN items on items.itemnumber=old_issues.itemnumber
294 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
295 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
296 WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL
297 order by ' . $order;
298 if ($limit) {
299 $query .= " limit $limit";
302 my $sth = $dbh->prepare($query);
303 $sth->execute( $borrowernumber, $borrowernumber );
304 return $sth->fetchall_arrayref( {} );
307 sub checkcardnumber {
308 my ( $cardnumber, $borrowernumber ) = @_;
310 # If cardnumber is null, we assume they're allowed.
311 return 0 unless defined $cardnumber;
313 my $dbh = C4::Context->dbh;
314 my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
315 $query .= " AND borrowernumber <> ?" if ($borrowernumber);
316 my $sth = $dbh->prepare($query);
317 $sth->execute(
318 $cardnumber,
319 ( $borrowernumber ? $borrowernumber : () )
322 return 1 if $sth->fetchrow_hashref;
324 my ( $min_length, $max_length ) = get_cardnumber_length();
325 return 2
326 if length $cardnumber > $max_length
327 or length $cardnumber < $min_length;
329 return 0;
332 =head2 get_cardnumber_length
334 my ($min, $max) = C4::Members::get_cardnumber_length()
336 Returns the minimum and maximum length for patron cardnumbers as
337 determined by the CardnumberLength system preference, the
338 BorrowerMandatoryField system preference, and the width of the
339 database column.
341 =cut
343 sub get_cardnumber_length {
344 my $borrower = Koha::Database->new->schema->resultset('Borrower');
345 my $field_size = $borrower->result_source->column_info('cardnumber')->{size};
346 my ( $min, $max ) = ( 0, $field_size ); # borrowers.cardnumber is a nullable varchar(20)
347 $min = 1 if C4::Context->preference('BorrowerMandatoryField') =~ /cardnumber/;
348 if ( my $cardnumber_length = C4::Context->preference('CardnumberLength') ) {
349 # Is integer and length match
350 if ( $cardnumber_length =~ m|^\d+$| ) {
351 $min = $max = $cardnumber_length
352 if $cardnumber_length >= $min
353 and $cardnumber_length <= $max;
355 # Else assuming it is a range
356 elsif ( $cardnumber_length =~ m|(\d*),(\d*)| ) {
357 $min = $1 if $1 and $min < $1;
358 $max = $2 if $2 and $max > $2;
362 $min = $max if $min > $max;
363 return ( $min, $max );
366 =head2 GetBorrowersToExpunge
368 $borrowers = &GetBorrowersToExpunge(
369 not_borrowed_since => $not_borrowed_since,
370 expired_before => $expired_before,
371 category_code => $category_code,
372 patron_list_id => $patron_list_id,
373 branchcode => $branchcode
376 This function get all borrowers based on the given criteria.
378 =cut
380 sub GetBorrowersToExpunge {
382 my $params = shift;
383 my $filterdate = $params->{'not_borrowed_since'};
384 my $filterexpiry = $params->{'expired_before'};
385 my $filterlastseen = $params->{'last_seen'};
386 my $filtercategory = $params->{'category_code'};
387 my $filterbranch = $params->{'branchcode'} ||
388 ((C4::Context->preference('IndependentBranches')
389 && C4::Context->userenv
390 && !C4::Context->IsSuperLibrarian()
391 && C4::Context->userenv->{branch})
392 ? C4::Context->userenv->{branch}
393 : "");
394 my $filterpatronlist = $params->{'patron_list_id'};
396 my $dbh = C4::Context->dbh;
397 my $query = q|
398 SELECT *
399 FROM (
400 SELECT borrowers.borrowernumber,
401 MAX(old_issues.timestamp) AS latestissue,
402 MAX(issues.timestamp) AS currentissue
403 FROM borrowers
404 JOIN categories USING (categorycode)
405 LEFT JOIN (
406 SELECT guarantorid
407 FROM borrowers
408 WHERE guarantorid IS NOT NULL
409 AND guarantorid <> 0
410 ) as tmp ON borrowers.borrowernumber=tmp.guarantorid
411 LEFT JOIN old_issues USING (borrowernumber)
412 LEFT JOIN issues USING (borrowernumber)|;
413 if ( $filterpatronlist ){
414 $query .= q| LEFT JOIN patron_list_patrons USING (borrowernumber)|;
416 $query .= q| WHERE category_type <> 'S'
417 AND tmp.guarantorid IS NULL
419 my @query_params;
420 if ( $filterbranch && $filterbranch ne "" ) {
421 $query.= " AND borrowers.branchcode = ? ";
422 push( @query_params, $filterbranch );
424 if ( $filterexpiry ) {
425 $query .= " AND dateexpiry < ? ";
426 push( @query_params, $filterexpiry );
428 if ( $filterlastseen ) {
429 $query .= ' AND lastseen < ? ';
430 push @query_params, $filterlastseen;
432 if ( $filtercategory ) {
433 $query .= " AND categorycode = ? ";
434 push( @query_params, $filtercategory );
436 if ( $filterpatronlist ){
437 $query.=" AND patron_list_id = ? ";
438 push( @query_params, $filterpatronlist );
440 $query .= " GROUP BY borrowers.borrowernumber";
441 $query .= q|
442 ) xxx WHERE currentissue IS NULL|;
443 if ( $filterdate ) {
444 $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
445 push @query_params,$filterdate;
448 warn $query if $debug;
450 my $sth = $dbh->prepare($query);
451 if (scalar(@query_params)>0){
452 $sth->execute(@query_params);
454 else {
455 $sth->execute;
458 my @results;
459 while ( my $data = $sth->fetchrow_hashref ) {
460 push @results, $data;
462 return \@results;
465 =head2 IssueSlip
467 IssueSlip($branchcode, $borrowernumber, $quickslip)
469 Returns letter hash ( see C4::Letters::GetPreparedLetter )
471 $quickslip is boolean, to indicate whether we want a quick slip
473 IssueSlip populates ISSUESLIP and ISSUEQSLIP, and will make the following expansions:
475 Both slips:
477 <<branches.*>>
478 <<borrowers.*>>
480 ISSUESLIP:
482 <checkedout>
483 <<biblio.*>>
484 <<items.*>>
485 <<biblioitems.*>>
486 <<issues.*>>
487 </checkedout>
489 <overdue>
490 <<biblio.*>>
491 <<items.*>>
492 <<biblioitems.*>>
493 <<issues.*>>
494 </overdue>
496 <news>
497 <<opac_news.*>>
498 </news>
500 ISSUEQSLIP:
502 <checkedout>
503 <<biblio.*>>
504 <<items.*>>
505 <<biblioitems.*>>
506 <<issues.*>>
507 </checkedout>
509 NOTE: Fields from tables issues, items, biblio and biblioitems are available
511 =cut
513 sub IssueSlip {
514 my ($branch, $borrowernumber, $quickslip) = @_;
516 # FIXME Check callers before removing this statement
517 #return unless $borrowernumber;
519 my $patron = Koha::Patrons->find( $borrowernumber );
520 return unless $patron;
522 my $pending_checkouts = $patron->pending_checkouts; # Should be $patron->checkouts->pending?
524 my ($letter_code, %repeat, %loops);
525 if ( $quickslip ) {
526 my $today_start = dt_from_string->set( hour => 0, minute => 0, second => 0 );
527 my $today_end = dt_from_string->set( hour => 23, minute => 59, second => 0 );
528 $today_start = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_start );
529 $today_end = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_end );
530 $letter_code = 'ISSUEQSLIP';
532 # issue date or lastreneweddate is today
533 my $todays_checkouts = $pending_checkouts->search(
535 -or => {
536 issuedate => {
537 '>=' => $today_start,
538 '<=' => $today_end,
540 lastreneweddate =>
541 { '>=' => $today_start, '<=' => $today_end, }
545 my @checkouts;
546 while ( my $c = $todays_checkouts->next ) {
547 my $all = $c->unblessed_all_relateds;
548 push @checkouts, {
549 biblio => $all,
550 items => $all,
551 biblioitems => $all,
552 issues => $all,
556 %repeat = (
557 checkedout => \@checkouts, # Historical syntax
559 %loops = (
560 issues => [ map { $_->{issues}{itemnumber} } @checkouts ], # TT syntax
563 else {
564 my $today = Koha::Database->new->schema->storage->datetime_parser->format_datetime( dt_from_string );
565 # Checkouts due in the future
566 my $checkouts = $pending_checkouts->search({ date_due => { '>' => $today } });
567 my @checkouts; my @overdues;
568 while ( my $c = $checkouts->next ) {
569 my $all = $c->unblessed_all_relateds;
570 push @checkouts, {
571 biblio => $all,
572 items => $all,
573 biblioitems => $all,
574 issues => $all,
578 # Checkouts due in the past are overdues
579 my $overdues = $pending_checkouts->search({ date_due => { '<=' => $today } });
580 while ( my $o = $overdues->next ) {
581 my $all = $o->unblessed_all_relateds;
582 push @overdues, {
583 biblio => $all,
584 items => $all,
585 biblioitems => $all,
586 issues => $all,
589 my $news = GetNewsToDisplay( "slip", $branch );
590 my @news = map {
591 $_->{'timestamp'} = $_->{'newdate'};
592 { opac_news => $_ }
593 } @$news;
594 $letter_code = 'ISSUESLIP';
595 %repeat = (
596 checkedout => \@checkouts,
597 overdue => \@overdues,
598 news => \@news,
600 %loops = (
601 issues => [ map { $_->{issues}{itemnumber} } @checkouts ],
602 overdues => [ map { $_->{issues}{itemnumber} } @overdues ],
603 opac_news => [ map { $_->{opac_news}{idnew} } @news ],
607 return C4::Letters::GetPreparedLetter (
608 module => 'circulation',
609 letter_code => $letter_code,
610 branchcode => $branch,
611 lang => $patron->lang,
612 tables => {
613 'branches' => $branch,
614 'borrowers' => $borrowernumber,
616 repeat => \%repeat,
617 loops => \%loops,
621 =head2 DeleteExpiredOpacRegistrations
623 Delete accounts that haven't been upgraded from the 'temporary' category
624 Returns the number of removed patrons
626 =cut
628 sub DeleteExpiredOpacRegistrations {
630 my $delay = C4::Context->preference('PatronSelfRegistrationExpireTemporaryAccountsDelay');
631 my $category_code = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
633 return 0 if not $category_code or not defined $delay or $delay eq q||;
635 my $query = qq|
636 SELECT borrowernumber
637 FROM borrowers
638 WHERE categorycode = ? AND DATEDIFF( NOW(), dateenrolled ) > ? |;
640 my $dbh = C4::Context->dbh;
641 my $sth = $dbh->prepare($query);
642 $sth->execute( $category_code, $delay );
643 my $cnt=0;
644 while ( my ($borrowernumber) = $sth->fetchrow_array() ) {
645 Koha::Patrons->find($borrowernumber)->delete;
646 $cnt++;
648 return $cnt;
651 =head2 DeleteUnverifiedOpacRegistrations
653 Delete all unverified self registrations in borrower_modifications,
654 older than the specified number of days.
656 =cut
658 sub DeleteUnverifiedOpacRegistrations {
659 my ( $days ) = @_;
660 my $dbh = C4::Context->dbh;
661 my $sql=qq|
662 DELETE FROM borrower_modifications
663 WHERE borrowernumber = 0 AND DATEDIFF( NOW(), timestamp ) > ?|;
664 my $cnt=$dbh->do($sql, undef, ($days) );
665 return $cnt eq '0E0'? 0: $cnt;
668 END { } # module clean-up code here (global destructor)
672 __END__
674 =head1 AUTHOR
676 Koha Team
678 =cut