3 # Copyright ByWater Solutions 2014
4 # Copyright PTFS Europe 2016
6 # This file is part of Koha.
8 # Koha is free software; you can redistribute it and/or modify it
9 # under the terms of the GNU General Public License as published by
10 # the Free Software Foundation; either version 3 of the License, or
11 # (at your option) any later version.
13 # Koha is distributed in the hope that it will be useful, but
14 # WITHOUT ANY WARRANTY; without even the implied warranty of
15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 # GNU General Public License for more details.
18 # You should have received a copy of the GNU General Public License
19 # along with Koha; if not, see <http://www.gnu.org/licenses>.
24 use List::MoreUtils qw( any uniq );
25 use JSON qw( to_json );
26 use Unicode::Normalize;
31 use Koha::ArticleRequests;
34 use Koha::Club::Enrollments;
37 use Koha::Exceptions::Password;
39 use Koha::Old::Checkouts;
40 use Koha::Patron::Attributes;
41 use Koha::Patron::Categories;
42 use Koha::Patron::HouseboundProfile;
43 use Koha::Patron::HouseboundRole;
44 use Koha::Patron::Images;
45 use Koha::Patron::Modifications;
46 use Koha::Patron::Relationships;
49 use Koha::Subscription::Routinglists;
51 use Koha::Virtualshelves;
53 use base qw(Koha::Object);
55 use constant ADMINISTRATIVE_LOCKOUT => -1;
57 our $RESULTSET_PATRON_ID_MAPPING = {
58 Accountline => 'borrowernumber',
59 Aqbasketuser => 'borrowernumber',
60 Aqbudget => 'budget_owner_id',
61 Aqbudgetborrower => 'borrowernumber',
62 ArticleRequest => 'borrowernumber',
63 BorrowerAttribute => 'borrowernumber',
64 BorrowerDebarment => 'borrowernumber',
65 BorrowerFile => 'borrowernumber',
66 BorrowerModification => 'borrowernumber',
67 ClubEnrollment => 'borrowernumber',
68 Issue => 'borrowernumber',
69 ItemsLastBorrower => 'borrowernumber',
70 Linktracker => 'borrowernumber',
71 Message => 'borrowernumber',
72 MessageQueue => 'borrowernumber',
73 OldIssue => 'borrowernumber',
74 OldReserve => 'borrowernumber',
75 Rating => 'borrowernumber',
76 Reserve => 'borrowernumber',
77 Review => 'borrowernumber',
78 SearchHistory => 'userid',
79 Statistic => 'borrowernumber',
80 Suggestion => 'suggestedby',
81 TagAll => 'borrowernumber',
82 Virtualshelfcontent => 'borrowernumber',
83 Virtualshelfshare => 'borrowernumber',
84 Virtualshelve => 'owner',
89 Koha::Patron - Koha Patron Object class
100 my ( $class, $params ) = @_;
102 return $class->SUPER::new($params);
105 =head3 fixup_cardnumber
107 Autogenerate next cardnumber from highest value found in database
111 sub fixup_cardnumber {
113 my $max = Koha::Patrons->search({
114 cardnumber => {-regexp => '^-?[0-9]+$'}
116 select => \'CAST(cardnumber AS SIGNED)',
117 as => ['cast_cardnumber']
118 })->_resultset->get_column('cast_cardnumber')->max;
119 $self->cardnumber(($max || 0) +1);
122 =head3 trim_whitespace
124 trim whitespace from data which has some non-whitespace in it.
125 Could be moved to Koha::Object if need to be reused
129 sub trim_whitespaces {
132 my $schema = Koha::Database->new->schema;
133 my @columns = $schema->source($self->_type)->columns;
135 for my $column( @columns ) {
136 my $value = $self->$column;
137 if ( defined $value ) {
138 $value =~ s/^\s*|\s*$//g;
139 $self->$column($value);
145 =head3 plain_text_password
147 $patron->plain_text_password( $password );
149 stores a copy of the unencrypted password in the object
150 for use in code before encrypting for db
154 sub plain_text_password {
155 my ( $self, $password ) = @_;
157 $self->{_plain_text_password} = $password;
160 return $self->{_plain_text_password}
161 if $self->{_plain_text_password};
168 Patron specific store method to cleanup record
169 and do other necessary things before saving
177 $self->_result->result_source->schema->txn_do(
180 C4::Context->preference("autoMemberNum")
181 and ( not defined $self->cardnumber
182 or $self->cardnumber eq '' )
185 # Warning: The caller is responsible for locking the members table in write
186 # mode, to avoid database corruption.
187 # We are in a transaction but the table is not locked
188 $self->fixup_cardnumber;
191 unless( $self->category->in_storage ) {
192 Koha::Exceptions::Object::FKConstraint->throw(
193 broken_fk => 'categorycode',
194 value => $self->categorycode,
198 $self->trim_whitespaces;
200 # Set surname to uppercase if uppercasesurname is true
201 $self->surname( uc($self->surname) )
202 if C4::Context->preference("uppercasesurnames");
204 $self->relationship(undef) # We do not want to store an empty string in this field
205 if defined $self->relationship
206 and $self->relationship eq "";
208 unless ( $self->in_storage ) { #AddMember
210 # Generate a valid userid/login if needed
211 $self->generate_userid
212 if not $self->userid or not $self->has_valid_userid;
214 # Add expiration date if it isn't already there
215 unless ( $self->dateexpiry ) {
216 $self->dateexpiry( $self->category->get_expiry_date );
219 # Add enrollment date if it isn't already there
220 unless ( $self->dateenrolled ) {
221 $self->dateenrolled(dt_from_string);
224 # Set the privacy depending on the patron's category
225 my $default_privacy = $self->category->default_privacy || q{};
227 $default_privacy eq 'default' ? 1
228 : $default_privacy eq 'never' ? 2
229 : $default_privacy eq 'forever' ? 0
231 $self->privacy($default_privacy);
233 # Call any check_password plugins if password is passed
234 if ( C4::Context->config("enable_plugins") && $self->password ) {
235 my @plugins = Koha::Plugins->new()->GetPlugins({
236 method => 'check_password',
238 foreach my $plugin ( @plugins ) {
239 # This plugin hook will also be used by a plugin for the Norwegian national
240 # patron database. This is why we need to pass both the password and the
241 # borrowernumber to the plugin.
242 my $ret = $plugin->check_password(
244 password => $self->password,
245 borrowernumber => $self->borrowernumber
248 if ( $ret->{'error'} == 1 ) {
249 Koha::Exceptions::Password::Plugin->throw();
254 # Make a copy of the plain text password for later use
255 $self->plain_text_password( $self->password );
257 # Create a disabled account if no password provided
258 $self->password( $self->password
259 ? Koha::AuthUtils::hash_password( $self->password )
262 $self->borrowernumber(undef);
264 $self = $self->SUPER::store;
266 $self->add_enrolment_fee_if_needed(0);
268 logaction( "MEMBERS", "CREATE", $self->borrowernumber, "" )
269 if C4::Context->preference("BorrowersLog");
273 my $self_from_storage = $self->get_from_storage;
274 # FIXME We should not deal with that here, callers have to do this job
275 # Moved from ModMember to prevent regressions
276 unless ( $self->userid ) {
277 my $stored_userid = $self_from_storage->userid;
278 $self->userid($stored_userid);
281 # Password must be updated using $self->set_password
282 $self->password($self_from_storage->password);
284 if ( $self->category->categorycode ne
285 $self_from_storage->category->categorycode )
287 # Add enrolement fee on category change if required
288 $self->add_enrolment_fee_if_needed(1)
289 if C4::Context->preference('FeeOnChangePatronCategory');
291 # Clean up guarantors on category change if required
292 $self->guarantor_relationships->delete
293 if ( $self->category->category_type ne 'C'
294 && $self->category->category_type ne 'P' );
299 if ( C4::Context->preference("BorrowersLog") ) {
301 my $from_storage = $self_from_storage->unblessed;
302 my $from_object = $self->unblessed;
303 my @skip_fields = (qw/lastseen updated_on/);
304 for my $key ( keys %{$from_storage} ) {
305 next if any { /$key/ } @skip_fields;
308 !defined( $from_storage->{$key} )
309 && defined( $from_object->{$key} )
311 || ( defined( $from_storage->{$key} )
312 && !defined( $from_object->{$key} ) )
314 defined( $from_storage->{$key} )
315 && defined( $from_object->{$key} )
316 && ( $from_storage->{$key} ne
317 $from_object->{$key} )
322 before => $from_storage->{$key},
323 after => $from_object->{$key}
328 if ( defined($info) ) {
332 $self->borrowernumber,
335 { utf8 => 1, pretty => 1, canonical => 1 }
342 $self = $self->SUPER::store;
353 Delete patron's holds, lists and finally the patron.
355 Lists owned by the borrower are deleted, but entries from the borrower to
356 other lists are kept.
363 $self->_result->result_source->schema->txn_do(
365 # Cancel Patron's holds
366 my $holds = $self->holds;
367 while( my $hold = $holds->next ){
371 # Delete all lists and all shares of this borrower
372 # Consistent with the approach Koha uses on deleting individual lists
373 # Note that entries in virtualshelfcontents added by this borrower to
374 # lists of others will be handled by a table constraint: the borrower
375 # is set to NULL in those entries.
377 # We could handle the above deletes via a constraint too.
378 # But a new BZ report 11889 has been opened to discuss another approach.
379 # Instead of deleting we could also disown lists (based on a pref).
380 # In that way we could save shared and public lists.
381 # The current table constraints support that idea now.
382 # This pref should then govern the results of other routines/methods such as
383 # Koha::Virtualshelf->new->delete too.
384 # FIXME Could be $patron->get_lists
385 $_->delete for Koha::Virtualshelves->search( { owner => $self->borrowernumber } );
387 # We cannot have a FK on borrower_modifications.borrowernumber, the table is also used
389 $_->delete for Koha::Patron::Modifications->search( { borrowernumber => $self->borrowernumber } );
391 $self->SUPER::delete;
393 logaction( "MEMBERS", "DELETE", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog");
402 my $patron_category = $patron->category
404 Return the patron category for this patron
410 return Koha::Patron::Category->_new_from_dbic( $self->_result->categorycode );
420 return Koha::Patron::Images->find( $self->borrowernumber );
425 Returns a Koha::Library object representing the patron's home library.
431 return Koha::Library->_new_from_dbic($self->_result->branchcode);
436 Returns a Koha::SMS::Provider object representing the patron's SMS provider.
442 return Koha::SMS::Provider->_new_from_dbic($self->_result->sms_provider);
445 =head3 guarantor_relationships
447 Returns Koha::Patron::Relationships object for this patron's guarantors
449 Returns the set of relationships for the patrons that are guarantors for this patron.
451 This is returned instead of a Koha::Patron object because the guarantor
452 may not exist as a patron in Koha. If this is true, the guarantors name
453 exists in the Koha::Patron::Relationship object and will have no guarantor_id.
457 sub guarantor_relationships {
460 return Koha::Patron::Relationships->search( { guarantee_id => $self->id } );
463 =head3 guarantee_relationships
465 Returns Koha::Patron::Relationships object for this patron's guarantors
467 Returns the set of relationships for the patrons that are guarantees for this patron.
469 The method returns Koha::Patron::Relationship objects for the sake
470 of consistency with the guantors method.
471 A guarantee by definition must exist as a patron in Koha.
475 sub guarantee_relationships {
478 return Koha::Patron::Relationships->search(
479 { guarantor_id => $self->id },
481 prefetch => 'guarantee',
482 order_by => { -asc => [ 'guarantee.surname', 'guarantee.firstname' ] },
487 =head3 housebound_profile
489 Returns the HouseboundProfile associated with this patron.
493 sub housebound_profile {
495 my $profile = $self->_result->housebound_profile;
496 return Koha::Patron::HouseboundProfile->_new_from_dbic($profile)
501 =head3 housebound_role
503 Returns the HouseboundRole associated with this patron.
507 sub housebound_role {
510 my $role = $self->_result->housebound_role;
511 return Koha::Patron::HouseboundRole->_new_from_dbic($role) if ( $role );
517 Returns the siblings of this patron.
524 my @guarantors = $self->guarantor_relationships()->guarantors();
526 return unless @guarantors;
529 map { $_->guarantee_relationships()->guarantees() } @guarantors;
531 return unless @siblings;
535 grep { !$seen{ $_->id }++ && ( $_->id != $self->id ) } @siblings;
537 return wantarray ? @siblings : Koha::Patrons->search( { borrowernumber => { -in => [ map { $_->id } @siblings ] } } );
542 my $patron = Koha::Patrons->find($id);
543 $patron->merge_with( \@patron_ids );
545 This subroutine merges a list of patrons into the patron record. This is accomplished by finding
546 all related patron ids for the patrons to be merged in other tables and changing the ids to be that
547 of the keeper patron.
552 my ( $self, $patron_ids ) = @_;
554 my @patron_ids = @{ $patron_ids };
556 # Ensure the keeper isn't in the list of patrons to merge
557 @patron_ids = grep { $_ ne $self->id } @patron_ids;
559 my $schema = Koha::Database->new()->schema();
563 $self->_result->result_source->schema->txn_do( sub {
564 foreach my $patron_id (@patron_ids) {
565 my $patron = Koha::Patrons->find( $patron_id );
569 # Unbless for safety, the patron will end up being deleted
570 $results->{merged}->{$patron_id}->{patron} = $patron->unblessed;
572 while (my ($r, $field) = each(%$RESULTSET_PATRON_ID_MAPPING)) {
573 my $rs = $schema->resultset($r)->search({ $field => $patron_id });
574 $results->{merged}->{ $patron_id }->{updated}->{$r} = $rs->count();
575 $rs->update({ $field => $self->id });
578 $patron->move_to_deleted();
588 =head3 wants_check_for_previous_checkout
590 $wants_check = $patron->wants_check_for_previous_checkout;
592 Return 1 if Koha needs to perform PrevIssue checking, else 0.
596 sub wants_check_for_previous_checkout {
598 my $syspref = C4::Context->preference("checkPrevCheckout");
601 ## Hard syspref trumps all
602 return 1 if ($syspref eq 'hardyes');
603 return 0 if ($syspref eq 'hardno');
604 ## Now, patron pref trumps all
605 return 1 if ($self->checkprevcheckout eq 'yes');
606 return 0 if ($self->checkprevcheckout eq 'no');
608 # More complex: patron inherits -> determine category preference
609 my $checkPrevCheckoutByCat = $self->category->checkprevcheckout;
610 return 1 if ($checkPrevCheckoutByCat eq 'yes');
611 return 0 if ($checkPrevCheckoutByCat eq 'no');
613 # Finally: category preference is inherit, default to 0
614 if ($syspref eq 'softyes') {
621 =head3 do_check_for_previous_checkout
623 $do_check = $patron->do_check_for_previous_checkout($item);
625 Return 1 if the bib associated with $ITEM has previously been checked out to
626 $PATRON, 0 otherwise.
630 sub do_check_for_previous_checkout {
631 my ( $self, $item ) = @_;
634 my $biblio = Koha::Biblios->find( $item->{biblionumber} );
635 if ( $biblio->is_serial ) {
636 push @item_nos, $item->{itemnumber};
638 # Get all itemnumbers for given bibliographic record.
639 @item_nos = $biblio->items->get_column( 'itemnumber' );
642 # Create (old)issues search criteria
644 borrowernumber => $self->borrowernumber,
645 itemnumber => \@item_nos,
648 # Check current issues table
649 my $issues = Koha::Checkouts->search($criteria);
650 return 1 if $issues->count; # 0 || N
652 # Check old issues table
653 my $old_issues = Koha::Old::Checkouts->search($criteria);
654 return $old_issues->count; # 0 || N
659 my $debarment_expiration = $patron->is_debarred;
661 Returns the date a patron debarment will expire, or undef if the patron is not
669 return unless $self->debarred;
670 return $self->debarred
671 if $self->debarred =~ '^9999'
672 or dt_from_string( $self->debarred ) > dt_from_string;
678 my $is_expired = $patron->is_expired;
680 Returns 1 if the patron is expired or 0;
686 return 0 unless $self->dateexpiry;
687 return 0 if $self->dateexpiry =~ '^9999';
688 return 1 if dt_from_string( $self->dateexpiry ) < dt_from_string->truncate( to => 'day' );
692 =head3 is_going_to_expire
694 my $is_going_to_expire = $patron->is_going_to_expire;
696 Returns 1 if the patron is going to expired, depending on the NotifyBorrowerDeparture pref or 0
700 sub is_going_to_expire {
703 my $delay = C4::Context->preference('NotifyBorrowerDeparture') || 0;
705 return 0 unless $delay;
706 return 0 unless $self->dateexpiry;
707 return 0 if $self->dateexpiry =~ '^9999';
708 return 1 if dt_from_string( $self->dateexpiry, undef, 'floating' )->subtract( days => $delay ) < dt_from_string(undef, undef, 'floating')->truncate( to => 'day' );
714 $patron->set_password({ password => $plain_text_password [, skip_validation => 1 ] });
716 Set the patron's password.
720 The passed string is validated against the current password enforcement policy.
721 Validation can be skipped by passing the I<skip_validation> parameter.
723 Exceptions are thrown if the password is not good enough.
727 =item Koha::Exceptions::Password::TooShort
729 =item Koha::Exceptions::Password::WhitespaceCharacters
731 =item Koha::Exceptions::Password::TooWeak
733 =item Koha::Exceptions::Password::Plugin (if a "check password" plugin is enabled)
740 my ( $self, $args ) = @_;
742 my $password = $args->{password};
744 unless ( $args->{skip_validation} ) {
745 my ( $is_valid, $error ) = Koha::AuthUtils::is_password_valid( $password );
748 if ( $error eq 'too_short' ) {
749 my $min_length = C4::Context->preference('minPasswordLength');
750 $min_length = 3 if not $min_length or $min_length < 3;
752 my $password_length = length($password);
753 Koha::Exceptions::Password::TooShort->throw(
754 length => $password_length, min_length => $min_length );
756 elsif ( $error eq 'has_whitespaces' ) {
757 Koha::Exceptions::Password::WhitespaceCharacters->throw();
759 elsif ( $error eq 'too_weak' ) {
760 Koha::Exceptions::Password::TooWeak->throw();
765 if ( C4::Context->config("enable_plugins") ) {
766 # Call any check_password plugins
767 my @plugins = Koha::Plugins->new()->GetPlugins({
768 method => 'check_password',
770 foreach my $plugin ( @plugins ) {
771 # This plugin hook will also be used by a plugin for the Norwegian national
772 # patron database. This is why we need to pass both the password and the
773 # borrowernumber to the plugin.
774 my $ret = $plugin->check_password(
776 password => $password,
777 borrowernumber => $self->borrowernumber
780 # This plugin hook will also be used by a plugin for the Norwegian national
781 # patron database. This is why we need to call the actual plugins and then
782 # check skip_validation afterwards.
783 if ( $ret->{'error'} == 1 && !$args->{skip_validation} ) {
784 Koha::Exceptions::Password::Plugin->throw();
789 my $digest = Koha::AuthUtils::hash_password($password);
791 # We do not want to call $self->store and retrieve password from DB
792 $self->password($digest);
793 $self->login_attempts(0);
796 logaction( "MEMBERS", "CHANGE PASS", $self->borrowernumber, "" )
797 if C4::Context->preference("BorrowersLog");
805 my $new_expiry_date = $patron->renew_account
807 Extending the subscription to the expiry date.
814 if ( C4::Context->preference('BorrowerRenewalPeriodBase') eq 'combination' ) {
815 $date = ( dt_from_string gt dt_from_string( $self->dateexpiry ) ) ? dt_from_string : dt_from_string( $self->dateexpiry );
818 C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry'
819 ? dt_from_string( $self->dateexpiry )
822 my $expiry_date = $self->category->get_expiry_date($date);
824 $self->dateexpiry($expiry_date);
825 $self->date_renewed( dt_from_string() );
828 $self->add_enrolment_fee_if_needed(1);
830 logaction( "MEMBERS", "RENEW", $self->borrowernumber, "Membership renewed" ) if C4::Context->preference("BorrowersLog");
831 return dt_from_string( $expiry_date )->truncate( to => 'day' );
836 my $has_overdues = $patron->has_overdues;
838 Returns the number of patron's overdues
844 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
845 return $self->_result->issues->search({ date_due => { '<' => $dtf->format_datetime( dt_from_string() ) } })->count;
850 $patron->track_login;
851 $patron->track_login({ force => 1 });
853 Tracks a (successful) login attempt.
854 The preference TrackLastPatronActivity must be enabled. Or you
855 should pass the force parameter.
860 my ( $self, $params ) = @_;
863 !C4::Context->preference('TrackLastPatronActivity');
864 $self->lastseen( dt_from_string() )->store;
867 =head3 move_to_deleted
869 my $is_moved = $patron->move_to_deleted;
871 Move a patron to the deletedborrowers table.
872 This can be done before deleting a patron, to make sure the data are not completely deleted.
876 sub move_to_deleted {
878 my $patron_infos = $self->unblessed;
879 delete $patron_infos->{updated_on}; #This ensures the updated_on date in deletedborrowers will be set to the current timestamp
880 return Koha::Database->new->schema->resultset('Deletedborrower')->create($patron_infos);
883 =head3 article_requests
885 my @requests = $borrower->article_requests();
886 my $requests = $borrower->article_requests();
888 Returns either a list of ArticleRequests objects,
889 or an ArtitleRequests object, depending on the
894 sub article_requests {
897 $self->{_article_requests} ||= Koha::ArticleRequests->search({ borrowernumber => $self->borrowernumber() });
899 return $self->{_article_requests};
902 =head3 article_requests_current
904 my @requests = $patron->article_requests_current
906 Returns the article requests associated with this patron that are incomplete
910 sub article_requests_current {
913 $self->{_article_requests_current} ||= Koha::ArticleRequests->search(
915 borrowernumber => $self->id(),
917 { status => Koha::ArticleRequest::Status::Pending },
918 { status => Koha::ArticleRequest::Status::Processing }
923 return $self->{_article_requests_current};
926 =head3 article_requests_finished
928 my @requests = $biblio->article_requests_finished
930 Returns the article requests associated with this patron that are completed
934 sub article_requests_finished {
935 my ( $self, $borrower ) = @_;
937 $self->{_article_requests_finished} ||= Koha::ArticleRequests->search(
939 borrowernumber => $self->id(),
941 { status => Koha::ArticleRequest::Status::Completed },
942 { status => Koha::ArticleRequest::Status::Canceled }
947 return $self->{_article_requests_finished};
950 =head3 add_enrolment_fee_if_needed
952 my $enrolment_fee = $patron->add_enrolment_fee_if_needed($renewal);
954 Add enrolment fee for a patron if needed.
956 $renewal - boolean denoting whether this is an account renewal or not
960 sub add_enrolment_fee_if_needed {
961 my ($self, $renewal) = @_;
962 my $enrolment_fee = $self->category->enrolmentfee;
963 if ( $enrolment_fee && $enrolment_fee > 0 ) {
964 my $type = $renewal ? 'ACCOUNT_RENEW' : 'ACCOUNT';
965 $self->account->add_debit(
967 amount => $enrolment_fee,
968 user_id => C4::Context->userenv ? C4::Context->userenv->{'number'} : undef,
969 interface => C4::Context->interface,
970 library_id => C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef,
975 return $enrolment_fee || 0;
980 my $checkouts = $patron->checkouts
986 my $checkouts = $self->_result->issues;
987 return Koha::Checkouts->_new_from_dbic( $checkouts );
990 =head3 pending_checkouts
992 my $pending_checkouts = $patron->pending_checkouts
994 This method will return the same as $self->checkouts, but with a prefetch on
995 items, biblio and biblioitems.
997 It has been introduced to replaced the C4::Members::GetPendingIssues subroutine
999 It should not be used directly, prefer to access fields you need instead of
1000 retrieving all these fields in one go.
1004 sub pending_checkouts {
1006 my $checkouts = $self->_result->issues->search(
1010 { -desc => 'me.timestamp' },
1011 { -desc => 'issuedate' },
1012 { -desc => 'issue_id' }, # Sort by issue_id should be enough
1014 prefetch => { item => { biblio => 'biblioitems' } },
1017 return Koha::Checkouts->_new_from_dbic( $checkouts );
1020 =head3 old_checkouts
1022 my $old_checkouts = $patron->old_checkouts
1028 my $old_checkouts = $self->_result->old_issues;
1029 return Koha::Old::Checkouts->_new_from_dbic( $old_checkouts );
1034 my $overdue_items = $patron->get_overdues
1036 Return the overdue items
1042 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
1043 return $self->checkouts->search(
1045 'me.date_due' => { '<' => $dtf->format_datetime(dt_from_string) },
1048 prefetch => { item => { biblio => 'biblioitems' } },
1053 =head3 get_routing_lists
1055 my @routinglists = $patron->get_routing_lists
1057 Returns the routing lists a patron is subscribed to.
1061 sub get_routing_lists {
1063 my $routing_list_rs = $self->_result->subscriptionroutinglists;
1064 return Koha::Subscription::Routinglists->_new_from_dbic($routing_list_rs);
1069 my $age = $patron->get_age
1071 Return the age of the patron
1077 my $today_str = dt_from_string->strftime("%Y-%m-%d");
1078 return unless $self->dateofbirth;
1079 my $dob_str = dt_from_string( $self->dateofbirth )->strftime("%Y-%m-%d");
1081 my ( $dob_y, $dob_m, $dob_d ) = split /-/, $dob_str;
1082 my ( $today_y, $today_m, $today_d ) = split /-/, $today_str;
1084 my $age = $today_y - $dob_y;
1085 if ( $dob_m . $dob_d > $today_m . $today_d ) {
1094 my $is_valid = $patron->is_valid_age
1096 Return 1 if patron's age is between allowed limits, returns 0 if it's not.
1102 my $age = $self->get_age;
1104 my $patroncategory = $self->category;
1105 my ($low,$high) = ($patroncategory->dateofbirthrequired, $patroncategory->upperagelimit);
1107 return (defined($age) && (($high && ($age > $high)) or ($age < $low))) ? 0 : 1;
1112 my $account = $patron->account
1118 return Koha::Account->new( { patron_id => $self->borrowernumber } );
1123 my $holds = $patron->holds
1125 Return all the holds placed by this patron
1131 my $holds_rs = $self->_result->reserves->search( {}, { order_by => 'reservedate' } );
1132 return Koha::Holds->_new_from_dbic($holds_rs);
1137 my $old_holds = $patron->old_holds
1139 Return all the historical holds for this patron
1145 my $old_holds_rs = $self->_result->old_reserves->search( {}, { order_by => 'reservedate' } );
1146 return Koha::Old::Holds->_new_from_dbic($old_holds_rs);
1149 =head3 return_claims
1151 my $return_claims = $patron->return_claims
1157 my $return_claims = $self->_result->return_claims_borrowernumbers;
1158 return Koha::Checkouts::ReturnClaims->_new_from_dbic( $return_claims );
1161 =head3 notice_email_address
1163 my $email = $patron->notice_email_address;
1165 Return the email address of patron used for notices.
1166 Returns the empty string if no email address.
1170 sub notice_email_address{
1173 my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
1174 # if syspref is set to 'first valid' (value == OFF), look up email address
1175 if ( $which_address eq 'OFF' ) {
1176 return $self->first_valid_email_address;
1179 return $self->$which_address || '';
1182 =head3 first_valid_email_address
1184 my $first_valid_email_address = $patron->first_valid_email_address
1186 Return the first valid email address for a patron.
1187 For now, the order is defined as email, emailpro, B_email.
1188 Returns the empty string if the borrower has no email addresses.
1192 sub first_valid_email_address {
1195 return $self->email() || $self->emailpro() || $self->B_email() || q{};
1198 =head3 get_club_enrollments
1202 sub get_club_enrollments {
1203 my ( $self, $return_scalar ) = @_;
1205 my $e = Koha::Club::Enrollments->search( { borrowernumber => $self->borrowernumber(), date_canceled => undef } );
1207 return $e if $return_scalar;
1209 return wantarray ? $e->as_list : $e;
1212 =head3 get_enrollable_clubs
1216 sub get_enrollable_clubs {
1217 my ( $self, $is_enrollable_from_opac, $return_scalar ) = @_;
1220 $params->{is_enrollable_from_opac} = $is_enrollable_from_opac
1221 if $is_enrollable_from_opac;
1222 $params->{is_email_required} = 0 unless $self->first_valid_email_address();
1224 $params->{borrower} = $self;
1226 my $e = Koha::Clubs->get_enrollable($params);
1228 return $e if $return_scalar;
1230 return wantarray ? $e->as_list : $e;
1233 =head3 account_locked
1235 my $is_locked = $patron->account_locked
1237 Return true if the patron has reached the maximum number of login attempts
1238 (see pref FailedLoginAttempts). If login_attempts is < 0, this is interpreted
1239 as an administrative lockout (independent of FailedLoginAttempts; see also
1240 Koha::Patron->lock).
1241 Otherwise return false.
1242 If the pref is not set (empty string, null or 0), the feature is considered as
1247 sub account_locked {
1249 my $FailedLoginAttempts = C4::Context->preference('FailedLoginAttempts');
1250 return 1 if $FailedLoginAttempts
1251 and $self->login_attempts
1252 and $self->login_attempts >= $FailedLoginAttempts;
1253 return 1 if ($self->login_attempts || 0) < 0; # administrative lockout
1257 =head3 can_see_patron_infos
1259 my $can_see = $patron->can_see_patron_infos( $patron );
1261 Return true if the patron (usually the logged in user) can see the patron's infos for a given patron
1265 sub can_see_patron_infos {
1266 my ( $self, $patron ) = @_;
1267 return unless $patron;
1268 return $self->can_see_patrons_from( $patron->library->branchcode );
1271 =head3 can_see_patrons_from
1273 my $can_see = $patron->can_see_patrons_from( $branchcode );
1275 Return true if the patron (usually the logged in user) can see the patron's infos from a given library
1279 sub can_see_patrons_from {
1280 my ( $self, $branchcode ) = @_;
1282 if ( $self->branchcode eq $branchcode ) {
1284 } elsif ( $self->has_permission( { borrowers => 'view_borrower_infos_from_any_libraries' } ) ) {
1286 } elsif ( my $library_groups = $self->library->library_groups ) {
1287 while ( my $library_group = $library_groups->next ) {
1288 if ( $library_group->parent->has_child( $branchcode ) ) {
1297 =head3 libraries_where_can_see_patrons
1299 my $libraries = $patron-libraries_where_can_see_patrons;
1301 Return the list of branchcodes(!) of libraries the patron is allowed to see other patron's infos.
1302 The branchcodes are arbitrarily returned sorted.
1303 We are supposing here that the object is related to the logged in patron (use of C4::Context::only_my_library)
1305 An empty array means no restriction, the patron can see patron's infos from any libraries.
1309 sub libraries_where_can_see_patrons {
1311 my $userenv = C4::Context->userenv;
1313 return () unless $userenv; # For tests, but userenv should be defined in tests...
1315 my @restricted_branchcodes;
1316 if (C4::Context::only_my_library) {
1317 push @restricted_branchcodes, $self->branchcode;
1321 $self->has_permission(
1322 { borrowers => 'view_borrower_infos_from_any_libraries' }
1326 my $library_groups = $self->library->library_groups({ ft_hide_patron_info => 1 });
1327 if ( $library_groups->count )
1329 while ( my $library_group = $library_groups->next ) {
1330 my $parent = $library_group->parent;
1331 if ( $parent->has_child( $self->branchcode ) ) {
1332 push @restricted_branchcodes, $parent->children->get_column('branchcode');
1337 @restricted_branchcodes = ( $self->branchcode ) unless @restricted_branchcodes;
1341 @restricted_branchcodes = grep { defined $_ } @restricted_branchcodes;
1342 @restricted_branchcodes = uniq(@restricted_branchcodes);
1343 @restricted_branchcodes = sort(@restricted_branchcodes);
1344 return @restricted_branchcodes;
1347 =head3 has_permission
1349 my $permission = $patron->has_permission($required);
1351 See C4::Auth::haspermission for details of syntax for $required
1355 sub has_permission {
1356 my ( $self, $flagsrequired ) = @_;
1357 return unless $self->userid;
1358 # TODO code from haspermission needs to be moved here!
1359 return C4::Auth::haspermission( $self->userid, $flagsrequired );
1364 my $is_adult = $patron->is_adult
1366 Return true if the patron has a category with a type Adult (A) or Organization (I)
1372 return $self->category->category_type =~ /^(A|I)$/ ? 1 : 0;
1377 my $is_child = $patron->is_child
1379 Return true if the patron has a category with a type Child (C)
1385 return $self->category->category_type eq 'C' ? 1 : 0;
1388 =head3 has_valid_userid
1390 my $patron = Koha::Patrons->find(42);
1391 $patron->userid( $new_userid );
1392 my $has_a_valid_userid = $patron->has_valid_userid
1394 my $patron = Koha::Patron->new( $params );
1395 my $has_a_valid_userid = $patron->has_valid_userid
1397 Return true if the current userid of this patron is valid/unique, otherwise false.
1399 Note that this should be done in $self->store instead and raise an exception if needed.
1403 sub has_valid_userid {
1406 return 0 unless $self->userid;
1408 return 0 if ( $self->userid eq C4::Context->config('user') ); # DB user
1410 my $already_exists = Koha::Patrons->search(
1412 userid => $self->userid,
1415 ? ( borrowernumber => { '!=' => $self->borrowernumber } )
1420 return $already_exists ? 0 : 1;
1423 =head3 generate_userid
1425 my $patron = Koha::Patron->new( $params );
1426 $patron->generate_userid
1428 Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
1430 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).
1434 sub generate_userid {
1437 my $firstname = $self->firstname // q{};
1438 my $surname = $self->surname // q{};
1439 #The script will "do" the following code and increment the $offset until the generated userid is unique
1441 $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1442 $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1443 my $userid = lc(($firstname)? "$firstname.$surname" : $surname);
1444 $userid = NFKD( $userid );
1445 $userid =~ s/\p{NonspacingMark}//g;
1446 $userid .= $offset unless $offset == 0;
1447 $self->userid( $userid );
1449 } while (! $self->has_valid_userid );
1454 =head3 add_extended_attribute
1458 sub add_extended_attribute {
1459 my ($self, $attribute) = @_;
1460 $attribute->{borrowernumber} = $self->borrowernumber;
1461 return Koha::Patron::Attribute->new($attribute)->store;
1464 =head3 extended_attributes
1466 Return object of Koha::Patron::Attributes type with all attributes set for this patron
1472 sub extended_attributes {
1473 my ( $self, $attributes ) = @_;
1474 if ($attributes) { # setter
1475 my $schema = $self->_result->result_source->schema;
1478 # Remove the existing one
1479 $self->extended_attributes->filter_by_branch_limitations->delete;
1481 # Insert the new ones
1482 for my $attribute (@$attributes) {
1484 $self->_result->create_related('borrower_attributes', $attribute);
1487 # 1 - Raise an exception
1488 # 2 - Execute in a transaction and don't save
1489 # or Insert anyway but display a message on the UI
1496 my $rs = $self->_result->borrower_attributes;
1497 # We call search to use the filters in Koha::Patron::Attributes->search
1498 return Koha::Patron::Attributes->_new_from_dbic($rs)->search;
1503 Koha::Patrons->find($id)->lock({ expire => 1, remove => 1 });
1505 Lock and optionally expire a patron account.
1506 Remove holds and article requests if remove flag set.
1507 In order to distinguish from locking by entering a wrong password, let's
1508 call this an administrative lockout.
1513 my ( $self, $params ) = @_;
1514 $self->login_attempts( ADMINISTRATIVE_LOCKOUT );
1515 if( $params->{expire} ) {
1516 $self->dateexpiry( dt_from_string->subtract(days => 1) );
1519 if( $params->{remove} ) {
1520 $self->holds->delete;
1521 $self->article_requests->delete;
1528 Koha::Patrons->find($id)->anonymize;
1530 Anonymize or clear borrower fields. Fields in BorrowerMandatoryField
1531 are randomized, other personal data is cleared too.
1532 Patrons with issues are skipped.
1538 if( $self->_result->issues->count ) {
1539 warn "Exiting anonymize: patron ".$self->borrowernumber." still has issues";
1542 # Mandatory fields come from the corresponding pref, but email fields
1543 # are removed since scrambled email addresses only generate errors
1544 my $mandatory = { map { (lc $_, 1); } grep { !/email/ }
1545 split /\s*\|\s*/, C4::Context->preference('BorrowerMandatoryField') };
1546 $mandatory->{userid} = 1; # needed since sub store does not clear field
1547 my @columns = $self->_result->result_source->columns;
1548 @columns = grep { !/borrowernumber|branchcode|categorycode|^date|password|flags|updated_on|lastseen|lang|login_attempts|anonymized/ } @columns;
1549 push @columns, 'dateofbirth'; # add this date back in
1550 foreach my $col (@columns) {
1551 $self->_anonymize_column($col, $mandatory->{lc $col} );
1553 $self->anonymized(1)->store;
1556 sub _anonymize_column {
1557 my ( $self, $col, $mandatory ) = @_;
1558 my $col_info = $self->_result->result_source->column_info($col);
1559 my $type = $col_info->{data_type};
1560 my $nullable = $col_info->{is_nullable};
1562 if( $type =~ /char|text/ ) {
1564 ? Koha::Token->new->generate({ pattern => '\w{10}' })
1568 } elsif( $type =~ /integer|int$|float|dec|double/ ) {
1569 $val = $nullable ? undef : 0;
1570 } elsif( $type =~ /date|time/ ) {
1571 $val = $nullable ? undef : dt_from_string;
1576 =head3 add_guarantor
1578 my @relationships = $patron->add_guarantor(
1580 borrowernumber => $borrowernumber,
1581 relationships => $relationship,
1585 Adds a new guarantor to a patron.
1590 my ( $self, $params ) = @_;
1592 my $guarantor_id = $params->{guarantor_id};
1593 my $relationship = $params->{relationship};
1595 return Koha::Patron::Relationship->new(
1597 guarantee_id => $self->id,
1598 guarantor_id => $guarantor_id,
1599 relationship => $relationship
1604 =head3 get_extended_attribute
1606 my $attribute_value = $patron->get_extended_attribute( $code );
1608 Return the attribute for the code passed in parameter.
1610 It not exist it returns undef
1612 Note that this will not work for repeatable attribute types.
1614 Maybe you certainly not want to use this method, it is actually only used for SHOW_BARCODE
1615 (which should be a real patron's attribute (not extended)
1619 sub get_extended_attribute {
1620 my ( $self, $code, $value ) = @_;
1621 my $rs = $self->_result->borrower_attributes;
1623 my $attribute = $rs->search({ code => $code, ( $value ? ( attribute => $value ) : () ) });
1624 return unless $attribute->count;
1625 return $attribute->next;
1630 my $json = $patron->to_api;
1632 Overloaded method that returns a JSON representation of the Koha::Patron object,
1633 suitable for API output.
1638 my ( $self, $params ) = @_;
1640 my $json_patron = $self->SUPER::to_api( $params );
1642 $json_patron->{restricted} = ( $self->is_debarred )
1644 : Mojo::JSON->false;
1646 return $json_patron;
1649 =head3 to_api_mapping
1651 This method returns the mapping for representing a Koha::Patron object
1656 sub to_api_mapping {
1658 borrowernotes => 'staff_notes',
1659 borrowernumber => 'patron_id',
1660 branchcode => 'library_id',
1661 categorycode => 'category_id',
1662 checkprevcheckout => 'check_previous_checkout',
1663 contactfirstname => undef, # Unused
1664 contactname => undef, # Unused
1665 contactnote => 'altaddress_notes',
1666 contacttitle => undef, # Unused
1667 dateenrolled => 'date_enrolled',
1668 dateexpiry => 'expiry_date',
1669 dateofbirth => 'date_of_birth',
1670 debarred => undef, # replaced by 'restricted'
1671 debarredcomment => undef, # calculated, API consumers will use /restrictions instead
1672 emailpro => 'secondary_email',
1673 flags => undef, # permissions manipulation handled in /permissions
1674 gonenoaddress => 'incorrect_address',
1675 guarantorid => 'guarantor_id',
1676 lastseen => 'last_seen',
1677 lost => 'patron_card_lost',
1678 opacnote => 'opac_notes',
1679 othernames => 'other_name',
1680 password => undef, # password manipulation handled in /password
1681 phonepro => 'secondary_phone',
1682 relationship => 'relationship_type',
1684 smsalertnumber => 'sms_number',
1685 sort1 => 'statistics_1',
1686 sort2 => 'statistics_2',
1687 autorenew_checkouts => 'autorenew_checkouts',
1688 streetnumber => 'street_number',
1689 streettype => 'street_type',
1690 zipcode => 'postal_code',
1691 B_address => 'altaddress_address',
1692 B_address2 => 'altaddress_address2',
1693 B_city => 'altaddress_city',
1694 B_country => 'altaddress_country',
1695 B_email => 'altaddress_email',
1696 B_phone => 'altaddress_phone',
1697 B_state => 'altaddress_state',
1698 B_streetnumber => 'altaddress_street_number',
1699 B_streettype => 'altaddress_street_type',
1700 B_zipcode => 'altaddress_postal_code',
1701 altcontactaddress1 => 'altcontact_address',
1702 altcontactaddress2 => 'altcontact_address2',
1703 altcontactaddress3 => 'altcontact_city',
1704 altcontactcountry => 'altcontact_country',
1705 altcontactfirstname => 'altcontact_firstname',
1706 altcontactphone => 'altcontact_phone',
1707 altcontactsurname => 'altcontact_surname',
1708 altcontactstate => 'altcontact_state',
1709 altcontactzipcode => 'altcontact_postal_code'
1713 =head2 Internal methods
1725 Kyle M Hall <kyle@bywatersolutions.com>
1726 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
1727 Martin Renvoize <martin.renvoize@ptfs-europe.com>