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 Module::Load::Conditional qw( can_load );
26 use Text::Unaccent qw( unac_string );
34 use Koha::Old::Checkouts;
35 use Koha::Patron::Categories;
36 use Koha::Patron::HouseboundProfile;
37 use Koha::Patron::HouseboundRole;
38 use Koha::Patron::Images;
40 use Koha::Virtualshelves;
41 use Koha::Club::Enrollments;
43 use Koha::Subscription::Routinglists;
45 if ( ! can_load( modules => { 'Koha::NorwegianPatronDB' => undef } ) ) {
46 warn "Unable to load Koha::NorwegianPatronDB";
49 use base qw(Koha::Object);
51 our $RESULTSET_PATRON_ID_MAPPING = {
52 Accountline => 'borrowernumber',
53 Aqbasketuser => 'borrowernumber',
54 Aqbudget => 'budget_owner_id',
55 Aqbudgetborrower => 'borrowernumber',
56 ArticleRequest => 'borrowernumber',
57 BorrowerAttribute => 'borrowernumber',
58 BorrowerDebarment => 'borrowernumber',
59 BorrowerFile => 'borrowernumber',
60 BorrowerModification => 'borrowernumber',
61 ClubEnrollment => 'borrowernumber',
62 Issue => 'borrowernumber',
63 ItemsLastBorrower => 'borrowernumber',
64 Linktracker => 'borrowernumber',
65 Message => 'borrowernumber',
66 MessageQueue => 'borrowernumber',
67 OldIssue => 'borrowernumber',
68 OldReserve => 'borrowernumber',
69 Rating => 'borrowernumber',
70 Reserve => 'borrowernumber',
71 Review => 'borrowernumber',
72 SearchHistory => 'userid',
73 Statistic => 'borrowernumber',
74 Suggestion => 'suggestedby',
75 TagAll => 'borrowernumber',
76 Virtualshelfcontent => 'borrowernumber',
77 Virtualshelfshare => 'borrowernumber',
78 Virtualshelve => 'owner',
83 Koha::Patron - Koha Patron Object class
96 my ( $class, $params ) = @_;
98 return $class->SUPER::new($params);
101 sub fixup_cardnumber {
103 my $max = Koha::Patrons->search({
104 cardnumber => {-regexp => '^-?[0-9]+$'}
106 select => \'CAST(cardnumber AS SIGNED)',
107 as => ['cast_cardnumber']
108 })->_resultset->get_column('cast_cardnumber')->max;
109 $self->cardnumber(($max || 0) +1);
112 # trim whitespace from data which has some non-whitespace in it.
113 # Could be moved to Koha::Object if need to be reused
114 sub trim_whitespaces {
117 my $schema = Koha::Database->new->schema;
118 my @columns = $schema->source($self->_type)->columns;
120 for my $column( @columns ) {
121 my $value = $self->$column;
122 if ( defined $value ) {
123 $value =~ s/^\s*|\s*$//g;
124 $self->$column($value);
130 sub plain_text_password {
131 my ( $self, $password ) = @_;
133 $self->{_plain_text_password} = $password;
136 return $self->{_plain_text_password}
137 if $self->{_plain_text_password};
145 $self->_result->result_source->schema->txn_do(
148 C4::Context->preference("autoMemberNum")
149 and ( not defined $self->cardnumber
150 or $self->cardnumber eq '' )
153 # Warning: The caller is responsible for locking the members table in write
154 # mode, to avoid database corruption.
155 # We are in a transaction but the table is not locked
156 $self->fixup_cardnumber;
158 unless ( $self->in_storage ) { #AddMember
160 unless( $self->category->in_storage ) {
161 Koha::Exceptions::Object::FKConstraint->throw(
162 broken_fk => 'categorycode',
163 value => $self->categorycode,
167 $self->trim_whitespaces;
169 # Generate a valid userid/login if needed
170 $self->userid($self->generate_userid)
171 if not $self->userid or not $self->has_valid_userid;
173 # Add expiration date if it isn't already there
174 unless ( $self->dateexpiry ) {
175 $self->dateexpiry( $self->category->get_expiry_date );
178 # Add enrollment date if it isn't already there
179 unless ( $self->dateenrolled ) {
180 $self->dateenrolled(dt_from_string);
183 # Set the privacy depending on the patron's category
184 my $default_privacy = $self->category->default_privacy || q{};
186 $default_privacy eq 'default' ? 1
187 : $default_privacy eq 'never' ? 2
188 : $default_privacy eq 'forever' ? 0
190 $self->privacy($default_privacy);
192 unless ( defined $self->privacy_guarantor_checkouts ) {
193 $self->privacy_guarantor_checkouts(0);
196 # Make a copy of the plain text password for later use
197 $self->plain_text_password( $self->password );
199 # Create a disabled account if no password provided
200 $self->password( $self->password
201 ? Koha::AuthUtils::hash_password( $self->password )
204 # We don't want invalid dates in the db (mysql has a bad habit of inserting 0000-00-00)
205 $self->dateofbirth(undef) unless $self->dateofbirth;
206 $self->debarred(undef) unless $self->debarred;
208 # Set default values if not set
209 $self->sms_provider_id(undef) unless $self->sms_provider_id;
210 $self->guarantorid(undef) unless $self->guarantorid;
212 $self->borrowernumber(undef);
214 $self = $self->SUPER::store;
216 # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
217 # cronjob will use for syncing with NL
218 if ( C4::Context->preference('NorwegianPatronDBEnable')
219 && C4::Context->preference('NorwegianPatronDBEnable') == 1 )
221 Koha::Database->new->schema->resultset('BorrowerSync')
224 'borrowernumber' => $self->borrowernumber,
225 'synctype' => 'norwegianpatrondb',
227 'syncstatus' => 'new',
229 Koha::NorwegianPatronDB::NLEncryptPIN($self->plain_text_password),
234 $self->add_enrolment_fee_if_needed;
236 logaction( "MEMBERS", "CREATE", $self->borrowernumber, "" )
237 if C4::Context->preference("BorrowersLog");
240 $self = $self->SUPER::store;
252 Delete patron's holds, lists and finally the patron.
254 Lists owned by the borrower are deleted, but entries from the borrower to
255 other lists are kept.
263 $self->_result->result_source->schema->txn_do(
265 # Delete Patron's holds
266 $self->holds->delete;
268 # Delete all lists and all shares of this borrower
269 # Consistent with the approach Koha uses on deleting individual lists
270 # Note that entries in virtualshelfcontents added by this borrower to
271 # lists of others will be handled by a table constraint: the borrower
272 # is set to NULL in those entries.
274 # We could handle the above deletes via a constraint too.
275 # But a new BZ report 11889 has been opened to discuss another approach.
276 # Instead of deleting we could also disown lists (based on a pref).
277 # In that way we could save shared and public lists.
278 # The current table constraints support that idea now.
279 # This pref should then govern the results of other routines/methods such as
280 # Koha::Virtualshelf->new->delete too.
281 # FIXME Could be $patron->get_lists
282 $_->delete for Koha::Virtualshelves->search( { owner => $self->borrowernumber } );
284 $deleted = $self->SUPER::delete;
286 logaction( "MEMBERS", "DELETE", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog");
295 my $patron_category = $patron->category
297 Return the patron category for this patron
303 return Koha::Patron::Category->_new_from_dbic( $self->_result->categorycode );
308 Returns a Koha::Patron object for this patron's guarantor
315 return unless $self->guarantorid();
317 return Koha::Patrons->find( $self->guarantorid() );
323 return scalar Koha::Patron::Images->find( $self->borrowernumber );
328 return Koha::Library->_new_from_dbic($self->_result->branchcode);
333 Returns the guarantees (list of Koha::Patron) of this patron
340 return Koha::Patrons->search( { guarantorid => $self->borrowernumber } );
343 =head3 housebound_profile
345 Returns the HouseboundProfile associated with this patron.
349 sub housebound_profile {
351 my $profile = $self->_result->housebound_profile;
352 return Koha::Patron::HouseboundProfile->_new_from_dbic($profile)
357 =head3 housebound_role
359 Returns the HouseboundRole associated with this patron.
363 sub housebound_role {
366 my $role = $self->_result->housebound_role;
367 return Koha::Patron::HouseboundRole->_new_from_dbic($role) if ( $role );
373 Returns the siblings of this patron.
380 my $guarantor = $self->guarantor;
382 return unless $guarantor;
384 return Koha::Patrons->search(
388 '=' => $guarantor->id,
391 '!=' => $self->borrowernumber,
399 my $patron = Koha::Patrons->find($id);
400 $patron->merge_with( \@patron_ids );
402 This subroutine merges a list of patrons into the patron record. This is accomplished by finding
403 all related patron ids for the patrons to be merged in other tables and changing the ids to be that
404 of the keeper patron.
409 my ( $self, $patron_ids ) = @_;
411 my @patron_ids = @{ $patron_ids };
413 # Ensure the keeper isn't in the list of patrons to merge
414 @patron_ids = grep { $_ ne $self->id } @patron_ids;
416 my $schema = Koha::Database->new()->schema();
420 $self->_result->result_source->schema->txn_do( sub {
421 foreach my $patron_id (@patron_ids) {
422 my $patron = Koha::Patrons->find( $patron_id );
426 # Unbless for safety, the patron will end up being deleted
427 $results->{merged}->{$patron_id}->{patron} = $patron->unblessed;
429 while (my ($r, $field) = each(%$RESULTSET_PATRON_ID_MAPPING)) {
430 my $rs = $schema->resultset($r)->search({ $field => $patron_id });
431 $results->{merged}->{ $patron_id }->{updated}->{$r} = $rs->count();
432 $rs->update({ $field => $self->id });
435 $patron->move_to_deleted();
445 =head3 wants_check_for_previous_checkout
447 $wants_check = $patron->wants_check_for_previous_checkout;
449 Return 1 if Koha needs to perform PrevIssue checking, else 0.
453 sub wants_check_for_previous_checkout {
455 my $syspref = C4::Context->preference("checkPrevCheckout");
458 ## Hard syspref trumps all
459 return 1 if ($syspref eq 'hardyes');
460 return 0 if ($syspref eq 'hardno');
461 ## Now, patron pref trumps all
462 return 1 if ($self->checkprevcheckout eq 'yes');
463 return 0 if ($self->checkprevcheckout eq 'no');
465 # More complex: patron inherits -> determine category preference
466 my $checkPrevCheckoutByCat = $self->category->checkprevcheckout;
467 return 1 if ($checkPrevCheckoutByCat eq 'yes');
468 return 0 if ($checkPrevCheckoutByCat eq 'no');
470 # Finally: category preference is inherit, default to 0
471 if ($syspref eq 'softyes') {
478 =head3 do_check_for_previous_checkout
480 $do_check = $patron->do_check_for_previous_checkout($item);
482 Return 1 if the bib associated with $ITEM has previously been checked out to
483 $PATRON, 0 otherwise.
487 sub do_check_for_previous_checkout {
488 my ( $self, $item ) = @_;
490 # Find all items for bib and extract item numbers.
491 my @items = Koha::Items->search({biblionumber => $item->{biblionumber}});
493 foreach my $item (@items) {
494 push @item_nos, $item->itemnumber;
497 # Create (old)issues search criteria
499 borrowernumber => $self->borrowernumber,
500 itemnumber => \@item_nos,
503 # Check current issues table
504 my $issues = Koha::Checkouts->search($criteria);
505 return 1 if $issues->count; # 0 || N
507 # Check old issues table
508 my $old_issues = Koha::Old::Checkouts->search($criteria);
509 return $old_issues->count; # 0 || N
514 my $debarment_expiration = $patron->is_debarred;
516 Returns the date a patron debarment will expire, or undef if the patron is not
524 return unless $self->debarred;
525 return $self->debarred
526 if $self->debarred =~ '^9999'
527 or dt_from_string( $self->debarred ) > dt_from_string;
533 my $is_expired = $patron->is_expired;
535 Returns 1 if the patron is expired or 0;
541 return 0 unless $self->dateexpiry;
542 return 0 if $self->dateexpiry =~ '^9999';
543 return 1 if dt_from_string( $self->dateexpiry ) < dt_from_string->truncate( to => 'day' );
547 =head3 is_going_to_expire
549 my $is_going_to_expire = $patron->is_going_to_expire;
551 Returns 1 if the patron is going to expired, depending on the NotifyBorrowerDeparture pref or 0
555 sub is_going_to_expire {
558 my $delay = C4::Context->preference('NotifyBorrowerDeparture') || 0;
560 return 0 unless $delay;
561 return 0 unless $self->dateexpiry;
562 return 0 if $self->dateexpiry =~ '^9999';
563 return 1 if dt_from_string( $self->dateexpiry )->subtract( days => $delay ) < dt_from_string->truncate( to => 'day' );
567 =head3 update_password
569 my $updated = $patron->update_password( $userid, $password );
571 Update the userid and the password of a patron.
572 If the userid already exists, returns and let DBIx::Class warns
573 This will add an entry to action_logs if BorrowersLog is set.
577 sub update_password {
578 my ( $self, $userid, $password ) = @_;
579 eval { $self->userid($userid)->store; };
580 return if $@; # Make sure the userid is not already in used by another patron
583 password => $password,
587 logaction( "MEMBERS", "CHANGE PASS", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog");
593 my $new_expiry_date = $patron->renew_account
595 Extending the subscription to the expiry date.
602 if ( C4::Context->preference('BorrowerRenewalPeriodBase') eq 'combination' ) {
603 $date = ( dt_from_string gt dt_from_string( $self->dateexpiry ) ) ? dt_from_string : dt_from_string( $self->dateexpiry );
606 C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry'
607 ? dt_from_string( $self->dateexpiry )
610 my $expiry_date = $self->category->get_expiry_date($date);
612 $self->dateexpiry($expiry_date);
613 $self->date_renewed( dt_from_string() );
616 $self->add_enrolment_fee_if_needed;
618 logaction( "MEMBERS", "RENEW", $self->borrowernumber, "Membership renewed" ) if C4::Context->preference("BorrowersLog");
619 return dt_from_string( $expiry_date )->truncate( to => 'day' );
624 my $has_overdues = $patron->has_overdues;
626 Returns the number of patron's overdues
632 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
633 return $self->_result->issues->search({ date_due => { '<' => $dtf->format_datetime( dt_from_string() ) } })->count;
638 $patron->track_login;
639 $patron->track_login({ force => 1 });
641 Tracks a (successful) login attempt.
642 The preference TrackLastPatronActivity must be enabled. Or you
643 should pass the force parameter.
648 my ( $self, $params ) = @_;
651 !C4::Context->preference('TrackLastPatronActivity');
652 $self->lastseen( dt_from_string() )->store;
655 =head3 move_to_deleted
657 my $is_moved = $patron->move_to_deleted;
659 Move a patron to the deletedborrowers table.
660 This can be done before deleting a patron, to make sure the data are not completely deleted.
664 sub move_to_deleted {
666 my $patron_infos = $self->unblessed;
667 delete $patron_infos->{updated_on}; #This ensures the updated_on date in deletedborrowers will be set to the current timestamp
668 return Koha::Database->new->schema->resultset('Deletedborrower')->create($patron_infos);
671 =head3 article_requests
673 my @requests = $borrower->article_requests();
674 my $requests = $borrower->article_requests();
676 Returns either a list of ArticleRequests objects,
677 or an ArtitleRequests object, depending on the
682 sub article_requests {
685 $self->{_article_requests} ||= Koha::ArticleRequests->search({ borrowernumber => $self->borrowernumber() });
687 return $self->{_article_requests};
690 =head3 article_requests_current
692 my @requests = $patron->article_requests_current
694 Returns the article requests associated with this patron that are incomplete
698 sub article_requests_current {
701 $self->{_article_requests_current} ||= Koha::ArticleRequests->search(
703 borrowernumber => $self->id(),
705 { status => Koha::ArticleRequest::Status::Pending },
706 { status => Koha::ArticleRequest::Status::Processing }
711 return $self->{_article_requests_current};
714 =head3 article_requests_finished
716 my @requests = $biblio->article_requests_finished
718 Returns the article requests associated with this patron that are completed
722 sub article_requests_finished {
723 my ( $self, $borrower ) = @_;
725 $self->{_article_requests_finished} ||= Koha::ArticleRequests->search(
727 borrowernumber => $self->id(),
729 { status => Koha::ArticleRequest::Status::Completed },
730 { status => Koha::ArticleRequest::Status::Canceled }
735 return $self->{_article_requests_finished};
738 =head3 add_enrolment_fee_if_needed
740 my $enrolment_fee = $patron->add_enrolment_fee_if_needed;
742 Add enrolment fee for a patron if needed.
746 sub add_enrolment_fee_if_needed {
748 my $enrolment_fee = $self->category->enrolmentfee;
749 if ( $enrolment_fee && $enrolment_fee > 0 ) {
750 # insert fee in patron debts
751 C4::Accounts::manualinvoice( $self->borrowernumber, '', '', 'A', $enrolment_fee );
753 return $enrolment_fee || 0;
758 my $checkouts = $patron->checkouts
764 my $checkouts = $self->_result->issues;
765 return Koha::Checkouts->_new_from_dbic( $checkouts );
768 =head3 pending_checkouts
770 my $pending_checkouts = $patron->pending_checkouts
772 This method will return the same as $self->checkouts, but with a prefetch on
773 items, biblio and biblioitems.
775 It has been introduced to replaced the C4::Members::GetPendingIssues subroutine
777 It should not be used directly, prefer to access fields you need instead of
778 retrieving all these fields in one go.
783 sub pending_checkouts {
785 my $checkouts = $self->_result->issues->search(
789 { -desc => 'me.timestamp' },
790 { -desc => 'issuedate' },
791 { -desc => 'issue_id' }, # Sort by issue_id should be enough
793 prefetch => { item => { biblio => 'biblioitems' } },
796 return Koha::Checkouts->_new_from_dbic( $checkouts );
801 my $old_checkouts = $patron->old_checkouts
807 my $old_checkouts = $self->_result->old_issues;
808 return Koha::Old::Checkouts->_new_from_dbic( $old_checkouts );
813 my $overdue_items = $patron->get_overdues
815 Return the overdue items
821 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
822 return $self->checkouts->search(
824 'me.date_due' => { '<' => $dtf->format_datetime(dt_from_string) },
827 prefetch => { item => { biblio => 'biblioitems' } },
832 =head3 get_routing_lists
834 my @routinglists = $patron->get_routing_lists
836 Returns the routing lists a patron is subscribed to.
840 sub get_routing_lists {
842 my $routing_list_rs = $self->_result->subscriptionroutinglists;
843 return Koha::Subscription::Routinglists->_new_from_dbic($routing_list_rs);
848 my $age = $patron->get_age
850 Return the age of the patron
856 my $today_str = dt_from_string->strftime("%Y-%m-%d");
857 return unless $self->dateofbirth;
858 my $dob_str = dt_from_string( $self->dateofbirth )->strftime("%Y-%m-%d");
860 my ( $dob_y, $dob_m, $dob_d ) = split /-/, $dob_str;
861 my ( $today_y, $today_m, $today_d ) = split /-/, $today_str;
863 my $age = $today_y - $dob_y;
864 if ( $dob_m . $dob_d > $today_m . $today_d ) {
873 my $account = $patron->account
879 return Koha::Account->new( { patron_id => $self->borrowernumber } );
884 my $holds = $patron->holds
886 Return all the holds placed by this patron
892 my $holds_rs = $self->_result->reserves->search( {}, { order_by => 'reservedate' } );
893 return Koha::Holds->_new_from_dbic($holds_rs);
898 my $old_holds = $patron->old_holds
900 Return all the historical holds for this patron
906 my $old_holds_rs = $self->_result->old_reserves->search( {}, { order_by => 'reservedate' } );
907 return Koha::Old::Holds->_new_from_dbic($old_holds_rs);
910 =head3 notice_email_address
912 my $email = $patron->notice_email_address;
914 Return the email address of patron used for notices.
915 Returns the empty string if no email address.
919 sub notice_email_address{
922 my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
923 # if syspref is set to 'first valid' (value == OFF), look up email address
924 if ( $which_address eq 'OFF' ) {
925 return $self->first_valid_email_address;
928 return $self->$which_address || '';
931 =head3 first_valid_email_address
933 my $first_valid_email_address = $patron->first_valid_email_address
935 Return the first valid email address for a patron.
936 For now, the order is defined as email, emailpro, B_email.
937 Returns the empty string if the borrower has no email addresses.
941 sub first_valid_email_address {
944 return $self->email() || $self->emailpro() || $self->B_email() || q{};
947 =head3 get_club_enrollments
951 sub get_club_enrollments {
952 my ( $self, $return_scalar ) = @_;
954 my $e = Koha::Club::Enrollments->search( { borrowernumber => $self->borrowernumber(), date_canceled => undef } );
956 return $e if $return_scalar;
958 return wantarray ? $e->as_list : $e;
961 =head3 get_enrollable_clubs
965 sub get_enrollable_clubs {
966 my ( $self, $is_enrollable_from_opac, $return_scalar ) = @_;
969 $params->{is_enrollable_from_opac} = $is_enrollable_from_opac
970 if $is_enrollable_from_opac;
971 $params->{is_email_required} = 0 unless $self->first_valid_email_address();
973 $params->{borrower} = $self;
975 my $e = Koha::Clubs->get_enrollable($params);
977 return $e if $return_scalar;
979 return wantarray ? $e->as_list : $e;
982 =head3 account_locked
984 my $is_locked = $patron->account_locked
986 Return true if the patron has reach the maximum number of login attempts (see pref FailedLoginAttempts).
987 Otherwise return false.
988 If the pref is not set (empty string, null or 0), the feature is considered as disabled.
994 my $FailedLoginAttempts = C4::Context->preference('FailedLoginAttempts');
995 return ( $FailedLoginAttempts
996 and $self->login_attempts
997 and $self->login_attempts >= $FailedLoginAttempts )? 1 : 0;
1000 =head3 can_see_patron_infos
1002 my $can_see = $patron->can_see_patron_infos( $patron );
1004 Return true if the patron (usually the logged in user) can see the patron's infos for a given patron
1008 sub can_see_patron_infos {
1009 my ( $self, $patron ) = @_;
1010 return $self->can_see_patrons_from( $patron->library->branchcode );
1013 =head3 can_see_patrons_from
1015 my $can_see = $patron->can_see_patrons_from( $branchcode );
1017 Return true if the patron (usually the logged in user) can see the patron's infos from a given library
1021 sub can_see_patrons_from {
1022 my ( $self, $branchcode ) = @_;
1024 if ( $self->branchcode eq $branchcode ) {
1026 } elsif ( $self->has_permission( { borrowers => 'view_borrower_infos_from_any_libraries' } ) ) {
1028 } elsif ( my $library_groups = $self->library->library_groups ) {
1029 while ( my $library_group = $library_groups->next ) {
1030 if ( $library_group->parent->has_child( $branchcode ) ) {
1039 =head3 libraries_where_can_see_patrons
1041 my $libraries = $patron-libraries_where_can_see_patrons;
1043 Return the list of branchcodes(!) of libraries the patron is allowed to see other patron's infos.
1044 The branchcodes are arbitrarily returned sorted.
1045 We are supposing here that the object is related to the logged in patron (use of C4::Context::only_my_library)
1047 An empty array means no restriction, the patron can see patron's infos from any libraries.
1051 sub libraries_where_can_see_patrons {
1053 my $userenv = C4::Context->userenv;
1055 return () unless $userenv; # For tests, but userenv should be defined in tests...
1057 my @restricted_branchcodes;
1058 if (C4::Context::only_my_library) {
1059 push @restricted_branchcodes, $self->branchcode;
1063 $self->has_permission(
1064 { borrowers => 'view_borrower_infos_from_any_libraries' }
1068 my $library_groups = $self->library->library_groups({ ft_hide_patron_info => 1 });
1069 if ( $library_groups->count )
1071 while ( my $library_group = $library_groups->next ) {
1072 my $parent = $library_group->parent;
1073 if ( $parent->has_child( $self->branchcode ) ) {
1074 push @restricted_branchcodes, $parent->children->get_column('branchcode');
1079 @restricted_branchcodes = ( $self->branchcode ) unless @restricted_branchcodes;
1083 @restricted_branchcodes = grep { defined $_ } @restricted_branchcodes;
1084 @restricted_branchcodes = uniq(@restricted_branchcodes);
1085 @restricted_branchcodes = sort(@restricted_branchcodes);
1086 return @restricted_branchcodes;
1089 sub has_permission {
1090 my ( $self, $flagsrequired ) = @_;
1091 return unless $self->userid;
1092 # TODO code from haspermission needs to be moved here!
1093 return C4::Auth::haspermission( $self->userid, $flagsrequired );
1098 my $is_adult = $patron->is_adult
1100 Return true if the patron has a category with a type Adult (A) or Organization (I)
1106 return $self->category->category_type =~ /^(A|I)$/ ? 1 : 0;
1111 my $is_child = $patron->is_child
1113 Return true if the patron has a category with a type Child (C)
1118 return $self->category->category_type eq 'C' ? 1 : 0;
1121 =head3 has_valid_userid
1123 my $patron = Koha::Patrons->find(42);
1124 $patron->userid( $new_userid );
1125 my $has_a_valid_userid = $patron->has_valid_userid
1127 my $patron = Koha::Patron->new( $params );
1128 my $has_a_valid_userid = $patron->has_valid_userid
1130 Return true if the current userid of this patron is valid/unique, otherwise false.
1132 Note that this should be done in $self->store instead and raise an exception if needed.
1136 sub has_valid_userid {
1139 return 0 unless $self->userid;
1141 return 0 if ( $self->userid eq C4::Context->config('user') ); # DB user
1143 my $already_exists = Koha::Patrons->search(
1145 userid => $self->userid,
1148 ? ( borrowernumber => { '!=' => $self->borrowernumber } )
1153 return $already_exists ? 0 : 1;
1156 =head3 generate_userid
1158 my $patron = Koha::Patron->new( $params );
1159 my $userid = $patron->generate_userid
1161 Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
1163 Return the generate 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).
1165 # Note: Should we set $self->userid with the generated value?
1166 # Certainly yes, but we AddMember and ModMember will be rewritten
1170 sub generate_userid {
1174 my $existing_userid = $self->userid;
1175 my $firstname = $self->firstname // q{};
1176 my $surname = $self->surname // q{};
1177 #The script will "do" the following code and increment the $offset until the generated userid is unique
1179 $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1180 $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1181 $userid = lc(($firstname)? "$firstname.$surname" : $surname);
1182 $userid = unac_string('utf-8',$userid);
1183 $userid .= $offset unless $offset == 0;
1184 $self->userid( $userid );
1186 } while (! $self->has_valid_userid );
1188 # Resetting to the previous value as the callers do not expect
1189 # this method to modify the userid attribute
1190 # This will be done later (move of AddMember and ModMember)
1191 $self->userid( $existing_userid );
1197 =head2 Internal methods
1209 Kyle M Hall <kyle@bywatersolutions.com>
1210 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>