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;
199 $self->lastseen(undef) unless $self->lastseen;
201 if ( defined $self->updated_on and not $self->updated_on ) {
202 $self->updated_on(undef);
205 # Set default values if not set
206 $self->sms_provider_id(undef) unless $self->sms_provider_id;
207 $self->guarantorid(undef) unless $self->guarantorid;
209 # If flags == 0 or flags == '' => no permission
210 $self->flags(undef) unless $self->flags;
213 $self->gonenoaddress(0) unless $self->gonenoaddress;
214 $self->login_attempts(0) unless $self->login_attempts;
215 $self->privacy_guarantor_checkouts(0) unless $self->privacy_guarantor_checkouts;
216 $self->lost(0) unless $self->lost;
218 unless ( $self->in_storage ) { #AddMember
220 # Generate a valid userid/login if needed
221 $self->generate_userid
222 if not $self->userid or not $self->has_valid_userid;
224 # Add expiration date if it isn't already there
225 unless ( $self->dateexpiry ) {
226 $self->dateexpiry( $self->category->get_expiry_date );
229 # Add enrollment date if it isn't already there
230 unless ( $self->dateenrolled ) {
231 $self->dateenrolled(dt_from_string);
234 # Set the privacy depending on the patron's category
235 my $default_privacy = $self->category->default_privacy || q{};
237 $default_privacy eq 'default' ? 1
238 : $default_privacy eq 'never' ? 2
239 : $default_privacy eq 'forever' ? 0
241 $self->privacy($default_privacy);
243 unless ( defined $self->privacy_guarantor_checkouts ) {
244 $self->privacy_guarantor_checkouts(0);
247 # Make a copy of the plain text password for later use
248 $self->plain_text_password( $self->password );
250 # Create a disabled account if no password provided
251 $self->password( $self->password
252 ? Koha::AuthUtils::hash_password( $self->password )
255 $self->borrowernumber(undef);
257 $self = $self->SUPER::store;
259 $self->add_enrolment_fee_if_needed;
261 logaction( "MEMBERS", "CREATE", $self->borrowernumber, "" )
262 if C4::Context->preference("BorrowersLog");
266 # Come from ModMember, but should not be possible (?)
267 $self->dateenrolled(undef) unless $self->dateenrolled;
268 $self->dateexpiry(undef) unless $self->dateexpiry;
271 my $self_from_storage = $self->get_from_storage;
272 # FIXME We should not deal with that here, callers have to do this job
273 # Moved from ModMember to prevent regressions
274 unless ( $self->userid ) {
275 my $stored_userid = $self_from_storage->userid;
276 $self->userid($stored_userid);
279 # Password must be updated using $self->set_password
280 $self->password($self_from_storage->password);
282 if ( C4::Context->preference('FeeOnChangePatronCategory')
283 and $self->category->categorycode ne
284 $self_from_storage->category->categorycode )
286 $self->add_enrolment_fee_if_needed;
289 my $borrowers_log = C4::Context->preference("BorrowersLog");
290 my $previous_cardnumber = $self_from_storage->cardnumber;
292 && ( !defined $previous_cardnumber
293 || $previous_cardnumber ne $self->cardnumber )
299 $self->borrowernumber,
302 cardnumber_replaced => {
303 previous_cardnumber => $previous_cardnumber,
304 new_cardnumber => $self->cardnumber,
307 { utf8 => 1, pretty => 1 }
312 logaction( "MEMBERS", "MODIFY", $self->borrowernumber,
313 "UPDATE (executed w/ arg: " . $self->borrowernumber . ")" )
316 $self = $self->SUPER::store;
327 Delete patron's holds, lists and finally the patron.
329 Lists owned by the borrower are deleted, but entries from the borrower to
330 other lists are kept.
338 $self->_result->result_source->schema->txn_do(
340 # Delete Patron's holds
341 $self->holds->delete;
343 # Delete all lists and all shares of this borrower
344 # Consistent with the approach Koha uses on deleting individual lists
345 # Note that entries in virtualshelfcontents added by this borrower to
346 # lists of others will be handled by a table constraint: the borrower
347 # is set to NULL in those entries.
349 # We could handle the above deletes via a constraint too.
350 # But a new BZ report 11889 has been opened to discuss another approach.
351 # Instead of deleting we could also disown lists (based on a pref).
352 # In that way we could save shared and public lists.
353 # The current table constraints support that idea now.
354 # This pref should then govern the results of other routines/methods such as
355 # Koha::Virtualshelf->new->delete too.
356 # FIXME Could be $patron->get_lists
357 $_->delete for Koha::Virtualshelves->search( { owner => $self->borrowernumber } );
359 $deleted = $self->SUPER::delete;
361 logaction( "MEMBERS", "DELETE", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog");
370 my $patron_category = $patron->category
372 Return the patron category for this patron
378 return Koha::Patron::Category->_new_from_dbic( $self->_result->categorycode );
383 Returns a Koha::Patron object for this patron's guarantor
390 return unless $self->guarantorid();
392 return Koha::Patrons->find( $self->guarantorid() );
398 return scalar Koha::Patron::Images->find( $self->borrowernumber );
403 return Koha::Library->_new_from_dbic($self->_result->branchcode);
408 Returns the guarantees (list of Koha::Patron) of this patron
415 return Koha::Patrons->search( { guarantorid => $self->borrowernumber }, { order_by => { -asc => ['surname','firstname'] } } );
418 =head3 housebound_profile
420 Returns the HouseboundProfile associated with this patron.
424 sub housebound_profile {
426 my $profile = $self->_result->housebound_profile;
427 return Koha::Patron::HouseboundProfile->_new_from_dbic($profile)
432 =head3 housebound_role
434 Returns the HouseboundRole associated with this patron.
438 sub housebound_role {
441 my $role = $self->_result->housebound_role;
442 return Koha::Patron::HouseboundRole->_new_from_dbic($role) if ( $role );
448 Returns the siblings of this patron.
455 my $guarantor = $self->guarantor;
457 return unless $guarantor;
459 return Koha::Patrons->search(
463 '=' => $guarantor->id,
466 '!=' => $self->borrowernumber,
474 my $patron = Koha::Patrons->find($id);
475 $patron->merge_with( \@patron_ids );
477 This subroutine merges a list of patrons into the patron record. This is accomplished by finding
478 all related patron ids for the patrons to be merged in other tables and changing the ids to be that
479 of the keeper patron.
484 my ( $self, $patron_ids ) = @_;
486 my @patron_ids = @{ $patron_ids };
488 # Ensure the keeper isn't in the list of patrons to merge
489 @patron_ids = grep { $_ ne $self->id } @patron_ids;
491 my $schema = Koha::Database->new()->schema();
495 $self->_result->result_source->schema->txn_do( sub {
496 foreach my $patron_id (@patron_ids) {
497 my $patron = Koha::Patrons->find( $patron_id );
501 # Unbless for safety, the patron will end up being deleted
502 $results->{merged}->{$patron_id}->{patron} = $patron->unblessed;
504 while (my ($r, $field) = each(%$RESULTSET_PATRON_ID_MAPPING)) {
505 my $rs = $schema->resultset($r)->search({ $field => $patron_id });
506 $results->{merged}->{ $patron_id }->{updated}->{$r} = $rs->count();
507 $rs->update({ $field => $self->id });
510 $patron->move_to_deleted();
520 =head3 wants_check_for_previous_checkout
522 $wants_check = $patron->wants_check_for_previous_checkout;
524 Return 1 if Koha needs to perform PrevIssue checking, else 0.
528 sub wants_check_for_previous_checkout {
530 my $syspref = C4::Context->preference("checkPrevCheckout");
533 ## Hard syspref trumps all
534 return 1 if ($syspref eq 'hardyes');
535 return 0 if ($syspref eq 'hardno');
536 ## Now, patron pref trumps all
537 return 1 if ($self->checkprevcheckout eq 'yes');
538 return 0 if ($self->checkprevcheckout eq 'no');
540 # More complex: patron inherits -> determine category preference
541 my $checkPrevCheckoutByCat = $self->category->checkprevcheckout;
542 return 1 if ($checkPrevCheckoutByCat eq 'yes');
543 return 0 if ($checkPrevCheckoutByCat eq 'no');
545 # Finally: category preference is inherit, default to 0
546 if ($syspref eq 'softyes') {
553 =head3 do_check_for_previous_checkout
555 $do_check = $patron->do_check_for_previous_checkout($item);
557 Return 1 if the bib associated with $ITEM has previously been checked out to
558 $PATRON, 0 otherwise.
562 sub do_check_for_previous_checkout {
563 my ( $self, $item ) = @_;
565 # Find all items for bib and extract item numbers.
566 my @items = Koha::Items->search({biblionumber => $item->{biblionumber}});
568 foreach my $item (@items) {
569 push @item_nos, $item->itemnumber;
572 # Create (old)issues search criteria
574 borrowernumber => $self->borrowernumber,
575 itemnumber => \@item_nos,
578 # Check current issues table
579 my $issues = Koha::Checkouts->search($criteria);
580 return 1 if $issues->count; # 0 || N
582 # Check old issues table
583 my $old_issues = Koha::Old::Checkouts->search($criteria);
584 return $old_issues->count; # 0 || N
589 my $debarment_expiration = $patron->is_debarred;
591 Returns the date a patron debarment will expire, or undef if the patron is not
599 return unless $self->debarred;
600 return $self->debarred
601 if $self->debarred =~ '^9999'
602 or dt_from_string( $self->debarred ) > dt_from_string;
608 my $is_expired = $patron->is_expired;
610 Returns 1 if the patron is expired or 0;
616 return 0 unless $self->dateexpiry;
617 return 0 if $self->dateexpiry =~ '^9999';
618 return 1 if dt_from_string( $self->dateexpiry ) < dt_from_string->truncate( to => 'day' );
622 =head3 is_going_to_expire
624 my $is_going_to_expire = $patron->is_going_to_expire;
626 Returns 1 if the patron is going to expired, depending on the NotifyBorrowerDeparture pref or 0
630 sub is_going_to_expire {
633 my $delay = C4::Context->preference('NotifyBorrowerDeparture') || 0;
635 return 0 unless $delay;
636 return 0 unless $self->dateexpiry;
637 return 0 if $self->dateexpiry =~ '^9999';
638 return 1 if dt_from_string( $self->dateexpiry )->subtract( days => $delay ) < dt_from_string->truncate( to => 'day' );
644 $patron->set_password({ password => $plain_text_password [, skip_validation => 1 ] });
646 Set the patron's password.
650 The passed string is validated against the current password enforcement policy.
651 Validation can be skipped by passing the I<skip_validation> parameter.
653 Exceptions are thrown if the password is not good enough.
657 =item Koha::Exceptions::Password::TooShort
659 =item Koha::Exceptions::Password::WhitespaceCharacters
661 =item Koha::Exceptions::Password::TooWeak
668 my ( $self, $args ) = @_;
670 my $password = $args->{password};
672 unless ( $args->{skip_validation} ) {
673 my ( $is_valid, $error ) = Koha::AuthUtils::is_password_valid( $password );
676 if ( $error eq 'too_short' ) {
677 my $min_length = C4::Context->preference('minPasswordLength');
678 $min_length = 3 if not $min_length or $min_length < 3;
680 my $password_length = length($password);
681 Koha::Exceptions::Password::TooShort->throw(
682 length => $password_length, min_length => $min_length );
684 elsif ( $error eq 'has_whitespaces' ) {
685 Koha::Exceptions::Password::WhitespaceCharacters->throw();
687 elsif ( $error eq 'too_weak' ) {
688 Koha::Exceptions::Password::TooWeak->throw();
693 my $digest = Koha::AuthUtils::hash_password($password);
695 { password => $digest,
700 logaction( "MEMBERS", "CHANGE PASS", $self->borrowernumber, "" )
701 if C4::Context->preference("BorrowersLog");
709 my $new_expiry_date = $patron->renew_account
711 Extending the subscription to the expiry date.
718 if ( C4::Context->preference('BorrowerRenewalPeriodBase') eq 'combination' ) {
719 $date = ( dt_from_string gt dt_from_string( $self->dateexpiry ) ) ? dt_from_string : dt_from_string( $self->dateexpiry );
722 C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry'
723 ? dt_from_string( $self->dateexpiry )
726 my $expiry_date = $self->category->get_expiry_date($date);
728 $self->dateexpiry($expiry_date);
729 $self->date_renewed( dt_from_string() );
732 $self->add_enrolment_fee_if_needed;
734 logaction( "MEMBERS", "RENEW", $self->borrowernumber, "Membership renewed" ) if C4::Context->preference("BorrowersLog");
735 return dt_from_string( $expiry_date )->truncate( to => 'day' );
740 my $has_overdues = $patron->has_overdues;
742 Returns the number of patron's overdues
748 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
749 return $self->_result->issues->search({ date_due => { '<' => $dtf->format_datetime( dt_from_string() ) } })->count;
754 $patron->track_login;
755 $patron->track_login({ force => 1 });
757 Tracks a (successful) login attempt.
758 The preference TrackLastPatronActivity must be enabled. Or you
759 should pass the force parameter.
764 my ( $self, $params ) = @_;
767 !C4::Context->preference('TrackLastPatronActivity');
768 $self->lastseen( dt_from_string() )->store;
771 =head3 move_to_deleted
773 my $is_moved = $patron->move_to_deleted;
775 Move a patron to the deletedborrowers table.
776 This can be done before deleting a patron, to make sure the data are not completely deleted.
780 sub move_to_deleted {
782 my $patron_infos = $self->unblessed;
783 delete $patron_infos->{updated_on}; #This ensures the updated_on date in deletedborrowers will be set to the current timestamp
784 return Koha::Database->new->schema->resultset('Deletedborrower')->create($patron_infos);
787 =head3 article_requests
789 my @requests = $borrower->article_requests();
790 my $requests = $borrower->article_requests();
792 Returns either a list of ArticleRequests objects,
793 or an ArtitleRequests object, depending on the
798 sub article_requests {
801 $self->{_article_requests} ||= Koha::ArticleRequests->search({ borrowernumber => $self->borrowernumber() });
803 return $self->{_article_requests};
806 =head3 article_requests_current
808 my @requests = $patron->article_requests_current
810 Returns the article requests associated with this patron that are incomplete
814 sub article_requests_current {
817 $self->{_article_requests_current} ||= Koha::ArticleRequests->search(
819 borrowernumber => $self->id(),
821 { status => Koha::ArticleRequest::Status::Pending },
822 { status => Koha::ArticleRequest::Status::Processing }
827 return $self->{_article_requests_current};
830 =head3 article_requests_finished
832 my @requests = $biblio->article_requests_finished
834 Returns the article requests associated with this patron that are completed
838 sub article_requests_finished {
839 my ( $self, $borrower ) = @_;
841 $self->{_article_requests_finished} ||= Koha::ArticleRequests->search(
843 borrowernumber => $self->id(),
845 { status => Koha::ArticleRequest::Status::Completed },
846 { status => Koha::ArticleRequest::Status::Canceled }
851 return $self->{_article_requests_finished};
854 =head3 add_enrolment_fee_if_needed
856 my $enrolment_fee = $patron->add_enrolment_fee_if_needed;
858 Add enrolment fee for a patron if needed.
862 sub add_enrolment_fee_if_needed {
864 my $enrolment_fee = $self->category->enrolmentfee;
865 if ( $enrolment_fee && $enrolment_fee > 0 ) {
866 # insert fee in patron debts
867 C4::Accounts::manualinvoice( $self->borrowernumber, '', '', 'A', $enrolment_fee );
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.
899 sub pending_checkouts {
901 my $checkouts = $self->_result->issues->search(
905 { -desc => 'me.timestamp' },
906 { -desc => 'issuedate' },
907 { -desc => 'issue_id' }, # Sort by issue_id should be enough
909 prefetch => { item => { biblio => 'biblioitems' } },
912 return Koha::Checkouts->_new_from_dbic( $checkouts );
917 my $old_checkouts = $patron->old_checkouts
923 my $old_checkouts = $self->_result->old_issues;
924 return Koha::Old::Checkouts->_new_from_dbic( $old_checkouts );
929 my $overdue_items = $patron->get_overdues
931 Return the overdue items
937 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
938 return $self->checkouts->search(
940 'me.date_due' => { '<' => $dtf->format_datetime(dt_from_string) },
943 prefetch => { item => { biblio => 'biblioitems' } },
948 =head3 get_routing_lists
950 my @routinglists = $patron->get_routing_lists
952 Returns the routing lists a patron is subscribed to.
956 sub get_routing_lists {
958 my $routing_list_rs = $self->_result->subscriptionroutinglists;
959 return Koha::Subscription::Routinglists->_new_from_dbic($routing_list_rs);
964 my $age = $patron->get_age
966 Return the age of the patron
972 my $today_str = dt_from_string->strftime("%Y-%m-%d");
973 return unless $self->dateofbirth;
974 my $dob_str = dt_from_string( $self->dateofbirth )->strftime("%Y-%m-%d");
976 my ( $dob_y, $dob_m, $dob_d ) = split /-/, $dob_str;
977 my ( $today_y, $today_m, $today_d ) = split /-/, $today_str;
979 my $age = $today_y - $dob_y;
980 if ( $dob_m . $dob_d > $today_m . $today_d ) {
989 my $account = $patron->account
995 return Koha::Account->new( { patron_id => $self->borrowernumber } );
1000 my $holds = $patron->holds
1002 Return all the holds placed by this patron
1008 my $holds_rs = $self->_result->reserves->search( {}, { order_by => 'reservedate' } );
1009 return Koha::Holds->_new_from_dbic($holds_rs);
1014 my $old_holds = $patron->old_holds
1016 Return all the historical holds for this patron
1022 my $old_holds_rs = $self->_result->old_reserves->search( {}, { order_by => 'reservedate' } );
1023 return Koha::Old::Holds->_new_from_dbic($old_holds_rs);
1026 =head3 notice_email_address
1028 my $email = $patron->notice_email_address;
1030 Return the email address of patron used for notices.
1031 Returns the empty string if no email address.
1035 sub notice_email_address{
1038 my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
1039 # if syspref is set to 'first valid' (value == OFF), look up email address
1040 if ( $which_address eq 'OFF' ) {
1041 return $self->first_valid_email_address;
1044 return $self->$which_address || '';
1047 =head3 first_valid_email_address
1049 my $first_valid_email_address = $patron->first_valid_email_address
1051 Return the first valid email address for a patron.
1052 For now, the order is defined as email, emailpro, B_email.
1053 Returns the empty string if the borrower has no email addresses.
1057 sub first_valid_email_address {
1060 return $self->email() || $self->emailpro() || $self->B_email() || q{};
1063 =head3 get_club_enrollments
1067 sub get_club_enrollments {
1068 my ( $self, $return_scalar ) = @_;
1070 my $e = Koha::Club::Enrollments->search( { borrowernumber => $self->borrowernumber(), date_canceled => undef } );
1072 return $e if $return_scalar;
1074 return wantarray ? $e->as_list : $e;
1077 =head3 get_enrollable_clubs
1081 sub get_enrollable_clubs {
1082 my ( $self, $is_enrollable_from_opac, $return_scalar ) = @_;
1085 $params->{is_enrollable_from_opac} = $is_enrollable_from_opac
1086 if $is_enrollable_from_opac;
1087 $params->{is_email_required} = 0 unless $self->first_valid_email_address();
1089 $params->{borrower} = $self;
1091 my $e = Koha::Clubs->get_enrollable($params);
1093 return $e if $return_scalar;
1095 return wantarray ? $e->as_list : $e;
1098 =head3 account_locked
1100 my $is_locked = $patron->account_locked
1102 Return true if the patron has reach the maximum number of login attempts (see pref FailedLoginAttempts).
1103 Otherwise return false.
1104 If the pref is not set (empty string, null or 0), the feature is considered as disabled.
1108 sub account_locked {
1110 my $FailedLoginAttempts = C4::Context->preference('FailedLoginAttempts');
1111 return ( $FailedLoginAttempts
1112 and $self->login_attempts
1113 and $self->login_attempts >= $FailedLoginAttempts )? 1 : 0;
1116 =head3 can_see_patron_infos
1118 my $can_see = $patron->can_see_patron_infos( $patron );
1120 Return true if the patron (usually the logged in user) can see the patron's infos for a given patron
1124 sub can_see_patron_infos {
1125 my ( $self, $patron ) = @_;
1126 return $self->can_see_patrons_from( $patron->library->branchcode );
1129 =head3 can_see_patrons_from
1131 my $can_see = $patron->can_see_patrons_from( $branchcode );
1133 Return true if the patron (usually the logged in user) can see the patron's infos from a given library
1137 sub can_see_patrons_from {
1138 my ( $self, $branchcode ) = @_;
1140 if ( $self->branchcode eq $branchcode ) {
1142 } elsif ( $self->has_permission( { borrowers => 'view_borrower_infos_from_any_libraries' } ) ) {
1144 } elsif ( my $library_groups = $self->library->library_groups ) {
1145 while ( my $library_group = $library_groups->next ) {
1146 if ( $library_group->parent->has_child( $branchcode ) ) {
1155 =head3 libraries_where_can_see_patrons
1157 my $libraries = $patron-libraries_where_can_see_patrons;
1159 Return the list of branchcodes(!) of libraries the patron is allowed to see other patron's infos.
1160 The branchcodes are arbitrarily returned sorted.
1161 We are supposing here that the object is related to the logged in patron (use of C4::Context::only_my_library)
1163 An empty array means no restriction, the patron can see patron's infos from any libraries.
1167 sub libraries_where_can_see_patrons {
1169 my $userenv = C4::Context->userenv;
1171 return () unless $userenv; # For tests, but userenv should be defined in tests...
1173 my @restricted_branchcodes;
1174 if (C4::Context::only_my_library) {
1175 push @restricted_branchcodes, $self->branchcode;
1179 $self->has_permission(
1180 { borrowers => 'view_borrower_infos_from_any_libraries' }
1184 my $library_groups = $self->library->library_groups({ ft_hide_patron_info => 1 });
1185 if ( $library_groups->count )
1187 while ( my $library_group = $library_groups->next ) {
1188 my $parent = $library_group->parent;
1189 if ( $parent->has_child( $self->branchcode ) ) {
1190 push @restricted_branchcodes, $parent->children->get_column('branchcode');
1195 @restricted_branchcodes = ( $self->branchcode ) unless @restricted_branchcodes;
1199 @restricted_branchcodes = grep { defined $_ } @restricted_branchcodes;
1200 @restricted_branchcodes = uniq(@restricted_branchcodes);
1201 @restricted_branchcodes = sort(@restricted_branchcodes);
1202 return @restricted_branchcodes;
1205 sub has_permission {
1206 my ( $self, $flagsrequired ) = @_;
1207 return unless $self->userid;
1208 # TODO code from haspermission needs to be moved here!
1209 return C4::Auth::haspermission( $self->userid, $flagsrequired );
1214 my $is_adult = $patron->is_adult
1216 Return true if the patron has a category with a type Adult (A) or Organization (I)
1222 return $self->category->category_type =~ /^(A|I)$/ ? 1 : 0;
1227 my $is_child = $patron->is_child
1229 Return true if the patron has a category with a type Child (C)
1234 return $self->category->category_type eq 'C' ? 1 : 0;
1237 =head3 has_valid_userid
1239 my $patron = Koha::Patrons->find(42);
1240 $patron->userid( $new_userid );
1241 my $has_a_valid_userid = $patron->has_valid_userid
1243 my $patron = Koha::Patron->new( $params );
1244 my $has_a_valid_userid = $patron->has_valid_userid
1246 Return true if the current userid of this patron is valid/unique, otherwise false.
1248 Note that this should be done in $self->store instead and raise an exception if needed.
1252 sub has_valid_userid {
1255 return 0 unless $self->userid;
1257 return 0 if ( $self->userid eq C4::Context->config('user') ); # DB user
1259 my $already_exists = Koha::Patrons->search(
1261 userid => $self->userid,
1264 ? ( borrowernumber => { '!=' => $self->borrowernumber } )
1269 return $already_exists ? 0 : 1;
1272 =head3 generate_userid
1274 my $patron = Koha::Patron->new( $params );
1275 $patron->generate_userid
1277 Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
1279 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).
1283 sub generate_userid {
1286 my $firstname = $self->firstname // q{};
1287 my $surname = $self->surname // q{};
1288 #The script will "do" the following code and increment the $offset until the generated userid is unique
1290 $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1291 $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1292 my $userid = lc(($firstname)? "$firstname.$surname" : $surname);
1293 $userid = unac_string('utf-8',$userid);
1294 $userid .= $offset unless $offset == 0;
1295 $self->userid( $userid );
1297 } while (! $self->has_valid_userid );
1303 =head2 Internal methods
1315 Kyle M Hall <kyle@bywatersolutions.com>
1316 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>