Bug 23853: Typo in authorised_values.tt
[koha.git] / Koha / Patron.pm
blob6f88023b72ebfa25d8ce996424b128d245dad949
1 package Koha::Patron;
3 # Copyright ByWater Solutions 2014
4 # Copyright PTFS Europe 2016
6 # This file is part of Koha.
8 # Koha is free software; you can redistribute it and/or modify it under the
9 # terms of the GNU General Public License as published by the Free Software
10 # Foundation; either version 3 of the License, or (at your option) any later
11 # version.
13 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
14 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
15 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License along
18 # with Koha; if not, write to the Free Software Foundation, Inc.,
19 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
21 use Modern::Perl;
23 use Carp;
24 use List::MoreUtils qw( any uniq );
25 use JSON qw( to_json );
26 use Text::Unaccent qw( unac_string );
28 use C4::Context;
29 use C4::Log;
30 use Koha::Account;
31 use Koha::AuthUtils;
32 use Koha::Checkouts;
33 use Koha::Club::Enrollments;
34 use Koha::Database;
35 use Koha::DateUtils;
36 use Koha::Exceptions::Password;
37 use Koha::Holds;
38 use Koha::Old::Checkouts;
39 use Koha::Patron::Attributes;
40 use Koha::Patron::Categories;
41 use Koha::Patron::HouseboundProfile;
42 use Koha::Patron::HouseboundRole;
43 use Koha::Patron::Images;
44 use Koha::Patron::Relationships;
45 use Koha::Patrons;
46 use Koha::Subscription::Routinglists;
47 use Koha::Token;
48 use Koha::Virtualshelves;
50 use base qw(Koha::Object);
52 use constant ADMINISTRATIVE_LOCKOUT => -1;
54 our $RESULTSET_PATRON_ID_MAPPING = {
55 Accountline => 'borrowernumber',
56 Aqbasketuser => 'borrowernumber',
57 Aqbudget => 'budget_owner_id',
58 Aqbudgetborrower => 'borrowernumber',
59 ArticleRequest => 'borrowernumber',
60 BorrowerAttribute => 'borrowernumber',
61 BorrowerDebarment => 'borrowernumber',
62 BorrowerFile => 'borrowernumber',
63 BorrowerModification => 'borrowernumber',
64 ClubEnrollment => 'borrowernumber',
65 Issue => 'borrowernumber',
66 ItemsLastBorrower => 'borrowernumber',
67 Linktracker => 'borrowernumber',
68 Message => 'borrowernumber',
69 MessageQueue => 'borrowernumber',
70 OldIssue => 'borrowernumber',
71 OldReserve => 'borrowernumber',
72 Rating => 'borrowernumber',
73 Reserve => 'borrowernumber',
74 Review => 'borrowernumber',
75 SearchHistory => 'userid',
76 Statistic => 'borrowernumber',
77 Suggestion => 'suggestedby',
78 TagAll => 'borrowernumber',
79 Virtualshelfcontent => 'borrowernumber',
80 Virtualshelfshare => 'borrowernumber',
81 Virtualshelve => 'owner',
84 =head1 NAME
86 Koha::Patron - Koha Patron Object class
88 =head1 API
90 =head2 Class Methods
92 =head3 new
94 =cut
96 sub new {
97 my ( $class, $params ) = @_;
99 return $class->SUPER::new($params);
102 =head3 fixup_cardnumber
104 Autogenerate next cardnumber from highest value found in database
106 =cut
108 sub fixup_cardnumber {
109 my ( $self ) = @_;
110 my $max = Koha::Patrons->search({
111 cardnumber => {-regexp => '^-?[0-9]+$'}
112 }, {
113 select => \'CAST(cardnumber AS SIGNED)',
114 as => ['cast_cardnumber']
115 })->_resultset->get_column('cast_cardnumber')->max;
116 $self->cardnumber(($max || 0) +1);
119 =head3 trim_whitespace
121 trim whitespace from data which has some non-whitespace in it.
122 Could be moved to Koha::Object if need to be reused
124 =cut
126 sub trim_whitespaces {
127 my( $self ) = @_;
129 my $schema = Koha::Database->new->schema;
130 my @columns = $schema->source($self->_type)->columns;
132 for my $column( @columns ) {
133 my $value = $self->$column;
134 if ( defined $value ) {
135 $value =~ s/^\s*|\s*$//g;
136 $self->$column($value);
139 return $self;
142 =head3 plain_text_password
144 $patron->plain_text_password( $password );
146 stores a copy of the unencrypted password in the object
147 for use in code before encrypting for db
149 =cut
151 sub plain_text_password {
152 my ( $self, $password ) = @_;
153 if ( $password ) {
154 $self->{_plain_text_password} = $password;
155 return $self;
157 return $self->{_plain_text_password}
158 if $self->{_plain_text_password};
160 return;
163 =head3 store
165 Patron specific store method to cleanup record
166 and do other necessary things before saving
167 to db
169 =cut
171 sub store {
172 my ($self) = @_;
174 $self->_result->result_source->schema->txn_do(
175 sub {
176 if (
177 C4::Context->preference("autoMemberNum")
178 and ( not defined $self->cardnumber
179 or $self->cardnumber eq '' )
182 # Warning: The caller is responsible for locking the members table in write
183 # mode, to avoid database corruption.
184 # We are in a transaction but the table is not locked
185 $self->fixup_cardnumber;
188 unless( $self->category->in_storage ) {
189 Koha::Exceptions::Object::FKConstraint->throw(
190 broken_fk => 'categorycode',
191 value => $self->categorycode,
195 $self->trim_whitespaces;
197 # Set surname to uppercase if uppercasesurname is true
198 $self->surname( uc($self->surname) )
199 if C4::Context->preference("uppercasesurnames");
201 unless ( $self->in_storage ) { #AddMember
203 # Generate a valid userid/login if needed
204 $self->generate_userid
205 if not $self->userid or not $self->has_valid_userid;
207 # Add expiration date if it isn't already there
208 unless ( $self->dateexpiry ) {
209 $self->dateexpiry( $self->category->get_expiry_date );
212 # Add enrollment date if it isn't already there
213 unless ( $self->dateenrolled ) {
214 $self->dateenrolled(dt_from_string);
217 # Set the privacy depending on the patron's category
218 my $default_privacy = $self->category->default_privacy || q{};
219 $default_privacy =
220 $default_privacy eq 'default' ? 1
221 : $default_privacy eq 'never' ? 2
222 : $default_privacy eq 'forever' ? 0
223 : undef;
224 $self->privacy($default_privacy);
227 # Make a copy of the plain text password for later use
228 $self->plain_text_password( $self->password );
230 # Create a disabled account if no password provided
231 $self->password( $self->password
232 ? Koha::AuthUtils::hash_password( $self->password )
233 : '!' );
235 $self->borrowernumber(undef);
237 $self = $self->SUPER::store;
239 $self->add_enrolment_fee_if_needed(0);
241 logaction( "MEMBERS", "CREATE", $self->borrowernumber, "" )
242 if C4::Context->preference("BorrowersLog");
244 else { #ModMember
246 my $self_from_storage = $self->get_from_storage;
247 # FIXME We should not deal with that here, callers have to do this job
248 # Moved from ModMember to prevent regressions
249 unless ( $self->userid ) {
250 my $stored_userid = $self_from_storage->userid;
251 $self->userid($stored_userid);
254 # Password must be updated using $self->set_password
255 $self->password($self_from_storage->password);
257 if ( $self->category->categorycode ne
258 $self_from_storage->category->categorycode )
260 # Add enrolement fee on category change if required
261 $self->add_enrolment_fee_if_needed(1)
262 if C4::Context->preference('FeeOnChangePatronCategory');
264 # Clean up guarantors on category change if required
265 $self->guarantor_relationships->delete
266 if ( $self->category->category_type ne 'C'
267 && $self->category->category_type ne 'P' );
271 # Actionlogs
272 if ( C4::Context->preference("BorrowersLog") ) {
273 my $info;
274 my $from_storage = $self_from_storage->unblessed;
275 my $from_object = $self->unblessed;
276 my @skip_fields = (qw/lastseen updated_on/);
277 for my $key ( keys %{$from_storage} ) {
278 next if any { /$key/ } @skip_fields;
279 if (
281 !defined( $from_storage->{$key} )
282 && defined( $from_object->{$key} )
284 || ( defined( $from_storage->{$key} )
285 && !defined( $from_object->{$key} ) )
286 || (
287 defined( $from_storage->{$key} )
288 && defined( $from_object->{$key} )
289 && ( $from_storage->{$key} ne
290 $from_object->{$key} )
294 $info->{$key} = {
295 before => $from_storage->{$key},
296 after => $from_object->{$key}
301 if ( defined($info) ) {
302 logaction(
303 "MEMBERS",
304 "MODIFY",
305 $self->borrowernumber,
306 to_json(
307 $info,
308 { utf8 => 1, pretty => 1, canonical => 1 }
314 # Final store
315 $self = $self->SUPER::store;
319 return $self;
322 =head3 delete
324 $patron->delete
326 Delete patron's holds, lists and finally the patron.
328 Lists owned by the borrower are deleted, but entries from the borrower to
329 other lists are kept.
331 =cut
333 sub delete {
334 my ($self) = @_;
336 my $deleted;
337 $self->_result->result_source->schema->txn_do(
338 sub {
339 # Cancel Patron's holds
340 my $holds = $self->holds;
341 while( my $hold = $holds->next ){
342 $hold->cancel;
345 # Delete all lists and all shares of this borrower
346 # Consistent with the approach Koha uses on deleting individual lists
347 # Note that entries in virtualshelfcontents added by this borrower to
348 # lists of others will be handled by a table constraint: the borrower
349 # is set to NULL in those entries.
350 # NOTE:
351 # We could handle the above deletes via a constraint too.
352 # But a new BZ report 11889 has been opened to discuss another approach.
353 # Instead of deleting we could also disown lists (based on a pref).
354 # In that way we could save shared and public lists.
355 # The current table constraints support that idea now.
356 # This pref should then govern the results of other routines/methods such as
357 # Koha::Virtualshelf->new->delete too.
358 # FIXME Could be $patron->get_lists
359 $_->delete for Koha::Virtualshelves->search( { owner => $self->borrowernumber } );
361 $deleted = $self->SUPER::delete;
363 logaction( "MEMBERS", "DELETE", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog");
366 return $deleted;
370 =head3 category
372 my $patron_category = $patron->category
374 Return the patron category for this patron
376 =cut
378 sub category {
379 my ( $self ) = @_;
380 return Koha::Patron::Category->_new_from_dbic( $self->_result->categorycode );
383 =head3 image
385 =cut
387 sub image {
388 my ( $self ) = @_;
390 return scalar Koha::Patron::Images->find( $self->borrowernumber );
393 =head3 library
395 Returns a Koha::Library object representing the patron's home library.
397 =cut
399 sub library {
400 my ( $self ) = @_;
401 return Koha::Library->_new_from_dbic($self->_result->branchcode);
404 =head3 guarantor_relationships
406 Returns Koha::Patron::Relationships object for this patron's guarantors
408 Returns the set of relationships for the patrons that are guarantors for this patron.
410 This is returned instead of a Koha::Patron object because the guarantor
411 may not exist as a patron in Koha. If this is true, the guarantors name
412 exists in the Koha::Patron::Relationship object and will have no guarantor_id.
414 =cut
416 sub guarantor_relationships {
417 my ($self) = @_;
419 return Koha::Patron::Relationships->search( { guarantee_id => $self->id } );
422 =head3 guarantee_relationships
424 Returns Koha::Patron::Relationships object for this patron's guarantors
426 Returns the set of relationships for the patrons that are guarantees for this patron.
428 The method returns Koha::Patron::Relationship objects for the sake
429 of consistency with the guantors method.
430 A guarantee by definition must exist as a patron in Koha.
432 =cut
434 sub guarantee_relationships {
435 my ($self) = @_;
437 return Koha::Patron::Relationships->search(
438 { guarantor_id => $self->id },
440 prefetch => 'guarantee',
441 order_by => { -asc => [ 'guarantee.surname', 'guarantee.firstname' ] },
446 =head3 housebound_profile
448 Returns the HouseboundProfile associated with this patron.
450 =cut
452 sub housebound_profile {
453 my ( $self ) = @_;
454 my $profile = $self->_result->housebound_profile;
455 return Koha::Patron::HouseboundProfile->_new_from_dbic($profile)
456 if ( $profile );
457 return;
460 =head3 housebound_role
462 Returns the HouseboundRole associated with this patron.
464 =cut
466 sub housebound_role {
467 my ( $self ) = @_;
469 my $role = $self->_result->housebound_role;
470 return Koha::Patron::HouseboundRole->_new_from_dbic($role) if ( $role );
471 return;
474 =head3 siblings
476 Returns the siblings of this patron.
478 =cut
480 sub siblings {
481 my ($self) = @_;
483 my @guarantors = $self->guarantor_relationships()->guarantors();
485 return unless @guarantors;
487 my @siblings =
488 map { $_->guarantee_relationships()->guarantees() } @guarantors;
490 return unless @siblings;
492 my %seen;
493 @siblings =
494 grep { !$seen{ $_->id }++ && ( $_->id != $self->id ) } @siblings;
496 return wantarray ? @siblings : Koha::Patrons->search( { borrowernumber => { -in => [ map { $_->id } @siblings ] } } );
499 =head3 merge_with
501 my $patron = Koha::Patrons->find($id);
502 $patron->merge_with( \@patron_ids );
504 This subroutine merges a list of patrons into the patron record. This is accomplished by finding
505 all related patron ids for the patrons to be merged in other tables and changing the ids to be that
506 of the keeper patron.
508 =cut
510 sub merge_with {
511 my ( $self, $patron_ids ) = @_;
513 my @patron_ids = @{ $patron_ids };
515 # Ensure the keeper isn't in the list of patrons to merge
516 @patron_ids = grep { $_ ne $self->id } @patron_ids;
518 my $schema = Koha::Database->new()->schema();
520 my $results;
522 $self->_result->result_source->schema->txn_do( sub {
523 foreach my $patron_id (@patron_ids) {
524 my $patron = Koha::Patrons->find( $patron_id );
526 next unless $patron;
528 # Unbless for safety, the patron will end up being deleted
529 $results->{merged}->{$patron_id}->{patron} = $patron->unblessed;
531 while (my ($r, $field) = each(%$RESULTSET_PATRON_ID_MAPPING)) {
532 my $rs = $schema->resultset($r)->search({ $field => $patron_id });
533 $results->{merged}->{ $patron_id }->{updated}->{$r} = $rs->count();
534 $rs->update({ $field => $self->id });
537 $patron->move_to_deleted();
538 $patron->delete();
542 return $results;
547 =head3 wants_check_for_previous_checkout
549 $wants_check = $patron->wants_check_for_previous_checkout;
551 Return 1 if Koha needs to perform PrevIssue checking, else 0.
553 =cut
555 sub wants_check_for_previous_checkout {
556 my ( $self ) = @_;
557 my $syspref = C4::Context->preference("checkPrevCheckout");
559 # Simple cases
560 ## Hard syspref trumps all
561 return 1 if ($syspref eq 'hardyes');
562 return 0 if ($syspref eq 'hardno');
563 ## Now, patron pref trumps all
564 return 1 if ($self->checkprevcheckout eq 'yes');
565 return 0 if ($self->checkprevcheckout eq 'no');
567 # More complex: patron inherits -> determine category preference
568 my $checkPrevCheckoutByCat = $self->category->checkprevcheckout;
569 return 1 if ($checkPrevCheckoutByCat eq 'yes');
570 return 0 if ($checkPrevCheckoutByCat eq 'no');
572 # Finally: category preference is inherit, default to 0
573 if ($syspref eq 'softyes') {
574 return 1;
575 } else {
576 return 0;
580 =head3 do_check_for_previous_checkout
582 $do_check = $patron->do_check_for_previous_checkout($item);
584 Return 1 if the bib associated with $ITEM has previously been checked out to
585 $PATRON, 0 otherwise.
587 =cut
589 sub do_check_for_previous_checkout {
590 my ( $self, $item ) = @_;
592 my @item_nos;
593 my $biblio = Koha::Biblios->find( $item->{biblionumber} );
594 if ( $biblio->is_serial ) {
595 push @item_nos, $item->{itemnumber};
596 } else {
597 # Get all itemnumbers for given bibliographic record.
598 @item_nos = $biblio->items->get_column( 'itemnumber' );
601 # Create (old)issues search criteria
602 my $criteria = {
603 borrowernumber => $self->borrowernumber,
604 itemnumber => \@item_nos,
607 # Check current issues table
608 my $issues = Koha::Checkouts->search($criteria);
609 return 1 if $issues->count; # 0 || N
611 # Check old issues table
612 my $old_issues = Koha::Old::Checkouts->search($criteria);
613 return $old_issues->count; # 0 || N
616 =head3 is_debarred
618 my $debarment_expiration = $patron->is_debarred;
620 Returns the date a patron debarment will expire, or undef if the patron is not
621 debarred
623 =cut
625 sub is_debarred {
626 my ($self) = @_;
628 return unless $self->debarred;
629 return $self->debarred
630 if $self->debarred =~ '^9999'
631 or dt_from_string( $self->debarred ) > dt_from_string;
632 return;
635 =head3 is_expired
637 my $is_expired = $patron->is_expired;
639 Returns 1 if the patron is expired or 0;
641 =cut
643 sub is_expired {
644 my ($self) = @_;
645 return 0 unless $self->dateexpiry;
646 return 0 if $self->dateexpiry =~ '^9999';
647 return 1 if dt_from_string( $self->dateexpiry ) < dt_from_string->truncate( to => 'day' );
648 return 0;
651 =head3 is_going_to_expire
653 my $is_going_to_expire = $patron->is_going_to_expire;
655 Returns 1 if the patron is going to expired, depending on the NotifyBorrowerDeparture pref or 0
657 =cut
659 sub is_going_to_expire {
660 my ($self) = @_;
662 my $delay = C4::Context->preference('NotifyBorrowerDeparture') || 0;
664 return 0 unless $delay;
665 return 0 unless $self->dateexpiry;
666 return 0 if $self->dateexpiry =~ '^9999';
667 return 1 if dt_from_string( $self->dateexpiry, undef, 'floating' )->subtract( days => $delay ) < dt_from_string(undef, undef, 'floating')->truncate( to => 'day' );
668 return 0;
671 =head3 set_password
673 $patron->set_password({ password => $plain_text_password [, skip_validation => 1 ] });
675 Set the patron's password.
677 =head4 Exceptions
679 The passed string is validated against the current password enforcement policy.
680 Validation can be skipped by passing the I<skip_validation> parameter.
682 Exceptions are thrown if the password is not good enough.
684 =over 4
686 =item Koha::Exceptions::Password::TooShort
688 =item Koha::Exceptions::Password::WhitespaceCharacters
690 =item Koha::Exceptions::Password::TooWeak
692 =back
694 =cut
696 sub set_password {
697 my ( $self, $args ) = @_;
699 my $password = $args->{password};
701 unless ( $args->{skip_validation} ) {
702 my ( $is_valid, $error ) = Koha::AuthUtils::is_password_valid( $password );
704 if ( !$is_valid ) {
705 if ( $error eq 'too_short' ) {
706 my $min_length = C4::Context->preference('minPasswordLength');
707 $min_length = 3 if not $min_length or $min_length < 3;
709 my $password_length = length($password);
710 Koha::Exceptions::Password::TooShort->throw(
711 length => $password_length, min_length => $min_length );
713 elsif ( $error eq 'has_whitespaces' ) {
714 Koha::Exceptions::Password::WhitespaceCharacters->throw();
716 elsif ( $error eq 'too_weak' ) {
717 Koha::Exceptions::Password::TooWeak->throw();
722 my $digest = Koha::AuthUtils::hash_password($password);
723 $self->update(
724 { password => $digest,
725 login_attempts => 0,
729 logaction( "MEMBERS", "CHANGE PASS", $self->borrowernumber, "" )
730 if C4::Context->preference("BorrowersLog");
732 return $self;
736 =head3 renew_account
738 my $new_expiry_date = $patron->renew_account
740 Extending the subscription to the expiry date.
742 =cut
744 sub renew_account {
745 my ($self) = @_;
746 my $date;
747 if ( C4::Context->preference('BorrowerRenewalPeriodBase') eq 'combination' ) {
748 $date = ( dt_from_string gt dt_from_string( $self->dateexpiry ) ) ? dt_from_string : dt_from_string( $self->dateexpiry );
749 } else {
750 $date =
751 C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry'
752 ? dt_from_string( $self->dateexpiry )
753 : dt_from_string;
755 my $expiry_date = $self->category->get_expiry_date($date);
757 $self->dateexpiry($expiry_date);
758 $self->date_renewed( dt_from_string() );
759 $self->store();
761 $self->add_enrolment_fee_if_needed(1);
763 logaction( "MEMBERS", "RENEW", $self->borrowernumber, "Membership renewed" ) if C4::Context->preference("BorrowersLog");
764 return dt_from_string( $expiry_date )->truncate( to => 'day' );
767 =head3 has_overdues
769 my $has_overdues = $patron->has_overdues;
771 Returns the number of patron's overdues
773 =cut
775 sub has_overdues {
776 my ($self) = @_;
777 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
778 return $self->_result->issues->search({ date_due => { '<' => $dtf->format_datetime( dt_from_string() ) } })->count;
781 =head3 track_login
783 $patron->track_login;
784 $patron->track_login({ force => 1 });
786 Tracks a (successful) login attempt.
787 The preference TrackLastPatronActivity must be enabled. Or you
788 should pass the force parameter.
790 =cut
792 sub track_login {
793 my ( $self, $params ) = @_;
794 return if
795 !$params->{force} &&
796 !C4::Context->preference('TrackLastPatronActivity');
797 $self->lastseen( dt_from_string() )->store;
800 =head3 move_to_deleted
802 my $is_moved = $patron->move_to_deleted;
804 Move a patron to the deletedborrowers table.
805 This can be done before deleting a patron, to make sure the data are not completely deleted.
807 =cut
809 sub move_to_deleted {
810 my ($self) = @_;
811 my $patron_infos = $self->unblessed;
812 delete $patron_infos->{updated_on}; #This ensures the updated_on date in deletedborrowers will be set to the current timestamp
813 return Koha::Database->new->schema->resultset('Deletedborrower')->create($patron_infos);
816 =head3 article_requests
818 my @requests = $borrower->article_requests();
819 my $requests = $borrower->article_requests();
821 Returns either a list of ArticleRequests objects,
822 or an ArtitleRequests object, depending on the
823 calling context.
825 =cut
827 sub article_requests {
828 my ( $self ) = @_;
830 $self->{_article_requests} ||= Koha::ArticleRequests->search({ borrowernumber => $self->borrowernumber() });
832 return $self->{_article_requests};
835 =head3 article_requests_current
837 my @requests = $patron->article_requests_current
839 Returns the article requests associated with this patron that are incomplete
841 =cut
843 sub article_requests_current {
844 my ( $self ) = @_;
846 $self->{_article_requests_current} ||= Koha::ArticleRequests->search(
848 borrowernumber => $self->id(),
849 -or => [
850 { status => Koha::ArticleRequest::Status::Pending },
851 { status => Koha::ArticleRequest::Status::Processing }
856 return $self->{_article_requests_current};
859 =head3 article_requests_finished
861 my @requests = $biblio->article_requests_finished
863 Returns the article requests associated with this patron that are completed
865 =cut
867 sub article_requests_finished {
868 my ( $self, $borrower ) = @_;
870 $self->{_article_requests_finished} ||= Koha::ArticleRequests->search(
872 borrowernumber => $self->id(),
873 -or => [
874 { status => Koha::ArticleRequest::Status::Completed },
875 { status => Koha::ArticleRequest::Status::Canceled }
880 return $self->{_article_requests_finished};
883 =head3 add_enrolment_fee_if_needed
885 my $enrolment_fee = $patron->add_enrolment_fee_if_needed($renewal);
887 Add enrolment fee for a patron if needed.
889 $renewal - boolean denoting whether this is an account renewal or not
891 =cut
893 sub add_enrolment_fee_if_needed {
894 my ($self, $renewal) = @_;
895 my $enrolment_fee = $self->category->enrolmentfee;
896 if ( $enrolment_fee && $enrolment_fee > 0 ) {
897 my $type = $renewal ? 'ACCOUNT_RENEW' : 'ACCOUNT';
898 $self->account->add_debit(
900 amount => $enrolment_fee,
901 user_id => C4::Context->userenv ? C4::Context->userenv->{'number'} : undef,
902 interface => C4::Context->interface,
903 library_id => C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef,
904 type => $type
908 return $enrolment_fee || 0;
911 =head3 checkouts
913 my $checkouts = $patron->checkouts
915 =cut
917 sub checkouts {
918 my ($self) = @_;
919 my $checkouts = $self->_result->issues;
920 return Koha::Checkouts->_new_from_dbic( $checkouts );
923 =head3 pending_checkouts
925 my $pending_checkouts = $patron->pending_checkouts
927 This method will return the same as $self->checkouts, but with a prefetch on
928 items, biblio and biblioitems.
930 It has been introduced to replaced the C4::Members::GetPendingIssues subroutine
932 It should not be used directly, prefer to access fields you need instead of
933 retrieving all these fields in one go.
935 =cut
937 sub pending_checkouts {
938 my( $self ) = @_;
939 my $checkouts = $self->_result->issues->search(
942 order_by => [
943 { -desc => 'me.timestamp' },
944 { -desc => 'issuedate' },
945 { -desc => 'issue_id' }, # Sort by issue_id should be enough
947 prefetch => { item => { biblio => 'biblioitems' } },
950 return Koha::Checkouts->_new_from_dbic( $checkouts );
953 =head3 old_checkouts
955 my $old_checkouts = $patron->old_checkouts
957 =cut
959 sub old_checkouts {
960 my ($self) = @_;
961 my $old_checkouts = $self->_result->old_issues;
962 return Koha::Old::Checkouts->_new_from_dbic( $old_checkouts );
965 =head3 get_overdues
967 my $overdue_items = $patron->get_overdues
969 Return the overdue items
971 =cut
973 sub get_overdues {
974 my ($self) = @_;
975 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
976 return $self->checkouts->search(
978 'me.date_due' => { '<' => $dtf->format_datetime(dt_from_string) },
981 prefetch => { item => { biblio => 'biblioitems' } },
986 =head3 get_routing_lists
988 my @routinglists = $patron->get_routing_lists
990 Returns the routing lists a patron is subscribed to.
992 =cut
994 sub get_routing_lists {
995 my ($self) = @_;
996 my $routing_list_rs = $self->_result->subscriptionroutinglists;
997 return Koha::Subscription::Routinglists->_new_from_dbic($routing_list_rs);
1000 =head3 get_age
1002 my $age = $patron->get_age
1004 Return the age of the patron
1006 =cut
1008 sub get_age {
1009 my ($self) = @_;
1010 my $today_str = dt_from_string->strftime("%Y-%m-%d");
1011 return unless $self->dateofbirth;
1012 my $dob_str = dt_from_string( $self->dateofbirth )->strftime("%Y-%m-%d");
1014 my ( $dob_y, $dob_m, $dob_d ) = split /-/, $dob_str;
1015 my ( $today_y, $today_m, $today_d ) = split /-/, $today_str;
1017 my $age = $today_y - $dob_y;
1018 if ( $dob_m . $dob_d > $today_m . $today_d ) {
1019 $age--;
1022 return $age;
1025 =head3 is_valid_age
1027 my $is_valid = $patron->is_valid_age
1029 Return 1 if patron's age is between allowed limits, returns 0 if it's not.
1031 =cut
1033 sub is_valid_age {
1034 my ($self) = @_;
1035 my $age = $self->get_age;
1037 my $patroncategory = $self->category;
1038 my ($low,$high) = ($patroncategory->dateofbirthrequired, $patroncategory->upperagelimit);
1040 return (defined($age) && (($high && ($age > $high)) or ($age < $low))) ? 0 : 1;
1043 =head3 account
1045 my $account = $patron->account
1047 =cut
1049 sub account {
1050 my ($self) = @_;
1051 return Koha::Account->new( { patron_id => $self->borrowernumber } );
1054 =head3 holds
1056 my $holds = $patron->holds
1058 Return all the holds placed by this patron
1060 =cut
1062 sub holds {
1063 my ($self) = @_;
1064 my $holds_rs = $self->_result->reserves->search( {}, { order_by => 'reservedate' } );
1065 return Koha::Holds->_new_from_dbic($holds_rs);
1068 =head3 old_holds
1070 my $old_holds = $patron->old_holds
1072 Return all the historical holds for this patron
1074 =cut
1076 sub old_holds {
1077 my ($self) = @_;
1078 my $old_holds_rs = $self->_result->old_reserves->search( {}, { order_by => 'reservedate' } );
1079 return Koha::Old::Holds->_new_from_dbic($old_holds_rs);
1082 =head3 notice_email_address
1084 my $email = $patron->notice_email_address;
1086 Return the email address of patron used for notices.
1087 Returns the empty string if no email address.
1089 =cut
1091 sub notice_email_address{
1092 my ( $self ) = @_;
1094 my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
1095 # if syspref is set to 'first valid' (value == OFF), look up email address
1096 if ( $which_address eq 'OFF' ) {
1097 return $self->first_valid_email_address;
1100 return $self->$which_address || '';
1103 =head3 first_valid_email_address
1105 my $first_valid_email_address = $patron->first_valid_email_address
1107 Return the first valid email address for a patron.
1108 For now, the order is defined as email, emailpro, B_email.
1109 Returns the empty string if the borrower has no email addresses.
1111 =cut
1113 sub first_valid_email_address {
1114 my ($self) = @_;
1116 return $self->email() || $self->emailpro() || $self->B_email() || q{};
1119 =head3 get_club_enrollments
1121 =cut
1123 sub get_club_enrollments {
1124 my ( $self, $return_scalar ) = @_;
1126 my $e = Koha::Club::Enrollments->search( { borrowernumber => $self->borrowernumber(), date_canceled => undef } );
1128 return $e if $return_scalar;
1130 return wantarray ? $e->as_list : $e;
1133 =head3 get_enrollable_clubs
1135 =cut
1137 sub get_enrollable_clubs {
1138 my ( $self, $is_enrollable_from_opac, $return_scalar ) = @_;
1140 my $params;
1141 $params->{is_enrollable_from_opac} = $is_enrollable_from_opac
1142 if $is_enrollable_from_opac;
1143 $params->{is_email_required} = 0 unless $self->first_valid_email_address();
1145 $params->{borrower} = $self;
1147 my $e = Koha::Clubs->get_enrollable($params);
1149 return $e if $return_scalar;
1151 return wantarray ? $e->as_list : $e;
1154 =head3 account_locked
1156 my $is_locked = $patron->account_locked
1158 Return true if the patron has reached the maximum number of login attempts
1159 (see pref FailedLoginAttempts). If login_attempts is < 0, this is interpreted
1160 as an administrative lockout (independent of FailedLoginAttempts; see also
1161 Koha::Patron->lock).
1162 Otherwise return false.
1163 If the pref is not set (empty string, null or 0), the feature is considered as
1164 disabled.
1166 =cut
1168 sub account_locked {
1169 my ($self) = @_;
1170 my $FailedLoginAttempts = C4::Context->preference('FailedLoginAttempts');
1171 return 1 if $FailedLoginAttempts
1172 and $self->login_attempts
1173 and $self->login_attempts >= $FailedLoginAttempts;
1174 return 1 if ($self->login_attempts || 0) < 0; # administrative lockout
1175 return 0;
1178 =head3 can_see_patron_infos
1180 my $can_see = $patron->can_see_patron_infos( $patron );
1182 Return true if the patron (usually the logged in user) can see the patron's infos for a given patron
1184 =cut
1186 sub can_see_patron_infos {
1187 my ( $self, $patron ) = @_;
1188 return unless $patron;
1189 return $self->can_see_patrons_from( $patron->library->branchcode );
1192 =head3 can_see_patrons_from
1194 my $can_see = $patron->can_see_patrons_from( $branchcode );
1196 Return true if the patron (usually the logged in user) can see the patron's infos from a given library
1198 =cut
1200 sub can_see_patrons_from {
1201 my ( $self, $branchcode ) = @_;
1202 my $can = 0;
1203 if ( $self->branchcode eq $branchcode ) {
1204 $can = 1;
1205 } elsif ( $self->has_permission( { borrowers => 'view_borrower_infos_from_any_libraries' } ) ) {
1206 $can = 1;
1207 } elsif ( my $library_groups = $self->library->library_groups ) {
1208 while ( my $library_group = $library_groups->next ) {
1209 if ( $library_group->parent->has_child( $branchcode ) ) {
1210 $can = 1;
1211 last;
1215 return $can;
1218 =head3 libraries_where_can_see_patrons
1220 my $libraries = $patron-libraries_where_can_see_patrons;
1222 Return the list of branchcodes(!) of libraries the patron is allowed to see other patron's infos.
1223 The branchcodes are arbitrarily returned sorted.
1224 We are supposing here that the object is related to the logged in patron (use of C4::Context::only_my_library)
1226 An empty array means no restriction, the patron can see patron's infos from any libraries.
1228 =cut
1230 sub libraries_where_can_see_patrons {
1231 my ( $self ) = @_;
1232 my $userenv = C4::Context->userenv;
1234 return () unless $userenv; # For tests, but userenv should be defined in tests...
1236 my @restricted_branchcodes;
1237 if (C4::Context::only_my_library) {
1238 push @restricted_branchcodes, $self->branchcode;
1240 else {
1241 unless (
1242 $self->has_permission(
1243 { borrowers => 'view_borrower_infos_from_any_libraries' }
1247 my $library_groups = $self->library->library_groups({ ft_hide_patron_info => 1 });
1248 if ( $library_groups->count )
1250 while ( my $library_group = $library_groups->next ) {
1251 my $parent = $library_group->parent;
1252 if ( $parent->has_child( $self->branchcode ) ) {
1253 push @restricted_branchcodes, $parent->children->get_column('branchcode');
1258 @restricted_branchcodes = ( $self->branchcode ) unless @restricted_branchcodes;
1262 @restricted_branchcodes = grep { defined $_ } @restricted_branchcodes;
1263 @restricted_branchcodes = uniq(@restricted_branchcodes);
1264 @restricted_branchcodes = sort(@restricted_branchcodes);
1265 return @restricted_branchcodes;
1268 sub has_permission {
1269 my ( $self, $flagsrequired ) = @_;
1270 return unless $self->userid;
1271 # TODO code from haspermission needs to be moved here!
1272 return C4::Auth::haspermission( $self->userid, $flagsrequired );
1275 =head3 is_adult
1277 my $is_adult = $patron->is_adult
1279 Return true if the patron has a category with a type Adult (A) or Organization (I)
1281 =cut
1283 sub is_adult {
1284 my ( $self ) = @_;
1285 return $self->category->category_type =~ /^(A|I)$/ ? 1 : 0;
1288 =head3 is_child
1290 my $is_child = $patron->is_child
1292 Return true if the patron has a category with a type Child (C)
1294 =cut
1296 sub is_child {
1297 my( $self ) = @_;
1298 return $self->category->category_type eq 'C' ? 1 : 0;
1301 =head3 has_valid_userid
1303 my $patron = Koha::Patrons->find(42);
1304 $patron->userid( $new_userid );
1305 my $has_a_valid_userid = $patron->has_valid_userid
1307 my $patron = Koha::Patron->new( $params );
1308 my $has_a_valid_userid = $patron->has_valid_userid
1310 Return true if the current userid of this patron is valid/unique, otherwise false.
1312 Note that this should be done in $self->store instead and raise an exception if needed.
1314 =cut
1316 sub has_valid_userid {
1317 my ($self) = @_;
1319 return 0 unless $self->userid;
1321 return 0 if ( $self->userid eq C4::Context->config('user') ); # DB user
1323 my $already_exists = Koha::Patrons->search(
1325 userid => $self->userid,
1327 $self->in_storage
1328 ? ( borrowernumber => { '!=' => $self->borrowernumber } )
1329 : ()
1332 )->count;
1333 return $already_exists ? 0 : 1;
1336 =head3 generate_userid
1338 my $patron = Koha::Patron->new( $params );
1339 $patron->generate_userid
1341 Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
1343 Set a generated userid ($firstname.$surname if there is a $firstname, or $surname if there is no value in $firstname) plus offset (0 if the $userid is unique, or a higher numeric value if not unique).
1345 =cut
1347 sub generate_userid {
1348 my ($self) = @_;
1349 my $offset = 0;
1350 my $firstname = $self->firstname // q{};
1351 my $surname = $self->surname // q{};
1352 #The script will "do" the following code and increment the $offset until the generated userid is unique
1353 do {
1354 $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1355 $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1356 my $userid = lc(($firstname)? "$firstname.$surname" : $surname);
1357 $userid = unac_string('utf-8',$userid);
1358 $userid .= $offset unless $offset == 0;
1359 $self->userid( $userid );
1360 $offset++;
1361 } while (! $self->has_valid_userid );
1363 return $self;
1367 =head3 attributes
1369 my $attributes = $patron->attributes
1371 Return object of Koha::Patron::Attributes type with all attributes set for this patron
1373 =cut
1375 sub attributes {
1376 my ( $self ) = @_;
1377 return Koha::Patron::Attributes->search({
1378 borrowernumber => $self->borrowernumber,
1379 branchcode => $self->branchcode,
1383 =head3 lock
1385 Koha::Patrons->find($id)->lock({ expire => 1, remove => 1 });
1387 Lock and optionally expire a patron account.
1388 Remove holds and article requests if remove flag set.
1389 In order to distinguish from locking by entering a wrong password, let's
1390 call this an administrative lockout.
1392 =cut
1394 sub lock {
1395 my ( $self, $params ) = @_;
1396 $self->login_attempts( ADMINISTRATIVE_LOCKOUT );
1397 if( $params->{expire} ) {
1398 $self->dateexpiry( dt_from_string->subtract(days => 1) );
1400 $self->store;
1401 if( $params->{remove} ) {
1402 $self->holds->delete;
1403 $self->article_requests->delete;
1405 return $self;
1408 =head3 anonymize
1410 Koha::Patrons->find($id)->anonymize;
1412 Anonymize or clear borrower fields. Fields in BorrowerMandatoryField
1413 are randomized, other personal data is cleared too.
1414 Patrons with issues are skipped.
1416 =cut
1418 sub anonymize {
1419 my ( $self ) = @_;
1420 if( $self->_result->issues->count ) {
1421 warn "Exiting anonymize: patron ".$self->borrowernumber." still has issues";
1422 return;
1424 # Mandatory fields come from the corresponding pref, but email fields
1425 # are removed since scrambled email addresses only generate errors
1426 my $mandatory = { map { (lc $_, 1); } grep { !/email/ }
1427 split /\s*\|\s*/, C4::Context->preference('BorrowerMandatoryField') };
1428 $mandatory->{userid} = 1; # needed since sub store does not clear field
1429 my @columns = $self->_result->result_source->columns;
1430 @columns = grep { !/borrowernumber|branchcode|categorycode|^date|password|flags|updated_on|lastseen|lang|login_attempts|anonymized/ } @columns;
1431 push @columns, 'dateofbirth'; # add this date back in
1432 foreach my $col (@columns) {
1433 $self->_anonymize_column($col, $mandatory->{lc $col} );
1435 $self->anonymized(1)->store;
1438 sub _anonymize_column {
1439 my ( $self, $col, $mandatory ) = @_;
1440 my $col_info = $self->_result->result_source->column_info($col);
1441 my $type = $col_info->{data_type};
1442 my $nullable = $col_info->{is_nullable};
1443 my $val;
1444 if( $type =~ /char|text/ ) {
1445 $val = $mandatory
1446 ? Koha::Token->new->generate({ pattern => '\w{10}' })
1447 : $nullable
1448 ? undef
1449 : q{};
1450 } elsif( $type =~ /integer|int$|float|dec|double/ ) {
1451 $val = $nullable ? undef : 0;
1452 } elsif( $type =~ /date|time/ ) {
1453 $val = $nullable ? undef : dt_from_string;
1455 $self->$col($val);
1458 =head3 add_guarantor
1460 my @relationships = $patron->add_guarantor(
1462 borrowernumber => $borrowernumber,
1463 relationships => $relationship,
1467 Adds a new guarantor to a patron.
1469 =cut
1471 sub add_guarantor {
1472 my ( $self, $params ) = @_;
1474 my $guarantor_id = $params->{guarantor_id};
1475 my $relationship = $params->{relationship};
1477 return Koha::Patron::Relationship->new(
1479 guarantee_id => $self->id,
1480 guarantor_id => $guarantor_id,
1481 relationship => $relationship
1483 )->store();
1486 =head3 to_api
1488 my $json = $patron->to_api;
1490 Overloaded method that returns a JSON representation of the Koha::Patron object,
1491 suitable for API output.
1493 =cut
1495 sub to_api {
1496 my ( $self ) = @_;
1498 my $json_patron = $self->SUPER::to_api;
1500 $json_patron->{restricted} = ( $self->is_debarred )
1501 ? Mojo::JSON->true
1502 : Mojo::JSON->false;
1504 return $json_patron;
1507 =head3 to_api_mapping
1509 This method returns the mapping for representing a Koha::Patron object
1510 on the API.
1512 =cut
1514 sub to_api_mapping {
1515 return {
1516 borrowernotes => 'staff_notes',
1517 borrowernumber => 'patron_id',
1518 branchcode => 'library_id',
1519 categorycode => 'category_id',
1520 checkprevcheckout => 'check_previous_checkout',
1521 contactfirstname => undef, # Unused
1522 contactname => undef, # Unused
1523 contactnote => 'altaddress_notes',
1524 contacttitle => undef, # Unused
1525 dateenrolled => 'date_enrolled',
1526 dateexpiry => 'expiry_date',
1527 dateofbirth => 'date_of_birth',
1528 debarred => undef, # replaced by 'restricted'
1529 debarredcomment => undef, # calculated, API consumers will use /restrictions instead
1530 emailpro => 'secondary_email',
1531 flags => undef, # permissions manipulation handled in /permissions
1532 gonenoaddress => 'incorrect_address',
1533 guarantorid => 'guarantor_id',
1534 lastseen => 'last_seen',
1535 lost => 'patron_card_lost',
1536 opacnote => 'opac_notes',
1537 othernames => 'other_name',
1538 password => undef, # password manipulation handled in /password
1539 phonepro => 'secondary_phone',
1540 relationship => 'relationship_type',
1541 sex => 'gender',
1542 smsalertnumber => 'sms_number',
1543 sort1 => 'statistics_1',
1544 sort2 => 'statistics_2',
1545 streetnumber => 'street_number',
1546 streettype => 'street_type',
1547 zipcode => 'postal_code',
1548 B_address => 'altaddress_address',
1549 B_address2 => 'altaddress_address2',
1550 B_city => 'altaddress_city',
1551 B_country => 'altaddress_country',
1552 B_email => 'altaddress_email',
1553 B_phone => 'altaddress_phone',
1554 B_state => 'altaddress_state',
1555 B_streetnumber => 'altaddress_street_number',
1556 B_streettype => 'altaddress_street_type',
1557 B_zipcode => 'altaddress_postal_code',
1558 altcontactaddress1 => 'altcontact_address',
1559 altcontactaddress2 => 'altcontact_address2',
1560 altcontactaddress3 => 'altcontact_city',
1561 altcontactcountry => 'altcontact_country',
1562 altcontactfirstname => 'altcontact_firstname',
1563 altcontactphone => 'altcontact_phone',
1564 altcontactsurname => 'altcontact_surname',
1565 altcontactstate => 'altcontact_state',
1566 altcontactzipcode => 'altcontact_postal_code'
1570 =head2 Internal methods
1572 =head3 _type
1574 =cut
1576 sub _type {
1577 return 'Borrower';
1580 =head1 AUTHORS
1582 Kyle M Hall <kyle@bywatersolutions.com>
1583 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
1584 Martin Renvoize <martin.renvoize@ptfs-europe.com>
1586 =cut