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
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.
24 use List::MoreUtils qw( any uniq );
25 use JSON qw( to_json );
26 use Text::Unaccent qw( unac_string );
33 use Koha::Club::Enrollments;
36 use Koha::Exceptions::Password;
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;
47 use Koha::Plugins::Handler;
48 use Koha::Subscription::Routinglists;
50 use Koha::Virtualshelves;
52 use base qw(Koha::Object);
54 use constant ADMINISTRATIVE_LOCKOUT => -1;
56 our $RESULTSET_PATRON_ID_MAPPING = {
57 Accountline => 'borrowernumber',
58 Aqbasketuser => 'borrowernumber',
59 Aqbudget => 'budget_owner_id',
60 Aqbudgetborrower => 'borrowernumber',
61 ArticleRequest => 'borrowernumber',
62 BorrowerAttribute => 'borrowernumber',
63 BorrowerDebarment => 'borrowernumber',
64 BorrowerFile => 'borrowernumber',
65 BorrowerModification => 'borrowernumber',
66 ClubEnrollment => 'borrowernumber',
67 Issue => 'borrowernumber',
68 ItemsLastBorrower => 'borrowernumber',
69 Linktracker => 'borrowernumber',
70 Message => 'borrowernumber',
71 MessageQueue => 'borrowernumber',
72 OldIssue => 'borrowernumber',
73 OldReserve => 'borrowernumber',
74 Rating => 'borrowernumber',
75 Reserve => 'borrowernumber',
76 Review => 'borrowernumber',
77 SearchHistory => 'userid',
78 Statistic => 'borrowernumber',
79 Suggestion => 'suggestedby',
80 TagAll => 'borrowernumber',
81 Virtualshelfcontent => 'borrowernumber',
82 Virtualshelfshare => 'borrowernumber',
83 Virtualshelve => 'owner',
88 Koha::Patron - Koha Patron Object class
99 my ( $class, $params ) = @_;
101 return $class->SUPER::new($params);
104 =head3 fixup_cardnumber
106 Autogenerate next cardnumber from highest value found in database
110 sub fixup_cardnumber {
112 my $max = Koha::Patrons->search({
113 cardnumber => {-regexp => '^-?[0-9]+$'}
115 select => \'CAST(cardnumber AS SIGNED)',
116 as => ['cast_cardnumber']
117 })->_resultset->get_column('cast_cardnumber')->max;
118 $self->cardnumber(($max || 0) +1);
121 =head3 trim_whitespace
123 trim whitespace from data which has some non-whitespace in it.
124 Could be moved to Koha::Object if need to be reused
128 sub trim_whitespaces {
131 my $schema = Koha::Database->new->schema;
132 my @columns = $schema->source($self->_type)->columns;
134 for my $column( @columns ) {
135 my $value = $self->$column;
136 if ( defined $value ) {
137 $value =~ s/^\s*|\s*$//g;
138 $self->$column($value);
144 =head3 plain_text_password
146 $patron->plain_text_password( $password );
148 stores a copy of the unencrypted password in the object
149 for use in code before encrypting for db
153 sub plain_text_password {
154 my ( $self, $password ) = @_;
156 $self->{_plain_text_password} = $password;
159 return $self->{_plain_text_password}
160 if $self->{_plain_text_password};
167 Patron specific store method to cleanup record
168 and do other necessary things before saving
176 $self->_result->result_source->schema->txn_do(
179 C4::Context->preference("autoMemberNum")
180 and ( not defined $self->cardnumber
181 or $self->cardnumber eq '' )
184 # Warning: The caller is responsible for locking the members table in write
185 # mode, to avoid database corruption.
186 # We are in a transaction but the table is not locked
187 $self->fixup_cardnumber;
190 unless( $self->category->in_storage ) {
191 Koha::Exceptions::Object::FKConstraint->throw(
192 broken_fk => 'categorycode',
193 value => $self->categorycode,
197 $self->trim_whitespaces;
199 # Set surname to uppercase if uppercasesurname is true
200 $self->surname( uc($self->surname) )
201 if C4::Context->preference("uppercasesurnames");
203 unless ( $self->in_storage ) { #AddMember
205 # Generate a valid userid/login if needed
206 $self->generate_userid
207 if not $self->userid or not $self->has_valid_userid;
209 # Add expiration date if it isn't already there
210 unless ( $self->dateexpiry ) {
211 $self->dateexpiry( $self->category->get_expiry_date );
214 # Add enrollment date if it isn't already there
215 unless ( $self->dateenrolled ) {
216 $self->dateenrolled(dt_from_string);
219 # Set the privacy depending on the patron's category
220 my $default_privacy = $self->category->default_privacy || q{};
222 $default_privacy eq 'default' ? 1
223 : $default_privacy eq 'never' ? 2
224 : $default_privacy eq 'forever' ? 0
226 $self->privacy($default_privacy);
228 # Make a copy of the plain text password for later use
229 $self->plain_text_password( $self->password );
231 if ( C4::Context->preference('UseKohaPlugins') && C4::Context->config("enable_plugins") ) {
232 # Call any check_password plugins
233 my @plugins = Koha::Plugins->new()->GetPlugins({
234 method => 'check_password',
236 foreach my $plugin ( @plugins ) {
237 # This plugin hook will also be used by a plugin for the Norwegian national
238 # patron database. This is why we need to pass both the password and the
239 # borrowernumber to the plugin.
240 my $ret = Koha::Plugins::Handler->run({
241 class => ref $plugin,
242 method => 'check_password',
244 password => $self->plain_text_password,
245 borrowernumber => $self->borrowernumber,
248 if ( $ret->{'error'} == 1 ) {
249 Koha::Exceptions::Password::Plugin->throw();
254 # Create a disabled account if no password provided
255 $self->password( $self->password
256 ? Koha::AuthUtils::hash_password( $self->password )
259 $self->borrowernumber(undef);
261 $self = $self->SUPER::store;
263 $self->add_enrolment_fee_if_needed(0);
265 logaction( "MEMBERS", "CREATE", $self->borrowernumber, "" )
266 if C4::Context->preference("BorrowersLog");
270 my $self_from_storage = $self->get_from_storage;
271 # FIXME We should not deal with that here, callers have to do this job
272 # Moved from ModMember to prevent regressions
273 unless ( $self->userid ) {
274 my $stored_userid = $self_from_storage->userid;
275 $self->userid($stored_userid);
278 # Password must be updated using $self->set_password
279 $self->password($self_from_storage->password);
281 if ( $self->category->categorycode ne
282 $self_from_storage->category->categorycode )
284 # Add enrolement fee on category change if required
285 $self->add_enrolment_fee_if_needed(1)
286 if C4::Context->preference('FeeOnChangePatronCategory');
288 # Clean up guarantors on category change if required
289 $self->guarantor_relationships->delete
290 if ( $self->category->category_type ne 'C'
291 && $self->category->category_type ne 'P' );
296 if ( C4::Context->preference("BorrowersLog") ) {
298 my $from_storage = $self_from_storage->unblessed;
299 my $from_object = $self->unblessed;
300 my @skip_fields = (qw/lastseen updated_on/);
301 for my $key ( keys %{$from_storage} ) {
302 next if any { /$key/ } @skip_fields;
305 !defined( $from_storage->{$key} )
306 && defined( $from_object->{$key} )
308 || ( defined( $from_storage->{$key} )
309 && !defined( $from_object->{$key} ) )
311 defined( $from_storage->{$key} )
312 && defined( $from_object->{$key} )
313 && ( $from_storage->{$key} ne
314 $from_object->{$key} )
319 before => $from_storage->{$key},
320 after => $from_object->{$key}
325 if ( defined($info) ) {
329 $self->borrowernumber,
332 { utf8 => 1, pretty => 1, canonical => 1 }
339 $self = $self->SUPER::store;
350 Delete patron's holds, lists and finally the patron.
352 Lists owned by the borrower are deleted, but entries from the borrower to
353 other lists are kept.
361 $self->_result->result_source->schema->txn_do(
363 # Cancel Patron's holds
364 my $holds = $self->holds;
365 while( my $hold = $holds->next ){
369 # Delete all lists and all shares of this borrower
370 # Consistent with the approach Koha uses on deleting individual lists
371 # Note that entries in virtualshelfcontents added by this borrower to
372 # lists of others will be handled by a table constraint: the borrower
373 # is set to NULL in those entries.
375 # We could handle the above deletes via a constraint too.
376 # But a new BZ report 11889 has been opened to discuss another approach.
377 # Instead of deleting we could also disown lists (based on a pref).
378 # In that way we could save shared and public lists.
379 # The current table constraints support that idea now.
380 # This pref should then govern the results of other routines/methods such as
381 # Koha::Virtualshelf->new->delete too.
382 # FIXME Could be $patron->get_lists
383 $_->delete for Koha::Virtualshelves->search( { owner => $self->borrowernumber } );
385 $deleted = $self->SUPER::delete;
387 logaction( "MEMBERS", "DELETE", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog");
396 my $patron_category = $patron->category
398 Return the patron category for this patron
404 return Koha::Patron::Category->_new_from_dbic( $self->_result->categorycode );
414 return scalar Koha::Patron::Images->find( $self->borrowernumber );
419 Returns a Koha::Library object representing the patron's home library.
425 return Koha::Library->_new_from_dbic($self->_result->branchcode);
428 =head3 guarantor_relationships
430 Returns Koha::Patron::Relationships object for this patron's guarantors
432 Returns the set of relationships for the patrons that are guarantors for this patron.
434 This is returned instead of a Koha::Patron object because the guarantor
435 may not exist as a patron in Koha. If this is true, the guarantors name
436 exists in the Koha::Patron::Relationship object and will have no guarantor_id.
440 sub guarantor_relationships {
443 return Koha::Patron::Relationships->search( { guarantee_id => $self->id } );
446 =head3 guarantee_relationships
448 Returns Koha::Patron::Relationships object for this patron's guarantors
450 Returns the set of relationships for the patrons that are guarantees for this patron.
452 The method returns Koha::Patron::Relationship objects for the sake
453 of consistency with the guantors method.
454 A guarantee by definition must exist as a patron in Koha.
458 sub guarantee_relationships {
461 return Koha::Patron::Relationships->search(
462 { guarantor_id => $self->id },
464 prefetch => 'guarantee',
465 order_by => { -asc => [ 'guarantee.surname', 'guarantee.firstname' ] },
470 =head3 housebound_profile
472 Returns the HouseboundProfile associated with this patron.
476 sub housebound_profile {
478 my $profile = $self->_result->housebound_profile;
479 return Koha::Patron::HouseboundProfile->_new_from_dbic($profile)
484 =head3 housebound_role
486 Returns the HouseboundRole associated with this patron.
490 sub housebound_role {
493 my $role = $self->_result->housebound_role;
494 return Koha::Patron::HouseboundRole->_new_from_dbic($role) if ( $role );
500 Returns the siblings of this patron.
507 my @guarantors = $self->guarantor_relationships()->guarantors();
509 return unless @guarantors;
512 map { $_->guarantee_relationships()->guarantees() } @guarantors;
514 return unless @siblings;
518 grep { !$seen{ $_->id }++ && ( $_->id != $self->id ) } @siblings;
520 return wantarray ? @siblings : Koha::Patrons->search( { borrowernumber => { -in => [ map { $_->id } @siblings ] } } );
525 my $patron = Koha::Patrons->find($id);
526 $patron->merge_with( \@patron_ids );
528 This subroutine merges a list of patrons into the patron record. This is accomplished by finding
529 all related patron ids for the patrons to be merged in other tables and changing the ids to be that
530 of the keeper patron.
535 my ( $self, $patron_ids ) = @_;
537 my @patron_ids = @{ $patron_ids };
539 # Ensure the keeper isn't in the list of patrons to merge
540 @patron_ids = grep { $_ ne $self->id } @patron_ids;
542 my $schema = Koha::Database->new()->schema();
546 $self->_result->result_source->schema->txn_do( sub {
547 foreach my $patron_id (@patron_ids) {
548 my $patron = Koha::Patrons->find( $patron_id );
552 # Unbless for safety, the patron will end up being deleted
553 $results->{merged}->{$patron_id}->{patron} = $patron->unblessed;
555 while (my ($r, $field) = each(%$RESULTSET_PATRON_ID_MAPPING)) {
556 my $rs = $schema->resultset($r)->search({ $field => $patron_id });
557 $results->{merged}->{ $patron_id }->{updated}->{$r} = $rs->count();
558 $rs->update({ $field => $self->id });
561 $patron->move_to_deleted();
571 =head3 wants_check_for_previous_checkout
573 $wants_check = $patron->wants_check_for_previous_checkout;
575 Return 1 if Koha needs to perform PrevIssue checking, else 0.
579 sub wants_check_for_previous_checkout {
581 my $syspref = C4::Context->preference("checkPrevCheckout");
584 ## Hard syspref trumps all
585 return 1 if ($syspref eq 'hardyes');
586 return 0 if ($syspref eq 'hardno');
587 ## Now, patron pref trumps all
588 return 1 if ($self->checkprevcheckout eq 'yes');
589 return 0 if ($self->checkprevcheckout eq 'no');
591 # More complex: patron inherits -> determine category preference
592 my $checkPrevCheckoutByCat = $self->category->checkprevcheckout;
593 return 1 if ($checkPrevCheckoutByCat eq 'yes');
594 return 0 if ($checkPrevCheckoutByCat eq 'no');
596 # Finally: category preference is inherit, default to 0
597 if ($syspref eq 'softyes') {
604 =head3 do_check_for_previous_checkout
606 $do_check = $patron->do_check_for_previous_checkout($item);
608 Return 1 if the bib associated with $ITEM has previously been checked out to
609 $PATRON, 0 otherwise.
613 sub do_check_for_previous_checkout {
614 my ( $self, $item ) = @_;
617 my $biblio = Koha::Biblios->find( $item->{biblionumber} );
618 if ( $biblio->is_serial ) {
619 push @item_nos, $item->{itemnumber};
621 # Get all itemnumbers for given bibliographic record.
622 @item_nos = $biblio->items->get_column( 'itemnumber' );
625 # Create (old)issues search criteria
627 borrowernumber => $self->borrowernumber,
628 itemnumber => \@item_nos,
631 # Check current issues table
632 my $issues = Koha::Checkouts->search($criteria);
633 return 1 if $issues->count; # 0 || N
635 # Check old issues table
636 my $old_issues = Koha::Old::Checkouts->search($criteria);
637 return $old_issues->count; # 0 || N
642 my $debarment_expiration = $patron->is_debarred;
644 Returns the date a patron debarment will expire, or undef if the patron is not
652 return unless $self->debarred;
653 return $self->debarred
654 if $self->debarred =~ '^9999'
655 or dt_from_string( $self->debarred ) > dt_from_string;
661 my $is_expired = $patron->is_expired;
663 Returns 1 if the patron is expired or 0;
669 return 0 unless $self->dateexpiry;
670 return 0 if $self->dateexpiry =~ '^9999';
671 return 1 if dt_from_string( $self->dateexpiry ) < dt_from_string->truncate( to => 'day' );
675 =head3 is_going_to_expire
677 my $is_going_to_expire = $patron->is_going_to_expire;
679 Returns 1 if the patron is going to expired, depending on the NotifyBorrowerDeparture pref or 0
683 sub is_going_to_expire {
686 my $delay = C4::Context->preference('NotifyBorrowerDeparture') || 0;
688 return 0 unless $delay;
689 return 0 unless $self->dateexpiry;
690 return 0 if $self->dateexpiry =~ '^9999';
691 return 1 if dt_from_string( $self->dateexpiry, undef, 'floating' )->subtract( days => $delay ) < dt_from_string(undef, undef, 'floating')->truncate( to => 'day' );
697 $patron->set_password({ password => $plain_text_password [, skip_validation => 1 ] });
699 Set the patron's password.
703 The passed string is validated against the current password enforcement policy.
704 Validation can be skipped by passing the I<skip_validation> parameter.
706 Exceptions are thrown if the password is not good enough.
710 =item Koha::Exceptions::Password::TooShort
712 =item Koha::Exceptions::Password::WhitespaceCharacters
714 =item Koha::Exceptions::Password::TooWeak
716 =item Koha::Exceptions::Password::Plugin (if a "check password" plugin is enabled)
723 my ( $self, $args ) = @_;
725 my $password = $args->{password};
727 unless ( $args->{skip_validation} ) {
728 my ( $is_valid, $error ) = Koha::AuthUtils::is_password_valid( $password );
731 if ( $error eq 'too_short' ) {
732 my $min_length = C4::Context->preference('minPasswordLength');
733 $min_length = 3 if not $min_length or $min_length < 3;
735 my $password_length = length($password);
736 Koha::Exceptions::Password::TooShort->throw(
737 length => $password_length, min_length => $min_length );
739 elsif ( $error eq 'has_whitespaces' ) {
740 Koha::Exceptions::Password::WhitespaceCharacters->throw();
742 elsif ( $error eq 'too_weak' ) {
743 Koha::Exceptions::Password::TooWeak->throw();
748 if ( C4::Context->preference('UseKohaPlugins') && C4::Context->config("enable_plugins") ) {
749 # Call any check_password plugins
750 my @plugins = Koha::Plugins->new()->GetPlugins({
751 method => 'check_password',
753 foreach my $plugin ( @plugins ) {
754 # This plugin hook will also be used by a plugin for the Norwegian national
755 # patron database. This is why we need to pass both the password and the
756 # borrowernumber to the plugin.
757 my $ret = Koha::Plugins::Handler->run({
758 class => ref $plugin,
759 method => 'check_password',
761 password => $password,
762 borrowernumber => $self->borrowernumber,
765 # This plugin hook will also be used by a plugin for the Norwegian national
766 # patron database. This is why we need to call the actual plugins and then
767 # check skip_validation afterwards.
768 if ( $ret->{'error'} == 1 && !$args->{skip_validation} ) {
769 Koha::Exceptions::Password::Plugin->throw();
774 my $digest = Koha::AuthUtils::hash_password($password);
776 { password => $digest,
781 logaction( "MEMBERS", "CHANGE PASS", $self->borrowernumber, "" )
782 if C4::Context->preference("BorrowersLog");
790 my $new_expiry_date = $patron->renew_account
792 Extending the subscription to the expiry date.
799 if ( C4::Context->preference('BorrowerRenewalPeriodBase') eq 'combination' ) {
800 $date = ( dt_from_string gt dt_from_string( $self->dateexpiry ) ) ? dt_from_string : dt_from_string( $self->dateexpiry );
803 C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry'
804 ? dt_from_string( $self->dateexpiry )
807 my $expiry_date = $self->category->get_expiry_date($date);
809 $self->dateexpiry($expiry_date);
810 $self->date_renewed( dt_from_string() );
813 $self->add_enrolment_fee_if_needed(1);
815 logaction( "MEMBERS", "RENEW", $self->borrowernumber, "Membership renewed" ) if C4::Context->preference("BorrowersLog");
816 return dt_from_string( $expiry_date )->truncate( to => 'day' );
821 my $has_overdues = $patron->has_overdues;
823 Returns the number of patron's overdues
829 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
830 return $self->_result->issues->search({ date_due => { '<' => $dtf->format_datetime( dt_from_string() ) } })->count;
835 $patron->track_login;
836 $patron->track_login({ force => 1 });
838 Tracks a (successful) login attempt.
839 The preference TrackLastPatronActivity must be enabled. Or you
840 should pass the force parameter.
845 my ( $self, $params ) = @_;
848 !C4::Context->preference('TrackLastPatronActivity');
849 $self->lastseen( dt_from_string() )->store;
852 =head3 move_to_deleted
854 my $is_moved = $patron->move_to_deleted;
856 Move a patron to the deletedborrowers table.
857 This can be done before deleting a patron, to make sure the data are not completely deleted.
861 sub move_to_deleted {
863 my $patron_infos = $self->unblessed;
864 delete $patron_infos->{updated_on}; #This ensures the updated_on date in deletedborrowers will be set to the current timestamp
865 return Koha::Database->new->schema->resultset('Deletedborrower')->create($patron_infos);
868 =head3 article_requests
870 my @requests = $borrower->article_requests();
871 my $requests = $borrower->article_requests();
873 Returns either a list of ArticleRequests objects,
874 or an ArtitleRequests object, depending on the
879 sub article_requests {
882 $self->{_article_requests} ||= Koha::ArticleRequests->search({ borrowernumber => $self->borrowernumber() });
884 return $self->{_article_requests};
887 =head3 article_requests_current
889 my @requests = $patron->article_requests_current
891 Returns the article requests associated with this patron that are incomplete
895 sub article_requests_current {
898 $self->{_article_requests_current} ||= Koha::ArticleRequests->search(
900 borrowernumber => $self->id(),
902 { status => Koha::ArticleRequest::Status::Pending },
903 { status => Koha::ArticleRequest::Status::Processing }
908 return $self->{_article_requests_current};
911 =head3 article_requests_finished
913 my @requests = $biblio->article_requests_finished
915 Returns the article requests associated with this patron that are completed
919 sub article_requests_finished {
920 my ( $self, $borrower ) = @_;
922 $self->{_article_requests_finished} ||= Koha::ArticleRequests->search(
924 borrowernumber => $self->id(),
926 { status => Koha::ArticleRequest::Status::Completed },
927 { status => Koha::ArticleRequest::Status::Canceled }
932 return $self->{_article_requests_finished};
935 =head3 add_enrolment_fee_if_needed
937 my $enrolment_fee = $patron->add_enrolment_fee_if_needed($renewal);
939 Add enrolment fee for a patron if needed.
941 $renewal - boolean denoting whether this is an account renewal or not
945 sub add_enrolment_fee_if_needed {
946 my ($self, $renewal) = @_;
947 my $enrolment_fee = $self->category->enrolmentfee;
948 if ( $enrolment_fee && $enrolment_fee > 0 ) {
949 my $type = $renewal ? 'ACCOUNT_RENEW' : 'ACCOUNT';
950 $self->account->add_debit(
952 amount => $enrolment_fee,
953 user_id => C4::Context->userenv ? C4::Context->userenv->{'number'} : undef,
954 interface => C4::Context->interface,
955 library_id => C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef,
960 return $enrolment_fee || 0;
965 my $checkouts = $patron->checkouts
971 my $checkouts = $self->_result->issues;
972 return Koha::Checkouts->_new_from_dbic( $checkouts );
975 =head3 pending_checkouts
977 my $pending_checkouts = $patron->pending_checkouts
979 This method will return the same as $self->checkouts, but with a prefetch on
980 items, biblio and biblioitems.
982 It has been introduced to replaced the C4::Members::GetPendingIssues subroutine
984 It should not be used directly, prefer to access fields you need instead of
985 retrieving all these fields in one go.
989 sub pending_checkouts {
991 my $checkouts = $self->_result->issues->search(
995 { -desc => 'me.timestamp' },
996 { -desc => 'issuedate' },
997 { -desc => 'issue_id' }, # Sort by issue_id should be enough
999 prefetch => { item => { biblio => 'biblioitems' } },
1002 return Koha::Checkouts->_new_from_dbic( $checkouts );
1005 =head3 old_checkouts
1007 my $old_checkouts = $patron->old_checkouts
1013 my $old_checkouts = $self->_result->old_issues;
1014 return Koha::Old::Checkouts->_new_from_dbic( $old_checkouts );
1019 my $overdue_items = $patron->get_overdues
1021 Return the overdue items
1027 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
1028 return $self->checkouts->search(
1030 'me.date_due' => { '<' => $dtf->format_datetime(dt_from_string) },
1033 prefetch => { item => { biblio => 'biblioitems' } },
1038 =head3 get_routing_lists
1040 my @routinglists = $patron->get_routing_lists
1042 Returns the routing lists a patron is subscribed to.
1046 sub get_routing_lists {
1048 my $routing_list_rs = $self->_result->subscriptionroutinglists;
1049 return Koha::Subscription::Routinglists->_new_from_dbic($routing_list_rs);
1054 my $age = $patron->get_age
1056 Return the age of the patron
1062 my $today_str = dt_from_string->strftime("%Y-%m-%d");
1063 return unless $self->dateofbirth;
1064 my $dob_str = dt_from_string( $self->dateofbirth )->strftime("%Y-%m-%d");
1066 my ( $dob_y, $dob_m, $dob_d ) = split /-/, $dob_str;
1067 my ( $today_y, $today_m, $today_d ) = split /-/, $today_str;
1069 my $age = $today_y - $dob_y;
1070 if ( $dob_m . $dob_d > $today_m . $today_d ) {
1079 my $is_valid = $patron->is_valid_age
1081 Return 1 if patron's age is between allowed limits, returns 0 if it's not.
1087 my $age = $self->get_age;
1089 my $patroncategory = $self->category;
1090 my ($low,$high) = ($patroncategory->dateofbirthrequired, $patroncategory->upperagelimit);
1092 return (defined($age) && (($high && ($age > $high)) or ($age < $low))) ? 0 : 1;
1097 my $account = $patron->account
1103 return Koha::Account->new( { patron_id => $self->borrowernumber } );
1108 my $holds = $patron->holds
1110 Return all the holds placed by this patron
1116 my $holds_rs = $self->_result->reserves->search( {}, { order_by => 'reservedate' } );
1117 return Koha::Holds->_new_from_dbic($holds_rs);
1122 my $old_holds = $patron->old_holds
1124 Return all the historical holds for this patron
1130 my $old_holds_rs = $self->_result->old_reserves->search( {}, { order_by => 'reservedate' } );
1131 return Koha::Old::Holds->_new_from_dbic($old_holds_rs);
1134 =head3 notice_email_address
1136 my $email = $patron->notice_email_address;
1138 Return the email address of patron used for notices.
1139 Returns the empty string if no email address.
1143 sub notice_email_address{
1146 my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
1147 # if syspref is set to 'first valid' (value == OFF), look up email address
1148 if ( $which_address eq 'OFF' ) {
1149 return $self->first_valid_email_address;
1152 return $self->$which_address || '';
1155 =head3 first_valid_email_address
1157 my $first_valid_email_address = $patron->first_valid_email_address
1159 Return the first valid email address for a patron.
1160 For now, the order is defined as email, emailpro, B_email.
1161 Returns the empty string if the borrower has no email addresses.
1165 sub first_valid_email_address {
1168 return $self->email() || $self->emailpro() || $self->B_email() || q{};
1171 =head3 get_club_enrollments
1175 sub get_club_enrollments {
1176 my ( $self, $return_scalar ) = @_;
1178 my $e = Koha::Club::Enrollments->search( { borrowernumber => $self->borrowernumber(), date_canceled => undef } );
1180 return $e if $return_scalar;
1182 return wantarray ? $e->as_list : $e;
1185 =head3 get_enrollable_clubs
1189 sub get_enrollable_clubs {
1190 my ( $self, $is_enrollable_from_opac, $return_scalar ) = @_;
1193 $params->{is_enrollable_from_opac} = $is_enrollable_from_opac
1194 if $is_enrollable_from_opac;
1195 $params->{is_email_required} = 0 unless $self->first_valid_email_address();
1197 $params->{borrower} = $self;
1199 my $e = Koha::Clubs->get_enrollable($params);
1201 return $e if $return_scalar;
1203 return wantarray ? $e->as_list : $e;
1206 =head3 account_locked
1208 my $is_locked = $patron->account_locked
1210 Return true if the patron has reached the maximum number of login attempts
1211 (see pref FailedLoginAttempts). If login_attempts is < 0, this is interpreted
1212 as an administrative lockout (independent of FailedLoginAttempts; see also
1213 Koha::Patron->lock).
1214 Otherwise return false.
1215 If the pref is not set (empty string, null or 0), the feature is considered as
1220 sub account_locked {
1222 my $FailedLoginAttempts = C4::Context->preference('FailedLoginAttempts');
1223 return 1 if $FailedLoginAttempts
1224 and $self->login_attempts
1225 and $self->login_attempts >= $FailedLoginAttempts;
1226 return 1 if ($self->login_attempts || 0) < 0; # administrative lockout
1230 =head3 can_see_patron_infos
1232 my $can_see = $patron->can_see_patron_infos( $patron );
1234 Return true if the patron (usually the logged in user) can see the patron's infos for a given patron
1238 sub can_see_patron_infos {
1239 my ( $self, $patron ) = @_;
1240 return unless $patron;
1241 return $self->can_see_patrons_from( $patron->library->branchcode );
1244 =head3 can_see_patrons_from
1246 my $can_see = $patron->can_see_patrons_from( $branchcode );
1248 Return true if the patron (usually the logged in user) can see the patron's infos from a given library
1252 sub can_see_patrons_from {
1253 my ( $self, $branchcode ) = @_;
1255 if ( $self->branchcode eq $branchcode ) {
1257 } elsif ( $self->has_permission( { borrowers => 'view_borrower_infos_from_any_libraries' } ) ) {
1259 } elsif ( my $library_groups = $self->library->library_groups ) {
1260 while ( my $library_group = $library_groups->next ) {
1261 if ( $library_group->parent->has_child( $branchcode ) ) {
1270 =head3 libraries_where_can_see_patrons
1272 my $libraries = $patron-libraries_where_can_see_patrons;
1274 Return the list of branchcodes(!) of libraries the patron is allowed to see other patron's infos.
1275 The branchcodes are arbitrarily returned sorted.
1276 We are supposing here that the object is related to the logged in patron (use of C4::Context::only_my_library)
1278 An empty array means no restriction, the patron can see patron's infos from any libraries.
1282 sub libraries_where_can_see_patrons {
1284 my $userenv = C4::Context->userenv;
1286 return () unless $userenv; # For tests, but userenv should be defined in tests...
1288 my @restricted_branchcodes;
1289 if (C4::Context::only_my_library) {
1290 push @restricted_branchcodes, $self->branchcode;
1294 $self->has_permission(
1295 { borrowers => 'view_borrower_infos_from_any_libraries' }
1299 my $library_groups = $self->library->library_groups({ ft_hide_patron_info => 1 });
1300 if ( $library_groups->count )
1302 while ( my $library_group = $library_groups->next ) {
1303 my $parent = $library_group->parent;
1304 if ( $parent->has_child( $self->branchcode ) ) {
1305 push @restricted_branchcodes, $parent->children->get_column('branchcode');
1310 @restricted_branchcodes = ( $self->branchcode ) unless @restricted_branchcodes;
1314 @restricted_branchcodes = grep { defined $_ } @restricted_branchcodes;
1315 @restricted_branchcodes = uniq(@restricted_branchcodes);
1316 @restricted_branchcodes = sort(@restricted_branchcodes);
1317 return @restricted_branchcodes;
1320 sub has_permission {
1321 my ( $self, $flagsrequired ) = @_;
1322 return unless $self->userid;
1323 # TODO code from haspermission needs to be moved here!
1324 return C4::Auth::haspermission( $self->userid, $flagsrequired );
1329 my $is_adult = $patron->is_adult
1331 Return true if the patron has a category with a type Adult (A) or Organization (I)
1337 return $self->category->category_type =~ /^(A|I)$/ ? 1 : 0;
1342 my $is_child = $patron->is_child
1344 Return true if the patron has a category with a type Child (C)
1350 return $self->category->category_type eq 'C' ? 1 : 0;
1353 =head3 has_valid_userid
1355 my $patron = Koha::Patrons->find(42);
1356 $patron->userid( $new_userid );
1357 my $has_a_valid_userid = $patron->has_valid_userid
1359 my $patron = Koha::Patron->new( $params );
1360 my $has_a_valid_userid = $patron->has_valid_userid
1362 Return true if the current userid of this patron is valid/unique, otherwise false.
1364 Note that this should be done in $self->store instead and raise an exception if needed.
1368 sub has_valid_userid {
1371 return 0 unless $self->userid;
1373 return 0 if ( $self->userid eq C4::Context->config('user') ); # DB user
1375 my $already_exists = Koha::Patrons->search(
1377 userid => $self->userid,
1380 ? ( borrowernumber => { '!=' => $self->borrowernumber } )
1385 return $already_exists ? 0 : 1;
1388 =head3 generate_userid
1390 my $patron = Koha::Patron->new( $params );
1391 $patron->generate_userid
1393 Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
1395 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).
1399 sub generate_userid {
1402 my $firstname = $self->firstname // q{};
1403 my $surname = $self->surname // q{};
1404 #The script will "do" the following code and increment the $offset until the generated userid is unique
1406 $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1407 $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1408 my $userid = lc(($firstname)? "$firstname.$surname" : $surname);
1409 $userid = unac_string('utf-8',$userid);
1410 $userid .= $offset unless $offset == 0;
1411 $self->userid( $userid );
1413 } while (! $self->has_valid_userid );
1421 my $attributes = $patron->attributes
1423 Return object of Koha::Patron::Attributes type with all attributes set for this patron
1429 return Koha::Patron::Attributes->search({
1430 borrowernumber => $self->borrowernumber,
1431 branchcode => $self->branchcode,
1437 Koha::Patrons->find($id)->lock({ expire => 1, remove => 1 });
1439 Lock and optionally expire a patron account.
1440 Remove holds and article requests if remove flag set.
1441 In order to distinguish from locking by entering a wrong password, let's
1442 call this an administrative lockout.
1447 my ( $self, $params ) = @_;
1448 $self->login_attempts( ADMINISTRATIVE_LOCKOUT );
1449 if( $params->{expire} ) {
1450 $self->dateexpiry( dt_from_string->subtract(days => 1) );
1453 if( $params->{remove} ) {
1454 $self->holds->delete;
1455 $self->article_requests->delete;
1462 Koha::Patrons->find($id)->anonymize;
1464 Anonymize or clear borrower fields. Fields in BorrowerMandatoryField
1465 are randomized, other personal data is cleared too.
1466 Patrons with issues are skipped.
1472 if( $self->_result->issues->count ) {
1473 warn "Exiting anonymize: patron ".$self->borrowernumber." still has issues";
1476 # Mandatory fields come from the corresponding pref, but email fields
1477 # are removed since scrambled email addresses only generate errors
1478 my $mandatory = { map { (lc $_, 1); } grep { !/email/ }
1479 split /\s*\|\s*/, C4::Context->preference('BorrowerMandatoryField') };
1480 $mandatory->{userid} = 1; # needed since sub store does not clear field
1481 my @columns = $self->_result->result_source->columns;
1482 @columns = grep { !/borrowernumber|branchcode|categorycode|^date|password|flags|updated_on|lastseen|lang|login_attempts|anonymized/ } @columns;
1483 push @columns, 'dateofbirth'; # add this date back in
1484 foreach my $col (@columns) {
1485 $self->_anonymize_column($col, $mandatory->{lc $col} );
1487 $self->anonymized(1)->store;
1490 sub _anonymize_column {
1491 my ( $self, $col, $mandatory ) = @_;
1492 my $col_info = $self->_result->result_source->column_info($col);
1493 my $type = $col_info->{data_type};
1494 my $nullable = $col_info->{is_nullable};
1496 if( $type =~ /char|text/ ) {
1498 ? Koha::Token->new->generate({ pattern => '\w{10}' })
1502 } elsif( $type =~ /integer|int$|float|dec|double/ ) {
1503 $val = $nullable ? undef : 0;
1504 } elsif( $type =~ /date|time/ ) {
1505 $val = $nullable ? undef : dt_from_string;
1510 =head3 add_guarantor
1512 my @relationships = $patron->add_guarantor(
1514 borrowernumber => $borrowernumber,
1515 relationships => $relationship,
1519 Adds a new guarantor to a patron.
1524 my ( $self, $params ) = @_;
1526 my $guarantor_id = $params->{guarantor_id};
1527 my $relationship = $params->{relationship};
1529 return Koha::Patron::Relationship->new(
1531 guarantee_id => $self->id,
1532 guarantor_id => $guarantor_id,
1533 relationship => $relationship
1540 my $json = $patron->to_api;
1542 Overloaded method that returns a JSON representation of the Koha::Patron object,
1543 suitable for API output.
1550 my $json_patron = $self->SUPER::to_api;
1552 $json_patron->{restricted} = ( $self->is_debarred )
1554 : Mojo::JSON->false;
1556 return $json_patron;
1559 =head3 to_api_mapping
1561 This method returns the mapping for representing a Koha::Patron object
1566 sub to_api_mapping {
1568 borrowernotes => 'staff_notes',
1569 borrowernumber => 'patron_id',
1570 branchcode => 'library_id',
1571 categorycode => 'category_id',
1572 checkprevcheckout => 'check_previous_checkout',
1573 contactfirstname => undef, # Unused
1574 contactname => undef, # Unused
1575 contactnote => 'altaddress_notes',
1576 contacttitle => undef, # Unused
1577 dateenrolled => 'date_enrolled',
1578 dateexpiry => 'expiry_date',
1579 dateofbirth => 'date_of_birth',
1580 debarred => undef, # replaced by 'restricted'
1581 debarredcomment => undef, # calculated, API consumers will use /restrictions instead
1582 emailpro => 'secondary_email',
1583 flags => undef, # permissions manipulation handled in /permissions
1584 gonenoaddress => 'incorrect_address',
1585 guarantorid => 'guarantor_id',
1586 lastseen => 'last_seen',
1587 lost => 'patron_card_lost',
1588 opacnote => 'opac_notes',
1589 othernames => 'other_name',
1590 password => undef, # password manipulation handled in /password
1591 phonepro => 'secondary_phone',
1592 relationship => 'relationship_type',
1594 smsalertnumber => 'sms_number',
1595 sort1 => 'statistics_1',
1596 sort2 => 'statistics_2',
1597 streetnumber => 'street_number',
1598 streettype => 'street_type',
1599 zipcode => 'postal_code',
1600 B_address => 'altaddress_address',
1601 B_address2 => 'altaddress_address2',
1602 B_city => 'altaddress_city',
1603 B_country => 'altaddress_country',
1604 B_email => 'altaddress_email',
1605 B_phone => 'altaddress_phone',
1606 B_state => 'altaddress_state',
1607 B_streetnumber => 'altaddress_street_number',
1608 B_streettype => 'altaddress_street_type',
1609 B_zipcode => 'altaddress_postal_code',
1610 altcontactaddress1 => 'altcontact_address',
1611 altcontactaddress2 => 'altcontact_address2',
1612 altcontactaddress3 => 'altcontact_city',
1613 altcontactcountry => 'altcontact_country',
1614 altcontactfirstname => 'altcontact_firstname',
1615 altcontactphone => 'altcontact_phone',
1616 altcontactsurname => 'altcontact_surname',
1617 altcontactstate => 'altcontact_state',
1618 altcontactzipcode => 'altcontact_postal_code'
1622 =head2 Internal methods
1634 Kyle M Hall <kyle@bywatersolutions.com>
1635 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
1636 Martin Renvoize <martin.renvoize@ptfs-europe.com>