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;
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::Relationships;
48 use Koha::Subscription::Routinglists;
50 use Koha::Virtualshelves;
52 use base qw(Koha::Object);
54 use constant ADMINISTRATIVE_LOCKOUT => -1;
56 our $RESULTSET_PATRON_ID_MAPPING = {
57 Accountline => 'borrowernumber',
58 Aqbasketuser => 'borrowernumber',
59 Aqbudget => 'budget_owner_id',
60 Aqbudgetborrower => 'borrowernumber',
61 ArticleRequest => 'borrowernumber',
62 BorrowerAttribute => 'borrowernumber',
63 BorrowerDebarment => 'borrowernumber',
64 BorrowerFile => 'borrowernumber',
65 BorrowerModification => 'borrowernumber',
66 ClubEnrollment => 'borrowernumber',
67 Issue => 'borrowernumber',
68 ItemsLastBorrower => 'borrowernumber',
69 Linktracker => 'borrowernumber',
70 Message => 'borrowernumber',
71 MessageQueue => 'borrowernumber',
72 OldIssue => 'borrowernumber',
73 OldReserve => 'borrowernumber',
74 Rating => 'borrowernumber',
75 Reserve => 'borrowernumber',
76 Review => 'borrowernumber',
77 SearchHistory => 'userid',
78 Statistic => 'borrowernumber',
79 Suggestion => 'suggestedby',
80 TagAll => 'borrowernumber',
81 Virtualshelfcontent => 'borrowernumber',
82 Virtualshelfshare => 'borrowernumber',
83 Virtualshelve => 'owner',
88 Koha::Patron - Koha Patron Object class
99 my ( $class, $params ) = @_;
101 return $class->SUPER::new($params);
104 =head3 fixup_cardnumber
106 Autogenerate next cardnumber from highest value found in database
110 sub fixup_cardnumber {
112 my $max = Koha::Patrons->search({
113 cardnumber => {-regexp => '^-?[0-9]+$'}
115 select => \'CAST(cardnumber AS SIGNED)',
116 as => ['cast_cardnumber']
117 })->_resultset->get_column('cast_cardnumber')->max;
118 $self->cardnumber(($max || 0) +1);
121 =head3 trim_whitespace
123 trim whitespace from data which has some non-whitespace in it.
124 Could be moved to Koha::Object if need to be reused
128 sub trim_whitespaces {
131 my $schema = Koha::Database->new->schema;
132 my @columns = $schema->source($self->_type)->columns;
134 for my $column( @columns ) {
135 my $value = $self->$column;
136 if ( defined $value ) {
137 $value =~ s/^\s*|\s*$//g;
138 $self->$column($value);
144 =head3 plain_text_password
146 $patron->plain_text_password( $password );
148 stores a copy of the unencrypted password in the object
149 for use in code before encrypting for db
153 sub plain_text_password {
154 my ( $self, $password ) = @_;
156 $self->{_plain_text_password} = $password;
159 return $self->{_plain_text_password}
160 if $self->{_plain_text_password};
167 Patron specific store method to cleanup record
168 and do other necessary things before saving
176 $self->_result->result_source->schema->txn_do(
179 C4::Context->preference("autoMemberNum")
180 and ( not defined $self->cardnumber
181 or $self->cardnumber eq '' )
184 # Warning: The caller is responsible for locking the members table in write
185 # mode, to avoid database corruption.
186 # We are in a transaction but the table is not locked
187 $self->fixup_cardnumber;
190 unless( $self->category->in_storage ) {
191 Koha::Exceptions::Object::FKConstraint->throw(
192 broken_fk => 'categorycode',
193 value => $self->categorycode,
197 $self->trim_whitespaces;
199 # Set surname to uppercase if uppercasesurname is true
200 $self->surname( uc($self->surname) )
201 if C4::Context->preference("uppercasesurnames");
203 $self->relationship(undef) # We do not want to store an empty string in this field
204 if defined $self->relationship
205 and $self->relationship eq "";
207 unless ( $self->in_storage ) { #AddMember
209 # Generate a valid userid/login if needed
210 $self->generate_userid
211 if not $self->userid or not $self->has_valid_userid;
213 # Add expiration date if it isn't already there
214 unless ( $self->dateexpiry ) {
215 $self->dateexpiry( $self->category->get_expiry_date );
218 # Add enrollment date if it isn't already there
219 unless ( $self->dateenrolled ) {
220 $self->dateenrolled(dt_from_string);
223 # Set the privacy depending on the patron's category
224 my $default_privacy = $self->category->default_privacy || q{};
226 $default_privacy eq 'default' ? 1
227 : $default_privacy eq 'never' ? 2
228 : $default_privacy eq 'forever' ? 0
230 $self->privacy($default_privacy);
232 # Call any check_password plugins if password is passed
233 if ( C4::Context->preference('UseKohaPlugins')
234 && C4::Context->config("enable_plugins")
237 my @plugins = Koha::Plugins->new()->GetPlugins({
238 method => 'check_password',
240 foreach my $plugin ( @plugins ) {
241 # This plugin hook will also be used by a plugin for the Norwegian national
242 # patron database. This is why we need to pass both the password and the
243 # borrowernumber to the plugin.
244 my $ret = $plugin->check_password(
246 password => $self->password,
247 borrowernumber => $self->borrowernumber
250 if ( $ret->{'error'} == 1 ) {
251 Koha::Exceptions::Password::Plugin->throw();
256 # Make a copy of the plain text password for later use
257 $self->plain_text_password( $self->password );
259 # Create a disabled account if no password provided
260 $self->password( $self->password
261 ? Koha::AuthUtils::hash_password( $self->password )
264 $self->borrowernumber(undef);
266 $self = $self->SUPER::store;
268 $self->add_enrolment_fee_if_needed(0);
270 logaction( "MEMBERS", "CREATE", $self->borrowernumber, "" )
271 if C4::Context->preference("BorrowersLog");
275 my $self_from_storage = $self->get_from_storage;
276 # FIXME We should not deal with that here, callers have to do this job
277 # Moved from ModMember to prevent regressions
278 unless ( $self->userid ) {
279 my $stored_userid = $self_from_storage->userid;
280 $self->userid($stored_userid);
283 # Password must be updated using $self->set_password
284 $self->password($self_from_storage->password);
286 if ( $self->category->categorycode ne
287 $self_from_storage->category->categorycode )
289 # Add enrolement fee on category change if required
290 $self->add_enrolment_fee_if_needed(1)
291 if C4::Context->preference('FeeOnChangePatronCategory');
293 # Clean up guarantors on category change if required
294 $self->guarantor_relationships->delete
295 if ( $self->category->category_type ne 'C'
296 && $self->category->category_type ne 'P' );
301 if ( C4::Context->preference("BorrowersLog") ) {
303 my $from_storage = $self_from_storage->unblessed;
304 my $from_object = $self->unblessed;
305 my @skip_fields = (qw/lastseen updated_on/);
306 for my $key ( keys %{$from_storage} ) {
307 next if any { /$key/ } @skip_fields;
310 !defined( $from_storage->{$key} )
311 && defined( $from_object->{$key} )
313 || ( defined( $from_storage->{$key} )
314 && !defined( $from_object->{$key} ) )
316 defined( $from_storage->{$key} )
317 && defined( $from_object->{$key} )
318 && ( $from_storage->{$key} ne
319 $from_object->{$key} )
324 before => $from_storage->{$key},
325 after => $from_object->{$key}
330 if ( defined($info) ) {
334 $self->borrowernumber,
337 { utf8 => 1, pretty => 1, canonical => 1 }
344 $self = $self->SUPER::store;
355 Delete patron's holds, lists and finally the patron.
357 Lists owned by the borrower are deleted, but entries from the borrower to
358 other lists are kept.
366 $self->_result->result_source->schema->txn_do(
368 # Cancel Patron's holds
369 my $holds = $self->holds;
370 while( my $hold = $holds->next ){
374 # Delete all lists and all shares of this borrower
375 # Consistent with the approach Koha uses on deleting individual lists
376 # Note that entries in virtualshelfcontents added by this borrower to
377 # lists of others will be handled by a table constraint: the borrower
378 # is set to NULL in those entries.
380 # We could handle the above deletes via a constraint too.
381 # But a new BZ report 11889 has been opened to discuss another approach.
382 # Instead of deleting we could also disown lists (based on a pref).
383 # In that way we could save shared and public lists.
384 # The current table constraints support that idea now.
385 # This pref should then govern the results of other routines/methods such as
386 # Koha::Virtualshelf->new->delete too.
387 # FIXME Could be $patron->get_lists
388 $_->delete for Koha::Virtualshelves->search( { owner => $self->borrowernumber } );
390 $deleted = $self->SUPER::delete;
392 logaction( "MEMBERS", "DELETE", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog");
401 my $patron_category = $patron->category
403 Return the patron category for this patron
409 return Koha::Patron::Category->_new_from_dbic( $self->_result->categorycode );
419 return Koha::Patron::Images->find( $self->borrowernumber );
424 Returns a Koha::Library object representing the patron's home library.
430 return Koha::Library->_new_from_dbic($self->_result->branchcode);
433 =head3 guarantor_relationships
435 Returns Koha::Patron::Relationships object for this patron's guarantors
437 Returns the set of relationships for the patrons that are guarantors for this patron.
439 This is returned instead of a Koha::Patron object because the guarantor
440 may not exist as a patron in Koha. If this is true, the guarantors name
441 exists in the Koha::Patron::Relationship object and will have no guarantor_id.
445 sub guarantor_relationships {
448 return Koha::Patron::Relationships->search( { guarantee_id => $self->id } );
451 =head3 guarantee_relationships
453 Returns Koha::Patron::Relationships object for this patron's guarantors
455 Returns the set of relationships for the patrons that are guarantees for this patron.
457 The method returns Koha::Patron::Relationship objects for the sake
458 of consistency with the guantors method.
459 A guarantee by definition must exist as a patron in Koha.
463 sub guarantee_relationships {
466 return Koha::Patron::Relationships->search(
467 { guarantor_id => $self->id },
469 prefetch => 'guarantee',
470 order_by => { -asc => [ 'guarantee.surname', 'guarantee.firstname' ] },
475 =head3 housebound_profile
477 Returns the HouseboundProfile associated with this patron.
481 sub housebound_profile {
483 my $profile = $self->_result->housebound_profile;
484 return Koha::Patron::HouseboundProfile->_new_from_dbic($profile)
489 =head3 housebound_role
491 Returns the HouseboundRole associated with this patron.
495 sub housebound_role {
498 my $role = $self->_result->housebound_role;
499 return Koha::Patron::HouseboundRole->_new_from_dbic($role) if ( $role );
505 Returns the siblings of this patron.
512 my @guarantors = $self->guarantor_relationships()->guarantors();
514 return unless @guarantors;
517 map { $_->guarantee_relationships()->guarantees() } @guarantors;
519 return unless @siblings;
523 grep { !$seen{ $_->id }++ && ( $_->id != $self->id ) } @siblings;
525 return wantarray ? @siblings : Koha::Patrons->search( { borrowernumber => { -in => [ map { $_->id } @siblings ] } } );
530 my $patron = Koha::Patrons->find($id);
531 $patron->merge_with( \@patron_ids );
533 This subroutine merges a list of patrons into the patron record. This is accomplished by finding
534 all related patron ids for the patrons to be merged in other tables and changing the ids to be that
535 of the keeper patron.
540 my ( $self, $patron_ids ) = @_;
542 my @patron_ids = @{ $patron_ids };
544 # Ensure the keeper isn't in the list of patrons to merge
545 @patron_ids = grep { $_ ne $self->id } @patron_ids;
547 my $schema = Koha::Database->new()->schema();
551 $self->_result->result_source->schema->txn_do( sub {
552 foreach my $patron_id (@patron_ids) {
553 my $patron = Koha::Patrons->find( $patron_id );
557 # Unbless for safety, the patron will end up being deleted
558 $results->{merged}->{$patron_id}->{patron} = $patron->unblessed;
560 while (my ($r, $field) = each(%$RESULTSET_PATRON_ID_MAPPING)) {
561 my $rs = $schema->resultset($r)->search({ $field => $patron_id });
562 $results->{merged}->{ $patron_id }->{updated}->{$r} = $rs->count();
563 $rs->update({ $field => $self->id });
566 $patron->move_to_deleted();
576 =head3 wants_check_for_previous_checkout
578 $wants_check = $patron->wants_check_for_previous_checkout;
580 Return 1 if Koha needs to perform PrevIssue checking, else 0.
584 sub wants_check_for_previous_checkout {
586 my $syspref = C4::Context->preference("checkPrevCheckout");
589 ## Hard syspref trumps all
590 return 1 if ($syspref eq 'hardyes');
591 return 0 if ($syspref eq 'hardno');
592 ## Now, patron pref trumps all
593 return 1 if ($self->checkprevcheckout eq 'yes');
594 return 0 if ($self->checkprevcheckout eq 'no');
596 # More complex: patron inherits -> determine category preference
597 my $checkPrevCheckoutByCat = $self->category->checkprevcheckout;
598 return 1 if ($checkPrevCheckoutByCat eq 'yes');
599 return 0 if ($checkPrevCheckoutByCat eq 'no');
601 # Finally: category preference is inherit, default to 0
602 if ($syspref eq 'softyes') {
609 =head3 do_check_for_previous_checkout
611 $do_check = $patron->do_check_for_previous_checkout($item);
613 Return 1 if the bib associated with $ITEM has previously been checked out to
614 $PATRON, 0 otherwise.
618 sub do_check_for_previous_checkout {
619 my ( $self, $item ) = @_;
622 my $biblio = Koha::Biblios->find( $item->{biblionumber} );
623 if ( $biblio->is_serial ) {
624 push @item_nos, $item->{itemnumber};
626 # Get all itemnumbers for given bibliographic record.
627 @item_nos = $biblio->items->get_column( 'itemnumber' );
630 # Create (old)issues search criteria
632 borrowernumber => $self->borrowernumber,
633 itemnumber => \@item_nos,
636 # Check current issues table
637 my $issues = Koha::Checkouts->search($criteria);
638 return 1 if $issues->count; # 0 || N
640 # Check old issues table
641 my $old_issues = Koha::Old::Checkouts->search($criteria);
642 return $old_issues->count; # 0 || N
647 my $debarment_expiration = $patron->is_debarred;
649 Returns the date a patron debarment will expire, or undef if the patron is not
657 return unless $self->debarred;
658 return $self->debarred
659 if $self->debarred =~ '^9999'
660 or dt_from_string( $self->debarred ) > dt_from_string;
666 my $is_expired = $patron->is_expired;
668 Returns 1 if the patron is expired or 0;
674 return 0 unless $self->dateexpiry;
675 return 0 if $self->dateexpiry =~ '^9999';
676 return 1 if dt_from_string( $self->dateexpiry ) < dt_from_string->truncate( to => 'day' );
680 =head3 is_going_to_expire
682 my $is_going_to_expire = $patron->is_going_to_expire;
684 Returns 1 if the patron is going to expired, depending on the NotifyBorrowerDeparture pref or 0
688 sub is_going_to_expire {
691 my $delay = C4::Context->preference('NotifyBorrowerDeparture') || 0;
693 return 0 unless $delay;
694 return 0 unless $self->dateexpiry;
695 return 0 if $self->dateexpiry =~ '^9999';
696 return 1 if dt_from_string( $self->dateexpiry, undef, 'floating' )->subtract( days => $delay ) < dt_from_string(undef, undef, 'floating')->truncate( to => 'day' );
702 $patron->set_password({ password => $plain_text_password [, skip_validation => 1 ] });
704 Set the patron's password.
708 The passed string is validated against the current password enforcement policy.
709 Validation can be skipped by passing the I<skip_validation> parameter.
711 Exceptions are thrown if the password is not good enough.
715 =item Koha::Exceptions::Password::TooShort
717 =item Koha::Exceptions::Password::WhitespaceCharacters
719 =item Koha::Exceptions::Password::TooWeak
721 =item Koha::Exceptions::Password::Plugin (if a "check password" plugin is enabled)
728 my ( $self, $args ) = @_;
730 my $password = $args->{password};
732 unless ( $args->{skip_validation} ) {
733 my ( $is_valid, $error ) = Koha::AuthUtils::is_password_valid( $password );
736 if ( $error eq 'too_short' ) {
737 my $min_length = C4::Context->preference('minPasswordLength');
738 $min_length = 3 if not $min_length or $min_length < 3;
740 my $password_length = length($password);
741 Koha::Exceptions::Password::TooShort->throw(
742 length => $password_length, min_length => $min_length );
744 elsif ( $error eq 'has_whitespaces' ) {
745 Koha::Exceptions::Password::WhitespaceCharacters->throw();
747 elsif ( $error eq 'too_weak' ) {
748 Koha::Exceptions::Password::TooWeak->throw();
753 if ( C4::Context->preference('UseKohaPlugins') && C4::Context->config("enable_plugins") ) {
754 # Call any check_password plugins
755 my @plugins = Koha::Plugins->new()->GetPlugins({
756 method => 'check_password',
758 foreach my $plugin ( @plugins ) {
759 # This plugin hook will also be used by a plugin for the Norwegian national
760 # patron database. This is why we need to pass both the password and the
761 # borrowernumber to the plugin.
762 my $ret = $plugin->check_password(
764 password => $password,
765 borrowernumber => $self->borrowernumber
768 # This plugin hook will also be used by a plugin for the Norwegian national
769 # patron database. This is why we need to call the actual plugins and then
770 # check skip_validation afterwards.
771 if ( $ret->{'error'} == 1 && !$args->{skip_validation} ) {
772 Koha::Exceptions::Password::Plugin->throw();
777 my $digest = Koha::AuthUtils::hash_password($password);
779 { password => $digest,
784 logaction( "MEMBERS", "CHANGE PASS", $self->borrowernumber, "" )
785 if C4::Context->preference("BorrowersLog");
793 my $new_expiry_date = $patron->renew_account
795 Extending the subscription to the expiry date.
802 if ( C4::Context->preference('BorrowerRenewalPeriodBase') eq 'combination' ) {
803 $date = ( dt_from_string gt dt_from_string( $self->dateexpiry ) ) ? dt_from_string : dt_from_string( $self->dateexpiry );
806 C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry'
807 ? dt_from_string( $self->dateexpiry )
810 my $expiry_date = $self->category->get_expiry_date($date);
812 $self->dateexpiry($expiry_date);
813 $self->date_renewed( dt_from_string() );
816 $self->add_enrolment_fee_if_needed(1);
818 logaction( "MEMBERS", "RENEW", $self->borrowernumber, "Membership renewed" ) if C4::Context->preference("BorrowersLog");
819 return dt_from_string( $expiry_date )->truncate( to => 'day' );
824 my $has_overdues = $patron->has_overdues;
826 Returns the number of patron's overdues
832 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
833 return $self->_result->issues->search({ date_due => { '<' => $dtf->format_datetime( dt_from_string() ) } })->count;
838 $patron->track_login;
839 $patron->track_login({ force => 1 });
841 Tracks a (successful) login attempt.
842 The preference TrackLastPatronActivity must be enabled. Or you
843 should pass the force parameter.
848 my ( $self, $params ) = @_;
851 !C4::Context->preference('TrackLastPatronActivity');
852 $self->lastseen( dt_from_string() )->store;
855 =head3 move_to_deleted
857 my $is_moved = $patron->move_to_deleted;
859 Move a patron to the deletedborrowers table.
860 This can be done before deleting a patron, to make sure the data are not completely deleted.
864 sub move_to_deleted {
866 my $patron_infos = $self->unblessed;
867 delete $patron_infos->{updated_on}; #This ensures the updated_on date in deletedborrowers will be set to the current timestamp
868 return Koha::Database->new->schema->resultset('Deletedborrower')->create($patron_infos);
871 =head3 article_requests
873 my @requests = $borrower->article_requests();
874 my $requests = $borrower->article_requests();
876 Returns either a list of ArticleRequests objects,
877 or an ArtitleRequests object, depending on the
882 sub article_requests {
885 $self->{_article_requests} ||= Koha::ArticleRequests->search({ borrowernumber => $self->borrowernumber() });
887 return $self->{_article_requests};
890 =head3 article_requests_current
892 my @requests = $patron->article_requests_current
894 Returns the article requests associated with this patron that are incomplete
898 sub article_requests_current {
901 $self->{_article_requests_current} ||= Koha::ArticleRequests->search(
903 borrowernumber => $self->id(),
905 { status => Koha::ArticleRequest::Status::Pending },
906 { status => Koha::ArticleRequest::Status::Processing }
911 return $self->{_article_requests_current};
914 =head3 article_requests_finished
916 my @requests = $biblio->article_requests_finished
918 Returns the article requests associated with this patron that are completed
922 sub article_requests_finished {
923 my ( $self, $borrower ) = @_;
925 $self->{_article_requests_finished} ||= Koha::ArticleRequests->search(
927 borrowernumber => $self->id(),
929 { status => Koha::ArticleRequest::Status::Completed },
930 { status => Koha::ArticleRequest::Status::Canceled }
935 return $self->{_article_requests_finished};
938 =head3 add_enrolment_fee_if_needed
940 my $enrolment_fee = $patron->add_enrolment_fee_if_needed($renewal);
942 Add enrolment fee for a patron if needed.
944 $renewal - boolean denoting whether this is an account renewal or not
948 sub add_enrolment_fee_if_needed {
949 my ($self, $renewal) = @_;
950 my $enrolment_fee = $self->category->enrolmentfee;
951 if ( $enrolment_fee && $enrolment_fee > 0 ) {
952 my $type = $renewal ? 'ACCOUNT_RENEW' : 'ACCOUNT';
953 $self->account->add_debit(
955 amount => $enrolment_fee,
956 user_id => C4::Context->userenv ? C4::Context->userenv->{'number'} : undef,
957 interface => C4::Context->interface,
958 library_id => C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef,
963 return $enrolment_fee || 0;
968 my $checkouts = $patron->checkouts
974 my $checkouts = $self->_result->issues;
975 return Koha::Checkouts->_new_from_dbic( $checkouts );
978 =head3 pending_checkouts
980 my $pending_checkouts = $patron->pending_checkouts
982 This method will return the same as $self->checkouts, but with a prefetch on
983 items, biblio and biblioitems.
985 It has been introduced to replaced the C4::Members::GetPendingIssues subroutine
987 It should not be used directly, prefer to access fields you need instead of
988 retrieving all these fields in one go.
992 sub pending_checkouts {
994 my $checkouts = $self->_result->issues->search(
998 { -desc => 'me.timestamp' },
999 { -desc => 'issuedate' },
1000 { -desc => 'issue_id' }, # Sort by issue_id should be enough
1002 prefetch => { item => { biblio => 'biblioitems' } },
1005 return Koha::Checkouts->_new_from_dbic( $checkouts );
1008 =head3 old_checkouts
1010 my $old_checkouts = $patron->old_checkouts
1016 my $old_checkouts = $self->_result->old_issues;
1017 return Koha::Old::Checkouts->_new_from_dbic( $old_checkouts );
1022 my $overdue_items = $patron->get_overdues
1024 Return the overdue items
1030 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
1031 return $self->checkouts->search(
1033 'me.date_due' => { '<' => $dtf->format_datetime(dt_from_string) },
1036 prefetch => { item => { biblio => 'biblioitems' } },
1041 =head3 get_routing_lists
1043 my @routinglists = $patron->get_routing_lists
1045 Returns the routing lists a patron is subscribed to.
1049 sub get_routing_lists {
1051 my $routing_list_rs = $self->_result->subscriptionroutinglists;
1052 return Koha::Subscription::Routinglists->_new_from_dbic($routing_list_rs);
1057 my $age = $patron->get_age
1059 Return the age of the patron
1065 my $today_str = dt_from_string->strftime("%Y-%m-%d");
1066 return unless $self->dateofbirth;
1067 my $dob_str = dt_from_string( $self->dateofbirth )->strftime("%Y-%m-%d");
1069 my ( $dob_y, $dob_m, $dob_d ) = split /-/, $dob_str;
1070 my ( $today_y, $today_m, $today_d ) = split /-/, $today_str;
1072 my $age = $today_y - $dob_y;
1073 if ( $dob_m . $dob_d > $today_m . $today_d ) {
1082 my $is_valid = $patron->is_valid_age
1084 Return 1 if patron's age is between allowed limits, returns 0 if it's not.
1090 my $age = $self->get_age;
1092 my $patroncategory = $self->category;
1093 my ($low,$high) = ($patroncategory->dateofbirthrequired, $patroncategory->upperagelimit);
1095 return (defined($age) && (($high && ($age > $high)) or ($age < $low))) ? 0 : 1;
1100 my $account = $patron->account
1106 return Koha::Account->new( { patron_id => $self->borrowernumber } );
1111 my $holds = $patron->holds
1113 Return all the holds placed by this patron
1119 my $holds_rs = $self->_result->reserves->search( {}, { order_by => 'reservedate' } );
1120 return Koha::Holds->_new_from_dbic($holds_rs);
1125 my $old_holds = $patron->old_holds
1127 Return all the historical holds for this patron
1133 my $old_holds_rs = $self->_result->old_reserves->search( {}, { order_by => 'reservedate' } );
1134 return Koha::Old::Holds->_new_from_dbic($old_holds_rs);
1137 =head3 return_claims
1139 my $return_claims = $patron->return_claims
1145 my $return_claims = $self->_result->return_claims_borrowernumbers;
1146 return Koha::Checkouts::ReturnClaims->_new_from_dbic( $return_claims );
1149 =head3 notice_email_address
1151 my $email = $patron->notice_email_address;
1153 Return the email address of patron used for notices.
1154 Returns the empty string if no email address.
1158 sub notice_email_address{
1161 my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
1162 # if syspref is set to 'first valid' (value == OFF), look up email address
1163 if ( $which_address eq 'OFF' ) {
1164 return $self->first_valid_email_address;
1167 return $self->$which_address || '';
1170 =head3 first_valid_email_address
1172 my $first_valid_email_address = $patron->first_valid_email_address
1174 Return the first valid email address for a patron.
1175 For now, the order is defined as email, emailpro, B_email.
1176 Returns the empty string if the borrower has no email addresses.
1180 sub first_valid_email_address {
1183 return $self->email() || $self->emailpro() || $self->B_email() || q{};
1186 =head3 get_club_enrollments
1190 sub get_club_enrollments {
1191 my ( $self, $return_scalar ) = @_;
1193 my $e = Koha::Club::Enrollments->search( { borrowernumber => $self->borrowernumber(), date_canceled => undef } );
1195 return $e if $return_scalar;
1197 return wantarray ? $e->as_list : $e;
1200 =head3 get_enrollable_clubs
1204 sub get_enrollable_clubs {
1205 my ( $self, $is_enrollable_from_opac, $return_scalar ) = @_;
1208 $params->{is_enrollable_from_opac} = $is_enrollable_from_opac
1209 if $is_enrollable_from_opac;
1210 $params->{is_email_required} = 0 unless $self->first_valid_email_address();
1212 $params->{borrower} = $self;
1214 my $e = Koha::Clubs->get_enrollable($params);
1216 return $e if $return_scalar;
1218 return wantarray ? $e->as_list : $e;
1221 =head3 account_locked
1223 my $is_locked = $patron->account_locked
1225 Return true if the patron has reached the maximum number of login attempts
1226 (see pref FailedLoginAttempts). If login_attempts is < 0, this is interpreted
1227 as an administrative lockout (independent of FailedLoginAttempts; see also
1228 Koha::Patron->lock).
1229 Otherwise return false.
1230 If the pref is not set (empty string, null or 0), the feature is considered as
1235 sub account_locked {
1237 my $FailedLoginAttempts = C4::Context->preference('FailedLoginAttempts');
1238 return 1 if $FailedLoginAttempts
1239 and $self->login_attempts
1240 and $self->login_attempts >= $FailedLoginAttempts;
1241 return 1 if ($self->login_attempts || 0) < 0; # administrative lockout
1245 =head3 can_see_patron_infos
1247 my $can_see = $patron->can_see_patron_infos( $patron );
1249 Return true if the patron (usually the logged in user) can see the patron's infos for a given patron
1253 sub can_see_patron_infos {
1254 my ( $self, $patron ) = @_;
1255 return unless $patron;
1256 return $self->can_see_patrons_from( $patron->library->branchcode );
1259 =head3 can_see_patrons_from
1261 my $can_see = $patron->can_see_patrons_from( $branchcode );
1263 Return true if the patron (usually the logged in user) can see the patron's infos from a given library
1267 sub can_see_patrons_from {
1268 my ( $self, $branchcode ) = @_;
1270 if ( $self->branchcode eq $branchcode ) {
1272 } elsif ( $self->has_permission( { borrowers => 'view_borrower_infos_from_any_libraries' } ) ) {
1274 } elsif ( my $library_groups = $self->library->library_groups ) {
1275 while ( my $library_group = $library_groups->next ) {
1276 if ( $library_group->parent->has_child( $branchcode ) ) {
1285 =head3 libraries_where_can_see_patrons
1287 my $libraries = $patron-libraries_where_can_see_patrons;
1289 Return the list of branchcodes(!) of libraries the patron is allowed to see other patron's infos.
1290 The branchcodes are arbitrarily returned sorted.
1291 We are supposing here that the object is related to the logged in patron (use of C4::Context::only_my_library)
1293 An empty array means no restriction, the patron can see patron's infos from any libraries.
1297 sub libraries_where_can_see_patrons {
1299 my $userenv = C4::Context->userenv;
1301 return () unless $userenv; # For tests, but userenv should be defined in tests...
1303 my @restricted_branchcodes;
1304 if (C4::Context::only_my_library) {
1305 push @restricted_branchcodes, $self->branchcode;
1309 $self->has_permission(
1310 { borrowers => 'view_borrower_infos_from_any_libraries' }
1314 my $library_groups = $self->library->library_groups({ ft_hide_patron_info => 1 });
1315 if ( $library_groups->count )
1317 while ( my $library_group = $library_groups->next ) {
1318 my $parent = $library_group->parent;
1319 if ( $parent->has_child( $self->branchcode ) ) {
1320 push @restricted_branchcodes, $parent->children->get_column('branchcode');
1325 @restricted_branchcodes = ( $self->branchcode ) unless @restricted_branchcodes;
1329 @restricted_branchcodes = grep { defined $_ } @restricted_branchcodes;
1330 @restricted_branchcodes = uniq(@restricted_branchcodes);
1331 @restricted_branchcodes = sort(@restricted_branchcodes);
1332 return @restricted_branchcodes;
1335 sub has_permission {
1336 my ( $self, $flagsrequired ) = @_;
1337 return unless $self->userid;
1338 # TODO code from haspermission needs to be moved here!
1339 return C4::Auth::haspermission( $self->userid, $flagsrequired );
1344 my $is_adult = $patron->is_adult
1346 Return true if the patron has a category with a type Adult (A) or Organization (I)
1352 return $self->category->category_type =~ /^(A|I)$/ ? 1 : 0;
1357 my $is_child = $patron->is_child
1359 Return true if the patron has a category with a type Child (C)
1365 return $self->category->category_type eq 'C' ? 1 : 0;
1368 =head3 has_valid_userid
1370 my $patron = Koha::Patrons->find(42);
1371 $patron->userid( $new_userid );
1372 my $has_a_valid_userid = $patron->has_valid_userid
1374 my $patron = Koha::Patron->new( $params );
1375 my $has_a_valid_userid = $patron->has_valid_userid
1377 Return true if the current userid of this patron is valid/unique, otherwise false.
1379 Note that this should be done in $self->store instead and raise an exception if needed.
1383 sub has_valid_userid {
1386 return 0 unless $self->userid;
1388 return 0 if ( $self->userid eq C4::Context->config('user') ); # DB user
1390 my $already_exists = Koha::Patrons->search(
1392 userid => $self->userid,
1395 ? ( borrowernumber => { '!=' => $self->borrowernumber } )
1400 return $already_exists ? 0 : 1;
1403 =head3 generate_userid
1405 my $patron = Koha::Patron->new( $params );
1406 $patron->generate_userid
1408 Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
1410 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).
1414 sub generate_userid {
1417 my $firstname = $self->firstname // q{};
1418 my $surname = $self->surname // q{};
1419 #The script will "do" the following code and increment the $offset until the generated userid is unique
1421 $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1422 $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1423 my $userid = lc(($firstname)? "$firstname.$surname" : $surname);
1424 $userid = NFKD( $userid );
1425 $userid =~ s/\p{NonspacingMark}//g;
1426 $userid .= $offset unless $offset == 0;
1427 $self->userid( $userid );
1429 } while (! $self->has_valid_userid );
1436 my $attributes = $patron->attributes
1438 Return object of Koha::Patron::Attributes type with all attributes set for this patron
1444 return Koha::Patron::Attributes->search({
1445 borrowernumber => $self->borrowernumber,
1446 branchcode => $self->branchcode,
1452 Koha::Patrons->find($id)->lock({ expire => 1, remove => 1 });
1454 Lock and optionally expire a patron account.
1455 Remove holds and article requests if remove flag set.
1456 In order to distinguish from locking by entering a wrong password, let's
1457 call this an administrative lockout.
1462 my ( $self, $params ) = @_;
1463 $self->login_attempts( ADMINISTRATIVE_LOCKOUT );
1464 if( $params->{expire} ) {
1465 $self->dateexpiry( dt_from_string->subtract(days => 1) );
1468 if( $params->{remove} ) {
1469 $self->holds->delete;
1470 $self->article_requests->delete;
1477 Koha::Patrons->find($id)->anonymize;
1479 Anonymize or clear borrower fields. Fields in BorrowerMandatoryField
1480 are randomized, other personal data is cleared too.
1481 Patrons with issues are skipped.
1487 if( $self->_result->issues->count ) {
1488 warn "Exiting anonymize: patron ".$self->borrowernumber." still has issues";
1491 # Mandatory fields come from the corresponding pref, but email fields
1492 # are removed since scrambled email addresses only generate errors
1493 my $mandatory = { map { (lc $_, 1); } grep { !/email/ }
1494 split /\s*\|\s*/, C4::Context->preference('BorrowerMandatoryField') };
1495 $mandatory->{userid} = 1; # needed since sub store does not clear field
1496 my @columns = $self->_result->result_source->columns;
1497 @columns = grep { !/borrowernumber|branchcode|categorycode|^date|password|flags|updated_on|lastseen|lang|login_attempts|anonymized/ } @columns;
1498 push @columns, 'dateofbirth'; # add this date back in
1499 foreach my $col (@columns) {
1500 $self->_anonymize_column($col, $mandatory->{lc $col} );
1502 $self->anonymized(1)->store;
1505 sub _anonymize_column {
1506 my ( $self, $col, $mandatory ) = @_;
1507 my $col_info = $self->_result->result_source->column_info($col);
1508 my $type = $col_info->{data_type};
1509 my $nullable = $col_info->{is_nullable};
1511 if( $type =~ /char|text/ ) {
1513 ? Koha::Token->new->generate({ pattern => '\w{10}' })
1517 } elsif( $type =~ /integer|int$|float|dec|double/ ) {
1518 $val = $nullable ? undef : 0;
1519 } elsif( $type =~ /date|time/ ) {
1520 $val = $nullable ? undef : dt_from_string;
1525 =head3 add_guarantor
1527 my @relationships = $patron->add_guarantor(
1529 borrowernumber => $borrowernumber,
1530 relationships => $relationship,
1534 Adds a new guarantor to a patron.
1539 my ( $self, $params ) = @_;
1541 my $guarantor_id = $params->{guarantor_id};
1542 my $relationship = $params->{relationship};
1544 return Koha::Patron::Relationship->new(
1546 guarantee_id => $self->id,
1547 guarantor_id => $guarantor_id,
1548 relationship => $relationship
1555 my $json = $patron->to_api;
1557 Overloaded method that returns a JSON representation of the Koha::Patron object,
1558 suitable for API output.
1565 my $json_patron = $self->SUPER::to_api;
1567 $json_patron->{restricted} = ( $self->is_debarred )
1569 : Mojo::JSON->false;
1571 return $json_patron;
1574 =head3 to_api_mapping
1576 This method returns the mapping for representing a Koha::Patron object
1581 sub to_api_mapping {
1583 borrowernotes => 'staff_notes',
1584 borrowernumber => 'patron_id',
1585 branchcode => 'library_id',
1586 categorycode => 'category_id',
1587 checkprevcheckout => 'check_previous_checkout',
1588 contactfirstname => undef, # Unused
1589 contactname => undef, # Unused
1590 contactnote => 'altaddress_notes',
1591 contacttitle => undef, # Unused
1592 dateenrolled => 'date_enrolled',
1593 dateexpiry => 'expiry_date',
1594 dateofbirth => 'date_of_birth',
1595 debarred => undef, # replaced by 'restricted'
1596 debarredcomment => undef, # calculated, API consumers will use /restrictions instead
1597 emailpro => 'secondary_email',
1598 flags => undef, # permissions manipulation handled in /permissions
1599 gonenoaddress => 'incorrect_address',
1600 guarantorid => 'guarantor_id',
1601 lastseen => 'last_seen',
1602 lost => 'patron_card_lost',
1603 opacnote => 'opac_notes',
1604 othernames => 'other_name',
1605 password => undef, # password manipulation handled in /password
1606 phonepro => 'secondary_phone',
1607 relationship => 'relationship_type',
1609 smsalertnumber => 'sms_number',
1610 sort1 => 'statistics_1',
1611 sort2 => 'statistics_2',
1612 streetnumber => 'street_number',
1613 streettype => 'street_type',
1614 zipcode => 'postal_code',
1615 B_address => 'altaddress_address',
1616 B_address2 => 'altaddress_address2',
1617 B_city => 'altaddress_city',
1618 B_country => 'altaddress_country',
1619 B_email => 'altaddress_email',
1620 B_phone => 'altaddress_phone',
1621 B_state => 'altaddress_state',
1622 B_streetnumber => 'altaddress_street_number',
1623 B_streettype => 'altaddress_street_type',
1624 B_zipcode => 'altaddress_postal_code',
1625 altcontactaddress1 => 'altcontact_address',
1626 altcontactaddress2 => 'altcontact_address2',
1627 altcontactaddress3 => 'altcontact_city',
1628 altcontactcountry => 'altcontact_country',
1629 altcontactfirstname => 'altcontact_firstname',
1630 altcontactphone => 'altcontact_phone',
1631 altcontactsurname => 'altcontact_surname',
1632 altcontactstate => 'altcontact_state',
1633 altcontactzipcode => 'altcontact_postal_code'
1637 =head2 Internal methods
1649 Kyle M Hall <kyle@bywatersolutions.com>
1650 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
1651 Martin Renvoize <martin.renvoize@ptfs-europe.com>