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 Unicode::Normalize;
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::Subscription::Routinglists;
49 use Koha::Virtualshelves;
51 use base qw(Koha::Object);
53 use constant ADMINISTRATIVE_LOCKOUT => -1;
55 our $RESULTSET_PATRON_ID_MAPPING = {
56 Accountline => 'borrowernumber',
57 Aqbasketuser => 'borrowernumber',
58 Aqbudget => 'budget_owner_id',
59 Aqbudgetborrower => 'borrowernumber',
60 ArticleRequest => 'borrowernumber',
61 BorrowerAttribute => 'borrowernumber',
62 BorrowerDebarment => 'borrowernumber',
63 BorrowerFile => 'borrowernumber',
64 BorrowerModification => 'borrowernumber',
65 ClubEnrollment => 'borrowernumber',
66 Issue => 'borrowernumber',
67 ItemsLastBorrower => 'borrowernumber',
68 Linktracker => 'borrowernumber',
69 Message => 'borrowernumber',
70 MessageQueue => 'borrowernumber',
71 OldIssue => 'borrowernumber',
72 OldReserve => 'borrowernumber',
73 Rating => 'borrowernumber',
74 Reserve => 'borrowernumber',
75 Review => 'borrowernumber',
76 SearchHistory => 'userid',
77 Statistic => 'borrowernumber',
78 Suggestion => 'suggestedby',
79 TagAll => 'borrowernumber',
80 Virtualshelfcontent => 'borrowernumber',
81 Virtualshelfshare => 'borrowernumber',
82 Virtualshelve => 'owner',
87 Koha::Patron - Koha Patron Object class
98 my ( $class, $params ) = @_;
100 return $class->SUPER::new($params);
103 =head3 fixup_cardnumber
105 Autogenerate next cardnumber from highest value found in database
109 sub fixup_cardnumber {
111 my $max = Koha::Patrons->search({
112 cardnumber => {-regexp => '^-?[0-9]+$'}
114 select => \'CAST(cardnumber AS SIGNED)',
115 as => ['cast_cardnumber']
116 })->_resultset->get_column('cast_cardnumber')->max;
117 $self->cardnumber(($max || 0) +1);
120 =head3 trim_whitespace
122 trim whitespace from data which has some non-whitespace in it.
123 Could be moved to Koha::Object if need to be reused
127 sub trim_whitespaces {
130 my $schema = Koha::Database->new->schema;
131 my @columns = $schema->source($self->_type)->columns;
133 for my $column( @columns ) {
134 my $value = $self->$column;
135 if ( defined $value ) {
136 $value =~ s/^\s*|\s*$//g;
137 $self->$column($value);
143 =head3 plain_text_password
145 $patron->plain_text_password( $password );
147 stores a copy of the unencrypted password in the object
148 for use in code before encrypting for db
152 sub plain_text_password {
153 my ( $self, $password ) = @_;
155 $self->{_plain_text_password} = $password;
158 return $self->{_plain_text_password}
159 if $self->{_plain_text_password};
166 Patron specific store method to cleanup record
167 and do other necessary things before saving
175 $self->_result->result_source->schema->txn_do(
178 C4::Context->preference("autoMemberNum")
179 and ( not defined $self->cardnumber
180 or $self->cardnumber eq '' )
183 # Warning: The caller is responsible for locking the members table in write
184 # mode, to avoid database corruption.
185 # We are in a transaction but the table is not locked
186 $self->fixup_cardnumber;
189 unless( $self->category->in_storage ) {
190 Koha::Exceptions::Object::FKConstraint->throw(
191 broken_fk => 'categorycode',
192 value => $self->categorycode,
196 $self->trim_whitespaces;
198 # Set surname to uppercase if uppercasesurname is true
199 $self->surname( uc($self->surname) )
200 if C4::Context->preference("uppercasesurnames");
202 $self->relationship(undef) # We do not want to store an empty string in this field
203 if defined $self->relationship
204 and $self->relationship eq "";
206 unless ( $self->in_storage ) { #AddMember
208 # Generate a valid userid/login if needed
209 $self->generate_userid
210 if not $self->userid or not $self->has_valid_userid;
212 # Add expiration date if it isn't already there
213 unless ( $self->dateexpiry ) {
214 $self->dateexpiry( $self->category->get_expiry_date );
217 # Add enrollment date if it isn't already there
218 unless ( $self->dateenrolled ) {
219 $self->dateenrolled(dt_from_string);
222 # Set the privacy depending on the patron's category
223 my $default_privacy = $self->category->default_privacy || q{};
225 $default_privacy eq 'default' ? 1
226 : $default_privacy eq 'never' ? 2
227 : $default_privacy eq 'forever' ? 0
229 $self->privacy($default_privacy);
231 # Call any check_password plugins if password is passed
232 if ( C4::Context->preference('UseKohaPlugins')
233 && C4::Context->config("enable_plugins")
236 my @plugins = Koha::Plugins->new()->GetPlugins({
237 method => 'check_password',
239 foreach my $plugin ( @plugins ) {
240 # This plugin hook will also be used by a plugin for the Norwegian national
241 # patron database. This is why we need to pass both the password and the
242 # borrowernumber to the plugin.
243 my $ret = $plugin->check_password(
245 password => $self->password,
246 borrowernumber => $self->borrowernumber
249 if ( $ret->{'error'} == 1 ) {
250 Koha::Exceptions::Password::Plugin->throw();
255 # Make a copy of the plain text password for later use
256 $self->plain_text_password( $self->password );
258 # Create a disabled account if no password provided
259 $self->password( $self->password
260 ? Koha::AuthUtils::hash_password( $self->password )
263 $self->borrowernumber(undef);
265 $self = $self->SUPER::store;
267 $self->add_enrolment_fee_if_needed(0);
269 logaction( "MEMBERS", "CREATE", $self->borrowernumber, "" )
270 if C4::Context->preference("BorrowersLog");
274 my $self_from_storage = $self->get_from_storage;
275 # FIXME We should not deal with that here, callers have to do this job
276 # Moved from ModMember to prevent regressions
277 unless ( $self->userid ) {
278 my $stored_userid = $self_from_storage->userid;
279 $self->userid($stored_userid);
282 # Password must be updated using $self->set_password
283 $self->password($self_from_storage->password);
285 if ( $self->category->categorycode ne
286 $self_from_storage->category->categorycode )
288 # Add enrolement fee on category change if required
289 $self->add_enrolment_fee_if_needed(1)
290 if C4::Context->preference('FeeOnChangePatronCategory');
292 # Clean up guarantors on category change if required
293 $self->guarantor_relationships->delete
294 if ( $self->category->category_type ne 'C'
295 && $self->category->category_type ne 'P' );
300 if ( C4::Context->preference("BorrowersLog") ) {
302 my $from_storage = $self_from_storage->unblessed;
303 my $from_object = $self->unblessed;
304 my @skip_fields = (qw/lastseen updated_on/);
305 for my $key ( keys %{$from_storage} ) {
306 next if any { /$key/ } @skip_fields;
309 !defined( $from_storage->{$key} )
310 && defined( $from_object->{$key} )
312 || ( defined( $from_storage->{$key} )
313 && !defined( $from_object->{$key} ) )
315 defined( $from_storage->{$key} )
316 && defined( $from_object->{$key} )
317 && ( $from_storage->{$key} ne
318 $from_object->{$key} )
323 before => $from_storage->{$key},
324 after => $from_object->{$key}
329 if ( defined($info) ) {
333 $self->borrowernumber,
336 { utf8 => 1, pretty => 1, canonical => 1 }
343 $self = $self->SUPER::store;
354 Delete patron's holds, lists and finally the patron.
356 Lists owned by the borrower are deleted, but entries from the borrower to
357 other lists are kept.
365 $self->_result->result_source->schema->txn_do(
367 # Cancel Patron's holds
368 my $holds = $self->holds;
369 while( my $hold = $holds->next ){
373 # Delete all lists and all shares of this borrower
374 # Consistent with the approach Koha uses on deleting individual lists
375 # Note that entries in virtualshelfcontents added by this borrower to
376 # lists of others will be handled by a table constraint: the borrower
377 # is set to NULL in those entries.
379 # We could handle the above deletes via a constraint too.
380 # But a new BZ report 11889 has been opened to discuss another approach.
381 # Instead of deleting we could also disown lists (based on a pref).
382 # In that way we could save shared and public lists.
383 # The current table constraints support that idea now.
384 # This pref should then govern the results of other routines/methods such as
385 # Koha::Virtualshelf->new->delete too.
386 # FIXME Could be $patron->get_lists
387 $_->delete for Koha::Virtualshelves->search( { owner => $self->borrowernumber } );
389 $deleted = $self->SUPER::delete;
391 logaction( "MEMBERS", "DELETE", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog");
400 my $patron_category = $patron->category
402 Return the patron category for this patron
408 return Koha::Patron::Category->_new_from_dbic( $self->_result->categorycode );
418 return scalar Koha::Patron::Images->find( $self->borrowernumber );
423 Returns a Koha::Library object representing the patron's home library.
429 return Koha::Library->_new_from_dbic($self->_result->branchcode);
432 =head3 guarantor_relationships
434 Returns Koha::Patron::Relationships object for this patron's guarantors
436 Returns the set of relationships for the patrons that are guarantors for this patron.
438 This is returned instead of a Koha::Patron object because the guarantor
439 may not exist as a patron in Koha. If this is true, the guarantors name
440 exists in the Koha::Patron::Relationship object and will have no guarantor_id.
444 sub guarantor_relationships {
447 return Koha::Patron::Relationships->search( { guarantee_id => $self->id } );
450 =head3 guarantee_relationships
452 Returns Koha::Patron::Relationships object for this patron's guarantors
454 Returns the set of relationships for the patrons that are guarantees for this patron.
456 The method returns Koha::Patron::Relationship objects for the sake
457 of consistency with the guantors method.
458 A guarantee by definition must exist as a patron in Koha.
462 sub guarantee_relationships {
465 return Koha::Patron::Relationships->search(
466 { guarantor_id => $self->id },
468 prefetch => 'guarantee',
469 order_by => { -asc => [ 'guarantee.surname', 'guarantee.firstname' ] },
474 =head3 housebound_profile
476 Returns the HouseboundProfile associated with this patron.
480 sub housebound_profile {
482 my $profile = $self->_result->housebound_profile;
483 return Koha::Patron::HouseboundProfile->_new_from_dbic($profile)
488 =head3 housebound_role
490 Returns the HouseboundRole associated with this patron.
494 sub housebound_role {
497 my $role = $self->_result->housebound_role;
498 return Koha::Patron::HouseboundRole->_new_from_dbic($role) if ( $role );
504 Returns the siblings of this patron.
511 my @guarantors = $self->guarantor_relationships()->guarantors();
513 return unless @guarantors;
516 map { $_->guarantee_relationships()->guarantees() } @guarantors;
518 return unless @siblings;
522 grep { !$seen{ $_->id }++ && ( $_->id != $self->id ) } @siblings;
524 return wantarray ? @siblings : Koha::Patrons->search( { borrowernumber => { -in => [ map { $_->id } @siblings ] } } );
529 my $patron = Koha::Patrons->find($id);
530 $patron->merge_with( \@patron_ids );
532 This subroutine merges a list of patrons into the patron record. This is accomplished by finding
533 all related patron ids for the patrons to be merged in other tables and changing the ids to be that
534 of the keeper patron.
539 my ( $self, $patron_ids ) = @_;
541 my @patron_ids = @{ $patron_ids };
543 # Ensure the keeper isn't in the list of patrons to merge
544 @patron_ids = grep { $_ ne $self->id } @patron_ids;
546 my $schema = Koha::Database->new()->schema();
550 $self->_result->result_source->schema->txn_do( sub {
551 foreach my $patron_id (@patron_ids) {
552 my $patron = Koha::Patrons->find( $patron_id );
556 # Unbless for safety, the patron will end up being deleted
557 $results->{merged}->{$patron_id}->{patron} = $patron->unblessed;
559 while (my ($r, $field) = each(%$RESULTSET_PATRON_ID_MAPPING)) {
560 my $rs = $schema->resultset($r)->search({ $field => $patron_id });
561 $results->{merged}->{ $patron_id }->{updated}->{$r} = $rs->count();
562 $rs->update({ $field => $self->id });
565 $patron->move_to_deleted();
575 =head3 wants_check_for_previous_checkout
577 $wants_check = $patron->wants_check_for_previous_checkout;
579 Return 1 if Koha needs to perform PrevIssue checking, else 0.
583 sub wants_check_for_previous_checkout {
585 my $syspref = C4::Context->preference("checkPrevCheckout");
588 ## Hard syspref trumps all
589 return 1 if ($syspref eq 'hardyes');
590 return 0 if ($syspref eq 'hardno');
591 ## Now, patron pref trumps all
592 return 1 if ($self->checkprevcheckout eq 'yes');
593 return 0 if ($self->checkprevcheckout eq 'no');
595 # More complex: patron inherits -> determine category preference
596 my $checkPrevCheckoutByCat = $self->category->checkprevcheckout;
597 return 1 if ($checkPrevCheckoutByCat eq 'yes');
598 return 0 if ($checkPrevCheckoutByCat eq 'no');
600 # Finally: category preference is inherit, default to 0
601 if ($syspref eq 'softyes') {
608 =head3 do_check_for_previous_checkout
610 $do_check = $patron->do_check_for_previous_checkout($item);
612 Return 1 if the bib associated with $ITEM has previously been checked out to
613 $PATRON, 0 otherwise.
617 sub do_check_for_previous_checkout {
618 my ( $self, $item ) = @_;
621 my $biblio = Koha::Biblios->find( $item->{biblionumber} );
622 if ( $biblio->is_serial ) {
623 push @item_nos, $item->{itemnumber};
625 # Get all itemnumbers for given bibliographic record.
626 @item_nos = $biblio->items->get_column( 'itemnumber' );
629 # Create (old)issues search criteria
631 borrowernumber => $self->borrowernumber,
632 itemnumber => \@item_nos,
635 # Check current issues table
636 my $issues = Koha::Checkouts->search($criteria);
637 return 1 if $issues->count; # 0 || N
639 # Check old issues table
640 my $old_issues = Koha::Old::Checkouts->search($criteria);
641 return $old_issues->count; # 0 || N
646 my $debarment_expiration = $patron->is_debarred;
648 Returns the date a patron debarment will expire, or undef if the patron is not
656 return unless $self->debarred;
657 return $self->debarred
658 if $self->debarred =~ '^9999'
659 or dt_from_string( $self->debarred ) > dt_from_string;
665 my $is_expired = $patron->is_expired;
667 Returns 1 if the patron is expired or 0;
673 return 0 unless $self->dateexpiry;
674 return 0 if $self->dateexpiry =~ '^9999';
675 return 1 if dt_from_string( $self->dateexpiry ) < dt_from_string->truncate( to => 'day' );
679 =head3 is_going_to_expire
681 my $is_going_to_expire = $patron->is_going_to_expire;
683 Returns 1 if the patron is going to expired, depending on the NotifyBorrowerDeparture pref or 0
687 sub is_going_to_expire {
690 my $delay = C4::Context->preference('NotifyBorrowerDeparture') || 0;
692 return 0 unless $delay;
693 return 0 unless $self->dateexpiry;
694 return 0 if $self->dateexpiry =~ '^9999';
695 return 1 if dt_from_string( $self->dateexpiry, undef, 'floating' )->subtract( days => $delay ) < dt_from_string(undef, undef, 'floating')->truncate( to => 'day' );
701 $patron->set_password({ password => $plain_text_password [, skip_validation => 1 ] });
703 Set the patron's password.
707 The passed string is validated against the current password enforcement policy.
708 Validation can be skipped by passing the I<skip_validation> parameter.
710 Exceptions are thrown if the password is not good enough.
714 =item Koha::Exceptions::Password::TooShort
716 =item Koha::Exceptions::Password::WhitespaceCharacters
718 =item Koha::Exceptions::Password::TooWeak
720 =item Koha::Exceptions::Password::Plugin (if a "check password" plugin is enabled)
727 my ( $self, $args ) = @_;
729 my $password = $args->{password};
731 unless ( $args->{skip_validation} ) {
732 my ( $is_valid, $error ) = Koha::AuthUtils::is_password_valid( $password );
735 if ( $error eq 'too_short' ) {
736 my $min_length = C4::Context->preference('minPasswordLength');
737 $min_length = 3 if not $min_length or $min_length < 3;
739 my $password_length = length($password);
740 Koha::Exceptions::Password::TooShort->throw(
741 length => $password_length, min_length => $min_length );
743 elsif ( $error eq 'has_whitespaces' ) {
744 Koha::Exceptions::Password::WhitespaceCharacters->throw();
746 elsif ( $error eq 'too_weak' ) {
747 Koha::Exceptions::Password::TooWeak->throw();
752 if ( C4::Context->preference('UseKohaPlugins') && C4::Context->config("enable_plugins") ) {
753 # Call any check_password plugins
754 my @plugins = Koha::Plugins->new()->GetPlugins({
755 method => 'check_password',
757 foreach my $plugin ( @plugins ) {
758 # This plugin hook will also be used by a plugin for the Norwegian national
759 # patron database. This is why we need to pass both the password and the
760 # borrowernumber to the plugin.
761 my $ret = $plugin->check_password(
763 password => $password,
764 borrowernumber => $self->borrowernumber
767 # This plugin hook will also be used by a plugin for the Norwegian national
768 # patron database. This is why we need to call the actual plugins and then
769 # check skip_validation afterwards.
770 if ( $ret->{'error'} == 1 && !$args->{skip_validation} ) {
771 Koha::Exceptions::Password::Plugin->throw();
776 my $digest = Koha::AuthUtils::hash_password($password);
778 { password => $digest,
783 logaction( "MEMBERS", "CHANGE PASS", $self->borrowernumber, "" )
784 if C4::Context->preference("BorrowersLog");
792 my $new_expiry_date = $patron->renew_account
794 Extending the subscription to the expiry date.
801 if ( C4::Context->preference('BorrowerRenewalPeriodBase') eq 'combination' ) {
802 $date = ( dt_from_string gt dt_from_string( $self->dateexpiry ) ) ? dt_from_string : dt_from_string( $self->dateexpiry );
805 C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry'
806 ? dt_from_string( $self->dateexpiry )
809 my $expiry_date = $self->category->get_expiry_date($date);
811 $self->dateexpiry($expiry_date);
812 $self->date_renewed( dt_from_string() );
815 $self->add_enrolment_fee_if_needed(1);
817 logaction( "MEMBERS", "RENEW", $self->borrowernumber, "Membership renewed" ) if C4::Context->preference("BorrowersLog");
818 return dt_from_string( $expiry_date )->truncate( to => 'day' );
823 my $has_overdues = $patron->has_overdues;
825 Returns the number of patron's overdues
831 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
832 return $self->_result->issues->search({ date_due => { '<' => $dtf->format_datetime( dt_from_string() ) } })->count;
837 $patron->track_login;
838 $patron->track_login({ force => 1 });
840 Tracks a (successful) login attempt.
841 The preference TrackLastPatronActivity must be enabled. Or you
842 should pass the force parameter.
847 my ( $self, $params ) = @_;
850 !C4::Context->preference('TrackLastPatronActivity');
851 $self->lastseen( dt_from_string() )->store;
854 =head3 move_to_deleted
856 my $is_moved = $patron->move_to_deleted;
858 Move a patron to the deletedborrowers table.
859 This can be done before deleting a patron, to make sure the data are not completely deleted.
863 sub move_to_deleted {
865 my $patron_infos = $self->unblessed;
866 delete $patron_infos->{updated_on}; #This ensures the updated_on date in deletedborrowers will be set to the current timestamp
867 return Koha::Database->new->schema->resultset('Deletedborrower')->create($patron_infos);
870 =head3 article_requests
872 my @requests = $borrower->article_requests();
873 my $requests = $borrower->article_requests();
875 Returns either a list of ArticleRequests objects,
876 or an ArtitleRequests object, depending on the
881 sub article_requests {
884 $self->{_article_requests} ||= Koha::ArticleRequests->search({ borrowernumber => $self->borrowernumber() });
886 return $self->{_article_requests};
889 =head3 article_requests_current
891 my @requests = $patron->article_requests_current
893 Returns the article requests associated with this patron that are incomplete
897 sub article_requests_current {
900 $self->{_article_requests_current} ||= Koha::ArticleRequests->search(
902 borrowernumber => $self->id(),
904 { status => Koha::ArticleRequest::Status::Pending },
905 { status => Koha::ArticleRequest::Status::Processing }
910 return $self->{_article_requests_current};
913 =head3 article_requests_finished
915 my @requests = $biblio->article_requests_finished
917 Returns the article requests associated with this patron that are completed
921 sub article_requests_finished {
922 my ( $self, $borrower ) = @_;
924 $self->{_article_requests_finished} ||= Koha::ArticleRequests->search(
926 borrowernumber => $self->id(),
928 { status => Koha::ArticleRequest::Status::Completed },
929 { status => Koha::ArticleRequest::Status::Canceled }
934 return $self->{_article_requests_finished};
937 =head3 add_enrolment_fee_if_needed
939 my $enrolment_fee = $patron->add_enrolment_fee_if_needed($renewal);
941 Add enrolment fee for a patron if needed.
943 $renewal - boolean denoting whether this is an account renewal or not
947 sub add_enrolment_fee_if_needed {
948 my ($self, $renewal) = @_;
949 my $enrolment_fee = $self->category->enrolmentfee;
950 if ( $enrolment_fee && $enrolment_fee > 0 ) {
951 my $type = $renewal ? 'ACCOUNT_RENEW' : 'ACCOUNT';
952 $self->account->add_debit(
954 amount => $enrolment_fee,
955 user_id => C4::Context->userenv ? C4::Context->userenv->{'number'} : undef,
956 interface => C4::Context->interface,
957 library_id => C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef,
962 return $enrolment_fee || 0;
967 my $checkouts = $patron->checkouts
973 my $checkouts = $self->_result->issues;
974 return Koha::Checkouts->_new_from_dbic( $checkouts );
977 =head3 pending_checkouts
979 my $pending_checkouts = $patron->pending_checkouts
981 This method will return the same as $self->checkouts, but with a prefetch on
982 items, biblio and biblioitems.
984 It has been introduced to replaced the C4::Members::GetPendingIssues subroutine
986 It should not be used directly, prefer to access fields you need instead of
987 retrieving all these fields in one go.
991 sub pending_checkouts {
993 my $checkouts = $self->_result->issues->search(
997 { -desc => 'me.timestamp' },
998 { -desc => 'issuedate' },
999 { -desc => 'issue_id' }, # Sort by issue_id should be enough
1001 prefetch => { item => { biblio => 'biblioitems' } },
1004 return Koha::Checkouts->_new_from_dbic( $checkouts );
1007 =head3 old_checkouts
1009 my $old_checkouts = $patron->old_checkouts
1015 my $old_checkouts = $self->_result->old_issues;
1016 return Koha::Old::Checkouts->_new_from_dbic( $old_checkouts );
1021 my $overdue_items = $patron->get_overdues
1023 Return the overdue items
1029 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
1030 return $self->checkouts->search(
1032 'me.date_due' => { '<' => $dtf->format_datetime(dt_from_string) },
1035 prefetch => { item => { biblio => 'biblioitems' } },
1040 =head3 get_routing_lists
1042 my @routinglists = $patron->get_routing_lists
1044 Returns the routing lists a patron is subscribed to.
1048 sub get_routing_lists {
1050 my $routing_list_rs = $self->_result->subscriptionroutinglists;
1051 return Koha::Subscription::Routinglists->_new_from_dbic($routing_list_rs);
1056 my $age = $patron->get_age
1058 Return the age of the patron
1064 my $today_str = dt_from_string->strftime("%Y-%m-%d");
1065 return unless $self->dateofbirth;
1066 my $dob_str = dt_from_string( $self->dateofbirth )->strftime("%Y-%m-%d");
1068 my ( $dob_y, $dob_m, $dob_d ) = split /-/, $dob_str;
1069 my ( $today_y, $today_m, $today_d ) = split /-/, $today_str;
1071 my $age = $today_y - $dob_y;
1072 if ( $dob_m . $dob_d > $today_m . $today_d ) {
1081 my $is_valid = $patron->is_valid_age
1083 Return 1 if patron's age is between allowed limits, returns 0 if it's not.
1089 my $age = $self->get_age;
1091 my $patroncategory = $self->category;
1092 my ($low,$high) = ($patroncategory->dateofbirthrequired, $patroncategory->upperagelimit);
1094 return (defined($age) && (($high && ($age > $high)) or ($age < $low))) ? 0 : 1;
1099 my $account = $patron->account
1105 return Koha::Account->new( { patron_id => $self->borrowernumber } );
1110 my $holds = $patron->holds
1112 Return all the holds placed by this patron
1118 my $holds_rs = $self->_result->reserves->search( {}, { order_by => 'reservedate' } );
1119 return Koha::Holds->_new_from_dbic($holds_rs);
1124 my $old_holds = $patron->old_holds
1126 Return all the historical holds for this patron
1132 my $old_holds_rs = $self->_result->old_reserves->search( {}, { order_by => 'reservedate' } );
1133 return Koha::Old::Holds->_new_from_dbic($old_holds_rs);
1136 =head3 return_claims
1138 my $return_claims = $patron->return_claims
1144 my $return_claims = $self->_result->return_claims_borrowernumbers;
1145 return Koha::Checkouts::ReturnClaims->_new_from_dbic( $return_claims );
1148 =head3 notice_email_address
1150 my $email = $patron->notice_email_address;
1152 Return the email address of patron used for notices.
1153 Returns the empty string if no email address.
1157 sub notice_email_address{
1160 my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
1161 # if syspref is set to 'first valid' (value == OFF), look up email address
1162 if ( $which_address eq 'OFF' ) {
1163 return $self->first_valid_email_address;
1166 return $self->$which_address || '';
1169 =head3 first_valid_email_address
1171 my $first_valid_email_address = $patron->first_valid_email_address
1173 Return the first valid email address for a patron.
1174 For now, the order is defined as email, emailpro, B_email.
1175 Returns the empty string if the borrower has no email addresses.
1179 sub first_valid_email_address {
1182 return $self->email() || $self->emailpro() || $self->B_email() || q{};
1185 =head3 get_club_enrollments
1189 sub get_club_enrollments {
1190 my ( $self, $return_scalar ) = @_;
1192 my $e = Koha::Club::Enrollments->search( { borrowernumber => $self->borrowernumber(), date_canceled => undef } );
1194 return $e if $return_scalar;
1196 return wantarray ? $e->as_list : $e;
1199 =head3 get_enrollable_clubs
1203 sub get_enrollable_clubs {
1204 my ( $self, $is_enrollable_from_opac, $return_scalar ) = @_;
1207 $params->{is_enrollable_from_opac} = $is_enrollable_from_opac
1208 if $is_enrollable_from_opac;
1209 $params->{is_email_required} = 0 unless $self->first_valid_email_address();
1211 $params->{borrower} = $self;
1213 my $e = Koha::Clubs->get_enrollable($params);
1215 return $e if $return_scalar;
1217 return wantarray ? $e->as_list : $e;
1220 =head3 account_locked
1222 my $is_locked = $patron->account_locked
1224 Return true if the patron has reached the maximum number of login attempts
1225 (see pref FailedLoginAttempts). If login_attempts is < 0, this is interpreted
1226 as an administrative lockout (independent of FailedLoginAttempts; see also
1227 Koha::Patron->lock).
1228 Otherwise return false.
1229 If the pref is not set (empty string, null or 0), the feature is considered as
1234 sub account_locked {
1236 my $FailedLoginAttempts = C4::Context->preference('FailedLoginAttempts');
1237 return 1 if $FailedLoginAttempts
1238 and $self->login_attempts
1239 and $self->login_attempts >= $FailedLoginAttempts;
1240 return 1 if ($self->login_attempts || 0) < 0; # administrative lockout
1244 =head3 can_see_patron_infos
1246 my $can_see = $patron->can_see_patron_infos( $patron );
1248 Return true if the patron (usually the logged in user) can see the patron's infos for a given patron
1252 sub can_see_patron_infos {
1253 my ( $self, $patron ) = @_;
1254 return unless $patron;
1255 return $self->can_see_patrons_from( $patron->library->branchcode );
1258 =head3 can_see_patrons_from
1260 my $can_see = $patron->can_see_patrons_from( $branchcode );
1262 Return true if the patron (usually the logged in user) can see the patron's infos from a given library
1266 sub can_see_patrons_from {
1267 my ( $self, $branchcode ) = @_;
1269 if ( $self->branchcode eq $branchcode ) {
1271 } elsif ( $self->has_permission( { borrowers => 'view_borrower_infos_from_any_libraries' } ) ) {
1273 } elsif ( my $library_groups = $self->library->library_groups ) {
1274 while ( my $library_group = $library_groups->next ) {
1275 if ( $library_group->parent->has_child( $branchcode ) ) {
1284 =head3 libraries_where_can_see_patrons
1286 my $libraries = $patron-libraries_where_can_see_patrons;
1288 Return the list of branchcodes(!) of libraries the patron is allowed to see other patron's infos.
1289 The branchcodes are arbitrarily returned sorted.
1290 We are supposing here that the object is related to the logged in patron (use of C4::Context::only_my_library)
1292 An empty array means no restriction, the patron can see patron's infos from any libraries.
1296 sub libraries_where_can_see_patrons {
1298 my $userenv = C4::Context->userenv;
1300 return () unless $userenv; # For tests, but userenv should be defined in tests...
1302 my @restricted_branchcodes;
1303 if (C4::Context::only_my_library) {
1304 push @restricted_branchcodes, $self->branchcode;
1308 $self->has_permission(
1309 { borrowers => 'view_borrower_infos_from_any_libraries' }
1313 my $library_groups = $self->library->library_groups({ ft_hide_patron_info => 1 });
1314 if ( $library_groups->count )
1316 while ( my $library_group = $library_groups->next ) {
1317 my $parent = $library_group->parent;
1318 if ( $parent->has_child( $self->branchcode ) ) {
1319 push @restricted_branchcodes, $parent->children->get_column('branchcode');
1324 @restricted_branchcodes = ( $self->branchcode ) unless @restricted_branchcodes;
1328 @restricted_branchcodes = grep { defined $_ } @restricted_branchcodes;
1329 @restricted_branchcodes = uniq(@restricted_branchcodes);
1330 @restricted_branchcodes = sort(@restricted_branchcodes);
1331 return @restricted_branchcodes;
1334 sub has_permission {
1335 my ( $self, $flagsrequired ) = @_;
1336 return unless $self->userid;
1337 # TODO code from haspermission needs to be moved here!
1338 return C4::Auth::haspermission( $self->userid, $flagsrequired );
1343 my $is_adult = $patron->is_adult
1345 Return true if the patron has a category with a type Adult (A) or Organization (I)
1351 return $self->category->category_type =~ /^(A|I)$/ ? 1 : 0;
1356 my $is_child = $patron->is_child
1358 Return true if the patron has a category with a type Child (C)
1364 return $self->category->category_type eq 'C' ? 1 : 0;
1367 =head3 has_valid_userid
1369 my $patron = Koha::Patrons->find(42);
1370 $patron->userid( $new_userid );
1371 my $has_a_valid_userid = $patron->has_valid_userid
1373 my $patron = Koha::Patron->new( $params );
1374 my $has_a_valid_userid = $patron->has_valid_userid
1376 Return true if the current userid of this patron is valid/unique, otherwise false.
1378 Note that this should be done in $self->store instead and raise an exception if needed.
1382 sub has_valid_userid {
1385 return 0 unless $self->userid;
1387 return 0 if ( $self->userid eq C4::Context->config('user') ); # DB user
1389 my $already_exists = Koha::Patrons->search(
1391 userid => $self->userid,
1394 ? ( borrowernumber => { '!=' => $self->borrowernumber } )
1399 return $already_exists ? 0 : 1;
1402 =head3 generate_userid
1404 my $patron = Koha::Patron->new( $params );
1405 $patron->generate_userid
1407 Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
1409 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).
1413 sub generate_userid {
1416 my $firstname = $self->firstname // q{};
1417 my $surname = $self->surname // q{};
1418 #The script will "do" the following code and increment the $offset until the generated userid is unique
1420 $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1421 $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1422 my $userid = lc(($firstname)? "$firstname.$surname" : $surname);
1423 $userid = NFKD( $userid );
1424 $userid =~ s/\p{NonspacingMark}//g;
1425 $userid .= $offset unless $offset == 0;
1426 $self->userid( $userid );
1428 } while (! $self->has_valid_userid );
1435 my $attributes = $patron->attributes
1437 Return object of Koha::Patron::Attributes type with all attributes set for this patron
1443 return Koha::Patron::Attributes->search({
1444 borrowernumber => $self->borrowernumber,
1445 branchcode => $self->branchcode,
1451 Koha::Patrons->find($id)->lock({ expire => 1, remove => 1 });
1453 Lock and optionally expire a patron account.
1454 Remove holds and article requests if remove flag set.
1455 In order to distinguish from locking by entering a wrong password, let's
1456 call this an administrative lockout.
1461 my ( $self, $params ) = @_;
1462 $self->login_attempts( ADMINISTRATIVE_LOCKOUT );
1463 if( $params->{expire} ) {
1464 $self->dateexpiry( dt_from_string->subtract(days => 1) );
1467 if( $params->{remove} ) {
1468 $self->holds->delete;
1469 $self->article_requests->delete;
1476 Koha::Patrons->find($id)->anonymize;
1478 Anonymize or clear borrower fields. Fields in BorrowerMandatoryField
1479 are randomized, other personal data is cleared too.
1480 Patrons with issues are skipped.
1486 if( $self->_result->issues->count ) {
1487 warn "Exiting anonymize: patron ".$self->borrowernumber." still has issues";
1490 # Mandatory fields come from the corresponding pref, but email fields
1491 # are removed since scrambled email addresses only generate errors
1492 my $mandatory = { map { (lc $_, 1); } grep { !/email/ }
1493 split /\s*\|\s*/, C4::Context->preference('BorrowerMandatoryField') };
1494 $mandatory->{userid} = 1; # needed since sub store does not clear field
1495 my @columns = $self->_result->result_source->columns;
1496 @columns = grep { !/borrowernumber|branchcode|categorycode|^date|password|flags|updated_on|lastseen|lang|login_attempts|anonymized/ } @columns;
1497 push @columns, 'dateofbirth'; # add this date back in
1498 foreach my $col (@columns) {
1499 $self->_anonymize_column($col, $mandatory->{lc $col} );
1501 $self->anonymized(1)->store;
1504 sub _anonymize_column {
1505 my ( $self, $col, $mandatory ) = @_;
1506 my $col_info = $self->_result->result_source->column_info($col);
1507 my $type = $col_info->{data_type};
1508 my $nullable = $col_info->{is_nullable};
1510 if( $type =~ /char|text/ ) {
1512 ? Koha::Token->new->generate({ pattern => '\w{10}' })
1516 } elsif( $type =~ /integer|int$|float|dec|double/ ) {
1517 $val = $nullable ? undef : 0;
1518 } elsif( $type =~ /date|time/ ) {
1519 $val = $nullable ? undef : dt_from_string;
1524 =head3 add_guarantor
1526 my @relationships = $patron->add_guarantor(
1528 borrowernumber => $borrowernumber,
1529 relationships => $relationship,
1533 Adds a new guarantor to a patron.
1538 my ( $self, $params ) = @_;
1540 my $guarantor_id = $params->{guarantor_id};
1541 my $relationship = $params->{relationship};
1543 return Koha::Patron::Relationship->new(
1545 guarantee_id => $self->id,
1546 guarantor_id => $guarantor_id,
1547 relationship => $relationship
1554 my $json = $patron->to_api;
1556 Overloaded method that returns a JSON representation of the Koha::Patron object,
1557 suitable for API output.
1564 my $json_patron = $self->SUPER::to_api;
1566 $json_patron->{restricted} = ( $self->is_debarred )
1568 : Mojo::JSON->false;
1570 return $json_patron;
1573 =head3 to_api_mapping
1575 This method returns the mapping for representing a Koha::Patron object
1580 sub to_api_mapping {
1582 borrowernotes => 'staff_notes',
1583 borrowernumber => 'patron_id',
1584 branchcode => 'library_id',
1585 categorycode => 'category_id',
1586 checkprevcheckout => 'check_previous_checkout',
1587 contactfirstname => undef, # Unused
1588 contactname => undef, # Unused
1589 contactnote => 'altaddress_notes',
1590 contacttitle => undef, # Unused
1591 dateenrolled => 'date_enrolled',
1592 dateexpiry => 'expiry_date',
1593 dateofbirth => 'date_of_birth',
1594 debarred => undef, # replaced by 'restricted'
1595 debarredcomment => undef, # calculated, API consumers will use /restrictions instead
1596 emailpro => 'secondary_email',
1597 flags => undef, # permissions manipulation handled in /permissions
1598 gonenoaddress => 'incorrect_address',
1599 guarantorid => 'guarantor_id',
1600 lastseen => 'last_seen',
1601 lost => 'patron_card_lost',
1602 opacnote => 'opac_notes',
1603 othernames => 'other_name',
1604 password => undef, # password manipulation handled in /password
1605 phonepro => 'secondary_phone',
1606 relationship => 'relationship_type',
1608 smsalertnumber => 'sms_number',
1609 sort1 => 'statistics_1',
1610 sort2 => 'statistics_2',
1611 streetnumber => 'street_number',
1612 streettype => 'street_type',
1613 zipcode => 'postal_code',
1614 B_address => 'altaddress_address',
1615 B_address2 => 'altaddress_address2',
1616 B_city => 'altaddress_city',
1617 B_country => 'altaddress_country',
1618 B_email => 'altaddress_email',
1619 B_phone => 'altaddress_phone',
1620 B_state => 'altaddress_state',
1621 B_streetnumber => 'altaddress_street_number',
1622 B_streettype => 'altaddress_street_type',
1623 B_zipcode => 'altaddress_postal_code',
1624 altcontactaddress1 => 'altcontact_address',
1625 altcontactaddress2 => 'altcontact_address2',
1626 altcontactaddress3 => 'altcontact_city',
1627 altcontactcountry => 'altcontact_country',
1628 altcontactfirstname => 'altcontact_firstname',
1629 altcontactphone => 'altcontact_phone',
1630 altcontactsurname => 'altcontact_surname',
1631 altcontactstate => 'altcontact_state',
1632 altcontactzipcode => 'altcontact_postal_code'
1636 =head2 Internal methods
1648 Kyle M Hall <kyle@bywatersolutions.com>
1649 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
1650 Martin Renvoize <martin.renvoize@ptfs-europe.com>