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({ password => $plain_text_password [, skip_validation => 1 ] });
675 Set the patron's password.
679 The passed string is validated against the current password enforcement policy.
680 Validation can be skipped by passing the I<skip_validation> parameter.
682 Exceptions are thrown if the password is not good enough.
686 =item Koha::Exceptions::Password::TooShort
688 =item Koha::Exceptions::Password::WhitespaceCharacters
690 =item Koha::Exceptions::Password::TooWeak
697 my ( $self, $args ) = @_;
699 my $password = $args->{password};
701 unless ( $args->{skip_validation} ) {
702 my ( $is_valid, $error ) = Koha::AuthUtils::is_password_valid( $password );
705 if ( $error eq 'too_short' ) {
706 my $min_length = C4::Context->preference('minPasswordLength');
707 $min_length = 3 if not $min_length or $min_length < 3;
709 my $password_length = length($password);
710 Koha::Exceptions::Password::TooShort->throw(
711 length => $password_length, min_length => $min_length );
713 elsif ( $error eq 'has_whitespaces' ) {
714 Koha::Exceptions::Password::WhitespaceCharacters->throw();
716 elsif ( $error eq 'too_weak' ) {
717 Koha::Exceptions::Password::TooWeak->throw();
722 my $digest = Koha::AuthUtils::hash_password($password);
724 { password => $digest,
729 logaction( "MEMBERS", "CHANGE PASS", $self->borrowernumber, "" )
730 if C4::Context->preference("BorrowersLog");
738 my $new_expiry_date = $patron->renew_account
740 Extending the subscription to the expiry date.
747 if ( C4::Context->preference('BorrowerRenewalPeriodBase') eq 'combination' ) {
748 $date = ( dt_from_string gt dt_from_string( $self->dateexpiry ) ) ? dt_from_string : dt_from_string( $self->dateexpiry );
751 C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry'
752 ? dt_from_string( $self->dateexpiry )
755 my $expiry_date = $self->category->get_expiry_date($date);
757 $self->dateexpiry($expiry_date);
758 $self->date_renewed( dt_from_string() );
761 $self->add_enrolment_fee_if_needed;
763 logaction( "MEMBERS", "RENEW", $self->borrowernumber, "Membership renewed" ) if C4::Context->preference("BorrowersLog");
764 return dt_from_string( $expiry_date )->truncate( to => 'day' );
769 my $has_overdues = $patron->has_overdues;
771 Returns the number of patron's overdues
777 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
778 return $self->_result->issues->search({ date_due => { '<' => $dtf->format_datetime( dt_from_string() ) } })->count;
783 $patron->track_login;
784 $patron->track_login({ force => 1 });
786 Tracks a (successful) login attempt.
787 The preference TrackLastPatronActivity must be enabled. Or you
788 should pass the force parameter.
793 my ( $self, $params ) = @_;
796 !C4::Context->preference('TrackLastPatronActivity');
797 $self->lastseen( dt_from_string() )->store;
800 =head3 move_to_deleted
802 my $is_moved = $patron->move_to_deleted;
804 Move a patron to the deletedborrowers table.
805 This can be done before deleting a patron, to make sure the data are not completely deleted.
809 sub move_to_deleted {
811 my $patron_infos = $self->unblessed;
812 delete $patron_infos->{updated_on}; #This ensures the updated_on date in deletedborrowers will be set to the current timestamp
813 return Koha::Database->new->schema->resultset('Deletedborrower')->create($patron_infos);
816 =head3 article_requests
818 my @requests = $borrower->article_requests();
819 my $requests = $borrower->article_requests();
821 Returns either a list of ArticleRequests objects,
822 or an ArtitleRequests object, depending on the
827 sub article_requests {
830 $self->{_article_requests} ||= Koha::ArticleRequests->search({ borrowernumber => $self->borrowernumber() });
832 return $self->{_article_requests};
835 =head3 article_requests_current
837 my @requests = $patron->article_requests_current
839 Returns the article requests associated with this patron that are incomplete
843 sub article_requests_current {
846 $self->{_article_requests_current} ||= Koha::ArticleRequests->search(
848 borrowernumber => $self->id(),
850 { status => Koha::ArticleRequest::Status::Pending },
851 { status => Koha::ArticleRequest::Status::Processing }
856 return $self->{_article_requests_current};
859 =head3 article_requests_finished
861 my @requests = $biblio->article_requests_finished
863 Returns the article requests associated with this patron that are completed
867 sub article_requests_finished {
868 my ( $self, $borrower ) = @_;
870 $self->{_article_requests_finished} ||= Koha::ArticleRequests->search(
872 borrowernumber => $self->id(),
874 { status => Koha::ArticleRequest::Status::Completed },
875 { status => Koha::ArticleRequest::Status::Canceled }
880 return $self->{_article_requests_finished};
883 =head3 add_enrolment_fee_if_needed
885 my $enrolment_fee = $patron->add_enrolment_fee_if_needed;
887 Add enrolment fee for a patron if needed.
891 sub add_enrolment_fee_if_needed {
893 my $enrolment_fee = $self->category->enrolmentfee;
894 if ( $enrolment_fee && $enrolment_fee > 0 ) {
895 # insert fee in patron debts
896 C4::Accounts::manualinvoice( $self->borrowernumber, '', '', 'A', $enrolment_fee );
898 return $enrolment_fee || 0;
903 my $checkouts = $patron->checkouts
909 my $checkouts = $self->_result->issues;
910 return Koha::Checkouts->_new_from_dbic( $checkouts );
913 =head3 pending_checkouts
915 my $pending_checkouts = $patron->pending_checkouts
917 This method will return the same as $self->checkouts, but with a prefetch on
918 items, biblio and biblioitems.
920 It has been introduced to replaced the C4::Members::GetPendingIssues subroutine
922 It should not be used directly, prefer to access fields you need instead of
923 retrieving all these fields in one go.
928 sub pending_checkouts {
930 my $checkouts = $self->_result->issues->search(
934 { -desc => 'me.timestamp' },
935 { -desc => 'issuedate' },
936 { -desc => 'issue_id' }, # Sort by issue_id should be enough
938 prefetch => { item => { biblio => 'biblioitems' } },
941 return Koha::Checkouts->_new_from_dbic( $checkouts );
946 my $old_checkouts = $patron->old_checkouts
952 my $old_checkouts = $self->_result->old_issues;
953 return Koha::Old::Checkouts->_new_from_dbic( $old_checkouts );
958 my $overdue_items = $patron->get_overdues
960 Return the overdue items
966 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
967 return $self->checkouts->search(
969 'me.date_due' => { '<' => $dtf->format_datetime(dt_from_string) },
972 prefetch => { item => { biblio => 'biblioitems' } },
977 =head3 get_routing_lists
979 my @routinglists = $patron->get_routing_lists
981 Returns the routing lists a patron is subscribed to.
985 sub get_routing_lists {
987 my $routing_list_rs = $self->_result->subscriptionroutinglists;
988 return Koha::Subscription::Routinglists->_new_from_dbic($routing_list_rs);
993 my $age = $patron->get_age
995 Return the age of the patron
1001 my $today_str = dt_from_string->strftime("%Y-%m-%d");
1002 return unless $self->dateofbirth;
1003 my $dob_str = dt_from_string( $self->dateofbirth )->strftime("%Y-%m-%d");
1005 my ( $dob_y, $dob_m, $dob_d ) = split /-/, $dob_str;
1006 my ( $today_y, $today_m, $today_d ) = split /-/, $today_str;
1008 my $age = $today_y - $dob_y;
1009 if ( $dob_m . $dob_d > $today_m . $today_d ) {
1018 my $account = $patron->account
1024 return Koha::Account->new( { patron_id => $self->borrowernumber } );
1029 my $holds = $patron->holds
1031 Return all the holds placed by this patron
1037 my $holds_rs = $self->_result->reserves->search( {}, { order_by => 'reservedate' } );
1038 return Koha::Holds->_new_from_dbic($holds_rs);
1043 my $old_holds = $patron->old_holds
1045 Return all the historical holds for this patron
1051 my $old_holds_rs = $self->_result->old_reserves->search( {}, { order_by => 'reservedate' } );
1052 return Koha::Old::Holds->_new_from_dbic($old_holds_rs);
1055 =head3 notice_email_address
1057 my $email = $patron->notice_email_address;
1059 Return the email address of patron used for notices.
1060 Returns the empty string if no email address.
1064 sub notice_email_address{
1067 my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
1068 # if syspref is set to 'first valid' (value == OFF), look up email address
1069 if ( $which_address eq 'OFF' ) {
1070 return $self->first_valid_email_address;
1073 return $self->$which_address || '';
1076 =head3 first_valid_email_address
1078 my $first_valid_email_address = $patron->first_valid_email_address
1080 Return the first valid email address for a patron.
1081 For now, the order is defined as email, emailpro, B_email.
1082 Returns the empty string if the borrower has no email addresses.
1086 sub first_valid_email_address {
1089 return $self->email() || $self->emailpro() || $self->B_email() || q{};
1092 =head3 get_club_enrollments
1096 sub get_club_enrollments {
1097 my ( $self, $return_scalar ) = @_;
1099 my $e = Koha::Club::Enrollments->search( { borrowernumber => $self->borrowernumber(), date_canceled => undef } );
1101 return $e if $return_scalar;
1103 return wantarray ? $e->as_list : $e;
1106 =head3 get_enrollable_clubs
1110 sub get_enrollable_clubs {
1111 my ( $self, $is_enrollable_from_opac, $return_scalar ) = @_;
1114 $params->{is_enrollable_from_opac} = $is_enrollable_from_opac
1115 if $is_enrollable_from_opac;
1116 $params->{is_email_required} = 0 unless $self->first_valid_email_address();
1118 $params->{borrower} = $self;
1120 my $e = Koha::Clubs->get_enrollable($params);
1122 return $e if $return_scalar;
1124 return wantarray ? $e->as_list : $e;
1127 =head3 account_locked
1129 my $is_locked = $patron->account_locked
1131 Return true if the patron has reach the maximum number of login attempts (see pref FailedLoginAttempts).
1132 Otherwise return false.
1133 If the pref is not set (empty string, null or 0), the feature is considered as disabled.
1137 sub account_locked {
1139 my $FailedLoginAttempts = C4::Context->preference('FailedLoginAttempts');
1140 return ( $FailedLoginAttempts
1141 and $self->login_attempts
1142 and $self->login_attempts >= $FailedLoginAttempts )? 1 : 0;
1145 =head3 can_see_patron_infos
1147 my $can_see = $patron->can_see_patron_infos( $patron );
1149 Return true if the patron (usually the logged in user) can see the patron's infos for a given patron
1153 sub can_see_patron_infos {
1154 my ( $self, $patron ) = @_;
1155 return $self->can_see_patrons_from( $patron->library->branchcode );
1158 =head3 can_see_patrons_from
1160 my $can_see = $patron->can_see_patrons_from( $branchcode );
1162 Return true if the patron (usually the logged in user) can see the patron's infos from a given library
1166 sub can_see_patrons_from {
1167 my ( $self, $branchcode ) = @_;
1169 if ( $self->branchcode eq $branchcode ) {
1171 } elsif ( $self->has_permission( { borrowers => 'view_borrower_infos_from_any_libraries' } ) ) {
1173 } elsif ( my $library_groups = $self->library->library_groups ) {
1174 while ( my $library_group = $library_groups->next ) {
1175 if ( $library_group->parent->has_child( $branchcode ) ) {
1184 =head3 libraries_where_can_see_patrons
1186 my $libraries = $patron-libraries_where_can_see_patrons;
1188 Return the list of branchcodes(!) of libraries the patron is allowed to see other patron's infos.
1189 The branchcodes are arbitrarily returned sorted.
1190 We are supposing here that the object is related to the logged in patron (use of C4::Context::only_my_library)
1192 An empty array means no restriction, the patron can see patron's infos from any libraries.
1196 sub libraries_where_can_see_patrons {
1198 my $userenv = C4::Context->userenv;
1200 return () unless $userenv; # For tests, but userenv should be defined in tests...
1202 my @restricted_branchcodes;
1203 if (C4::Context::only_my_library) {
1204 push @restricted_branchcodes, $self->branchcode;
1208 $self->has_permission(
1209 { borrowers => 'view_borrower_infos_from_any_libraries' }
1213 my $library_groups = $self->library->library_groups({ ft_hide_patron_info => 1 });
1214 if ( $library_groups->count )
1216 while ( my $library_group = $library_groups->next ) {
1217 my $parent = $library_group->parent;
1218 if ( $parent->has_child( $self->branchcode ) ) {
1219 push @restricted_branchcodes, $parent->children->get_column('branchcode');
1224 @restricted_branchcodes = ( $self->branchcode ) unless @restricted_branchcodes;
1228 @restricted_branchcodes = grep { defined $_ } @restricted_branchcodes;
1229 @restricted_branchcodes = uniq(@restricted_branchcodes);
1230 @restricted_branchcodes = sort(@restricted_branchcodes);
1231 return @restricted_branchcodes;
1234 sub has_permission {
1235 my ( $self, $flagsrequired ) = @_;
1236 return unless $self->userid;
1237 # TODO code from haspermission needs to be moved here!
1238 return C4::Auth::haspermission( $self->userid, $flagsrequired );
1243 my $is_adult = $patron->is_adult
1245 Return true if the patron has a category with a type Adult (A) or Organization (I)
1251 return $self->category->category_type =~ /^(A|I)$/ ? 1 : 0;
1256 my $is_child = $patron->is_child
1258 Return true if the patron has a category with a type Child (C)
1263 return $self->category->category_type eq 'C' ? 1 : 0;
1266 =head3 has_valid_userid
1268 my $patron = Koha::Patrons->find(42);
1269 $patron->userid( $new_userid );
1270 my $has_a_valid_userid = $patron->has_valid_userid
1272 my $patron = Koha::Patron->new( $params );
1273 my $has_a_valid_userid = $patron->has_valid_userid
1275 Return true if the current userid of this patron is valid/unique, otherwise false.
1277 Note that this should be done in $self->store instead and raise an exception if needed.
1281 sub has_valid_userid {
1284 return 0 unless $self->userid;
1286 return 0 if ( $self->userid eq C4::Context->config('user') ); # DB user
1288 my $already_exists = Koha::Patrons->search(
1290 userid => $self->userid,
1293 ? ( borrowernumber => { '!=' => $self->borrowernumber } )
1298 return $already_exists ? 0 : 1;
1301 =head3 generate_userid
1303 my $patron = Koha::Patron->new( $params );
1304 $patron->generate_userid
1306 Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
1308 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).
1312 sub generate_userid {
1315 my $firstname = $self->firstname // q{};
1316 my $surname = $self->surname // q{};
1317 #The script will "do" the following code and increment the $offset until the generated userid is unique
1319 $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1320 $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1321 my $userid = lc(($firstname)? "$firstname.$surname" : $surname);
1322 $userid = unac_string('utf-8',$userid);
1323 $userid .= $offset unless $offset == 0;
1324 $self->userid( $userid );
1326 } while (! $self->has_valid_userid );
1332 =head2 Internal methods
1344 Kyle M Hall <kyle@bywatersolutions.com>
1345 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>