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 );
35 use Koha::Old::Checkouts;
36 use Koha::Patron::Categories;
37 use Koha::Patron::HouseboundProfile;
38 use Koha::Patron::HouseboundRole;
39 use Koha::Patron::Images;
41 use Koha::Virtualshelves;
42 use Koha::Club::Enrollments;
44 use Koha::Subscription::Routinglists;
46 if ( ! can_load( modules => { 'Koha::NorwegianPatronDB' => undef } ) ) {
47 warn "Unable to load Koha::NorwegianPatronDB";
50 use base qw(Koha::Object);
52 our $RESULTSET_PATRON_ID_MAPPING = {
53 Accountline => 'borrowernumber',
54 Aqbasketuser => 'borrowernumber',
55 Aqbudget => 'budget_owner_id',
56 Aqbudgetborrower => 'borrowernumber',
57 ArticleRequest => 'borrowernumber',
58 BorrowerAttribute => 'borrowernumber',
59 BorrowerDebarment => 'borrowernumber',
60 BorrowerFile => 'borrowernumber',
61 BorrowerModification => 'borrowernumber',
62 ClubEnrollment => 'borrowernumber',
63 Issue => 'borrowernumber',
64 ItemsLastBorrower => 'borrowernumber',
65 Linktracker => 'borrowernumber',
66 Message => 'borrowernumber',
67 MessageQueue => 'borrowernumber',
68 OldIssue => 'borrowernumber',
69 OldReserve => 'borrowernumber',
70 Rating => 'borrowernumber',
71 Reserve => 'borrowernumber',
72 Review => 'borrowernumber',
73 SearchHistory => 'userid',
74 Statistic => 'borrowernumber',
75 Suggestion => 'suggestedby',
76 TagAll => 'borrowernumber',
77 Virtualshelfcontent => 'borrowernumber',
78 Virtualshelfshare => 'borrowernumber',
79 Virtualshelve => 'owner',
84 Koha::Patron - Koha Patron Object class
97 my ( $class, $params ) = @_;
99 return $class->SUPER::new($params);
102 =head3 fixup_cardnumber
104 Autogenerate next cardnumber from highest value found in database
108 sub fixup_cardnumber {
110 my $max = Koha::Patrons->search({
111 cardnumber => {-regexp => '^-?[0-9]+$'}
113 select => \'CAST(cardnumber AS SIGNED)',
114 as => ['cast_cardnumber']
115 })->_resultset->get_column('cast_cardnumber')->max;
116 $self->cardnumber(($max || 0) +1);
119 =head3 trim_whitespace
121 trim whitespace from data which has some non-whitespace in it.
122 Could be moved to Koha::Object if need to be reused
126 sub trim_whitespaces {
129 my $schema = Koha::Database->new->schema;
130 my @columns = $schema->source($self->_type)->columns;
132 for my $column( @columns ) {
133 my $value = $self->$column;
134 if ( defined $value ) {
135 $value =~ s/^\s*|\s*$//g;
136 $self->$column($value);
142 =head3 plain_text_password
144 $patron->plain_text_password( $password );
146 stores a copy of the unencrypted password in the object
147 for use in code before encrypting for db
151 sub plain_text_password {
152 my ( $self, $password ) = @_;
154 $self->{_plain_text_password} = $password;
157 return $self->{_plain_text_password}
158 if $self->{_plain_text_password};
165 Patron specific store method to cleanup record
166 and do other necessary things before saving
174 $self->_result->result_source->schema->txn_do(
177 C4::Context->preference("autoMemberNum")
178 and ( not defined $self->cardnumber
179 or $self->cardnumber eq '' )
182 # Warning: The caller is responsible for locking the members table in write
183 # mode, to avoid database corruption.
184 # We are in a transaction but the table is not locked
185 $self->fixup_cardnumber;
188 unless( $self->category->in_storage ) {
189 Koha::Exceptions::Object::FKConstraint->throw(
190 broken_fk => 'categorycode',
191 value => $self->categorycode,
195 $self->trim_whitespaces;
197 # We don't want invalid dates in the db (mysql has a bad habit of inserting 0000-00-00)
198 $self->dateofbirth(undef) unless $self->dateofbirth;
199 $self->debarred(undef) unless $self->debarred;
201 # Set default values if not set
202 $self->sms_provider_id(undef) unless $self->sms_provider_id;
203 $self->guarantorid(undef) unless $self->guarantorid;
205 unless ( $self->in_storage ) { #AddMember
207 # Generate a valid userid/login if needed
208 $self->generate_userid
209 if not $self->userid or not $self->has_valid_userid;
211 # Add expiration date if it isn't already there
212 unless ( $self->dateexpiry ) {
213 $self->dateexpiry( $self->category->get_expiry_date );
216 # Add enrollment date if it isn't already there
217 unless ( $self->dateenrolled ) {
218 $self->dateenrolled(dt_from_string);
221 # Set the privacy depending on the patron's category
222 my $default_privacy = $self->category->default_privacy || q{};
224 $default_privacy eq 'default' ? 1
225 : $default_privacy eq 'never' ? 2
226 : $default_privacy eq 'forever' ? 0
228 $self->privacy($default_privacy);
230 unless ( defined $self->privacy_guarantor_checkouts ) {
231 $self->privacy_guarantor_checkouts(0);
234 # Make a copy of the plain text password for later use
235 $self->plain_text_password( $self->password );
237 # Create a disabled account if no password provided
238 $self->password( $self->password
239 ? Koha::AuthUtils::hash_password( $self->password )
242 $self->borrowernumber(undef);
244 $self = $self->SUPER::store;
246 # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
247 # cronjob will use for syncing with NL
248 if ( C4::Context->preference('NorwegianPatronDBEnable')
249 && C4::Context->preference('NorwegianPatronDBEnable') == 1 )
251 Koha::Database->new->schema->resultset('BorrowerSync')
254 'borrowernumber' => $self->borrowernumber,
255 'synctype' => 'norwegianpatrondb',
257 'syncstatus' => 'new',
259 Koha::NorwegianPatronDB::NLEncryptPIN($self->plain_text_password),
264 $self->add_enrolment_fee_if_needed;
266 logaction( "MEMBERS", "CREATE", $self->borrowernumber, "" )
267 if C4::Context->preference("BorrowersLog");
270 # test to know if you must update or not the borrower password
271 if ( defined $self->password ) {
272 if ( $self->password eq '****' or $self->password eq '' ) {
273 $self->password(undef);
275 if ( C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
276 # Update the hashed PIN in borrower_sync.hashed_pin, before Koha hashes it
277 Koha::NorwegianPatronDB::NLUpdateHashedPIN( $self->borrowernumber, $self->password );
279 $self->password(Koha::AuthUtils::hash_password($self->password));
283 # Come from ModMember, but should not be possible (?)
284 $self->dateenrolled(undef) unless $self->dateenrolled;
285 $self->dateexpiry(undef) unless $self->dateexpiry;
287 # FIXME We should not deal with that here, callers have to do this job
288 # Moved from ModMember to prevent regressions
289 unless ( $self->userid ) {
290 my $stored_userid = $self->get_from_storage->userid;
291 $self->userid($stored_userid);
294 if ( C4::Context->preference('FeeOnChangePatronCategory')
295 and $self->category->categorycode ne
296 $self->get_from_storage->category->categorycode )
298 $self->add_enrolment_fee_if_needed;
301 # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
302 # cronjob will use for syncing with NL
303 if ( C4::Context->preference('NorwegianPatronDBEnable')
304 && C4::Context->preference('NorwegianPatronDBEnable') == 1 )
306 my $borrowersync = Koha::Database->new->schema->resultset('BorrowerSync')->find({
307 'synctype' => 'norwegianpatrondb',
308 'borrowernumber' => $self->borrowernumber,
310 # Do not set to "edited" if syncstatus is "new". We need to sync as new before
311 # we can sync as changed. And the "new sync" will pick up all changes since
312 # the patron was created anyway.
313 if ( $borrowersync->syncstatus ne 'new' && $borrowersync->syncstatus ne 'delete' ) {
314 $borrowersync->update( { 'syncstatus' => 'edited' } );
316 # Set the value of 'sync'
317 # FIXME THIS IS BROKEN # $borrowersync->update( { 'sync' => $data{'sync'} } );
319 # Try to do the live sync
320 Koha::NorwegianPatronDB::NLSync({ 'borrowernumber' => $self->borrowernumber });
323 my $borrowers_log = C4::Context->preference("BorrowersLog");
324 my $previous_cardnumber = $self->get_from_storage->cardnumber;
326 && ( !defined $previous_cardnumber
327 || $previous_cardnumber ne $self->cardnumber )
333 $self->borrowernumber,
336 cardnumber_replaced => {
337 previous_cardnumber => $previous_cardnumber,
338 new_cardnumber => $self->cardnumber,
341 { utf8 => 1, pretty => 1 }
346 logaction( "MEMBERS", "MODIFY", $self->borrowernumber,
347 "UPDATE (executed w/ arg: " . $self->borrowernumber . ")" )
350 $self = $self->SUPER::store;
361 Delete patron's holds, lists and finally the patron.
363 Lists owned by the borrower are deleted, but entries from the borrower to
364 other lists are kept.
372 $self->_result->result_source->schema->txn_do(
374 # Delete Patron's holds
375 $self->holds->delete;
377 # Delete all lists and all shares of this borrower
378 # Consistent with the approach Koha uses on deleting individual lists
379 # Note that entries in virtualshelfcontents added by this borrower to
380 # lists of others will be handled by a table constraint: the borrower
381 # is set to NULL in those entries.
383 # We could handle the above deletes via a constraint too.
384 # But a new BZ report 11889 has been opened to discuss another approach.
385 # Instead of deleting we could also disown lists (based on a pref).
386 # In that way we could save shared and public lists.
387 # The current table constraints support that idea now.
388 # This pref should then govern the results of other routines/methods such as
389 # Koha::Virtualshelf->new->delete too.
390 # FIXME Could be $patron->get_lists
391 $_->delete for Koha::Virtualshelves->search( { owner => $self->borrowernumber } );
393 $deleted = $self->SUPER::delete;
395 logaction( "MEMBERS", "DELETE", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog");
404 my $patron_category = $patron->category
406 Return the patron category for this patron
412 return Koha::Patron::Category->_new_from_dbic( $self->_result->categorycode );
417 Returns a Koha::Patron object for this patron's guarantor
424 return unless $self->guarantorid();
426 return Koha::Patrons->find( $self->guarantorid() );
432 return scalar Koha::Patron::Images->find( $self->borrowernumber );
437 return Koha::Library->_new_from_dbic($self->_result->branchcode);
442 Returns the guarantees (list of Koha::Patron) of this patron
449 return Koha::Patrons->search( { guarantorid => $self->borrowernumber } );
452 =head3 housebound_profile
454 Returns the HouseboundProfile associated with this patron.
458 sub housebound_profile {
460 my $profile = $self->_result->housebound_profile;
461 return Koha::Patron::HouseboundProfile->_new_from_dbic($profile)
466 =head3 housebound_role
468 Returns the HouseboundRole associated with this patron.
472 sub housebound_role {
475 my $role = $self->_result->housebound_role;
476 return Koha::Patron::HouseboundRole->_new_from_dbic($role) if ( $role );
482 Returns the siblings of this patron.
489 my $guarantor = $self->guarantor;
491 return unless $guarantor;
493 return Koha::Patrons->search(
497 '=' => $guarantor->id,
500 '!=' => $self->borrowernumber,
508 my $patron = Koha::Patrons->find($id);
509 $patron->merge_with( \@patron_ids );
511 This subroutine merges a list of patrons into the patron record. This is accomplished by finding
512 all related patron ids for the patrons to be merged in other tables and changing the ids to be that
513 of the keeper patron.
518 my ( $self, $patron_ids ) = @_;
520 my @patron_ids = @{ $patron_ids };
522 # Ensure the keeper isn't in the list of patrons to merge
523 @patron_ids = grep { $_ ne $self->id } @patron_ids;
525 my $schema = Koha::Database->new()->schema();
529 $self->_result->result_source->schema->txn_do( sub {
530 foreach my $patron_id (@patron_ids) {
531 my $patron = Koha::Patrons->find( $patron_id );
535 # Unbless for safety, the patron will end up being deleted
536 $results->{merged}->{$patron_id}->{patron} = $patron->unblessed;
538 while (my ($r, $field) = each(%$RESULTSET_PATRON_ID_MAPPING)) {
539 my $rs = $schema->resultset($r)->search({ $field => $patron_id });
540 $results->{merged}->{ $patron_id }->{updated}->{$r} = $rs->count();
541 $rs->update({ $field => $self->id });
544 $patron->move_to_deleted();
554 =head3 wants_check_for_previous_checkout
556 $wants_check = $patron->wants_check_for_previous_checkout;
558 Return 1 if Koha needs to perform PrevIssue checking, else 0.
562 sub wants_check_for_previous_checkout {
564 my $syspref = C4::Context->preference("checkPrevCheckout");
567 ## Hard syspref trumps all
568 return 1 if ($syspref eq 'hardyes');
569 return 0 if ($syspref eq 'hardno');
570 ## Now, patron pref trumps all
571 return 1 if ($self->checkprevcheckout eq 'yes');
572 return 0 if ($self->checkprevcheckout eq 'no');
574 # More complex: patron inherits -> determine category preference
575 my $checkPrevCheckoutByCat = $self->category->checkprevcheckout;
576 return 1 if ($checkPrevCheckoutByCat eq 'yes');
577 return 0 if ($checkPrevCheckoutByCat eq 'no');
579 # Finally: category preference is inherit, default to 0
580 if ($syspref eq 'softyes') {
587 =head3 do_check_for_previous_checkout
589 $do_check = $patron->do_check_for_previous_checkout($item);
591 Return 1 if the bib associated with $ITEM has previously been checked out to
592 $PATRON, 0 otherwise.
596 sub do_check_for_previous_checkout {
597 my ( $self, $item ) = @_;
599 # Find all items for bib and extract item numbers.
600 my @items = Koha::Items->search({biblionumber => $item->{biblionumber}});
602 foreach my $item (@items) {
603 push @item_nos, $item->itemnumber;
606 # Create (old)issues search criteria
608 borrowernumber => $self->borrowernumber,
609 itemnumber => \@item_nos,
612 # Check current issues table
613 my $issues = Koha::Checkouts->search($criteria);
614 return 1 if $issues->count; # 0 || N
616 # Check old issues table
617 my $old_issues = Koha::Old::Checkouts->search($criteria);
618 return $old_issues->count; # 0 || N
623 my $debarment_expiration = $patron->is_debarred;
625 Returns the date a patron debarment will expire, or undef if the patron is not
633 return unless $self->debarred;
634 return $self->debarred
635 if $self->debarred =~ '^9999'
636 or dt_from_string( $self->debarred ) > dt_from_string;
642 my $is_expired = $patron->is_expired;
644 Returns 1 if the patron is expired or 0;
650 return 0 unless $self->dateexpiry;
651 return 0 if $self->dateexpiry =~ '^9999';
652 return 1 if dt_from_string( $self->dateexpiry ) < dt_from_string->truncate( to => 'day' );
656 =head3 is_going_to_expire
658 my $is_going_to_expire = $patron->is_going_to_expire;
660 Returns 1 if the patron is going to expired, depending on the NotifyBorrowerDeparture pref or 0
664 sub is_going_to_expire {
667 my $delay = C4::Context->preference('NotifyBorrowerDeparture') || 0;
669 return 0 unless $delay;
670 return 0 unless $self->dateexpiry;
671 return 0 if $self->dateexpiry =~ '^9999';
672 return 1 if dt_from_string( $self->dateexpiry )->subtract( days => $delay ) < dt_from_string->truncate( to => 'day' );
676 =head3 update_password
678 my $updated = $patron->update_password( $userid, $password );
680 Update the userid and the password of a patron.
681 If the userid already exists, returns and let DBIx::Class warns
682 This will add an entry to action_logs if BorrowersLog is set.
686 sub update_password {
687 my ( $self, $userid, $password ) = @_;
688 eval { $self->userid($userid)->store; };
689 return if $@; # Make sure the userid is not already in used by another patron
692 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>