Bug 7947: Update MARC21 440/490 mapping and visibility in ru-RU installer
[koha.git] / C4 / Members.pm
blob6c10eeeb2c72a8db39b707b2b1821b8510c5b296
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 Modern::Perl;
24 use C4::Context;
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 );
29 use JSON qw(to_json);
30 use C4::Log; # logaction
31 use C4::Overdues;
32 use C4::Reserves;
33 use C4::Accounts;
34 use C4::Biblio;
35 use C4::Letters;
36 use C4::NewsChannels; #get slip news
37 use DateTime;
38 use Koha::Database;
39 use Koha::DateUtils;
40 use Koha::AuthUtils qw(hash_password);
41 use Koha::Database;
42 use Koha::Holds;
43 use Koha::List::Patron;
44 use Koha::Patrons;
45 use Koha::Patron::Categories;
47 our (@ISA,@EXPORT,@EXPORT_OK,$debug);
49 BEGIN {
50 $debug = $ENV{DEBUG} || 0;
51 require Exporter;
52 @ISA = qw(Exporter);
53 #Get data
54 push @EXPORT, qw(
56 &GetAllIssues
58 &GetBorrowersToExpunge
60 &IssueSlip
63 #Check data
64 push @EXPORT, qw(
65 &checkuserpassword
66 &checkcardnumber
70 =head1 NAME
72 C4::Members - Perl Module containing convenience functions for member handling
74 =head1 SYNOPSIS
76 use C4::Members;
78 =head1 DESCRIPTION
80 This module contains routines for adding, modifying and deleting members/patrons/borrowers
82 =head1 FUNCTIONS
84 =head2 patronflags
86 $flags = &patronflags($patron);
88 This function is not exported.
90 The following will be set where applicable:
91 $flags->{CHARGES}->{amount} Amount of debt
92 $flags->{CHARGES}->{noissues} Set if debt amount >$5.00 (or syspref noissuescharge)
93 $flags->{CHARGES}->{message} Message -- deprecated
95 $flags->{CREDITS}->{amount} Amount of credit
96 $flags->{CREDITS}->{message} Message -- deprecated
98 $flags->{ GNA } Patron has no valid address
99 $flags->{ GNA }->{noissues} Set for each GNA
100 $flags->{ GNA }->{message} "Borrower has no valid address" -- deprecated
102 $flags->{ LOST } Patron's card reported lost
103 $flags->{ LOST }->{noissues} Set for each LOST
104 $flags->{ LOST }->{message} Message -- deprecated
106 $flags->{DBARRED} Set if patron debarred, no access
107 $flags->{DBARRED}->{noissues} Set for each DBARRED
108 $flags->{DBARRED}->{message} Message -- deprecated
110 $flags->{ NOTES }
111 $flags->{ NOTES }->{message} The note itself. NOT deprecated
113 $flags->{ ODUES } Set if patron has overdue books.
114 $flags->{ ODUES }->{message} "Yes" -- deprecated
115 $flags->{ ODUES }->{itemlist} ref-to-array: list of overdue books
116 $flags->{ ODUES }->{itemlisttext} Text list of overdue items -- deprecated
118 $flags->{WAITING} Set if any of patron's reserves are available
119 $flags->{WAITING}->{message} Message -- deprecated
120 $flags->{WAITING}->{itemlist} ref-to-array: list of available items
122 =over
124 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
125 overdue items. Its elements are references-to-hash, each describing an
126 overdue item. The keys are selected fields from the issues, biblio,
127 biblioitems, and items tables of the Koha database.
129 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
130 the overdue items, one per line. Deprecated.
132 =item C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
133 available items. Each element is a reference-to-hash whose keys are
134 fields from the reserves table of the Koha database.
136 =back
138 All the "message" fields that include language generated in this function are deprecated,
139 because such strings belong properly in the display layer.
141 The "message" field that comes from the DB is OK.
143 =cut
145 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
146 # FIXME rename this function.
147 # DEPRECATED Do not use this subroutine!
148 sub patronflags {
149 my %flags;
150 my ( $patroninformation) = @_;
151 my $dbh=C4::Context->dbh;
152 my $patron = Koha::Patrons->find( $patroninformation->{borrowernumber} );
153 my $account = $patron->account;
154 my $owing = $account->non_issues_charges;
155 if ( $owing > 0 ) {
156 my %flaginfo;
157 my $noissuescharge = C4::Context->preference("noissuescharge") || 5;
158 $flaginfo{'message'} = sprintf 'Patron owes %.02f', $owing;
159 $flaginfo{'amount'} = sprintf "%.02f", $owing;
160 if ( $owing > $noissuescharge && !C4::Context->preference("AllowFineOverride") ) {
161 $flaginfo{'noissues'} = 1;
163 $flags{'CHARGES'} = \%flaginfo;
165 elsif ( ( my $balance = $account->balance ) < 0 ) {
166 my %flaginfo;
167 $flaginfo{'message'} = sprintf 'Patron has credit of %.02f', -$balance;
168 $flaginfo{'amount'} = sprintf "%.02f", $balance;
169 $flags{'CREDITS'} = \%flaginfo;
172 # Check the debt of the guarntees of this patron
173 my $no_issues_charge_guarantees = C4::Context->preference("NoIssuesChargeGuarantees");
174 $no_issues_charge_guarantees = undef unless looks_like_number( $no_issues_charge_guarantees );
175 if ( defined $no_issues_charge_guarantees ) {
176 my $p = Koha::Patrons->find( $patroninformation->{borrowernumber} );
177 my @guarantees = map { $_->guarantee } $p->guarantee_relationships;
178 my $guarantees_non_issues_charges;
179 foreach my $g ( @guarantees ) {
180 $guarantees_non_issues_charges += $g->account->non_issues_charges;
183 if ( $guarantees_non_issues_charges > $no_issues_charge_guarantees ) {
184 my %flaginfo;
185 $flaginfo{'message'} = sprintf 'patron guarantees owe %.02f', $guarantees_non_issues_charges;
186 $flaginfo{'amount'} = $guarantees_non_issues_charges;
187 $flaginfo{'noissues'} = 1 unless C4::Context->preference("allowfineoverride");
188 $flags{'CHARGES_GUARANTEES'} = \%flaginfo;
192 if ( $patroninformation->{'gonenoaddress'}
193 && $patroninformation->{'gonenoaddress'} == 1 )
195 my %flaginfo;
196 $flaginfo{'message'} = 'Borrower has no valid address.';
197 $flaginfo{'noissues'} = 1;
198 $flags{'GNA'} = \%flaginfo;
200 if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
201 my %flaginfo;
202 $flaginfo{'message'} = 'Borrower\'s card reported lost.';
203 $flaginfo{'noissues'} = 1;
204 $flags{'LOST'} = \%flaginfo;
206 if ( $patroninformation->{'debarred'} && check_date( split( /-/, $patroninformation->{'debarred'} ) ) ) {
207 if ( Date_to_Days(Date::Calc::Today) < Date_to_Days( split( /-/, $patroninformation->{'debarred'} ) ) ) {
208 my %flaginfo;
209 $flaginfo{'debarredcomment'} = $patroninformation->{'debarredcomment'};
210 $flaginfo{'message'} = $patroninformation->{'debarredcomment'};
211 $flaginfo{'noissues'} = 1;
212 $flaginfo{'dateend'} = $patroninformation->{'debarred'};
213 $flags{'DBARRED'} = \%flaginfo;
216 if ( $patroninformation->{'borrowernotes'}
217 && $patroninformation->{'borrowernotes'} )
219 my %flaginfo;
220 $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
221 $flags{'NOTES'} = \%flaginfo;
223 my ( $odues, $itemsoverdue ) = C4::Overdues::checkoverdues($patroninformation->{'borrowernumber'});
224 if ( $odues && $odues > 0 ) {
225 my %flaginfo;
226 $flaginfo{'message'} = "Yes";
227 $flaginfo{'itemlist'} = $itemsoverdue;
228 foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
229 @$itemsoverdue )
231 $flaginfo{'itemlisttext'} .=
232 "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n"; # newline is display layer
234 $flags{'ODUES'} = \%flaginfo;
237 my $waiting_holds = $patron->holds->search({ found => 'W' });
238 my $nowaiting = $waiting_holds->count;
239 if ( $nowaiting > 0 ) {
240 my %flaginfo;
241 $flaginfo{'message'} = "Reserved items available";
242 $flaginfo{'itemlist'} = $waiting_holds->unblessed;
243 $flags{'WAITING'} = \%flaginfo;
245 return ( \%flags );
248 =head2 GetAllIssues
250 $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
252 Looks up what the patron with the given borrowernumber has borrowed,
253 and sorts the results.
255 C<$sortkey> is the name of a field on which to sort the results. This
256 should be the name of a field in the C<issues>, C<biblio>,
257 C<biblioitems>, or C<items> table in the Koha database.
259 C<$limit> is the maximum number of results to return.
261 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
262 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
263 C<items> tables of the Koha database.
265 =cut
268 sub GetAllIssues {
269 my ( $borrowernumber, $order, $limit ) = @_;
271 return unless $borrowernumber;
272 $order = 'date_due desc' unless $order;
274 my $dbh = C4::Context->dbh;
275 my $query =
276 'SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
277 FROM issues
278 LEFT JOIN items on items.itemnumber=issues.itemnumber
279 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
280 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
281 WHERE borrowernumber=?
282 UNION ALL
283 SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
284 FROM old_issues
285 LEFT JOIN items on items.itemnumber=old_issues.itemnumber
286 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
287 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
288 WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL
289 order by ' . $order;
290 if ($limit) {
291 $query .= " limit $limit";
294 my $sth = $dbh->prepare($query);
295 $sth->execute( $borrowernumber, $borrowernumber );
296 return $sth->fetchall_arrayref( {} );
299 sub checkcardnumber {
300 my ( $cardnumber, $borrowernumber ) = @_;
302 # If cardnumber is null, we assume they're allowed.
303 return 0 unless defined $cardnumber;
305 my $dbh = C4::Context->dbh;
306 my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
307 $query .= " AND borrowernumber <> ?" if ($borrowernumber);
308 my $sth = $dbh->prepare($query);
309 $sth->execute(
310 $cardnumber,
311 ( $borrowernumber ? $borrowernumber : () )
314 return 1 if $sth->fetchrow_hashref;
316 my ( $min_length, $max_length ) = get_cardnumber_length();
317 return 2
318 if length $cardnumber > $max_length
319 or length $cardnumber < $min_length;
321 return 0;
324 =head2 get_cardnumber_length
326 my ($min, $max) = C4::Members::get_cardnumber_length()
328 Returns the minimum and maximum length for patron cardnumbers as
329 determined by the CardnumberLength system preference, the
330 BorrowerMandatoryField system preference, and the width of the
331 database column.
333 =cut
335 sub get_cardnumber_length {
336 my $borrower = Koha::Database->new->schema->resultset('Borrower');
337 my $field_size = $borrower->result_source->column_info('cardnumber')->{size};
338 my ( $min, $max ) = ( 0, $field_size ); # borrowers.cardnumber is a nullable varchar(20)
339 $min = 1 if C4::Context->preference('BorrowerMandatoryField') =~ /cardnumber/;
340 if ( my $cardnumber_length = C4::Context->preference('CardnumberLength') ) {
341 # Is integer and length match
342 if ( $cardnumber_length =~ m|^\d+$| ) {
343 $min = $max = $cardnumber_length
344 if $cardnumber_length >= $min
345 and $cardnumber_length <= $max;
347 # Else assuming it is a range
348 elsif ( $cardnumber_length =~ m|(\d*),(\d*)| ) {
349 $min = $1 if $1 and $min < $1;
350 $max = $2 if $2 and $max > $2;
354 $min = $max if $min > $max;
355 return ( $min, $max );
358 =head2 GetBorrowersToExpunge
360 $borrowers = &GetBorrowersToExpunge(
361 not_borrowed_since => $not_borrowed_since,
362 expired_before => $expired_before,
363 category_code => $category_code,
364 patron_list_id => $patron_list_id,
365 branchcode => $branchcode
368 This function get all borrowers based on the given criteria.
370 =cut
372 sub GetBorrowersToExpunge {
374 my $params = shift;
375 my $filterdate = $params->{'not_borrowed_since'};
376 my $filterexpiry = $params->{'expired_before'};
377 my $filterlastseen = $params->{'last_seen'};
378 my $filtercategory = $params->{'category_code'};
379 my $filterbranch = $params->{'branchcode'} ||
380 ((C4::Context->preference('IndependentBranches')
381 && C4::Context->userenv
382 && !C4::Context->IsSuperLibrarian()
383 && C4::Context->userenv->{branch})
384 ? C4::Context->userenv->{branch}
385 : "");
386 my $filterpatronlist = $params->{'patron_list_id'};
388 my $dbh = C4::Context->dbh;
389 my $query = q|
390 SELECT *
391 FROM (
392 SELECT borrowers.borrowernumber,
393 MAX(old_issues.timestamp) AS latestissue,
394 MAX(issues.timestamp) AS currentissue
395 FROM borrowers
396 JOIN categories USING (categorycode)
397 LEFT JOIN (
398 SELECT guarantor_id
399 FROM borrower_relationships
400 WHERE guarantor_id IS NOT NULL
401 AND guarantor_id <> 0
402 ) as tmp ON borrowers.borrowernumber=tmp.guarantor_id
403 LEFT JOIN old_issues USING (borrowernumber)
404 LEFT JOIN issues USING (borrowernumber)|;
405 if ( $filterpatronlist ){
406 $query .= q| LEFT JOIN patron_list_patrons USING (borrowernumber)|;
408 $query .= q| WHERE category_type <> 'S'
409 AND tmp.guarantor_id IS NULL
411 my @query_params;
412 if ( $filterbranch && $filterbranch ne "" ) {
413 $query.= " AND borrowers.branchcode = ? ";
414 push( @query_params, $filterbranch );
416 if ( $filterexpiry ) {
417 $query .= " AND dateexpiry < ? ";
418 push( @query_params, $filterexpiry );
420 if ( $filterlastseen ) {
421 $query .= ' AND lastseen < ? ';
422 push @query_params, $filterlastseen;
424 if ( $filtercategory ) {
425 $query .= " AND categorycode = ? ";
426 push( @query_params, $filtercategory );
428 if ( $filterpatronlist ){
429 $query.=" AND patron_list_id = ? ";
430 push( @query_params, $filterpatronlist );
432 $query .= " GROUP BY borrowers.borrowernumber";
433 $query .= q|
434 ) xxx WHERE currentissue IS NULL|;
435 if ( $filterdate ) {
436 $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
437 push @query_params,$filterdate;
440 warn $query if $debug;
442 my $sth = $dbh->prepare($query);
443 if (scalar(@query_params)>0){
444 $sth->execute(@query_params);
446 else {
447 $sth->execute;
450 my @results;
451 while ( my $data = $sth->fetchrow_hashref ) {
452 push @results, $data;
454 return \@results;
457 =head2 IssueSlip
459 IssueSlip($branchcode, $borrowernumber, $quickslip)
461 Returns letter hash ( see C4::Letters::GetPreparedLetter )
463 $quickslip is boolean, to indicate whether we want a quick slip
465 IssueSlip populates ISSUESLIP and ISSUEQSLIP, and will make the following expansions:
467 Both slips:
469 <<branches.*>>
470 <<borrowers.*>>
472 ISSUESLIP:
474 <checkedout>
475 <<biblio.*>>
476 <<items.*>>
477 <<biblioitems.*>>
478 <<issues.*>>
479 </checkedout>
481 <overdue>
482 <<biblio.*>>
483 <<items.*>>
484 <<biblioitems.*>>
485 <<issues.*>>
486 </overdue>
488 <news>
489 <<opac_news.*>>
490 </news>
492 ISSUEQSLIP:
494 <checkedout>
495 <<biblio.*>>
496 <<items.*>>
497 <<biblioitems.*>>
498 <<issues.*>>
499 </checkedout>
501 NOTE: Fields from tables issues, items, biblio and biblioitems are available
503 =cut
505 sub IssueSlip {
506 my ($branch, $borrowernumber, $quickslip) = @_;
508 # FIXME Check callers before removing this statement
509 #return unless $borrowernumber;
511 my $patron = Koha::Patrons->find( $borrowernumber );
512 return unless $patron;
514 my $pending_checkouts = $patron->pending_checkouts; # Should be $patron->checkouts->pending?
516 my ($letter_code, %repeat, %loops);
517 if ( $quickslip ) {
518 my $today_start = dt_from_string->set( hour => 0, minute => 0, second => 0 );
519 my $today_end = dt_from_string->set( hour => 23, minute => 59, second => 0 );
520 $today_start = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_start );
521 $today_end = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_end );
522 $letter_code = 'ISSUEQSLIP';
524 # issue date or lastreneweddate is today
525 my $todays_checkouts = $pending_checkouts->search(
527 -or => {
528 issuedate => {
529 '>=' => $today_start,
530 '<=' => $today_end,
532 lastreneweddate =>
533 { '>=' => $today_start, '<=' => $today_end, }
537 my @checkouts;
538 while ( my $c = $todays_checkouts->next ) {
539 my $all = $c->unblessed_all_relateds;
540 push @checkouts, {
541 biblio => $all,
542 items => $all,
543 biblioitems => $all,
544 issues => $all,
548 %repeat = (
549 checkedout => \@checkouts, # Historical syntax
551 %loops = (
552 issues => [ map { $_->{issues}{itemnumber} } @checkouts ], # TT syntax
555 else {
556 my $today = Koha::Database->new->schema->storage->datetime_parser->format_datetime( dt_from_string );
557 # Checkouts due in the future
558 my $checkouts = $pending_checkouts->search({ date_due => { '>' => $today } });
559 my @checkouts; my @overdues;
560 while ( my $c = $checkouts->next ) {
561 my $all = $c->unblessed_all_relateds;
562 push @checkouts, {
563 biblio => $all,
564 items => $all,
565 biblioitems => $all,
566 issues => $all,
570 # Checkouts due in the past are overdues
571 my $overdues = $pending_checkouts->search({ date_due => { '<=' => $today } });
572 while ( my $o = $overdues->next ) {
573 my $all = $o->unblessed_all_relateds;
574 push @overdues, {
575 biblio => $all,
576 items => $all,
577 biblioitems => $all,
578 issues => $all,
581 my $news = GetNewsToDisplay( "slip", $branch );
582 my @news = map {
583 $_->{'timestamp'} = $_->{'newdate'};
584 { opac_news => $_ }
585 } @$news;
586 $letter_code = 'ISSUESLIP';
587 %repeat = (
588 checkedout => \@checkouts,
589 overdue => \@overdues,
590 news => \@news,
592 %loops = (
593 issues => [ map { $_->{issues}{itemnumber} } @checkouts ],
594 overdues => [ map { $_->{issues}{itemnumber} } @overdues ],
595 opac_news => [ map { $_->{opac_news}{idnew} } @news ],
599 return C4::Letters::GetPreparedLetter (
600 module => 'circulation',
601 letter_code => $letter_code,
602 branchcode => $branch,
603 lang => $patron->lang,
604 tables => {
605 'branches' => $branch,
606 'borrowers' => $borrowernumber,
608 repeat => \%repeat,
609 loops => \%loops,
613 =head2 DeleteExpiredOpacRegistrations
615 Delete accounts that haven't been upgraded from the 'temporary' category
616 Returns the number of removed patrons
618 =cut
620 sub DeleteExpiredOpacRegistrations {
622 my $delay = C4::Context->preference('PatronSelfRegistrationExpireTemporaryAccountsDelay');
623 my $category_code = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
625 return 0 if not $category_code or not defined $delay or $delay eq q||;
626 my $date_enrolled = dt_from_string();
627 $date_enrolled->subtract( days => $delay );
629 my $registrations_to_del = Koha::Patrons->search({
630 dateenrolled => {'<=' => $date_enrolled->ymd},
631 categorycode => $category_code,
634 my $cnt=0;
635 while ( my $registration = $registrations_to_del->next() ) {
636 next if $registration->checkouts->count || $registration->account->balance;
637 $registration->delete;
638 $cnt++;
640 return $cnt;
643 =head2 DeleteUnverifiedOpacRegistrations
645 Delete all unverified self registrations in borrower_modifications,
646 older than the specified number of days.
648 =cut
650 sub DeleteUnverifiedOpacRegistrations {
651 my ( $days ) = @_;
652 my $dbh = C4::Context->dbh;
653 my $sql=qq|
654 DELETE FROM borrower_modifications
655 WHERE borrowernumber = 0 AND DATEDIFF( NOW(), timestamp ) > ?|;
656 my $cnt=$dbh->do($sql, undef, ($days) );
657 return $cnt eq '0E0'? 0: $cnt;
660 END { } # module clean-up code here (global destructor)
664 __END__
666 =head1 AUTHOR
668 Koha Team
670 =cut