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->update_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' );
642 =head3 update_password
644 my $updated = $patron->update_password( $userid, $password );
646 Update the userid and the password of a patron.
647 If the userid already exists, returns and let DBIx::Class warns
648 This will add an entry to action_logs if BorrowersLog is set.
652 sub update_password {
653 my ( $self, $userid, $password ) = @_;
654 eval { $self->userid($userid)->store; };
655 return if $@; # Make sure the userid is not already in used by another patron
657 return 0 if $password eq '****' or $password eq '';
659 my $digest = Koha::AuthUtils::hash_password($password);
667 logaction( "MEMBERS", "CHANGE PASS", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog");
673 $patron->set_password( $plain_text_password );
675 Set the patron's password.
679 The passed string is validated against the current password enforcement policy.
680 Exceptions are thrown if the password is not good enough.
684 =item Koha::Exceptions::Password::TooShort
686 =item Koha::Exceptions::Password::WhitespaceCharacters
688 =item Koha::Exceptions::Password::TooWeak
695 my ( $self, $password ) = @_;
697 my ( $is_valid, $error ) = Koha::AuthUtils::is_password_valid( $password );
700 if ( $error eq 'too_short' ) {
701 my $min_length = C4::Context->preference('minPasswordLength');
702 $min_length = 3 if not $min_length or $min_length < 3;
704 my $password_length = length($password);
705 Koha::Exceptions::Password::TooShort->throw(
706 { length => $password_length, min_length => $min_length } );
708 elsif ( $error eq 'has_whitespaces' ) {
709 Koha::Exceptions::Password::WhitespaceCharacters->throw();
711 elsif ( $error eq 'too_weak' ) {
712 Koha::Exceptions::Password::TooWeak->throw();
716 my $digest = Koha::AuthUtils::hash_password($password);
718 { password => $digest,
723 logaction( "MEMBERS", "CHANGE PASS", $self->borrowernumber, "" )
724 if C4::Context->preference("BorrowersLog");
732 my $new_expiry_date = $patron->renew_account
734 Extending the subscription to the expiry date.
741 if ( C4::Context->preference('BorrowerRenewalPeriodBase') eq 'combination' ) {
742 $date = ( dt_from_string gt dt_from_string( $self->dateexpiry ) ) ? dt_from_string : dt_from_string( $self->dateexpiry );
745 C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry'
746 ? dt_from_string( $self->dateexpiry )
749 my $expiry_date = $self->category->get_expiry_date($date);
751 $self->dateexpiry($expiry_date);
752 $self->date_renewed( dt_from_string() );
755 $self->add_enrolment_fee_if_needed;
757 logaction( "MEMBERS", "RENEW", $self->borrowernumber, "Membership renewed" ) if C4::Context->preference("BorrowersLog");
758 return dt_from_string( $expiry_date )->truncate( to => 'day' );
763 my $has_overdues = $patron->has_overdues;
765 Returns the number of patron's overdues
771 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
772 return $self->_result->issues->search({ date_due => { '<' => $dtf->format_datetime( dt_from_string() ) } })->count;
777 $patron->track_login;
778 $patron->track_login({ force => 1 });
780 Tracks a (successful) login attempt.
781 The preference TrackLastPatronActivity must be enabled. Or you
782 should pass the force parameter.
787 my ( $self, $params ) = @_;
790 !C4::Context->preference('TrackLastPatronActivity');
791 $self->lastseen( dt_from_string() )->store;
794 =head3 move_to_deleted
796 my $is_moved = $patron->move_to_deleted;
798 Move a patron to the deletedborrowers table.
799 This can be done before deleting a patron, to make sure the data are not completely deleted.
803 sub move_to_deleted {
805 my $patron_infos = $self->unblessed;
806 delete $patron_infos->{updated_on}; #This ensures the updated_on date in deletedborrowers will be set to the current timestamp
807 return Koha::Database->new->schema->resultset('Deletedborrower')->create($patron_infos);
810 =head3 article_requests
812 my @requests = $borrower->article_requests();
813 my $requests = $borrower->article_requests();
815 Returns either a list of ArticleRequests objects,
816 or an ArtitleRequests object, depending on the
821 sub article_requests {
824 $self->{_article_requests} ||= Koha::ArticleRequests->search({ borrowernumber => $self->borrowernumber() });
826 return $self->{_article_requests};
829 =head3 article_requests_current
831 my @requests = $patron->article_requests_current
833 Returns the article requests associated with this patron that are incomplete
837 sub article_requests_current {
840 $self->{_article_requests_current} ||= Koha::ArticleRequests->search(
842 borrowernumber => $self->id(),
844 { status => Koha::ArticleRequest::Status::Pending },
845 { status => Koha::ArticleRequest::Status::Processing }
850 return $self->{_article_requests_current};
853 =head3 article_requests_finished
855 my @requests = $biblio->article_requests_finished
857 Returns the article requests associated with this patron that are completed
861 sub article_requests_finished {
862 my ( $self, $borrower ) = @_;
864 $self->{_article_requests_finished} ||= Koha::ArticleRequests->search(
866 borrowernumber => $self->id(),
868 { status => Koha::ArticleRequest::Status::Completed },
869 { status => Koha::ArticleRequest::Status::Canceled }
874 return $self->{_article_requests_finished};
877 =head3 add_enrolment_fee_if_needed
879 my $enrolment_fee = $patron->add_enrolment_fee_if_needed;
881 Add enrolment fee for a patron if needed.
885 sub add_enrolment_fee_if_needed {
887 my $enrolment_fee = $self->category->enrolmentfee;
888 if ( $enrolment_fee && $enrolment_fee > 0 ) {
889 # insert fee in patron debts
890 C4::Accounts::manualinvoice( $self->borrowernumber, '', '', 'A', $enrolment_fee );
892 return $enrolment_fee || 0;
897 my $checkouts = $patron->checkouts
903 my $checkouts = $self->_result->issues;
904 return Koha::Checkouts->_new_from_dbic( $checkouts );
907 =head3 pending_checkouts
909 my $pending_checkouts = $patron->pending_checkouts
911 This method will return the same as $self->checkouts, but with a prefetch on
912 items, biblio and biblioitems.
914 It has been introduced to replaced the C4::Members::GetPendingIssues subroutine
916 It should not be used directly, prefer to access fields you need instead of
917 retrieving all these fields in one go.
922 sub pending_checkouts {
924 my $checkouts = $self->_result->issues->search(
928 { -desc => 'me.timestamp' },
929 { -desc => 'issuedate' },
930 { -desc => 'issue_id' }, # Sort by issue_id should be enough
932 prefetch => { item => { biblio => 'biblioitems' } },
935 return Koha::Checkouts->_new_from_dbic( $checkouts );
940 my $old_checkouts = $patron->old_checkouts
946 my $old_checkouts = $self->_result->old_issues;
947 return Koha::Old::Checkouts->_new_from_dbic( $old_checkouts );
952 my $overdue_items = $patron->get_overdues
954 Return the overdue items
960 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
961 return $self->checkouts->search(
963 'me.date_due' => { '<' => $dtf->format_datetime(dt_from_string) },
966 prefetch => { item => { biblio => 'biblioitems' } },
971 =head3 get_routing_lists
973 my @routinglists = $patron->get_routing_lists
975 Returns the routing lists a patron is subscribed to.
979 sub get_routing_lists {
981 my $routing_list_rs = $self->_result->subscriptionroutinglists;
982 return Koha::Subscription::Routinglists->_new_from_dbic($routing_list_rs);
987 my $age = $patron->get_age
989 Return the age of the patron
995 my $today_str = dt_from_string->strftime("%Y-%m-%d");
996 return unless $self->dateofbirth;
997 my $dob_str = dt_from_string( $self->dateofbirth )->strftime("%Y-%m-%d");
999 my ( $dob_y, $dob_m, $dob_d ) = split /-/, $dob_str;
1000 my ( $today_y, $today_m, $today_d ) = split /-/, $today_str;
1002 my $age = $today_y - $dob_y;
1003 if ( $dob_m . $dob_d > $today_m . $today_d ) {
1012 my $account = $patron->account
1018 return Koha::Account->new( { patron_id => $self->borrowernumber } );
1023 my $holds = $patron->holds
1025 Return all the holds placed by this patron
1031 my $holds_rs = $self->_result->reserves->search( {}, { order_by => 'reservedate' } );
1032 return Koha::Holds->_new_from_dbic($holds_rs);
1037 my $old_holds = $patron->old_holds
1039 Return all the historical holds for this patron
1045 my $old_holds_rs = $self->_result->old_reserves->search( {}, { order_by => 'reservedate' } );
1046 return Koha::Old::Holds->_new_from_dbic($old_holds_rs);
1049 =head3 notice_email_address
1051 my $email = $patron->notice_email_address;
1053 Return the email address of patron used for notices.
1054 Returns the empty string if no email address.
1058 sub notice_email_address{
1061 my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
1062 # if syspref is set to 'first valid' (value == OFF), look up email address
1063 if ( $which_address eq 'OFF' ) {
1064 return $self->first_valid_email_address;
1067 return $self->$which_address || '';
1070 =head3 first_valid_email_address
1072 my $first_valid_email_address = $patron->first_valid_email_address
1074 Return the first valid email address for a patron.
1075 For now, the order is defined as email, emailpro, B_email.
1076 Returns the empty string if the borrower has no email addresses.
1080 sub first_valid_email_address {
1083 return $self->email() || $self->emailpro() || $self->B_email() || q{};
1086 =head3 get_club_enrollments
1090 sub get_club_enrollments {
1091 my ( $self, $return_scalar ) = @_;
1093 my $e = Koha::Club::Enrollments->search( { borrowernumber => $self->borrowernumber(), date_canceled => undef } );
1095 return $e if $return_scalar;
1097 return wantarray ? $e->as_list : $e;
1100 =head3 get_enrollable_clubs
1104 sub get_enrollable_clubs {
1105 my ( $self, $is_enrollable_from_opac, $return_scalar ) = @_;
1108 $params->{is_enrollable_from_opac} = $is_enrollable_from_opac
1109 if $is_enrollable_from_opac;
1110 $params->{is_email_required} = 0 unless $self->first_valid_email_address();
1112 $params->{borrower} = $self;
1114 my $e = Koha::Clubs->get_enrollable($params);
1116 return $e if $return_scalar;
1118 return wantarray ? $e->as_list : $e;
1121 =head3 account_locked
1123 my $is_locked = $patron->account_locked
1125 Return true if the patron has reach the maximum number of login attempts (see pref FailedLoginAttempts).
1126 Otherwise return false.
1127 If the pref is not set (empty string, null or 0), the feature is considered as disabled.
1131 sub account_locked {
1133 my $FailedLoginAttempts = C4::Context->preference('FailedLoginAttempts');
1134 return ( $FailedLoginAttempts
1135 and $self->login_attempts
1136 and $self->login_attempts >= $FailedLoginAttempts )? 1 : 0;
1139 =head3 can_see_patron_infos
1141 my $can_see = $patron->can_see_patron_infos( $patron );
1143 Return true if the patron (usually the logged in user) can see the patron's infos for a given patron
1147 sub can_see_patron_infos {
1148 my ( $self, $patron ) = @_;
1149 return $self->can_see_patrons_from( $patron->library->branchcode );
1152 =head3 can_see_patrons_from
1154 my $can_see = $patron->can_see_patrons_from( $branchcode );
1156 Return true if the patron (usually the logged in user) can see the patron's infos from a given library
1160 sub can_see_patrons_from {
1161 my ( $self, $branchcode ) = @_;
1163 if ( $self->branchcode eq $branchcode ) {
1165 } elsif ( $self->has_permission( { borrowers => 'view_borrower_infos_from_any_libraries' } ) ) {
1167 } elsif ( my $library_groups = $self->library->library_groups ) {
1168 while ( my $library_group = $library_groups->next ) {
1169 if ( $library_group->parent->has_child( $branchcode ) ) {
1178 =head3 libraries_where_can_see_patrons
1180 my $libraries = $patron-libraries_where_can_see_patrons;
1182 Return the list of branchcodes(!) of libraries the patron is allowed to see other patron's infos.
1183 The branchcodes are arbitrarily returned sorted.
1184 We are supposing here that the object is related to the logged in patron (use of C4::Context::only_my_library)
1186 An empty array means no restriction, the patron can see patron's infos from any libraries.
1190 sub libraries_where_can_see_patrons {
1192 my $userenv = C4::Context->userenv;
1194 return () unless $userenv; # For tests, but userenv should be defined in tests...
1196 my @restricted_branchcodes;
1197 if (C4::Context::only_my_library) {
1198 push @restricted_branchcodes, $self->branchcode;
1202 $self->has_permission(
1203 { borrowers => 'view_borrower_infos_from_any_libraries' }
1207 my $library_groups = $self->library->library_groups({ ft_hide_patron_info => 1 });
1208 if ( $library_groups->count )
1210 while ( my $library_group = $library_groups->next ) {
1211 my $parent = $library_group->parent;
1212 if ( $parent->has_child( $self->branchcode ) ) {
1213 push @restricted_branchcodes, $parent->children->get_column('branchcode');
1218 @restricted_branchcodes = ( $self->branchcode ) unless @restricted_branchcodes;
1222 @restricted_branchcodes = grep { defined $_ } @restricted_branchcodes;
1223 @restricted_branchcodes = uniq(@restricted_branchcodes);
1224 @restricted_branchcodes = sort(@restricted_branchcodes);
1225 return @restricted_branchcodes;
1228 sub has_permission {
1229 my ( $self, $flagsrequired ) = @_;
1230 return unless $self->userid;
1231 # TODO code from haspermission needs to be moved here!
1232 return C4::Auth::haspermission( $self->userid, $flagsrequired );
1237 my $is_adult = $patron->is_adult
1239 Return true if the patron has a category with a type Adult (A) or Organization (I)
1245 return $self->category->category_type =~ /^(A|I)$/ ? 1 : 0;
1250 my $is_child = $patron->is_child
1252 Return true if the patron has a category with a type Child (C)
1257 return $self->category->category_type eq 'C' ? 1 : 0;
1260 =head3 has_valid_userid
1262 my $patron = Koha::Patrons->find(42);
1263 $patron->userid( $new_userid );
1264 my $has_a_valid_userid = $patron->has_valid_userid
1266 my $patron = Koha::Patron->new( $params );
1267 my $has_a_valid_userid = $patron->has_valid_userid
1269 Return true if the current userid of this patron is valid/unique, otherwise false.
1271 Note that this should be done in $self->store instead and raise an exception if needed.
1275 sub has_valid_userid {
1278 return 0 unless $self->userid;
1280 return 0 if ( $self->userid eq C4::Context->config('user') ); # DB user
1282 my $already_exists = Koha::Patrons->search(
1284 userid => $self->userid,
1287 ? ( borrowernumber => { '!=' => $self->borrowernumber } )
1292 return $already_exists ? 0 : 1;
1295 =head3 generate_userid
1297 my $patron = Koha::Patron->new( $params );
1298 $patron->generate_userid
1300 Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
1302 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).
1306 sub generate_userid {
1309 my $firstname = $self->firstname // q{};
1310 my $surname = $self->surname // q{};
1311 #The script will "do" the following code and increment the $offset until the generated userid is unique
1313 $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1314 $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1315 my $userid = lc(($firstname)? "$firstname.$surname" : $surname);
1316 $userid = unac_string('utf-8',$userid);
1317 $userid .= $offset unless $offset == 0;
1318 $self->userid( $userid );
1320 } while (! $self->has_valid_userid );
1326 =head2 Internal methods
1338 Kyle M Hall <kyle@bywatersolutions.com>
1339 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>