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);
204 # This is bad we should use columns_info instead
205 # But it will avoid unecessary processing
206 $self->updated_on(\"current_timestamp");
209 # Set default values if not set
210 $self->sms_provider_id(undef) unless $self->sms_provider_id;
211 $self->guarantorid(undef) unless $self->guarantorid;
213 # If flags == 0 or flags == '' => no permission
214 $self->flags(undef) unless $self->flags;
217 $self->gonenoaddress(0) unless $self->gonenoaddress;
218 $self->login_attempts(0) unless $self->login_attempts;
219 $self->privacy_guarantor_checkouts(0) unless $self->privacy_guarantor_checkouts;
220 $self->lost(0) unless $self->lost;
222 unless ( $self->in_storage ) { #AddMember
224 # Generate a valid userid/login if needed
225 $self->generate_userid
226 if not $self->userid or not $self->has_valid_userid;
228 # Add expiration date if it isn't already there
229 unless ( $self->dateexpiry ) {
230 $self->dateexpiry( $self->category->get_expiry_date );
233 # Add enrollment date if it isn't already there
234 unless ( $self->dateenrolled ) {
235 $self->dateenrolled(dt_from_string);
238 # Set the privacy depending on the patron's category
239 my $default_privacy = $self->category->default_privacy || q{};
241 $default_privacy eq 'default' ? 1
242 : $default_privacy eq 'never' ? 2
243 : $default_privacy eq 'forever' ? 0
245 $self->privacy($default_privacy);
247 unless ( defined $self->privacy_guarantor_checkouts ) {
248 $self->privacy_guarantor_checkouts(0);
251 # Make a copy of the plain text password for later use
252 $self->plain_text_password( $self->password );
254 # Create a disabled account if no password provided
255 $self->password( $self->password
256 ? Koha::AuthUtils::hash_password( $self->password )
259 $self->borrowernumber(undef);
261 $self = $self->SUPER::store;
263 $self->add_enrolment_fee_if_needed;
265 logaction( "MEMBERS", "CREATE", $self->borrowernumber, "" )
266 if C4::Context->preference("BorrowersLog");
270 # Come from ModMember, but should not be possible (?)
271 $self->dateenrolled(undef) unless $self->dateenrolled;
272 $self->dateexpiry(undef) unless $self->dateexpiry;
275 my $self_from_storage = $self->get_from_storage;
276 # FIXME We should not deal with that here, callers have to do this job
277 # Moved from ModMember to prevent regressions
278 unless ( $self->userid ) {
279 my $stored_userid = $self_from_storage->userid;
280 $self->userid($stored_userid);
283 # Password must be updated using $self->update_password
284 $self->password($self_from_storage->password);
286 if ( C4::Context->preference('FeeOnChangePatronCategory')
287 and $self->category->categorycode ne
288 $self_from_storage->category->categorycode )
290 $self->add_enrolment_fee_if_needed;
293 my $borrowers_log = C4::Context->preference("BorrowersLog");
294 my $previous_cardnumber = $self_from_storage->cardnumber;
296 && ( !defined $previous_cardnumber
297 || $previous_cardnumber ne $self->cardnumber )
303 $self->borrowernumber,
306 cardnumber_replaced => {
307 previous_cardnumber => $previous_cardnumber,
308 new_cardnumber => $self->cardnumber,
311 { utf8 => 1, pretty => 1 }
316 logaction( "MEMBERS", "MODIFY", $self->borrowernumber,
317 "UPDATE (executed w/ arg: " . $self->borrowernumber . ")" )
320 $self = $self->SUPER::store;
331 Delete patron's holds, lists and finally the patron.
333 Lists owned by the borrower are deleted, but entries from the borrower to
334 other lists are kept.
342 $self->_result->result_source->schema->txn_do(
344 # Delete Patron's holds
345 $self->holds->delete;
347 # Delete all lists and all shares of this borrower
348 # Consistent with the approach Koha uses on deleting individual lists
349 # Note that entries in virtualshelfcontents added by this borrower to
350 # lists of others will be handled by a table constraint: the borrower
351 # is set to NULL in those entries.
353 # We could handle the above deletes via a constraint too.
354 # But a new BZ report 11889 has been opened to discuss another approach.
355 # Instead of deleting we could also disown lists (based on a pref).
356 # In that way we could save shared and public lists.
357 # The current table constraints support that idea now.
358 # This pref should then govern the results of other routines/methods such as
359 # Koha::Virtualshelf->new->delete too.
360 # FIXME Could be $patron->get_lists
361 $_->delete for Koha::Virtualshelves->search( { owner => $self->borrowernumber } );
363 $deleted = $self->SUPER::delete;
365 logaction( "MEMBERS", "DELETE", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog");
374 my $patron_category = $patron->category
376 Return the patron category for this patron
382 return Koha::Patron::Category->_new_from_dbic( $self->_result->categorycode );
387 Returns a Koha::Patron object for this patron's guarantor
394 return unless $self->guarantorid();
396 return Koha::Patrons->find( $self->guarantorid() );
402 return scalar Koha::Patron::Images->find( $self->borrowernumber );
407 return Koha::Library->_new_from_dbic($self->_result->branchcode);
412 Returns the guarantees (list of Koha::Patron) of this patron
419 return Koha::Patrons->search( { guarantorid => $self->borrowernumber }, { order_by => { -asc => ['surname','firstname'] } } );
422 =head3 housebound_profile
424 Returns the HouseboundProfile associated with this patron.
428 sub housebound_profile {
430 my $profile = $self->_result->housebound_profile;
431 return Koha::Patron::HouseboundProfile->_new_from_dbic($profile)
436 =head3 housebound_role
438 Returns the HouseboundRole associated with this patron.
442 sub housebound_role {
445 my $role = $self->_result->housebound_role;
446 return Koha::Patron::HouseboundRole->_new_from_dbic($role) if ( $role );
452 Returns the siblings of this patron.
459 my $guarantor = $self->guarantor;
461 return unless $guarantor;
463 return Koha::Patrons->search(
467 '=' => $guarantor->id,
470 '!=' => $self->borrowernumber,
478 my $patron = Koha::Patrons->find($id);
479 $patron->merge_with( \@patron_ids );
481 This subroutine merges a list of patrons into the patron record. This is accomplished by finding
482 all related patron ids for the patrons to be merged in other tables and changing the ids to be that
483 of the keeper patron.
488 my ( $self, $patron_ids ) = @_;
490 my @patron_ids = @{ $patron_ids };
492 # Ensure the keeper isn't in the list of patrons to merge
493 @patron_ids = grep { $_ ne $self->id } @patron_ids;
495 my $schema = Koha::Database->new()->schema();
499 $self->_result->result_source->schema->txn_do( sub {
500 foreach my $patron_id (@patron_ids) {
501 my $patron = Koha::Patrons->find( $patron_id );
505 # Unbless for safety, the patron will end up being deleted
506 $results->{merged}->{$patron_id}->{patron} = $patron->unblessed;
508 while (my ($r, $field) = each(%$RESULTSET_PATRON_ID_MAPPING)) {
509 my $rs = $schema->resultset($r)->search({ $field => $patron_id });
510 $results->{merged}->{ $patron_id }->{updated}->{$r} = $rs->count();
511 $rs->update({ $field => $self->id });
514 $patron->move_to_deleted();
524 =head3 wants_check_for_previous_checkout
526 $wants_check = $patron->wants_check_for_previous_checkout;
528 Return 1 if Koha needs to perform PrevIssue checking, else 0.
532 sub wants_check_for_previous_checkout {
534 my $syspref = C4::Context->preference("checkPrevCheckout");
537 ## Hard syspref trumps all
538 return 1 if ($syspref eq 'hardyes');
539 return 0 if ($syspref eq 'hardno');
540 ## Now, patron pref trumps all
541 return 1 if ($self->checkprevcheckout eq 'yes');
542 return 0 if ($self->checkprevcheckout eq 'no');
544 # More complex: patron inherits -> determine category preference
545 my $checkPrevCheckoutByCat = $self->category->checkprevcheckout;
546 return 1 if ($checkPrevCheckoutByCat eq 'yes');
547 return 0 if ($checkPrevCheckoutByCat eq 'no');
549 # Finally: category preference is inherit, default to 0
550 if ($syspref eq 'softyes') {
557 =head3 do_check_for_previous_checkout
559 $do_check = $patron->do_check_for_previous_checkout($item);
561 Return 1 if the bib associated with $ITEM has previously been checked out to
562 $PATRON, 0 otherwise.
566 sub do_check_for_previous_checkout {
567 my ( $self, $item ) = @_;
569 # Find all items for bib and extract item numbers.
570 my @items = Koha::Items->search({biblionumber => $item->{biblionumber}});
572 foreach my $item (@items) {
573 push @item_nos, $item->itemnumber;
576 # Create (old)issues search criteria
578 borrowernumber => $self->borrowernumber,
579 itemnumber => \@item_nos,
582 # Check current issues table
583 my $issues = Koha::Checkouts->search($criteria);
584 return 1 if $issues->count; # 0 || N
586 # Check old issues table
587 my $old_issues = Koha::Old::Checkouts->search($criteria);
588 return $old_issues->count; # 0 || N
593 my $debarment_expiration = $patron->is_debarred;
595 Returns the date a patron debarment will expire, or undef if the patron is not
603 return unless $self->debarred;
604 return $self->debarred
605 if $self->debarred =~ '^9999'
606 or dt_from_string( $self->debarred ) > dt_from_string;
612 my $is_expired = $patron->is_expired;
614 Returns 1 if the patron is expired or 0;
620 return 0 unless $self->dateexpiry;
621 return 0 if $self->dateexpiry =~ '^9999';
622 return 1 if dt_from_string( $self->dateexpiry ) < dt_from_string->truncate( to => 'day' );
626 =head3 is_going_to_expire
628 my $is_going_to_expire = $patron->is_going_to_expire;
630 Returns 1 if the patron is going to expired, depending on the NotifyBorrowerDeparture pref or 0
634 sub is_going_to_expire {
637 my $delay = C4::Context->preference('NotifyBorrowerDeparture') || 0;
639 return 0 unless $delay;
640 return 0 unless $self->dateexpiry;
641 return 0 if $self->dateexpiry =~ '^9999';
642 return 1 if dt_from_string( $self->dateexpiry )->subtract( days => $delay ) < dt_from_string->truncate( to => 'day' );
646 =head3 update_password
648 my $updated = $patron->update_password( $userid, $password );
650 Update the userid and the password of a patron.
651 If the userid already exists, returns and let DBIx::Class warns
652 This will add an entry to action_logs if BorrowersLog is set.
656 sub update_password {
657 my ( $self, $userid, $password ) = @_;
658 eval { $self->userid($userid)->store; };
659 return if $@; # Make sure the userid is not already in used by another patron
661 return 0 if $password eq '****' or $password eq '';
663 my $digest = Koha::AuthUtils::hash_password($password);
671 logaction( "MEMBERS", "CHANGE PASS", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog");
677 $patron->set_password( $plain_text_password );
679 Set the patron's password.
683 The passed string is validated against the current password enforcement policy.
684 Exceptions are thrown if the password is not good enough.
688 =item Koha::Exceptions::Password::TooShort
690 =item Koha::Exceptions::Password::WhitespaceCharacters
692 =item Koha::Exceptions::Password::TooWeak
699 my ( $self, $password ) = @_;
701 my ( $is_valid, $error ) = Koha::AuthUtils::is_password_valid( $password );
704 if ( $error eq 'too_short' ) {
705 my $min_length = C4::Context->preference('minPasswordLength');
706 $min_length = 3 if not $min_length or $min_length < 3;
708 my $password_length = length($password);
709 Koha::Exceptions::Password::TooShort->throw(
710 { length => $password_length, min_length => $min_length } );
712 elsif ( $error eq 'has_whitespaces' ) {
713 Koha::Exceptions::Password::WhitespaceCharacters->throw();
715 elsif ( $error eq 'too_weak' ) {
716 Koha::Exceptions::Password::TooWeak->throw();
720 my $digest = Koha::AuthUtils::hash_password($password);
722 { password => $digest,
727 logaction( "MEMBERS", "CHANGE PASS", $self->borrowernumber, "" )
728 if C4::Context->preference("BorrowersLog");
736 my $new_expiry_date = $patron->renew_account
738 Extending the subscription to the expiry date.
745 if ( C4::Context->preference('BorrowerRenewalPeriodBase') eq 'combination' ) {
746 $date = ( dt_from_string gt dt_from_string( $self->dateexpiry ) ) ? dt_from_string : dt_from_string( $self->dateexpiry );
749 C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry'
750 ? dt_from_string( $self->dateexpiry )
753 my $expiry_date = $self->category->get_expiry_date($date);
755 $self->dateexpiry($expiry_date);
756 $self->date_renewed( dt_from_string() );
759 $self->add_enrolment_fee_if_needed;
761 logaction( "MEMBERS", "RENEW", $self->borrowernumber, "Membership renewed" ) if C4::Context->preference("BorrowersLog");
762 return dt_from_string( $expiry_date )->truncate( to => 'day' );
767 my $has_overdues = $patron->has_overdues;
769 Returns the number of patron's overdues
775 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
776 return $self->_result->issues->search({ date_due => { '<' => $dtf->format_datetime( dt_from_string() ) } })->count;
781 $patron->track_login;
782 $patron->track_login({ force => 1 });
784 Tracks a (successful) login attempt.
785 The preference TrackLastPatronActivity must be enabled. Or you
786 should pass the force parameter.
791 my ( $self, $params ) = @_;
794 !C4::Context->preference('TrackLastPatronActivity');
795 $self->lastseen( dt_from_string() )->store;
798 =head3 move_to_deleted
800 my $is_moved = $patron->move_to_deleted;
802 Move a patron to the deletedborrowers table.
803 This can be done before deleting a patron, to make sure the data are not completely deleted.
807 sub move_to_deleted {
809 my $patron_infos = $self->unblessed;
810 delete $patron_infos->{updated_on}; #This ensures the updated_on date in deletedborrowers will be set to the current timestamp
811 return Koha::Database->new->schema->resultset('Deletedborrower')->create($patron_infos);
814 =head3 article_requests
816 my @requests = $borrower->article_requests();
817 my $requests = $borrower->article_requests();
819 Returns either a list of ArticleRequests objects,
820 or an ArtitleRequests object, depending on the
825 sub article_requests {
828 $self->{_article_requests} ||= Koha::ArticleRequests->search({ borrowernumber => $self->borrowernumber() });
830 return $self->{_article_requests};
833 =head3 article_requests_current
835 my @requests = $patron->article_requests_current
837 Returns the article requests associated with this patron that are incomplete
841 sub article_requests_current {
844 $self->{_article_requests_current} ||= Koha::ArticleRequests->search(
846 borrowernumber => $self->id(),
848 { status => Koha::ArticleRequest::Status::Pending },
849 { status => Koha::ArticleRequest::Status::Processing }
854 return $self->{_article_requests_current};
857 =head3 article_requests_finished
859 my @requests = $biblio->article_requests_finished
861 Returns the article requests associated with this patron that are completed
865 sub article_requests_finished {
866 my ( $self, $borrower ) = @_;
868 $self->{_article_requests_finished} ||= Koha::ArticleRequests->search(
870 borrowernumber => $self->id(),
872 { status => Koha::ArticleRequest::Status::Completed },
873 { status => Koha::ArticleRequest::Status::Canceled }
878 return $self->{_article_requests_finished};
881 =head3 add_enrolment_fee_if_needed
883 my $enrolment_fee = $patron->add_enrolment_fee_if_needed;
885 Add enrolment fee for a patron if needed.
889 sub add_enrolment_fee_if_needed {
891 my $enrolment_fee = $self->category->enrolmentfee;
892 if ( $enrolment_fee && $enrolment_fee > 0 ) {
893 # insert fee in patron debts
894 C4::Accounts::manualinvoice( $self->borrowernumber, '', '', 'A', $enrolment_fee );
896 return $enrolment_fee || 0;
901 my $checkouts = $patron->checkouts
907 my $checkouts = $self->_result->issues;
908 return Koha::Checkouts->_new_from_dbic( $checkouts );
911 =head3 pending_checkouts
913 my $pending_checkouts = $patron->pending_checkouts
915 This method will return the same as $self->checkouts, but with a prefetch on
916 items, biblio and biblioitems.
918 It has been introduced to replaced the C4::Members::GetPendingIssues subroutine
920 It should not be used directly, prefer to access fields you need instead of
921 retrieving all these fields in one go.
926 sub pending_checkouts {
928 my $checkouts = $self->_result->issues->search(
932 { -desc => 'me.timestamp' },
933 { -desc => 'issuedate' },
934 { -desc => 'issue_id' }, # Sort by issue_id should be enough
936 prefetch => { item => { biblio => 'biblioitems' } },
939 return Koha::Checkouts->_new_from_dbic( $checkouts );
944 my $old_checkouts = $patron->old_checkouts
950 my $old_checkouts = $self->_result->old_issues;
951 return Koha::Old::Checkouts->_new_from_dbic( $old_checkouts );
956 my $overdue_items = $patron->get_overdues
958 Return the overdue items
964 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
965 return $self->checkouts->search(
967 'me.date_due' => { '<' => $dtf->format_datetime(dt_from_string) },
970 prefetch => { item => { biblio => 'biblioitems' } },
975 =head3 get_routing_lists
977 my @routinglists = $patron->get_routing_lists
979 Returns the routing lists a patron is subscribed to.
983 sub get_routing_lists {
985 my $routing_list_rs = $self->_result->subscriptionroutinglists;
986 return Koha::Subscription::Routinglists->_new_from_dbic($routing_list_rs);
991 my $age = $patron->get_age
993 Return the age of the patron
999 my $today_str = dt_from_string->strftime("%Y-%m-%d");
1000 return unless $self->dateofbirth;
1001 my $dob_str = dt_from_string( $self->dateofbirth )->strftime("%Y-%m-%d");
1003 my ( $dob_y, $dob_m, $dob_d ) = split /-/, $dob_str;
1004 my ( $today_y, $today_m, $today_d ) = split /-/, $today_str;
1006 my $age = $today_y - $dob_y;
1007 if ( $dob_m . $dob_d > $today_m . $today_d ) {
1016 my $account = $patron->account
1022 return Koha::Account->new( { patron_id => $self->borrowernumber } );
1027 my $holds = $patron->holds
1029 Return all the holds placed by this patron
1035 my $holds_rs = $self->_result->reserves->search( {}, { order_by => 'reservedate' } );
1036 return Koha::Holds->_new_from_dbic($holds_rs);
1041 my $old_holds = $patron->old_holds
1043 Return all the historical holds for this patron
1049 my $old_holds_rs = $self->_result->old_reserves->search( {}, { order_by => 'reservedate' } );
1050 return Koha::Old::Holds->_new_from_dbic($old_holds_rs);
1053 =head3 notice_email_address
1055 my $email = $patron->notice_email_address;
1057 Return the email address of patron used for notices.
1058 Returns the empty string if no email address.
1062 sub notice_email_address{
1065 my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
1066 # if syspref is set to 'first valid' (value == OFF), look up email address
1067 if ( $which_address eq 'OFF' ) {
1068 return $self->first_valid_email_address;
1071 return $self->$which_address || '';
1074 =head3 first_valid_email_address
1076 my $first_valid_email_address = $patron->first_valid_email_address
1078 Return the first valid email address for a patron.
1079 For now, the order is defined as email, emailpro, B_email.
1080 Returns the empty string if the borrower has no email addresses.
1084 sub first_valid_email_address {
1087 return $self->email() || $self->emailpro() || $self->B_email() || q{};
1090 =head3 get_club_enrollments
1094 sub get_club_enrollments {
1095 my ( $self, $return_scalar ) = @_;
1097 my $e = Koha::Club::Enrollments->search( { borrowernumber => $self->borrowernumber(), date_canceled => undef } );
1099 return $e if $return_scalar;
1101 return wantarray ? $e->as_list : $e;
1104 =head3 get_enrollable_clubs
1108 sub get_enrollable_clubs {
1109 my ( $self, $is_enrollable_from_opac, $return_scalar ) = @_;
1112 $params->{is_enrollable_from_opac} = $is_enrollable_from_opac
1113 if $is_enrollable_from_opac;
1114 $params->{is_email_required} = 0 unless $self->first_valid_email_address();
1116 $params->{borrower} = $self;
1118 my $e = Koha::Clubs->get_enrollable($params);
1120 return $e if $return_scalar;
1122 return wantarray ? $e->as_list : $e;
1125 =head3 account_locked
1127 my $is_locked = $patron->account_locked
1129 Return true if the patron has reach the maximum number of login attempts (see pref FailedLoginAttempts).
1130 Otherwise return false.
1131 If the pref is not set (empty string, null or 0), the feature is considered as disabled.
1135 sub account_locked {
1137 my $FailedLoginAttempts = C4::Context->preference('FailedLoginAttempts');
1138 return ( $FailedLoginAttempts
1139 and $self->login_attempts
1140 and $self->login_attempts >= $FailedLoginAttempts )? 1 : 0;
1143 =head3 can_see_patron_infos
1145 my $can_see = $patron->can_see_patron_infos( $patron );
1147 Return true if the patron (usually the logged in user) can see the patron's infos for a given patron
1151 sub can_see_patron_infos {
1152 my ( $self, $patron ) = @_;
1153 return $self->can_see_patrons_from( $patron->library->branchcode );
1156 =head3 can_see_patrons_from
1158 my $can_see = $patron->can_see_patrons_from( $branchcode );
1160 Return true if the patron (usually the logged in user) can see the patron's infos from a given library
1164 sub can_see_patrons_from {
1165 my ( $self, $branchcode ) = @_;
1167 if ( $self->branchcode eq $branchcode ) {
1169 } elsif ( $self->has_permission( { borrowers => 'view_borrower_infos_from_any_libraries' } ) ) {
1171 } elsif ( my $library_groups = $self->library->library_groups ) {
1172 while ( my $library_group = $library_groups->next ) {
1173 if ( $library_group->parent->has_child( $branchcode ) ) {
1182 =head3 libraries_where_can_see_patrons
1184 my $libraries = $patron-libraries_where_can_see_patrons;
1186 Return the list of branchcodes(!) of libraries the patron is allowed to see other patron's infos.
1187 The branchcodes are arbitrarily returned sorted.
1188 We are supposing here that the object is related to the logged in patron (use of C4::Context::only_my_library)
1190 An empty array means no restriction, the patron can see patron's infos from any libraries.
1194 sub libraries_where_can_see_patrons {
1196 my $userenv = C4::Context->userenv;
1198 return () unless $userenv; # For tests, but userenv should be defined in tests...
1200 my @restricted_branchcodes;
1201 if (C4::Context::only_my_library) {
1202 push @restricted_branchcodes, $self->branchcode;
1206 $self->has_permission(
1207 { borrowers => 'view_borrower_infos_from_any_libraries' }
1211 my $library_groups = $self->library->library_groups({ ft_hide_patron_info => 1 });
1212 if ( $library_groups->count )
1214 while ( my $library_group = $library_groups->next ) {
1215 my $parent = $library_group->parent;
1216 if ( $parent->has_child( $self->branchcode ) ) {
1217 push @restricted_branchcodes, $parent->children->get_column('branchcode');
1222 @restricted_branchcodes = ( $self->branchcode ) unless @restricted_branchcodes;
1226 @restricted_branchcodes = grep { defined $_ } @restricted_branchcodes;
1227 @restricted_branchcodes = uniq(@restricted_branchcodes);
1228 @restricted_branchcodes = sort(@restricted_branchcodes);
1229 return @restricted_branchcodes;
1232 sub has_permission {
1233 my ( $self, $flagsrequired ) = @_;
1234 return unless $self->userid;
1235 # TODO code from haspermission needs to be moved here!
1236 return C4::Auth::haspermission( $self->userid, $flagsrequired );
1241 my $is_adult = $patron->is_adult
1243 Return true if the patron has a category with a type Adult (A) or Organization (I)
1249 return $self->category->category_type =~ /^(A|I)$/ ? 1 : 0;
1254 my $is_child = $patron->is_child
1256 Return true if the patron has a category with a type Child (C)
1261 return $self->category->category_type eq 'C' ? 1 : 0;
1264 =head3 has_valid_userid
1266 my $patron = Koha::Patrons->find(42);
1267 $patron->userid( $new_userid );
1268 my $has_a_valid_userid = $patron->has_valid_userid
1270 my $patron = Koha::Patron->new( $params );
1271 my $has_a_valid_userid = $patron->has_valid_userid
1273 Return true if the current userid of this patron is valid/unique, otherwise false.
1275 Note that this should be done in $self->store instead and raise an exception if needed.
1279 sub has_valid_userid {
1282 return 0 unless $self->userid;
1284 return 0 if ( $self->userid eq C4::Context->config('user') ); # DB user
1286 my $already_exists = Koha::Patrons->search(
1288 userid => $self->userid,
1291 ? ( borrowernumber => { '!=' => $self->borrowernumber } )
1296 return $already_exists ? 0 : 1;
1299 =head3 generate_userid
1301 my $patron = Koha::Patron->new( $params );
1302 $patron->generate_userid
1304 Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
1306 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).
1310 sub generate_userid {
1313 my $firstname = $self->firstname // q{};
1314 my $surname = $self->surname // q{};
1315 #The script will "do" the following code and increment the $offset until the generated userid is unique
1317 $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1318 $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1319 my $userid = lc(($firstname)? "$firstname.$surname" : $surname);
1320 $userid = unac_string('utf-8',$userid);
1321 $userid .= $offset unless $offset == 0;
1322 $self->userid( $userid );
1324 } while (! $self->has_valid_userid );
1330 =head2 Internal methods
1342 Kyle M Hall <kyle@bywatersolutions.com>
1343 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>