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
9 # under the terms of the GNU General Public License as published by
10 # the Free Software Foundation; either version 3 of the License, or
11 # (at your option) any later version.
13 # Koha is distributed in the hope that it will be useful, but
14 # WITHOUT ANY WARRANTY; without even the implied warranty of
15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 # GNU General Public License for more details.
18 # You should have received a copy of the GNU General Public License
19 # along with Koha; if not, see <http://www.gnu.org/licenses>.
24 use List::MoreUtils qw( any uniq );
25 use JSON qw( to_json );
26 use Unicode::Normalize;
31 use Koha::ArticleRequests;
34 use Koha::Club::Enrollments;
37 use Koha::Exceptions::Password;
39 use Koha::Old::Checkouts;
40 use Koha::Patron::Attributes;
41 use Koha::Patron::Categories;
42 use Koha::Patron::HouseboundProfile;
43 use Koha::Patron::HouseboundRole;
44 use Koha::Patron::Images;
45 use Koha::Patron::Modifications;
46 use Koha::Patron::Relationships;
49 use Koha::Subscription::Routinglists;
51 use Koha::Virtualshelves;
53 use base qw(Koha::Object);
55 use constant ADMINISTRATIVE_LOCKOUT => -1;
57 our $RESULTSET_PATRON_ID_MAPPING = {
58 Accountline => 'borrowernumber',
59 Aqbasketuser => 'borrowernumber',
60 Aqbudget => 'budget_owner_id',
61 Aqbudgetborrower => 'borrowernumber',
62 ArticleRequest => 'borrowernumber',
63 BorrowerAttribute => 'borrowernumber',
64 BorrowerDebarment => 'borrowernumber',
65 BorrowerFile => 'borrowernumber',
66 BorrowerModification => 'borrowernumber',
67 ClubEnrollment => 'borrowernumber',
68 Issue => 'borrowernumber',
69 ItemsLastBorrower => 'borrowernumber',
70 Linktracker => 'borrowernumber',
71 Message => 'borrowernumber',
72 MessageQueue => 'borrowernumber',
73 OldIssue => 'borrowernumber',
74 OldReserve => 'borrowernumber',
75 Rating => 'borrowernumber',
76 Reserve => 'borrowernumber',
77 Review => 'borrowernumber',
78 SearchHistory => 'userid',
79 Statistic => 'borrowernumber',
80 Suggestion => 'suggestedby',
81 TagAll => 'borrowernumber',
82 Virtualshelfcontent => 'borrowernumber',
83 Virtualshelfshare => 'borrowernumber',
84 Virtualshelve => 'owner',
89 Koha::Patron - Koha Patron Object class
100 my ( $class, $params ) = @_;
102 return $class->SUPER::new($params);
105 =head3 fixup_cardnumber
107 Autogenerate next cardnumber from highest value found in database
111 sub fixup_cardnumber {
113 my $max = Koha::Patrons->search({
114 cardnumber => {-regexp => '^-?[0-9]+$'}
116 select => \'CAST(cardnumber AS SIGNED)',
117 as => ['cast_cardnumber']
118 })->_resultset->get_column('cast_cardnumber')->max;
119 $self->cardnumber(($max || 0) +1);
122 =head3 trim_whitespace
124 trim whitespace from data which has some non-whitespace in it.
125 Could be moved to Koha::Object if need to be reused
129 sub trim_whitespaces {
132 my $schema = Koha::Database->new->schema;
133 my @columns = $schema->source($self->_type)->columns;
135 for my $column( @columns ) {
136 my $value = $self->$column;
137 if ( defined $value ) {
138 $value =~ s/^\s*|\s*$//g;
139 $self->$column($value);
145 =head3 plain_text_password
147 $patron->plain_text_password( $password );
149 stores a copy of the unencrypted password in the object
150 for use in code before encrypting for db
154 sub plain_text_password {
155 my ( $self, $password ) = @_;
157 $self->{_plain_text_password} = $password;
160 return $self->{_plain_text_password}
161 if $self->{_plain_text_password};
168 Patron specific store method to cleanup record
169 and do other necessary things before saving
177 $self->_result->result_source->schema->txn_do(
180 C4::Context->preference("autoMemberNum")
181 and ( not defined $self->cardnumber
182 or $self->cardnumber eq '' )
185 # Warning: The caller is responsible for locking the members table in write
186 # mode, to avoid database corruption.
187 # We are in a transaction but the table is not locked
188 $self->fixup_cardnumber;
191 unless( $self->category->in_storage ) {
192 Koha::Exceptions::Object::FKConstraint->throw(
193 broken_fk => 'categorycode',
194 value => $self->categorycode,
198 $self->trim_whitespaces;
200 # Set surname to uppercase if uppercasesurname is true
201 $self->surname( uc($self->surname) )
202 if C4::Context->preference("uppercasesurnames");
204 $self->relationship(undef) # We do not want to store an empty string in this field
205 if defined $self->relationship
206 and $self->relationship eq "";
208 unless ( $self->in_storage ) { #AddMember
210 # Generate a valid userid/login if needed
211 $self->generate_userid
212 if not $self->userid or not $self->has_valid_userid;
214 # Add expiration date if it isn't already there
215 unless ( $self->dateexpiry ) {
216 $self->dateexpiry( $self->category->get_expiry_date );
219 # Add enrollment date if it isn't already there
220 unless ( $self->dateenrolled ) {
221 $self->dateenrolled(dt_from_string);
224 # Set the privacy depending on the patron's category
225 my $default_privacy = $self->category->default_privacy || q{};
227 $default_privacy eq 'default' ? 1
228 : $default_privacy eq 'never' ? 2
229 : $default_privacy eq 'forever' ? 0
231 $self->privacy($default_privacy);
233 # Call any check_password plugins if password is passed
234 if ( C4::Context->config("enable_plugins") && $self->password ) {
235 my @plugins = Koha::Plugins->new()->GetPlugins({
236 method => 'check_password',
238 foreach my $plugin ( @plugins ) {
239 # This plugin hook will also be used by a plugin for the Norwegian national
240 # patron database. This is why we need to pass both the password and the
241 # borrowernumber to the plugin.
242 my $ret = $plugin->check_password(
244 password => $self->password,
245 borrowernumber => $self->borrowernumber
248 if ( $ret->{'error'} == 1 ) {
249 Koha::Exceptions::Password::Plugin->throw();
254 # Make a copy of the plain text password for later use
255 $self->plain_text_password( $self->password );
257 # Create a disabled account if no password provided
258 $self->password( $self->password
259 ? Koha::AuthUtils::hash_password( $self->password )
262 $self->borrowernumber(undef);
264 $self = $self->SUPER::store;
266 $self->add_enrolment_fee_if_needed(0);
268 logaction( "MEMBERS", "CREATE", $self->borrowernumber, "" )
269 if C4::Context->preference("BorrowersLog");
273 my $self_from_storage = $self->get_from_storage;
274 # FIXME We should not deal with that here, callers have to do this job
275 # Moved from ModMember to prevent regressions
276 unless ( $self->userid ) {
277 my $stored_userid = $self_from_storage->userid;
278 $self->userid($stored_userid);
281 # Password must be updated using $self->set_password
282 $self->password($self_from_storage->password);
284 if ( $self->category->categorycode ne
285 $self_from_storage->category->categorycode )
287 # Add enrolement fee on category change if required
288 $self->add_enrolment_fee_if_needed(1)
289 if C4::Context->preference('FeeOnChangePatronCategory');
291 # Clean up guarantors on category change if required
292 $self->guarantor_relationships->delete
293 if ( $self->category->category_type ne 'C'
294 && $self->category->category_type ne 'P' );
299 if ( C4::Context->preference("BorrowersLog") ) {
301 my $from_storage = $self_from_storage->unblessed;
302 my $from_object = $self->unblessed;
303 my @skip_fields = (qw/lastseen updated_on/);
304 for my $key ( keys %{$from_storage} ) {
305 next if any { /$key/ } @skip_fields;
308 !defined( $from_storage->{$key} )
309 && defined( $from_object->{$key} )
311 || ( defined( $from_storage->{$key} )
312 && !defined( $from_object->{$key} ) )
314 defined( $from_storage->{$key} )
315 && defined( $from_object->{$key} )
316 && ( $from_storage->{$key} ne
317 $from_object->{$key} )
322 before => $from_storage->{$key},
323 after => $from_object->{$key}
328 if ( defined($info) ) {
332 $self->borrowernumber,
335 { utf8 => 1, pretty => 1, canonical => 1 }
342 $self = $self->SUPER::store;
353 Delete patron's holds, lists and finally the patron.
355 Lists owned by the borrower are deleted, but entries from the borrower to
356 other lists are kept.
363 $self->_result->result_source->schema->txn_do(
365 # Cancel Patron's holds
366 my $holds = $self->holds;
367 while( my $hold = $holds->next ){
371 # Delete all lists and all shares of this borrower
372 # Consistent with the approach Koha uses on deleting individual lists
373 # Note that entries in virtualshelfcontents added by this borrower to
374 # lists of others will be handled by a table constraint: the borrower
375 # is set to NULL in those entries.
377 # We could handle the above deletes via a constraint too.
378 # But a new BZ report 11889 has been opened to discuss another approach.
379 # Instead of deleting we could also disown lists (based on a pref).
380 # In that way we could save shared and public lists.
381 # The current table constraints support that idea now.
382 # This pref should then govern the results of other routines/methods such as
383 # Koha::Virtualshelf->new->delete too.
384 # FIXME Could be $patron->get_lists
385 $_->delete for Koha::Virtualshelves->search( { owner => $self->borrowernumber } );
387 # We cannot have a FK on borrower_modifications.borrowernumber, the table is also used
389 $_->delete for Koha::Patron::Modifications->search( { borrowernumber => $self->borrowernumber } );
391 $self->SUPER::delete;
393 logaction( "MEMBERS", "DELETE", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog");
402 my $patron_category = $patron->category
404 Return the patron category for this patron
410 return Koha::Patron::Category->_new_from_dbic( $self->_result->categorycode );
420 return Koha::Patron::Images->find( $self->borrowernumber );
425 Returns a Koha::Library object representing the patron's home library.
431 return Koha::Library->_new_from_dbic($self->_result->branchcode);
436 Returns a Koha::SMS::Provider object representing the patron's SMS provider.
442 my $sms_provider_rs = $self->_result->sms_provider;
443 return unless $sms_provider_rs;
444 return Koha::SMS::Provider->_new_from_dbic($sms_provider_rs);
447 =head3 guarantor_relationships
449 Returns Koha::Patron::Relationships object for this patron's guarantors
451 Returns the set of relationships for the patrons that are guarantors for this patron.
453 This is returned instead of a Koha::Patron object because the guarantor
454 may not exist as a patron in Koha. If this is true, the guarantors name
455 exists in the Koha::Patron::Relationship object and will have no guarantor_id.
459 sub guarantor_relationships {
462 return Koha::Patron::Relationships->search( { guarantee_id => $self->id } );
465 =head3 guarantee_relationships
467 Returns Koha::Patron::Relationships object for this patron's guarantors
469 Returns the set of relationships for the patrons that are guarantees for this patron.
471 The method returns Koha::Patron::Relationship objects for the sake
472 of consistency with the guantors method.
473 A guarantee by definition must exist as a patron in Koha.
477 sub guarantee_relationships {
480 return Koha::Patron::Relationships->search(
481 { guarantor_id => $self->id },
483 prefetch => 'guarantee',
484 order_by => { -asc => [ 'guarantee.surname', 'guarantee.firstname' ] },
489 =head3 housebound_profile
491 Returns the HouseboundProfile associated with this patron.
495 sub housebound_profile {
497 my $profile = $self->_result->housebound_profile;
498 return Koha::Patron::HouseboundProfile->_new_from_dbic($profile)
503 =head3 housebound_role
505 Returns the HouseboundRole associated with this patron.
509 sub housebound_role {
512 my $role = $self->_result->housebound_role;
513 return Koha::Patron::HouseboundRole->_new_from_dbic($role) if ( $role );
519 Returns the siblings of this patron.
526 my @guarantors = $self->guarantor_relationships()->guarantors();
528 return unless @guarantors;
531 map { $_->guarantee_relationships()->guarantees() } @guarantors;
533 return unless @siblings;
537 grep { !$seen{ $_->id }++ && ( $_->id != $self->id ) } @siblings;
539 return wantarray ? @siblings : Koha::Patrons->search( { borrowernumber => { -in => [ map { $_->id } @siblings ] } } );
544 my $patron = Koha::Patrons->find($id);
545 $patron->merge_with( \@patron_ids );
547 This subroutine merges a list of patrons into the patron record. This is accomplished by finding
548 all related patron ids for the patrons to be merged in other tables and changing the ids to be that
549 of the keeper patron.
554 my ( $self, $patron_ids ) = @_;
556 my @patron_ids = @{ $patron_ids };
558 # Ensure the keeper isn't in the list of patrons to merge
559 @patron_ids = grep { $_ ne $self->id } @patron_ids;
561 my $schema = Koha::Database->new()->schema();
565 $self->_result->result_source->schema->txn_do( sub {
566 foreach my $patron_id (@patron_ids) {
567 my $patron = Koha::Patrons->find( $patron_id );
571 # Unbless for safety, the patron will end up being deleted
572 $results->{merged}->{$patron_id}->{patron} = $patron->unblessed;
574 while (my ($r, $field) = each(%$RESULTSET_PATRON_ID_MAPPING)) {
575 my $rs = $schema->resultset($r)->search({ $field => $patron_id });
576 $results->{merged}->{ $patron_id }->{updated}->{$r} = $rs->count();
577 $rs->update({ $field => $self->id });
580 $patron->move_to_deleted();
590 =head3 wants_check_for_previous_checkout
592 $wants_check = $patron->wants_check_for_previous_checkout;
594 Return 1 if Koha needs to perform PrevIssue checking, else 0.
598 sub wants_check_for_previous_checkout {
600 my $syspref = C4::Context->preference("checkPrevCheckout");
603 ## Hard syspref trumps all
604 return 1 if ($syspref eq 'hardyes');
605 return 0 if ($syspref eq 'hardno');
606 ## Now, patron pref trumps all
607 return 1 if ($self->checkprevcheckout eq 'yes');
608 return 0 if ($self->checkprevcheckout eq 'no');
610 # More complex: patron inherits -> determine category preference
611 my $checkPrevCheckoutByCat = $self->category->checkprevcheckout;
612 return 1 if ($checkPrevCheckoutByCat eq 'yes');
613 return 0 if ($checkPrevCheckoutByCat eq 'no');
615 # Finally: category preference is inherit, default to 0
616 if ($syspref eq 'softyes') {
623 =head3 do_check_for_previous_checkout
625 $do_check = $patron->do_check_for_previous_checkout($item);
627 Return 1 if the bib associated with $ITEM has previously been checked out to
628 $PATRON, 0 otherwise.
632 sub do_check_for_previous_checkout {
633 my ( $self, $item ) = @_;
636 my $biblio = Koha::Biblios->find( $item->{biblionumber} );
637 if ( $biblio->is_serial ) {
638 push @item_nos, $item->{itemnumber};
640 # Get all itemnumbers for given bibliographic record.
641 @item_nos = $biblio->items->get_column( 'itemnumber' );
644 # Create (old)issues search criteria
646 borrowernumber => $self->borrowernumber,
647 itemnumber => \@item_nos,
650 # Check current issues table
651 my $issues = Koha::Checkouts->search($criteria);
652 return 1 if $issues->count; # 0 || N
654 # Check old issues table
655 my $old_issues = Koha::Old::Checkouts->search($criteria);
656 return $old_issues->count; # 0 || N
661 my $debarment_expiration = $patron->is_debarred;
663 Returns the date a patron debarment will expire, or undef if the patron is not
671 return unless $self->debarred;
672 return $self->debarred
673 if $self->debarred =~ '^9999'
674 or dt_from_string( $self->debarred ) > dt_from_string;
680 my $is_expired = $patron->is_expired;
682 Returns 1 if the patron is expired or 0;
688 return 0 unless $self->dateexpiry;
689 return 0 if $self->dateexpiry =~ '^9999';
690 return 1 if dt_from_string( $self->dateexpiry ) < dt_from_string->truncate( to => 'day' );
694 =head3 is_going_to_expire
696 my $is_going_to_expire = $patron->is_going_to_expire;
698 Returns 1 if the patron is going to expired, depending on the NotifyBorrowerDeparture pref or 0
702 sub is_going_to_expire {
705 my $delay = C4::Context->preference('NotifyBorrowerDeparture') || 0;
707 return 0 unless $delay;
708 return 0 unless $self->dateexpiry;
709 return 0 if $self->dateexpiry =~ '^9999';
710 return 1 if dt_from_string( $self->dateexpiry, undef, 'floating' )->subtract( days => $delay ) < dt_from_string(undef, undef, 'floating')->truncate( to => 'day' );
716 $patron->set_password({ password => $plain_text_password [, skip_validation => 1 ] });
718 Set the patron's password.
722 The passed string is validated against the current password enforcement policy.
723 Validation can be skipped by passing the I<skip_validation> parameter.
725 Exceptions are thrown if the password is not good enough.
729 =item Koha::Exceptions::Password::TooShort
731 =item Koha::Exceptions::Password::WhitespaceCharacters
733 =item Koha::Exceptions::Password::TooWeak
735 =item Koha::Exceptions::Password::Plugin (if a "check password" plugin is enabled)
742 my ( $self, $args ) = @_;
744 my $password = $args->{password};
746 unless ( $args->{skip_validation} ) {
747 my ( $is_valid, $error ) = Koha::AuthUtils::is_password_valid( $password );
750 if ( $error eq 'too_short' ) {
751 my $min_length = C4::Context->preference('minPasswordLength');
752 $min_length = 3 if not $min_length or $min_length < 3;
754 my $password_length = length($password);
755 Koha::Exceptions::Password::TooShort->throw(
756 length => $password_length, min_length => $min_length );
758 elsif ( $error eq 'has_whitespaces' ) {
759 Koha::Exceptions::Password::WhitespaceCharacters->throw();
761 elsif ( $error eq 'too_weak' ) {
762 Koha::Exceptions::Password::TooWeak->throw();
767 if ( C4::Context->config("enable_plugins") ) {
768 # Call any check_password plugins
769 my @plugins = Koha::Plugins->new()->GetPlugins({
770 method => 'check_password',
772 foreach my $plugin ( @plugins ) {
773 # This plugin hook will also be used by a plugin for the Norwegian national
774 # patron database. This is why we need to pass both the password and the
775 # borrowernumber to the plugin.
776 my $ret = $plugin->check_password(
778 password => $password,
779 borrowernumber => $self->borrowernumber
782 # This plugin hook will also be used by a plugin for the Norwegian national
783 # patron database. This is why we need to call the actual plugins and then
784 # check skip_validation afterwards.
785 if ( $ret->{'error'} == 1 && !$args->{skip_validation} ) {
786 Koha::Exceptions::Password::Plugin->throw();
791 my $digest = Koha::AuthUtils::hash_password($password);
793 # We do not want to call $self->store and retrieve password from DB
794 $self->password($digest);
795 $self->login_attempts(0);
798 logaction( "MEMBERS", "CHANGE PASS", $self->borrowernumber, "" )
799 if C4::Context->preference("BorrowersLog");
807 my $new_expiry_date = $patron->renew_account
809 Extending the subscription to the expiry date.
816 if ( C4::Context->preference('BorrowerRenewalPeriodBase') eq 'combination' ) {
817 $date = ( dt_from_string gt dt_from_string( $self->dateexpiry ) ) ? dt_from_string : dt_from_string( $self->dateexpiry );
820 C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry'
821 ? dt_from_string( $self->dateexpiry )
824 my $expiry_date = $self->category->get_expiry_date($date);
826 $self->dateexpiry($expiry_date);
827 $self->date_renewed( dt_from_string() );
830 $self->add_enrolment_fee_if_needed(1);
832 logaction( "MEMBERS", "RENEW", $self->borrowernumber, "Membership renewed" ) if C4::Context->preference("BorrowersLog");
833 return dt_from_string( $expiry_date )->truncate( to => 'day' );
838 my $has_overdues = $patron->has_overdues;
840 Returns the number of patron's overdues
846 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
847 return $self->_result->issues->search({ date_due => { '<' => $dtf->format_datetime( dt_from_string() ) } })->count;
852 $patron->track_login;
853 $patron->track_login({ force => 1 });
855 Tracks a (successful) login attempt.
856 The preference TrackLastPatronActivity must be enabled. Or you
857 should pass the force parameter.
862 my ( $self, $params ) = @_;
865 !C4::Context->preference('TrackLastPatronActivity');
866 $self->lastseen( dt_from_string() )->store;
869 =head3 move_to_deleted
871 my $is_moved = $patron->move_to_deleted;
873 Move a patron to the deletedborrowers table.
874 This can be done before deleting a patron, to make sure the data are not completely deleted.
878 sub move_to_deleted {
880 my $patron_infos = $self->unblessed;
881 delete $patron_infos->{updated_on}; #This ensures the updated_on date in deletedborrowers will be set to the current timestamp
882 return Koha::Database->new->schema->resultset('Deletedborrower')->create($patron_infos);
885 =head3 article_requests
887 my @requests = $borrower->article_requests();
888 my $requests = $borrower->article_requests();
890 Returns either a list of ArticleRequests objects,
891 or an ArtitleRequests object, depending on the
896 sub article_requests {
899 $self->{_article_requests} ||= Koha::ArticleRequests->search({ borrowernumber => $self->borrowernumber() });
901 return $self->{_article_requests};
904 =head3 article_requests_current
906 my @requests = $patron->article_requests_current
908 Returns the article requests associated with this patron that are incomplete
912 sub article_requests_current {
915 $self->{_article_requests_current} ||= Koha::ArticleRequests->search(
917 borrowernumber => $self->id(),
919 { status => Koha::ArticleRequest::Status::Pending },
920 { status => Koha::ArticleRequest::Status::Processing }
925 return $self->{_article_requests_current};
928 =head3 article_requests_finished
930 my @requests = $biblio->article_requests_finished
932 Returns the article requests associated with this patron that are completed
936 sub article_requests_finished {
937 my ( $self, $borrower ) = @_;
939 $self->{_article_requests_finished} ||= Koha::ArticleRequests->search(
941 borrowernumber => $self->id(),
943 { status => Koha::ArticleRequest::Status::Completed },
944 { status => Koha::ArticleRequest::Status::Canceled }
949 return $self->{_article_requests_finished};
952 =head3 add_enrolment_fee_if_needed
954 my $enrolment_fee = $patron->add_enrolment_fee_if_needed($renewal);
956 Add enrolment fee for a patron if needed.
958 $renewal - boolean denoting whether this is an account renewal or not
962 sub add_enrolment_fee_if_needed {
963 my ($self, $renewal) = @_;
964 my $enrolment_fee = $self->category->enrolmentfee;
965 if ( $enrolment_fee && $enrolment_fee > 0 ) {
966 my $type = $renewal ? 'ACCOUNT_RENEW' : 'ACCOUNT';
967 $self->account->add_debit(
969 amount => $enrolment_fee,
970 user_id => C4::Context->userenv ? C4::Context->userenv->{'number'} : undef,
971 interface => C4::Context->interface,
972 library_id => C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef,
977 return $enrolment_fee || 0;
982 my $checkouts = $patron->checkouts
988 my $checkouts = $self->_result->issues;
989 return Koha::Checkouts->_new_from_dbic( $checkouts );
992 =head3 pending_checkouts
994 my $pending_checkouts = $patron->pending_checkouts
996 This method will return the same as $self->checkouts, but with a prefetch on
997 items, biblio and biblioitems.
999 It has been introduced to replaced the C4::Members::GetPendingIssues subroutine
1001 It should not be used directly, prefer to access fields you need instead of
1002 retrieving all these fields in one go.
1006 sub pending_checkouts {
1008 my $checkouts = $self->_result->issues->search(
1012 { -desc => 'me.timestamp' },
1013 { -desc => 'issuedate' },
1014 { -desc => 'issue_id' }, # Sort by issue_id should be enough
1016 prefetch => { item => { biblio => 'biblioitems' } },
1019 return Koha::Checkouts->_new_from_dbic( $checkouts );
1022 =head3 old_checkouts
1024 my $old_checkouts = $patron->old_checkouts
1030 my $old_checkouts = $self->_result->old_issues;
1031 return Koha::Old::Checkouts->_new_from_dbic( $old_checkouts );
1036 my $overdue_items = $patron->get_overdues
1038 Return the overdue items
1044 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
1045 return $self->checkouts->search(
1047 'me.date_due' => { '<' => $dtf->format_datetime(dt_from_string) },
1050 prefetch => { item => { biblio => 'biblioitems' } },
1055 =head3 get_routing_lists
1057 my @routinglists = $patron->get_routing_lists
1059 Returns the routing lists a patron is subscribed to.
1063 sub get_routing_lists {
1065 my $routing_list_rs = $self->_result->subscriptionroutinglists;
1066 return Koha::Subscription::Routinglists->_new_from_dbic($routing_list_rs);
1071 my $age = $patron->get_age
1073 Return the age of the patron
1079 my $today_str = dt_from_string->strftime("%Y-%m-%d");
1080 return unless $self->dateofbirth;
1081 my $dob_str = dt_from_string( $self->dateofbirth )->strftime("%Y-%m-%d");
1083 my ( $dob_y, $dob_m, $dob_d ) = split /-/, $dob_str;
1084 my ( $today_y, $today_m, $today_d ) = split /-/, $today_str;
1086 my $age = $today_y - $dob_y;
1087 if ( $dob_m . $dob_d > $today_m . $today_d ) {
1096 my $is_valid = $patron->is_valid_age
1098 Return 1 if patron's age is between allowed limits, returns 0 if it's not.
1104 my $age = $self->get_age;
1106 my $patroncategory = $self->category;
1107 my ($low,$high) = ($patroncategory->dateofbirthrequired, $patroncategory->upperagelimit);
1109 return (defined($age) && (($high && ($age > $high)) or ($age < $low))) ? 0 : 1;
1114 my $account = $patron->account
1120 return Koha::Account->new( { patron_id => $self->borrowernumber } );
1125 my $holds = $patron->holds
1127 Return all the holds placed by this patron
1133 my $holds_rs = $self->_result->reserves->search( {}, { order_by => 'reservedate' } );
1134 return Koha::Holds->_new_from_dbic($holds_rs);
1139 my $old_holds = $patron->old_holds
1141 Return all the historical holds for this patron
1147 my $old_holds_rs = $self->_result->old_reserves->search( {}, { order_by => 'reservedate' } );
1148 return Koha::Old::Holds->_new_from_dbic($old_holds_rs);
1151 =head3 return_claims
1153 my $return_claims = $patron->return_claims
1159 my $return_claims = $self->_result->return_claims_borrowernumbers;
1160 return Koha::Checkouts::ReturnClaims->_new_from_dbic( $return_claims );
1163 =head3 notice_email_address
1165 my $email = $patron->notice_email_address;
1167 Return the email address of patron used for notices.
1168 Returns the empty string if no email address.
1172 sub notice_email_address{
1175 my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
1176 # if syspref is set to 'first valid' (value == OFF), look up email address
1177 if ( $which_address eq 'OFF' ) {
1178 return $self->first_valid_email_address;
1181 return $self->$which_address || '';
1184 =head3 first_valid_email_address
1186 my $first_valid_email_address = $patron->first_valid_email_address
1188 Return the first valid email address for a patron.
1189 For now, the order is defined as email, emailpro, B_email.
1190 Returns the empty string if the borrower has no email addresses.
1194 sub first_valid_email_address {
1197 return $self->email() || $self->emailpro() || $self->B_email() || q{};
1200 =head3 get_club_enrollments
1204 sub get_club_enrollments {
1205 my ( $self, $return_scalar ) = @_;
1207 my $e = Koha::Club::Enrollments->search( { borrowernumber => $self->borrowernumber(), date_canceled => undef } );
1209 return $e if $return_scalar;
1211 return wantarray ? $e->as_list : $e;
1214 =head3 get_enrollable_clubs
1218 sub get_enrollable_clubs {
1219 my ( $self, $is_enrollable_from_opac, $return_scalar ) = @_;
1222 $params->{is_enrollable_from_opac} = $is_enrollable_from_opac
1223 if $is_enrollable_from_opac;
1224 $params->{is_email_required} = 0 unless $self->first_valid_email_address();
1226 $params->{borrower} = $self;
1228 my $e = Koha::Clubs->get_enrollable($params);
1230 return $e if $return_scalar;
1232 return wantarray ? $e->as_list : $e;
1235 =head3 account_locked
1237 my $is_locked = $patron->account_locked
1239 Return true if the patron has reached the maximum number of login attempts
1240 (see pref FailedLoginAttempts). If login_attempts is < 0, this is interpreted
1241 as an administrative lockout (independent of FailedLoginAttempts; see also
1242 Koha::Patron->lock).
1243 Otherwise return false.
1244 If the pref is not set (empty string, null or 0), the feature is considered as
1249 sub account_locked {
1251 my $FailedLoginAttempts = C4::Context->preference('FailedLoginAttempts');
1252 return 1 if $FailedLoginAttempts
1253 and $self->login_attempts
1254 and $self->login_attempts >= $FailedLoginAttempts;
1255 return 1 if ($self->login_attempts || 0) < 0; # administrative lockout
1259 =head3 can_see_patron_infos
1261 my $can_see = $patron->can_see_patron_infos( $patron );
1263 Return true if the patron (usually the logged in user) can see the patron's infos for a given patron
1267 sub can_see_patron_infos {
1268 my ( $self, $patron ) = @_;
1269 return unless $patron;
1270 return $self->can_see_patrons_from( $patron->library->branchcode );
1273 =head3 can_see_patrons_from
1275 my $can_see = $patron->can_see_patrons_from( $branchcode );
1277 Return true if the patron (usually the logged in user) can see the patron's infos from a given library
1281 sub can_see_patrons_from {
1282 my ( $self, $branchcode ) = @_;
1284 if ( $self->branchcode eq $branchcode ) {
1286 } elsif ( $self->has_permission( { borrowers => 'view_borrower_infos_from_any_libraries' } ) ) {
1288 } elsif ( my $library_groups = $self->library->library_groups ) {
1289 while ( my $library_group = $library_groups->next ) {
1290 if ( $library_group->parent->has_child( $branchcode ) ) {
1299 =head3 libraries_where_can_see_patrons
1301 my $libraries = $patron-libraries_where_can_see_patrons;
1303 Return the list of branchcodes(!) of libraries the patron is allowed to see other patron's infos.
1304 The branchcodes are arbitrarily returned sorted.
1305 We are supposing here that the object is related to the logged in patron (use of C4::Context::only_my_library)
1307 An empty array means no restriction, the patron can see patron's infos from any libraries.
1311 sub libraries_where_can_see_patrons {
1313 my $userenv = C4::Context->userenv;
1315 return () unless $userenv; # For tests, but userenv should be defined in tests...
1317 my @restricted_branchcodes;
1318 if (C4::Context::only_my_library) {
1319 push @restricted_branchcodes, $self->branchcode;
1323 $self->has_permission(
1324 { borrowers => 'view_borrower_infos_from_any_libraries' }
1328 my $library_groups = $self->library->library_groups({ ft_hide_patron_info => 1 });
1329 if ( $library_groups->count )
1331 while ( my $library_group = $library_groups->next ) {
1332 my $parent = $library_group->parent;
1333 if ( $parent->has_child( $self->branchcode ) ) {
1334 push @restricted_branchcodes, $parent->children->get_column('branchcode');
1339 @restricted_branchcodes = ( $self->branchcode ) unless @restricted_branchcodes;
1343 @restricted_branchcodes = grep { defined $_ } @restricted_branchcodes;
1344 @restricted_branchcodes = uniq(@restricted_branchcodes);
1345 @restricted_branchcodes = sort(@restricted_branchcodes);
1346 return @restricted_branchcodes;
1349 =head3 has_permission
1351 my $permission = $patron->has_permission($required);
1353 See C4::Auth::haspermission for details of syntax for $required
1357 sub has_permission {
1358 my ( $self, $flagsrequired ) = @_;
1359 return unless $self->userid;
1360 # TODO code from haspermission needs to be moved here!
1361 return C4::Auth::haspermission( $self->userid, $flagsrequired );
1364 =head3 is_superlibrarian
1366 my $is_superlibrarian = $patron->is_superlibrarian;
1368 Return true if the patron is a superlibrarian.
1372 sub is_superlibrarian {
1374 return $self->has_permission( { superlibrarian => 1 } ) ? 1 : 0;
1379 my $is_adult = $patron->is_adult
1381 Return true if the patron has a category with a type Adult (A) or Organization (I)
1387 return $self->category->category_type =~ /^(A|I)$/ ? 1 : 0;
1392 my $is_child = $patron->is_child
1394 Return true if the patron has a category with a type Child (C)
1400 return $self->category->category_type eq 'C' ? 1 : 0;
1403 =head3 has_valid_userid
1405 my $patron = Koha::Patrons->find(42);
1406 $patron->userid( $new_userid );
1407 my $has_a_valid_userid = $patron->has_valid_userid
1409 my $patron = Koha::Patron->new( $params );
1410 my $has_a_valid_userid = $patron->has_valid_userid
1412 Return true if the current userid of this patron is valid/unique, otherwise false.
1414 Note that this should be done in $self->store instead and raise an exception if needed.
1418 sub has_valid_userid {
1421 return 0 unless $self->userid;
1423 return 0 if ( $self->userid eq C4::Context->config('user') ); # DB user
1425 my $already_exists = Koha::Patrons->search(
1427 userid => $self->userid,
1430 ? ( borrowernumber => { '!=' => $self->borrowernumber } )
1435 return $already_exists ? 0 : 1;
1438 =head3 generate_userid
1440 my $patron = Koha::Patron->new( $params );
1441 $patron->generate_userid
1443 Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
1445 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).
1449 sub generate_userid {
1452 my $firstname = $self->firstname // q{};
1453 my $surname = $self->surname // q{};
1454 #The script will "do" the following code and increment the $offset until the generated userid is unique
1456 $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1457 $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1458 my $userid = lc(($firstname)? "$firstname.$surname" : $surname);
1459 $userid = NFKD( $userid );
1460 $userid =~ s/\p{NonspacingMark}//g;
1461 $userid .= $offset unless $offset == 0;
1462 $self->userid( $userid );
1464 } while (! $self->has_valid_userid );
1469 =head3 add_extended_attribute
1473 sub add_extended_attribute {
1474 my ($self, $attribute) = @_;
1475 $attribute->{borrowernumber} = $self->borrowernumber;
1476 return Koha::Patron::Attribute->new($attribute)->store;
1479 =head3 extended_attributes
1481 Return object of Koha::Patron::Attributes type with all attributes set for this patron
1487 sub extended_attributes {
1488 my ( $self, $attributes ) = @_;
1489 if ($attributes) { # setter
1490 my $schema = $self->_result->result_source->schema;
1493 # Remove the existing one
1494 $self->extended_attributes->filter_by_branch_limitations->delete;
1496 # Insert the new ones
1497 for my $attribute (@$attributes) {
1499 $self->_result->create_related('borrower_attributes', $attribute);
1502 # 1 - Raise an exception
1503 # 2 - Execute in a transaction and don't save
1504 # or Insert anyway but display a message on the UI
1511 my $rs = $self->_result->borrower_attributes;
1512 # We call search to use the filters in Koha::Patron::Attributes->search
1513 return Koha::Patron::Attributes->_new_from_dbic($rs)->search;
1518 Koha::Patrons->find($id)->lock({ expire => 1, remove => 1 });
1520 Lock and optionally expire a patron account.
1521 Remove holds and article requests if remove flag set.
1522 In order to distinguish from locking by entering a wrong password, let's
1523 call this an administrative lockout.
1528 my ( $self, $params ) = @_;
1529 $self->login_attempts( ADMINISTRATIVE_LOCKOUT );
1530 if( $params->{expire} ) {
1531 $self->dateexpiry( dt_from_string->subtract(days => 1) );
1534 if( $params->{remove} ) {
1535 $self->holds->delete;
1536 $self->article_requests->delete;
1543 Koha::Patrons->find($id)->anonymize;
1545 Anonymize or clear borrower fields. Fields in BorrowerMandatoryField
1546 are randomized, other personal data is cleared too.
1547 Patrons with issues are skipped.
1553 if( $self->_result->issues->count ) {
1554 warn "Exiting anonymize: patron ".$self->borrowernumber." still has issues";
1557 # Mandatory fields come from the corresponding pref, but email fields
1558 # are removed since scrambled email addresses only generate errors
1559 my $mandatory = { map { (lc $_, 1); } grep { !/email/ }
1560 split /\s*\|\s*/, C4::Context->preference('BorrowerMandatoryField') };
1561 $mandatory->{userid} = 1; # needed since sub store does not clear field
1562 my @columns = $self->_result->result_source->columns;
1563 @columns = grep { !/borrowernumber|branchcode|categorycode|^date|password|flags|updated_on|lastseen|lang|login_attempts|anonymized/ } @columns;
1564 push @columns, 'dateofbirth'; # add this date back in
1565 foreach my $col (@columns) {
1566 $self->_anonymize_column($col, $mandatory->{lc $col} );
1568 $self->anonymized(1)->store;
1571 sub _anonymize_column {
1572 my ( $self, $col, $mandatory ) = @_;
1573 my $col_info = $self->_result->result_source->column_info($col);
1574 my $type = $col_info->{data_type};
1575 my $nullable = $col_info->{is_nullable};
1577 if( $type =~ /char|text/ ) {
1579 ? Koha::Token->new->generate({ pattern => '\w{10}' })
1583 } elsif( $type =~ /integer|int$|float|dec|double/ ) {
1584 $val = $nullable ? undef : 0;
1585 } elsif( $type =~ /date|time/ ) {
1586 $val = $nullable ? undef : dt_from_string;
1591 =head3 add_guarantor
1593 my @relationships = $patron->add_guarantor(
1595 borrowernumber => $borrowernumber,
1596 relationships => $relationship,
1600 Adds a new guarantor to a patron.
1605 my ( $self, $params ) = @_;
1607 my $guarantor_id = $params->{guarantor_id};
1608 my $relationship = $params->{relationship};
1610 return Koha::Patron::Relationship->new(
1612 guarantee_id => $self->id,
1613 guarantor_id => $guarantor_id,
1614 relationship => $relationship
1619 =head3 get_extended_attribute
1621 my $attribute_value = $patron->get_extended_attribute( $code );
1623 Return the attribute for the code passed in parameter.
1625 It not exist it returns undef
1627 Note that this will not work for repeatable attribute types.
1629 Maybe you certainly not want to use this method, it is actually only used for SHOW_BARCODE
1630 (which should be a real patron's attribute (not extended)
1634 sub get_extended_attribute {
1635 my ( $self, $code, $value ) = @_;
1636 my $rs = $self->_result->borrower_attributes;
1638 my $attribute = $rs->search({ code => $code, ( $value ? ( attribute => $value ) : () ) });
1639 return unless $attribute->count;
1640 return $attribute->next;
1645 my $json = $patron->to_api;
1647 Overloaded method that returns a JSON representation of the Koha::Patron object,
1648 suitable for API output.
1653 my ( $self, $params ) = @_;
1655 my $json_patron = $self->SUPER::to_api( $params );
1657 $json_patron->{restricted} = ( $self->is_debarred )
1659 : Mojo::JSON->false;
1661 return $json_patron;
1664 =head3 to_api_mapping
1666 This method returns the mapping for representing a Koha::Patron object
1671 sub to_api_mapping {
1673 borrowernotes => 'staff_notes',
1674 borrowernumber => 'patron_id',
1675 branchcode => 'library_id',
1676 categorycode => 'category_id',
1677 checkprevcheckout => 'check_previous_checkout',
1678 contactfirstname => undef, # Unused
1679 contactname => undef, # Unused
1680 contactnote => 'altaddress_notes',
1681 contacttitle => undef, # Unused
1682 dateenrolled => 'date_enrolled',
1683 dateexpiry => 'expiry_date',
1684 dateofbirth => 'date_of_birth',
1685 debarred => undef, # replaced by 'restricted'
1686 debarredcomment => undef, # calculated, API consumers will use /restrictions instead
1687 emailpro => 'secondary_email',
1688 flags => undef, # permissions manipulation handled in /permissions
1689 gonenoaddress => 'incorrect_address',
1690 guarantorid => 'guarantor_id',
1691 lastseen => 'last_seen',
1692 lost => 'patron_card_lost',
1693 opacnote => 'opac_notes',
1694 othernames => 'other_name',
1695 password => undef, # password manipulation handled in /password
1696 phonepro => 'secondary_phone',
1697 relationship => 'relationship_type',
1699 smsalertnumber => 'sms_number',
1700 sort1 => 'statistics_1',
1701 sort2 => 'statistics_2',
1702 autorenew_checkouts => 'autorenew_checkouts',
1703 streetnumber => 'street_number',
1704 streettype => 'street_type',
1705 zipcode => 'postal_code',
1706 B_address => 'altaddress_address',
1707 B_address2 => 'altaddress_address2',
1708 B_city => 'altaddress_city',
1709 B_country => 'altaddress_country',
1710 B_email => 'altaddress_email',
1711 B_phone => 'altaddress_phone',
1712 B_state => 'altaddress_state',
1713 B_streetnumber => 'altaddress_street_number',
1714 B_streettype => 'altaddress_street_type',
1715 B_zipcode => 'altaddress_postal_code',
1716 altcontactaddress1 => 'altcontact_address',
1717 altcontactaddress2 => 'altcontact_address2',
1718 altcontactaddress3 => 'altcontact_city',
1719 altcontactcountry => 'altcontact_country',
1720 altcontactfirstname => 'altcontact_firstname',
1721 altcontactphone => 'altcontact_phone',
1722 altcontactsurname => 'altcontact_surname',
1723 altcontactstate => 'altcontact_state',
1724 altcontactzipcode => 'altcontact_postal_code'
1728 =head2 Internal methods
1740 Kyle M Hall <kyle@bywatersolutions.com>
1741 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
1742 Martin Renvoize <martin.renvoize@ptfs-europe.com>