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 );
35 use Koha::ArticleRequests;
39 use Koha::CirculationRules;
40 use Koha::Club::Enrollments;
41 use Koha::CurbsidePickups;
43 use Koha::DateUtils qw( dt_from_string );
46 use Koha::Exceptions::Password;
48 use Koha::Old::Checkouts;
49 use Koha::OverdueRules;
50 use Koha::Patron::Attributes;
51 use Koha::Patron::Categories;
52 use Koha::Patron::Consents;
53 use Koha::Patron::Debarments;
54 use Koha::Patron::HouseboundProfile;
55 use Koha::Patron::HouseboundRole;
56 use Koha::Patron::Images;
57 use Koha::Patron::Messages;
58 use Koha::Patron::Modifications;
59 use Koha::Patron::MessagePreferences;
60 use Koha::Patron::Relationships;
61 use Koha::Patron::Restrictions;
65 use Koha::Result::Boolean;
66 use Koha::Subscription::Routinglists;
68 use Koha::Virtualshelves;
70 use base qw(Koha::Object);
72 use constant ADMINISTRATIVE_LOCKOUT => -1;
74 our $RESULTSET_PATRON_ID_MAPPING = {
75 Accountline => 'borrowernumber',
76 Aqbasketuser => 'borrowernumber',
77 Aqbudget => 'budget_owner_id',
78 Aqbudgetborrower => 'borrowernumber',
79 ArticleRequest => 'borrowernumber',
80 BorrowerDebarment => 'borrowernumber',
81 BorrowerFile => 'borrowernumber',
82 BorrowerModification => 'borrowernumber',
83 ClubEnrollment => 'borrowernumber',
84 Issue => 'borrowernumber',
85 ItemsLastBorrower => 'borrowernumber',
86 Linktracker => 'borrowernumber',
87 Message => 'borrowernumber',
88 MessageQueue => 'borrowernumber',
89 OldIssue => 'borrowernumber',
90 OldReserve => 'borrowernumber',
91 Rating => 'borrowernumber',
92 Reserve => 'borrowernumber',
93 Review => 'borrowernumber',
94 SearchHistory => 'userid',
95 Statistic => 'borrowernumber',
96 Suggestion => 'suggestedby',
97 TagAll => 'borrowernumber',
98 Virtualshelfcontent => 'borrowernumber',
99 Virtualshelfshare => 'borrowernumber',
100 Virtualshelve => 'owner',
105 Koha::Patron - Koha Patron Object class
116 my ( $class, $params ) = @_;
118 return $class->SUPER::new($params);
121 =head3 fixup_cardnumber
123 Autogenerate next cardnumber from highest value found in database
127 sub fixup_cardnumber {
130 my $max = $self->cardnumber;
131 Koha::Plugins->call( 'patron_barcode_transform', \$max );
133 $max ||= Koha::Patrons->search({
134 cardnumber => {-regexp => '^-?[0-9]+$'}
136 select => \'CAST(cardnumber AS SIGNED)',
137 as => ['cast_cardnumber']
138 })->_resultset->get_column('cast_cardnumber')->max;
139 $self->cardnumber(($max || 0) +1);
142 =head3 trim_whitespace
144 trim whitespace from data which has some non-whitespace in it.
145 Could be moved to Koha::Object if need to be reused
149 sub trim_whitespaces {
152 my $schema = Koha::Database->new->schema;
153 my @columns = $schema->source($self->_type)->columns;
155 for my $column( @columns ) {
156 my $value = $self->$column;
157 if ( defined $value ) {
158 $value =~ s/^\s*|\s*$//g;
159 $self->$column($value);
165 =head3 plain_text_password
167 $patron->plain_text_password( $password );
169 stores a copy of the unencrypted password in the object
170 for use in code before encrypting for db
174 sub plain_text_password {
175 my ( $self, $password ) = @_;
177 $self->{_plain_text_password} = $password;
180 return $self->{_plain_text_password}
181 if $self->{_plain_text_password};
188 Patron specific store method to cleanup record
189 and do other necessary things before saving
196 my $params = @_ ? shift : {};
198 my $guarantors = $params->{guarantors} // [];
200 $self->_result->result_source->schema->txn_do(
203 C4::Context->preference("autoMemberNum")
204 and ( not defined $self->cardnumber
205 or $self->cardnumber eq '' )
208 # Warning: The caller is responsible for locking the members table in write
209 # mode, to avoid database corruption.
210 # We are in a transaction but the table is not locked
211 $self->fixup_cardnumber;
214 unless ( $self->category->in_storage ) {
215 Koha::Exceptions::Object::FKConstraint->throw(
216 broken_fk => 'categorycode',
217 value => $self->categorycode,
221 $self->trim_whitespaces;
223 my $new_cardnumber = $self->cardnumber;
224 Koha::Plugins->call( 'patron_barcode_transform', \$new_cardnumber );
225 $self->cardnumber($new_cardnumber);
227 # Set surname to uppercase if uppercasesurname is true
228 $self->surname( uc( $self->surname ) )
229 if C4::Context->preference("uppercasesurnames");
231 $self->relationship(undef) # We do not want to store an empty string in this field
232 if defined $self->relationship
233 and $self->relationship eq "";
235 for my $note_field (qw( borrowernotes opacnote )) {
236 if ( !$self->in_storage || $self->_result->is_column_changed($note_field) ) {
237 $self->$note_field( C4::Scrubber->new('note')->scrub( $self->$note_field ) );
241 unless ( $self->in_storage ) { #AddMember
243 # Generate a valid userid/login if needed
244 $self->generate_userid unless $self->userid;
245 Koha::Exceptions::Patron::InvalidUserid->throw( userid => $self->userid )
246 unless $self->has_valid_userid;
248 # Add expiration date if it isn't already there
249 unless ( $self->dateexpiry ) {
250 $self->dateexpiry( $self->category->get_expiry_date );
253 # Add enrollment date if it isn't already there
254 unless ( $self->dateenrolled ) {
255 $self->dateenrolled(dt_from_string);
258 # Set the privacy depending on the patron's category
259 my $default_privacy = $self->category->default_privacy || q{};
261 $default_privacy eq 'default' ? 1
262 : $default_privacy eq 'never' ? 2
263 : $default_privacy eq 'forever' ? 0
265 $self->privacy($default_privacy);
267 # Call any check_password plugins if password is passed
268 if ( C4::Context->config("enable_plugins") && $self->password ) {
269 my @plugins = Koha::Plugins->new()->GetPlugins(
271 method => 'check_password',
274 foreach my $plugin (@plugins) {
276 # This plugin hook will also be used by a plugin for the Norwegian national
277 # patron database. This is why we need to pass both the password and the
278 # borrowernumber to the plugin.
279 my $ret = $plugin->check_password(
281 password => $self->password,
282 borrowernumber => $self->borrowernumber
285 if ( $ret->{'error'} == 1 ) {
286 Koha::Exceptions::Password::Plugin->throw();
291 # Make a copy of the plain text password for later use
292 $self->plain_text_password( $self->password );
294 $self->password_expiration_date(
296 ? $self->category->get_password_expiry_date || undef
300 # Create a disabled account if no password provided
303 ? Koha::AuthUtils::hash_password( $self->password )
307 $self->borrowernumber(undef);
309 if ( C4::Context->preference('ChildNeedsGuarantor')
310 and ( $self->is_child or $self->category->can_be_guarantee )
311 and $self->contactname eq ""
314 Koha::Exceptions::Patron::Relationship::NoGuarantor->throw();
317 foreach my $guarantor (@$guarantors) {
318 if ( $guarantor->is_child or $guarantor->category->can_be_guarantee ) {
319 Koha::Exceptions::Patron::Relationship::InvalidRelationship->throw( invalid_guarantor => 1 );
323 $self = $self->SUPER::store;
325 $self->add_enrolment_fee_if_needed(0);
327 logaction( "MEMBERS", "CREATE", $self->borrowernumber, "" )
328 if C4::Context->preference("BorrowersLog");
331 my $self_from_storage = $self->get_from_storage;
333 # Do not accept invalid userid here
334 $self->generate_userid unless $self->userid;
335 Koha::Exceptions::Patron::InvalidUserid->throw( userid => $self->userid )
336 unless $self->has_valid_userid;
338 # If a borrower has set their privacy to never we should immediately anonymize
340 if ( $self->privacy() == 2 && $self_from_storage->privacy() != 2 ) {
342 $self->old_checkouts->anonymize;
344 Koha::Exceptions::Patron::FailedAnonymizing->throw( error => @_ );
348 # Password must be updated using $self->set_password
349 $self->password( $self_from_storage->password );
351 if ( $self->category->categorycode ne $self_from_storage->category->categorycode ) {
353 # Add enrolement fee on category change if required
354 $self->add_enrolment_fee_if_needed(1)
355 if C4::Context->preference('FeeOnChangePatronCategory');
357 # Clean up guarantors on category change if required
358 $self->guarantor_relationships->delete
359 unless ( $self->category->can_be_guarantee );
363 my @existing_guarantors = $self->guarantor_relationships()->guarantors->as_list;
364 push @$guarantors, @existing_guarantors;
366 if ( C4::Context->preference('ChildNeedsGuarantor')
367 and ( $self->is_child or $self->category->can_be_guarantee )
368 and $self->contactname eq ""
371 Koha::Exceptions::Patron::Relationship::NoGuarantor->throw();
374 foreach my $guarantor (@$guarantors) {
375 if ( $guarantor->is_child or $guarantor->category->can_be_guarantee ) {
376 Koha::Exceptions::Patron::Relationship::InvalidRelationship->throw( invalid_guarantor => 1 );
381 if ( C4::Context->preference("BorrowersLog") ) {
383 my $from_storage = $self_from_storage->unblessed;
384 my $from_object = $self->unblessed;
386 # Object's dateexpiry is a DateTime object which stringifies to iso8601 datetime,
387 # but the column in only a date so we need to convert the datetime to just a date
388 # to know if it has actually changed.
389 $from_object->{dateexpiry} = dt_from_string( $from_object->{dateexpiry} )->ymd
390 if $from_object->{dateexpiry};
392 my @skip_fields = (qw/lastseen updated_on/);
393 for my $key ( keys %{$from_storage} ) {
394 next if any { /$key/ } @skip_fields;
395 my $storage_value = $from_storage->{$key} // q{};
396 my $object_value = $from_object->{$key} // q{};
397 if ( ( $storage_value || $object_value )
398 && ( $storage_value ne $object_value ) )
401 before => $from_storage->{$key},
402 after => $from_object->{$key}
407 if ( defined($info) ) {
411 $self->borrowernumber,
414 { utf8 => 1, pretty => 1, canonical => 1 }
421 $self = $self->SUPER::store;
432 Delete patron's holds, lists and finally the patron.
434 Lists owned by the borrower are deleted or ownership is transferred depending on the
435 ListOwnershipUponPatronDeletion pref, but entries from the borrower to other lists are kept.
442 my $anonymous_patron = C4::Context->preference("AnonymousPatron");
443 Koha::Exceptions::Patron::FailedDeleteAnonymousPatron->throw() if $anonymous_patron && $self->id eq $anonymous_patron;
445 # Check if patron is protected
446 Koha::Exceptions::Patron::FailedDeleteProtectedPatron->throw() if $self->protected == 1;
448 $self->_result->result_source->schema->txn_do(
450 # Cancel Patron's holds
451 my $holds = $self->holds;
452 while( my $hold = $holds->next ){
456 # Handle lists (virtualshelves)
457 $self->virtualshelves->disown_or_delete;
459 # We cannot have a FK on borrower_modifications.borrowernumber, the table is also used
461 $_->delete for Koha::Patron::Modifications->search( { borrowernumber => $self->borrowernumber } )->as_list;
463 $self->SUPER::delete;
465 logaction( "MEMBERS", "DELETE", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog");
473 my $patron_category = $patron->category
475 Return the patron category for this patron
481 return Koha::Patron::Category->_new_from_dbic( $self->_result->categorycode );
491 return Koha::Patron::Images->find( $self->borrowernumber );
496 Returns a Koha::Library object representing the patron's home library.
502 return Koha::Library->_new_from_dbic($self->_result->branchcode);
507 Returns a Koha::SMS::Provider object representing the patron's SMS provider.
513 my $sms_provider_rs = $self->_result->sms_provider;
514 return unless $sms_provider_rs;
515 return Koha::SMS::Provider->_new_from_dbic($sms_provider_rs);
518 =head3 guarantor_relationships
520 Returns Koha::Patron::Relationships object for this patron's guarantors
522 Returns the set of relationships for the patrons that are guarantors for this patron.
524 Note that a guarantor should exist as a patron in Koha; it was not possible
525 to add them without a guarantor_id in the interface for some time. Bug 30472
526 restricts it on db level.
530 sub guarantor_relationships {
533 return Koha::Patron::Relationships->search( { guarantee_id => $self->id } );
536 =head3 guarantee_relationships
538 Returns Koha::Patron::Relationships object for this patron's guarantors
540 Returns the set of relationships for the patrons that are guarantees for this patron.
542 The method returns Koha::Patron::Relationship objects for the sake
543 of consistency with the guantors method.
544 A guarantee by definition must exist as a patron in Koha.
548 sub guarantee_relationships {
551 return Koha::Patron::Relationships->search(
552 { guarantor_id => $self->id },
554 prefetch => 'guarantee',
555 order_by => { -asc => [ 'guarantee.surname', 'guarantee.firstname' ] },
560 =head3 relationships_debt
562 Returns the amount owed by the patron's guarantors *and* the other guarantees of those guarantors
566 sub relationships_debt {
567 my ($self, $params) = @_;
569 my $include_guarantors = $params->{include_guarantors};
570 my $only_this_guarantor = $params->{only_this_guarantor};
571 my $include_this_patron = $params->{include_this_patron};
574 if ( $only_this_guarantor ) {
575 @guarantors = $self->guarantee_relationships->count ? ( $self ) : ();
576 Koha::Exceptions::BadParameter->throw( { parameter => 'only_this_guarantor' } ) unless @guarantors;
577 } elsif ( $self->guarantor_relationships->count ) {
578 # I am a guarantee, just get all my guarantors
579 @guarantors = $self->guarantor_relationships->guarantors->as_list;
581 # I am a guarantor, I need to get all the guarantors of all my guarantees
582 @guarantors = map { $_->guarantor_relationships->guarantors->as_list } $self->guarantee_relationships->guarantees->as_list;
585 my $non_issues_charges = 0;
586 my $seen = $include_this_patron ? {} : { $self->id => 1 }; # For tracking members already added to the total
587 foreach my $guarantor (@guarantors) {
588 $non_issues_charges += $guarantor->account->non_issues_charges if $include_guarantors && !$seen->{ $guarantor->id };
590 # We've added what the guarantor owes, not added in that guarantor's guarantees as well
591 my @guarantees = map { $_->guarantee } $guarantor->guarantee_relationships->as_list;
592 my $guarantees_non_issues_charges = 0;
593 foreach my $guarantee (@guarantees) {
594 next if $seen->{ $guarantee->id };
595 $guarantees_non_issues_charges += $guarantee->account->non_issues_charges;
596 # Mark this guarantee as seen so we don't double count a guarantee linked to multiple guarantors
597 $seen->{ $guarantee->id } = 1;
600 $non_issues_charges += $guarantees_non_issues_charges;
601 $seen->{ $guarantor->id } = 1;
604 return $non_issues_charges;
607 =head3 housebound_profile
609 Returns the HouseboundProfile associated with this patron.
613 sub housebound_profile {
615 my $profile = $self->_result->housebound_profile;
616 return Koha::Patron::HouseboundProfile->_new_from_dbic($profile)
621 =head3 housebound_role
623 Returns the HouseboundRole associated with this patron.
627 sub housebound_role {
630 my $role = $self->_result->housebound_role;
631 return Koha::Patron::HouseboundRole->_new_from_dbic($role) if ( $role );
637 Returns the siblings of this patron.
644 my @guarantors = $self->guarantor_relationships()->guarantors()->as_list;
646 return unless @guarantors;
649 map { $_->guarantee_relationships()->guarantees()->as_list } @guarantors;
651 return unless @siblings;
655 grep { !$seen{ $_->id }++ && ( $_->id != $self->id ) } @siblings;
657 return Koha::Patrons->search( { borrowernumber => { -in => [ map { $_->id } @siblings ] } } );
662 my $patron = Koha::Patrons->find($id);
663 $patron->merge_with( \@patron_ids );
665 This subroutine merges a list of patrons into the patron record. This is accomplished by finding
666 all related patron ids for the patrons to be merged in other tables and changing the ids to be that
667 of the keeper patron.
672 my ( $self, $patron_ids ) = @_;
674 my $anonymous_patron = C4::Context->preference("AnonymousPatron");
675 return if $anonymous_patron && $self->id eq $anonymous_patron;
677 # Do not merge other patrons into a protected patron
678 return if $self->protected;
680 my @patron_ids = @{ $patron_ids };
682 # Ensure the keeper isn't in the list of patrons to merge
683 @patron_ids = grep { $_ ne $self->id } @patron_ids;
685 my $schema = Koha::Database->new()->schema();
689 $self->_result->result_source->schema->txn_do( sub {
690 foreach my $patron_id (@patron_ids) {
692 next if $patron_id eq $anonymous_patron;
694 my $patron = Koha::Patrons->find( $patron_id );
698 # Do not merge protected patrons into other patrons
699 next if $patron->protected;
701 # Unbless for safety, the patron will end up being deleted
702 $results->{merged}->{$patron_id}->{patron} = $patron->unblessed;
704 my $attributes = $patron->extended_attributes;
705 my $new_attributes = [
706 map { { code => $_->code, attribute => $_->attribute } }
709 $attributes->delete; # We need to delete before trying to merge them to prevent exception on unique and repeatable
710 for my $attribute ( @$new_attributes ) {
712 $self->add_extended_attribute($attribute);
714 # Don't block the merge if there is a non-repeatable attribute that cannot be added to the current patron.
715 unless ( $_->isa('Koha::Exceptions::Patron::Attribute::NonRepeatable') ) {
721 while (my ($r, $field) = each(%$RESULTSET_PATRON_ID_MAPPING)) {
722 my $rs = $schema->resultset($r)->search({ $field => $patron_id });
723 $results->{merged}->{ $patron_id }->{updated}->{$r} = $rs->count();
724 $rs->update({ $field => $self->id });
725 if ( $r eq 'BorrowerDebarment' ) {
726 Koha::Patron::Debarments::UpdateBorrowerDebarmentFlags($self->id);
730 $patron->move_to_deleted();
739 =head3 messaging_preferences
741 my $patron = Koha::Patrons->find($id);
742 $patron->messaging_preferences();
746 sub messaging_preferences {
749 return Koha::Patron::MessagePreferences->search({
750 borrowernumber => $self->borrowernumber,
754 =head3 wants_check_for_previous_checkout
756 $wants_check = $patron->wants_check_for_previous_checkout;
758 Return 1 if Koha needs to perform PrevIssue checking, else 0.
762 sub wants_check_for_previous_checkout {
764 my $syspref = C4::Context->preference("checkPrevCheckout");
767 ## Hard syspref trumps all
768 return 1 if ($syspref eq 'hardyes');
769 return 0 if ($syspref eq 'hardno');
770 ## Now, patron pref trumps all
771 return 1 if ($self->checkprevcheckout eq 'yes');
772 return 0 if ($self->checkprevcheckout eq 'no');
774 # More complex: patron inherits -> determine category preference
775 my $checkPrevCheckoutByCat = $self->category->checkprevcheckout;
776 return 1 if ($checkPrevCheckoutByCat eq 'yes');
777 return 0 if ($checkPrevCheckoutByCat eq 'no');
779 # Finally: category preference is inherit, default to 0
780 if ($syspref eq 'softyes') {
787 =head3 do_check_for_previous_checkout
789 $do_check = $patron->do_check_for_previous_checkout($item);
791 Return 1 if the bib associated with $ITEM has previously been checked out to
792 $PATRON, 0 otherwise.
796 sub do_check_for_previous_checkout {
797 my ( $self, $item ) = @_;
800 my $biblio = Koha::Biblios->find( $item->{biblionumber} );
801 if ( $biblio->is_serial ) {
802 push @item_nos, $item->{itemnumber};
804 # Get all itemnumbers for given bibliographic record.
805 @item_nos = $biblio->items->get_column( 'itemnumber' );
808 # Create (old)issues search criteria
810 borrowernumber => $self->borrowernumber,
811 itemnumber => \@item_nos,
814 my $delay = C4::Context->preference('CheckPrevCheckoutDelay') || 0;
816 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
817 my $newer_than = dt_from_string()->subtract( days => $delay );
818 $criteria->{'returndate'} = { '>' => $dtf->format_datetime($newer_than), };
821 # Check current issues table
822 my $issues = Koha::Checkouts->search($criteria);
823 return 1 if $issues->count; # 0 || N
825 # Check old issues table
826 my $old_issues = Koha::Old::Checkouts->search($criteria);
827 return $old_issues->count; # 0 || N
832 my $debarment_expiration = $patron->is_debarred;
834 Returns the date a patron debarment will expire, or undef if the patron is not
842 return unless $self->debarred;
843 return $self->debarred
844 if $self->debarred =~ '^9999'
845 or dt_from_string( $self->debarred ) > dt_from_string;
851 my $is_expired = $patron->is_expired;
853 Returns 1 if the patron is expired or 0;
859 return 0 unless $self->dateexpiry;
860 return 0 if $self->dateexpiry =~ '^9999';
861 return 1 if dt_from_string( $self->dateexpiry ) < dt_from_string->truncate( to => 'day' );
867 $patron->is_active({ [ since => $date ], [ days|weeks|months|years => $value ] })
869 A patron is considered 'active' if the following conditions hold:
871 - account did not expire
872 - account has not been anonymized
873 - enrollment or lastseen within period specified
875 Note: lastseen is updated for triggers defined in preference
876 TrackLastPatronActivityTriggers. This includes logins, issues, holds, etc.
878 The period to check is defined by $date or $value in days, weeks or months. You should
879 pass one of those; otherwise an exception is thrown.
884 my ( $self, $params ) = @_;
885 return 0 if $self->is_expired or $self->anonymized;
888 if ( $params->{since} ) {
889 $dt = dt_from_string( $params->{since}, 'iso' );
890 } elsif ( grep { $params->{$_} } qw(days weeks months years) ) {
891 $dt = dt_from_string();
892 foreach my $duration (qw(days weeks months years)) {
893 $dt = $dt->subtract( $duration => $params->{$duration} ) if $params->{$duration};
896 Koha::Exceptions::MissingParameter->throw('is_active needs date or period');
899 # Enrollment within this period?
900 return 1 if DateTime->compare( dt_from_string( $self->dateenrolled ), $dt ) > -1;
902 # We look at lastseen regardless of TrackLastPatronActivityTriggers. If lastseen is set
903 # recently, the triggers may have been removed after that, etc.
904 return 1 if $self->lastseen && DateTime->compare( dt_from_string( $self->lastseen ), $dt ) > -1;
909 =head3 password_expired
911 my $password_expired = $patron->password_expired;
913 Returns 1 if the patron's password is expired or 0;
917 sub password_expired {
919 return 0 unless $self->password_expiration_date;
920 return 1 if dt_from_string( $self->password_expiration_date ) <= dt_from_string->truncate( to => 'day' );
924 =head3 is_going_to_expire
926 my $is_going_to_expire = $patron->is_going_to_expire;
928 Returns 1 if the patron is going to expired, depending on the NotifyBorrowerDeparture pref or 0
932 sub is_going_to_expire {
935 my $delay = C4::Context->preference('NotifyBorrowerDeparture') || 0;
937 return 0 unless $delay;
938 return 0 unless $self->dateexpiry;
939 return 0 if $self->dateexpiry =~ '^9999';
940 return 1 if dt_from_string( $self->dateexpiry, undef, 'floating' )->subtract( days => $delay ) < dt_from_string(undef, undef, 'floating')->truncate( to => 'day' );
946 $patron->set_password({ password => $plain_text_password [, skip_validation => 1, action => NAME ] });
948 Set the patron's password.
950 Allows optional action parameter to change name of action logged (when enabled). Used for reset password.
954 The passed string is validated against the current password enforcement policy.
955 Validation can be skipped by passing the I<skip_validation> parameter.
957 Exceptions are thrown if the password is not good enough.
961 =item Koha::Exceptions::Password::TooShort
963 =item Koha::Exceptions::Password::WhitespaceCharacters
965 =item Koha::Exceptions::Password::TooWeak
967 =item Koha::Exceptions::Password::Plugin (if a "check password" plugin is enabled)
974 my ( $self, $args ) = @_;
976 my $password = $args->{password};
977 my $action = $args->{action} || "CHANGE PASS";
979 unless ( $args->{skip_validation} ) {
980 my ( $is_valid, $error ) = Koha::AuthUtils::is_password_valid( $password, $self->category );
983 if ( $error eq 'too_short' ) {
984 my $min_length = $self->category->effective_min_password_length;
985 $min_length = 3 if not $min_length or $min_length < 3;
987 my $password_length = length($password);
988 Koha::Exceptions::Password::TooShort->throw(
989 length => $password_length, min_length => $min_length );
991 elsif ( $error eq 'has_whitespaces' ) {
992 Koha::Exceptions::Password::WhitespaceCharacters->throw();
994 elsif ( $error eq 'too_weak' ) {
995 Koha::Exceptions::Password::TooWeak->throw();
1000 if ( C4::Context->config("enable_plugins") ) {
1001 # Call any check_password plugins
1002 my @plugins = Koha::Plugins->new()->GetPlugins({
1003 method => 'check_password',
1005 foreach my $plugin ( @plugins ) {
1006 # This plugin hook will also be used by a plugin for the Norwegian national
1007 # patron database. This is why we need to pass both the password and the
1008 # borrowernumber to the plugin.
1009 my $ret = $plugin->check_password(
1011 password => $password,
1012 borrowernumber => $self->borrowernumber
1015 # This plugin hook will also be used by a plugin for the Norwegian national
1016 # patron database. This is why we need to call the actual plugins and then
1017 # check skip_validation afterwards.
1018 if ( $ret->{'error'} == 1 && !$args->{skip_validation} ) {
1019 Koha::Exceptions::Password::Plugin->throw();
1024 if ( C4::Context->preference('NotifyPasswordChange') ) {
1025 my $self_from_storage = $self->get_from_storage;
1026 if ( !C4::Auth::checkpw_hash( $password, $self_from_storage->password ) ) {
1027 my $emailaddr = $self_from_storage->notice_email_address;
1029 # if we manage to find a valid email address, send notice
1031 my $letter = C4::Letters::GetPreparedLetter(
1032 module => 'members',
1033 letter_code => 'PASSWORD_CHANGE',
1034 branchcode => $self_from_storage->branchcode,
1036 lang => $self_from_storage->lang || 'default',
1038 'branches' => $self_from_storage->branchcode,
1039 'borrowers' => $self_from_storage->borrowernumber,
1041 want_librarian => 1,
1044 my $message_id = C4::Letters::EnqueueLetter(
1047 borrowernumber => $self_from_storage->id,
1048 to_address => $emailaddr,
1049 message_transport_type => 'email'
1052 C4::Letters::SendQueuedMessages( { message_id => $message_id } ) if $message_id;
1057 my $digest = Koha::AuthUtils::hash_password($password);
1059 $self->password_expiration_date( $self->category->get_password_expiry_date || undef );
1061 # We do not want to call $self->store and retrieve password from DB
1062 $self->password($digest);
1063 $self->login_attempts(0);
1064 $self->SUPER::store;
1066 logaction( "MEMBERS", $action, $self->borrowernumber, "" )
1067 if C4::Context->preference("BorrowersLog");
1073 =head3 renew_account
1075 my $new_expiry_date = $patron->renew_account
1077 Extending the subscription to the expiry date.
1084 if ( C4::Context->preference('BorrowerRenewalPeriodBase') eq 'combination' ) {
1085 $date = ( dt_from_string gt dt_from_string( $self->dateexpiry ) ) ? dt_from_string : dt_from_string( $self->dateexpiry );
1088 C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry'
1089 ? dt_from_string( $self->dateexpiry )
1092 my $expiry_date = $self->category->get_expiry_date($date);
1094 $self->dateexpiry($expiry_date);
1095 $self->date_renewed( dt_from_string() );
1098 $self->add_enrolment_fee_if_needed(1);
1100 logaction( "MEMBERS", "RENEW", $self->borrowernumber, "Membership renewed" ) if C4::Context->preference("BorrowersLog");
1101 return dt_from_string( $expiry_date )->truncate( to => 'day' );
1106 my $has_overdues = $patron->has_overdues;
1108 Returns the number of patron's overdues
1114 my $date = dt_from_string();
1115 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
1116 return $self->_result->issues->search({ date_due => { '<' => $dtf->format_datetime($date) } })->count;
1121 =head3 has_restricting_overdues
1123 my $has_restricting_overdues = $patron->has_restricting_overdues({ issue_branchcode => $branchcode });
1125 Returns true if patron has overdues that would result in debarment.
1129 sub has_restricting_overdues {
1130 my ( $self, $params ) = @_;
1132 my $date = dt_from_string()->truncate( to => 'day' );
1134 # If ignoring unrestricted overdues, calculate which delay value for
1135 # overdue messages is set with restrictions. Then only include overdue
1136 # issues older than that date when counting.
1137 #TODO: bail out/throw exception if $params->{issue_branchcode} not set?
1138 my $debarred_delay = _get_overdue_debarred_delay( $params->{issue_branchcode}, $self->categorycode() );
1139 return 0 unless defined $debarred_delay;
1141 # Emulate the conditions in overdue_notices.pl.
1142 # The overdue_notices-script effectively truncates both issues.date_due and current date
1143 # to days when selecting overdue issues.
1144 # Hours and minutes for issues.date_due is usually set to 23 and 59 respectively, though can theoretically
1145 # be set to any other value (truncated to minutes, except if CalcDateDue gets a $startdate)
1147 # No matter what time of day date_due is set to, overdue_notices.pl will select all issues that are due
1148 # the current date or later. We can emulate this query by instead of truncating both to days in the SQL-query,
1149 # using the condition that date_due must be less then the current date truncated to days (time set to 00:00:00)
1150 # offset by one day in the future.
1152 $date->add( days => 1 );
1155 if ( C4::Context->preference('OverdueNoticeCalendar') ) {
1156 $calendar = Koha::Calendar->new( branchcode => $params->{issue_branchcode} );
1159 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
1160 my $issues = $self->_result->issues->search( { date_due => { '<' => $dtf->format_datetime($date) } } );
1161 my $now = dt_from_string();
1163 while ( my $issue = $issues->next ) {
1165 C4::Context->preference('OverdueNoticeCalendar')
1166 ? $calendar->days_between( dt_from_string( $issue->date_due ), $now )->in_units('days')
1167 : $now->delta_days( dt_from_string( $issue->date_due ) )->in_units('days');
1168 if ( $days_between >= $debarred_delay ) {
1175 # Fetch first delayX value from overduerules where debarredX is set, or 0 for no delay
1176 sub _get_overdue_debarred_delay {
1177 my ( $branchcode, $categorycode ) = @_;
1178 my $dbh = C4::Context->dbh();
1180 # We get default rules if there is no rule for this branch
1181 my $rule = Koha::OverdueRules->find(
1183 branchcode => $branchcode,
1184 categorycode => $categorycode
1187 || Koha::OverdueRules->find(
1190 categorycode => $categorycode
1195 return $rule->delay1 if $rule->debarred1;
1196 return $rule->delay2 if $rule->debarred2;
1197 return $rule->delay3 if $rule->debarred3;
1201 =head3 update_lastseen
1203 $patron->update_lastseen('activity');
1205 Updates the lastseen field, limited to one update per day, whenever the activity passed is
1206 listed in TrackLastPatronActivityTriggers.
1208 The method should be called upon successful completion of the activity.
1212 sub update_lastseen {
1213 my ( $self, $activity ) = @_;
1214 my $tracked_activities = {
1215 map { ( lc $_, 1 ); } split /\s*\,\s*/,
1216 C4::Context->preference('TrackLastPatronActivityTriggers')
1218 return $self unless $tracked_activities->{$activity};
1220 my $cache = Koha::Caches->get_instance();
1221 my $cache_key = "track_activity_" . $self->borrowernumber;
1222 my $cached = $cache->get_from_cache($cache_key);
1223 my $now = dt_from_string();
1224 return $self if $cached && $cached eq $now->ymd;
1226 $self->lastseen($now)->store;
1227 $cache->set_in_cache( $cache_key, $now->ymd );
1231 =head3 move_to_deleted
1233 my $is_moved = $patron->move_to_deleted;
1235 Move a patron to the deletedborrowers table.
1236 This can be done before deleting a patron, to make sure the data are not completely deleted.
1240 sub move_to_deleted {
1242 my $patron_infos = $self->unblessed;
1243 delete $patron_infos->{updated_on}; #This ensures the updated_on date in deletedborrowers will be set to the current timestamp
1244 return Koha::Database->new->schema->resultset('Deletedborrower')->create($patron_infos);
1247 =head3 can_request_article
1249 if ( $patron->can_request_article( $library->id ) ) { ... }
1251 Returns true if the patron can request articles. As limits apply for the patron
1252 on the same day, those completed the same day are considered as current.
1254 A I<library_id> can be passed as parameter, falling back to userenv if absent.
1258 sub can_request_article {
1259 my ($self, $library_id) = @_;
1261 $library_id //= C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef;
1263 my $rule = Koha::CirculationRules->get_effective_rule(
1265 branchcode => $library_id,
1266 categorycode => $self->categorycode,
1267 rule_name => 'open_article_requests_limit'
1271 my $limit = ($rule) ? $rule->rule_value : undef;
1273 return 1 unless defined $limit;
1275 my $count = Koha::ArticleRequests->search(
1276 [ { borrowernumber => $self->borrowernumber, status => [ 'REQUESTED', 'PENDING', 'PROCESSING' ] },
1277 { borrowernumber => $self->borrowernumber, status => 'COMPLETED', updated_on => { '>=' => \'CAST(NOW() AS DATE)' } },
1280 return $count < $limit ? 1 : 0;
1283 =head3 article_request_fee
1285 my $fee = $patron->article_request_fee(
1287 [ library_id => $library->id, ]
1291 Returns the fee to be charged to the patron when it places an article request.
1293 A I<library_id> can be passed as parameter, falling back to userenv if absent.
1297 sub article_request_fee {
1298 my ($self, $params) = @_;
1300 my $library_id = $params->{library_id};
1302 $library_id //= C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef;
1304 my $rule = Koha::CirculationRules->get_effective_rule(
1306 branchcode => $library_id,
1307 categorycode => $self->categorycode,
1308 rule_name => 'article_request_fee'
1312 my $fee = ($rule) ? $rule->rule_value + 0 : 0;
1317 =head3 add_article_request_fee_if_needed
1319 my $fee = $patron->add_article_request_fee_if_needed(
1321 [ item_id => $item->id,
1322 library_id => $library->id, ]
1326 If an article request fee needs to be charged, it adds a debit to the patron's
1329 Returns the fee line.
1331 A I<library_id> can be passed as parameter, falling back to userenv if absent.
1335 sub add_article_request_fee_if_needed {
1336 my ($self, $params) = @_;
1338 my $library_id = $params->{library_id};
1339 my $item_id = $params->{item_id};
1341 $library_id //= C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef;
1343 my $amount = $self->article_request_fee(
1345 library_id => $library_id,
1351 if ( $amount > 0 ) {
1352 $debit_line = $self->account->add_debit(
1355 user_id => C4::Context->userenv ? C4::Context->userenv->{'number'} : undef,
1356 interface => C4::Context->interface,
1357 library_id => $library_id,
1358 type => 'ARTICLE_REQUEST',
1359 item_id => $item_id,
1367 =head3 article_requests
1369 my $article_requests = $patron->article_requests;
1371 Returns the patron article requests.
1375 sub article_requests {
1378 return Koha::ArticleRequests->_new_from_dbic( scalar $self->_result->article_requests );
1381 =head3 add_enrolment_fee_if_needed
1383 my $enrolment_fee = $patron->add_enrolment_fee_if_needed($renewal);
1385 Add enrolment fee for a patron if needed.
1387 $renewal - boolean denoting whether this is an account renewal or not
1391 sub add_enrolment_fee_if_needed {
1392 my ($self, $renewal) = @_;
1393 my $enrolment_fee = $self->category->enrolmentfee;
1394 if ( $enrolment_fee && $enrolment_fee > 0 ) {
1395 my $type = $renewal ? 'ACCOUNT_RENEW' : 'ACCOUNT';
1396 $self->account->add_debit(
1398 amount => $enrolment_fee,
1399 user_id => C4::Context->userenv ? C4::Context->userenv->{'number'} : undef,
1400 interface => C4::Context->interface,
1401 library_id => C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef,
1406 return $enrolment_fee || 0;
1411 my $checkouts = $patron->checkouts
1417 my $checkouts = $self->_result->issues;
1418 return Koha::Checkouts->_new_from_dbic( $checkouts );
1421 =head3 pending_checkouts
1423 my $pending_checkouts = $patron->pending_checkouts
1425 This method will return the same as $self->checkouts, but with a prefetch on
1426 items, biblio and biblioitems.
1428 It has been introduced to replaced the C4::Members::GetPendingIssues subroutine
1430 It should not be used directly, prefer to access fields you need instead of
1431 retrieving all these fields in one go.
1435 sub pending_checkouts {
1437 my $checkouts = $self->_result->issues->search(
1441 { -desc => 'me.timestamp' },
1442 { -desc => 'issuedate' },
1443 { -desc => 'issue_id' }, # Sort by issue_id should be enough
1445 prefetch => { item => { biblio => 'biblioitems' } },
1448 return Koha::Checkouts->_new_from_dbic( $checkouts );
1451 =head3 old_checkouts
1453 my $old_checkouts = $patron->old_checkouts
1459 my $old_checkouts = $self->_result->old_issues;
1460 return Koha::Old::Checkouts->_new_from_dbic( $old_checkouts );
1465 my $overdue_items = $patron->overdues
1467 Return the overdue items
1473 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
1474 return $self->checkouts->search(
1476 'me.date_due' => { '<' => $dtf->format_datetime(dt_from_string) },
1479 prefetch => { item => { biblio => 'biblioitems' } },
1487 my $restrictions = $patron->restrictions;
1489 Returns the patron restrictions.
1495 my $restrictions_rs = $self->_result->restrictions;
1496 return Koha::Patron::Restrictions->_new_from_dbic($restrictions_rs);
1499 =head3 get_routing_lists
1501 my $routinglists = $patron->get_routing_lists
1503 Returns the routing lists a patron is subscribed to.
1507 sub get_routing_lists {
1509 my $routing_list_rs = $self->_result->subscriptionroutinglists;
1510 return Koha::Subscription::Routinglists->_new_from_dbic($routing_list_rs);
1515 my $age = $patron->get_age
1517 Return the age of the patron
1524 return unless $self->dateofbirth;
1526 #Set timezone to floating to avoid any datetime math issues caused by DST
1527 my $date_of_birth = dt_from_string( $self->dateofbirth, undef, 'floating' );
1528 my $today = dt_from_string(undef, undef, 'floating')->truncate( to => 'day' );
1530 return $today->subtract_datetime( $date_of_birth )->years;
1535 my $is_valid = $patron->is_valid_age
1537 Return 1 if patron's age is between allowed limits, returns 0 if it's not.
1543 my $age = $self->get_age;
1545 my $patroncategory = $self->category;
1546 my ($low,$high) = ($patroncategory->dateofbirthrequired, $patroncategory->upperagelimit);
1548 return (defined($age) && (($high && ($age > $high)) or ($low && ($age < $low)))) ? 0 : 1;
1553 my $account = $patron->account
1559 return Koha::Account->new( { patron_id => $self->borrowernumber } );
1564 my $holds = $patron->holds
1566 Return all the holds placed by this patron
1572 my $holds_rs = $self->_result->reserves->search( {}, { order_by => 'reservedate' } );
1573 return Koha::Holds->_new_from_dbic($holds_rs);
1578 my $old_holds = $patron->old_holds
1580 Return all the historical holds for this patron
1586 my $old_holds_rs = $self->_result->old_reserves->search( {}, { order_by => 'reservedate' } );
1587 return Koha::Old::Holds->_new_from_dbic($old_holds_rs);
1590 =head3 curbside_pickups
1592 my $curbside_pickups = $patron->curbside_pickups;
1594 Return all the curbside pickups for this patron
1598 sub curbside_pickups {
1600 my $curbside_pickups_rs = $self->_result->curbside_pickups_borrowernumbers->search;
1601 return Koha::CurbsidePickups->_new_from_dbic($curbside_pickups_rs);
1606 my $bookings = $item->bookings();
1608 Returns the bookings for this patron.
1613 my ( $self, $params ) = @_;
1614 my $bookings_rs = $self->_result->bookings->search($params);
1615 return Koha::Bookings->_new_from_dbic( $bookings_rs );
1618 =head3 return_claims
1620 my $return_claims = $patron->return_claims
1626 my $return_claims = $self->_result->return_claims_borrowernumbers;
1627 return Koha::Checkouts::ReturnClaims->_new_from_dbic( $return_claims );
1630 =head3 notice_email_address
1632 my $email = $patron->notice_email_address;
1634 Return the email address of patron used for notices.
1635 Returns the empty string if no email address.
1639 sub notice_email_address{
1642 my $which_address = C4::Context->preference("EmailFieldPrimary");
1644 # if syspref is set to 'first valid' (value == OFF), look up email address
1645 if ( $which_address eq 'OFF' ) {
1646 return $self->first_valid_email_address;
1649 # if syspref is set to 'selected addresses' (value == MULTI), look up email addresses
1650 if ( $which_address eq 'MULTI' ) {
1652 my $selected_fields = C4::Context->preference("EmailFieldSelection");
1653 for my $email_field ( split ",", $selected_fields ) {
1654 my $email_address = $self->$email_field;
1655 push @addresses, $email_address if $email_address;
1657 return join(",",@addresses);
1660 return $self->$which_address || '';
1664 =head3 first_valid_email_address
1666 my $first_valid_email_address = $patron->first_valid_email_address
1668 Return the first valid email address for a patron.
1669 For now, the order is defined as email, emailpro, B_email.
1670 Returns the empty string if the borrower has no email addresses.
1674 sub first_valid_email_address {
1679 my @fields = split /\s*\|\s*/,
1680 C4::Context->preference('EmailFieldPrecedence');
1681 for my $field (@fields) {
1682 $email = $self->$field;
1689 =head3 get_club_enrollments
1693 sub get_club_enrollments {
1696 return Koha::Club::Enrollments->search( { borrowernumber => $self->borrowernumber(), date_canceled => undef } );
1699 =head3 get_enrollable_clubs
1703 sub get_enrollable_clubs {
1704 my ( $self, $is_enrollable_from_opac ) = @_;
1707 $params->{is_enrollable_from_opac} = $is_enrollable_from_opac
1708 if $is_enrollable_from_opac;
1709 $params->{is_email_required} = 0 unless $self->first_valid_email_address();
1711 $params->{borrower} = $self;
1713 return Koha::Clubs->get_enrollable($params);
1717 =head3 get_lists_with_patron
1719 my @lists = $patron->get_lists_with_patron;
1721 FIXME: This method returns a DBIC resultset instead of a Koha::Objects-based
1726 sub get_lists_with_patron {
1728 my $borrowernumber = $self->borrowernumber;
1730 return Koha::Database->new()->schema()->resultset('PatronList')->search(
1732 'patron_list_patrons.borrowernumber' => $borrowernumber,
1735 join => 'patron_list_patrons',
1742 =head3 account_locked
1744 my $is_locked = $patron->account_locked
1746 Return true if the patron has reached the maximum number of login attempts
1747 (see pref FailedLoginAttempts). If login_attempts is < 0, this is interpreted
1748 as an administrative lockout (independent of FailedLoginAttempts; see also
1749 Koha::Patron->lock).
1750 Otherwise return false.
1751 If the pref is not set (empty string, null or 0), the feature is considered as
1756 sub account_locked {
1758 my $FailedLoginAttempts = C4::Context->preference('FailedLoginAttempts');
1759 return 1 if $FailedLoginAttempts
1760 and $self->login_attempts
1761 and $self->login_attempts >= $FailedLoginAttempts;
1762 return 1 if ($self->login_attempts || 0) < 0; # administrative lockout
1766 =head3 can_see_patron_infos
1768 my $can_see = $patron->can_see_patron_infos( $patron );
1770 Return true if the patron (usually the logged in user) can see the patron's infos for a given patron
1774 sub can_see_patron_infos {
1775 my ( $self, $patron ) = @_;
1776 return unless $patron;
1777 return $self->can_see_patrons_from( $patron->branchcode );
1780 =head3 can_see_patrons_from
1782 my $can_see = $patron->can_see_patrons_from( $branchcode );
1784 Return true if the patron (usually the logged in user) can see the patron's infos from a given library
1788 sub can_see_patrons_from {
1789 my ( $self, $branchcode ) = @_;
1791 return $self->can_see_things_from(
1793 branchcode => $branchcode,
1794 permission => 'borrowers',
1795 subpermission => 'view_borrower_infos_from_any_libraries',
1800 =head3 can_edit_items_from
1802 my $can_edit = $patron->can_edit_items_from( $branchcode );
1804 Return true if the I<Koha::Patron> can edit items from the given branchcode
1808 sub can_edit_items_from {
1809 my ( $self, $branchcode ) = @_;
1811 return 1 if C4::Context->IsSuperLibrarian();
1813 my $userenv = C4::Context->userenv();
1814 if ( $userenv && C4::Context->preference('IndependentBranches') ) {
1815 return $userenv->{branch} eq $branchcode;
1818 return $self->can_see_things_from(
1820 branchcode => $branchcode,
1821 permission => 'editcatalogue',
1822 subpermission => 'edit_any_item',
1827 =head3 libraries_where_can_edit_items
1829 my $libraries = $patron->libraries_where_can_edit_items;
1831 Return the list of branchcodes(!) of libraries the patron is allowed to items for.
1832 The branchcodes are arbitrarily returned sorted.
1833 We are supposing here that the object is related to the logged in patron (use of C4::Context::only_my_library)
1835 An empty array means no restriction, the user can edit any item.
1839 sub libraries_where_can_edit_items {
1842 return $self->libraries_where_can_see_things(
1844 permission => 'editcatalogue',
1845 subpermission => 'edit_any_item',
1846 group_feature => 'ft_limit_item_editing',
1851 =head3 libraries_where_can_see_patrons
1853 my $libraries = $patron->libraries_where_can_see_patrons;
1855 Return the list of branchcodes(!) of libraries the patron is allowed to see other patron's infos.
1856 The branchcodes are arbitrarily returned sorted.
1857 We are supposing here that the object is related to the logged in patron (use of C4::Context::only_my_library)
1859 An empty array means no restriction, the patron can see patron's infos from any libraries.
1863 sub libraries_where_can_see_patrons {
1866 return $self->libraries_where_can_see_things(
1868 permission => 'borrowers',
1869 subpermission => 'view_borrower_infos_from_any_libraries',
1870 group_feature => 'ft_hide_patron_info',
1875 =head3 can_see_things_from
1877 my $can_see = $patron->can_see_things_from( $branchcode );
1879 Return true if the I<Koha::Patron> can perform some action on the given thing
1883 sub can_see_things_from {
1884 my ( $self, $params ) = @_;
1886 my $branchcode = $params->{branchcode};
1887 my $permission = $params->{permission};
1888 my $subpermission = $params->{subpermission};
1890 return 1 if C4::Context->IsSuperLibrarian();
1893 if ( $self->branchcode eq $branchcode ) {
1895 } elsif ( $self->has_permission( { $permission => $subpermission } ) ) {
1897 } elsif ( my @branches = $self->libraries_where_can_see_patrons ) {
1898 $can = ( any { $_ eq $branchcode } @branches ) ? 1 : 0;
1905 my $can_log_into = $patron->can_log_into( $library );
1907 Given a I<Koha::Library> object, it returns a boolean representing
1908 the fact the patron can log into a the library.
1913 my ( $self, $library ) = @_;
1917 if ( C4::Context->preference('IndependentBranches') ) {
1919 if $self->is_superlibrarian
1920 or $self->branchcode eq $library->id;
1930 =head3 libraries_where_can_see_things
1932 my $libraries = $patron->libraries_where_can_see_things;
1934 Returns a list of libraries where an aribitarary action is allowed to be taken by the logged in librarian
1935 against an object based on some branchcode related to the object ( patron branchcode, item homebranch, etc ).
1937 We are supposing here that the object is related to the logged in librarian (use of C4::Context::only_my_library)
1939 An empty array means no restriction, the thing can see thing's infos from any libraries.
1943 sub libraries_where_can_see_things {
1944 my ( $self, $params ) = @_;
1945 my $permission = $params->{permission};
1946 my $subpermission = $params->{subpermission};
1947 my $group_feature = $params->{group_feature};
1949 return $self->{"_restricted_branchcodes:$permission:$subpermission:$group_feature"}
1950 if exists( $self->{"_restricted_branchcodes:$permission:$subpermission:$group_feature"} );
1952 my $userenv = C4::Context->userenv;
1954 return () unless $userenv; # For tests, but userenv should be defined in tests...
1956 my @restricted_branchcodes;
1957 if (C4::Context::only_my_library) {
1958 push @restricted_branchcodes, $self->branchcode;
1962 $self->has_permission(
1963 { $permission => $subpermission }
1967 my $library_groups = $self->library->library_groups({ $group_feature => 1 });
1968 if ( $library_groups->count )
1970 while ( my $library_group = $library_groups->next ) {
1971 my $parent = $library_group->parent;
1972 if ( $parent->has_child( $self->branchcode ) ) {
1973 push @restricted_branchcodes, $parent->children->get_column('branchcode');
1978 @restricted_branchcodes = ( $self->branchcode ) unless @restricted_branchcodes;
1982 @restricted_branchcodes = grep { defined $_ } @restricted_branchcodes;
1983 @restricted_branchcodes = uniq(@restricted_branchcodes);
1984 @restricted_branchcodes = sort(@restricted_branchcodes);
1986 $self->{"_restricted_branchcodes:$permission:$subpermission:$group_feature"} = \@restricted_branchcodes;
1987 return @{ $self->{"_restricted_branchcodes:$permission:$subpermission:$group_feature"} };
1990 =head3 has_permission
1992 my $permission = $patron->has_permission($required);
1994 See C4::Auth::haspermission for details of syntax for $required
1998 sub has_permission {
1999 my ( $self, $flagsrequired ) = @_;
2000 return unless $self->userid;
2001 # TODO code from haspermission needs to be moved here!
2002 return C4::Auth::haspermission( $self->userid, $flagsrequired );
2005 =head3 is_superlibrarian
2007 my $is_superlibrarian = $patron->is_superlibrarian;
2009 Return true if the patron is a superlibrarian.
2013 sub is_superlibrarian {
2015 return $self->has_permission( { superlibrarian => 1 } ) ? 1 : 0;
2020 my $is_adult = $patron->is_adult
2022 Return true if the patron has a category with a type Adult (A) or Organization (I)
2028 return $self->category->category_type =~ /^(A|I)$/ ? 1 : 0;
2033 my $is_child = $patron->is_child
2035 Return true if the patron has a category with a type Child (C)
2041 return $self->category->category_type eq 'C' ? 1 : 0;
2044 =head3 has_valid_userid
2046 my $patron = Koha::Patrons->find(42);
2047 $patron->userid( $new_userid );
2048 my $has_a_valid_userid = $patron->has_valid_userid
2050 my $patron = Koha::Patron->new( $params );
2051 my $has_a_valid_userid = $patron->has_valid_userid
2053 Return true if the current userid of this patron is valid/unique, otherwise false.
2055 Note that this should be done in $self->store instead and raise an exception if needed.
2059 sub has_valid_userid {
2062 return 0 unless $self->userid;
2064 return 0 if ( $self->userid eq C4::Context->config('user') ); # DB user
2066 my $already_exists = Koha::Patrons->search(
2068 userid => $self->userid,
2071 ? ( borrowernumber => { '!=' => $self->borrowernumber } )
2076 return $already_exists ? 0 : 1;
2079 =head3 generate_userid
2081 $patron->generate_userid;
2083 If you do not have a plugin for generating a userid, we will call
2084 the internal method here that returns firstname.surname[.number],
2085 where number is an optional suffix to make the userid unique.
2086 (Its behavior has not been changed on bug 32426.)
2088 If you have plugin(s), the first valid response will be used.
2089 A plugin is assumed to return a valid userid as suggestion, but not
2090 assumed to save it already.
2091 Does not fallback to internal (you could arrange for that in your plugin).
2092 Clears userid when there are no valid plugin responses.
2096 sub generate_userid {
2098 my @responses = Koha::Plugins->call(
2099 'patron_generate_userid',
2101 patron => $self, #FIXME To be deprecated
2102 payload => { patron => $self },
2105 unless( @responses ) {
2106 # Empty list only possible when there are NO enabled plugins for this method.
2107 # In that case we provide internal response.
2108 return $self->_generate_userid_internal;
2110 # If a plugin returned false value or invalid value, we do however not return
2111 # internal response. The plugins should deal with that themselves. So we prevent
2112 # unexpected/unwelcome internal codes for plugin failures.
2113 foreach my $response ( grep { $_ } @responses ) {
2114 $self->userid( $response );
2115 return $self if $self->has_valid_userid;
2117 $self->userid(undef);
2121 sub _generate_userid_internal { # as we always did
2124 my $firstname = $self->firstname // q{};
2125 my $surname = $self->surname // q{};
2126 #The script will "do" the following code and increment the $offset until the generated userid is unique
2128 $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
2129 $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
2130 my $userid = lc(($firstname)? "$firstname.$surname" : $surname);
2131 $userid = NFKD( $userid );
2132 $userid =~ s/\p{NonspacingMark}//g;
2133 $userid .= $offset unless $offset == 0;
2134 $self->userid( $userid );
2136 } while (! $self->has_valid_userid );
2141 =head3 add_extended_attribute
2145 sub add_extended_attribute {
2146 my ($self, $attribute) = @_;
2148 return Koha::Patron::Attribute->new(
2151 ( borrowernumber => $self->borrowernumber ),
2157 =head3 extended_attributes
2159 Return object of Koha::Patron::Attributes type with all attributes set for this patron
2165 sub extended_attributes {
2166 my ( $self, $attributes ) = @_;
2167 if ($attributes) { # setter
2168 my $schema = $self->_result->result_source->schema;
2171 # Remove the existing one
2172 $self->extended_attributes->filter_by_branch_limitations->delete;
2174 # Insert the new ones
2176 for my $attribute (@$attributes) {
2177 $self->add_extended_attribute($attribute);
2178 $new_types->{$attribute->{code}} = 1;
2181 # Check globally mandatory types
2182 my @required_attribute_types =
2183 Koha::Patron::Attribute::Types->search(
2186 category_code => [ undef, $self->categorycode ],
2187 'borrower_attribute_types_branches.b_branchcode' =>
2190 { join => 'borrower_attribute_types_branches' }
2191 )->get_column('code');
2192 for my $type ( @required_attribute_types ) {
2193 Koha::Exceptions::Patron::MissingMandatoryExtendedAttribute->throw(
2195 ) if !$new_types->{$type};
2201 my $rs = $self->_result->borrower_attributes;
2202 # We call search to use the filters in Koha::Patron::Attributes->search
2203 return Koha::Patron::Attributes->_new_from_dbic($rs)->search;
2208 my $messages = $patron->messages;
2210 Return the message attached to the patron.
2216 my $messages_rs = $self->_result->messages_borrowernumbers->search;
2217 return Koha::Patron::Messages->_new_from_dbic($messages_rs);
2222 Koha::Patrons->find($id)->lock({ expire => 1, remove => 1 });
2224 Lock and optionally expire a patron account.
2225 Remove holds and article requests if remove flag set.
2226 In order to distinguish from locking by entering a wrong password, let's
2227 call this an administrative lockout.
2232 my ( $self, $params ) = @_;
2233 $self->login_attempts( ADMINISTRATIVE_LOCKOUT );
2234 if( $params->{expire} ) {
2235 $self->dateexpiry( dt_from_string->subtract(days => 1) );
2238 if( $params->{remove} ) {
2239 $self->holds->delete;
2240 $self->article_requests->delete;
2247 Koha::Patrons->find($id)->anonymize;
2249 Anonymize or clear borrower fields. Fields in BorrowerMandatoryField
2250 are randomized, other personal data is cleared too.
2251 Patrons with issues are skipped.
2257 if( $self->_result->issues->count ) {
2258 warn "Exiting anonymize: patron ".$self->borrowernumber." still has issues";
2261 # Mandatory fields come from the corresponding pref, but email fields
2262 # are removed since scrambled email addresses only generate errors
2263 my $mandatory = { map { (lc $_, 1); } grep { !/email/ }
2264 split /\s*\|\s*/, C4::Context->preference('BorrowerMandatoryField') };
2265 $mandatory->{userid} = 1; # needed since sub store does not clear field
2266 my @columns = $self->_result->result_source->columns;
2267 @columns = grep { !/borrowernumber|branchcode|categorycode|^date|password|flags|updated_on|lastseen|lang|login_attempts|anonymized|auth_method/ } @columns;
2268 push @columns, 'dateofbirth'; # add this date back in
2269 foreach my $col (@columns) {
2270 $self->_anonymize_column($col, $mandatory->{lc $col} );
2272 $self->anonymized(1)->store;
2275 sub _anonymize_column {
2276 my ( $self, $col, $mandatory ) = @_;
2277 my $col_info = $self->_result->result_source->column_info($col);
2278 my $type = $col_info->{data_type};
2279 my $nullable = $col_info->{is_nullable};
2281 if( $type =~ /char|text/ ) {
2283 ? Koha::Token->new->generate({ pattern => '\w{10}' })
2287 } elsif( $type =~ /integer|int$|float|dec|double/ ) {
2288 $val = $nullable ? undef : 0;
2289 } elsif( $type =~ /date|time/ ) {
2290 $val = $nullable ? undef : dt_from_string;
2295 =head3 add_guarantor
2297 my $relationship = $patron->add_guarantor(
2299 borrowernumber => $borrowernumber,
2300 relationships => $relationship,
2304 Adds a new guarantor to a patron.
2309 my ( $self, $params ) = @_;
2311 my $guarantor_id = $params->{guarantor_id};
2312 my $relationship = $params->{relationship};
2314 return Koha::Patron::Relationship->new(
2316 guarantee_id => $self->id,
2317 guarantor_id => $guarantor_id,
2318 relationship => $relationship
2323 =head3 get_extended_attribute
2325 my $attribute_value = $patron->get_extended_attribute( $code );
2327 Return the attribute for the code passed in parameter.
2329 It not exist it returns undef
2331 Note that this will not work for repeatable attribute types.
2333 Maybe you certainly not want to use this method, it is actually only used for SHOW_BARCODE
2334 (which should be a real patron's attribute (not extended)
2338 sub get_extended_attribute {
2339 my ( $self, $code, $value ) = @_;
2340 my $rs = $self->_result->borrower_attributes;
2342 my $attribute = $rs->search({ code => $code, ( $value ? ( attribute => $value ) : () ) });
2343 return unless $attribute->count;
2344 return $attribute->next;
2347 =head3 set_default_messaging_preferences
2349 $patron->set_default_messaging_preferences
2351 Sets default messaging preferences on patron.
2353 See Koha::Patron::MessagePreference(s) for more documentation, especially on
2358 sub set_default_messaging_preferences {
2359 my ($self, $categorycode) = @_;
2361 my $options = Koha::Patron::MessagePreferences->get_options;
2363 foreach my $option (@$options) {
2364 # Check that this option has preference configuration for this category
2365 unless (Koha::Patron::MessagePreferences->search({
2366 message_attribute_id => $option->{message_attribute_id},
2367 categorycode => $categorycode || $self->categorycode,
2372 # Delete current setting
2373 Koha::Patron::MessagePreferences->search({
2374 borrowernumber => $self->borrowernumber,
2375 message_attribute_id => $option->{message_attribute_id},
2378 Koha::Patron::MessagePreference->new_from_default({
2379 borrowernumber => $self->borrowernumber,
2380 categorycode => $categorycode || $self->categorycode,
2381 message_attribute_id => $option->{message_attribute_id},
2388 =head3 is_accessible
2390 if ( $patron->is_accessible({ user => $logged_in_user }) ) { ... }
2392 This overloaded method validates whether the current I<Koha::Patron> object can be accessed
2393 by the logged in user.
2395 Returns 0 if the I<user> parameter is missing.
2400 my ( $self, $params ) = @_;
2402 unless ( defined( $params->{user} ) ) {
2403 Koha::Exceptions::MissingParameter->throw( error => "The `user` parameter is mandatory" );
2406 my $consumer = $params->{user};
2407 return $consumer->can_see_patron_infos($self);
2410 =head3 unredact_list
2412 This method returns the list of database fields that should be visible, even for restricted users,
2413 for both API and UI output purposes
2418 return ['branchcode'];
2423 my $json = $patron->to_api;
2425 Overloaded method that returns a JSON representation of the Koha::Patron object,
2426 suitable for API output.
2431 my ( $self, $params ) = @_;
2433 my $json_patron = $self->SUPER::to_api( $params );
2435 return unless $json_patron;
2437 $json_patron->{restricted} = ( $self->is_debarred )
2439 : Mojo::JSON->false;
2441 return $json_patron;
2444 =head3 to_api_mapping
2446 This method returns the mapping for representing a Koha::Patron object
2451 sub to_api_mapping {
2453 borrowernotes => 'staff_notes',
2454 borrowernumber => 'patron_id',
2455 branchcode => 'library_id',
2456 categorycode => 'category_id',
2457 checkprevcheckout => 'check_previous_checkout',
2458 contactfirstname => undef, # Unused
2459 contactname => undef, # Unused
2460 contactnote => 'altaddress_notes',
2461 contacttitle => undef, # Unused
2462 dateenrolled => 'date_enrolled',
2463 dateexpiry => 'expiry_date',
2464 dateofbirth => 'date_of_birth',
2465 debarred => undef, # replaced by 'restricted'
2466 debarredcomment => undef, # calculated, API consumers will use /restrictions instead
2467 emailpro => 'secondary_email',
2468 flags => undef, # permissions manipulation handled in /permissions
2469 gonenoaddress => 'incorrect_address',
2470 lastseen => 'last_seen',
2471 lost => 'patron_card_lost',
2472 opacnote => 'opac_notes',
2473 othernames => 'other_name',
2474 password => undef, # password manipulation handled in /password
2475 phonepro => 'secondary_phone',
2476 relationship => 'relationship_type',
2478 smsalertnumber => 'sms_number',
2479 sort1 => 'statistics_1',
2480 sort2 => 'statistics_2',
2481 autorenew_checkouts => 'autorenew_checkouts',
2482 streetnumber => 'street_number',
2483 streettype => 'street_type',
2484 zipcode => 'postal_code',
2485 B_address => 'altaddress_address',
2486 B_address2 => 'altaddress_address2',
2487 B_city => 'altaddress_city',
2488 B_country => 'altaddress_country',
2489 B_email => 'altaddress_email',
2490 B_phone => 'altaddress_phone',
2491 B_state => 'altaddress_state',
2492 B_streetnumber => 'altaddress_street_number',
2493 B_streettype => 'altaddress_street_type',
2494 B_zipcode => 'altaddress_postal_code',
2495 altcontactaddress1 => 'altcontact_address',
2496 altcontactaddress2 => 'altcontact_address2',
2497 altcontactaddress3 => 'altcontact_city',
2498 altcontactcountry => 'altcontact_country',
2499 altcontactfirstname => 'altcontact_firstname',
2500 altcontactphone => 'altcontact_phone',
2501 altcontactsurname => 'altcontact_surname',
2502 altcontactstate => 'altcontact_state',
2503 altcontactzipcode => 'altcontact_postal_code',
2504 password_expiration_date => undef,
2505 primary_contact_method => undef,
2507 auth_method => undef,
2513 Returns a map of column name to string representations including the string.
2518 my ( $self, $params ) = @_;
2522 str => $self->library->branchname,
2526 str => $self->category->description,
2527 type => 'patron_category',
2534 Koha::Patrons->queue_notice({ letter_params => $letter_params, message_name => 'DUE'});
2535 Koha::Patrons->queue_notice({ letter_params => $letter_params, message_transports => \@message_transports });
2536 Koha::Patrons->queue_notice({ letter_params => $letter_params, message_transports => \@message_transports, test_mode => 1 });
2538 Queue messages to a patron. Can pass a message that is part of the message_attributes
2539 table or supply the transport to use.
2541 If passed a message name we retrieve the patrons preferences for transports
2542 Otherwise we use the supplied transport. In the case of email or sms we fall back to print if
2543 we have no address/number for sending
2545 $letter_params is a hashref of the values to be passed to GetPreparedLetter
2547 test_mode will only report which notices would be sent, but nothing will be queued
2552 my ( $self, $params ) = @_;
2553 my $letter_params = $params->{letter_params};
2554 my $test_mode = $params->{test_mode};
2556 return unless $letter_params;
2557 return unless exists $params->{message_name} xor $params->{message_transports}; # We only want one of these
2559 my $library = Koha::Libraries->find( $letter_params->{branchcode} );
2560 my $from_email_address = $library->from_email_address;
2562 my @message_transports;
2564 $letter_code = $letter_params->{letter_code};
2565 if( $params->{message_name} ){
2566 my $messaging_prefs = C4::Members::Messaging::GetMessagingPreferences( {
2567 borrowernumber => $letter_params->{borrowernumber},
2568 message_name => $params->{message_name}
2570 @message_transports = ( keys %{ $messaging_prefs->{transports} } );
2571 $letter_code = $messaging_prefs->{transports}->{$message_transports[0]} unless $letter_code;
2573 @message_transports = @{$params->{message_transports}};
2575 return unless defined $letter_code;
2576 $letter_params->{letter_code} = $letter_code;
2579 foreach my $mtt (@message_transports){
2580 next if ($mtt eq 'itiva' and C4::Context->preference('TalkingTechItivaPhoneNotification') );
2581 # Notice is handled by TalkingTech_itiva_outbound.pl
2582 if ( ( $mtt eq 'email' and not $self->notice_email_address )
2583 or ( $mtt eq 'sms' and not $self->smsalertnumber )
2584 or ( $mtt eq 'phone' and not $self->phone ) )
2586 push @{ $return{fallback} }, $mtt;
2589 next if $mtt eq 'print' && $print_sent;
2590 $letter_params->{message_transport_type} = $mtt;
2591 my $letter = C4::Letters::GetPreparedLetter( %$letter_params );
2592 C4::Letters::EnqueueLetter({
2594 borrowernumber => $self->borrowernumber,
2595 from_address => $from_email_address,
2596 message_transport_type => $mtt
2597 }) unless $test_mode;
2598 push @{$return{sent}}, $mtt;
2599 $print_sent = 1 if $mtt eq 'print';
2604 =head3 safe_to_delete
2606 my $result = $patron->safe_to_delete;
2607 if ( $result eq 'has_guarantees' ) { ... }
2608 elsif ( $result ) { ... }
2609 else { # cannot delete }
2611 This method tells if the Koha:Patron object can be deleted. Possible return values
2617 =item 'has_checkouts'
2621 =item 'has_guarantees'
2623 =item 'is_anonymous_patron'
2625 =item 'is_protected'
2631 sub safe_to_delete {
2634 my $anonymous_patron = C4::Context->preference('AnonymousPatron');
2638 if ( $anonymous_patron && $self->id eq $anonymous_patron ) {
2639 $error = 'is_anonymous_patron';
2641 elsif ( $self->checkouts->count ) {
2642 $error = 'has_checkouts';
2644 elsif ( $self->account->outstanding_debits->total_outstanding > 0 ) {
2645 $error = 'has_debt';
2647 elsif ( $self->guarantee_relationships->count ) {
2648 $error = 'has_guarantees';
2650 elsif ( $self->protected ) {
2651 $error = 'is_protected';
2655 return Koha::Result::Boolean->new(0)->add_message({ message => $error });
2658 return Koha::Result::Boolean->new(1);
2663 my $recalls = $patron->recalls;
2665 Return the patron's recalls.
2672 return Koha::Recalls->search({ patron_id => $self->borrowernumber });
2675 =head3 account_balance
2677 my $balance = $patron->account_balance
2679 Return the patron's account balance
2683 sub account_balance {
2685 return $self->account->balance;
2688 =head3 notify_library_of_registration
2690 $patron->notify_library_of_registration( $email_patron_registrations );
2692 Send patron registration email to library if EmailPatronRegistrations system preference is enabled.
2696 sub notify_library_of_registration {
2697 my ( $self, $email_patron_registrations ) = @_;
2700 my $letter = C4::Letters::GetPreparedLetter(
2701 module => 'members',
2702 letter_code => 'OPAC_REG',
2703 branchcode => $self->branchcode,
2704 lang => $self->lang || 'default',
2706 'borrowers' => $self->borrowernumber
2711 if ( $email_patron_registrations eq "BranchEmailAddress" ) {
2712 my $library = Koha::Libraries->find( $self->branchcode );
2713 $to_address = $library->inbound_email_address;
2715 elsif ( $email_patron_registrations eq "KohaAdminEmailAddress" ) {
2716 $to_address = C4::Context->preference('ReplytoDefault')
2717 || C4::Context->preference('KohaAdminEmailAddress');
2721 C4::Context->preference('EmailAddressForPatronRegistrations')
2722 || C4::Context->preference('ReplytoDefault')
2723 || C4::Context->preference('KohaAdminEmailAddress');
2726 my $message_id = C4::Letters::EnqueueLetter(
2729 borrowernumber => $self->borrowernumber,
2730 to_address => $to_address,
2731 message_transport_type => 'email'
2733 ) or warn "can't enqueue letter $letter";
2734 if ( $message_id ) {
2740 =head3 has_messaging_preference
2742 my $bool = $patron->has_messaging_preference({
2743 message_name => $message_name, # A value from message_attributes.message_name
2744 message_transport_type => $message_transport_type, # email, sms, phone, itiva, etc...
2745 wants_digest => $wants_digest, # 1 if you are looking for the digest version, don't pass if you just want either
2750 sub has_messaging_preference {
2751 my ( $self, $params ) = @_;
2753 my $message_name = $params->{message_name};
2754 my $message_transport_type = $params->{message_transport_type};
2755 my $wants_digest = $params->{wants_digest};
2757 return $self->_result->search_related_rs(
2758 'borrower_message_preferences',
2762 [ 'borrower_message_transport_preferences', 'message_attribute' ]
2767 =head3 can_patron_change_staff_only_lists
2769 $patron->can_patron_change_staff_only_lists;
2771 Return 1 if a patron has 'Superlibrarian' or 'Catalogue' permission.
2772 Otherwise, return 0.
2776 sub can_patron_change_staff_only_lists {
2777 my ( $self, $params ) = @_;
2778 return 1 if C4::Auth::haspermission( $self->userid, { 'catalogue' => 1 });
2782 =head3 can_patron_change_permitted_staff_lists
2784 $patron->can_patron_change_permitted_staff_lists;
2786 Return 1 if a patron has 'Superlibrarian' or 'Catalogue' and 'edit_public_list_contents' permissions.
2787 Otherwise, return 0.
2791 sub can_patron_change_permitted_staff_lists {
2792 my ( $self, $params ) = @_;
2793 return 1 if C4::Auth::haspermission( $self->userid, { 'catalogue' => 1, lists => 'edit_public_list_contents' } );
2797 =head3 encode_secret
2799 $patron->encode_secret($secret32);
2801 Secret (TwoFactorAuth expects it in base32 format) is encrypted.
2802 You still need to call ->store.
2807 my ( $self, $secret ) = @_;
2809 return $self->secret( Koha::Encryption->new->encrypt_hex($secret) );
2811 return $self->secret($secret);
2814 =head3 decoded_secret
2816 my $secret32 = $patron->decoded_secret;
2818 Decode the patron secret. We expect to get back a base32 string, but this
2819 is not checked here. Caller of encode_secret is responsible for that.
2823 sub decoded_secret {
2825 if( $self->secret ) {
2826 return Koha::Encryption->new->decrypt_hex( $self->secret );
2828 return $self->secret;
2831 =head3 virtualshelves
2833 my $shelves = $patron->virtualshelves;
2837 sub virtualshelves {
2839 return Koha::Virtualshelves->_new_from_dbic( scalar $self->_result->virtualshelves );
2844 my $savings = $patron->get_savings;
2846 Use the replacement price of patron's old and current issues to calculate how much they have 'saved' by using the library.
2853 my @itemnumbers = grep { defined $_ } ( $self->old_checkouts->get_column('itemnumber'), $self->checkouts->get_column('itemnumber') );
2855 return Koha::Items->search(
2856 { itemnumber => { -in => \@itemnumbers } },
2857 { select => [ { sum => 'me.replacementprice' } ],
2858 as => ['total_savings']
2860 )->next->get_column('total_savings') // 0;
2863 =head3 alert_subscriptions
2865 my $subscriptions = $patron->alert_subscriptions;
2867 Return a Koha::Subscriptions object containing subscriptions for which the patron has subscribed to email alerts.
2871 sub alert_subscriptions {
2874 my @alerts = $self->_result->alerts;
2875 my @subscription_ids = map { $_->externalid } @alerts;
2877 return Koha::Subscriptions->search( { subscriptionid => \@subscription_ids } );
2882 my $consent = $patron->consent(TYPE);
2884 Returns the first consent of type TYPE (there should be only one) or a new instance
2885 of Koha::Patron::Consent.
2890 my ( $self, $type ) = @_;
2891 Koha::Exceptions::MissingParameter->throw('Missing consent type') if !$type;
2892 my $consents = Koha::Patron::Consents->search(
2894 borrowernumber => $self->borrowernumber,
2898 return $consents && $consents->count
2900 : Koha::Patron::Consent->new( { borrowernumber => $self->borrowernumber, type => $type } );
2903 =head2 Internal methods
2915 Kyle M Hall <kyle@bywatersolutions.com>
2916 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
2917 Martin Renvoize <martin.renvoize@ptfs-europe.com>