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;
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;
45 use Koha::Virtualshelves;
46 use Koha::Club::Enrollments;
48 use Koha::Subscription::Routinglists;
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);
228 # Make a copy of the plain text password for later use
229 $self->plain_text_password( $self->password );
231 # Create a disabled account if no password provided
232 $self->password( $self->password
233 ? Koha::AuthUtils::hash_password( $self->password )
236 $self->borrowernumber(undef);
238 $self = $self->SUPER::store;
240 $self->add_enrolment_fee_if_needed;
242 logaction( "MEMBERS", "CREATE", $self->borrowernumber, "" )
243 if C4::Context->preference("BorrowersLog");
247 my $self_from_storage = $self->get_from_storage;
248 # FIXME We should not deal with that here, callers have to do this job
249 # Moved from ModMember to prevent regressions
250 unless ( $self->userid ) {
251 my $stored_userid = $self_from_storage->userid;
252 $self->userid($stored_userid);
255 # Password must be updated using $self->set_password
256 $self->password($self_from_storage->password);
258 if ( C4::Context->preference('FeeOnChangePatronCategory')
259 and $self->category->categorycode ne
260 $self_from_storage->category->categorycode )
262 $self->add_enrolment_fee_if_needed;
266 if ( C4::Context->preference("BorrowersLog") ) {
268 my $from_storage = $self_from_storage->unblessed;
269 my $from_object = $self->unblessed;
270 my @skip_fields = (qw/lastseen updated_on/);
271 for my $key ( keys %{$from_storage} ) {
272 next if any { /$key/ } @skip_fields;
275 !defined( $from_storage->{$key} )
276 && defined( $from_object->{$key} )
278 || ( defined( $from_storage->{$key} )
279 && !defined( $from_object->{$key} ) )
281 defined( $from_storage->{$key} )
282 && defined( $from_object->{$key} )
283 && ( $from_storage->{$key} ne
284 $from_object->{$key} )
289 before => $from_storage->{$key},
290 after => $from_object->{$key}
295 if ( defined($info) ) {
299 $self->borrowernumber,
302 { utf8 => 1, pretty => 1, canonical => 1 }
309 $self = $self->SUPER::store;
320 Delete patron's holds, lists and finally the patron.
322 Lists owned by the borrower are deleted, but entries from the borrower to
323 other lists are kept.
331 $self->_result->result_source->schema->txn_do(
333 # Delete Patron's holds
334 $self->holds->delete;
336 # Delete all lists and all shares of this borrower
337 # Consistent with the approach Koha uses on deleting individual lists
338 # Note that entries in virtualshelfcontents added by this borrower to
339 # lists of others will be handled by a table constraint: the borrower
340 # is set to NULL in those entries.
342 # We could handle the above deletes via a constraint too.
343 # But a new BZ report 11889 has been opened to discuss another approach.
344 # Instead of deleting we could also disown lists (based on a pref).
345 # In that way we could save shared and public lists.
346 # The current table constraints support that idea now.
347 # This pref should then govern the results of other routines/methods such as
348 # Koha::Virtualshelf->new->delete too.
349 # FIXME Could be $patron->get_lists
350 $_->delete for Koha::Virtualshelves->search( { owner => $self->borrowernumber } );
352 $deleted = $self->SUPER::delete;
354 logaction( "MEMBERS", "DELETE", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog");
363 my $patron_category = $patron->category
365 Return the patron category for this patron
371 return Koha::Patron::Category->_new_from_dbic( $self->_result->categorycode );
376 Returns a Koha::Patron object for this patron's guarantor
383 return unless $self->guarantorid();
385 return Koha::Patrons->find( $self->guarantorid() );
391 return scalar Koha::Patron::Images->find( $self->borrowernumber );
396 return Koha::Library->_new_from_dbic($self->_result->branchcode);
401 Returns the guarantees (list of Koha::Patron) of this patron
408 return Koha::Patrons->search( { guarantorid => $self->borrowernumber }, { order_by => { -asc => ['surname','firstname'] } } );
411 =head3 housebound_profile
413 Returns the HouseboundProfile associated with this patron.
417 sub housebound_profile {
419 my $profile = $self->_result->housebound_profile;
420 return Koha::Patron::HouseboundProfile->_new_from_dbic($profile)
425 =head3 housebound_role
427 Returns the HouseboundRole associated with this patron.
431 sub housebound_role {
434 my $role = $self->_result->housebound_role;
435 return Koha::Patron::HouseboundRole->_new_from_dbic($role) if ( $role );
441 Returns the siblings of this patron.
448 my $guarantor = $self->guarantor;
450 return unless $guarantor;
452 return Koha::Patrons->search(
456 '=' => $guarantor->id,
459 '!=' => $self->borrowernumber,
467 my $patron = Koha::Patrons->find($id);
468 $patron->merge_with( \@patron_ids );
470 This subroutine merges a list of patrons into the patron record. This is accomplished by finding
471 all related patron ids for the patrons to be merged in other tables and changing the ids to be that
472 of the keeper patron.
477 my ( $self, $patron_ids ) = @_;
479 my @patron_ids = @{ $patron_ids };
481 # Ensure the keeper isn't in the list of patrons to merge
482 @patron_ids = grep { $_ ne $self->id } @patron_ids;
484 my $schema = Koha::Database->new()->schema();
488 $self->_result->result_source->schema->txn_do( sub {
489 foreach my $patron_id (@patron_ids) {
490 my $patron = Koha::Patrons->find( $patron_id );
494 # Unbless for safety, the patron will end up being deleted
495 $results->{merged}->{$patron_id}->{patron} = $patron->unblessed;
497 while (my ($r, $field) = each(%$RESULTSET_PATRON_ID_MAPPING)) {
498 my $rs = $schema->resultset($r)->search({ $field => $patron_id });
499 $results->{merged}->{ $patron_id }->{updated}->{$r} = $rs->count();
500 $rs->update({ $field => $self->id });
503 $patron->move_to_deleted();
513 =head3 wants_check_for_previous_checkout
515 $wants_check = $patron->wants_check_for_previous_checkout;
517 Return 1 if Koha needs to perform PrevIssue checking, else 0.
521 sub wants_check_for_previous_checkout {
523 my $syspref = C4::Context->preference("checkPrevCheckout");
526 ## Hard syspref trumps all
527 return 1 if ($syspref eq 'hardyes');
528 return 0 if ($syspref eq 'hardno');
529 ## Now, patron pref trumps all
530 return 1 if ($self->checkprevcheckout eq 'yes');
531 return 0 if ($self->checkprevcheckout eq 'no');
533 # More complex: patron inherits -> determine category preference
534 my $checkPrevCheckoutByCat = $self->category->checkprevcheckout;
535 return 1 if ($checkPrevCheckoutByCat eq 'yes');
536 return 0 if ($checkPrevCheckoutByCat eq 'no');
538 # Finally: category preference is inherit, default to 0
539 if ($syspref eq 'softyes') {
546 =head3 do_check_for_previous_checkout
548 $do_check = $patron->do_check_for_previous_checkout($item);
550 Return 1 if the bib associated with $ITEM has previously been checked out to
551 $PATRON, 0 otherwise.
555 sub do_check_for_previous_checkout {
556 my ( $self, $item ) = @_;
558 # Find all items for bib and extract item numbers.
559 my @items = Koha::Items->search({biblionumber => $item->{biblionumber}});
561 foreach my $item (@items) {
562 push @item_nos, $item->itemnumber;
565 # Create (old)issues search criteria
567 borrowernumber => $self->borrowernumber,
568 itemnumber => \@item_nos,
571 # Check current issues table
572 my $issues = Koha::Checkouts->search($criteria);
573 return 1 if $issues->count; # 0 || N
575 # Check old issues table
576 my $old_issues = Koha::Old::Checkouts->search($criteria);
577 return $old_issues->count; # 0 || N
582 my $debarment_expiration = $patron->is_debarred;
584 Returns the date a patron debarment will expire, or undef if the patron is not
592 return unless $self->debarred;
593 return $self->debarred
594 if $self->debarred =~ '^9999'
595 or dt_from_string( $self->debarred ) > dt_from_string;
601 my $is_expired = $patron->is_expired;
603 Returns 1 if the patron is expired or 0;
609 return 0 unless $self->dateexpiry;
610 return 0 if $self->dateexpiry =~ '^9999';
611 return 1 if dt_from_string( $self->dateexpiry ) < dt_from_string->truncate( to => 'day' );
615 =head3 is_going_to_expire
617 my $is_going_to_expire = $patron->is_going_to_expire;
619 Returns 1 if the patron is going to expired, depending on the NotifyBorrowerDeparture pref or 0
623 sub is_going_to_expire {
626 my $delay = C4::Context->preference('NotifyBorrowerDeparture') || 0;
628 return 0 unless $delay;
629 return 0 unless $self->dateexpiry;
630 return 0 if $self->dateexpiry =~ '^9999';
631 return 1 if dt_from_string( $self->dateexpiry, undef, 'floating' )->subtract( days => $delay ) < dt_from_string(undef, undef, 'floating')->truncate( to => 'day' );
637 $patron->set_password({ password => $plain_text_password [, skip_validation => 1 ] });
639 Set the patron's password.
643 The passed string is validated against the current password enforcement policy.
644 Validation can be skipped by passing the I<skip_validation> parameter.
646 Exceptions are thrown if the password is not good enough.
650 =item Koha::Exceptions::Password::TooShort
652 =item Koha::Exceptions::Password::WhitespaceCharacters
654 =item Koha::Exceptions::Password::TooWeak
661 my ( $self, $args ) = @_;
663 my $password = $args->{password};
665 unless ( $args->{skip_validation} ) {
666 my ( $is_valid, $error ) = Koha::AuthUtils::is_password_valid( $password );
669 if ( $error eq 'too_short' ) {
670 my $min_length = C4::Context->preference('minPasswordLength');
671 $min_length = 3 if not $min_length or $min_length < 3;
673 my $password_length = length($password);
674 Koha::Exceptions::Password::TooShort->throw(
675 length => $password_length, min_length => $min_length );
677 elsif ( $error eq 'has_whitespaces' ) {
678 Koha::Exceptions::Password::WhitespaceCharacters->throw();
680 elsif ( $error eq 'too_weak' ) {
681 Koha::Exceptions::Password::TooWeak->throw();
686 my $digest = Koha::AuthUtils::hash_password($password);
688 { password => $digest,
693 logaction( "MEMBERS", "CHANGE PASS", $self->borrowernumber, "" )
694 if C4::Context->preference("BorrowersLog");
702 my $new_expiry_date = $patron->renew_account
704 Extending the subscription to the expiry date.
711 if ( C4::Context->preference('BorrowerRenewalPeriodBase') eq 'combination' ) {
712 $date = ( dt_from_string gt dt_from_string( $self->dateexpiry ) ) ? dt_from_string : dt_from_string( $self->dateexpiry );
715 C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry'
716 ? dt_from_string( $self->dateexpiry )
719 my $expiry_date = $self->category->get_expiry_date($date);
721 $self->dateexpiry($expiry_date);
722 $self->date_renewed( dt_from_string() );
725 $self->add_enrolment_fee_if_needed;
727 logaction( "MEMBERS", "RENEW", $self->borrowernumber, "Membership renewed" ) if C4::Context->preference("BorrowersLog");
728 return dt_from_string( $expiry_date )->truncate( to => 'day' );
733 my $has_overdues = $patron->has_overdues;
735 Returns the number of patron's overdues
741 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
742 return $self->_result->issues->search({ date_due => { '<' => $dtf->format_datetime( dt_from_string() ) } })->count;
747 $patron->track_login;
748 $patron->track_login({ force => 1 });
750 Tracks a (successful) login attempt.
751 The preference TrackLastPatronActivity must be enabled. Or you
752 should pass the force parameter.
757 my ( $self, $params ) = @_;
760 !C4::Context->preference('TrackLastPatronActivity');
761 $self->lastseen( dt_from_string() )->store;
764 =head3 move_to_deleted
766 my $is_moved = $patron->move_to_deleted;
768 Move a patron to the deletedborrowers table.
769 This can be done before deleting a patron, to make sure the data are not completely deleted.
773 sub move_to_deleted {
775 my $patron_infos = $self->unblessed;
776 delete $patron_infos->{updated_on}; #This ensures the updated_on date in deletedborrowers will be set to the current timestamp
777 return Koha::Database->new->schema->resultset('Deletedborrower')->create($patron_infos);
780 =head3 article_requests
782 my @requests = $borrower->article_requests();
783 my $requests = $borrower->article_requests();
785 Returns either a list of ArticleRequests objects,
786 or an ArtitleRequests object, depending on the
791 sub article_requests {
794 $self->{_article_requests} ||= Koha::ArticleRequests->search({ borrowernumber => $self->borrowernumber() });
796 return $self->{_article_requests};
799 =head3 article_requests_current
801 my @requests = $patron->article_requests_current
803 Returns the article requests associated with this patron that are incomplete
807 sub article_requests_current {
810 $self->{_article_requests_current} ||= Koha::ArticleRequests->search(
812 borrowernumber => $self->id(),
814 { status => Koha::ArticleRequest::Status::Pending },
815 { status => Koha::ArticleRequest::Status::Processing }
820 return $self->{_article_requests_current};
823 =head3 article_requests_finished
825 my @requests = $biblio->article_requests_finished
827 Returns the article requests associated with this patron that are completed
831 sub article_requests_finished {
832 my ( $self, $borrower ) = @_;
834 $self->{_article_requests_finished} ||= Koha::ArticleRequests->search(
836 borrowernumber => $self->id(),
838 { status => Koha::ArticleRequest::Status::Completed },
839 { status => Koha::ArticleRequest::Status::Canceled }
844 return $self->{_article_requests_finished};
847 =head3 add_enrolment_fee_if_needed
849 my $enrolment_fee = $patron->add_enrolment_fee_if_needed;
851 Add enrolment fee for a patron if needed.
855 sub add_enrolment_fee_if_needed {
857 my $enrolment_fee = $self->category->enrolmentfee;
858 if ( $enrolment_fee && $enrolment_fee > 0 ) {
859 $self->account->add_debit(
861 amount => $enrolment_fee,
862 user_id => C4::Context->userenv ? C4::Context->userenv->{'number'} : undef,
863 interface => C4::Context->interface,
864 library_id => C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef,
869 return $enrolment_fee || 0;
874 my $checkouts = $patron->checkouts
880 my $checkouts = $self->_result->issues;
881 return Koha::Checkouts->_new_from_dbic( $checkouts );
884 =head3 pending_checkouts
886 my $pending_checkouts = $patron->pending_checkouts
888 This method will return the same as $self->checkouts, but with a prefetch on
889 items, biblio and biblioitems.
891 It has been introduced to replaced the C4::Members::GetPendingIssues subroutine
893 It should not be used directly, prefer to access fields you need instead of
894 retrieving all these fields in one go.
898 sub pending_checkouts {
900 my $checkouts = $self->_result->issues->search(
904 { -desc => 'me.timestamp' },
905 { -desc => 'issuedate' },
906 { -desc => 'issue_id' }, # Sort by issue_id should be enough
908 prefetch => { item => { biblio => 'biblioitems' } },
911 return Koha::Checkouts->_new_from_dbic( $checkouts );
916 my $old_checkouts = $patron->old_checkouts
922 my $old_checkouts = $self->_result->old_issues;
923 return Koha::Old::Checkouts->_new_from_dbic( $old_checkouts );
928 my $overdue_items = $patron->get_overdues
930 Return the overdue items
936 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
937 return $self->checkouts->search(
939 'me.date_due' => { '<' => $dtf->format_datetime(dt_from_string) },
942 prefetch => { item => { biblio => 'biblioitems' } },
947 =head3 get_routing_lists
949 my @routinglists = $patron->get_routing_lists
951 Returns the routing lists a patron is subscribed to.
955 sub get_routing_lists {
957 my $routing_list_rs = $self->_result->subscriptionroutinglists;
958 return Koha::Subscription::Routinglists->_new_from_dbic($routing_list_rs);
963 my $age = $patron->get_age
965 Return the age of the patron
971 my $today_str = dt_from_string->strftime("%Y-%m-%d");
972 return unless $self->dateofbirth;
973 my $dob_str = dt_from_string( $self->dateofbirth )->strftime("%Y-%m-%d");
975 my ( $dob_y, $dob_m, $dob_d ) = split /-/, $dob_str;
976 my ( $today_y, $today_m, $today_d ) = split /-/, $today_str;
978 my $age = $today_y - $dob_y;
979 if ( $dob_m . $dob_d > $today_m . $today_d ) {
988 my $account = $patron->account
994 return Koha::Account->new( { patron_id => $self->borrowernumber } );
999 my $holds = $patron->holds
1001 Return all the holds placed by this patron
1007 my $holds_rs = $self->_result->reserves->search( {}, { order_by => 'reservedate' } );
1008 return Koha::Holds->_new_from_dbic($holds_rs);
1013 my $old_holds = $patron->old_holds
1015 Return all the historical holds for this patron
1021 my $old_holds_rs = $self->_result->old_reserves->search( {}, { order_by => 'reservedate' } );
1022 return Koha::Old::Holds->_new_from_dbic($old_holds_rs);
1025 =head3 notice_email_address
1027 my $email = $patron->notice_email_address;
1029 Return the email address of patron used for notices.
1030 Returns the empty string if no email address.
1034 sub notice_email_address{
1037 my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
1038 # if syspref is set to 'first valid' (value == OFF), look up email address
1039 if ( $which_address eq 'OFF' ) {
1040 return $self->first_valid_email_address;
1043 return $self->$which_address || '';
1046 =head3 first_valid_email_address
1048 my $first_valid_email_address = $patron->first_valid_email_address
1050 Return the first valid email address for a patron.
1051 For now, the order is defined as email, emailpro, B_email.
1052 Returns the empty string if the borrower has no email addresses.
1056 sub first_valid_email_address {
1059 return $self->email() || $self->emailpro() || $self->B_email() || q{};
1062 =head3 get_club_enrollments
1066 sub get_club_enrollments {
1067 my ( $self, $return_scalar ) = @_;
1069 my $e = Koha::Club::Enrollments->search( { borrowernumber => $self->borrowernumber(), date_canceled => undef } );
1071 return $e if $return_scalar;
1073 return wantarray ? $e->as_list : $e;
1076 =head3 get_enrollable_clubs
1080 sub get_enrollable_clubs {
1081 my ( $self, $is_enrollable_from_opac, $return_scalar ) = @_;
1084 $params->{is_enrollable_from_opac} = $is_enrollable_from_opac
1085 if $is_enrollable_from_opac;
1086 $params->{is_email_required} = 0 unless $self->first_valid_email_address();
1088 $params->{borrower} = $self;
1090 my $e = Koha::Clubs->get_enrollable($params);
1092 return $e if $return_scalar;
1094 return wantarray ? $e->as_list : $e;
1097 =head3 account_locked
1099 my $is_locked = $patron->account_locked
1101 Return true if the patron has reached the maximum number of login attempts
1102 (see pref FailedLoginAttempts). If login_attempts is < 0, this is interpreted
1103 as an administrative lockout (independent of FailedLoginAttempts; see also
1104 Koha::Patron->lock).
1105 Otherwise return false.
1106 If the pref is not set (empty string, null or 0), the feature is considered as
1111 sub account_locked {
1113 my $FailedLoginAttempts = C4::Context->preference('FailedLoginAttempts');
1114 return 1 if $FailedLoginAttempts
1115 and $self->login_attempts
1116 and $self->login_attempts >= $FailedLoginAttempts;
1117 return 1 if ($self->login_attempts || 0) < 0; # administrative lockout
1121 =head3 can_see_patron_infos
1123 my $can_see = $patron->can_see_patron_infos( $patron );
1125 Return true if the patron (usually the logged in user) can see the patron's infos for a given patron
1129 sub can_see_patron_infos {
1130 my ( $self, $patron ) = @_;
1131 return unless $patron;
1132 return $self->can_see_patrons_from( $patron->library->branchcode );
1135 =head3 can_see_patrons_from
1137 my $can_see = $patron->can_see_patrons_from( $branchcode );
1139 Return true if the patron (usually the logged in user) can see the patron's infos from a given library
1143 sub can_see_patrons_from {
1144 my ( $self, $branchcode ) = @_;
1146 if ( $self->branchcode eq $branchcode ) {
1148 } elsif ( $self->has_permission( { borrowers => 'view_borrower_infos_from_any_libraries' } ) ) {
1150 } elsif ( my $library_groups = $self->library->library_groups ) {
1151 while ( my $library_group = $library_groups->next ) {
1152 if ( $library_group->parent->has_child( $branchcode ) ) {
1161 =head3 libraries_where_can_see_patrons
1163 my $libraries = $patron-libraries_where_can_see_patrons;
1165 Return the list of branchcodes(!) of libraries the patron is allowed to see other patron's infos.
1166 The branchcodes are arbitrarily returned sorted.
1167 We are supposing here that the object is related to the logged in patron (use of C4::Context::only_my_library)
1169 An empty array means no restriction, the patron can see patron's infos from any libraries.
1173 sub libraries_where_can_see_patrons {
1175 my $userenv = C4::Context->userenv;
1177 return () unless $userenv; # For tests, but userenv should be defined in tests...
1179 my @restricted_branchcodes;
1180 if (C4::Context::only_my_library) {
1181 push @restricted_branchcodes, $self->branchcode;
1185 $self->has_permission(
1186 { borrowers => 'view_borrower_infos_from_any_libraries' }
1190 my $library_groups = $self->library->library_groups({ ft_hide_patron_info => 1 });
1191 if ( $library_groups->count )
1193 while ( my $library_group = $library_groups->next ) {
1194 my $parent = $library_group->parent;
1195 if ( $parent->has_child( $self->branchcode ) ) {
1196 push @restricted_branchcodes, $parent->children->get_column('branchcode');
1201 @restricted_branchcodes = ( $self->branchcode ) unless @restricted_branchcodes;
1205 @restricted_branchcodes = grep { defined $_ } @restricted_branchcodes;
1206 @restricted_branchcodes = uniq(@restricted_branchcodes);
1207 @restricted_branchcodes = sort(@restricted_branchcodes);
1208 return @restricted_branchcodes;
1211 sub has_permission {
1212 my ( $self, $flagsrequired ) = @_;
1213 return unless $self->userid;
1214 # TODO code from haspermission needs to be moved here!
1215 return C4::Auth::haspermission( $self->userid, $flagsrequired );
1220 my $is_adult = $patron->is_adult
1222 Return true if the patron has a category with a type Adult (A) or Organization (I)
1228 return $self->category->category_type =~ /^(A|I)$/ ? 1 : 0;
1233 my $is_child = $patron->is_child
1235 Return true if the patron has a category with a type Child (C)
1241 return $self->category->category_type eq 'C' ? 1 : 0;
1244 =head3 has_valid_userid
1246 my $patron = Koha::Patrons->find(42);
1247 $patron->userid( $new_userid );
1248 my $has_a_valid_userid = $patron->has_valid_userid
1250 my $patron = Koha::Patron->new( $params );
1251 my $has_a_valid_userid = $patron->has_valid_userid
1253 Return true if the current userid of this patron is valid/unique, otherwise false.
1255 Note that this should be done in $self->store instead and raise an exception if needed.
1259 sub has_valid_userid {
1262 return 0 unless $self->userid;
1264 return 0 if ( $self->userid eq C4::Context->config('user') ); # DB user
1266 my $already_exists = Koha::Patrons->search(
1268 userid => $self->userid,
1271 ? ( borrowernumber => { '!=' => $self->borrowernumber } )
1276 return $already_exists ? 0 : 1;
1279 =head3 generate_userid
1281 my $patron = Koha::Patron->new( $params );
1282 $patron->generate_userid
1284 Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
1286 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).
1290 sub generate_userid {
1293 my $firstname = $self->firstname // q{};
1294 my $surname = $self->surname // q{};
1295 #The script will "do" the following code and increment the $offset until the generated userid is unique
1297 $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1298 $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1299 my $userid = lc(($firstname)? "$firstname.$surname" : $surname);
1300 $userid = NFKD( $userid );
1301 $userid =~ s/\p{NonspacingMark}//g;
1302 $userid .= $offset unless $offset == 0;
1303 $self->userid( $userid );
1305 } while (! $self->has_valid_userid );
1312 my $attributes = $patron->attributes
1314 Return object of Koha::Patron::Attributes type with all attributes set for this patron
1320 return Koha::Patron::Attributes->search({
1321 borrowernumber => $self->borrowernumber,
1322 branchcode => $self->branchcode,
1328 Koha::Patrons->find($id)->lock({ expire => 1, remove => 1 });
1330 Lock and optionally expire a patron account.
1331 Remove holds and article requests if remove flag set.
1332 In order to distinguish from locking by entering a wrong password, let's
1333 call this an administrative lockout.
1338 my ( $self, $params ) = @_;
1339 $self->login_attempts( ADMINISTRATIVE_LOCKOUT );
1340 if( $params->{expire} ) {
1341 $self->dateexpiry( dt_from_string->subtract(days => 1) );
1344 if( $params->{remove} ) {
1345 $self->holds->delete;
1346 $self->article_requests->delete;
1353 Koha::Patrons->find($id)->anonymize;
1355 Anonymize or clear borrower fields. Fields in BorrowerMandatoryField
1356 are randomized, other personal data is cleared too.
1357 Patrons with issues are skipped.
1363 if( $self->_result->issues->count ) {
1364 warn "Exiting anonymize: patron ".$self->borrowernumber." still has issues";
1367 # Mandatory fields come from the corresponding pref, but email fields
1368 # are removed since scrambled email addresses only generate errors
1369 my $mandatory = { map { (lc $_, 1); } grep { !/email/ }
1370 split /\s*\|\s*/, C4::Context->preference('BorrowerMandatoryField') };
1371 $mandatory->{userid} = 1; # needed since sub store does not clear field
1372 my @columns = $self->_result->result_source->columns;
1373 @columns = grep { !/borrowernumber|branchcode|categorycode|^date|password|flags|updated_on|lastseen|lang|login_attempts|anonymized/ } @columns;
1374 push @columns, 'dateofbirth'; # add this date back in
1375 foreach my $col (@columns) {
1376 $self->_anonymize_column($col, $mandatory->{lc $col} );
1378 $self->anonymized(1)->store;
1381 sub _anonymize_column {
1382 my ( $self, $col, $mandatory ) = @_;
1383 my $col_info = $self->_result->result_source->column_info($col);
1384 my $type = $col_info->{data_type};
1385 my $nullable = $col_info->{is_nullable};
1387 if( $type =~ /char|text/ ) {
1389 ? Koha::Token->new->generate({ pattern => '\w{10}' })
1393 } elsif( $type =~ /integer|int$|float|dec|double/ ) {
1394 $val = $nullable ? undef : 0;
1395 } elsif( $type =~ /date|time/ ) {
1396 $val = $nullable ? undef : dt_from_string;
1401 =head2 Internal methods
1413 Kyle M Hall <kyle@bywatersolutions.com>
1414 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
1415 Martin Renvoize <martin.renvoize@ptfs-europe.com>