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
94 my ( $class, $params ) = @_;
96 return $class->SUPER::new($params);
99 =head3 fixup_cardnumber
101 Autogenerate next cardnumber from highest value found in database
105 sub fixup_cardnumber {
107 my $max = Koha::Patrons->search({
108 cardnumber => {-regexp => '^-?[0-9]+$'}
110 select => \'CAST(cardnumber AS SIGNED)',
111 as => ['cast_cardnumber']
112 })->_resultset->get_column('cast_cardnumber')->max;
113 $self->cardnumber(($max || 0) +1);
116 =head3 trim_whitespace
118 trim whitespace from data which has some non-whitespace in it.
119 Could be moved to Koha::Object if need to be reused
123 sub trim_whitespaces {
126 my $schema = Koha::Database->new->schema;
127 my @columns = $schema->source($self->_type)->columns;
129 for my $column( @columns ) {
130 my $value = $self->$column;
131 if ( defined $value ) {
132 $value =~ s/^\s*|\s*$//g;
133 $self->$column($value);
139 =head3 plain_text_password
141 $patron->plain_text_password( $password );
143 stores a copy of the unencrypted password in the object
144 for use in code before encrypting for db
148 sub plain_text_password {
149 my ( $self, $password ) = @_;
151 $self->{_plain_text_password} = $password;
154 return $self->{_plain_text_password}
155 if $self->{_plain_text_password};
162 Patron specific store method to cleanup record
163 and do other necessary things before saving
171 $self->_result->result_source->schema->txn_do(
174 C4::Context->preference("autoMemberNum")
175 and ( not defined $self->cardnumber
176 or $self->cardnumber eq '' )
179 # Warning: The caller is responsible for locking the members table in write
180 # mode, to avoid database corruption.
181 # We are in a transaction but the table is not locked
182 $self->fixup_cardnumber;
185 unless( $self->category->in_storage ) {
186 Koha::Exceptions::Object::FKConstraint->throw(
187 broken_fk => 'categorycode',
188 value => $self->categorycode,
192 $self->trim_whitespaces;
194 unless ( $self->in_storage ) { #AddMember
196 # Generate a valid userid/login if needed
197 $self->generate_userid
198 if not $self->userid or not $self->has_valid_userid;
200 # Add expiration date if it isn't already there
201 unless ( $self->dateexpiry ) {
202 $self->dateexpiry( $self->category->get_expiry_date );
205 # Add enrollment date if it isn't already there
206 unless ( $self->dateenrolled ) {
207 $self->dateenrolled(dt_from_string);
210 # Set the privacy depending on the patron's category
211 my $default_privacy = $self->category->default_privacy || q{};
213 $default_privacy eq 'default' ? 1
214 : $default_privacy eq 'never' ? 2
215 : $default_privacy eq 'forever' ? 0
217 $self->privacy($default_privacy);
220 # Make a copy of the plain text password for later use
221 $self->plain_text_password( $self->password );
223 # Create a disabled account if no password provided
224 $self->password( $self->password
225 ? Koha::AuthUtils::hash_password( $self->password )
228 $self->borrowernumber(undef);
230 $self = $self->SUPER::store;
232 $self->add_enrolment_fee_if_needed;
234 logaction( "MEMBERS", "CREATE", $self->borrowernumber, "" )
235 if C4::Context->preference("BorrowersLog");
239 my $self_from_storage = $self->get_from_storage;
240 # FIXME We should not deal with that here, callers have to do this job
241 # Moved from ModMember to prevent regressions
242 unless ( $self->userid ) {
243 my $stored_userid = $self_from_storage->userid;
244 $self->userid($stored_userid);
247 # Password must be updated using $self->set_password
248 $self->password($self_from_storage->password);
250 if ( C4::Context->preference('FeeOnChangePatronCategory')
251 and $self->category->categorycode ne
252 $self_from_storage->category->categorycode )
254 $self->add_enrolment_fee_if_needed;
258 if ( C4::Context->preference("BorrowersLog") ) {
260 my $from_storage = $self_from_storage->unblessed;
261 my $from_object = $self->unblessed;
262 my @skip_fields = (qw/lastseen/);
263 for my $key ( keys %{$from_storage} ) {
264 next if any { /$key/ } @skip_fields;
267 !defined( $from_storage->{$key} )
268 && defined( $from_object->{$key} )
270 || ( defined( $from_storage->{$key} )
271 && !defined( $from_object->{$key} ) )
273 defined( $from_storage->{$key} )
274 && defined( $from_object->{$key} )
275 && ( $from_storage->{$key} ne
276 $from_object->{$key} )
281 before => $from_storage->{$key},
282 after => $from_object->{$key}
287 if ( defined($info) ) {
291 $self->borrowernumber,
294 { utf8 => 1, pretty => 1, canonical => 1 }
301 $self = $self->SUPER::store;
312 Delete patron's holds, lists and finally the patron.
314 Lists owned by the borrower are deleted, but entries from the borrower to
315 other lists are kept.
323 $self->_result->result_source->schema->txn_do(
325 # Delete Patron's holds
326 $self->holds->delete;
328 # Delete all lists and all shares of this borrower
329 # Consistent with the approach Koha uses on deleting individual lists
330 # Note that entries in virtualshelfcontents added by this borrower to
331 # lists of others will be handled by a table constraint: the borrower
332 # is set to NULL in those entries.
334 # We could handle the above deletes via a constraint too.
335 # But a new BZ report 11889 has been opened to discuss another approach.
336 # Instead of deleting we could also disown lists (based on a pref).
337 # In that way we could save shared and public lists.
338 # The current table constraints support that idea now.
339 # This pref should then govern the results of other routines/methods such as
340 # Koha::Virtualshelf->new->delete too.
341 # FIXME Could be $patron->get_lists
342 $_->delete for Koha::Virtualshelves->search( { owner => $self->borrowernumber } );
344 $deleted = $self->SUPER::delete;
346 logaction( "MEMBERS", "DELETE", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog");
355 my $patron_category = $patron->category
357 Return the patron category for this patron
363 return Koha::Patron::Category->_new_from_dbic( $self->_result->categorycode );
368 Returns a Koha::Patron object for this patron's guarantor
375 return unless $self->guarantorid();
377 return Koha::Patrons->find( $self->guarantorid() );
383 return scalar Koha::Patron::Images->find( $self->borrowernumber );
388 return Koha::Library->_new_from_dbic($self->_result->branchcode);
393 Returns the guarantees (list of Koha::Patron) of this patron
400 return Koha::Patrons->search( { guarantorid => $self->borrowernumber }, { order_by => { -asc => ['surname','firstname'] } } );
403 =head3 housebound_profile
405 Returns the HouseboundProfile associated with this patron.
409 sub housebound_profile {
411 my $profile = $self->_result->housebound_profile;
412 return Koha::Patron::HouseboundProfile->_new_from_dbic($profile)
417 =head3 housebound_role
419 Returns the HouseboundRole associated with this patron.
423 sub housebound_role {
426 my $role = $self->_result->housebound_role;
427 return Koha::Patron::HouseboundRole->_new_from_dbic($role) if ( $role );
433 Returns the siblings of this patron.
440 my $guarantor = $self->guarantor;
442 return unless $guarantor;
444 return Koha::Patrons->search(
448 '=' => $guarantor->id,
451 '!=' => $self->borrowernumber,
459 my $patron = Koha::Patrons->find($id);
460 $patron->merge_with( \@patron_ids );
462 This subroutine merges a list of patrons into the patron record. This is accomplished by finding
463 all related patron ids for the patrons to be merged in other tables and changing the ids to be that
464 of the keeper patron.
469 my ( $self, $patron_ids ) = @_;
471 my @patron_ids = @{ $patron_ids };
473 # Ensure the keeper isn't in the list of patrons to merge
474 @patron_ids = grep { $_ ne $self->id } @patron_ids;
476 my $schema = Koha::Database->new()->schema();
480 $self->_result->result_source->schema->txn_do( sub {
481 foreach my $patron_id (@patron_ids) {
482 my $patron = Koha::Patrons->find( $patron_id );
486 # Unbless for safety, the patron will end up being deleted
487 $results->{merged}->{$patron_id}->{patron} = $patron->unblessed;
489 while (my ($r, $field) = each(%$RESULTSET_PATRON_ID_MAPPING)) {
490 my $rs = $schema->resultset($r)->search({ $field => $patron_id });
491 $results->{merged}->{ $patron_id }->{updated}->{$r} = $rs->count();
492 $rs->update({ $field => $self->id });
495 $patron->move_to_deleted();
505 =head3 wants_check_for_previous_checkout
507 $wants_check = $patron->wants_check_for_previous_checkout;
509 Return 1 if Koha needs to perform PrevIssue checking, else 0.
513 sub wants_check_for_previous_checkout {
515 my $syspref = C4::Context->preference("checkPrevCheckout");
518 ## Hard syspref trumps all
519 return 1 if ($syspref eq 'hardyes');
520 return 0 if ($syspref eq 'hardno');
521 ## Now, patron pref trumps all
522 return 1 if ($self->checkprevcheckout eq 'yes');
523 return 0 if ($self->checkprevcheckout eq 'no');
525 # More complex: patron inherits -> determine category preference
526 my $checkPrevCheckoutByCat = $self->category->checkprevcheckout;
527 return 1 if ($checkPrevCheckoutByCat eq 'yes');
528 return 0 if ($checkPrevCheckoutByCat eq 'no');
530 # Finally: category preference is inherit, default to 0
531 if ($syspref eq 'softyes') {
538 =head3 do_check_for_previous_checkout
540 $do_check = $patron->do_check_for_previous_checkout($item);
542 Return 1 if the bib associated with $ITEM has previously been checked out to
543 $PATRON, 0 otherwise.
547 sub do_check_for_previous_checkout {
548 my ( $self, $item ) = @_;
550 # Find all items for bib and extract item numbers.
551 my @items = Koha::Items->search({biblionumber => $item->{biblionumber}});
553 foreach my $item (@items) {
554 push @item_nos, $item->itemnumber;
557 # Create (old)issues search criteria
559 borrowernumber => $self->borrowernumber,
560 itemnumber => \@item_nos,
563 # Check current issues table
564 my $issues = Koha::Checkouts->search($criteria);
565 return 1 if $issues->count; # 0 || N
567 # Check old issues table
568 my $old_issues = Koha::Old::Checkouts->search($criteria);
569 return $old_issues->count; # 0 || N
574 my $debarment_expiration = $patron->is_debarred;
576 Returns the date a patron debarment will expire, or undef if the patron is not
584 return unless $self->debarred;
585 return $self->debarred
586 if $self->debarred =~ '^9999'
587 or dt_from_string( $self->debarred ) > dt_from_string;
593 my $is_expired = $patron->is_expired;
595 Returns 1 if the patron is expired or 0;
601 return 0 unless $self->dateexpiry;
602 return 0 if $self->dateexpiry =~ '^9999';
603 return 1 if dt_from_string( $self->dateexpiry ) < dt_from_string->truncate( to => 'day' );
607 =head3 is_going_to_expire
609 my $is_going_to_expire = $patron->is_going_to_expire;
611 Returns 1 if the patron is going to expired, depending on the NotifyBorrowerDeparture pref or 0
615 sub is_going_to_expire {
618 my $delay = C4::Context->preference('NotifyBorrowerDeparture') || 0;
620 return 0 unless $delay;
621 return 0 unless $self->dateexpiry;
622 return 0 if $self->dateexpiry =~ '^9999';
623 return 1 if dt_from_string( $self->dateexpiry )->subtract( days => $delay ) < dt_from_string->truncate( to => 'day' );
629 $patron->set_password({ password => $plain_text_password [, skip_validation => 1 ] });
631 Set the patron's password.
635 The passed string is validated against the current password enforcement policy.
636 Validation can be skipped by passing the I<skip_validation> parameter.
638 Exceptions are thrown if the password is not good enough.
642 =item Koha::Exceptions::Password::TooShort
644 =item Koha::Exceptions::Password::WhitespaceCharacters
646 =item Koha::Exceptions::Password::TooWeak
653 my ( $self, $args ) = @_;
655 my $password = $args->{password};
657 unless ( $args->{skip_validation} ) {
658 my ( $is_valid, $error ) = Koha::AuthUtils::is_password_valid( $password );
661 if ( $error eq 'too_short' ) {
662 my $min_length = C4::Context->preference('minPasswordLength');
663 $min_length = 3 if not $min_length or $min_length < 3;
665 my $password_length = length($password);
666 Koha::Exceptions::Password::TooShort->throw(
667 length => $password_length, min_length => $min_length );
669 elsif ( $error eq 'has_whitespaces' ) {
670 Koha::Exceptions::Password::WhitespaceCharacters->throw();
672 elsif ( $error eq 'too_weak' ) {
673 Koha::Exceptions::Password::TooWeak->throw();
678 my $digest = Koha::AuthUtils::hash_password($password);
680 { password => $digest,
685 logaction( "MEMBERS", "CHANGE PASS", $self->borrowernumber, "" )
686 if C4::Context->preference("BorrowersLog");
694 my $new_expiry_date = $patron->renew_account
696 Extending the subscription to the expiry date.
703 if ( C4::Context->preference('BorrowerRenewalPeriodBase') eq 'combination' ) {
704 $date = ( dt_from_string gt dt_from_string( $self->dateexpiry ) ) ? dt_from_string : dt_from_string( $self->dateexpiry );
707 C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry'
708 ? dt_from_string( $self->dateexpiry )
711 my $expiry_date = $self->category->get_expiry_date($date);
713 $self->dateexpiry($expiry_date);
714 $self->date_renewed( dt_from_string() );
717 $self->add_enrolment_fee_if_needed;
719 logaction( "MEMBERS", "RENEW", $self->borrowernumber, "Membership renewed" ) if C4::Context->preference("BorrowersLog");
720 return dt_from_string( $expiry_date )->truncate( to => 'day' );
725 my $has_overdues = $patron->has_overdues;
727 Returns the number of patron's overdues
733 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
734 return $self->_result->issues->search({ date_due => { '<' => $dtf->format_datetime( dt_from_string() ) } })->count;
739 $patron->track_login;
740 $patron->track_login({ force => 1 });
742 Tracks a (successful) login attempt.
743 The preference TrackLastPatronActivity must be enabled. Or you
744 should pass the force parameter.
749 my ( $self, $params ) = @_;
752 !C4::Context->preference('TrackLastPatronActivity');
753 $self->lastseen( dt_from_string() )->store;
756 =head3 move_to_deleted
758 my $is_moved = $patron->move_to_deleted;
760 Move a patron to the deletedborrowers table.
761 This can be done before deleting a patron, to make sure the data are not completely deleted.
765 sub move_to_deleted {
767 my $patron_infos = $self->unblessed;
768 delete $patron_infos->{updated_on}; #This ensures the updated_on date in deletedborrowers will be set to the current timestamp
769 return Koha::Database->new->schema->resultset('Deletedborrower')->create($patron_infos);
772 =head3 article_requests
774 my @requests = $borrower->article_requests();
775 my $requests = $borrower->article_requests();
777 Returns either a list of ArticleRequests objects,
778 or an ArtitleRequests object, depending on the
783 sub article_requests {
786 $self->{_article_requests} ||= Koha::ArticleRequests->search({ borrowernumber => $self->borrowernumber() });
788 return $self->{_article_requests};
791 =head3 article_requests_current
793 my @requests = $patron->article_requests_current
795 Returns the article requests associated with this patron that are incomplete
799 sub article_requests_current {
802 $self->{_article_requests_current} ||= Koha::ArticleRequests->search(
804 borrowernumber => $self->id(),
806 { status => Koha::ArticleRequest::Status::Pending },
807 { status => Koha::ArticleRequest::Status::Processing }
812 return $self->{_article_requests_current};
815 =head3 article_requests_finished
817 my @requests = $biblio->article_requests_finished
819 Returns the article requests associated with this patron that are completed
823 sub article_requests_finished {
824 my ( $self, $borrower ) = @_;
826 $self->{_article_requests_finished} ||= Koha::ArticleRequests->search(
828 borrowernumber => $self->id(),
830 { status => Koha::ArticleRequest::Status::Completed },
831 { status => Koha::ArticleRequest::Status::Canceled }
836 return $self->{_article_requests_finished};
839 =head3 add_enrolment_fee_if_needed
841 my $enrolment_fee = $patron->add_enrolment_fee_if_needed;
843 Add enrolment fee for a patron if needed.
847 sub add_enrolment_fee_if_needed {
849 my $enrolment_fee = $self->category->enrolmentfee;
850 if ( $enrolment_fee && $enrolment_fee > 0 ) {
851 $self->account->add_debit(
853 amount => $enrolment_fee,
854 user_id => C4::Context->userenv ? C4::Context->userenv->{'number'} : 0,
855 library_id => C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef,
860 return $enrolment_fee || 0;
865 my $checkouts = $patron->checkouts
871 my $checkouts = $self->_result->issues;
872 return Koha::Checkouts->_new_from_dbic( $checkouts );
875 =head3 pending_checkouts
877 my $pending_checkouts = $patron->pending_checkouts
879 This method will return the same as $self->checkouts, but with a prefetch on
880 items, biblio and biblioitems.
882 It has been introduced to replaced the C4::Members::GetPendingIssues subroutine
884 It should not be used directly, prefer to access fields you need instead of
885 retrieving all these fields in one go.
890 sub pending_checkouts {
892 my $checkouts = $self->_result->issues->search(
896 { -desc => 'me.timestamp' },
897 { -desc => 'issuedate' },
898 { -desc => 'issue_id' }, # Sort by issue_id should be enough
900 prefetch => { item => { biblio => 'biblioitems' } },
903 return Koha::Checkouts->_new_from_dbic( $checkouts );
908 my $old_checkouts = $patron->old_checkouts
914 my $old_checkouts = $self->_result->old_issues;
915 return Koha::Old::Checkouts->_new_from_dbic( $old_checkouts );
920 my $overdue_items = $patron->get_overdues
922 Return the overdue items
928 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
929 return $self->checkouts->search(
931 'me.date_due' => { '<' => $dtf->format_datetime(dt_from_string) },
934 prefetch => { item => { biblio => 'biblioitems' } },
939 =head3 get_routing_lists
941 my @routinglists = $patron->get_routing_lists
943 Returns the routing lists a patron is subscribed to.
947 sub get_routing_lists {
949 my $routing_list_rs = $self->_result->subscriptionroutinglists;
950 return Koha::Subscription::Routinglists->_new_from_dbic($routing_list_rs);
955 my $age = $patron->get_age
957 Return the age of the patron
963 my $today_str = dt_from_string->strftime("%Y-%m-%d");
964 return unless $self->dateofbirth;
965 my $dob_str = dt_from_string( $self->dateofbirth )->strftime("%Y-%m-%d");
967 my ( $dob_y, $dob_m, $dob_d ) = split /-/, $dob_str;
968 my ( $today_y, $today_m, $today_d ) = split /-/, $today_str;
970 my $age = $today_y - $dob_y;
971 if ( $dob_m . $dob_d > $today_m . $today_d ) {
980 my $account = $patron->account
986 return Koha::Account->new( { patron_id => $self->borrowernumber } );
991 my $holds = $patron->holds
993 Return all the holds placed by this patron
999 my $holds_rs = $self->_result->reserves->search( {}, { order_by => 'reservedate' } );
1000 return Koha::Holds->_new_from_dbic($holds_rs);
1005 my $old_holds = $patron->old_holds
1007 Return all the historical holds for this patron
1013 my $old_holds_rs = $self->_result->old_reserves->search( {}, { order_by => 'reservedate' } );
1014 return Koha::Old::Holds->_new_from_dbic($old_holds_rs);
1017 =head3 notice_email_address
1019 my $email = $patron->notice_email_address;
1021 Return the email address of patron used for notices.
1022 Returns the empty string if no email address.
1026 sub notice_email_address{
1029 my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
1030 # if syspref is set to 'first valid' (value == OFF), look up email address
1031 if ( $which_address eq 'OFF' ) {
1032 return $self->first_valid_email_address;
1035 return $self->$which_address || '';
1038 =head3 first_valid_email_address
1040 my $first_valid_email_address = $patron->first_valid_email_address
1042 Return the first valid email address for a patron.
1043 For now, the order is defined as email, emailpro, B_email.
1044 Returns the empty string if the borrower has no email addresses.
1048 sub first_valid_email_address {
1051 return $self->email() || $self->emailpro() || $self->B_email() || q{};
1054 =head3 get_club_enrollments
1058 sub get_club_enrollments {
1059 my ( $self, $return_scalar ) = @_;
1061 my $e = Koha::Club::Enrollments->search( { borrowernumber => $self->borrowernumber(), date_canceled => undef } );
1063 return $e if $return_scalar;
1065 return wantarray ? $e->as_list : $e;
1068 =head3 get_enrollable_clubs
1072 sub get_enrollable_clubs {
1073 my ( $self, $is_enrollable_from_opac, $return_scalar ) = @_;
1076 $params->{is_enrollable_from_opac} = $is_enrollable_from_opac
1077 if $is_enrollable_from_opac;
1078 $params->{is_email_required} = 0 unless $self->first_valid_email_address();
1080 $params->{borrower} = $self;
1082 my $e = Koha::Clubs->get_enrollable($params);
1084 return $e if $return_scalar;
1086 return wantarray ? $e->as_list : $e;
1089 =head3 account_locked
1091 my $is_locked = $patron->account_locked
1093 Return true if the patron has reach the maximum number of login attempts (see pref FailedLoginAttempts).
1094 Otherwise return false.
1095 If the pref is not set (empty string, null or 0), the feature is considered as disabled.
1099 sub account_locked {
1101 my $FailedLoginAttempts = C4::Context->preference('FailedLoginAttempts');
1102 return ( $FailedLoginAttempts
1103 and $self->login_attempts
1104 and $self->login_attempts >= $FailedLoginAttempts )? 1 : 0;
1107 =head3 can_see_patron_infos
1109 my $can_see = $patron->can_see_patron_infos( $patron );
1111 Return true if the patron (usually the logged in user) can see the patron's infos for a given patron
1115 sub can_see_patron_infos {
1116 my ( $self, $patron ) = @_;
1117 return unless $patron;
1118 return $self->can_see_patrons_from( $patron->library->branchcode );
1121 =head3 can_see_patrons_from
1123 my $can_see = $patron->can_see_patrons_from( $branchcode );
1125 Return true if the patron (usually the logged in user) can see the patron's infos from a given library
1129 sub can_see_patrons_from {
1130 my ( $self, $branchcode ) = @_;
1132 if ( $self->branchcode eq $branchcode ) {
1134 } elsif ( $self->has_permission( { borrowers => 'view_borrower_infos_from_any_libraries' } ) ) {
1136 } elsif ( my $library_groups = $self->library->library_groups ) {
1137 while ( my $library_group = $library_groups->next ) {
1138 if ( $library_group->parent->has_child( $branchcode ) ) {
1147 =head3 libraries_where_can_see_patrons
1149 my $libraries = $patron-libraries_where_can_see_patrons;
1151 Return the list of branchcodes(!) of libraries the patron is allowed to see other patron's infos.
1152 The branchcodes are arbitrarily returned sorted.
1153 We are supposing here that the object is related to the logged in patron (use of C4::Context::only_my_library)
1155 An empty array means no restriction, the patron can see patron's infos from any libraries.
1159 sub libraries_where_can_see_patrons {
1161 my $userenv = C4::Context->userenv;
1163 return () unless $userenv; # For tests, but userenv should be defined in tests...
1165 my @restricted_branchcodes;
1166 if (C4::Context::only_my_library) {
1167 push @restricted_branchcodes, $self->branchcode;
1171 $self->has_permission(
1172 { borrowers => 'view_borrower_infos_from_any_libraries' }
1176 my $library_groups = $self->library->library_groups({ ft_hide_patron_info => 1 });
1177 if ( $library_groups->count )
1179 while ( my $library_group = $library_groups->next ) {
1180 my $parent = $library_group->parent;
1181 if ( $parent->has_child( $self->branchcode ) ) {
1182 push @restricted_branchcodes, $parent->children->get_column('branchcode');
1187 @restricted_branchcodes = ( $self->branchcode ) unless @restricted_branchcodes;
1191 @restricted_branchcodes = grep { defined $_ } @restricted_branchcodes;
1192 @restricted_branchcodes = uniq(@restricted_branchcodes);
1193 @restricted_branchcodes = sort(@restricted_branchcodes);
1194 return @restricted_branchcodes;
1197 sub has_permission {
1198 my ( $self, $flagsrequired ) = @_;
1199 return unless $self->userid;
1200 # TODO code from haspermission needs to be moved here!
1201 return C4::Auth::haspermission( $self->userid, $flagsrequired );
1206 my $is_adult = $patron->is_adult
1208 Return true if the patron has a category with a type Adult (A) or Organization (I)
1214 return $self->category->category_type =~ /^(A|I)$/ ? 1 : 0;
1219 my $is_child = $patron->is_child
1221 Return true if the patron has a category with a type Child (C)
1226 return $self->category->category_type eq 'C' ? 1 : 0;
1229 =head3 has_valid_userid
1231 my $patron = Koha::Patrons->find(42);
1232 $patron->userid( $new_userid );
1233 my $has_a_valid_userid = $patron->has_valid_userid
1235 my $patron = Koha::Patron->new( $params );
1236 my $has_a_valid_userid = $patron->has_valid_userid
1238 Return true if the current userid of this patron is valid/unique, otherwise false.
1240 Note that this should be done in $self->store instead and raise an exception if needed.
1244 sub has_valid_userid {
1247 return 0 unless $self->userid;
1249 return 0 if ( $self->userid eq C4::Context->config('user') ); # DB user
1251 my $already_exists = Koha::Patrons->search(
1253 userid => $self->userid,
1256 ? ( borrowernumber => { '!=' => $self->borrowernumber } )
1261 return $already_exists ? 0 : 1;
1264 =head3 generate_userid
1266 my $patron = Koha::Patron->new( $params );
1267 $patron->generate_userid
1269 Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
1271 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).
1275 sub generate_userid {
1278 my $firstname = $self->firstname // q{};
1279 my $surname = $self->surname // q{};
1280 #The script will "do" the following code and increment the $offset until the generated userid is unique
1282 $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1283 $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1284 my $userid = lc(($firstname)? "$firstname.$surname" : $surname);
1285 $userid = unac_string('utf-8',$userid);
1286 $userid .= $offset unless $offset == 0;
1287 $self->userid( $userid );
1289 } while (! $self->has_valid_userid );
1295 =head2 Internal methods
1307 Kyle M Hall <kyle@bywatersolutions.com>
1308 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
1309 Martin Renvoize <martin.renvoize@ptfs-europe.com>