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 Text
::Unaccent
qw( unac_string );
36 use Koha
::Old
::Checkouts
;
37 use Koha
::Patron
::Categories
;
38 use Koha
::Patron
::HouseboundProfile
;
39 use Koha
::Patron
::HouseboundRole
;
40 use Koha
::Patron
::Images
;
42 use Koha
::Virtualshelves
;
43 use Koha
::Club
::Enrollments
;
45 use Koha
::Subscription
::Routinglists
;
47 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 # We don't want invalid dates
in the db
(mysql has a bad habit of inserting
0000-00-00)
195 $self->dateofbirth(undef) unless $self->dateofbirth;
196 $self->debarred(undef) unless $self->debarred;
198 # Set default values if not set
199 $self->sms_provider_id(undef) unless $self->sms_provider_id;
200 $self->guarantorid(undef) unless $self->guarantorid;
202 unless ( $self->in_storage ) { #AddMember
204 # Generate a valid userid/login if needed
205 $self->generate_userid
206 if not $self->userid or not $self->has_valid_userid;
208 # Add expiration date if it isn't already there
209 unless ( $self->dateexpiry ) {
210 $self->dateexpiry( $self->category->get_expiry_date );
213 # Add enrollment date if it isn't already there
214 unless ( $self->dateenrolled ) {
215 $self->dateenrolled(dt_from_string
);
218 # Set the privacy depending on the patron's category
219 my $default_privacy = $self->category->default_privacy || q{};
221 $default_privacy eq 'default' ?
1
222 : $default_privacy eq 'never' ?
2
223 : $default_privacy eq 'forever' ?
0
225 $self->privacy($default_privacy);
227 unless ( defined $self->privacy_guarantor_checkouts ) {
228 $self->privacy_guarantor_checkouts(0);
231 # Make a copy of the plain text password for later use
232 $self->plain_text_password( $self->password );
234 # Create a disabled account if no password provided
235 $self->password( $self->password
236 ? Koha
::AuthUtils
::hash_password
( $self->password )
239 $self->borrowernumber(undef);
241 $self = $self->SUPER::store
;
243 $self->add_enrolment_fee_if_needed;
245 logaction
( "MEMBERS", "CREATE", $self->borrowernumber, "" )
246 if C4
::Context
->preference("BorrowersLog");
250 # Come from ModMember, but should not be possible (?)
251 $self->dateenrolled(undef) unless $self->dateenrolled;
252 $self->dateexpiry(undef) unless $self->dateexpiry;
255 my $self_from_storage = $self->get_from_storage;
256 # FIXME We should not deal with that here, callers have to do this job
257 # Moved from ModMember to prevent regressions
258 unless ( $self->userid ) {
259 my $stored_userid = $self_from_storage->userid;
260 $self->userid($stored_userid);
263 # Password must be updated using $self->update_password
264 $self->password($self_from_storage->password);
266 if ( C4
::Context
->preference('FeeOnChangePatronCategory')
267 and $self->category->categorycode ne
268 $self_from_storage->category->categorycode )
270 $self->add_enrolment_fee_if_needed;
273 my $borrowers_log = C4
::Context
->preference("BorrowersLog");
274 my $previous_cardnumber = $self_from_storage->cardnumber;
276 && ( !defined $previous_cardnumber
277 || $previous_cardnumber ne $self->cardnumber )
283 $self->borrowernumber,
286 cardnumber_replaced
=> {
287 previous_cardnumber
=> $previous_cardnumber,
288 new_cardnumber
=> $self->cardnumber,
291 { utf8
=> 1, pretty
=> 1 }
296 logaction
( "MEMBERS", "MODIFY", $self->borrowernumber,
297 "UPDATE (executed w/ arg: " . $self->borrowernumber . ")" )
300 $self = $self->SUPER::store
;
311 Delete patron's holds, lists and finally the patron.
313 Lists owned by the borrower are deleted, but entries from the borrower to
314 other lists are kept.
322 $self->_result->result_source->schema->txn_do(
324 # Delete Patron's holds
325 $self->holds->delete;
327 # Delete all lists and all shares of this borrower
328 # Consistent with the approach Koha uses on deleting individual lists
329 # Note that entries in virtualshelfcontents added by this borrower to
330 # lists of others will be handled by a table constraint: the borrower
331 # is set to NULL in those entries.
333 # We could handle the above deletes via a constraint too.
334 # But a new BZ report 11889 has been opened to discuss another approach.
335 # Instead of deleting we could also disown lists (based on a pref).
336 # In that way we could save shared and public lists.
337 # The current table constraints support that idea now.
338 # This pref should then govern the results of other routines/methods such as
339 # Koha::Virtualshelf->new->delete too.
340 # FIXME Could be $patron->get_lists
341 $_->delete for Koha
::Virtualshelves
->search( { owner
=> $self->borrowernumber } );
343 $deleted = $self->SUPER::delete;
345 logaction
( "MEMBERS", "DELETE", $self->borrowernumber, "" ) if C4
::Context
->preference("BorrowersLog");
354 my $patron_category = $patron->category
356 Return the patron category for this patron
362 return Koha
::Patron
::Category
->_new_from_dbic( $self->_result->categorycode );
367 Returns a Koha::Patron object for this patron's guarantor
374 return unless $self->guarantorid();
376 return Koha
::Patrons
->find( $self->guarantorid() );
382 return scalar Koha
::Patron
::Images
->find( $self->borrowernumber );
387 return Koha
::Library
->_new_from_dbic($self->_result->branchcode);
392 Returns the guarantees (list of Koha::Patron) of this patron
399 return Koha
::Patrons
->search( { guarantorid
=> $self->borrowernumber }, { order_by
=> { -asc
=> ['surname','firstname'] } } );
402 =head3 housebound_profile
404 Returns the HouseboundProfile associated with this patron.
408 sub housebound_profile
{
410 my $profile = $self->_result->housebound_profile;
411 return Koha
::Patron
::HouseboundProfile
->_new_from_dbic($profile)
416 =head3 housebound_role
418 Returns the HouseboundRole associated with this patron.
422 sub housebound_role
{
425 my $role = $self->_result->housebound_role;
426 return Koha
::Patron
::HouseboundRole
->_new_from_dbic($role) if ( $role );
432 Returns the siblings of this patron.
439 my $guarantor = $self->guarantor;
441 return unless $guarantor;
443 return Koha
::Patrons
->search(
447 '=' => $guarantor->id,
450 '!=' => $self->borrowernumber,
458 my $patron = Koha::Patrons->find($id);
459 $patron->merge_with( \@patron_ids );
461 This subroutine merges a list of patrons into the patron record. This is accomplished by finding
462 all related patron ids for the patrons to be merged in other tables and changing the ids to be that
463 of the keeper patron.
468 my ( $self, $patron_ids ) = @_;
470 my @patron_ids = @
{ $patron_ids };
472 # Ensure the keeper isn't in the list of patrons to merge
473 @patron_ids = grep { $_ ne $self->id } @patron_ids;
475 my $schema = Koha
::Database
->new()->schema();
479 $self->_result->result_source->schema->txn_do( sub {
480 foreach my $patron_id (@patron_ids) {
481 my $patron = Koha
::Patrons
->find( $patron_id );
485 # Unbless for safety, the patron will end up being deleted
486 $results->{merged
}->{$patron_id}->{patron
} = $patron->unblessed;
488 while (my ($r, $field) = each(%$RESULTSET_PATRON_ID_MAPPING)) {
489 my $rs = $schema->resultset($r)->search({ $field => $patron_id });
490 $results->{merged
}->{ $patron_id }->{updated
}->{$r} = $rs->count();
491 $rs->update({ $field => $self->id });
494 $patron->move_to_deleted();
504 =head3 wants_check_for_previous_checkout
506 $wants_check = $patron->wants_check_for_previous_checkout;
508 Return 1 if Koha needs to perform PrevIssue checking, else 0.
512 sub wants_check_for_previous_checkout
{
514 my $syspref = C4
::Context
->preference("checkPrevCheckout");
517 ## Hard syspref trumps all
518 return 1 if ($syspref eq 'hardyes');
519 return 0 if ($syspref eq 'hardno');
520 ## Now, patron pref trumps all
521 return 1 if ($self->checkprevcheckout eq 'yes');
522 return 0 if ($self->checkprevcheckout eq 'no');
524 # More complex: patron inherits -> determine category preference
525 my $checkPrevCheckoutByCat = $self->category->checkprevcheckout;
526 return 1 if ($checkPrevCheckoutByCat eq 'yes');
527 return 0 if ($checkPrevCheckoutByCat eq 'no');
529 # Finally: category preference is inherit, default to 0
530 if ($syspref eq 'softyes') {
537 =head3 do_check_for_previous_checkout
539 $do_check = $patron->do_check_for_previous_checkout($item);
541 Return 1 if the bib associated with $ITEM has previously been checked out to
542 $PATRON, 0 otherwise.
546 sub do_check_for_previous_checkout
{
547 my ( $self, $item ) = @_;
549 # Find all items for bib and extract item numbers.
550 my @items = Koha
::Items
->search({biblionumber
=> $item->{biblionumber
}});
552 foreach my $item (@items) {
553 push @item_nos, $item->itemnumber;
556 # Create (old)issues search criteria
558 borrowernumber
=> $self->borrowernumber,
559 itemnumber
=> \
@item_nos,
562 # Check current issues table
563 my $issues = Koha
::Checkouts
->search($criteria);
564 return 1 if $issues->count; # 0 || N
566 # Check old issues table
567 my $old_issues = Koha
::Old
::Checkouts
->search($criteria);
568 return $old_issues->count; # 0 || N
573 my $debarment_expiration = $patron->is_debarred;
575 Returns the date a patron debarment will expire, or undef if the patron is not
583 return unless $self->debarred;
584 return $self->debarred
585 if $self->debarred =~ '^9999'
586 or dt_from_string
( $self->debarred ) > dt_from_string
;
592 my $is_expired = $patron->is_expired;
594 Returns 1 if the patron is expired or 0;
600 return 0 unless $self->dateexpiry;
601 return 0 if $self->dateexpiry =~ '^9999';
602 return 1 if dt_from_string
( $self->dateexpiry ) < dt_from_string
->truncate( to
=> 'day' );
606 =head3 is_going_to_expire
608 my $is_going_to_expire = $patron->is_going_to_expire;
610 Returns 1 if the patron is going to expired, depending on the NotifyBorrowerDeparture pref or 0
614 sub is_going_to_expire
{
617 my $delay = C4
::Context
->preference('NotifyBorrowerDeparture') || 0;
619 return 0 unless $delay;
620 return 0 unless $self->dateexpiry;
621 return 0 if $self->dateexpiry =~ '^9999';
622 return 1 if dt_from_string
( $self->dateexpiry )->subtract( days
=> $delay ) < dt_from_string
->truncate( to
=> 'day' );
626 =head3 update_password
628 my $updated = $patron->update_password( $userid, $password );
630 Update the userid and the password of a patron.
631 If the userid already exists, returns and let DBIx::Class warns
632 This will add an entry to action_logs if BorrowersLog is set.
636 sub update_password
{
637 my ( $self, $userid, $password ) = @_;
638 eval { $self->userid($userid)->store; };
639 return if $@
; # Make sure the userid is not already in used by another patron
641 return 0 if $password eq '****' or $password eq '';
643 my $digest = Koha
::AuthUtils
::hash_password
($password);
651 logaction
( "MEMBERS", "CHANGE PASS", $self->borrowernumber, "" ) if C4
::Context
->preference("BorrowersLog");
657 my $new_expiry_date = $patron->renew_account
659 Extending the subscription to the expiry date.
666 if ( C4
::Context
->preference('BorrowerRenewalPeriodBase') eq 'combination' ) {
667 $date = ( dt_from_string
gt dt_from_string
( $self->dateexpiry ) ) ? dt_from_string
: dt_from_string
( $self->dateexpiry );
670 C4
::Context
->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry'
671 ? dt_from_string
( $self->dateexpiry )
674 my $expiry_date = $self->category->get_expiry_date($date);
676 $self->dateexpiry($expiry_date);
677 $self->date_renewed( dt_from_string
() );
680 $self->add_enrolment_fee_if_needed;
682 logaction
( "MEMBERS", "RENEW", $self->borrowernumber, "Membership renewed" ) if C4
::Context
->preference("BorrowersLog");
683 return dt_from_string
( $expiry_date )->truncate( to
=> 'day' );
688 my $has_overdues = $patron->has_overdues;
690 Returns the number of patron's overdues
696 my $dtf = Koha
::Database
->new->schema->storage->datetime_parser;
697 return $self->_result->issues->search({ date_due
=> { '<' => $dtf->format_datetime( dt_from_string
() ) } })->count;
702 $patron->track_login;
703 $patron->track_login({ force => 1 });
705 Tracks a (successful) login attempt.
706 The preference TrackLastPatronActivity must be enabled. Or you
707 should pass the force parameter.
712 my ( $self, $params ) = @_;
715 !C4
::Context
->preference('TrackLastPatronActivity');
716 $self->lastseen( dt_from_string
() )->store;
719 =head3 move_to_deleted
721 my $is_moved = $patron->move_to_deleted;
723 Move a patron to the deletedborrowers table.
724 This can be done before deleting a patron, to make sure the data are not completely deleted.
728 sub move_to_deleted
{
730 my $patron_infos = $self->unblessed;
731 delete $patron_infos->{updated_on
}; #This ensures the updated_on date in deletedborrowers will be set to the current timestamp
732 return Koha
::Database
->new->schema->resultset('Deletedborrower')->create($patron_infos);
735 =head3 article_requests
737 my @requests = $borrower->article_requests();
738 my $requests = $borrower->article_requests();
740 Returns either a list of ArticleRequests objects,
741 or an ArtitleRequests object, depending on the
746 sub article_requests
{
749 $self->{_article_requests
} ||= Koha
::ArticleRequests
->search({ borrowernumber
=> $self->borrowernumber() });
751 return $self->{_article_requests
};
754 =head3 article_requests_current
756 my @requests = $patron->article_requests_current
758 Returns the article requests associated with this patron that are incomplete
762 sub article_requests_current
{
765 $self->{_article_requests_current
} ||= Koha
::ArticleRequests
->search(
767 borrowernumber
=> $self->id(),
769 { status
=> Koha
::ArticleRequest
::Status
::Pending
},
770 { status
=> Koha
::ArticleRequest
::Status
::Processing
}
775 return $self->{_article_requests_current
};
778 =head3 article_requests_finished
780 my @requests = $biblio->article_requests_finished
782 Returns the article requests associated with this patron that are completed
786 sub article_requests_finished
{
787 my ( $self, $borrower ) = @_;
789 $self->{_article_requests_finished
} ||= Koha
::ArticleRequests
->search(
791 borrowernumber
=> $self->id(),
793 { status
=> Koha
::ArticleRequest
::Status
::Completed
},
794 { status
=> Koha
::ArticleRequest
::Status
::Canceled
}
799 return $self->{_article_requests_finished
};
802 =head3 add_enrolment_fee_if_needed
804 my $enrolment_fee = $patron->add_enrolment_fee_if_needed;
806 Add enrolment fee for a patron if needed.
810 sub add_enrolment_fee_if_needed
{
812 my $enrolment_fee = $self->category->enrolmentfee;
813 if ( $enrolment_fee && $enrolment_fee > 0 ) {
814 # insert fee in patron debts
815 C4
::Accounts
::manualinvoice
( $self->borrowernumber, '', '', 'A', $enrolment_fee );
817 return $enrolment_fee || 0;
822 my $checkouts = $patron->checkouts
828 my $checkouts = $self->_result->issues;
829 return Koha
::Checkouts
->_new_from_dbic( $checkouts );
832 =head3 pending_checkouts
834 my $pending_checkouts = $patron->pending_checkouts
836 This method will return the same as $self->checkouts, but with a prefetch on
837 items, biblio and biblioitems.
839 It has been introduced to replaced the C4::Members::GetPendingIssues subroutine
841 It should not be used directly, prefer to access fields you need instead of
842 retrieving all these fields in one go.
847 sub pending_checkouts
{
849 my $checkouts = $self->_result->issues->search(
853 { -desc
=> 'me.timestamp' },
854 { -desc
=> 'issuedate' },
855 { -desc
=> 'issue_id' }, # Sort by issue_id should be enough
857 prefetch
=> { item
=> { biblio
=> 'biblioitems' } },
860 return Koha
::Checkouts
->_new_from_dbic( $checkouts );
865 my $old_checkouts = $patron->old_checkouts
871 my $old_checkouts = $self->_result->old_issues;
872 return Koha
::Old
::Checkouts
->_new_from_dbic( $old_checkouts );
877 my $overdue_items = $patron->get_overdues
879 Return the overdue items
885 my $dtf = Koha
::Database
->new->schema->storage->datetime_parser;
886 return $self->checkouts->search(
888 'me.date_due' => { '<' => $dtf->format_datetime(dt_from_string
) },
891 prefetch
=> { item
=> { biblio
=> 'biblioitems' } },
896 =head3 get_routing_lists
898 my @routinglists = $patron->get_routing_lists
900 Returns the routing lists a patron is subscribed to.
904 sub get_routing_lists
{
906 my $routing_list_rs = $self->_result->subscriptionroutinglists;
907 return Koha
::Subscription
::Routinglists
->_new_from_dbic($routing_list_rs);
912 my $age = $patron->get_age
914 Return the age of the patron
920 my $today_str = dt_from_string
->strftime("%Y-%m-%d");
921 return unless $self->dateofbirth;
922 my $dob_str = dt_from_string
( $self->dateofbirth )->strftime("%Y-%m-%d");
924 my ( $dob_y, $dob_m, $dob_d ) = split /-/, $dob_str;
925 my ( $today_y, $today_m, $today_d ) = split /-/, $today_str;
927 my $age = $today_y - $dob_y;
928 if ( $dob_m . $dob_d > $today_m . $today_d ) {
937 my $account = $patron->account
943 return Koha
::Account
->new( { patron_id
=> $self->borrowernumber } );
948 my $holds = $patron->holds
950 Return all the holds placed by this patron
956 my $holds_rs = $self->_result->reserves->search( {}, { order_by
=> 'reservedate' } );
957 return Koha
::Holds
->_new_from_dbic($holds_rs);
962 my $old_holds = $patron->old_holds
964 Return all the historical holds for this patron
970 my $old_holds_rs = $self->_result->old_reserves->search( {}, { order_by
=> 'reservedate' } );
971 return Koha
::Old
::Holds
->_new_from_dbic($old_holds_rs);
974 =head3 notice_email_address
976 my $email = $patron->notice_email_address;
978 Return the email address of patron used for notices.
979 Returns the empty string if no email address.
983 sub notice_email_address
{
986 my $which_address = C4
::Context
->preference("AutoEmailPrimaryAddress");
987 # if syspref is set to 'first valid' (value == OFF), look up email address
988 if ( $which_address eq 'OFF' ) {
989 return $self->first_valid_email_address;
992 return $self->$which_address || '';
995 =head3 first_valid_email_address
997 my $first_valid_email_address = $patron->first_valid_email_address
999 Return the first valid email address for a patron.
1000 For now, the order is defined as email, emailpro, B_email.
1001 Returns the empty string if the borrower has no email addresses.
1005 sub first_valid_email_address
{
1008 return $self->email() || $self->emailpro() || $self->B_email() || q{};
1011 =head3 get_club_enrollments
1015 sub get_club_enrollments
{
1016 my ( $self, $return_scalar ) = @_;
1018 my $e = Koha
::Club
::Enrollments
->search( { borrowernumber
=> $self->borrowernumber(), date_canceled
=> undef } );
1020 return $e if $return_scalar;
1022 return wantarray ?
$e->as_list : $e;
1025 =head3 get_enrollable_clubs
1029 sub get_enrollable_clubs
{
1030 my ( $self, $is_enrollable_from_opac, $return_scalar ) = @_;
1033 $params->{is_enrollable_from_opac
} = $is_enrollable_from_opac
1034 if $is_enrollable_from_opac;
1035 $params->{is_email_required
} = 0 unless $self->first_valid_email_address();
1037 $params->{borrower
} = $self;
1039 my $e = Koha
::Clubs
->get_enrollable($params);
1041 return $e if $return_scalar;
1043 return wantarray ?
$e->as_list : $e;
1046 =head3 account_locked
1048 my $is_locked = $patron->account_locked
1050 Return true if the patron has reach the maximum number of login attempts (see pref FailedLoginAttempts).
1051 Otherwise return false.
1052 If the pref is not set (empty string, null or 0), the feature is considered as disabled.
1056 sub account_locked
{
1058 my $FailedLoginAttempts = C4
::Context
->preference('FailedLoginAttempts');
1059 return ( $FailedLoginAttempts
1060 and $self->login_attempts
1061 and $self->login_attempts >= $FailedLoginAttempts )?
1 : 0;
1064 =head3 can_see_patron_infos
1066 my $can_see = $patron->can_see_patron_infos( $patron );
1068 Return true if the patron (usually the logged in user) can see the patron's infos for a given patron
1072 sub can_see_patron_infos
{
1073 my ( $self, $patron ) = @_;
1074 return $self->can_see_patrons_from( $patron->library->branchcode );
1077 =head3 can_see_patrons_from
1079 my $can_see = $patron->can_see_patrons_from( $branchcode );
1081 Return true if the patron (usually the logged in user) can see the patron's infos from a given library
1085 sub can_see_patrons_from
{
1086 my ( $self, $branchcode ) = @_;
1088 if ( $self->branchcode eq $branchcode ) {
1090 } elsif ( $self->has_permission( { borrowers
=> 'view_borrower_infos_from_any_libraries' } ) ) {
1092 } elsif ( my $library_groups = $self->library->library_groups ) {
1093 while ( my $library_group = $library_groups->next ) {
1094 if ( $library_group->parent->has_child( $branchcode ) ) {
1103 =head3 libraries_where_can_see_patrons
1105 my $libraries = $patron-libraries_where_can_see_patrons;
1107 Return the list of branchcodes(!) of libraries the patron is allowed to see other patron's infos.
1108 The branchcodes are arbitrarily returned sorted.
1109 We are supposing here that the object is related to the logged in patron (use of C4::Context::only_my_library)
1111 An empty array means no restriction, the patron can see patron's infos from any libraries.
1115 sub libraries_where_can_see_patrons
{
1117 my $userenv = C4
::Context
->userenv;
1119 return () unless $userenv; # For tests, but userenv should be defined in tests...
1121 my @restricted_branchcodes;
1122 if (C4
::Context
::only_my_library
) {
1123 push @restricted_branchcodes, $self->branchcode;
1127 $self->has_permission(
1128 { borrowers
=> 'view_borrower_infos_from_any_libraries' }
1132 my $library_groups = $self->library->library_groups({ ft_hide_patron_info
=> 1 });
1133 if ( $library_groups->count )
1135 while ( my $library_group = $library_groups->next ) {
1136 my $parent = $library_group->parent;
1137 if ( $parent->has_child( $self->branchcode ) ) {
1138 push @restricted_branchcodes, $parent->children->get_column('branchcode');
1143 @restricted_branchcodes = ( $self->branchcode ) unless @restricted_branchcodes;
1147 @restricted_branchcodes = grep { defined $_ } @restricted_branchcodes;
1148 @restricted_branchcodes = uniq
(@restricted_branchcodes);
1149 @restricted_branchcodes = sort(@restricted_branchcodes);
1150 return @restricted_branchcodes;
1153 sub has_permission
{
1154 my ( $self, $flagsrequired ) = @_;
1155 return unless $self->userid;
1156 # TODO code from haspermission needs to be moved here!
1157 return C4
::Auth
::haspermission
( $self->userid, $flagsrequired );
1162 my $is_adult = $patron->is_adult
1164 Return true if the patron has a category with a type Adult (A) or Organization (I)
1170 return $self->category->category_type =~ /^(A|I)$/ ?
1 : 0;
1175 my $is_child = $patron->is_child
1177 Return true if the patron has a category with a type Child (C)
1182 return $self->category->category_type eq 'C' ?
1 : 0;
1185 =head3 has_valid_userid
1187 my $patron = Koha::Patrons->find(42);
1188 $patron->userid( $new_userid );
1189 my $has_a_valid_userid = $patron->has_valid_userid
1191 my $patron = Koha::Patron->new( $params );
1192 my $has_a_valid_userid = $patron->has_valid_userid
1194 Return true if the current userid of this patron is valid/unique, otherwise false.
1196 Note that this should be done in $self->store instead and raise an exception if needed.
1200 sub has_valid_userid
{
1203 return 0 unless $self->userid;
1205 return 0 if ( $self->userid eq C4
::Context
->config('user') ); # DB user
1207 my $already_exists = Koha
::Patrons
->search(
1209 userid
=> $self->userid,
1212 ?
( borrowernumber
=> { '!=' => $self->borrowernumber } )
1217 return $already_exists ?
0 : 1;
1220 =head3 generate_userid
1222 my $patron = Koha::Patron->new( $params );
1223 $patron->generate_userid
1225 Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
1227 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).
1231 sub generate_userid
{
1234 my $firstname = $self->firstname // q{};
1235 my $surname = $self->surname // q{};
1236 #The script will "do" the following code and increment the $offset until the generated userid is unique
1238 $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1239 $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1240 my $userid = lc(($firstname)?
"$firstname.$surname" : $surname);
1241 $userid = unac_string
('utf-8',$userid);
1242 $userid .= $offset unless $offset == 0;
1243 $self->userid( $userid );
1245 } while (! $self->has_valid_userid );
1251 =head2 Internal methods
1263 Kyle M Hall <kyle@bywatersolutions.com>
1264 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>