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( any uniq );
25 use JSON qw( to_json );
26 use Text::Unaccent qw( unac_string );
34 use Koha::Exceptions::Password;
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 use base qw(Koha::Object);
49 our $RESULTSET_PATRON_ID_MAPPING = {
50 Accountline => 'borrowernumber',
51 Aqbasketuser => 'borrowernumber',
52 Aqbudget => 'budget_owner_id',
53 Aqbudgetborrower => 'borrowernumber',
54 ArticleRequest => 'borrowernumber',
55 BorrowerAttribute => 'borrowernumber',
56 BorrowerDebarment => 'borrowernumber',
57 BorrowerFile => 'borrowernumber',
58 BorrowerModification => 'borrowernumber',
59 ClubEnrollment => 'borrowernumber',
60 Issue => 'borrowernumber',
61 ItemsLastBorrower => 'borrowernumber',
62 Linktracker => 'borrowernumber',
63 Message => 'borrowernumber',
64 MessageQueue => 'borrowernumber',
65 OldIssue => 'borrowernumber',
66 OldReserve => 'borrowernumber',
67 Rating => 'borrowernumber',
68 Reserve => 'borrowernumber',
69 Review => 'borrowernumber',
70 SearchHistory => 'userid',
71 Statistic => 'borrowernumber',
72 Suggestion => 'suggestedby',
73 TagAll => 'borrowernumber',
74 Virtualshelfcontent => 'borrowernumber',
75 Virtualshelfshare => 'borrowernumber',
76 Virtualshelve => 'owner',
81 Koha::Patron - Koha Patron Object class
92 my ( $class, $params ) = @_;
94 return $class->SUPER::new($params);
97 =head3 fixup_cardnumber
99 Autogenerate next cardnumber from highest value found in database
103 sub fixup_cardnumber {
105 my $max = Koha::Patrons->search({
106 cardnumber => {-regexp => '^-?[0-9]+$'}
108 select => \'CAST(cardnumber AS SIGNED)',
109 as => ['cast_cardnumber']
110 })->_resultset->get_column('cast_cardnumber')->max;
111 $self->cardnumber(($max || 0) +1);
114 =head3 trim_whitespace
116 trim whitespace from data which has some non-whitespace in it.
117 Could be moved to Koha::Object if need to be reused
121 sub trim_whitespaces {
124 my $schema = Koha::Database->new->schema;
125 my @columns = $schema->source($self->_type)->columns;
127 for my $column( @columns ) {
128 my $value = $self->$column;
129 if ( defined $value ) {
130 $value =~ s/^\s*|\s*$//g;
131 $self->$column($value);
137 =head3 plain_text_password
139 $patron->plain_text_password( $password );
141 stores a copy of the unencrypted password in the object
142 for use in code before encrypting for db
146 sub plain_text_password {
147 my ( $self, $password ) = @_;
149 $self->{_plain_text_password} = $password;
152 return $self->{_plain_text_password}
153 if $self->{_plain_text_password};
160 Patron specific store method to cleanup record
161 and do other necessary things before saving
169 $self->_result->result_source->schema->txn_do(
172 C4::Context->preference("autoMemberNum")
173 and ( not defined $self->cardnumber
174 or $self->cardnumber eq '' )
177 # Warning: The caller is responsible for locking the members table in write
178 # mode, to avoid database corruption.
179 # We are in a transaction but the table is not locked
180 $self->fixup_cardnumber;
183 unless( $self->category->in_storage ) {
184 Koha::Exceptions::Object::FKConstraint->throw(
185 broken_fk => 'categorycode',
186 value => $self->categorycode,
190 $self->trim_whitespaces;
192 unless ( $self->in_storage ) { #AddMember
194 # Generate a valid userid/login if needed
195 $self->generate_userid
196 if not $self->userid or not $self->has_valid_userid;
198 # Add expiration date if it isn't already there
199 unless ( $self->dateexpiry ) {
200 $self->dateexpiry( $self->category->get_expiry_date );
203 # Add enrollment date if it isn't already there
204 unless ( $self->dateenrolled ) {
205 $self->dateenrolled(dt_from_string);
208 # Set the privacy depending on the patron's category
209 my $default_privacy = $self->category->default_privacy || q{};
211 $default_privacy eq 'default' ? 1
212 : $default_privacy eq 'never' ? 2
213 : $default_privacy eq 'forever' ? 0
215 $self->privacy($default_privacy);
218 # Make a copy of the plain text password for later use
219 $self->plain_text_password( $self->password );
221 # Create a disabled account if no password provided
222 $self->password( $self->password
223 ? Koha::AuthUtils::hash_password( $self->password )
226 $self->borrowernumber(undef);
228 $self = $self->SUPER::store;
230 $self->add_enrolment_fee_if_needed;
232 logaction( "MEMBERS", "CREATE", $self->borrowernumber, "" )
233 if C4::Context->preference("BorrowersLog");
237 my $self_from_storage = $self->get_from_storage;
238 # FIXME We should not deal with that here, callers have to do this job
239 # Moved from ModMember to prevent regressions
240 unless ( $self->userid ) {
241 my $stored_userid = $self_from_storage->userid;
242 $self->userid($stored_userid);
245 # Password must be updated using $self->set_password
246 $self->password($self_from_storage->password);
248 if ( C4::Context->preference('FeeOnChangePatronCategory')
249 and $self->category->categorycode ne
250 $self_from_storage->category->categorycode )
252 $self->add_enrolment_fee_if_needed;
256 if ( C4::Context->preference("BorrowersLog") ) {
258 my $from_storage = $self_from_storage->unblessed;
259 my $from_object = $self->unblessed;
260 my @skip_fields = (qw/lastseen/);
261 for my $key ( keys %{$from_storage} ) {
262 next if any { /$key/ } @skip_fields;
265 !defined( $from_storage->{$key} )
266 && defined( $from_object->{$key} )
268 || ( defined( $from_storage->{$key} )
269 && !defined( $from_object->{$key} ) )
271 defined( $from_storage->{$key} )
272 && defined( $from_object->{$key} )
273 && ( $from_storage->{$key} ne
274 $from_object->{$key} )
279 before => $from_storage->{$key},
280 after => $from_object->{$key}
285 if ( defined($info) ) {
289 $self->borrowernumber,
292 { utf8 => 1, pretty => 1, canonical => 1 }
299 $self = $self->SUPER::store;
310 Delete patron's holds, lists and finally the patron.
312 Lists owned by the borrower are deleted, but entries from the borrower to
313 other lists are kept.
321 $self->_result->result_source->schema->txn_do(
323 # Delete Patron's holds
324 $self->holds->delete;
326 # Delete all lists and all shares of this borrower
327 # Consistent with the approach Koha uses on deleting individual lists
328 # Note that entries in virtualshelfcontents added by this borrower to
329 # lists of others will be handled by a table constraint: the borrower
330 # is set to NULL in those entries.
332 # We could handle the above deletes via a constraint too.
333 # But a new BZ report 11889 has been opened to discuss another approach.
334 # Instead of deleting we could also disown lists (based on a pref).
335 # In that way we could save shared and public lists.
336 # The current table constraints support that idea now.
337 # This pref should then govern the results of other routines/methods such as
338 # Koha::Virtualshelf->new->delete too.
339 # FIXME Could be $patron->get_lists
340 $_->delete for Koha::Virtualshelves->search( { owner => $self->borrowernumber } );
342 $deleted = $self->SUPER::delete;
344 logaction( "MEMBERS", "DELETE", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog");
353 my $patron_category = $patron->category
355 Return the patron category for this patron
361 return Koha::Patron::Category->_new_from_dbic( $self->_result->categorycode );
366 Returns a Koha::Patron object for this patron's guarantor
373 return unless $self->guarantorid();
375 return Koha::Patrons->find( $self->guarantorid() );
381 return scalar Koha::Patron::Images->find( $self->borrowernumber );
386 return Koha::Library->_new_from_dbic($self->_result->branchcode);
391 Returns the guarantees (list of Koha::Patron) of this patron
398 return Koha::Patrons->search( { guarantorid => $self->borrowernumber }, { order_by => { -asc => ['surname','firstname'] } } );
401 =head3 housebound_profile
403 Returns the HouseboundProfile associated with this patron.
407 sub housebound_profile {
409 my $profile = $self->_result->housebound_profile;
410 return Koha::Patron::HouseboundProfile->_new_from_dbic($profile)
415 =head3 housebound_role
417 Returns the HouseboundRole associated with this patron.
421 sub housebound_role {
424 my $role = $self->_result->housebound_role;
425 return Koha::Patron::HouseboundRole->_new_from_dbic($role) if ( $role );
431 Returns the siblings of this patron.
438 my $guarantor = $self->guarantor;
440 return unless $guarantor;
442 return Koha::Patrons->search(
446 '=' => $guarantor->id,
449 '!=' => $self->borrowernumber,
457 my $patron = Koha::Patrons->find($id);
458 $patron->merge_with( \@patron_ids );
460 This subroutine merges a list of patrons into the patron record. This is accomplished by finding
461 all related patron ids for the patrons to be merged in other tables and changing the ids to be that
462 of the keeper patron.
467 my ( $self, $patron_ids ) = @_;
469 my @patron_ids = @{ $patron_ids };
471 # Ensure the keeper isn't in the list of patrons to merge
472 @patron_ids = grep { $_ ne $self->id } @patron_ids;
474 my $schema = Koha::Database->new()->schema();
478 $self->_result->result_source->schema->txn_do( sub {
479 foreach my $patron_id (@patron_ids) {
480 my $patron = Koha::Patrons->find( $patron_id );
484 # Unbless for safety, the patron will end up being deleted
485 $results->{merged}->{$patron_id}->{patron} = $patron->unblessed;
487 while (my ($r, $field) = each(%$RESULTSET_PATRON_ID_MAPPING)) {
488 my $rs = $schema->resultset($r)->search({ $field => $patron_id });
489 $results->{merged}->{ $patron_id }->{updated}->{$r} = $rs->count();
490 $rs->update({ $field => $self->id });
493 $patron->move_to_deleted();
503 =head3 wants_check_for_previous_checkout
505 $wants_check = $patron->wants_check_for_previous_checkout;
507 Return 1 if Koha needs to perform PrevIssue checking, else 0.
511 sub wants_check_for_previous_checkout {
513 my $syspref = C4::Context->preference("checkPrevCheckout");
516 ## Hard syspref trumps all
517 return 1 if ($syspref eq 'hardyes');
518 return 0 if ($syspref eq 'hardno');
519 ## Now, patron pref trumps all
520 return 1 if ($self->checkprevcheckout eq 'yes');
521 return 0 if ($self->checkprevcheckout eq 'no');
523 # More complex: patron inherits -> determine category preference
524 my $checkPrevCheckoutByCat = $self->category->checkprevcheckout;
525 return 1 if ($checkPrevCheckoutByCat eq 'yes');
526 return 0 if ($checkPrevCheckoutByCat eq 'no');
528 # Finally: category preference is inherit, default to 0
529 if ($syspref eq 'softyes') {
536 =head3 do_check_for_previous_checkout
538 $do_check = $patron->do_check_for_previous_checkout($item);
540 Return 1 if the bib associated with $ITEM has previously been checked out to
541 $PATRON, 0 otherwise.
545 sub do_check_for_previous_checkout {
546 my ( $self, $item ) = @_;
548 # Find all items for bib and extract item numbers.
549 my @items = Koha::Items->search({biblionumber => $item->{biblionumber}});
551 foreach my $item (@items) {
552 push @item_nos, $item->itemnumber;
555 # Create (old)issues search criteria
557 borrowernumber => $self->borrowernumber,
558 itemnumber => \@item_nos,
561 # Check current issues table
562 my $issues = Koha::Checkouts->search($criteria);
563 return 1 if $issues->count; # 0 || N
565 # Check old issues table
566 my $old_issues = Koha::Old::Checkouts->search($criteria);
567 return $old_issues->count; # 0 || N
572 my $debarment_expiration = $patron->is_debarred;
574 Returns the date a patron debarment will expire, or undef if the patron is not
582 return unless $self->debarred;
583 return $self->debarred
584 if $self->debarred =~ '^9999'
585 or dt_from_string( $self->debarred ) > dt_from_string;
591 my $is_expired = $patron->is_expired;
593 Returns 1 if the patron is expired or 0;
599 return 0 unless $self->dateexpiry;
600 return 0 if $self->dateexpiry =~ '^9999';
601 return 1 if dt_from_string( $self->dateexpiry ) < dt_from_string->truncate( to => 'day' );
605 =head3 is_going_to_expire
607 my $is_going_to_expire = $patron->is_going_to_expire;
609 Returns 1 if the patron is going to expired, depending on the NotifyBorrowerDeparture pref or 0
613 sub is_going_to_expire {
616 my $delay = C4::Context->preference('NotifyBorrowerDeparture') || 0;
618 return 0 unless $delay;
619 return 0 unless $self->dateexpiry;
620 return 0 if $self->dateexpiry =~ '^9999';
621 return 1 if dt_from_string( $self->dateexpiry )->subtract( days => $delay ) < dt_from_string->truncate( to => 'day' );
627 $patron->set_password({ password => $plain_text_password [, skip_validation => 1 ] });
629 Set the patron's password.
633 The passed string is validated against the current password enforcement policy.
634 Validation can be skipped by passing the I<skip_validation> parameter.
636 Exceptions are thrown if the password is not good enough.
640 =item Koha::Exceptions::Password::TooShort
642 =item Koha::Exceptions::Password::WhitespaceCharacters
644 =item Koha::Exceptions::Password::TooWeak
651 my ( $self, $args ) = @_;
653 my $password = $args->{password};
655 unless ( $args->{skip_validation} ) {
656 my ( $is_valid, $error ) = Koha::AuthUtils::is_password_valid( $password );
659 if ( $error eq 'too_short' ) {
660 my $min_length = C4::Context->preference('minPasswordLength');
661 $min_length = 3 if not $min_length or $min_length < 3;
663 my $password_length = length($password);
664 Koha::Exceptions::Password::TooShort->throw(
665 length => $password_length, min_length => $min_length );
667 elsif ( $error eq 'has_whitespaces' ) {
668 Koha::Exceptions::Password::WhitespaceCharacters->throw();
670 elsif ( $error eq 'too_weak' ) {
671 Koha::Exceptions::Password::TooWeak->throw();
676 my $digest = Koha::AuthUtils::hash_password($password);
678 { password => $digest,
683 logaction( "MEMBERS", "CHANGE PASS", $self->borrowernumber, "" )
684 if C4::Context->preference("BorrowersLog");
692 my $new_expiry_date = $patron->renew_account
694 Extending the subscription to the expiry date.
701 if ( C4::Context->preference('BorrowerRenewalPeriodBase') eq 'combination' ) {
702 $date = ( dt_from_string gt dt_from_string( $self->dateexpiry ) ) ? dt_from_string : dt_from_string( $self->dateexpiry );
705 C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry'
706 ? dt_from_string( $self->dateexpiry )
709 my $expiry_date = $self->category->get_expiry_date($date);
711 $self->dateexpiry($expiry_date);
712 $self->date_renewed( dt_from_string() );
715 $self->add_enrolment_fee_if_needed;
717 logaction( "MEMBERS", "RENEW", $self->borrowernumber, "Membership renewed" ) if C4::Context->preference("BorrowersLog");
718 return dt_from_string( $expiry_date )->truncate( to => 'day' );
723 my $has_overdues = $patron->has_overdues;
725 Returns the number of patron's overdues
731 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
732 return $self->_result->issues->search({ date_due => { '<' => $dtf->format_datetime( dt_from_string() ) } })->count;
737 $patron->track_login;
738 $patron->track_login({ force => 1 });
740 Tracks a (successful) login attempt.
741 The preference TrackLastPatronActivity must be enabled. Or you
742 should pass the force parameter.
747 my ( $self, $params ) = @_;
750 !C4::Context->preference('TrackLastPatronActivity');
751 $self->lastseen( dt_from_string() )->store;
754 =head3 move_to_deleted
756 my $is_moved = $patron->move_to_deleted;
758 Move a patron to the deletedborrowers table.
759 This can be done before deleting a patron, to make sure the data are not completely deleted.
763 sub move_to_deleted {
765 my $patron_infos = $self->unblessed;
766 delete $patron_infos->{updated_on}; #This ensures the updated_on date in deletedborrowers will be set to the current timestamp
767 return Koha::Database->new->schema->resultset('Deletedborrower')->create($patron_infos);
770 =head3 article_requests
772 my @requests = $borrower->article_requests();
773 my $requests = $borrower->article_requests();
775 Returns either a list of ArticleRequests objects,
776 or an ArtitleRequests object, depending on the
781 sub article_requests {
784 $self->{_article_requests} ||= Koha::ArticleRequests->search({ borrowernumber => $self->borrowernumber() });
786 return $self->{_article_requests};
789 =head3 article_requests_current
791 my @requests = $patron->article_requests_current
793 Returns the article requests associated with this patron that are incomplete
797 sub article_requests_current {
800 $self->{_article_requests_current} ||= Koha::ArticleRequests->search(
802 borrowernumber => $self->id(),
804 { status => Koha::ArticleRequest::Status::Pending },
805 { status => Koha::ArticleRequest::Status::Processing }
810 return $self->{_article_requests_current};
813 =head3 article_requests_finished
815 my @requests = $biblio->article_requests_finished
817 Returns the article requests associated with this patron that are completed
821 sub article_requests_finished {
822 my ( $self, $borrower ) = @_;
824 $self->{_article_requests_finished} ||= Koha::ArticleRequests->search(
826 borrowernumber => $self->id(),
828 { status => Koha::ArticleRequest::Status::Completed },
829 { status => Koha::ArticleRequest::Status::Canceled }
834 return $self->{_article_requests_finished};
837 =head3 add_enrolment_fee_if_needed
839 my $enrolment_fee = $patron->add_enrolment_fee_if_needed;
841 Add enrolment fee for a patron if needed.
845 sub add_enrolment_fee_if_needed {
847 my $enrolment_fee = $self->category->enrolmentfee;
848 if ( $enrolment_fee && $enrolment_fee > 0 ) {
849 $self->account->add_debit(
851 amount => $enrolment_fee,
852 user_id => C4::Context->userenv ? C4::Context->userenv->{'number'} : 0,
853 library_id => C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef,
858 return $enrolment_fee || 0;
863 my $checkouts = $patron->checkouts
869 my $checkouts = $self->_result->issues;
870 return Koha::Checkouts->_new_from_dbic( $checkouts );
873 =head3 pending_checkouts
875 my $pending_checkouts = $patron->pending_checkouts
877 This method will return the same as $self->checkouts, but with a prefetch on
878 items, biblio and biblioitems.
880 It has been introduced to replaced the C4::Members::GetPendingIssues subroutine
882 It should not be used directly, prefer to access fields you need instead of
883 retrieving all these fields in one go.
887 sub pending_checkouts {
889 my $checkouts = $self->_result->issues->search(
893 { -desc => 'me.timestamp' },
894 { -desc => 'issuedate' },
895 { -desc => 'issue_id' }, # Sort by issue_id should be enough
897 prefetch => { item => { biblio => 'biblioitems' } },
900 return Koha::Checkouts->_new_from_dbic( $checkouts );
905 my $old_checkouts = $patron->old_checkouts
911 my $old_checkouts = $self->_result->old_issues;
912 return Koha::Old::Checkouts->_new_from_dbic( $old_checkouts );
917 my $overdue_items = $patron->get_overdues
919 Return the overdue items
925 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
926 return $self->checkouts->search(
928 'me.date_due' => { '<' => $dtf->format_datetime(dt_from_string) },
931 prefetch => { item => { biblio => 'biblioitems' } },
936 =head3 get_routing_lists
938 my @routinglists = $patron->get_routing_lists
940 Returns the routing lists a patron is subscribed to.
944 sub get_routing_lists {
946 my $routing_list_rs = $self->_result->subscriptionroutinglists;
947 return Koha::Subscription::Routinglists->_new_from_dbic($routing_list_rs);
952 my $age = $patron->get_age
954 Return the age of the patron
960 my $today_str = dt_from_string->strftime("%Y-%m-%d");
961 return unless $self->dateofbirth;
962 my $dob_str = dt_from_string( $self->dateofbirth )->strftime("%Y-%m-%d");
964 my ( $dob_y, $dob_m, $dob_d ) = split /-/, $dob_str;
965 my ( $today_y, $today_m, $today_d ) = split /-/, $today_str;
967 my $age = $today_y - $dob_y;
968 if ( $dob_m . $dob_d > $today_m . $today_d ) {
977 my $account = $patron->account
983 return Koha::Account->new( { patron_id => $self->borrowernumber } );
988 my $holds = $patron->holds
990 Return all the holds placed by this patron
996 my $holds_rs = $self->_result->reserves->search( {}, { order_by => 'reservedate' } );
997 return Koha::Holds->_new_from_dbic($holds_rs);
1002 my $old_holds = $patron->old_holds
1004 Return all the historical holds for this patron
1010 my $old_holds_rs = $self->_result->old_reserves->search( {}, { order_by => 'reservedate' } );
1011 return Koha::Old::Holds->_new_from_dbic($old_holds_rs);
1014 =head3 notice_email_address
1016 my $email = $patron->notice_email_address;
1018 Return the email address of patron used for notices.
1019 Returns the empty string if no email address.
1023 sub notice_email_address{
1026 my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
1027 # if syspref is set to 'first valid' (value == OFF), look up email address
1028 if ( $which_address eq 'OFF' ) {
1029 return $self->first_valid_email_address;
1032 return $self->$which_address || '';
1035 =head3 first_valid_email_address
1037 my $first_valid_email_address = $patron->first_valid_email_address
1039 Return the first valid email address for a patron.
1040 For now, the order is defined as email, emailpro, B_email.
1041 Returns the empty string if the borrower has no email addresses.
1045 sub first_valid_email_address {
1048 return $self->email() || $self->emailpro() || $self->B_email() || q{};
1051 =head3 get_club_enrollments
1055 sub get_club_enrollments {
1056 my ( $self, $return_scalar ) = @_;
1058 my $e = Koha::Club::Enrollments->search( { borrowernumber => $self->borrowernumber(), date_canceled => undef } );
1060 return $e if $return_scalar;
1062 return wantarray ? $e->as_list : $e;
1065 =head3 get_enrollable_clubs
1069 sub get_enrollable_clubs {
1070 my ( $self, $is_enrollable_from_opac, $return_scalar ) = @_;
1073 $params->{is_enrollable_from_opac} = $is_enrollable_from_opac
1074 if $is_enrollable_from_opac;
1075 $params->{is_email_required} = 0 unless $self->first_valid_email_address();
1077 $params->{borrower} = $self;
1079 my $e = Koha::Clubs->get_enrollable($params);
1081 return $e if $return_scalar;
1083 return wantarray ? $e->as_list : $e;
1086 =head3 account_locked
1088 my $is_locked = $patron->account_locked
1090 Return true if the patron has reach the maximum number of login attempts (see pref FailedLoginAttempts).
1091 Otherwise return false.
1092 If the pref is not set (empty string, null or 0), the feature is considered as disabled.
1096 sub account_locked {
1098 my $FailedLoginAttempts = C4::Context->preference('FailedLoginAttempts');
1099 return ( $FailedLoginAttempts
1100 and $self->login_attempts
1101 and $self->login_attempts >= $FailedLoginAttempts )? 1 : 0;
1104 =head3 can_see_patron_infos
1106 my $can_see = $patron->can_see_patron_infos( $patron );
1108 Return true if the patron (usually the logged in user) can see the patron's infos for a given patron
1112 sub can_see_patron_infos {
1113 my ( $self, $patron ) = @_;
1114 return unless $patron;
1115 return $self->can_see_patrons_from( $patron->library->branchcode );
1118 =head3 can_see_patrons_from
1120 my $can_see = $patron->can_see_patrons_from( $branchcode );
1122 Return true if the patron (usually the logged in user) can see the patron's infos from a given library
1126 sub can_see_patrons_from {
1127 my ( $self, $branchcode ) = @_;
1129 if ( $self->branchcode eq $branchcode ) {
1131 } elsif ( $self->has_permission( { borrowers => 'view_borrower_infos_from_any_libraries' } ) ) {
1133 } elsif ( my $library_groups = $self->library->library_groups ) {
1134 while ( my $library_group = $library_groups->next ) {
1135 if ( $library_group->parent->has_child( $branchcode ) ) {
1144 =head3 libraries_where_can_see_patrons
1146 my $libraries = $patron-libraries_where_can_see_patrons;
1148 Return the list of branchcodes(!) of libraries the patron is allowed to see other patron's infos.
1149 The branchcodes are arbitrarily returned sorted.
1150 We are supposing here that the object is related to the logged in patron (use of C4::Context::only_my_library)
1152 An empty array means no restriction, the patron can see patron's infos from any libraries.
1156 sub libraries_where_can_see_patrons {
1158 my $userenv = C4::Context->userenv;
1160 return () unless $userenv; # For tests, but userenv should be defined in tests...
1162 my @restricted_branchcodes;
1163 if (C4::Context::only_my_library) {
1164 push @restricted_branchcodes, $self->branchcode;
1168 $self->has_permission(
1169 { borrowers => 'view_borrower_infos_from_any_libraries' }
1173 my $library_groups = $self->library->library_groups({ ft_hide_patron_info => 1 });
1174 if ( $library_groups->count )
1176 while ( my $library_group = $library_groups->next ) {
1177 my $parent = $library_group->parent;
1178 if ( $parent->has_child( $self->branchcode ) ) {
1179 push @restricted_branchcodes, $parent->children->get_column('branchcode');
1184 @restricted_branchcodes = ( $self->branchcode ) unless @restricted_branchcodes;
1188 @restricted_branchcodes = grep { defined $_ } @restricted_branchcodes;
1189 @restricted_branchcodes = uniq(@restricted_branchcodes);
1190 @restricted_branchcodes = sort(@restricted_branchcodes);
1191 return @restricted_branchcodes;
1194 sub has_permission {
1195 my ( $self, $flagsrequired ) = @_;
1196 return unless $self->userid;
1197 # TODO code from haspermission needs to be moved here!
1198 return C4::Auth::haspermission( $self->userid, $flagsrequired );
1203 my $is_adult = $patron->is_adult
1205 Return true if the patron has a category with a type Adult (A) or Organization (I)
1211 return $self->category->category_type =~ /^(A|I)$/ ? 1 : 0;
1216 my $is_child = $patron->is_child
1218 Return true if the patron has a category with a type Child (C)
1224 return $self->category->category_type eq 'C' ? 1 : 0;
1227 =head3 has_valid_userid
1229 my $patron = Koha::Patrons->find(42);
1230 $patron->userid( $new_userid );
1231 my $has_a_valid_userid = $patron->has_valid_userid
1233 my $patron = Koha::Patron->new( $params );
1234 my $has_a_valid_userid = $patron->has_valid_userid
1236 Return true if the current userid of this patron is valid/unique, otherwise false.
1238 Note that this should be done in $self->store instead and raise an exception if needed.
1242 sub has_valid_userid {
1245 return 0 unless $self->userid;
1247 return 0 if ( $self->userid eq C4::Context->config('user') ); # DB user
1249 my $already_exists = Koha::Patrons->search(
1251 userid => $self->userid,
1254 ? ( borrowernumber => { '!=' => $self->borrowernumber } )
1259 return $already_exists ? 0 : 1;
1262 =head3 generate_userid
1264 my $patron = Koha::Patron->new( $params );
1265 $patron->generate_userid
1267 Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
1269 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).
1273 sub generate_userid {
1276 my $firstname = $self->firstname // q{};
1277 my $surname = $self->surname // q{};
1278 #The script will "do" the following code and increment the $offset until the generated userid is unique
1280 $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1281 $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1282 my $userid = lc(($firstname)? "$firstname.$surname" : $surname);
1283 $userid = unac_string('utf-8',$userid);
1284 $userid .= $offset unless $offset == 0;
1285 $self->userid( $userid );
1287 } while (! $self->has_valid_userid );
1293 =head2 Internal methods
1305 Kyle M Hall <kyle@bywatersolutions.com>
1306 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
1307 Martin Renvoize <martin.renvoize@ptfs-europe.com>