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
9 # under the terms of the GNU General Public License as published by
10 # the Free Software Foundation; either version 3 of the License, or
11 # (at your option) any later version.
13 # Koha is distributed in the hope that it will be useful, but
14 # WITHOUT ANY WARRANTY; without even the implied warranty of
15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 # GNU General Public License for more details.
18 # You should have received a copy of the GNU General Public License
19 # along with Koha; if not, see <http://www.gnu.org/licenses>.
23 use List::MoreUtils qw( any uniq );
24 use JSON qw( to_json );
25 use Unicode::Normalize qw( NFKD );
29 use C4::Auth qw( checkpw_hash );
31 use C4::Letters qw( GetPreparedLetter EnqueueLetter SendQueuedMessages );
32 use C4::Log qw( logaction );
34 use Koha::ArticleRequests;
38 use Koha::CirculationRules;
39 use Koha::Club::Enrollments;
40 use Koha::CurbsidePickups;
42 use Koha::DateUtils qw( dt_from_string );
44 use Koha::Exceptions::Password;
46 use Koha::Old::Checkouts;
47 use Koha::OverdueRules;
48 use Koha::Patron::Attributes;
49 use Koha::Patron::Categories;
50 use Koha::Patron::Debarments;
51 use Koha::Patron::HouseboundProfile;
52 use Koha::Patron::HouseboundRole;
53 use Koha::Patron::Images;
54 use Koha::Patron::Messages;
55 use Koha::Patron::Modifications;
56 use Koha::Patron::MessagePreferences;
57 use Koha::Patron::Relationships;
58 use Koha::Patron::Restrictions;
62 use Koha::Result::Boolean;
63 use Koha::Subscription::Routinglists;
65 use Koha::Virtualshelves;
67 use base qw(Koha::Object);
69 use constant ADMINISTRATIVE_LOCKOUT => -1;
71 our $RESULTSET_PATRON_ID_MAPPING = {
72 Accountline => 'borrowernumber',
73 Aqbasketuser => 'borrowernumber',
74 Aqbudget => 'budget_owner_id',
75 Aqbudgetborrower => 'borrowernumber',
76 ArticleRequest => 'borrowernumber',
77 BorrowerDebarment => 'borrowernumber',
78 BorrowerFile => 'borrowernumber',
79 BorrowerModification => 'borrowernumber',
80 ClubEnrollment => 'borrowernumber',
81 Issue => 'borrowernumber',
82 ItemsLastBorrower => 'borrowernumber',
83 Linktracker => 'borrowernumber',
84 Message => 'borrowernumber',
85 MessageQueue => 'borrowernumber',
86 OldIssue => 'borrowernumber',
87 OldReserve => 'borrowernumber',
88 Rating => 'borrowernumber',
89 Reserve => 'borrowernumber',
90 Review => 'borrowernumber',
91 SearchHistory => 'userid',
92 Statistic => 'borrowernumber',
93 Suggestion => 'suggestedby',
94 TagAll => 'borrowernumber',
95 Virtualshelfcontent => 'borrowernumber',
96 Virtualshelfshare => 'borrowernumber',
97 Virtualshelve => 'owner',
102 Koha::Patron - Koha Patron Object class
113 my ( $class, $params ) = @_;
115 return $class->SUPER::new($params);
118 =head3 fixup_cardnumber
120 Autogenerate next cardnumber from highest value found in database
124 sub fixup_cardnumber {
127 my $max = $self->cardnumber;
128 Koha::Plugins->call( 'patron_barcode_transform', \$max );
130 $max ||= Koha::Patrons->search({
131 cardnumber => {-regexp => '^-?[0-9]+$'}
133 select => \'CAST(cardnumber AS SIGNED)',
134 as => ['cast_cardnumber']
135 })->_resultset->get_column('cast_cardnumber')->max;
136 $self->cardnumber(($max || 0) +1);
139 =head3 trim_whitespace
141 trim whitespace from data which has some non-whitespace in it.
142 Could be moved to Koha::Object if need to be reused
146 sub trim_whitespaces {
149 my $schema = Koha::Database->new->schema;
150 my @columns = $schema->source($self->_type)->columns;
152 for my $column( @columns ) {
153 my $value = $self->$column;
154 if ( defined $value ) {
155 $value =~ s/^\s*|\s*$//g;
156 $self->$column($value);
162 =head3 plain_text_password
164 $patron->plain_text_password( $password );
166 stores a copy of the unencrypted password in the object
167 for use in code before encrypting for db
171 sub plain_text_password {
172 my ( $self, $password ) = @_;
174 $self->{_plain_text_password} = $password;
177 return $self->{_plain_text_password}
178 if $self->{_plain_text_password};
185 Patron specific store method to cleanup record
186 and do other necessary things before saving
194 $self->_result->result_source->schema->txn_do(
197 C4::Context->preference("autoMemberNum")
198 and ( not defined $self->cardnumber
199 or $self->cardnumber eq '' )
202 # Warning: The caller is responsible for locking the members table in write
203 # mode, to avoid database corruption.
204 # We are in a transaction but the table is not locked
205 $self->fixup_cardnumber;
208 unless( $self->category->in_storage ) {
209 Koha::Exceptions::Object::FKConstraint->throw(
210 broken_fk => 'categorycode',
211 value => $self->categorycode,
215 $self->trim_whitespaces;
217 my $new_cardnumber = $self->cardnumber;
218 Koha::Plugins->call( 'patron_barcode_transform', \$new_cardnumber );
219 $self->cardnumber( $new_cardnumber );
221 # Set surname to uppercase if uppercasesurname is true
222 $self->surname( uc($self->surname) )
223 if C4::Context->preference("uppercasesurnames");
225 $self->relationship(undef) # We do not want to store an empty string in this field
226 if defined $self->relationship
227 and $self->relationship eq "";
229 unless ( $self->in_storage ) { #AddMember
231 # Generate a valid userid/login if needed
232 $self->generate_userid unless $self->userid;
233 Koha::Exceptions::Patron::InvalidUserid->throw( userid => $self->userid )
234 unless $self->has_valid_userid;
236 # Add expiration date if it isn't already there
237 unless ( $self->dateexpiry ) {
238 $self->dateexpiry( $self->category->get_expiry_date );
241 # Add enrollment date if it isn't already there
242 unless ( $self->dateenrolled ) {
243 $self->dateenrolled(dt_from_string);
246 # Set the privacy depending on the patron's category
247 my $default_privacy = $self->category->default_privacy || q{};
249 $default_privacy eq 'default' ? 1
250 : $default_privacy eq 'never' ? 2
251 : $default_privacy eq 'forever' ? 0
253 $self->privacy($default_privacy);
255 # Call any check_password plugins if password is passed
256 if ( C4::Context->config("enable_plugins") && $self->password ) {
257 my @plugins = Koha::Plugins->new()->GetPlugins({
258 method => 'check_password',
260 foreach my $plugin ( @plugins ) {
261 # This plugin hook will also be used by a plugin for the Norwegian national
262 # patron database. This is why we need to pass both the password and the
263 # borrowernumber to the plugin.
264 my $ret = $plugin->check_password(
266 password => $self->password,
267 borrowernumber => $self->borrowernumber
270 if ( $ret->{'error'} == 1 ) {
271 Koha::Exceptions::Password::Plugin->throw();
276 # Make a copy of the plain text password for later use
277 $self->plain_text_password( $self->password );
279 $self->password_expiration_date( $self->password
280 ? $self->category->get_password_expiry_date || undef
282 # Create a disabled account if no password provided
283 $self->password( $self->password
284 ? Koha::AuthUtils::hash_password( $self->password )
287 $self->borrowernumber(undef);
289 $self = $self->SUPER::store;
291 $self->add_enrolment_fee_if_needed(0);
293 logaction( "MEMBERS", "CREATE", $self->borrowernumber, "" )
294 if C4::Context->preference("BorrowersLog");
298 my $self_from_storage = $self->get_from_storage;
300 # Do not accept invalid userid here
301 $self->generate_userid unless $self->userid;
302 Koha::Exceptions::Patron::InvalidUserid->throw( userid => $self->userid )
303 unless $self->has_valid_userid;
305 # If a borrower has set their privacy to never we should immediately anonymize
307 if( $self->privacy() == 2 && $self_from_storage->privacy() != 2 ){
309 $self->old_checkouts->anonymize;
312 Koha::Exceptions::Patron::FailedAnonymizing->throw(
318 # Password must be updated using $self->set_password
319 $self->password($self_from_storage->password);
321 if ( $self->category->categorycode ne
322 $self_from_storage->category->categorycode )
324 # Add enrolement fee on category change if required
325 $self->add_enrolment_fee_if_needed(1)
326 if C4::Context->preference('FeeOnChangePatronCategory');
328 # Clean up guarantors on category change if required
329 $self->guarantor_relationships->delete
330 unless ( $self->category->can_be_guarantee );
335 if ( C4::Context->preference("BorrowersLog") ) {
337 my $from_storage = $self_from_storage->unblessed;
338 my $from_object = $self->unblessed;
339 my @skip_fields = (qw/lastseen updated_on/);
340 for my $key ( keys %{$from_storage} ) {
341 next if any { /$key/ } @skip_fields;
344 !defined( $from_storage->{$key} )
345 && defined( $from_object->{$key} )
347 || ( defined( $from_storage->{$key} )
348 && !defined( $from_object->{$key} ) )
350 defined( $from_storage->{$key} )
351 && defined( $from_object->{$key} )
352 && ( $from_storage->{$key} ne
353 $from_object->{$key} )
358 before => $from_storage->{$key},
359 after => $from_object->{$key}
364 if ( defined($info) ) {
368 $self->borrowernumber,
371 { utf8 => 1, pretty => 1, canonical => 1 }
378 $self = $self->SUPER::store;
389 Delete patron's holds, lists and finally the patron.
391 Lists owned by the borrower are deleted or ownership is transferred depending on the
392 ListOwnershipUponPatronDeletion pref, but entries from the borrower to other lists are kept.
399 my $anonymous_patron = C4::Context->preference("AnonymousPatron");
400 Koha::Exceptions::Patron::FailedDeleteAnonymousPatron->throw() if $anonymous_patron && $self->id eq $anonymous_patron;
402 $self->_result->result_source->schema->txn_do(
404 # Cancel Patron's holds
405 my $holds = $self->holds;
406 while( my $hold = $holds->next ){
410 # Handle lists (virtualshelves)
411 $self->virtualshelves->disown_or_delete;
413 # We cannot have a FK on borrower_modifications.borrowernumber, the table is also used
415 $_->delete for Koha::Patron::Modifications->search( { borrowernumber => $self->borrowernumber } )->as_list;
417 $self->SUPER::delete;
419 logaction( "MEMBERS", "DELETE", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog");
427 my $patron_category = $patron->category
429 Return the patron category for this patron
435 return Koha::Patron::Category->_new_from_dbic( $self->_result->categorycode );
445 return Koha::Patron::Images->find( $self->borrowernumber );
450 Returns a Koha::Library object representing the patron's home library.
456 return Koha::Library->_new_from_dbic($self->_result->branchcode);
461 Returns a Koha::SMS::Provider object representing the patron's SMS provider.
467 my $sms_provider_rs = $self->_result->sms_provider;
468 return unless $sms_provider_rs;
469 return Koha::SMS::Provider->_new_from_dbic($sms_provider_rs);
472 =head3 guarantor_relationships
474 Returns Koha::Patron::Relationships object for this patron's guarantors
476 Returns the set of relationships for the patrons that are guarantors for this patron.
478 Note that a guarantor should exist as a patron in Koha; it was not possible
479 to add them without a guarantor_id in the interface for some time. Bug 30472
480 restricts it on db level.
484 sub guarantor_relationships {
487 return Koha::Patron::Relationships->search( { guarantee_id => $self->id } );
490 =head3 guarantee_relationships
492 Returns Koha::Patron::Relationships object for this patron's guarantors
494 Returns the set of relationships for the patrons that are guarantees for this patron.
496 The method returns Koha::Patron::Relationship objects for the sake
497 of consistency with the guantors method.
498 A guarantee by definition must exist as a patron in Koha.
502 sub guarantee_relationships {
505 return Koha::Patron::Relationships->search(
506 { guarantor_id => $self->id },
508 prefetch => 'guarantee',
509 order_by => { -asc => [ 'guarantee.surname', 'guarantee.firstname' ] },
514 =head3 relationships_debt
516 Returns the amount owed by the patron's guarantors *and* the other guarantees of those guarantors
520 sub relationships_debt {
521 my ($self, $params) = @_;
523 my $include_guarantors = $params->{include_guarantors};
524 my $only_this_guarantor = $params->{only_this_guarantor};
525 my $include_this_patron = $params->{include_this_patron};
528 if ( $only_this_guarantor ) {
529 @guarantors = $self->guarantee_relationships->count ? ( $self ) : ();
530 Koha::Exceptions::BadParameter->throw( { parameter => 'only_this_guarantor' } ) unless @guarantors;
531 } elsif ( $self->guarantor_relationships->count ) {
532 # I am a guarantee, just get all my guarantors
533 @guarantors = $self->guarantor_relationships->guarantors->as_list;
535 # I am a guarantor, I need to get all the guarantors of all my guarantees
536 @guarantors = map { $_->guarantor_relationships->guarantors->as_list } $self->guarantee_relationships->guarantees->as_list;
539 my $non_issues_charges = 0;
540 my $seen = $include_this_patron ? {} : { $self->id => 1 }; # For tracking members already added to the total
541 foreach my $guarantor (@guarantors) {
542 $non_issues_charges += $guarantor->account->non_issues_charges if $include_guarantors && !$seen->{ $guarantor->id };
544 # We've added what the guarantor owes, not added in that guarantor's guarantees as well
545 my @guarantees = map { $_->guarantee } $guarantor->guarantee_relationships->as_list;
546 my $guarantees_non_issues_charges = 0;
547 foreach my $guarantee (@guarantees) {
548 next if $seen->{ $guarantee->id };
549 $guarantees_non_issues_charges += $guarantee->account->non_issues_charges;
550 # Mark this guarantee as seen so we don't double count a guarantee linked to multiple guarantors
551 $seen->{ $guarantee->id } = 1;
554 $non_issues_charges += $guarantees_non_issues_charges;
555 $seen->{ $guarantor->id } = 1;
558 return $non_issues_charges;
561 =head3 housebound_profile
563 Returns the HouseboundProfile associated with this patron.
567 sub housebound_profile {
569 my $profile = $self->_result->housebound_profile;
570 return Koha::Patron::HouseboundProfile->_new_from_dbic($profile)
575 =head3 housebound_role
577 Returns the HouseboundRole associated with this patron.
581 sub housebound_role {
584 my $role = $self->_result->housebound_role;
585 return Koha::Patron::HouseboundRole->_new_from_dbic($role) if ( $role );
591 Returns the siblings of this patron.
598 my @guarantors = $self->guarantor_relationships()->guarantors()->as_list;
600 return unless @guarantors;
603 map { $_->guarantee_relationships()->guarantees()->as_list } @guarantors;
605 return unless @siblings;
609 grep { !$seen{ $_->id }++ && ( $_->id != $self->id ) } @siblings;
611 return Koha::Patrons->search( { borrowernumber => { -in => [ map { $_->id } @siblings ] } } );
616 my $patron = Koha::Patrons->find($id);
617 $patron->merge_with( \@patron_ids );
619 This subroutine merges a list of patrons into the patron record. This is accomplished by finding
620 all related patron ids for the patrons to be merged in other tables and changing the ids to be that
621 of the keeper patron.
626 my ( $self, $patron_ids ) = @_;
628 my $anonymous_patron = C4::Context->preference("AnonymousPatron");
629 return if $anonymous_patron && $self->id eq $anonymous_patron;
631 my @patron_ids = @{ $patron_ids };
633 # Ensure the keeper isn't in the list of patrons to merge
634 @patron_ids = grep { $_ ne $self->id } @patron_ids;
636 my $schema = Koha::Database->new()->schema();
640 $self->_result->result_source->schema->txn_do( sub {
641 foreach my $patron_id (@patron_ids) {
643 next if $patron_id eq $anonymous_patron;
645 my $patron = Koha::Patrons->find( $patron_id );
649 # Unbless for safety, the patron will end up being deleted
650 $results->{merged}->{$patron_id}->{patron} = $patron->unblessed;
652 my $attributes = $patron->extended_attributes;
653 my $new_attributes = [
654 map { { code => $_->code, attribute => $_->attribute } }
657 $attributes->delete; # We need to delete before trying to merge them to prevent exception on unique and repeatable
658 for my $attribute ( @$new_attributes ) {
660 $self->add_extended_attribute($attribute);
662 # Don't block the merge if there is a non-repeatable attribute that cannot be added to the current patron.
663 unless ( $_->isa('Koha::Exceptions::Patron::Attribute::NonRepeatable') ) {
669 while (my ($r, $field) = each(%$RESULTSET_PATRON_ID_MAPPING)) {
670 my $rs = $schema->resultset($r)->search({ $field => $patron_id });
671 $results->{merged}->{ $patron_id }->{updated}->{$r} = $rs->count();
672 $rs->update({ $field => $self->id });
673 if ( $r eq 'BorrowerDebarment' ) {
674 Koha::Patron::Debarments::UpdateBorrowerDebarmentFlags($self->id);
678 $patron->move_to_deleted();
687 =head3 messaging_preferences
689 my $patron = Koha::Patrons->find($id);
690 $patron->messaging_preferences();
694 sub messaging_preferences {
697 return Koha::Patron::MessagePreferences->search({
698 borrowernumber => $self->borrowernumber,
702 =head3 wants_check_for_previous_checkout
704 $wants_check = $patron->wants_check_for_previous_checkout;
706 Return 1 if Koha needs to perform PrevIssue checking, else 0.
710 sub wants_check_for_previous_checkout {
712 my $syspref = C4::Context->preference("checkPrevCheckout");
715 ## Hard syspref trumps all
716 return 1 if ($syspref eq 'hardyes');
717 return 0 if ($syspref eq 'hardno');
718 ## Now, patron pref trumps all
719 return 1 if ($self->checkprevcheckout eq 'yes');
720 return 0 if ($self->checkprevcheckout eq 'no');
722 # More complex: patron inherits -> determine category preference
723 my $checkPrevCheckoutByCat = $self->category->checkprevcheckout;
724 return 1 if ($checkPrevCheckoutByCat eq 'yes');
725 return 0 if ($checkPrevCheckoutByCat eq 'no');
727 # Finally: category preference is inherit, default to 0
728 if ($syspref eq 'softyes') {
735 =head3 do_check_for_previous_checkout
737 $do_check = $patron->do_check_for_previous_checkout($item);
739 Return 1 if the bib associated with $ITEM has previously been checked out to
740 $PATRON, 0 otherwise.
744 sub do_check_for_previous_checkout {
745 my ( $self, $item ) = @_;
748 my $biblio = Koha::Biblios->find( $item->{biblionumber} );
749 if ( $biblio->is_serial ) {
750 push @item_nos, $item->{itemnumber};
752 # Get all itemnumbers for given bibliographic record.
753 @item_nos = $biblio->items->get_column( 'itemnumber' );
756 # Create (old)issues search criteria
758 borrowernumber => $self->borrowernumber,
759 itemnumber => \@item_nos,
762 my $delay = C4::Context->preference('CheckPrevCheckoutDelay') || 0;
764 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
765 my $newer_than = dt_from_string()->subtract( days => $delay );
766 $criteria->{'returndate'} = { '>' => $dtf->format_datetime($newer_than), };
769 # Check current issues table
770 my $issues = Koha::Checkouts->search($criteria);
771 return 1 if $issues->count; # 0 || N
773 # Check old issues table
774 my $old_issues = Koha::Old::Checkouts->search($criteria);
775 return $old_issues->count; # 0 || N
780 my $debarment_expiration = $patron->is_debarred;
782 Returns the date a patron debarment will expire, or undef if the patron is not
790 return unless $self->debarred;
791 return $self->debarred
792 if $self->debarred =~ '^9999'
793 or dt_from_string( $self->debarred ) > dt_from_string;
799 my $is_expired = $patron->is_expired;
801 Returns 1 if the patron is expired or 0;
807 return 0 unless $self->dateexpiry;
808 return 0 if $self->dateexpiry =~ '^9999';
809 return 1 if dt_from_string( $self->dateexpiry ) < dt_from_string->truncate( to => 'day' );
815 $patron->is_active({ [ since => $date ], [ days|weeks|months|years => $value ] })
817 A patron is considered 'active' if the following conditions hold:
819 - account did not expire
820 - account has not been anonymized
821 - enrollment or lastseen within period specified
823 Note: lastseen is updated for triggers defined in preference
824 TrackLastPatronActivityTriggers. This includes logins, issues, holds, etc.
826 The period to check is defined by $date or $value in days, weeks or months. You should
827 pass one of those; otherwise an exception is thrown.
832 my ( $self, $params ) = @_;
833 return 0 if $self->is_expired or $self->anonymized;
836 if ( $params->{since} ) {
837 $dt = dt_from_string( $params->{since}, 'iso' );
838 } elsif ( grep { $params->{$_} } qw(days weeks months years) ) {
839 $dt = dt_from_string();
840 foreach my $duration (qw(days weeks months years)) {
841 $dt = $dt->subtract( $duration => $params->{$duration} ) if $params->{$duration};
844 Koha::Exceptions::MissingParameter->throw('is_active needs date or period');
847 # Enrollment within this period?
848 return 1 if DateTime->compare( dt_from_string( $self->dateenrolled ), $dt ) > -1;
850 # We look at lastseen regardless of TrackLastPatronActivityTriggers. If lastseen is set
851 # recently, the triggers may have been removed after that, etc.
852 return 1 if $self->lastseen && DateTime->compare( dt_from_string( $self->lastseen ), $dt ) > -1;
857 =head3 password_expired
859 my $password_expired = $patron->password_expired;
861 Returns 1 if the patron's password is expired or 0;
865 sub password_expired {
867 return 0 unless $self->password_expiration_date;
868 return 1 if dt_from_string( $self->password_expiration_date ) <= dt_from_string->truncate( to => 'day' );
872 =head3 is_going_to_expire
874 my $is_going_to_expire = $patron->is_going_to_expire;
876 Returns 1 if the patron is going to expired, depending on the NotifyBorrowerDeparture pref or 0
880 sub is_going_to_expire {
883 my $delay = C4::Context->preference('NotifyBorrowerDeparture') || 0;
885 return 0 unless $delay;
886 return 0 unless $self->dateexpiry;
887 return 0 if $self->dateexpiry =~ '^9999';
888 return 1 if dt_from_string( $self->dateexpiry, undef, 'floating' )->subtract( days => $delay ) < dt_from_string(undef, undef, 'floating')->truncate( to => 'day' );
894 $patron->set_password({ password => $plain_text_password [, skip_validation => 1 ] });
896 Set the patron's password.
900 The passed string is validated against the current password enforcement policy.
901 Validation can be skipped by passing the I<skip_validation> parameter.
903 Exceptions are thrown if the password is not good enough.
907 =item Koha::Exceptions::Password::TooShort
909 =item Koha::Exceptions::Password::WhitespaceCharacters
911 =item Koha::Exceptions::Password::TooWeak
913 =item Koha::Exceptions::Password::Plugin (if a "check password" plugin is enabled)
920 my ( $self, $args ) = @_;
922 my $password = $args->{password};
924 unless ( $args->{skip_validation} ) {
925 my ( $is_valid, $error ) = Koha::AuthUtils::is_password_valid( $password, $self->category );
928 if ( $error eq 'too_short' ) {
929 my $min_length = $self->category->effective_min_password_length;
930 $min_length = 3 if not $min_length or $min_length < 3;
932 my $password_length = length($password);
933 Koha::Exceptions::Password::TooShort->throw(
934 length => $password_length, min_length => $min_length );
936 elsif ( $error eq 'has_whitespaces' ) {
937 Koha::Exceptions::Password::WhitespaceCharacters->throw();
939 elsif ( $error eq 'too_weak' ) {
940 Koha::Exceptions::Password::TooWeak->throw();
945 if ( C4::Context->config("enable_plugins") ) {
946 # Call any check_password plugins
947 my @plugins = Koha::Plugins->new()->GetPlugins({
948 method => 'check_password',
950 foreach my $plugin ( @plugins ) {
951 # This plugin hook will also be used by a plugin for the Norwegian national
952 # patron database. This is why we need to pass both the password and the
953 # borrowernumber to the plugin.
954 my $ret = $plugin->check_password(
956 password => $password,
957 borrowernumber => $self->borrowernumber
960 # This plugin hook will also be used by a plugin for the Norwegian national
961 # patron database. This is why we need to call the actual plugins and then
962 # check skip_validation afterwards.
963 if ( $ret->{'error'} == 1 && !$args->{skip_validation} ) {
964 Koha::Exceptions::Password::Plugin->throw();
969 if ( C4::Context->preference('NotifyPasswordChange') ) {
970 my $self_from_storage = $self->get_from_storage;
971 if ( !C4::Auth::checkpw_hash( $password, $self_from_storage->password ) ) {
972 my $emailaddr = $self_from_storage->notice_email_address;
974 # if we manage to find a valid email address, send notice
976 my $letter = C4::Letters::GetPreparedLetter(
978 letter_code => 'PASSWORD_CHANGE',
979 branchcode => $self_from_storage->branchcode,
981 lang => $self_from_storage->lang || 'default',
983 'branches' => $self_from_storage->branchcode,
984 'borrowers' => $self_from_storage->borrowernumber,
989 my $message_id = C4::Letters::EnqueueLetter(
992 borrowernumber => $self_from_storage->id,
993 to_address => $emailaddr,
994 message_transport_type => 'email'
997 C4::Letters::SendQueuedMessages( { message_id => $message_id } ) if $message_id;
1002 my $digest = Koha::AuthUtils::hash_password($password);
1004 $self->password_expiration_date( $self->category->get_password_expiry_date || undef );
1006 # We do not want to call $self->store and retrieve password from DB
1007 $self->password($digest);
1008 $self->login_attempts(0);
1009 $self->SUPER::store;
1011 logaction( "MEMBERS", "CHANGE PASS", $self->borrowernumber, "" )
1012 if C4::Context->preference("BorrowersLog");
1018 =head3 renew_account
1020 my $new_expiry_date = $patron->renew_account
1022 Extending the subscription to the expiry date.
1029 if ( C4::Context->preference('BorrowerRenewalPeriodBase') eq 'combination' ) {
1030 $date = ( dt_from_string gt dt_from_string( $self->dateexpiry ) ) ? dt_from_string : dt_from_string( $self->dateexpiry );
1033 C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry'
1034 ? dt_from_string( $self->dateexpiry )
1037 my $expiry_date = $self->category->get_expiry_date($date);
1039 $self->dateexpiry($expiry_date);
1040 $self->date_renewed( dt_from_string() );
1043 $self->add_enrolment_fee_if_needed(1);
1045 logaction( "MEMBERS", "RENEW", $self->borrowernumber, "Membership renewed" ) if C4::Context->preference("BorrowersLog");
1046 return dt_from_string( $expiry_date )->truncate( to => 'day' );
1051 my $has_overdues = $patron->has_overdues;
1053 Returns the number of patron's overdues
1059 my $date = dt_from_string();
1060 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
1061 return $self->_result->issues->search({ date_due => { '<' => $dtf->format_datetime($date) } })->count;
1066 =head3 has_restricting_overdues
1068 my $has_restricting_overdues = $patron->has_restricting_overdues({ issue_branchcode => $branchcode });
1070 Returns true if patron has overdues that would result in debarment.
1074 sub has_restricting_overdues {
1075 my ( $self, $params ) = @_;
1077 my $date = dt_from_string()->truncate( to => 'day' );
1079 # If ignoring unrestricted overdues, calculate which delay value for
1080 # overdue messages is set with restrictions. Then only include overdue
1081 # issues older than that date when counting.
1082 #TODO: bail out/throw exception if $params->{issue_branchcode} not set?
1083 my $debarred_delay = _get_overdue_debarred_delay( $params->{issue_branchcode}, $self->categorycode() );
1084 return 0 unless defined $debarred_delay;
1086 # Emulate the conditions in overdue_notices.pl.
1087 # The overdue_notices-script effectively truncates both issues.date_due and current date
1088 # to days when selecting overdue issues.
1089 # Hours and minutes for issues.date_due is usually set to 23 and 59 respectively, though can theoretically
1090 # be set to any other value (truncated to minutes, except if CalcDateDue gets a $startdate)
1092 # No matter what time of day date_due is set to, overdue_notices.pl will select all issues that are due
1093 # the current date or later. We can emulate this query by instead of truncating both to days in the SQL-query,
1094 # using the condition that date_due must be less then the current date truncated to days (time set to 00:00:00)
1095 # offset by one day in the future.
1097 $date->add( days => 1 );
1100 if ( C4::Context->preference('OverdueNoticeCalendar') ) {
1101 $calendar = Koha::Calendar->new( branchcode => $params->{issue_branchcode} );
1104 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
1105 my $issues = $self->_result->issues->search( { date_due => { '<' => $dtf->format_datetime($date) } } );
1106 my $now = dt_from_string();
1108 while ( my $issue = $issues->next ) {
1110 C4::Context->preference('OverdueNoticeCalendar')
1111 ? $calendar->days_between( dt_from_string( $issue->date_due ), $now )->in_units('days')
1112 : $now->delta_days( dt_from_string( $issue->date_due ) )->in_units('days');
1113 if ( $days_between >= $debarred_delay ) {
1120 # Fetch first delayX value from overduerules where debarredX is set, or 0 for no delay
1121 sub _get_overdue_debarred_delay {
1122 my ( $branchcode, $categorycode ) = @_;
1123 my $dbh = C4::Context->dbh();
1125 # We get default rules if there is no rule for this branch
1126 my $rule = Koha::OverdueRules->find(
1128 branchcode => $branchcode,
1129 categorycode => $categorycode
1132 || Koha::OverdueRules->find(
1135 categorycode => $categorycode
1140 return $rule->delay1 if $rule->debarred1;
1141 return $rule->delay2 if $rule->debarred2;
1142 return $rule->delay3 if $rule->debarred3;
1146 =head3 update_lastseen
1148 $patron->update_lastseen('activity');
1150 Updates the lastseen field, limited to one update per day, whenever the activity passed is
1151 listed in TrackLastPatronActivityTriggers.
1153 The method should be called upon successful completion of the activity.
1157 sub update_lastseen {
1158 my ( $self, $activity ) = @_;
1159 my $tracked_activities = {
1160 map { ( lc $_, 1 ); } split /\s*\,\s*/,
1161 C4::Context->preference('TrackLastPatronActivityTriggers')
1163 return $self unless $tracked_activities->{$activity};
1165 my $cache = Koha::Caches->get_instance();
1166 my $cache_key = "track_activity_" . $self->borrowernumber;
1167 my $cached = $cache->get_from_cache($cache_key);
1168 my $now = dt_from_string();
1169 return $self if $cached && $cached eq $now->ymd;
1171 $self->lastseen($now)->store;
1172 $cache->set_in_cache( $cache_key, $now->ymd );
1176 =head3 move_to_deleted
1178 my $is_moved = $patron->move_to_deleted;
1180 Move a patron to the deletedborrowers table.
1181 This can be done before deleting a patron, to make sure the data are not completely deleted.
1185 sub move_to_deleted {
1187 my $patron_infos = $self->unblessed;
1188 delete $patron_infos->{updated_on}; #This ensures the updated_on date in deletedborrowers will be set to the current timestamp
1189 return Koha::Database->new->schema->resultset('Deletedborrower')->create($patron_infos);
1192 =head3 can_request_article
1194 if ( $patron->can_request_article( $library->id ) ) { ... }
1196 Returns true if the patron can request articles. As limits apply for the patron
1197 on the same day, those completed the same day are considered as current.
1199 A I<library_id> can be passed as parameter, falling back to userenv if absent.
1203 sub can_request_article {
1204 my ($self, $library_id) = @_;
1206 $library_id //= C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef;
1208 my $rule = Koha::CirculationRules->get_effective_rule(
1210 branchcode => $library_id,
1211 categorycode => $self->categorycode,
1212 rule_name => 'open_article_requests_limit'
1216 my $limit = ($rule) ? $rule->rule_value : undef;
1218 return 1 unless defined $limit;
1220 my $count = Koha::ArticleRequests->search(
1221 [ { borrowernumber => $self->borrowernumber, status => [ 'REQUESTED', 'PENDING', 'PROCESSING' ] },
1222 { borrowernumber => $self->borrowernumber, status => 'COMPLETED', updated_on => { '>=' => \'CAST(NOW() AS DATE)' } },
1225 return $count < $limit ? 1 : 0;
1228 =head3 article_request_fee
1230 my $fee = $patron->article_request_fee(
1232 [ library_id => $library->id, ]
1236 Returns the fee to be charged to the patron when it places an article request.
1238 A I<library_id> can be passed as parameter, falling back to userenv if absent.
1242 sub article_request_fee {
1243 my ($self, $params) = @_;
1245 my $library_id = $params->{library_id};
1247 $library_id //= C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef;
1249 my $rule = Koha::CirculationRules->get_effective_rule(
1251 branchcode => $library_id,
1252 categorycode => $self->categorycode,
1253 rule_name => 'article_request_fee'
1257 my $fee = ($rule) ? $rule->rule_value + 0 : 0;
1262 =head3 add_article_request_fee_if_needed
1264 my $fee = $patron->add_article_request_fee_if_needed(
1266 [ item_id => $item->id,
1267 library_id => $library->id, ]
1271 If an article request fee needs to be charged, it adds a debit to the patron's
1274 Returns the fee line.
1276 A I<library_id> can be passed as parameter, falling back to userenv if absent.
1280 sub add_article_request_fee_if_needed {
1281 my ($self, $params) = @_;
1283 my $library_id = $params->{library_id};
1284 my $item_id = $params->{item_id};
1286 $library_id //= C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef;
1288 my $amount = $self->article_request_fee(
1290 library_id => $library_id,
1296 if ( $amount > 0 ) {
1297 $debit_line = $self->account->add_debit(
1300 user_id => C4::Context->userenv ? C4::Context->userenv->{'number'} : undef,
1301 interface => C4::Context->interface,
1302 library_id => $library_id,
1303 type => 'ARTICLE_REQUEST',
1304 item_id => $item_id,
1312 =head3 article_requests
1314 my $article_requests = $patron->article_requests;
1316 Returns the patron article requests.
1320 sub article_requests {
1323 return Koha::ArticleRequests->_new_from_dbic( scalar $self->_result->article_requests );
1326 =head3 add_enrolment_fee_if_needed
1328 my $enrolment_fee = $patron->add_enrolment_fee_if_needed($renewal);
1330 Add enrolment fee for a patron if needed.
1332 $renewal - boolean denoting whether this is an account renewal or not
1336 sub add_enrolment_fee_if_needed {
1337 my ($self, $renewal) = @_;
1338 my $enrolment_fee = $self->category->enrolmentfee;
1339 if ( $enrolment_fee && $enrolment_fee > 0 ) {
1340 my $type = $renewal ? 'ACCOUNT_RENEW' : 'ACCOUNT';
1341 $self->account->add_debit(
1343 amount => $enrolment_fee,
1344 user_id => C4::Context->userenv ? C4::Context->userenv->{'number'} : undef,
1345 interface => C4::Context->interface,
1346 library_id => C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef,
1351 return $enrolment_fee || 0;
1356 my $checkouts = $patron->checkouts
1362 my $checkouts = $self->_result->issues;
1363 return Koha::Checkouts->_new_from_dbic( $checkouts );
1366 =head3 pending_checkouts
1368 my $pending_checkouts = $patron->pending_checkouts
1370 This method will return the same as $self->checkouts, but with a prefetch on
1371 items, biblio and biblioitems.
1373 It has been introduced to replaced the C4::Members::GetPendingIssues subroutine
1375 It should not be used directly, prefer to access fields you need instead of
1376 retrieving all these fields in one go.
1380 sub pending_checkouts {
1382 my $checkouts = $self->_result->issues->search(
1386 { -desc => 'me.timestamp' },
1387 { -desc => 'issuedate' },
1388 { -desc => 'issue_id' }, # Sort by issue_id should be enough
1390 prefetch => { item => { biblio => 'biblioitems' } },
1393 return Koha::Checkouts->_new_from_dbic( $checkouts );
1396 =head3 old_checkouts
1398 my $old_checkouts = $patron->old_checkouts
1404 my $old_checkouts = $self->_result->old_issues;
1405 return Koha::Old::Checkouts->_new_from_dbic( $old_checkouts );
1410 my $overdue_items = $patron->overdues
1412 Return the overdue items
1418 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
1419 return $self->checkouts->search(
1421 'me.date_due' => { '<' => $dtf->format_datetime(dt_from_string) },
1424 prefetch => { item => { biblio => 'biblioitems' } },
1432 my $restrictions = $patron->restrictions;
1434 Returns the patron restrictions.
1440 my $restrictions_rs = $self->_result->restrictions;
1441 return Koha::Patron::Restrictions->_new_from_dbic($restrictions_rs);
1444 =head3 get_routing_lists
1446 my $routinglists = $patron->get_routing_lists
1448 Returns the routing lists a patron is subscribed to.
1452 sub get_routing_lists {
1454 my $routing_list_rs = $self->_result->subscriptionroutinglists;
1455 return Koha::Subscription::Routinglists->_new_from_dbic($routing_list_rs);
1460 my $age = $patron->get_age
1462 Return the age of the patron
1469 return unless $self->dateofbirth;
1471 #Set timezone to floating to avoid any datetime math issues caused by DST
1472 my $date_of_birth = dt_from_string( $self->dateofbirth, undef, 'floating' );
1473 my $today = dt_from_string(undef, undef, 'floating')->truncate( to => 'day' );
1475 return $today->subtract_datetime( $date_of_birth )->years;
1480 my $is_valid = $patron->is_valid_age
1482 Return 1 if patron's age is between allowed limits, returns 0 if it's not.
1488 my $age = $self->get_age;
1490 my $patroncategory = $self->category;
1491 my ($low,$high) = ($patroncategory->dateofbirthrequired, $patroncategory->upperagelimit);
1493 return (defined($age) && (($high && ($age > $high)) or ($low && ($age < $low)))) ? 0 : 1;
1498 my $account = $patron->account
1504 return Koha::Account->new( { patron_id => $self->borrowernumber } );
1509 my $holds = $patron->holds
1511 Return all the holds placed by this patron
1517 my $holds_rs = $self->_result->reserves->search( {}, { order_by => 'reservedate' } );
1518 return Koha::Holds->_new_from_dbic($holds_rs);
1523 my $old_holds = $patron->old_holds
1525 Return all the historical holds for this patron
1531 my $old_holds_rs = $self->_result->old_reserves->search( {}, { order_by => 'reservedate' } );
1532 return Koha::Old::Holds->_new_from_dbic($old_holds_rs);
1535 =head3 curbside_pickups
1537 my $curbside_pickups = $patron->curbside_pickups;
1539 Return all the curbside pickups for this patron
1543 sub curbside_pickups {
1545 my $curbside_pickups_rs = $self->_result->curbside_pickups_borrowernumbers->search;
1546 return Koha::CurbsidePickups->_new_from_dbic($curbside_pickups_rs);
1549 =head3 return_claims
1551 my $return_claims = $patron->return_claims
1557 my $return_claims = $self->_result->return_claims_borrowernumbers;
1558 return Koha::Checkouts::ReturnClaims->_new_from_dbic( $return_claims );
1561 =head3 notice_email_address
1563 my $email = $patron->notice_email_address;
1565 Return the email address of patron used for notices.
1566 Returns the empty string if no email address.
1570 sub notice_email_address{
1573 my $which_address = C4::Context->preference("EmailFieldPrimary");
1574 # if syspref is set to 'first valid' (value == OFF), look up email address
1575 if ( $which_address eq 'OFF' ) {
1576 return $self->first_valid_email_address;
1579 return $self->$which_address || '';
1582 =head3 first_valid_email_address
1584 my $first_valid_email_address = $patron->first_valid_email_address
1586 Return the first valid email address for a patron.
1587 For now, the order is defined as email, emailpro, B_email.
1588 Returns the empty string if the borrower has no email addresses.
1592 sub first_valid_email_address {
1597 my @fields = split /\s*\|\s*/,
1598 C4::Context->preference('EmailFieldPrecedence');
1599 for my $field (@fields) {
1600 $email = $self->$field;
1607 =head3 get_club_enrollments
1611 sub get_club_enrollments {
1614 return Koha::Club::Enrollments->search( { borrowernumber => $self->borrowernumber(), date_canceled => undef } );
1617 =head3 get_enrollable_clubs
1621 sub get_enrollable_clubs {
1622 my ( $self, $is_enrollable_from_opac ) = @_;
1625 $params->{is_enrollable_from_opac} = $is_enrollable_from_opac
1626 if $is_enrollable_from_opac;
1627 $params->{is_email_required} = 0 unless $self->first_valid_email_address();
1629 $params->{borrower} = $self;
1631 return Koha::Clubs->get_enrollable($params);
1634 =head3 account_locked
1636 my $is_locked = $patron->account_locked
1638 Return true if the patron has reached the maximum number of login attempts
1639 (see pref FailedLoginAttempts). If login_attempts is < 0, this is interpreted
1640 as an administrative lockout (independent of FailedLoginAttempts; see also
1641 Koha::Patron->lock).
1642 Otherwise return false.
1643 If the pref is not set (empty string, null or 0), the feature is considered as
1648 sub account_locked {
1650 my $FailedLoginAttempts = C4::Context->preference('FailedLoginAttempts');
1651 return 1 if $FailedLoginAttempts
1652 and $self->login_attempts
1653 and $self->login_attempts >= $FailedLoginAttempts;
1654 return 1 if ($self->login_attempts || 0) < 0; # administrative lockout
1658 =head3 can_see_patron_infos
1660 my $can_see = $patron->can_see_patron_infos( $patron );
1662 Return true if the patron (usually the logged in user) can see the patron's infos for a given patron
1666 sub can_see_patron_infos {
1667 my ( $self, $patron ) = @_;
1668 return unless $patron;
1669 return $self->can_see_patrons_from( $patron->branchcode );
1672 =head3 can_see_patrons_from
1674 my $can_see = $patron->can_see_patrons_from( $branchcode );
1676 Return true if the patron (usually the logged in user) can see the patron's infos from a given library
1680 sub can_see_patrons_from {
1681 my ( $self, $branchcode ) = @_;
1683 return $self->can_see_things_from(
1685 branchcode => $branchcode,
1686 permission => 'borrowers',
1687 subpermission => 'view_borrower_infos_from_any_libraries',
1692 =head3 can_edit_items_from
1694 my $can_edit = $patron->can_edit_items_from( $branchcode );
1696 Return true if the I<Koha::Patron> can edit items from the given branchcode
1700 sub can_edit_items_from {
1701 my ( $self, $branchcode ) = @_;
1703 return 1 if C4::Context->IsSuperLibrarian();
1705 my $userenv = C4::Context->userenv();
1706 if ( $userenv && C4::Context->preference('IndependentBranches') ) {
1707 return $userenv->{branch} eq $branchcode;
1710 return $self->can_see_things_from(
1712 branchcode => $branchcode,
1713 permission => 'editcatalogue',
1714 subpermission => 'edit_any_item',
1719 =head3 libraries_where_can_edit_items
1721 my $libraries = $patron->libraries_where_can_edit_items;
1723 Return the list of branchcodes(!) of libraries the patron is allowed to items for.
1724 The branchcodes are arbitrarily returned sorted.
1725 We are supposing here that the object is related to the logged in patron (use of C4::Context::only_my_library)
1727 An empty array means no restriction, the user can edit any item.
1731 sub libraries_where_can_edit_items {
1734 return $self->libraries_where_can_see_things(
1736 permission => 'editcatalogue',
1737 subpermission => 'edit_any_item',
1738 group_feature => 'ft_limit_item_editing',
1743 =head3 libraries_where_can_see_patrons
1745 my $libraries = $patron->libraries_where_can_see_patrons;
1747 Return the list of branchcodes(!) of libraries the patron is allowed to see other patron's infos.
1748 The branchcodes are arbitrarily returned sorted.
1749 We are supposing here that the object is related to the logged in patron (use of C4::Context::only_my_library)
1751 An empty array means no restriction, the patron can see patron's infos from any libraries.
1755 sub libraries_where_can_see_patrons {
1758 return $self->libraries_where_can_see_things(
1760 permission => 'borrowers',
1761 subpermission => 'view_borrower_infos_from_any_libraries',
1762 group_feature => 'ft_hide_patron_info',
1767 =head3 can_see_things_from
1769 my $can_see = $patron->can_see_things_from( $branchcode );
1771 Return true if the I<Koha::Patron> can perform some action on the given thing
1775 sub can_see_things_from {
1776 my ( $self, $params ) = @_;
1778 my $branchcode = $params->{branchcode};
1779 my $permission = $params->{permission};
1780 my $subpermission = $params->{subpermission};
1782 return 1 if C4::Context->IsSuperLibrarian();
1785 if ( $self->branchcode eq $branchcode ) {
1787 } elsif ( $self->has_permission( { $permission => $subpermission } ) ) {
1789 } elsif ( my $library_groups = $self->library->library_groups ) {
1790 while ( my $library_group = $library_groups->next ) {
1791 if ( $library_group->parent->has_child( $branchcode ) ) {
1802 my $can_log_into = $patron->can_log_into( $library );
1804 Given a I<Koha::Library> object, it returns a boolean representing
1805 the fact the patron can log into a the library.
1810 my ( $self, $library ) = @_;
1814 if ( C4::Context->preference('IndependentBranches') ) {
1816 if $self->is_superlibrarian
1817 or $self->branchcode eq $library->id;
1827 =head3 libraries_where_can_see_things
1829 my $libraries = $patron->libraries_where_can_see_things;
1831 Returns a list of libraries where an aribitarary action is allowed to be taken by the logged in librarian
1832 against an object based on some branchcode related to the object ( patron branchcode, item homebranch, etc ).
1834 We are supposing here that the object is related to the logged in librarian (use of C4::Context::only_my_library)
1836 An empty array means no restriction, the thing can see thing's infos from any libraries.
1840 sub libraries_where_can_see_things {
1841 my ( $self, $params ) = @_;
1842 my $permission = $params->{permission};
1843 my $subpermission = $params->{subpermission};
1844 my $group_feature = $params->{group_feature};
1846 my $userenv = C4::Context->userenv;
1848 return () unless $userenv; # For tests, but userenv should be defined in tests...
1850 my @restricted_branchcodes;
1851 if (C4::Context::only_my_library) {
1852 push @restricted_branchcodes, $self->branchcode;
1856 $self->has_permission(
1857 { $permission => $subpermission }
1861 my $library_groups = $self->library->library_groups({ $group_feature => 1 });
1862 if ( $library_groups->count )
1864 while ( my $library_group = $library_groups->next ) {
1865 my $parent = $library_group->parent;
1866 if ( $parent->has_child( $self->branchcode ) ) {
1867 push @restricted_branchcodes, $parent->children->get_column('branchcode');
1872 @restricted_branchcodes = ( $self->branchcode ) unless @restricted_branchcodes;
1876 @restricted_branchcodes = grep { defined $_ } @restricted_branchcodes;
1877 @restricted_branchcodes = uniq(@restricted_branchcodes);
1878 @restricted_branchcodes = sort(@restricted_branchcodes);
1879 return @restricted_branchcodes;
1882 =head3 has_permission
1884 my $permission = $patron->has_permission($required);
1886 See C4::Auth::haspermission for details of syntax for $required
1890 sub has_permission {
1891 my ( $self, $flagsrequired ) = @_;
1892 return unless $self->userid;
1893 # TODO code from haspermission needs to be moved here!
1894 return C4::Auth::haspermission( $self->userid, $flagsrequired );
1897 =head3 is_superlibrarian
1899 my $is_superlibrarian = $patron->is_superlibrarian;
1901 Return true if the patron is a superlibrarian.
1905 sub is_superlibrarian {
1907 return $self->has_permission( { superlibrarian => 1 } ) ? 1 : 0;
1912 my $is_adult = $patron->is_adult
1914 Return true if the patron has a category with a type Adult (A) or Organization (I)
1920 return $self->category->category_type =~ /^(A|I)$/ ? 1 : 0;
1925 my $is_child = $patron->is_child
1927 Return true if the patron has a category with a type Child (C)
1933 return $self->category->category_type eq 'C' ? 1 : 0;
1936 =head3 has_valid_userid
1938 my $patron = Koha::Patrons->find(42);
1939 $patron->userid( $new_userid );
1940 my $has_a_valid_userid = $patron->has_valid_userid
1942 my $patron = Koha::Patron->new( $params );
1943 my $has_a_valid_userid = $patron->has_valid_userid
1945 Return true if the current userid of this patron is valid/unique, otherwise false.
1947 Note that this should be done in $self->store instead and raise an exception if needed.
1951 sub has_valid_userid {
1954 return 0 unless $self->userid;
1956 return 0 if ( $self->userid eq C4::Context->config('user') ); # DB user
1958 my $already_exists = Koha::Patrons->search(
1960 userid => $self->userid,
1963 ? ( borrowernumber => { '!=' => $self->borrowernumber } )
1968 return $already_exists ? 0 : 1;
1971 =head3 generate_userid
1973 $patron->generate_userid;
1975 If you do not have a plugin for generating a userid, we will call
1976 the internal method here that returns firstname.surname[.number],
1977 where number is an optional suffix to make the userid unique.
1978 (Its behavior has not been changed on bug 32426.)
1980 If you have plugin(s), the first valid response will be used.
1981 A plugin is assumed to return a valid userid as suggestion, but not
1982 assumed to save it already.
1983 Does not fallback to internal (you could arrange for that in your plugin).
1984 Clears userid when there are no valid plugin responses.
1988 sub generate_userid {
1990 my @responses = Koha::Plugins->call(
1991 'patron_generate_userid', { patron => $self },
1993 unless( @responses ) {
1994 # Empty list only possible when there are NO enabled plugins for this method.
1995 # In that case we provide internal response.
1996 return $self->_generate_userid_internal;
1998 # If a plugin returned false value or invalid value, we do however not return
1999 # internal response. The plugins should deal with that themselves. So we prevent
2000 # unexpected/unwelcome internal codes for plugin failures.
2001 foreach my $response ( grep { $_ } @responses ) {
2002 $self->userid( $response );
2003 return $self if $self->has_valid_userid;
2005 $self->userid(undef);
2009 sub _generate_userid_internal { # as we always did
2012 my $firstname = $self->firstname // q{};
2013 my $surname = $self->surname // q{};
2014 #The script will "do" the following code and increment the $offset until the generated userid is unique
2016 $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
2017 $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
2018 my $userid = lc(($firstname)? "$firstname.$surname" : $surname);
2019 $userid = NFKD( $userid );
2020 $userid =~ s/\p{NonspacingMark}//g;
2021 $userid .= $offset unless $offset == 0;
2022 $self->userid( $userid );
2024 } while (! $self->has_valid_userid );
2029 =head3 add_extended_attribute
2033 sub add_extended_attribute {
2034 my ($self, $attribute) = @_;
2036 return Koha::Patron::Attribute->new(
2039 ( borrowernumber => $self->borrowernumber ),
2045 =head3 extended_attributes
2047 Return object of Koha::Patron::Attributes type with all attributes set for this patron
2053 sub extended_attributes {
2054 my ( $self, $attributes ) = @_;
2055 if ($attributes) { # setter
2056 my $schema = $self->_result->result_source->schema;
2059 # Remove the existing one
2060 $self->extended_attributes->filter_by_branch_limitations->delete;
2062 # Insert the new ones
2064 for my $attribute (@$attributes) {
2065 $self->add_extended_attribute($attribute);
2066 $new_types->{$attribute->{code}} = 1;
2069 # Check globally mandatory types
2070 my @required_attribute_types =
2071 Koha::Patron::Attribute::Types->search(
2074 category_code => [ undef, $self->categorycode ],
2075 'borrower_attribute_types_branches.b_branchcode' =>
2078 { join => 'borrower_attribute_types_branches' }
2079 )->get_column('code');
2080 for my $type ( @required_attribute_types ) {
2081 Koha::Exceptions::Patron::MissingMandatoryExtendedAttribute->throw(
2083 ) if !$new_types->{$type};
2089 my $rs = $self->_result->borrower_attributes;
2090 # We call search to use the filters in Koha::Patron::Attributes->search
2091 return Koha::Patron::Attributes->_new_from_dbic($rs)->search;
2096 my $messages = $patron->messages;
2098 Return the message attached to the patron.
2104 my $messages_rs = $self->_result->messages_borrowernumbers->search;
2105 return Koha::Patron::Messages->_new_from_dbic($messages_rs);
2110 Koha::Patrons->find($id)->lock({ expire => 1, remove => 1 });
2112 Lock and optionally expire a patron account.
2113 Remove holds and article requests if remove flag set.
2114 In order to distinguish from locking by entering a wrong password, let's
2115 call this an administrative lockout.
2120 my ( $self, $params ) = @_;
2121 $self->login_attempts( ADMINISTRATIVE_LOCKOUT );
2122 if( $params->{expire} ) {
2123 $self->dateexpiry( dt_from_string->subtract(days => 1) );
2126 if( $params->{remove} ) {
2127 $self->holds->delete;
2128 $self->article_requests->delete;
2135 Koha::Patrons->find($id)->anonymize;
2137 Anonymize or clear borrower fields. Fields in BorrowerMandatoryField
2138 are randomized, other personal data is cleared too.
2139 Patrons with issues are skipped.
2145 if( $self->_result->issues->count ) {
2146 warn "Exiting anonymize: patron ".$self->borrowernumber." still has issues";
2149 # Mandatory fields come from the corresponding pref, but email fields
2150 # are removed since scrambled email addresses only generate errors
2151 my $mandatory = { map { (lc $_, 1); } grep { !/email/ }
2152 split /\s*\|\s*/, C4::Context->preference('BorrowerMandatoryField') };
2153 $mandatory->{userid} = 1; # needed since sub store does not clear field
2154 my @columns = $self->_result->result_source->columns;
2155 @columns = grep { !/borrowernumber|branchcode|categorycode|^date|password|flags|updated_on|lastseen|lang|login_attempts|anonymized|auth_method/ } @columns;
2156 push @columns, 'dateofbirth'; # add this date back in
2157 foreach my $col (@columns) {
2158 $self->_anonymize_column($col, $mandatory->{lc $col} );
2160 $self->anonymized(1)->store;
2163 sub _anonymize_column {
2164 my ( $self, $col, $mandatory ) = @_;
2165 my $col_info = $self->_result->result_source->column_info($col);
2166 my $type = $col_info->{data_type};
2167 my $nullable = $col_info->{is_nullable};
2169 if( $type =~ /char|text/ ) {
2171 ? Koha::Token->new->generate({ pattern => '\w{10}' })
2175 } elsif( $type =~ /integer|int$|float|dec|double/ ) {
2176 $val = $nullable ? undef : 0;
2177 } elsif( $type =~ /date|time/ ) {
2178 $val = $nullable ? undef : dt_from_string;
2183 =head3 add_guarantor
2185 my $relationship = $patron->add_guarantor(
2187 borrowernumber => $borrowernumber,
2188 relationships => $relationship,
2192 Adds a new guarantor to a patron.
2197 my ( $self, $params ) = @_;
2199 my $guarantor_id = $params->{guarantor_id};
2200 my $relationship = $params->{relationship};
2202 return Koha::Patron::Relationship->new(
2204 guarantee_id => $self->id,
2205 guarantor_id => $guarantor_id,
2206 relationship => $relationship
2211 =head3 get_extended_attribute
2213 my $attribute_value = $patron->get_extended_attribute( $code );
2215 Return the attribute for the code passed in parameter.
2217 It not exist it returns undef
2219 Note that this will not work for repeatable attribute types.
2221 Maybe you certainly not want to use this method, it is actually only used for SHOW_BARCODE
2222 (which should be a real patron's attribute (not extended)
2226 sub get_extended_attribute {
2227 my ( $self, $code, $value ) = @_;
2228 my $rs = $self->_result->borrower_attributes;
2230 my $attribute = $rs->search({ code => $code, ( $value ? ( attribute => $value ) : () ) });
2231 return unless $attribute->count;
2232 return $attribute->next;
2235 =head3 set_default_messaging_preferences
2237 $patron->set_default_messaging_preferences
2239 Sets default messaging preferences on patron.
2241 See Koha::Patron::MessagePreference(s) for more documentation, especially on
2246 sub set_default_messaging_preferences {
2247 my ($self, $categorycode) = @_;
2249 my $options = Koha::Patron::MessagePreferences->get_options;
2251 foreach my $option (@$options) {
2252 # Check that this option has preference configuration for this category
2253 unless (Koha::Patron::MessagePreferences->search({
2254 message_attribute_id => $option->{message_attribute_id},
2255 categorycode => $categorycode || $self->categorycode,
2260 # Delete current setting
2261 Koha::Patron::MessagePreferences->search({
2262 borrowernumber => $self->borrowernumber,
2263 message_attribute_id => $option->{message_attribute_id},
2266 Koha::Patron::MessagePreference->new_from_default({
2267 borrowernumber => $self->borrowernumber,
2268 categorycode => $categorycode || $self->categorycode,
2269 message_attribute_id => $option->{message_attribute_id},
2278 my $json = $patron->to_api;
2280 Overloaded method that returns a JSON representation of the Koha::Patron object,
2281 suitable for API output.
2286 my ( $self, $params ) = @_;
2288 my $json_patron = $self->SUPER::to_api( $params );
2290 $json_patron->{restricted} = ( $self->is_debarred )
2292 : Mojo::JSON->false;
2294 return $json_patron;
2297 =head3 to_api_mapping
2299 This method returns the mapping for representing a Koha::Patron object
2304 sub to_api_mapping {
2306 borrowernotes => 'staff_notes',
2307 borrowernumber => 'patron_id',
2308 branchcode => 'library_id',
2309 categorycode => 'category_id',
2310 checkprevcheckout => 'check_previous_checkout',
2311 contactfirstname => undef, # Unused
2312 contactname => undef, # Unused
2313 contactnote => 'altaddress_notes',
2314 contacttitle => undef, # Unused
2315 dateenrolled => 'date_enrolled',
2316 dateexpiry => 'expiry_date',
2317 dateofbirth => 'date_of_birth',
2318 debarred => undef, # replaced by 'restricted'
2319 debarredcomment => undef, # calculated, API consumers will use /restrictions instead
2320 emailpro => 'secondary_email',
2321 flags => undef, # permissions manipulation handled in /permissions
2322 gonenoaddress => 'incorrect_address',
2323 lastseen => 'last_seen',
2324 lost => 'patron_card_lost',
2325 opacnote => 'opac_notes',
2326 othernames => 'other_name',
2327 password => undef, # password manipulation handled in /password
2328 phonepro => 'secondary_phone',
2329 relationship => 'relationship_type',
2331 smsalertnumber => 'sms_number',
2332 sort1 => 'statistics_1',
2333 sort2 => 'statistics_2',
2334 autorenew_checkouts => 'autorenew_checkouts',
2335 streetnumber => 'street_number',
2336 streettype => 'street_type',
2337 zipcode => 'postal_code',
2338 B_address => 'altaddress_address',
2339 B_address2 => 'altaddress_address2',
2340 B_city => 'altaddress_city',
2341 B_country => 'altaddress_country',
2342 B_email => 'altaddress_email',
2343 B_phone => 'altaddress_phone',
2344 B_state => 'altaddress_state',
2345 B_streetnumber => 'altaddress_street_number',
2346 B_streettype => 'altaddress_street_type',
2347 B_zipcode => 'altaddress_postal_code',
2348 altcontactaddress1 => 'altcontact_address',
2349 altcontactaddress2 => 'altcontact_address2',
2350 altcontactaddress3 => 'altcontact_city',
2351 altcontactcountry => 'altcontact_country',
2352 altcontactfirstname => 'altcontact_firstname',
2353 altcontactphone => 'altcontact_phone',
2354 altcontactsurname => 'altcontact_surname',
2355 altcontactstate => 'altcontact_state',
2356 altcontactzipcode => 'altcontact_postal_code',
2357 password_expiration_date => undef,
2358 primary_contact_method => undef,
2360 auth_method => undef,
2366 Koha::Patrons->queue_notice({ letter_params => $letter_params, message_name => 'DUE'});
2367 Koha::Patrons->queue_notice({ letter_params => $letter_params, message_transports => \@message_transports });
2368 Koha::Patrons->queue_notice({ letter_params => $letter_params, message_transports => \@message_transports, test_mode => 1 });
2370 Queue messages to a patron. Can pass a message that is part of the message_attributes
2371 table or supply the transport to use.
2373 If passed a message name we retrieve the patrons preferences for transports
2374 Otherwise we use the supplied transport. In the case of email or sms we fall back to print if
2375 we have no address/number for sending
2377 $letter_params is a hashref of the values to be passed to GetPreparedLetter
2379 test_mode will only report which notices would be sent, but nothing will be queued
2384 my ( $self, $params ) = @_;
2385 my $letter_params = $params->{letter_params};
2386 my $test_mode = $params->{test_mode};
2388 return unless $letter_params;
2389 return unless exists $params->{message_name} xor $params->{message_transports}; # We only want one of these
2391 my $library = Koha::Libraries->find( $letter_params->{branchcode} );
2392 my $from_email_address = $library->from_email_address;
2394 my @message_transports;
2396 $letter_code = $letter_params->{letter_code};
2397 if( $params->{message_name} ){
2398 my $messaging_prefs = C4::Members::Messaging::GetMessagingPreferences( {
2399 borrowernumber => $letter_params->{borrowernumber},
2400 message_name => $params->{message_name}
2402 @message_transports = ( keys %{ $messaging_prefs->{transports} } );
2403 $letter_code = $messaging_prefs->{transports}->{$message_transports[0]} unless $letter_code;
2405 @message_transports = @{$params->{message_transports}};
2407 return unless defined $letter_code;
2408 $letter_params->{letter_code} = $letter_code;
2411 foreach my $mtt (@message_transports){
2412 next if ($mtt eq 'itiva' and C4::Context->preference('TalkingTechItivaPhoneNotification') );
2413 # Notice is handled by TalkingTech_itiva_outbound.pl
2414 if ( ( $mtt eq 'email' and not $self->notice_email_address )
2415 or ( $mtt eq 'sms' and not $self->smsalertnumber )
2416 or ( $mtt eq 'phone' and not $self->phone ) )
2418 push @{ $return{fallback} }, $mtt;
2421 next if $mtt eq 'print' && $print_sent;
2422 $letter_params->{message_transport_type} = $mtt;
2423 my $letter = C4::Letters::GetPreparedLetter( %$letter_params );
2424 C4::Letters::EnqueueLetter({
2426 borrowernumber => $self->borrowernumber,
2427 from_address => $from_email_address,
2428 message_transport_type => $mtt
2429 }) unless $test_mode;
2430 push @{$return{sent}}, $mtt;
2431 $print_sent = 1 if $mtt eq 'print';
2436 =head3 safe_to_delete
2438 my $result = $patron->safe_to_delete;
2439 if ( $result eq 'has_guarantees' ) { ... }
2440 elsif ( $result ) { ... }
2441 else { # cannot delete }
2443 This method tells if the Koha:Patron object can be deleted. Possible return values
2449 =item 'has_checkouts'
2453 =item 'has_guarantees'
2455 =item 'is_anonymous_patron'
2461 sub safe_to_delete {
2464 my $anonymous_patron = C4::Context->preference('AnonymousPatron');
2468 if ( $anonymous_patron && $self->id eq $anonymous_patron ) {
2469 $error = 'is_anonymous_patron';
2471 elsif ( $self->checkouts->count ) {
2472 $error = 'has_checkouts';
2474 elsif ( $self->account->outstanding_debits->total_outstanding > 0 ) {
2475 $error = 'has_debt';
2477 elsif ( $self->guarantee_relationships->count ) {
2478 $error = 'has_guarantees';
2482 return Koha::Result::Boolean->new(0)->add_message({ message => $error });
2485 return Koha::Result::Boolean->new(1);
2490 my $recalls = $patron->recalls;
2492 Return the patron's recalls.
2499 return Koha::Recalls->search({ patron_id => $self->borrowernumber });
2502 =head3 account_balance
2504 my $balance = $patron->account_balance
2506 Return the patron's account balance
2510 sub account_balance {
2512 return $self->account->balance;
2515 =head3 notify_library_of_registration
2517 $patron->notify_library_of_registration( $email_patron_registrations );
2519 Send patron registration email to library if EmailPatronRegistrations system preference is enabled.
2523 sub notify_library_of_registration {
2524 my ( $self, $email_patron_registrations ) = @_;
2527 my $letter = C4::Letters::GetPreparedLetter(
2528 module => 'members',
2529 letter_code => 'OPAC_REG',
2530 branchcode => $self->branchcode,
2531 lang => $self->lang || 'default',
2533 'borrowers' => $self->borrowernumber
2538 if ( $email_patron_registrations eq "BranchEmailAddress" ) {
2539 my $library = Koha::Libraries->find( $self->branchcode );
2540 $to_address = $library->inbound_email_address;
2542 elsif ( $email_patron_registrations eq "KohaAdminEmailAddress" ) {
2543 $to_address = C4::Context->preference('ReplytoDefault')
2544 || C4::Context->preference('KohaAdminEmailAddress');
2548 C4::Context->preference('EmailAddressForPatronRegistrations')
2549 || C4::Context->preference('ReplytoDefault')
2550 || C4::Context->preference('KohaAdminEmailAddress');
2553 my $message_id = C4::Letters::EnqueueLetter(
2556 borrowernumber => $self->borrowernumber,
2557 to_address => $to_address,
2558 message_transport_type => 'email'
2560 ) or warn "can't enqueue letter $letter";
2561 if ( $message_id ) {
2567 =head3 has_messaging_preference
2569 my $bool = $patron->has_messaging_preference({
2570 message_name => $message_name, # A value from message_attributes.message_name
2571 message_transport_type => $message_transport_type, # email, sms, phone, itiva, etc...
2572 wants_digest => $wants_digest, # 1 if you are looking for the digest version, don't pass if you just want either
2577 sub has_messaging_preference {
2578 my ( $self, $params ) = @_;
2580 my $message_name = $params->{message_name};
2581 my $message_transport_type = $params->{message_transport_type};
2582 my $wants_digest = $params->{wants_digest};
2584 return $self->_result->search_related_rs(
2585 'borrower_message_preferences',
2589 [ 'borrower_message_transport_preferences', 'message_attribute' ]
2594 =head3 can_patron_change_staff_only_lists
2596 $patron->can_patron_change_staff_only_lists;
2598 Return 1 if a patron has 'Superlibrarian' or 'Catalogue' permission.
2599 Otherwise, return 0.
2603 sub can_patron_change_staff_only_lists {
2604 my ( $self, $params ) = @_;
2605 return 1 if C4::Auth::haspermission( $self->userid, { 'catalogue' => 1 });
2609 =head3 can_patron_change_permitted_staff_lists
2611 $patron->can_patron_change_permitted_staff_lists;
2613 Return 1 if a patron has 'Superlibrarian' or 'Catalogue' and 'edit_public_list_contents' permissions.
2614 Otherwise, return 0.
2618 sub can_patron_change_permitted_staff_lists {
2619 my ( $self, $params ) = @_;
2620 return 1 if C4::Auth::haspermission( $self->userid, { 'catalogue' => 1, lists => 'edit_public_list_contents' } );
2624 =head3 encode_secret
2626 $patron->encode_secret($secret32);
2628 Secret (TwoFactorAuth expects it in base32 format) is encrypted.
2629 You still need to call ->store.
2634 my ( $self, $secret ) = @_;
2636 return $self->secret( Koha::Encryption->new->encrypt_hex($secret) );
2638 return $self->secret($secret);
2641 =head3 decoded_secret
2643 my $secret32 = $patron->decoded_secret;
2645 Decode the patron secret. We expect to get back a base32 string, but this
2646 is not checked here. Caller of encode_secret is responsible for that.
2650 sub decoded_secret {
2652 if( $self->secret ) {
2653 return Koha::Encryption->new->decrypt_hex( $self->secret );
2655 return $self->secret;
2658 =head3 virtualshelves
2660 my $shelves = $patron->virtualshelves;
2664 sub virtualshelves {
2666 return Koha::Virtualshelves->_new_from_dbic( scalar $self->_result->virtualshelves );
2671 my $savings = $patron->get_savings;
2673 Use the replacement price of patron's old and current issues to calculate how much they have 'saved' by using the library.
2680 my @itemnumbers = grep { defined $_ } ( $self->old_checkouts->get_column('itemnumber'), $self->checkouts->get_column('itemnumber') );
2682 return Koha::Items->search(
2683 { itemnumber => { -in => \@itemnumbers } },
2684 { select => [ { sum => 'me.replacementprice' } ],
2685 as => ['total_savings']
2687 )->next->get_column('total_savings') // 0;
2690 =head3 alert_subscriptions
2692 my $subscriptions = $patron->alert_subscriptions;
2694 Return a Koha::Subscriptions object containing subscriptions for which the patron has subscribed to email alerts.
2698 sub alert_subscriptions {
2701 my @alerts = $self->_result->alerts;
2702 my @subscription_ids = map { $_->externalid } @alerts;
2704 return Koha::Subscriptions->search( { subscriptionid => \@subscription_ids } );
2707 =head2 Internal methods
2719 Kyle M Hall <kyle@bywatersolutions.com>
2720 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
2721 Martin Renvoize <martin.renvoize@ptfs-europe.com>