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( uniq );
25 use JSON qw( to_json );
26 use Text::Unaccent qw( unac_string );
35 use Koha::Exceptions::Password;
37 use Koha::Old::Checkouts;
38 use Koha::Patron::Categories;
39 use Koha::Patron::HouseboundProfile;
40 use Koha::Patron::HouseboundRole;
41 use Koha::Patron::Images;
43 use Koha::Virtualshelves;
44 use Koha::Club::Enrollments;
46 use Koha::Subscription::Routinglists;
48 use base qw(Koha::Object);
50 our $RESULTSET_PATRON_ID_MAPPING = {
51 Accountline => 'borrowernumber',
52 Aqbasketuser => 'borrowernumber',
53 Aqbudget => 'budget_owner_id',
54 Aqbudgetborrower => 'borrowernumber',
55 ArticleRequest => 'borrowernumber',
56 BorrowerAttribute => 'borrowernumber',
57 BorrowerDebarment => 'borrowernumber',
58 BorrowerFile => 'borrowernumber',
59 BorrowerModification => 'borrowernumber',
60 ClubEnrollment => 'borrowernumber',
61 Issue => 'borrowernumber',
62 ItemsLastBorrower => 'borrowernumber',
63 Linktracker => 'borrowernumber',
64 Message => 'borrowernumber',
65 MessageQueue => 'borrowernumber',
66 OldIssue => 'borrowernumber',
67 OldReserve => 'borrowernumber',
68 Rating => 'borrowernumber',
69 Reserve => 'borrowernumber',
70 Review => 'borrowernumber',
71 SearchHistory => 'userid',
72 Statistic => 'borrowernumber',
73 Suggestion => 'suggestedby',
74 TagAll => 'borrowernumber',
75 Virtualshelfcontent => 'borrowernumber',
76 Virtualshelfshare => 'borrowernumber',
77 Virtualshelve => 'owner',
82 Koha::Patron - Koha Patron Object class
95 my ( $class, $params ) = @_;
97 return $class->SUPER::new($params);
100 =head3 fixup_cardnumber
102 Autogenerate next cardnumber from highest value found in database
106 sub fixup_cardnumber {
108 my $max = Koha::Patrons->search({
109 cardnumber => {-regexp => '^-?[0-9]+$'}
111 select => \'CAST(cardnumber AS SIGNED)',
112 as => ['cast_cardnumber']
113 })->_resultset->get_column('cast_cardnumber')->max;
114 $self->cardnumber(($max || 0) +1);
117 =head3 trim_whitespace
119 trim whitespace from data which has some non-whitespace in it.
120 Could be moved to Koha::Object if need to be reused
124 sub trim_whitespaces {
127 my $schema = Koha::Database->new->schema;
128 my @columns = $schema->source($self->_type)->columns;
130 for my $column( @columns ) {
131 my $value = $self->$column;
132 if ( defined $value ) {
133 $value =~ s/^\s*|\s*$//g;
134 $self->$column($value);
140 =head3 plain_text_password
142 $patron->plain_text_password( $password );
144 stores a copy of the unencrypted password in the object
145 for use in code before encrypting for db
149 sub plain_text_password {
150 my ( $self, $password ) = @_;
152 $self->{_plain_text_password} = $password;
155 return $self->{_plain_text_password}
156 if $self->{_plain_text_password};
163 Patron specific store method to cleanup record
164 and do other necessary things before saving
172 $self->_result->result_source->schema->txn_do(
175 C4::Context->preference("autoMemberNum")
176 and ( not defined $self->cardnumber
177 or $self->cardnumber eq '' )
180 # Warning: The caller is responsible for locking the members table in write
181 # mode, to avoid database corruption.
182 # We are in a transaction but the table is not locked
183 $self->fixup_cardnumber;
186 unless( $self->category->in_storage ) {
187 Koha::Exceptions::Object::FKConstraint->throw(
188 broken_fk => 'categorycode',
189 value => $self->categorycode,
193 $self->trim_whitespaces;
195 # We don't want invalid dates in the db (mysql has a bad habit of inserting 0000-00-00)
196 $self->dateofbirth(undef) unless $self->dateofbirth;
197 $self->debarred(undef) unless $self->debarred;
198 $self->date_renewed(undef) unless $self->date_renewed;
200 # Set default values if not set
201 $self->sms_provider_id(undef) unless $self->sms_provider_id;
202 $self->guarantorid(undef) unless $self->guarantorid;
204 # If flags == 0 or flags == '' => no permission
205 $self->flags(undef) unless $self->flags;
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 unless ( defined $self->privacy_guarantor_checkouts ) {
233 $self->privacy_guarantor_checkouts(0);
236 # Make a copy of the plain text password for later use
237 $self->plain_text_password( $self->password );
239 # Create a disabled account if no password provided
240 $self->password( $self->password
241 ? Koha::AuthUtils::hash_password( $self->password )
244 $self->borrowernumber(undef);
246 $self = $self->SUPER::store;
248 $self->add_enrolment_fee_if_needed;
250 logaction( "MEMBERS", "CREATE", $self->borrowernumber, "" )
251 if C4::Context->preference("BorrowersLog");
255 # Come from ModMember, but should not be possible (?)
256 $self->dateenrolled(undef) unless $self->dateenrolled;
257 $self->dateexpiry(undef) unless $self->dateexpiry;
260 my $self_from_storage = $self->get_from_storage;
261 # FIXME We should not deal with that here, callers have to do this job
262 # Moved from ModMember to prevent regressions
263 unless ( $self->userid ) {
264 my $stored_userid = $self_from_storage->userid;
265 $self->userid($stored_userid);
268 # Password must be updated using $self->update_password
269 $self->password($self_from_storage->password);
271 if ( C4::Context->preference('FeeOnChangePatronCategory')
272 and $self->category->categorycode ne
273 $self_from_storage->category->categorycode )
275 $self->add_enrolment_fee_if_needed;
278 my $borrowers_log = C4::Context->preference("BorrowersLog");
279 my $previous_cardnumber = $self_from_storage->cardnumber;
281 && ( !defined $previous_cardnumber
282 || $previous_cardnumber ne $self->cardnumber )
288 $self->borrowernumber,
291 cardnumber_replaced => {
292 previous_cardnumber => $previous_cardnumber,
293 new_cardnumber => $self->cardnumber,
296 { utf8 => 1, pretty => 1 }
301 logaction( "MEMBERS", "MODIFY", $self->borrowernumber,
302 "UPDATE (executed w/ arg: " . $self->borrowernumber . ")" )
305 $self = $self->SUPER::store;
316 Delete patron's holds, lists and finally the patron.
318 Lists owned by the borrower are deleted, but entries from the borrower to
319 other lists are kept.
327 $self->_result->result_source->schema->txn_do(
329 # Delete Patron's holds
330 $self->holds->delete;
332 # Delete all lists and all shares of this borrower
333 # Consistent with the approach Koha uses on deleting individual lists
334 # Note that entries in virtualshelfcontents added by this borrower to
335 # lists of others will be handled by a table constraint: the borrower
336 # is set to NULL in those entries.
338 # We could handle the above deletes via a constraint too.
339 # But a new BZ report 11889 has been opened to discuss another approach.
340 # Instead of deleting we could also disown lists (based on a pref).
341 # In that way we could save shared and public lists.
342 # The current table constraints support that idea now.
343 # This pref should then govern the results of other routines/methods such as
344 # Koha::Virtualshelf->new->delete too.
345 # FIXME Could be $patron->get_lists
346 $_->delete for Koha::Virtualshelves->search( { owner => $self->borrowernumber } );
348 $deleted = $self->SUPER::delete;
350 logaction( "MEMBERS", "DELETE", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog");
359 my $patron_category = $patron->category
361 Return the patron category for this patron
367 return Koha::Patron::Category->_new_from_dbic( $self->_result->categorycode );
372 Returns a Koha::Patron object for this patron's guarantor
379 return unless $self->guarantorid();
381 return Koha::Patrons->find( $self->guarantorid() );
387 return scalar Koha::Patron::Images->find( $self->borrowernumber );
392 return Koha::Library->_new_from_dbic($self->_result->branchcode);
397 Returns the guarantees (list of Koha::Patron) of this patron
404 return Koha::Patrons->search( { guarantorid => $self->borrowernumber }, { order_by => { -asc => ['surname','firstname'] } } );
407 =head3 housebound_profile
409 Returns the HouseboundProfile associated with this patron.
413 sub housebound_profile {
415 my $profile = $self->_result->housebound_profile;
416 return Koha::Patron::HouseboundProfile->_new_from_dbic($profile)
421 =head3 housebound_role
423 Returns the HouseboundRole associated with this patron.
427 sub housebound_role {
430 my $role = $self->_result->housebound_role;
431 return Koha::Patron::HouseboundRole->_new_from_dbic($role) if ( $role );
437 Returns the siblings of this patron.
444 my $guarantor = $self->guarantor;
446 return unless $guarantor;
448 return Koha::Patrons->search(
452 '=' => $guarantor->id,
455 '!=' => $self->borrowernumber,
463 my $patron = Koha::Patrons->find($id);
464 $patron->merge_with( \@patron_ids );
466 This subroutine merges a list of patrons into the patron record. This is accomplished by finding
467 all related patron ids for the patrons to be merged in other tables and changing the ids to be that
468 of the keeper patron.
473 my ( $self, $patron_ids ) = @_;
475 my @patron_ids = @{ $patron_ids };
477 # Ensure the keeper isn't in the list of patrons to merge
478 @patron_ids = grep { $_ ne $self->id } @patron_ids;
480 my $schema = Koha::Database->new()->schema();
484 $self->_result->result_source->schema->txn_do( sub {
485 foreach my $patron_id (@patron_ids) {
486 my $patron = Koha::Patrons->find( $patron_id );
490 # Unbless for safety, the patron will end up being deleted
491 $results->{merged}->{$patron_id}->{patron} = $patron->unblessed;
493 while (my ($r, $field) = each(%$RESULTSET_PATRON_ID_MAPPING)) {
494 my $rs = $schema->resultset($r)->search({ $field => $patron_id });
495 $results->{merged}->{ $patron_id }->{updated}->{$r} = $rs->count();
496 $rs->update({ $field => $self->id });
499 $patron->move_to_deleted();
509 =head3 wants_check_for_previous_checkout
511 $wants_check = $patron->wants_check_for_previous_checkout;
513 Return 1 if Koha needs to perform PrevIssue checking, else 0.
517 sub wants_check_for_previous_checkout {
519 my $syspref = C4::Context->preference("checkPrevCheckout");
522 ## Hard syspref trumps all
523 return 1 if ($syspref eq 'hardyes');
524 return 0 if ($syspref eq 'hardno');
525 ## Now, patron pref trumps all
526 return 1 if ($self->checkprevcheckout eq 'yes');
527 return 0 if ($self->checkprevcheckout eq 'no');
529 # More complex: patron inherits -> determine category preference
530 my $checkPrevCheckoutByCat = $self->category->checkprevcheckout;
531 return 1 if ($checkPrevCheckoutByCat eq 'yes');
532 return 0 if ($checkPrevCheckoutByCat eq 'no');
534 # Finally: category preference is inherit, default to 0
535 if ($syspref eq 'softyes') {
542 =head3 do_check_for_previous_checkout
544 $do_check = $patron->do_check_for_previous_checkout($item);
546 Return 1 if the bib associated with $ITEM has previously been checked out to
547 $PATRON, 0 otherwise.
551 sub do_check_for_previous_checkout {
552 my ( $self, $item ) = @_;
554 # Find all items for bib and extract item numbers.
555 my @items = Koha::Items->search({biblionumber => $item->{biblionumber}});
557 foreach my $item (@items) {
558 push @item_nos, $item->itemnumber;
561 # Create (old)issues search criteria
563 borrowernumber => $self->borrowernumber,
564 itemnumber => \@item_nos,
567 # Check current issues table
568 my $issues = Koha::Checkouts->search($criteria);
569 return 1 if $issues->count; # 0 || N
571 # Check old issues table
572 my $old_issues = Koha::Old::Checkouts->search($criteria);
573 return $old_issues->count; # 0 || N
578 my $debarment_expiration = $patron->is_debarred;
580 Returns the date a patron debarment will expire, or undef if the patron is not
588 return unless $self->debarred;
589 return $self->debarred
590 if $self->debarred =~ '^9999'
591 or dt_from_string( $self->debarred ) > dt_from_string;
597 my $is_expired = $patron->is_expired;
599 Returns 1 if the patron is expired or 0;
605 return 0 unless $self->dateexpiry;
606 return 0 if $self->dateexpiry =~ '^9999';
607 return 1 if dt_from_string( $self->dateexpiry ) < dt_from_string->truncate( to => 'day' );
611 =head3 is_going_to_expire
613 my $is_going_to_expire = $patron->is_going_to_expire;
615 Returns 1 if the patron is going to expired, depending on the NotifyBorrowerDeparture pref or 0
619 sub is_going_to_expire {
622 my $delay = C4::Context->preference('NotifyBorrowerDeparture') || 0;
624 return 0 unless $delay;
625 return 0 unless $self->dateexpiry;
626 return 0 if $self->dateexpiry =~ '^9999';
627 return 1 if dt_from_string( $self->dateexpiry )->subtract( days => $delay ) < dt_from_string->truncate( to => 'day' );
631 =head3 update_password
633 my $updated = $patron->update_password( $userid, $password );
635 Update the userid and the password of a patron.
636 If the userid already exists, returns and let DBIx::Class warns
637 This will add an entry to action_logs if BorrowersLog is set.
641 sub update_password {
642 my ( $self, $userid, $password ) = @_;
643 eval { $self->userid($userid)->store; };
644 return if $@; # Make sure the userid is not already in used by another patron
646 return 0 if $password eq '****' or $password eq '';
648 my $digest = Koha::AuthUtils::hash_password($password);
656 logaction( "MEMBERS", "CHANGE PASS", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog");
662 $patron->set_password( $plain_text_password );
664 Set the patron's password.
668 The passed string is validated against the current password enforcement policy.
669 Exceptions are thrown if the password is not good enough.
673 =item Koha::Exceptions::Password::TooShort
675 =item Koha::Exceptions::Password::WhitespaceCharacters
677 =item Koha::Exceptions::Password::TooWeak
684 my ( $self, $password ) = @_;
686 my ( $is_valid, $error ) = Koha::AuthUtils::is_password_valid( $password );
689 if ( $error eq 'too_short' ) {
690 my $min_length = C4::Context->preference('minPasswordLength');
691 $min_length = 3 if not $min_length or $min_length < 3;
693 my $password_length = length($password);
694 Koha::Exceptions::Password::TooShort->throw(
695 { length => $password_length, min_length => $min_length } );
697 elsif ( $error eq 'has_whitespaces' ) {
698 Koha::Exceptions::Password::WhitespaceCharacters->throw();
700 elsif ( $error eq 'too_weak' ) {
701 Koha::Exceptions::Password::TooWeak->throw();
705 my $digest = Koha::AuthUtils::hash_password($password);
707 { password => $digest,
712 logaction( "MEMBERS", "CHANGE PASS", $self->borrowernumber, "" )
713 if C4::Context->preference("BorrowersLog");
721 my $new_expiry_date = $patron->renew_account
723 Extending the subscription to the expiry date.
730 if ( C4::Context->preference('BorrowerRenewalPeriodBase') eq 'combination' ) {
731 $date = ( dt_from_string gt dt_from_string( $self->dateexpiry ) ) ? dt_from_string : dt_from_string( $self->dateexpiry );
734 C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry'
735 ? dt_from_string( $self->dateexpiry )
738 my $expiry_date = $self->category->get_expiry_date($date);
740 $self->dateexpiry($expiry_date);
741 $self->date_renewed( dt_from_string() );
744 $self->add_enrolment_fee_if_needed;
746 logaction( "MEMBERS", "RENEW", $self->borrowernumber, "Membership renewed" ) if C4::Context->preference("BorrowersLog");
747 return dt_from_string( $expiry_date )->truncate( to => 'day' );
752 my $has_overdues = $patron->has_overdues;
754 Returns the number of patron's overdues
760 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
761 return $self->_result->issues->search({ date_due => { '<' => $dtf->format_datetime( dt_from_string() ) } })->count;
766 $patron->track_login;
767 $patron->track_login({ force => 1 });
769 Tracks a (successful) login attempt.
770 The preference TrackLastPatronActivity must be enabled. Or you
771 should pass the force parameter.
776 my ( $self, $params ) = @_;
779 !C4::Context->preference('TrackLastPatronActivity');
780 $self->lastseen( dt_from_string() )->store;
783 =head3 move_to_deleted
785 my $is_moved = $patron->move_to_deleted;
787 Move a patron to the deletedborrowers table.
788 This can be done before deleting a patron, to make sure the data are not completely deleted.
792 sub move_to_deleted {
794 my $patron_infos = $self->unblessed;
795 delete $patron_infos->{updated_on}; #This ensures the updated_on date in deletedborrowers will be set to the current timestamp
796 return Koha::Database->new->schema->resultset('Deletedborrower')->create($patron_infos);
799 =head3 article_requests
801 my @requests = $borrower->article_requests();
802 my $requests = $borrower->article_requests();
804 Returns either a list of ArticleRequests objects,
805 or an ArtitleRequests object, depending on the
810 sub article_requests {
813 $self->{_article_requests} ||= Koha::ArticleRequests->search({ borrowernumber => $self->borrowernumber() });
815 return $self->{_article_requests};
818 =head3 article_requests_current
820 my @requests = $patron->article_requests_current
822 Returns the article requests associated with this patron that are incomplete
826 sub article_requests_current {
829 $self->{_article_requests_current} ||= Koha::ArticleRequests->search(
831 borrowernumber => $self->id(),
833 { status => Koha::ArticleRequest::Status::Pending },
834 { status => Koha::ArticleRequest::Status::Processing }
839 return $self->{_article_requests_current};
842 =head3 article_requests_finished
844 my @requests = $biblio->article_requests_finished
846 Returns the article requests associated with this patron that are completed
850 sub article_requests_finished {
851 my ( $self, $borrower ) = @_;
853 $self->{_article_requests_finished} ||= Koha::ArticleRequests->search(
855 borrowernumber => $self->id(),
857 { status => Koha::ArticleRequest::Status::Completed },
858 { status => Koha::ArticleRequest::Status::Canceled }
863 return $self->{_article_requests_finished};
866 =head3 add_enrolment_fee_if_needed
868 my $enrolment_fee = $patron->add_enrolment_fee_if_needed;
870 Add enrolment fee for a patron if needed.
874 sub add_enrolment_fee_if_needed {
876 my $enrolment_fee = $self->category->enrolmentfee;
877 if ( $enrolment_fee && $enrolment_fee > 0 ) {
878 # insert fee in patron debts
879 C4::Accounts::manualinvoice( $self->borrowernumber, '', '', 'A', $enrolment_fee );
881 return $enrolment_fee || 0;
886 my $checkouts = $patron->checkouts
892 my $checkouts = $self->_result->issues;
893 return Koha::Checkouts->_new_from_dbic( $checkouts );
896 =head3 pending_checkouts
898 my $pending_checkouts = $patron->pending_checkouts
900 This method will return the same as $self->checkouts, but with a prefetch on
901 items, biblio and biblioitems.
903 It has been introduced to replaced the C4::Members::GetPendingIssues subroutine
905 It should not be used directly, prefer to access fields you need instead of
906 retrieving all these fields in one go.
911 sub pending_checkouts {
913 my $checkouts = $self->_result->issues->search(
917 { -desc => 'me.timestamp' },
918 { -desc => 'issuedate' },
919 { -desc => 'issue_id' }, # Sort by issue_id should be enough
921 prefetch => { item => { biblio => 'biblioitems' } },
924 return Koha::Checkouts->_new_from_dbic( $checkouts );
929 my $old_checkouts = $patron->old_checkouts
935 my $old_checkouts = $self->_result->old_issues;
936 return Koha::Old::Checkouts->_new_from_dbic( $old_checkouts );
941 my $overdue_items = $patron->get_overdues
943 Return the overdue items
949 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
950 return $self->checkouts->search(
952 'me.date_due' => { '<' => $dtf->format_datetime(dt_from_string) },
955 prefetch => { item => { biblio => 'biblioitems' } },
960 =head3 get_routing_lists
962 my @routinglists = $patron->get_routing_lists
964 Returns the routing lists a patron is subscribed to.
968 sub get_routing_lists {
970 my $routing_list_rs = $self->_result->subscriptionroutinglists;
971 return Koha::Subscription::Routinglists->_new_from_dbic($routing_list_rs);
976 my $age = $patron->get_age
978 Return the age of the patron
984 my $today_str = dt_from_string->strftime("%Y-%m-%d");
985 return unless $self->dateofbirth;
986 my $dob_str = dt_from_string( $self->dateofbirth )->strftime("%Y-%m-%d");
988 my ( $dob_y, $dob_m, $dob_d ) = split /-/, $dob_str;
989 my ( $today_y, $today_m, $today_d ) = split /-/, $today_str;
991 my $age = $today_y - $dob_y;
992 if ( $dob_m . $dob_d > $today_m . $today_d ) {
1001 my $account = $patron->account
1007 return Koha::Account->new( { patron_id => $self->borrowernumber } );
1012 my $holds = $patron->holds
1014 Return all the holds placed by this patron
1020 my $holds_rs = $self->_result->reserves->search( {}, { order_by => 'reservedate' } );
1021 return Koha::Holds->_new_from_dbic($holds_rs);
1026 my $old_holds = $patron->old_holds
1028 Return all the historical holds for this patron
1034 my $old_holds_rs = $self->_result->old_reserves->search( {}, { order_by => 'reservedate' } );
1035 return Koha::Old::Holds->_new_from_dbic($old_holds_rs);
1038 =head3 notice_email_address
1040 my $email = $patron->notice_email_address;
1042 Return the email address of patron used for notices.
1043 Returns the empty string if no email address.
1047 sub notice_email_address{
1050 my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
1051 # if syspref is set to 'first valid' (value == OFF), look up email address
1052 if ( $which_address eq 'OFF' ) {
1053 return $self->first_valid_email_address;
1056 return $self->$which_address || '';
1059 =head3 first_valid_email_address
1061 my $first_valid_email_address = $patron->first_valid_email_address
1063 Return the first valid email address for a patron.
1064 For now, the order is defined as email, emailpro, B_email.
1065 Returns the empty string if the borrower has no email addresses.
1069 sub first_valid_email_address {
1072 return $self->email() || $self->emailpro() || $self->B_email() || q{};
1075 =head3 get_club_enrollments
1079 sub get_club_enrollments {
1080 my ( $self, $return_scalar ) = @_;
1082 my $e = Koha::Club::Enrollments->search( { borrowernumber => $self->borrowernumber(), date_canceled => undef } );
1084 return $e if $return_scalar;
1086 return wantarray ? $e->as_list : $e;
1089 =head3 get_enrollable_clubs
1093 sub get_enrollable_clubs {
1094 my ( $self, $is_enrollable_from_opac, $return_scalar ) = @_;
1097 $params->{is_enrollable_from_opac} = $is_enrollable_from_opac
1098 if $is_enrollable_from_opac;
1099 $params->{is_email_required} = 0 unless $self->first_valid_email_address();
1101 $params->{borrower} = $self;
1103 my $e = Koha::Clubs->get_enrollable($params);
1105 return $e if $return_scalar;
1107 return wantarray ? $e->as_list : $e;
1110 =head3 account_locked
1112 my $is_locked = $patron->account_locked
1114 Return true if the patron has reach the maximum number of login attempts (see pref FailedLoginAttempts).
1115 Otherwise return false.
1116 If the pref is not set (empty string, null or 0), the feature is considered as disabled.
1120 sub account_locked {
1122 my $FailedLoginAttempts = C4::Context->preference('FailedLoginAttempts');
1123 return ( $FailedLoginAttempts
1124 and $self->login_attempts
1125 and $self->login_attempts >= $FailedLoginAttempts )? 1 : 0;
1128 =head3 can_see_patron_infos
1130 my $can_see = $patron->can_see_patron_infos( $patron );
1132 Return true if the patron (usually the logged in user) can see the patron's infos for a given patron
1136 sub can_see_patron_infos {
1137 my ( $self, $patron ) = @_;
1138 return $self->can_see_patrons_from( $patron->library->branchcode );
1141 =head3 can_see_patrons_from
1143 my $can_see = $patron->can_see_patrons_from( $branchcode );
1145 Return true if the patron (usually the logged in user) can see the patron's infos from a given library
1149 sub can_see_patrons_from {
1150 my ( $self, $branchcode ) = @_;
1152 if ( $self->branchcode eq $branchcode ) {
1154 } elsif ( $self->has_permission( { borrowers => 'view_borrower_infos_from_any_libraries' } ) ) {
1156 } elsif ( my $library_groups = $self->library->library_groups ) {
1157 while ( my $library_group = $library_groups->next ) {
1158 if ( $library_group->parent->has_child( $branchcode ) ) {
1167 =head3 libraries_where_can_see_patrons
1169 my $libraries = $patron-libraries_where_can_see_patrons;
1171 Return the list of branchcodes(!) of libraries the patron is allowed to see other patron's infos.
1172 The branchcodes are arbitrarily returned sorted.
1173 We are supposing here that the object is related to the logged in patron (use of C4::Context::only_my_library)
1175 An empty array means no restriction, the patron can see patron's infos from any libraries.
1179 sub libraries_where_can_see_patrons {
1181 my $userenv = C4::Context->userenv;
1183 return () unless $userenv; # For tests, but userenv should be defined in tests...
1185 my @restricted_branchcodes;
1186 if (C4::Context::only_my_library) {
1187 push @restricted_branchcodes, $self->branchcode;
1191 $self->has_permission(
1192 { borrowers => 'view_borrower_infos_from_any_libraries' }
1196 my $library_groups = $self->library->library_groups({ ft_hide_patron_info => 1 });
1197 if ( $library_groups->count )
1199 while ( my $library_group = $library_groups->next ) {
1200 my $parent = $library_group->parent;
1201 if ( $parent->has_child( $self->branchcode ) ) {
1202 push @restricted_branchcodes, $parent->children->get_column('branchcode');
1207 @restricted_branchcodes = ( $self->branchcode ) unless @restricted_branchcodes;
1211 @restricted_branchcodes = grep { defined $_ } @restricted_branchcodes;
1212 @restricted_branchcodes = uniq(@restricted_branchcodes);
1213 @restricted_branchcodes = sort(@restricted_branchcodes);
1214 return @restricted_branchcodes;
1217 sub has_permission {
1218 my ( $self, $flagsrequired ) = @_;
1219 return unless $self->userid;
1220 # TODO code from haspermission needs to be moved here!
1221 return C4::Auth::haspermission( $self->userid, $flagsrequired );
1226 my $is_adult = $patron->is_adult
1228 Return true if the patron has a category with a type Adult (A) or Organization (I)
1234 return $self->category->category_type =~ /^(A|I)$/ ? 1 : 0;
1239 my $is_child = $patron->is_child
1241 Return true if the patron has a category with a type Child (C)
1246 return $self->category->category_type eq 'C' ? 1 : 0;
1249 =head3 has_valid_userid
1251 my $patron = Koha::Patrons->find(42);
1252 $patron->userid( $new_userid );
1253 my $has_a_valid_userid = $patron->has_valid_userid
1255 my $patron = Koha::Patron->new( $params );
1256 my $has_a_valid_userid = $patron->has_valid_userid
1258 Return true if the current userid of this patron is valid/unique, otherwise false.
1260 Note that this should be done in $self->store instead and raise an exception if needed.
1264 sub has_valid_userid {
1267 return 0 unless $self->userid;
1269 return 0 if ( $self->userid eq C4::Context->config('user') ); # DB user
1271 my $already_exists = Koha::Patrons->search(
1273 userid => $self->userid,
1276 ? ( borrowernumber => { '!=' => $self->borrowernumber } )
1281 return $already_exists ? 0 : 1;
1284 =head3 generate_userid
1286 my $patron = Koha::Patron->new( $params );
1287 $patron->generate_userid
1289 Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
1291 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).
1295 sub generate_userid {
1298 my $firstname = $self->firstname // q{};
1299 my $surname = $self->surname // q{};
1300 #The script will "do" the following code and increment the $offset until the generated userid is unique
1302 $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1303 $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1304 my $userid = lc(($firstname)? "$firstname.$surname" : $surname);
1305 $userid = unac_string('utf-8',$userid);
1306 $userid .= $offset unless $offset == 0;
1307 $self->userid( $userid );
1309 } while (! $self->has_valid_userid );
1315 =head2 Internal methods
1327 Kyle M Hall <kyle@bywatersolutions.com>
1328 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>