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 Module::Load::Conditional qw( can_load );
27 use Text::Unaccent qw( unac_string );
36 use Koha::Old::Checkouts;
37 use Koha::Patron::Categories;
38 use Koha::Patron::HouseboundProfile;
39 use Koha::Patron::HouseboundRole;
40 use Koha::Patron::Images;
42 use Koha::Virtualshelves;
43 use Koha::Club::Enrollments;
45 use Koha::Subscription::Routinglists;
47 if ( ! can_load( modules => { 'Koha::NorwegianPatronDB' => undef } ) ) {
48 warn "Unable to load Koha::NorwegianPatronDB";
51 use base qw(Koha::Object);
53 our $RESULTSET_PATRON_ID_MAPPING = {
54 Accountline => 'borrowernumber',
55 Aqbasketuser => 'borrowernumber',
56 Aqbudget => 'budget_owner_id',
57 Aqbudgetborrower => 'borrowernumber',
58 ArticleRequest => 'borrowernumber',
59 BorrowerAttribute => 'borrowernumber',
60 BorrowerDebarment => 'borrowernumber',
61 BorrowerFile => 'borrowernumber',
62 BorrowerModification => 'borrowernumber',
63 ClubEnrollment => 'borrowernumber',
64 Issue => 'borrowernumber',
65 ItemsLastBorrower => 'borrowernumber',
66 Linktracker => 'borrowernumber',
67 Message => 'borrowernumber',
68 MessageQueue => 'borrowernumber',
69 OldIssue => 'borrowernumber',
70 OldReserve => 'borrowernumber',
71 Rating => 'borrowernumber',
72 Reserve => 'borrowernumber',
73 Review => 'borrowernumber',
74 SearchHistory => 'userid',
75 Statistic => 'borrowernumber',
76 Suggestion => 'suggestedby',
77 TagAll => 'borrowernumber',
78 Virtualshelfcontent => 'borrowernumber',
79 Virtualshelfshare => 'borrowernumber',
80 Virtualshelve => 'owner',
85 Koha::Patron - Koha Patron Object class
98 my ( $class, $params ) = @_;
100 return $class->SUPER::new($params);
103 =head3 fixup_cardnumber
105 Autogenerate next cardnumber from highest value found in database
109 sub fixup_cardnumber {
111 my $max = Koha::Patrons->search({
112 cardnumber => {-regexp => '^-?[0-9]+$'}
114 select => \'CAST(cardnumber AS SIGNED)',
115 as => ['cast_cardnumber']
116 })->_resultset->get_column('cast_cardnumber')->max;
117 $self->cardnumber(($max || 0) +1);
120 =head3 trim_whitespace
122 trim whitespace from data which has some non-whitespace in it.
123 Could be moved to Koha::Object if need to be reused
127 sub trim_whitespaces {
130 my $schema = Koha::Database->new->schema;
131 my @columns = $schema->source($self->_type)->columns;
133 for my $column( @columns ) {
134 my $value = $self->$column;
135 if ( defined $value ) {
136 $value =~ s/^\s*|\s*$//g;
137 $self->$column($value);
143 =head3 plain_text_password
145 $patron->plain_text_password( $password );
147 stores a copy of the unencrypted password in the object
148 for use in code before encrypting for db
152 sub plain_text_password {
153 my ( $self, $password ) = @_;
155 $self->{_plain_text_password} = $password;
158 return $self->{_plain_text_password}
159 if $self->{_plain_text_password};
166 Patron specific store method to cleanup record
167 and do other necessary things before saving
175 $self->_result->result_source->schema->txn_do(
178 C4::Context->preference("autoMemberNum")
179 and ( not defined $self->cardnumber
180 or $self->cardnumber eq '' )
183 # Warning: The caller is responsible for locking the members table in write
184 # mode, to avoid database corruption.
185 # We are in a transaction but the table is not locked
186 $self->fixup_cardnumber;
189 unless( $self->category->in_storage ) {
190 Koha::Exceptions::Object::FKConstraint->throw(
191 broken_fk => 'categorycode',
192 value => $self->categorycode,
196 $self->trim_whitespaces;
198 # We don't want invalid dates in the db (mysql has a bad habit of inserting 0000-00-00)
199 $self->dateofbirth(undef) unless $self->dateofbirth;
200 $self->debarred(undef) unless $self->debarred;
202 # Set default values if not set
203 $self->sms_provider_id(undef) unless $self->sms_provider_id;
204 $self->guarantorid(undef) unless $self->guarantorid;
206 unless ( $self->in_storage ) { #AddMember
208 # Generate a valid userid/login if needed
209 $self->generate_userid
210 if not $self->userid or not $self->has_valid_userid;
212 # Add expiration date if it isn't already there
213 unless ( $self->dateexpiry ) {
214 $self->dateexpiry( $self->category->get_expiry_date );
217 # Add enrollment date if it isn't already there
218 unless ( $self->dateenrolled ) {
219 $self->dateenrolled(dt_from_string);
222 # Set the privacy depending on the patron's category
223 my $default_privacy = $self->category->default_privacy || q{};
225 $default_privacy eq 'default' ? 1
226 : $default_privacy eq 'never' ? 2
227 : $default_privacy eq 'forever' ? 0
229 $self->privacy($default_privacy);
231 unless ( defined $self->privacy_guarantor_checkouts ) {
232 $self->privacy_guarantor_checkouts(0);
235 # Make a copy of the plain text password for later use
236 $self->plain_text_password( $self->password );
238 # Create a disabled account if no password provided
239 $self->password( $self->password
240 ? Koha::AuthUtils::hash_password( $self->password )
243 $self->borrowernumber(undef);
245 $self = $self->SUPER::store;
247 # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
248 # cronjob will use for syncing with NL
249 if ( C4::Context->preference('NorwegianPatronDBEnable')
250 && C4::Context->preference('NorwegianPatronDBEnable') == 1 )
252 Koha::Database->new->schema->resultset('BorrowerSync')
255 'borrowernumber' => $self->borrowernumber,
256 'synctype' => 'norwegianpatrondb',
258 'syncstatus' => 'new',
260 Koha::NorwegianPatronDB::NLEncryptPIN($self->plain_text_password),
265 $self->add_enrolment_fee_if_needed;
267 logaction( "MEMBERS", "CREATE", $self->borrowernumber, "" )
268 if C4::Context->preference("BorrowersLog");
271 # We could add a test here to make sure the password is not update (?)
273 # Come from ModMember, but should not be possible (?)
274 $self->dateenrolled(undef) unless $self->dateenrolled;
275 $self->dateexpiry(undef) unless $self->dateexpiry;
277 # FIXME We should not deal with that here, callers have to do this job
278 # Moved from ModMember to prevent regressions
279 unless ( $self->userid ) {
280 my $stored_userid = $self->get_from_storage->userid;
281 $self->userid($stored_userid);
284 if ( C4::Context->preference('FeeOnChangePatronCategory')
285 and $self->category->categorycode ne
286 $self->get_from_storage->category->categorycode )
288 $self->add_enrolment_fee_if_needed;
291 # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
292 # cronjob will use for syncing with NL
293 if ( C4::Context->preference('NorwegianPatronDBEnable')
294 && C4::Context->preference('NorwegianPatronDBEnable') == 1 )
296 my $borrowersync = Koha::Database->new->schema->resultset('BorrowerSync')->find({
297 'synctype' => 'norwegianpatrondb',
298 'borrowernumber' => $self->borrowernumber,
300 # Do not set to "edited" if syncstatus is "new". We need to sync as new before
301 # we can sync as changed. And the "new sync" will pick up all changes since
302 # the patron was created anyway.
303 if ( $borrowersync->syncstatus ne 'new' && $borrowersync->syncstatus ne 'delete' ) {
304 $borrowersync->update( { 'syncstatus' => 'edited' } );
306 # Set the value of 'sync'
307 # FIXME THIS IS BROKEN # $borrowersync->update( { 'sync' => $data{'sync'} } );
309 # Try to do the live sync
310 Koha::NorwegianPatronDB::NLSync({ 'borrowernumber' => $self->borrowernumber });
313 my $borrowers_log = C4::Context->preference("BorrowersLog");
314 my $previous_cardnumber = $self->get_from_storage->cardnumber;
316 && ( !defined $previous_cardnumber
317 || $previous_cardnumber ne $self->cardnumber )
323 $self->borrowernumber,
326 cardnumber_replaced => {
327 previous_cardnumber => $previous_cardnumber,
328 new_cardnumber => $self->cardnumber,
331 { utf8 => 1, pretty => 1 }
336 logaction( "MEMBERS", "MODIFY", $self->borrowernumber,
337 "UPDATE (executed w/ arg: " . $self->borrowernumber . ")" )
340 $self = $self->SUPER::store;
351 Delete patron's holds, lists and finally the patron.
353 Lists owned by the borrower are deleted, but entries from the borrower to
354 other lists are kept.
362 $self->_result->result_source->schema->txn_do(
364 # Delete Patron's holds
365 $self->holds->delete;
367 # Delete all lists and all shares of this borrower
368 # Consistent with the approach Koha uses on deleting individual lists
369 # Note that entries in virtualshelfcontents added by this borrower to
370 # lists of others will be handled by a table constraint: the borrower
371 # is set to NULL in those entries.
373 # We could handle the above deletes via a constraint too.
374 # But a new BZ report 11889 has been opened to discuss another approach.
375 # Instead of deleting we could also disown lists (based on a pref).
376 # In that way we could save shared and public lists.
377 # The current table constraints support that idea now.
378 # This pref should then govern the results of other routines/methods such as
379 # Koha::Virtualshelf->new->delete too.
380 # FIXME Could be $patron->get_lists
381 $_->delete for Koha::Virtualshelves->search( { owner => $self->borrowernumber } );
383 $deleted = $self->SUPER::delete;
385 logaction( "MEMBERS", "DELETE", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog");
394 my $patron_category = $patron->category
396 Return the patron category for this patron
402 return Koha::Patron::Category->_new_from_dbic( $self->_result->categorycode );
407 Returns a Koha::Patron object for this patron's guarantor
414 return unless $self->guarantorid();
416 return Koha::Patrons->find( $self->guarantorid() );
422 return scalar Koha::Patron::Images->find( $self->borrowernumber );
427 return Koha::Library->_new_from_dbic($self->_result->branchcode);
432 Returns the guarantees (list of Koha::Patron) of this patron
439 return Koha::Patrons->search( { guarantorid => $self->borrowernumber } );
442 =head3 housebound_profile
444 Returns the HouseboundProfile associated with this patron.
448 sub housebound_profile {
450 my $profile = $self->_result->housebound_profile;
451 return Koha::Patron::HouseboundProfile->_new_from_dbic($profile)
456 =head3 housebound_role
458 Returns the HouseboundRole associated with this patron.
462 sub housebound_role {
465 my $role = $self->_result->housebound_role;
466 return Koha::Patron::HouseboundRole->_new_from_dbic($role) if ( $role );
472 Returns the siblings of this patron.
479 my $guarantor = $self->guarantor;
481 return unless $guarantor;
483 return Koha::Patrons->search(
487 '=' => $guarantor->id,
490 '!=' => $self->borrowernumber,
498 my $patron = Koha::Patrons->find($id);
499 $patron->merge_with( \@patron_ids );
501 This subroutine merges a list of patrons into the patron record. This is accomplished by finding
502 all related patron ids for the patrons to be merged in other tables and changing the ids to be that
503 of the keeper patron.
508 my ( $self, $patron_ids ) = @_;
510 my @patron_ids = @{ $patron_ids };
512 # Ensure the keeper isn't in the list of patrons to merge
513 @patron_ids = grep { $_ ne $self->id } @patron_ids;
515 my $schema = Koha::Database->new()->schema();
519 $self->_result->result_source->schema->txn_do( sub {
520 foreach my $patron_id (@patron_ids) {
521 my $patron = Koha::Patrons->find( $patron_id );
525 # Unbless for safety, the patron will end up being deleted
526 $results->{merged}->{$patron_id}->{patron} = $patron->unblessed;
528 while (my ($r, $field) = each(%$RESULTSET_PATRON_ID_MAPPING)) {
529 my $rs = $schema->resultset($r)->search({ $field => $patron_id });
530 $results->{merged}->{ $patron_id }->{updated}->{$r} = $rs->count();
531 $rs->update({ $field => $self->id });
534 $patron->move_to_deleted();
544 =head3 wants_check_for_previous_checkout
546 $wants_check = $patron->wants_check_for_previous_checkout;
548 Return 1 if Koha needs to perform PrevIssue checking, else 0.
552 sub wants_check_for_previous_checkout {
554 my $syspref = C4::Context->preference("checkPrevCheckout");
557 ## Hard syspref trumps all
558 return 1 if ($syspref eq 'hardyes');
559 return 0 if ($syspref eq 'hardno');
560 ## Now, patron pref trumps all
561 return 1 if ($self->checkprevcheckout eq 'yes');
562 return 0 if ($self->checkprevcheckout eq 'no');
564 # More complex: patron inherits -> determine category preference
565 my $checkPrevCheckoutByCat = $self->category->checkprevcheckout;
566 return 1 if ($checkPrevCheckoutByCat eq 'yes');
567 return 0 if ($checkPrevCheckoutByCat eq 'no');
569 # Finally: category preference is inherit, default to 0
570 if ($syspref eq 'softyes') {
577 =head3 do_check_for_previous_checkout
579 $do_check = $patron->do_check_for_previous_checkout($item);
581 Return 1 if the bib associated with $ITEM has previously been checked out to
582 $PATRON, 0 otherwise.
586 sub do_check_for_previous_checkout {
587 my ( $self, $item ) = @_;
589 # Find all items for bib and extract item numbers.
590 my @items = Koha::Items->search({biblionumber => $item->{biblionumber}});
592 foreach my $item (@items) {
593 push @item_nos, $item->itemnumber;
596 # Create (old)issues search criteria
598 borrowernumber => $self->borrowernumber,
599 itemnumber => \@item_nos,
602 # Check current issues table
603 my $issues = Koha::Checkouts->search($criteria);
604 return 1 if $issues->count; # 0 || N
606 # Check old issues table
607 my $old_issues = Koha::Old::Checkouts->search($criteria);
608 return $old_issues->count; # 0 || N
613 my $debarment_expiration = $patron->is_debarred;
615 Returns the date a patron debarment will expire, or undef if the patron is not
623 return unless $self->debarred;
624 return $self->debarred
625 if $self->debarred =~ '^9999'
626 or dt_from_string( $self->debarred ) > dt_from_string;
632 my $is_expired = $patron->is_expired;
634 Returns 1 if the patron is expired or 0;
640 return 0 unless $self->dateexpiry;
641 return 0 if $self->dateexpiry =~ '^9999';
642 return 1 if dt_from_string( $self->dateexpiry ) < dt_from_string->truncate( to => 'day' );
646 =head3 is_going_to_expire
648 my $is_going_to_expire = $patron->is_going_to_expire;
650 Returns 1 if the patron is going to expired, depending on the NotifyBorrowerDeparture pref or 0
654 sub is_going_to_expire {
657 my $delay = C4::Context->preference('NotifyBorrowerDeparture') || 0;
659 return 0 unless $delay;
660 return 0 unless $self->dateexpiry;
661 return 0 if $self->dateexpiry =~ '^9999';
662 return 1 if dt_from_string( $self->dateexpiry )->subtract( days => $delay ) < dt_from_string->truncate( to => 'day' );
666 =head3 update_password
668 my $updated = $patron->update_password( $userid, $password );
670 Update the userid and the password of a patron.
671 If the userid already exists, returns and let DBIx::Class warns
672 This will add an entry to action_logs if BorrowersLog is set.
676 sub update_password {
677 my ( $self, $userid, $password ) = @_;
678 eval { $self->userid($userid)->store; };
679 return if $@; # Make sure the userid is not already in used by another patron
681 return 0 if $password eq '****' or $password eq ''; # Do we need that?
683 if ( C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
684 # Update the hashed PIN in borrower_sync.hashed_pin, before Koha hashes it
685 Koha::NorwegianPatronDB::NLUpdateHashedPIN( $self->borrowernumber, $password );
688 my $digest = Koha::AuthUtils::hash_password($password);
696 logaction( "MEMBERS", "CHANGE PASS", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog");
702 my $new_expiry_date = $patron->renew_account
704 Extending the subscription to the expiry date.
711 if ( C4::Context->preference('BorrowerRenewalPeriodBase') eq 'combination' ) {
712 $date = ( dt_from_string gt dt_from_string( $self->dateexpiry ) ) ? dt_from_string : dt_from_string( $self->dateexpiry );
715 C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry'
716 ? dt_from_string( $self->dateexpiry )
719 my $expiry_date = $self->category->get_expiry_date($date);
721 $self->dateexpiry($expiry_date);
722 $self->date_renewed( dt_from_string() );
725 $self->add_enrolment_fee_if_needed;
727 logaction( "MEMBERS", "RENEW", $self->borrowernumber, "Membership renewed" ) if C4::Context->preference("BorrowersLog");
728 return dt_from_string( $expiry_date )->truncate( to => 'day' );
733 my $has_overdues = $patron->has_overdues;
735 Returns the number of patron's overdues
741 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
742 return $self->_result->issues->search({ date_due => { '<' => $dtf->format_datetime( dt_from_string() ) } })->count;
747 $patron->track_login;
748 $patron->track_login({ force => 1 });
750 Tracks a (successful) login attempt.
751 The preference TrackLastPatronActivity must be enabled. Or you
752 should pass the force parameter.
757 my ( $self, $params ) = @_;
760 !C4::Context->preference('TrackLastPatronActivity');
761 $self->lastseen( dt_from_string() )->store;
764 =head3 move_to_deleted
766 my $is_moved = $patron->move_to_deleted;
768 Move a patron to the deletedborrowers table.
769 This can be done before deleting a patron, to make sure the data are not completely deleted.
773 sub move_to_deleted {
775 my $patron_infos = $self->unblessed;
776 delete $patron_infos->{updated_on}; #This ensures the updated_on date in deletedborrowers will be set to the current timestamp
777 return Koha::Database->new->schema->resultset('Deletedborrower')->create($patron_infos);
780 =head3 article_requests
782 my @requests = $borrower->article_requests();
783 my $requests = $borrower->article_requests();
785 Returns either a list of ArticleRequests objects,
786 or an ArtitleRequests object, depending on the
791 sub article_requests {
794 $self->{_article_requests} ||= Koha::ArticleRequests->search({ borrowernumber => $self->borrowernumber() });
796 return $self->{_article_requests};
799 =head3 article_requests_current
801 my @requests = $patron->article_requests_current
803 Returns the article requests associated with this patron that are incomplete
807 sub article_requests_current {
810 $self->{_article_requests_current} ||= Koha::ArticleRequests->search(
812 borrowernumber => $self->id(),
814 { status => Koha::ArticleRequest::Status::Pending },
815 { status => Koha::ArticleRequest::Status::Processing }
820 return $self->{_article_requests_current};
823 =head3 article_requests_finished
825 my @requests = $biblio->article_requests_finished
827 Returns the article requests associated with this patron that are completed
831 sub article_requests_finished {
832 my ( $self, $borrower ) = @_;
834 $self->{_article_requests_finished} ||= Koha::ArticleRequests->search(
836 borrowernumber => $self->id(),
838 { status => Koha::ArticleRequest::Status::Completed },
839 { status => Koha::ArticleRequest::Status::Canceled }
844 return $self->{_article_requests_finished};
847 =head3 add_enrolment_fee_if_needed
849 my $enrolment_fee = $patron->add_enrolment_fee_if_needed;
851 Add enrolment fee for a patron if needed.
855 sub add_enrolment_fee_if_needed {
857 my $enrolment_fee = $self->category->enrolmentfee;
858 if ( $enrolment_fee && $enrolment_fee > 0 ) {
859 # insert fee in patron debts
860 C4::Accounts::manualinvoice( $self->borrowernumber, '', '', 'A', $enrolment_fee );
862 return $enrolment_fee || 0;
867 my $checkouts = $patron->checkouts
873 my $checkouts = $self->_result->issues;
874 return Koha::Checkouts->_new_from_dbic( $checkouts );
877 =head3 pending_checkouts
879 my $pending_checkouts = $patron->pending_checkouts
881 This method will return the same as $self->checkouts, but with a prefetch on
882 items, biblio and biblioitems.
884 It has been introduced to replaced the C4::Members::GetPendingIssues subroutine
886 It should not be used directly, prefer to access fields you need instead of
887 retrieving all these fields in one go.
892 sub pending_checkouts {
894 my $checkouts = $self->_result->issues->search(
898 { -desc => 'me.timestamp' },
899 { -desc => 'issuedate' },
900 { -desc => 'issue_id' }, # Sort by issue_id should be enough
902 prefetch => { item => { biblio => 'biblioitems' } },
905 return Koha::Checkouts->_new_from_dbic( $checkouts );
910 my $old_checkouts = $patron->old_checkouts
916 my $old_checkouts = $self->_result->old_issues;
917 return Koha::Old::Checkouts->_new_from_dbic( $old_checkouts );
922 my $overdue_items = $patron->get_overdues
924 Return the overdue items
930 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
931 return $self->checkouts->search(
933 'me.date_due' => { '<' => $dtf->format_datetime(dt_from_string) },
936 prefetch => { item => { biblio => 'biblioitems' } },
941 =head3 get_routing_lists
943 my @routinglists = $patron->get_routing_lists
945 Returns the routing lists a patron is subscribed to.
949 sub get_routing_lists {
951 my $routing_list_rs = $self->_result->subscriptionroutinglists;
952 return Koha::Subscription::Routinglists->_new_from_dbic($routing_list_rs);
957 my $age = $patron->get_age
959 Return the age of the patron
965 my $today_str = dt_from_string->strftime("%Y-%m-%d");
966 return unless $self->dateofbirth;
967 my $dob_str = dt_from_string( $self->dateofbirth )->strftime("%Y-%m-%d");
969 my ( $dob_y, $dob_m, $dob_d ) = split /-/, $dob_str;
970 my ( $today_y, $today_m, $today_d ) = split /-/, $today_str;
972 my $age = $today_y - $dob_y;
973 if ( $dob_m . $dob_d > $today_m . $today_d ) {
982 my $account = $patron->account
988 return Koha::Account->new( { patron_id => $self->borrowernumber } );
993 my $holds = $patron->holds
995 Return all the holds placed by this patron
1001 my $holds_rs = $self->_result->reserves->search( {}, { order_by => 'reservedate' } );
1002 return Koha::Holds->_new_from_dbic($holds_rs);
1007 my $old_holds = $patron->old_holds
1009 Return all the historical holds for this patron
1015 my $old_holds_rs = $self->_result->old_reserves->search( {}, { order_by => 'reservedate' } );
1016 return Koha::Old::Holds->_new_from_dbic($old_holds_rs);
1019 =head3 notice_email_address
1021 my $email = $patron->notice_email_address;
1023 Return the email address of patron used for notices.
1024 Returns the empty string if no email address.
1028 sub notice_email_address{
1031 my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
1032 # if syspref is set to 'first valid' (value == OFF), look up email address
1033 if ( $which_address eq 'OFF' ) {
1034 return $self->first_valid_email_address;
1037 return $self->$which_address || '';
1040 =head3 first_valid_email_address
1042 my $first_valid_email_address = $patron->first_valid_email_address
1044 Return the first valid email address for a patron.
1045 For now, the order is defined as email, emailpro, B_email.
1046 Returns the empty string if the borrower has no email addresses.
1050 sub first_valid_email_address {
1053 return $self->email() || $self->emailpro() || $self->B_email() || q{};
1056 =head3 get_club_enrollments
1060 sub get_club_enrollments {
1061 my ( $self, $return_scalar ) = @_;
1063 my $e = Koha::Club::Enrollments->search( { borrowernumber => $self->borrowernumber(), date_canceled => undef } );
1065 return $e if $return_scalar;
1067 return wantarray ? $e->as_list : $e;
1070 =head3 get_enrollable_clubs
1074 sub get_enrollable_clubs {
1075 my ( $self, $is_enrollable_from_opac, $return_scalar ) = @_;
1078 $params->{is_enrollable_from_opac} = $is_enrollable_from_opac
1079 if $is_enrollable_from_opac;
1080 $params->{is_email_required} = 0 unless $self->first_valid_email_address();
1082 $params->{borrower} = $self;
1084 my $e = Koha::Clubs->get_enrollable($params);
1086 return $e if $return_scalar;
1088 return wantarray ? $e->as_list : $e;
1091 =head3 account_locked
1093 my $is_locked = $patron->account_locked
1095 Return true if the patron has reach the maximum number of login attempts (see pref FailedLoginAttempts).
1096 Otherwise return false.
1097 If the pref is not set (empty string, null or 0), the feature is considered as disabled.
1101 sub account_locked {
1103 my $FailedLoginAttempts = C4::Context->preference('FailedLoginAttempts');
1104 return ( $FailedLoginAttempts
1105 and $self->login_attempts
1106 and $self->login_attempts >= $FailedLoginAttempts )? 1 : 0;
1109 =head3 can_see_patron_infos
1111 my $can_see = $patron->can_see_patron_infos( $patron );
1113 Return true if the patron (usually the logged in user) can see the patron's infos for a given patron
1117 sub can_see_patron_infos {
1118 my ( $self, $patron ) = @_;
1119 return $self->can_see_patrons_from( $patron->library->branchcode );
1122 =head3 can_see_patrons_from
1124 my $can_see = $patron->can_see_patrons_from( $branchcode );
1126 Return true if the patron (usually the logged in user) can see the patron's infos from a given library
1130 sub can_see_patrons_from {
1131 my ( $self, $branchcode ) = @_;
1133 if ( $self->branchcode eq $branchcode ) {
1135 } elsif ( $self->has_permission( { borrowers => 'view_borrower_infos_from_any_libraries' } ) ) {
1137 } elsif ( my $library_groups = $self->library->library_groups ) {
1138 while ( my $library_group = $library_groups->next ) {
1139 if ( $library_group->parent->has_child( $branchcode ) ) {
1148 =head3 libraries_where_can_see_patrons
1150 my $libraries = $patron-libraries_where_can_see_patrons;
1152 Return the list of branchcodes(!) of libraries the patron is allowed to see other patron's infos.
1153 The branchcodes are arbitrarily returned sorted.
1154 We are supposing here that the object is related to the logged in patron (use of C4::Context::only_my_library)
1156 An empty array means no restriction, the patron can see patron's infos from any libraries.
1160 sub libraries_where_can_see_patrons {
1162 my $userenv = C4::Context->userenv;
1164 return () unless $userenv; # For tests, but userenv should be defined in tests...
1166 my @restricted_branchcodes;
1167 if (C4::Context::only_my_library) {
1168 push @restricted_branchcodes, $self->branchcode;
1172 $self->has_permission(
1173 { borrowers => 'view_borrower_infos_from_any_libraries' }
1177 my $library_groups = $self->library->library_groups({ ft_hide_patron_info => 1 });
1178 if ( $library_groups->count )
1180 while ( my $library_group = $library_groups->next ) {
1181 my $parent = $library_group->parent;
1182 if ( $parent->has_child( $self->branchcode ) ) {
1183 push @restricted_branchcodes, $parent->children->get_column('branchcode');
1188 @restricted_branchcodes = ( $self->branchcode ) unless @restricted_branchcodes;
1192 @restricted_branchcodes = grep { defined $_ } @restricted_branchcodes;
1193 @restricted_branchcodes = uniq(@restricted_branchcodes);
1194 @restricted_branchcodes = sort(@restricted_branchcodes);
1195 return @restricted_branchcodes;
1198 sub has_permission {
1199 my ( $self, $flagsrequired ) = @_;
1200 return unless $self->userid;
1201 # TODO code from haspermission needs to be moved here!
1202 return C4::Auth::haspermission( $self->userid, $flagsrequired );
1207 my $is_adult = $patron->is_adult
1209 Return true if the patron has a category with a type Adult (A) or Organization (I)
1215 return $self->category->category_type =~ /^(A|I)$/ ? 1 : 0;
1220 my $is_child = $patron->is_child
1222 Return true if the patron has a category with a type Child (C)
1227 return $self->category->category_type eq 'C' ? 1 : 0;
1230 =head3 has_valid_userid
1232 my $patron = Koha::Patrons->find(42);
1233 $patron->userid( $new_userid );
1234 my $has_a_valid_userid = $patron->has_valid_userid
1236 my $patron = Koha::Patron->new( $params );
1237 my $has_a_valid_userid = $patron->has_valid_userid
1239 Return true if the current userid of this patron is valid/unique, otherwise false.
1241 Note that this should be done in $self->store instead and raise an exception if needed.
1245 sub has_valid_userid {
1248 return 0 unless $self->userid;
1250 return 0 if ( $self->userid eq C4::Context->config('user') ); # DB user
1252 my $already_exists = Koha::Patrons->search(
1254 userid => $self->userid,
1257 ? ( borrowernumber => { '!=' => $self->borrowernumber } )
1262 return $already_exists ? 0 : 1;
1265 =head3 generate_userid
1267 my $patron = Koha::Patron->new( $params );
1268 $patron->generate_userid
1270 Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
1272 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).
1276 sub generate_userid {
1279 my $firstname = $self->firstname // q{};
1280 my $surname = $self->surname // q{};
1281 #The script will "do" the following code and increment the $offset until the generated userid is unique
1283 $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1284 $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1285 my $userid = lc(($firstname)? "$firstname.$surname" : $surname);
1286 $userid = unac_string('utf-8',$userid);
1287 $userid .= $offset unless $offset == 0;
1288 $self->userid( $userid );
1290 } while (! $self->has_valid_userid );
1296 =head2 Internal methods
1308 Kyle M Hall <kyle@bywatersolutions.com>
1309 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>