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
::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 unless ( $self->in_storage ) { #AddMember
204 # Generate a valid userid/login if needed
205 $self->generate_userid
206 if not $self->userid or not $self->has_valid_userid;
208 # Add expiration date if it isn't already there
209 unless ( $self->dateexpiry ) {
210 $self->dateexpiry( $self->category->get_expiry_date );
213 # Add enrollment date if it isn't already there
214 unless ( $self->dateenrolled ) {
215 $self->dateenrolled(dt_from_string
);
218 # Set the privacy depending on the patron's category
219 my $default_privacy = $self->category->default_privacy || q{};
221 $default_privacy eq 'default' ?
1
222 : $default_privacy eq 'never' ?
2
223 : $default_privacy eq 'forever' ?
0
225 $self->privacy($default_privacy);
227 # Call any check_password plugins if password is passed
228 if ( C4
::Context
->preference('UseKohaPlugins')
229 && C4
::Context
->config("enable_plugins")
232 my @plugins = Koha
::Plugins
->new()->GetPlugins({
233 method
=> 'check_password',
235 foreach my $plugin ( @plugins ) {
236 # This plugin hook will also be used by a plugin for the Norwegian national
237 # patron database. This is why we need to pass both the password and the
238 # borrowernumber to the plugin.
239 my $ret = $plugin->check_password(
241 password
=> $self->password,
242 borrowernumber
=> $self->borrowernumber
245 if ( $ret->{'error'} == 1 ) {
246 Koha
::Exceptions
::Password
::Plugin
->throw();
251 # Make a copy of the plain text password for later use
252 $self->plain_text_password( $self->password );
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.
360 $self->_result->result_source->schema->txn_do(
362 # Cancel Patron's holds
363 my $holds = $self->holds;
364 while( my $hold = $holds->next ){
368 # Delete all lists and all shares of this borrower
369 # Consistent with the approach Koha uses on deleting individual lists
370 # Note that entries in virtualshelfcontents added by this borrower to
371 # lists of others will be handled by a table constraint: the borrower
372 # is set to NULL in those entries.
374 # We could handle the above deletes via a constraint too.
375 # But a new BZ report 11889 has been opened to discuss another approach.
376 # Instead of deleting we could also disown lists (based on a pref).
377 # In that way we could save shared and public lists.
378 # The current table constraints support that idea now.
379 # This pref should then govern the results of other routines/methods such as
380 # Koha::Virtualshelf->new->delete too.
381 # FIXME Could be $patron->get_lists
382 $_->delete for Koha
::Virtualshelves
->search( { owner
=> $self->borrowernumber } );
384 $self->SUPER::delete;
386 logaction
( "MEMBERS", "DELETE", $self->borrowernumber, "" ) if C4
::Context
->preference("BorrowersLog");
395 my $patron_category = $patron->category
397 Return the patron category for this patron
403 return Koha
::Patron
::Category
->_new_from_dbic( $self->_result->categorycode );
413 return scalar Koha
::Patron
::Images
->find( $self->borrowernumber );
418 Returns a Koha::Library object representing the patron's home library.
424 return Koha
::Library
->_new_from_dbic($self->_result->branchcode);
427 =head3 guarantor_relationships
429 Returns Koha::Patron::Relationships object for this patron's guarantors
431 Returns the set of relationships for the patrons that are guarantors for this patron.
433 This is returned instead of a Koha::Patron object because the guarantor
434 may not exist as a patron in Koha. If this is true, the guarantors name
435 exists in the Koha::Patron::Relationship object and will have no guarantor_id.
439 sub guarantor_relationships
{
442 return Koha
::Patron
::Relationships
->search( { guarantee_id
=> $self->id } );
445 =head3 guarantee_relationships
447 Returns Koha::Patron::Relationships object for this patron's guarantors
449 Returns the set of relationships for the patrons that are guarantees for this patron.
451 The method returns Koha::Patron::Relationship objects for the sake
452 of consistency with the guantors method.
453 A guarantee by definition must exist as a patron in Koha.
457 sub guarantee_relationships
{
460 return Koha
::Patron
::Relationships
->search(
461 { guarantor_id
=> $self->id },
463 prefetch
=> 'guarantee',
464 order_by
=> { -asc
=> [ 'guarantee.surname', 'guarantee.firstname' ] },
469 =head3 housebound_profile
471 Returns the HouseboundProfile associated with this patron.
475 sub housebound_profile
{
477 my $profile = $self->_result->housebound_profile;
478 return Koha
::Patron
::HouseboundProfile
->_new_from_dbic($profile)
483 =head3 housebound_role
485 Returns the HouseboundRole associated with this patron.
489 sub housebound_role
{
492 my $role = $self->_result->housebound_role;
493 return Koha
::Patron
::HouseboundRole
->_new_from_dbic($role) if ( $role );
499 Returns the siblings of this patron.
506 my @guarantors = $self->guarantor_relationships()->guarantors();
508 return unless @guarantors;
511 map { $_->guarantee_relationships()->guarantees() } @guarantors;
513 return unless @siblings;
517 grep { !$seen{ $_->id }++ && ( $_->id != $self->id ) } @siblings;
519 return wantarray ?
@siblings : Koha
::Patrons
->search( { borrowernumber
=> { -in => [ map { $_->id } @siblings ] } } );
524 my $patron = Koha::Patrons->find($id);
525 $patron->merge_with( \@patron_ids );
527 This subroutine merges a list of patrons into the patron record. This is accomplished by finding
528 all related patron ids for the patrons to be merged in other tables and changing the ids to be that
529 of the keeper patron.
534 my ( $self, $patron_ids ) = @_;
536 my @patron_ids = @
{ $patron_ids };
538 # Ensure the keeper isn't in the list of patrons to merge
539 @patron_ids = grep { $_ ne $self->id } @patron_ids;
541 my $schema = Koha
::Database
->new()->schema();
545 $self->_result->result_source->schema->txn_do( sub {
546 foreach my $patron_id (@patron_ids) {
547 my $patron = Koha
::Patrons
->find( $patron_id );
551 # Unbless for safety, the patron will end up being deleted
552 $results->{merged
}->{$patron_id}->{patron
} = $patron->unblessed;
554 while (my ($r, $field) = each(%$RESULTSET_PATRON_ID_MAPPING)) {
555 my $rs = $schema->resultset($r)->search({ $field => $patron_id });
556 $results->{merged
}->{ $patron_id }->{updated
}->{$r} = $rs->count();
557 $rs->update({ $field => $self->id });
560 $patron->move_to_deleted();
570 =head3 wants_check_for_previous_checkout
572 $wants_check = $patron->wants_check_for_previous_checkout;
574 Return 1 if Koha needs to perform PrevIssue checking, else 0.
578 sub wants_check_for_previous_checkout
{
580 my $syspref = C4
::Context
->preference("checkPrevCheckout");
583 ## Hard syspref trumps all
584 return 1 if ($syspref eq 'hardyes');
585 return 0 if ($syspref eq 'hardno');
586 ## Now, patron pref trumps all
587 return 1 if ($self->checkprevcheckout eq 'yes');
588 return 0 if ($self->checkprevcheckout eq 'no');
590 # More complex: patron inherits -> determine category preference
591 my $checkPrevCheckoutByCat = $self->category->checkprevcheckout;
592 return 1 if ($checkPrevCheckoutByCat eq 'yes');
593 return 0 if ($checkPrevCheckoutByCat eq 'no');
595 # Finally: category preference is inherit, default to 0
596 if ($syspref eq 'softyes') {
603 =head3 do_check_for_previous_checkout
605 $do_check = $patron->do_check_for_previous_checkout($item);
607 Return 1 if the bib associated with $ITEM has previously been checked out to
608 $PATRON, 0 otherwise.
612 sub do_check_for_previous_checkout
{
613 my ( $self, $item ) = @_;
616 my $biblio = Koha
::Biblios
->find( $item->{biblionumber
} );
617 if ( $biblio->is_serial ) {
618 push @item_nos, $item->{itemnumber
};
620 # Get all itemnumbers for given bibliographic record.
621 @item_nos = $biblio->items->get_column( 'itemnumber' );
624 # Create (old)issues search criteria
626 borrowernumber
=> $self->borrowernumber,
627 itemnumber
=> \
@item_nos,
630 # Check current issues table
631 my $issues = Koha
::Checkouts
->search($criteria);
632 return 1 if $issues->count; # 0 || N
634 # Check old issues table
635 my $old_issues = Koha
::Old
::Checkouts
->search($criteria);
636 return $old_issues->count; # 0 || N
641 my $debarment_expiration = $patron->is_debarred;
643 Returns the date a patron debarment will expire, or undef if the patron is not
651 return unless $self->debarred;
652 return $self->debarred
653 if $self->debarred =~ '^9999'
654 or dt_from_string
( $self->debarred ) > dt_from_string
;
660 my $is_expired = $patron->is_expired;
662 Returns 1 if the patron is expired or 0;
668 return 0 unless $self->dateexpiry;
669 return 0 if $self->dateexpiry =~ '^9999';
670 return 1 if dt_from_string
( $self->dateexpiry ) < dt_from_string
->truncate( to
=> 'day' );
674 =head3 is_going_to_expire
676 my $is_going_to_expire = $patron->is_going_to_expire;
678 Returns 1 if the patron is going to expired, depending on the NotifyBorrowerDeparture pref or 0
682 sub is_going_to_expire
{
685 my $delay = C4
::Context
->preference('NotifyBorrowerDeparture') || 0;
687 return 0 unless $delay;
688 return 0 unless $self->dateexpiry;
689 return 0 if $self->dateexpiry =~ '^9999';
690 return 1 if dt_from_string
( $self->dateexpiry, undef, 'floating' )->subtract( days
=> $delay ) < dt_from_string
(undef, undef, 'floating')->truncate( to
=> 'day' );
696 $patron->set_password({ password => $plain_text_password [, skip_validation => 1 ] });
698 Set the patron's password.
702 The passed string is validated against the current password enforcement policy.
703 Validation can be skipped by passing the I<skip_validation> parameter.
705 Exceptions are thrown if the password is not good enough.
709 =item Koha::Exceptions::Password::TooShort
711 =item Koha::Exceptions::Password::WhitespaceCharacters
713 =item Koha::Exceptions::Password::TooWeak
715 =item Koha::Exceptions::Password::Plugin (if a "check password" plugin is enabled)
722 my ( $self, $args ) = @_;
724 my $password = $args->{password
};
726 unless ( $args->{skip_validation
} ) {
727 my ( $is_valid, $error ) = Koha
::AuthUtils
::is_password_valid
( $password );
730 if ( $error eq 'too_short' ) {
731 my $min_length = C4
::Context
->preference('minPasswordLength');
732 $min_length = 3 if not $min_length or $min_length < 3;
734 my $password_length = length($password);
735 Koha
::Exceptions
::Password
::TooShort
->throw(
736 length => $password_length, min_length
=> $min_length );
738 elsif ( $error eq 'has_whitespaces' ) {
739 Koha
::Exceptions
::Password
::WhitespaceCharacters
->throw();
741 elsif ( $error eq 'too_weak' ) {
742 Koha
::Exceptions
::Password
::TooWeak
->throw();
747 if ( C4
::Context
->preference('UseKohaPlugins') && C4
::Context
->config("enable_plugins") ) {
748 # Call any check_password plugins
749 my @plugins = Koha
::Plugins
->new()->GetPlugins({
750 method
=> 'check_password',
752 foreach my $plugin ( @plugins ) {
753 # This plugin hook will also be used by a plugin for the Norwegian national
754 # patron database. This is why we need to pass both the password and the
755 # borrowernumber to the plugin.
756 my $ret = $plugin->check_password(
758 password
=> $password,
759 borrowernumber
=> $self->borrowernumber
762 # This plugin hook will also be used by a plugin for the Norwegian national
763 # patron database. This is why we need to call the actual plugins and then
764 # check skip_validation afterwards.
765 if ( $ret->{'error'} == 1 && !$args->{skip_validation
} ) {
766 Koha
::Exceptions
::Password
::Plugin
->throw();
771 my $digest = Koha
::AuthUtils
::hash_password
($password);
773 # We do not want to call $self->store and retrieve password from DB
774 $self->password($digest);
775 $self->login_attempts(0);
778 logaction
( "MEMBERS", "CHANGE PASS", $self->borrowernumber, "" )
779 if C4
::Context
->preference("BorrowersLog");
787 my $new_expiry_date = $patron->renew_account
789 Extending the subscription to the expiry date.
796 if ( C4
::Context
->preference('BorrowerRenewalPeriodBase') eq 'combination' ) {
797 $date = ( dt_from_string
gt dt_from_string
( $self->dateexpiry ) ) ? dt_from_string
: dt_from_string
( $self->dateexpiry );
800 C4
::Context
->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry'
801 ? dt_from_string
( $self->dateexpiry )
804 my $expiry_date = $self->category->get_expiry_date($date);
806 $self->dateexpiry($expiry_date);
807 $self->date_renewed( dt_from_string
() );
810 $self->add_enrolment_fee_if_needed(1);
812 logaction
( "MEMBERS", "RENEW", $self->borrowernumber, "Membership renewed" ) if C4
::Context
->preference("BorrowersLog");
813 return dt_from_string
( $expiry_date )->truncate( to
=> 'day' );
818 my $has_overdues = $patron->has_overdues;
820 Returns the number of patron's overdues
826 my $dtf = Koha
::Database
->new->schema->storage->datetime_parser;
827 return $self->_result->issues->search({ date_due
=> { '<' => $dtf->format_datetime( dt_from_string
() ) } })->count;
832 $patron->track_login;
833 $patron->track_login({ force => 1 });
835 Tracks a (successful) login attempt.
836 The preference TrackLastPatronActivity must be enabled. Or you
837 should pass the force parameter.
842 my ( $self, $params ) = @_;
845 !C4
::Context
->preference('TrackLastPatronActivity');
846 $self->lastseen( dt_from_string
() )->store;
849 =head3 move_to_deleted
851 my $is_moved = $patron->move_to_deleted;
853 Move a patron to the deletedborrowers table.
854 This can be done before deleting a patron, to make sure the data are not completely deleted.
858 sub move_to_deleted
{
860 my $patron_infos = $self->unblessed;
861 delete $patron_infos->{updated_on
}; #This ensures the updated_on date in deletedborrowers will be set to the current timestamp
862 return Koha
::Database
->new->schema->resultset('Deletedborrower')->create($patron_infos);
865 =head3 article_requests
867 my @requests = $borrower->article_requests();
868 my $requests = $borrower->article_requests();
870 Returns either a list of ArticleRequests objects,
871 or an ArtitleRequests object, depending on the
876 sub article_requests
{
879 $self->{_article_requests
} ||= Koha
::ArticleRequests
->search({ borrowernumber
=> $self->borrowernumber() });
881 return $self->{_article_requests
};
884 =head3 article_requests_current
886 my @requests = $patron->article_requests_current
888 Returns the article requests associated with this patron that are incomplete
892 sub article_requests_current
{
895 $self->{_article_requests_current
} ||= Koha
::ArticleRequests
->search(
897 borrowernumber
=> $self->id(),
899 { status
=> Koha
::ArticleRequest
::Status
::Pending
},
900 { status
=> Koha
::ArticleRequest
::Status
::Processing
}
905 return $self->{_article_requests_current
};
908 =head3 article_requests_finished
910 my @requests = $biblio->article_requests_finished
912 Returns the article requests associated with this patron that are completed
916 sub article_requests_finished
{
917 my ( $self, $borrower ) = @_;
919 $self->{_article_requests_finished
} ||= Koha
::ArticleRequests
->search(
921 borrowernumber
=> $self->id(),
923 { status
=> Koha
::ArticleRequest
::Status
::Completed
},
924 { status
=> Koha
::ArticleRequest
::Status
::Canceled
}
929 return $self->{_article_requests_finished
};
932 =head3 add_enrolment_fee_if_needed
934 my $enrolment_fee = $patron->add_enrolment_fee_if_needed($renewal);
936 Add enrolment fee for a patron if needed.
938 $renewal - boolean denoting whether this is an account renewal or not
942 sub add_enrolment_fee_if_needed
{
943 my ($self, $renewal) = @_;
944 my $enrolment_fee = $self->category->enrolmentfee;
945 if ( $enrolment_fee && $enrolment_fee > 0 ) {
946 my $type = $renewal ?
'ACCOUNT_RENEW' : 'ACCOUNT';
947 $self->account->add_debit(
949 amount
=> $enrolment_fee,
950 user_id
=> C4
::Context
->userenv ? C4
::Context
->userenv->{'number'} : undef,
951 interface
=> C4
::Context
->interface,
952 library_id
=> C4
::Context
->userenv ? C4
::Context
->userenv->{'branch'} : undef,
957 return $enrolment_fee || 0;
962 my $checkouts = $patron->checkouts
968 my $checkouts = $self->_result->issues;
969 return Koha
::Checkouts
->_new_from_dbic( $checkouts );
972 =head3 pending_checkouts
974 my $pending_checkouts = $patron->pending_checkouts
976 This method will return the same as $self->checkouts, but with a prefetch on
977 items, biblio and biblioitems.
979 It has been introduced to replaced the C4::Members::GetPendingIssues subroutine
981 It should not be used directly, prefer to access fields you need instead of
982 retrieving all these fields in one go.
986 sub pending_checkouts
{
988 my $checkouts = $self->_result->issues->search(
992 { -desc
=> 'me.timestamp' },
993 { -desc
=> 'issuedate' },
994 { -desc
=> 'issue_id' }, # Sort by issue_id should be enough
996 prefetch
=> { item
=> { biblio
=> 'biblioitems' } },
999 return Koha
::Checkouts
->_new_from_dbic( $checkouts );
1002 =head3 old_checkouts
1004 my $old_checkouts = $patron->old_checkouts
1010 my $old_checkouts = $self->_result->old_issues;
1011 return Koha
::Old
::Checkouts
->_new_from_dbic( $old_checkouts );
1016 my $overdue_items = $patron->get_overdues
1018 Return the overdue items
1024 my $dtf = Koha
::Database
->new->schema->storage->datetime_parser;
1025 return $self->checkouts->search(
1027 'me.date_due' => { '<' => $dtf->format_datetime(dt_from_string
) },
1030 prefetch
=> { item
=> { biblio
=> 'biblioitems' } },
1035 =head3 get_routing_lists
1037 my @routinglists = $patron->get_routing_lists
1039 Returns the routing lists a patron is subscribed to.
1043 sub get_routing_lists
{
1045 my $routing_list_rs = $self->_result->subscriptionroutinglists;
1046 return Koha
::Subscription
::Routinglists
->_new_from_dbic($routing_list_rs);
1051 my $age = $patron->get_age
1053 Return the age of the patron
1059 my $today_str = dt_from_string
->strftime("%Y-%m-%d");
1060 return unless $self->dateofbirth;
1061 my $dob_str = dt_from_string
( $self->dateofbirth )->strftime("%Y-%m-%d");
1063 my ( $dob_y, $dob_m, $dob_d ) = split /-/, $dob_str;
1064 my ( $today_y, $today_m, $today_d ) = split /-/, $today_str;
1066 my $age = $today_y - $dob_y;
1067 if ( $dob_m . $dob_d > $today_m . $today_d ) {
1076 my $is_valid = $patron->is_valid_age
1078 Return 1 if patron's age is between allowed limits, returns 0 if it's not.
1084 my $age = $self->get_age;
1086 my $patroncategory = $self->category;
1087 my ($low,$high) = ($patroncategory->dateofbirthrequired, $patroncategory->upperagelimit);
1089 return (defined($age) && (($high && ($age > $high)) or ($age < $low))) ?
0 : 1;
1094 my $account = $patron->account
1100 return Koha
::Account
->new( { patron_id
=> $self->borrowernumber } );
1105 my $holds = $patron->holds
1107 Return all the holds placed by this patron
1113 my $holds_rs = $self->_result->reserves->search( {}, { order_by
=> 'reservedate' } );
1114 return Koha
::Holds
->_new_from_dbic($holds_rs);
1119 my $old_holds = $patron->old_holds
1121 Return all the historical holds for this patron
1127 my $old_holds_rs = $self->_result->old_reserves->search( {}, { order_by
=> 'reservedate' } );
1128 return Koha
::Old
::Holds
->_new_from_dbic($old_holds_rs);
1131 =head3 return_claims
1133 my $return_claims = $patron->return_claims
1139 my $return_claims = $self->_result->return_claims_borrowernumbers;
1140 return Koha
::Checkouts
::ReturnClaims
->_new_from_dbic( $return_claims );
1143 =head3 notice_email_address
1145 my $email = $patron->notice_email_address;
1147 Return the email address of patron used for notices.
1148 Returns the empty string if no email address.
1152 sub notice_email_address
{
1155 my $which_address = C4
::Context
->preference("AutoEmailPrimaryAddress");
1156 # if syspref is set to 'first valid' (value == OFF), look up email address
1157 if ( $which_address eq 'OFF' ) {
1158 return $self->first_valid_email_address;
1161 return $self->$which_address || '';
1164 =head3 first_valid_email_address
1166 my $first_valid_email_address = $patron->first_valid_email_address
1168 Return the first valid email address for a patron.
1169 For now, the order is defined as email, emailpro, B_email.
1170 Returns the empty string if the borrower has no email addresses.
1174 sub first_valid_email_address
{
1177 return $self->email() || $self->emailpro() || $self->B_email() || q{};
1180 =head3 get_club_enrollments
1184 sub get_club_enrollments
{
1185 my ( $self, $return_scalar ) = @_;
1187 my $e = Koha
::Club
::Enrollments
->search( { borrowernumber
=> $self->borrowernumber(), date_canceled
=> undef } );
1189 return $e if $return_scalar;
1191 return wantarray ?
$e->as_list : $e;
1194 =head3 get_enrollable_clubs
1198 sub get_enrollable_clubs
{
1199 my ( $self, $is_enrollable_from_opac, $return_scalar ) = @_;
1202 $params->{is_enrollable_from_opac
} = $is_enrollable_from_opac
1203 if $is_enrollable_from_opac;
1204 $params->{is_email_required
} = 0 unless $self->first_valid_email_address();
1206 $params->{borrower
} = $self;
1208 my $e = Koha
::Clubs
->get_enrollable($params);
1210 return $e if $return_scalar;
1212 return wantarray ?
$e->as_list : $e;
1215 =head3 account_locked
1217 my $is_locked = $patron->account_locked
1219 Return true if the patron has reached the maximum number of login attempts
1220 (see pref FailedLoginAttempts). If login_attempts is < 0, this is interpreted
1221 as an administrative lockout (independent of FailedLoginAttempts; see also
1222 Koha::Patron->lock).
1223 Otherwise return false.
1224 If the pref is not set (empty string, null or 0), the feature is considered as
1229 sub account_locked
{
1231 my $FailedLoginAttempts = C4
::Context
->preference('FailedLoginAttempts');
1232 return 1 if $FailedLoginAttempts
1233 and $self->login_attempts
1234 and $self->login_attempts >= $FailedLoginAttempts;
1235 return 1 if ($self->login_attempts || 0) < 0; # administrative lockout
1239 =head3 can_see_patron_infos
1241 my $can_see = $patron->can_see_patron_infos( $patron );
1243 Return true if the patron (usually the logged in user) can see the patron's infos for a given patron
1247 sub can_see_patron_infos
{
1248 my ( $self, $patron ) = @_;
1249 return unless $patron;
1250 return $self->can_see_patrons_from( $patron->library->branchcode );
1253 =head3 can_see_patrons_from
1255 my $can_see = $patron->can_see_patrons_from( $branchcode );
1257 Return true if the patron (usually the logged in user) can see the patron's infos from a given library
1261 sub can_see_patrons_from
{
1262 my ( $self, $branchcode ) = @_;
1264 if ( $self->branchcode eq $branchcode ) {
1266 } elsif ( $self->has_permission( { borrowers
=> 'view_borrower_infos_from_any_libraries' } ) ) {
1268 } elsif ( my $library_groups = $self->library->library_groups ) {
1269 while ( my $library_group = $library_groups->next ) {
1270 if ( $library_group->parent->has_child( $branchcode ) ) {
1279 =head3 libraries_where_can_see_patrons
1281 my $libraries = $patron-libraries_where_can_see_patrons;
1283 Return the list of branchcodes(!) of libraries the patron is allowed to see other patron's infos.
1284 The branchcodes are arbitrarily returned sorted.
1285 We are supposing here that the object is related to the logged in patron (use of C4::Context::only_my_library)
1287 An empty array means no restriction, the patron can see patron's infos from any libraries.
1291 sub libraries_where_can_see_patrons
{
1293 my $userenv = C4
::Context
->userenv;
1295 return () unless $userenv; # For tests, but userenv should be defined in tests...
1297 my @restricted_branchcodes;
1298 if (C4
::Context
::only_my_library
) {
1299 push @restricted_branchcodes, $self->branchcode;
1303 $self->has_permission(
1304 { borrowers
=> 'view_borrower_infos_from_any_libraries' }
1308 my $library_groups = $self->library->library_groups({ ft_hide_patron_info
=> 1 });
1309 if ( $library_groups->count )
1311 while ( my $library_group = $library_groups->next ) {
1312 my $parent = $library_group->parent;
1313 if ( $parent->has_child( $self->branchcode ) ) {
1314 push @restricted_branchcodes, $parent->children->get_column('branchcode');
1319 @restricted_branchcodes = ( $self->branchcode ) unless @restricted_branchcodes;
1323 @restricted_branchcodes = grep { defined $_ } @restricted_branchcodes;
1324 @restricted_branchcodes = uniq
(@restricted_branchcodes);
1325 @restricted_branchcodes = sort(@restricted_branchcodes);
1326 return @restricted_branchcodes;
1329 sub has_permission
{
1330 my ( $self, $flagsrequired ) = @_;
1331 return unless $self->userid;
1332 # TODO code from haspermission needs to be moved here!
1333 return C4
::Auth
::haspermission
( $self->userid, $flagsrequired );
1338 my $is_adult = $patron->is_adult
1340 Return true if the patron has a category with a type Adult (A) or Organization (I)
1346 return $self->category->category_type =~ /^(A|I)$/ ?
1 : 0;
1351 my $is_child = $patron->is_child
1353 Return true if the patron has a category with a type Child (C)
1359 return $self->category->category_type eq 'C' ?
1 : 0;
1362 =head3 has_valid_userid
1364 my $patron = Koha::Patrons->find(42);
1365 $patron->userid( $new_userid );
1366 my $has_a_valid_userid = $patron->has_valid_userid
1368 my $patron = Koha::Patron->new( $params );
1369 my $has_a_valid_userid = $patron->has_valid_userid
1371 Return true if the current userid of this patron is valid/unique, otherwise false.
1373 Note that this should be done in $self->store instead and raise an exception if needed.
1377 sub has_valid_userid
{
1380 return 0 unless $self->userid;
1382 return 0 if ( $self->userid eq C4
::Context
->config('user') ); # DB user
1384 my $already_exists = Koha
::Patrons
->search(
1386 userid
=> $self->userid,
1389 ?
( borrowernumber
=> { '!=' => $self->borrowernumber } )
1394 return $already_exists ?
0 : 1;
1397 =head3 generate_userid
1399 my $patron = Koha::Patron->new( $params );
1400 $patron->generate_userid
1402 Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
1404 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).
1408 sub generate_userid
{
1411 my $firstname = $self->firstname // q{};
1412 my $surname = $self->surname // q{};
1413 #The script will "do" the following code and increment the $offset until the generated userid is unique
1415 $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1416 $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1417 my $userid = lc(($firstname)?
"$firstname.$surname" : $surname);
1418 $userid = unac_string
('utf-8',$userid);
1419 $userid .= $offset unless $offset == 0;
1420 $self->userid( $userid );
1422 } while (! $self->has_valid_userid );
1430 my $attributes = $patron->attributes
1432 Return object of Koha::Patron::Attributes type with all attributes set for this patron
1438 return Koha
::Patron
::Attributes
->search({
1439 borrowernumber
=> $self->borrowernumber,
1440 branchcode
=> $self->branchcode,
1446 Koha::Patrons->find($id)->lock({ expire => 1, remove => 1 });
1448 Lock and optionally expire a patron account.
1449 Remove holds and article requests if remove flag set.
1450 In order to distinguish from locking by entering a wrong password, let's
1451 call this an administrative lockout.
1456 my ( $self, $params ) = @_;
1457 $self->login_attempts( ADMINISTRATIVE_LOCKOUT
);
1458 if( $params->{expire
} ) {
1459 $self->dateexpiry( dt_from_string
->subtract(days
=> 1) );
1462 if( $params->{remove
} ) {
1463 $self->holds->delete;
1464 $self->article_requests->delete;
1471 Koha::Patrons->find($id)->anonymize;
1473 Anonymize or clear borrower fields. Fields in BorrowerMandatoryField
1474 are randomized, other personal data is cleared too.
1475 Patrons with issues are skipped.
1481 if( $self->_result->issues->count ) {
1482 warn "Exiting anonymize: patron ".$self->borrowernumber." still has issues";
1485 # Mandatory fields come from the corresponding pref, but email fields
1486 # are removed since scrambled email addresses only generate errors
1487 my $mandatory = { map { (lc $_, 1); } grep { !/email/ }
1488 split /\s*\|\s*/, C4
::Context
->preference('BorrowerMandatoryField') };
1489 $mandatory->{userid
} = 1; # needed since sub store does not clear field
1490 my @columns = $self->_result->result_source->columns;
1491 @columns = grep { !/borrowernumber|branchcode|categorycode|^date|password|flags|updated_on|lastseen|lang|login_attempts|anonymized/ } @columns;
1492 push @columns, 'dateofbirth'; # add this date back in
1493 foreach my $col (@columns) {
1494 $self->_anonymize_column($col, $mandatory->{lc $col} );
1496 $self->anonymized(1)->store;
1499 sub _anonymize_column
{
1500 my ( $self, $col, $mandatory ) = @_;
1501 my $col_info = $self->_result->result_source->column_info($col);
1502 my $type = $col_info->{data_type
};
1503 my $nullable = $col_info->{is_nullable
};
1505 if( $type =~ /char|text/ ) {
1507 ? Koha
::Token
->new->generate({ pattern
=> '\w{10}' })
1511 } elsif( $type =~ /integer|int$|float|dec|double/ ) {
1512 $val = $nullable ?
undef : 0;
1513 } elsif( $type =~ /date|time/ ) {
1514 $val = $nullable ?
undef : dt_from_string
;
1519 =head3 add_guarantor
1521 my @relationships = $patron->add_guarantor(
1523 borrowernumber => $borrowernumber,
1524 relationships => $relationship,
1528 Adds a new guarantor to a patron.
1533 my ( $self, $params ) = @_;
1535 my $guarantor_id = $params->{guarantor_id
};
1536 my $relationship = $params->{relationship
};
1538 return Koha
::Patron
::Relationship
->new(
1540 guarantee_id
=> $self->id,
1541 guarantor_id
=> $guarantor_id,
1542 relationship
=> $relationship
1549 my $json = $patron->to_api;
1551 Overloaded method that returns a JSON representation of the Koha::Patron object,
1552 suitable for API output.
1559 my $json_patron = $self->SUPER::to_api
;
1561 $json_patron->{restricted
} = ( $self->is_debarred )
1563 : Mojo
::JSON
->false;
1565 return $json_patron;
1568 =head3 to_api_mapping
1570 This method returns the mapping for representing a Koha::Patron object
1575 sub to_api_mapping
{
1577 borrowernotes
=> 'staff_notes',
1578 borrowernumber
=> 'patron_id',
1579 branchcode
=> 'library_id',
1580 categorycode
=> 'category_id',
1581 checkprevcheckout
=> 'check_previous_checkout',
1582 contactfirstname
=> undef, # Unused
1583 contactname
=> undef, # Unused
1584 contactnote
=> 'altaddress_notes',
1585 contacttitle
=> undef, # Unused
1586 dateenrolled
=> 'date_enrolled',
1587 dateexpiry
=> 'expiry_date',
1588 dateofbirth
=> 'date_of_birth',
1589 debarred
=> undef, # replaced by 'restricted'
1590 debarredcomment
=> undef, # calculated, API consumers will use /restrictions instead
1591 emailpro
=> 'secondary_email',
1592 flags
=> undef, # permissions manipulation handled in /permissions
1593 gonenoaddress
=> 'incorrect_address',
1594 guarantorid
=> 'guarantor_id',
1595 lastseen
=> 'last_seen',
1596 lost
=> 'patron_card_lost',
1597 opacnote
=> 'opac_notes',
1598 othernames
=> 'other_name',
1599 password
=> undef, # password manipulation handled in /password
1600 phonepro
=> 'secondary_phone',
1601 relationship
=> 'relationship_type',
1603 smsalertnumber
=> 'sms_number',
1604 sort1
=> 'statistics_1',
1605 sort2
=> 'statistics_2',
1606 streetnumber
=> 'street_number',
1607 streettype
=> 'street_type',
1608 zipcode
=> 'postal_code',
1609 B_address
=> 'altaddress_address',
1610 B_address2
=> 'altaddress_address2',
1611 B_city
=> 'altaddress_city',
1612 B_country
=> 'altaddress_country',
1613 B_email
=> 'altaddress_email',
1614 B_phone
=> 'altaddress_phone',
1615 B_state
=> 'altaddress_state',
1616 B_streetnumber
=> 'altaddress_street_number',
1617 B_streettype
=> 'altaddress_street_type',
1618 B_zipcode
=> 'altaddress_postal_code',
1619 altcontactaddress1
=> 'altcontact_address',
1620 altcontactaddress2
=> 'altcontact_address2',
1621 altcontactaddress3
=> 'altcontact_city',
1622 altcontactcountry
=> 'altcontact_country',
1623 altcontactfirstname
=> 'altcontact_firstname',
1624 altcontactphone
=> 'altcontact_phone',
1625 altcontactsurname
=> 'altcontact_surname',
1626 altcontactstate
=> 'altcontact_state',
1627 altcontactzipcode
=> 'altcontact_postal_code'
1631 =head2 Internal methods
1643 Kyle M Hall <kyle@bywatersolutions.com>
1644 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
1645 Martin Renvoize <martin.renvoize@ptfs-europe.com>