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::Log qw( logaction );
31 use Koha::ArticleRequests;
35 use Koha::CirculationRules;
36 use Koha::Club::Enrollments;
38 use Koha::DateUtils qw( dt_from_string );
40 use Koha::Exceptions::Password;
42 use Koha::Old::Checkouts;
43 use Koha::Patron::Attributes;
44 use Koha::Patron::Categories;
45 use Koha::Patron::Debarments;
46 use Koha::Patron::HouseboundProfile;
47 use Koha::Patron::HouseboundRole;
48 use Koha::Patron::Images;
49 use Koha::Patron::Messages;
50 use Koha::Patron::Modifications;
51 use Koha::Patron::Relationships;
55 use Koha::Result::Boolean;
56 use Koha::Subscription::Routinglists;
58 use Koha::Virtualshelves;
60 use base qw(Koha::Object);
62 use constant ADMINISTRATIVE_LOCKOUT => -1;
64 our $RESULTSET_PATRON_ID_MAPPING = {
65 Accountline => 'borrowernumber',
66 Aqbasketuser => 'borrowernumber',
67 Aqbudget => 'budget_owner_id',
68 Aqbudgetborrower => 'borrowernumber',
69 ArticleRequest => 'borrowernumber',
70 BorrowerDebarment => 'borrowernumber',
71 BorrowerFile => 'borrowernumber',
72 BorrowerModification => 'borrowernumber',
73 ClubEnrollment => 'borrowernumber',
74 Issue => 'borrowernumber',
75 ItemsLastBorrower => 'borrowernumber',
76 Linktracker => 'borrowernumber',
77 Message => 'borrowernumber',
78 MessageQueue => 'borrowernumber',
79 OldIssue => 'borrowernumber',
80 OldReserve => 'borrowernumber',
81 Rating => 'borrowernumber',
82 Reserve => 'borrowernumber',
83 Review => 'borrowernumber',
84 SearchHistory => 'userid',
85 Statistic => 'borrowernumber',
86 Suggestion => 'suggestedby',
87 TagAll => 'borrowernumber',
88 Virtualshelfcontent => 'borrowernumber',
89 Virtualshelfshare => 'borrowernumber',
90 Virtualshelve => 'owner',
95 Koha::Patron - Koha Patron Object class
106 my ( $class, $params ) = @_;
108 return $class->SUPER::new($params);
111 =head3 fixup_cardnumber
113 Autogenerate next cardnumber from highest value found in database
117 sub fixup_cardnumber {
120 my $max = $self->cardnumber;
121 Koha::Plugins->call( 'patron_barcode_transform', \$max );
123 $max ||= Koha::Patrons->search({
124 cardnumber => {-regexp => '^-?[0-9]+$'}
126 select => \'CAST(cardnumber AS SIGNED)',
127 as => ['cast_cardnumber']
128 })->_resultset->get_column('cast_cardnumber')->max;
129 $self->cardnumber(($max || 0) +1);
132 =head3 trim_whitespace
134 trim whitespace from data which has some non-whitespace in it.
135 Could be moved to Koha::Object if need to be reused
139 sub trim_whitespaces {
142 my $schema = Koha::Database->new->schema;
143 my @columns = $schema->source($self->_type)->columns;
145 for my $column( @columns ) {
146 my $value = $self->$column;
147 if ( defined $value ) {
148 $value =~ s/^\s*|\s*$//g;
149 $self->$column($value);
155 =head3 plain_text_password
157 $patron->plain_text_password( $password );
159 stores a copy of the unencrypted password in the object
160 for use in code before encrypting for db
164 sub plain_text_password {
165 my ( $self, $password ) = @_;
167 $self->{_plain_text_password} = $password;
170 return $self->{_plain_text_password}
171 if $self->{_plain_text_password};
178 Patron specific store method to cleanup record
179 and do other necessary things before saving
187 $self->_result->result_source->schema->txn_do(
190 C4::Context->preference("autoMemberNum")
191 and ( not defined $self->cardnumber
192 or $self->cardnumber eq '' )
195 # Warning: The caller is responsible for locking the members table in write
196 # mode, to avoid database corruption.
197 # We are in a transaction but the table is not locked
198 $self->fixup_cardnumber;
201 unless( $self->category->in_storage ) {
202 Koha::Exceptions::Object::FKConstraint->throw(
203 broken_fk => 'categorycode',
204 value => $self->categorycode,
208 $self->trim_whitespaces;
210 my $new_cardnumber = $self->cardnumber;
211 Koha::Plugins->call( 'patron_barcode_transform', \$new_cardnumber );
212 $self->cardnumber( $new_cardnumber );
214 # Set surname to uppercase if uppercasesurname is true
215 $self->surname( uc($self->surname) )
216 if C4::Context->preference("uppercasesurnames");
218 $self->relationship(undef) # We do not want to store an empty string in this field
219 if defined $self->relationship
220 and $self->relationship eq "";
222 unless ( $self->in_storage ) { #AddMember
224 # Generate a valid userid/login if needed
225 $self->generate_userid
226 if not $self->userid or not $self->has_valid_userid;
228 # Add expiration date if it isn't already there
229 unless ( $self->dateexpiry ) {
230 $self->dateexpiry( $self->category->get_expiry_date );
233 # Add enrollment date if it isn't already there
234 unless ( $self->dateenrolled ) {
235 $self->dateenrolled(dt_from_string);
238 # Set the privacy depending on the patron's category
239 my $default_privacy = $self->category->default_privacy || q{};
241 $default_privacy eq 'default' ? 1
242 : $default_privacy eq 'never' ? 2
243 : $default_privacy eq 'forever' ? 0
245 $self->privacy($default_privacy);
247 # Call any check_password plugins if password is passed
248 if ( C4::Context->config("enable_plugins") && $self->password ) {
249 my @plugins = Koha::Plugins->new()->GetPlugins({
250 method => 'check_password',
252 foreach my $plugin ( @plugins ) {
253 # This plugin hook will also be used by a plugin for the Norwegian national
254 # patron database. This is why we need to pass both the password and the
255 # borrowernumber to the plugin.
256 my $ret = $plugin->check_password(
258 password => $self->password,
259 borrowernumber => $self->borrowernumber
262 if ( $ret->{'error'} == 1 ) {
263 Koha::Exceptions::Password::Plugin->throw();
268 # Make a copy of the plain text password for later use
269 $self->plain_text_password( $self->password );
271 # Create a disabled account if no password provided
272 $self->password( $self->password
273 ? Koha::AuthUtils::hash_password( $self->password )
276 $self->borrowernumber(undef);
278 $self = $self->SUPER::store;
280 $self->add_enrolment_fee_if_needed(0);
282 logaction( "MEMBERS", "CREATE", $self->borrowernumber, "" )
283 if C4::Context->preference("BorrowersLog");
287 my $self_from_storage = $self->get_from_storage;
288 # FIXME We should not deal with that here, callers have to do this job
289 # Moved from ModMember to prevent regressions
290 unless ( $self->userid ) {
291 my $stored_userid = $self_from_storage->userid;
292 $self->userid($stored_userid);
295 # Password must be updated using $self->set_password
296 $self->password($self_from_storage->password);
298 if ( $self->category->categorycode ne
299 $self_from_storage->category->categorycode )
301 # Add enrolement fee on category change if required
302 $self->add_enrolment_fee_if_needed(1)
303 if C4::Context->preference('FeeOnChangePatronCategory');
305 # Clean up guarantors on category change if required
306 $self->guarantor_relationships->delete
307 if ( $self->category->category_type ne 'C'
308 && $self->category->category_type ne 'P' );
313 if ( C4::Context->preference("BorrowersLog") ) {
315 my $from_storage = $self_from_storage->unblessed;
316 my $from_object = $self->unblessed;
317 my @skip_fields = (qw/lastseen updated_on/);
318 for my $key ( keys %{$from_storage} ) {
319 next if any { /$key/ } @skip_fields;
322 !defined( $from_storage->{$key} )
323 && defined( $from_object->{$key} )
325 || ( defined( $from_storage->{$key} )
326 && !defined( $from_object->{$key} ) )
328 defined( $from_storage->{$key} )
329 && defined( $from_object->{$key} )
330 && ( $from_storage->{$key} ne
331 $from_object->{$key} )
336 before => $from_storage->{$key},
337 after => $from_object->{$key}
342 if ( defined($info) ) {
346 $self->borrowernumber,
349 { utf8 => 1, pretty => 1, canonical => 1 }
356 $self = $self->SUPER::store;
367 Delete patron's holds, lists and finally the patron.
369 Lists owned by the borrower are deleted, but entries from the borrower to
370 other lists are kept.
377 my $anonymous_patron = C4::Context->preference("AnonymousPatron");
378 Koha::Exceptions::Patron::FailedDeleteAnonymousPatron->throw() if $anonymous_patron && $self->id eq $anonymous_patron;
380 $self->_result->result_source->schema->txn_do(
382 # Cancel Patron's holds
383 my $holds = $self->holds;
384 while( my $hold = $holds->next ){
388 # Delete all lists and all shares of this borrower
389 # Consistent with the approach Koha uses on deleting individual lists
390 # Note that entries in virtualshelfcontents added by this borrower to
391 # lists of others will be handled by a table constraint: the borrower
392 # is set to NULL in those entries.
394 # We could handle the above deletes via a constraint too.
395 # But a new BZ report 11889 has been opened to discuss another approach.
396 # Instead of deleting we could also disown lists (based on a pref).
397 # In that way we could save shared and public lists.
398 # The current table constraints support that idea now.
399 # This pref should then govern the results of other routines/methods such as
400 # Koha::Virtualshelf->new->delete too.
401 # FIXME Could be $patron->get_lists
402 $_->delete for Koha::Virtualshelves->search( { owner => $self->borrowernumber } )->as_list;
404 # We cannot have a FK on borrower_modifications.borrowernumber, the table is also used
406 $_->delete for Koha::Patron::Modifications->search( { borrowernumber => $self->borrowernumber } )->as_list;
408 $self->SUPER::delete;
410 logaction( "MEMBERS", "DELETE", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog");
419 my $patron_category = $patron->category
421 Return the patron category for this patron
427 return Koha::Patron::Category->_new_from_dbic( $self->_result->categorycode );
437 return Koha::Patron::Images->find( $self->borrowernumber );
442 Returns a Koha::Library object representing the patron's home library.
448 return Koha::Library->_new_from_dbic($self->_result->branchcode);
453 Returns a Koha::SMS::Provider object representing the patron's SMS provider.
459 my $sms_provider_rs = $self->_result->sms_provider;
460 return unless $sms_provider_rs;
461 return Koha::SMS::Provider->_new_from_dbic($sms_provider_rs);
464 =head3 guarantor_relationships
466 Returns Koha::Patron::Relationships object for this patron's guarantors
468 Returns the set of relationships for the patrons that are guarantors for this patron.
470 This is returned instead of a Koha::Patron object because the guarantor
471 may not exist as a patron in Koha. If this is true, the guarantors name
472 exists in the Koha::Patron::Relationship object and will have no guarantor_id.
476 sub guarantor_relationships {
479 return Koha::Patron::Relationships->search( { guarantee_id => $self->id } );
482 =head3 guarantee_relationships
484 Returns Koha::Patron::Relationships object for this patron's guarantors
486 Returns the set of relationships for the patrons that are guarantees for this patron.
488 The method returns Koha::Patron::Relationship objects for the sake
489 of consistency with the guantors method.
490 A guarantee by definition must exist as a patron in Koha.
494 sub guarantee_relationships {
497 return Koha::Patron::Relationships->search(
498 { guarantor_id => $self->id },
500 prefetch => 'guarantee',
501 order_by => { -asc => [ 'guarantee.surname', 'guarantee.firstname' ] },
506 =head3 relationships_debt
508 Returns the amount owed by the patron's guarantors *and* the other guarantees of those guarantors
512 sub relationships_debt {
513 my ($self, $params) = @_;
515 my $include_guarantors = $params->{include_guarantors};
516 my $only_this_guarantor = $params->{only_this_guarantor};
517 my $include_this_patron = $params->{include_this_patron};
520 if ( $only_this_guarantor ) {
521 @guarantors = $self->guarantee_relationships->count ? ( $self ) : ();
522 Koha::Exceptions::BadParameter->throw( { parameter => 'only_this_guarantor' } ) unless @guarantors;
523 } elsif ( $self->guarantor_relationships->count ) {
524 # I am a guarantee, just get all my guarantors
525 @guarantors = $self->guarantor_relationships->guarantors->as_list;
527 # I am a guarantor, I need to get all the guarantors of all my guarantees
528 @guarantors = map { $_->guarantor_relationships->guarantors->as_list } $self->guarantee_relationships->guarantees->as_list;
531 my $non_issues_charges = 0;
532 my $seen = $include_this_patron ? {} : { $self->id => 1 }; # For tracking members already added to the total
533 foreach my $guarantor (@guarantors) {
534 $non_issues_charges += $guarantor->account->non_issues_charges if $include_guarantors && !$seen->{ $guarantor->id };
536 # We've added what the guarantor owes, not added in that guarantor's guarantees as well
537 my @guarantees = map { $_->guarantee } $guarantor->guarantee_relationships->as_list;
538 my $guarantees_non_issues_charges = 0;
539 foreach my $guarantee (@guarantees) {
540 next if $seen->{ $guarantee->id };
541 $guarantees_non_issues_charges += $guarantee->account->non_issues_charges;
542 # Mark this guarantee as seen so we don't double count a guarantee linked to multiple guarantors
543 $seen->{ $guarantee->id } = 1;
546 $non_issues_charges += $guarantees_non_issues_charges;
547 $seen->{ $guarantor->id } = 1;
550 return $non_issues_charges;
553 =head3 housebound_profile
555 Returns the HouseboundProfile associated with this patron.
559 sub housebound_profile {
561 my $profile = $self->_result->housebound_profile;
562 return Koha::Patron::HouseboundProfile->_new_from_dbic($profile)
567 =head3 housebound_role
569 Returns the HouseboundRole associated with this patron.
573 sub housebound_role {
576 my $role = $self->_result->housebound_role;
577 return Koha::Patron::HouseboundRole->_new_from_dbic($role) if ( $role );
583 Returns the siblings of this patron.
590 my @guarantors = $self->guarantor_relationships()->guarantors()->as_list;
592 return unless @guarantors;
595 map { $_->guarantee_relationships()->guarantees()->as_list } @guarantors;
597 return unless @siblings;
601 grep { !$seen{ $_->id }++ && ( $_->id != $self->id ) } @siblings;
603 return Koha::Patrons->search( { borrowernumber => { -in => [ map { $_->id } @siblings ] } } );
608 my $patron = Koha::Patrons->find($id);
609 $patron->merge_with( \@patron_ids );
611 This subroutine merges a list of patrons into the patron record. This is accomplished by finding
612 all related patron ids for the patrons to be merged in other tables and changing the ids to be that
613 of the keeper patron.
618 my ( $self, $patron_ids ) = @_;
620 my $anonymous_patron = C4::Context->preference("AnonymousPatron");
621 return if $anonymous_patron && $self->id eq $anonymous_patron;
623 my @patron_ids = @{ $patron_ids };
625 # Ensure the keeper isn't in the list of patrons to merge
626 @patron_ids = grep { $_ ne $self->id } @patron_ids;
628 my $schema = Koha::Database->new()->schema();
632 $self->_result->result_source->schema->txn_do( sub {
633 foreach my $patron_id (@patron_ids) {
635 next if $patron_id eq $anonymous_patron;
637 my $patron = Koha::Patrons->find( $patron_id );
641 # Unbless for safety, the patron will end up being deleted
642 $results->{merged}->{$patron_id}->{patron} = $patron->unblessed;
644 my $attributes = $patron->extended_attributes;
645 my $new_attributes = [
646 map { { code => $_->code, attribute => $_->attribute } }
649 $attributes->delete; # We need to delete before trying to merge them to prevent exception on unique and repeatable
650 for my $attribute ( @$new_attributes ) {
652 $self->add_extended_attribute($attribute);
654 # Don't block the merge if there is a non-repeatable attribute that cannot be added to the current patron.
655 unless ( $_->isa('Koha::Exceptions::Patron::Attribute::NonRepeatable') ) {
661 while (my ($r, $field) = each(%$RESULTSET_PATRON_ID_MAPPING)) {
662 my $rs = $schema->resultset($r)->search({ $field => $patron_id });
663 $results->{merged}->{ $patron_id }->{updated}->{$r} = $rs->count();
664 $rs->update({ $field => $self->id });
665 if ( $r eq 'BorrowerDebarment' ) {
666 Koha::Patron::Debarments::UpdateBorrowerDebarmentFlags($self->id);
670 $patron->move_to_deleted();
680 =head3 wants_check_for_previous_checkout
682 $wants_check = $patron->wants_check_for_previous_checkout;
684 Return 1 if Koha needs to perform PrevIssue checking, else 0.
688 sub wants_check_for_previous_checkout {
690 my $syspref = C4::Context->preference("checkPrevCheckout");
693 ## Hard syspref trumps all
694 return 1 if ($syspref eq 'hardyes');
695 return 0 if ($syspref eq 'hardno');
696 ## Now, patron pref trumps all
697 return 1 if ($self->checkprevcheckout eq 'yes');
698 return 0 if ($self->checkprevcheckout eq 'no');
700 # More complex: patron inherits -> determine category preference
701 my $checkPrevCheckoutByCat = $self->category->checkprevcheckout;
702 return 1 if ($checkPrevCheckoutByCat eq 'yes');
703 return 0 if ($checkPrevCheckoutByCat eq 'no');
705 # Finally: category preference is inherit, default to 0
706 if ($syspref eq 'softyes') {
713 =head3 do_check_for_previous_checkout
715 $do_check = $patron->do_check_for_previous_checkout($item);
717 Return 1 if the bib associated with $ITEM has previously been checked out to
718 $PATRON, 0 otherwise.
722 sub do_check_for_previous_checkout {
723 my ( $self, $item ) = @_;
726 my $biblio = Koha::Biblios->find( $item->{biblionumber} );
727 if ( $biblio->is_serial ) {
728 push @item_nos, $item->{itemnumber};
730 # Get all itemnumbers for given bibliographic record.
731 @item_nos = $biblio->items->get_column( 'itemnumber' );
734 # Create (old)issues search criteria
736 borrowernumber => $self->borrowernumber,
737 itemnumber => \@item_nos,
740 my $delay = C4::Context->preference('CheckPrevCheckoutDelay') || 0;
742 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
743 my $newer_than = dt_from_string()->subtract( days => $delay );
744 $criteria->{'returndate'} = { '>' => $dtf->format_datetime($newer_than), };
747 # Check current issues table
748 my $issues = Koha::Checkouts->search($criteria);
749 return 1 if $issues->count; # 0 || N
751 # Check old issues table
752 my $old_issues = Koha::Old::Checkouts->search($criteria);
753 return $old_issues->count; # 0 || N
758 my $debarment_expiration = $patron->is_debarred;
760 Returns the date a patron debarment will expire, or undef if the patron is not
768 return unless $self->debarred;
769 return $self->debarred
770 if $self->debarred =~ '^9999'
771 or dt_from_string( $self->debarred ) > dt_from_string;
777 my $is_expired = $patron->is_expired;
779 Returns 1 if the patron is expired or 0;
785 return 0 unless $self->dateexpiry;
786 return 0 if $self->dateexpiry =~ '^9999';
787 return 1 if dt_from_string( $self->dateexpiry ) < dt_from_string->truncate( to => 'day' );
791 =head3 is_going_to_expire
793 my $is_going_to_expire = $patron->is_going_to_expire;
795 Returns 1 if the patron is going to expired, depending on the NotifyBorrowerDeparture pref or 0
799 sub is_going_to_expire {
802 my $delay = C4::Context->preference('NotifyBorrowerDeparture') || 0;
804 return 0 unless $delay;
805 return 0 unless $self->dateexpiry;
806 return 0 if $self->dateexpiry =~ '^9999';
807 return 1 if dt_from_string( $self->dateexpiry, undef, 'floating' )->subtract( days => $delay ) < dt_from_string(undef, undef, 'floating')->truncate( to => 'day' );
813 $patron->set_password({ password => $plain_text_password [, skip_validation => 1 ] });
815 Set the patron's password.
819 The passed string is validated against the current password enforcement policy.
820 Validation can be skipped by passing the I<skip_validation> parameter.
822 Exceptions are thrown if the password is not good enough.
826 =item Koha::Exceptions::Password::TooShort
828 =item Koha::Exceptions::Password::WhitespaceCharacters
830 =item Koha::Exceptions::Password::TooWeak
832 =item Koha::Exceptions::Password::Plugin (if a "check password" plugin is enabled)
839 my ( $self, $args ) = @_;
841 my $password = $args->{password};
843 unless ( $args->{skip_validation} ) {
844 my ( $is_valid, $error ) = Koha::AuthUtils::is_password_valid( $password, $self->category );
847 if ( $error eq 'too_short' ) {
848 my $min_length = $self->category->effective_min_password_length;
849 $min_length = 3 if not $min_length or $min_length < 3;
851 my $password_length = length($password);
852 Koha::Exceptions::Password::TooShort->throw(
853 length => $password_length, min_length => $min_length );
855 elsif ( $error eq 'has_whitespaces' ) {
856 Koha::Exceptions::Password::WhitespaceCharacters->throw();
858 elsif ( $error eq 'too_weak' ) {
859 Koha::Exceptions::Password::TooWeak->throw();
864 if ( C4::Context->config("enable_plugins") ) {
865 # Call any check_password plugins
866 my @plugins = Koha::Plugins->new()->GetPlugins({
867 method => 'check_password',
869 foreach my $plugin ( @plugins ) {
870 # This plugin hook will also be used by a plugin for the Norwegian national
871 # patron database. This is why we need to pass both the password and the
872 # borrowernumber to the plugin.
873 my $ret = $plugin->check_password(
875 password => $password,
876 borrowernumber => $self->borrowernumber
879 # This plugin hook will also be used by a plugin for the Norwegian national
880 # patron database. This is why we need to call the actual plugins and then
881 # check skip_validation afterwards.
882 if ( $ret->{'error'} == 1 && !$args->{skip_validation} ) {
883 Koha::Exceptions::Password::Plugin->throw();
888 my $digest = Koha::AuthUtils::hash_password($password);
890 # We do not want to call $self->store and retrieve password from DB
891 $self->password($digest);
892 $self->login_attempts(0);
895 logaction( "MEMBERS", "CHANGE PASS", $self->borrowernumber, "" )
896 if C4::Context->preference("BorrowersLog");
904 my $new_expiry_date = $patron->renew_account
906 Extending the subscription to the expiry date.
913 if ( C4::Context->preference('BorrowerRenewalPeriodBase') eq 'combination' ) {
914 $date = ( dt_from_string gt dt_from_string( $self->dateexpiry ) ) ? dt_from_string : dt_from_string( $self->dateexpiry );
917 C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry'
918 ? dt_from_string( $self->dateexpiry )
921 my $expiry_date = $self->category->get_expiry_date($date);
923 $self->dateexpiry($expiry_date);
924 $self->date_renewed( dt_from_string() );
927 $self->add_enrolment_fee_if_needed(1);
929 logaction( "MEMBERS", "RENEW", $self->borrowernumber, "Membership renewed" ) if C4::Context->preference("BorrowersLog");
930 return dt_from_string( $expiry_date )->truncate( to => 'day' );
935 my $has_overdues = $patron->has_overdues;
937 Returns the number of patron's overdues
943 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
944 return $self->_result->issues->search({ date_due => { '<' => $dtf->format_datetime( dt_from_string() ) } })->count;
949 $patron->track_login;
950 $patron->track_login({ force => 1 });
952 Tracks a (successful) login attempt.
953 The preference TrackLastPatronActivity must be enabled. Or you
954 should pass the force parameter.
959 my ( $self, $params ) = @_;
962 !C4::Context->preference('TrackLastPatronActivity');
963 $self->lastseen( dt_from_string() )->store;
966 =head3 move_to_deleted
968 my $is_moved = $patron->move_to_deleted;
970 Move a patron to the deletedborrowers table.
971 This can be done before deleting a patron, to make sure the data are not completely deleted.
975 sub move_to_deleted {
977 my $patron_infos = $self->unblessed;
978 delete $patron_infos->{updated_on}; #This ensures the updated_on date in deletedborrowers will be set to the current timestamp
979 return Koha::Database->new->schema->resultset('Deletedborrower')->create($patron_infos);
982 =head3 can_request_article
984 if ( $patron->can_request_article( $library->id ) ) { ... }
986 Returns true if the patron can request articles. As limits apply for the patron
987 on the same day, those completed the same day are considered as current.
989 A I<library_id> can be passed as parameter, falling back to userenv if absent.
993 sub can_request_article {
994 my ($self, $library_id) = @_;
996 $library_id //= C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef;
998 my $rule = Koha::CirculationRules->get_effective_rule(
1000 branchcode => $library_id,
1001 categorycode => $self->categorycode,
1002 rule_name => 'open_article_requests_limit'
1006 my $limit = ($rule) ? $rule->rule_value : undef;
1008 return 1 unless defined $limit;
1010 my $count = Koha::ArticleRequests->search(
1011 [ { borrowernumber => $self->borrowernumber, status => [ 'REQUESTED', 'PENDING', 'PROCESSING' ] },
1012 { borrowernumber => $self->borrowernumber, status => 'COMPLETED', updated_on => { '>=' => \'CAST(NOW() AS DATE)' } },
1015 return $count < $limit ? 1 : 0;
1018 =head3 article_request_fee
1020 my $fee = $patron->article_request_fee(
1022 [ library_id => $library->id, ]
1026 Returns the fee to be charged to the patron when it places an article request.
1028 A I<library_id> can be passed as parameter, falling back to userenv if absent.
1032 sub article_request_fee {
1033 my ($self, $params) = @_;
1035 my $library_id = $params->{library_id};
1037 $library_id //= C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef;
1039 my $rule = Koha::CirculationRules->get_effective_rule(
1041 branchcode => $library_id,
1042 categorycode => $self->categorycode,
1043 rule_name => 'article_request_fee'
1047 my $fee = ($rule) ? $rule->rule_value + 0 : 0;
1052 =head3 add_article_request_fee_if_needed
1054 my $fee = $patron->add_article_request_fee_if_needed(
1056 [ item_id => $item->id,
1057 library_id => $library->id, ]
1061 If an article request fee needs to be charged, it adds a debit to the patron's
1064 Returns the fee line.
1066 A I<library_id> can be passed as parameter, falling back to userenv if absent.
1070 sub add_article_request_fee_if_needed {
1071 my ($self, $params) = @_;
1073 my $library_id = $params->{library_id};
1074 my $item_id = $params->{item_id};
1076 $library_id //= C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef;
1078 my $amount = $self->article_request_fee(
1080 library_id => $library_id,
1086 if ( $amount > 0 ) {
1087 $debit_line = $self->account->add_debit(
1090 user_id => C4::Context->userenv ? C4::Context->userenv->{'number'} : undef,
1091 interface => C4::Context->interface,
1092 library_id => $library_id,
1093 type => 'ARTICLE_REQUEST',
1094 item_id => $item_id,
1102 =head3 article_requests
1104 my $article_requests = $patron->article_requests;
1106 Returns the patron article requests.
1110 sub article_requests {
1113 return Koha::ArticleRequests->_new_from_dbic( scalar $self->_result->article_requests );
1116 =head3 add_enrolment_fee_if_needed
1118 my $enrolment_fee = $patron->add_enrolment_fee_if_needed($renewal);
1120 Add enrolment fee for a patron if needed.
1122 $renewal - boolean denoting whether this is an account renewal or not
1126 sub add_enrolment_fee_if_needed {
1127 my ($self, $renewal) = @_;
1128 my $enrolment_fee = $self->category->enrolmentfee;
1129 if ( $enrolment_fee && $enrolment_fee > 0 ) {
1130 my $type = $renewal ? 'ACCOUNT_RENEW' : 'ACCOUNT';
1131 $self->account->add_debit(
1133 amount => $enrolment_fee,
1134 user_id => C4::Context->userenv ? C4::Context->userenv->{'number'} : undef,
1135 interface => C4::Context->interface,
1136 library_id => C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef,
1141 return $enrolment_fee || 0;
1146 my $checkouts = $patron->checkouts
1152 my $checkouts = $self->_result->issues;
1153 return Koha::Checkouts->_new_from_dbic( $checkouts );
1156 =head3 pending_checkouts
1158 my $pending_checkouts = $patron->pending_checkouts
1160 This method will return the same as $self->checkouts, but with a prefetch on
1161 items, biblio and biblioitems.
1163 It has been introduced to replaced the C4::Members::GetPendingIssues subroutine
1165 It should not be used directly, prefer to access fields you need instead of
1166 retrieving all these fields in one go.
1170 sub pending_checkouts {
1172 my $checkouts = $self->_result->issues->search(
1176 { -desc => 'me.timestamp' },
1177 { -desc => 'issuedate' },
1178 { -desc => 'issue_id' }, # Sort by issue_id should be enough
1180 prefetch => { item => { biblio => 'biblioitems' } },
1183 return Koha::Checkouts->_new_from_dbic( $checkouts );
1186 =head3 old_checkouts
1188 my $old_checkouts = $patron->old_checkouts
1194 my $old_checkouts = $self->_result->old_issues;
1195 return Koha::Old::Checkouts->_new_from_dbic( $old_checkouts );
1200 my $overdue_items = $patron->get_overdues
1202 Return the overdue items
1208 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
1209 return $self->checkouts->search(
1211 'me.date_due' => { '<' => $dtf->format_datetime(dt_from_string) },
1214 prefetch => { item => { biblio => 'biblioitems' } },
1219 sub overdues { my $self = shift; return $self->get_overdues(@_); }
1221 =head3 get_routing_lists
1223 my $routinglists = $patron->get_routing_lists
1225 Returns the routing lists a patron is subscribed to.
1229 sub get_routing_lists {
1231 my $routing_list_rs = $self->_result->subscriptionroutinglists;
1232 return Koha::Subscription::Routinglists->_new_from_dbic($routing_list_rs);
1237 my $age = $patron->get_age
1239 Return the age of the patron
1246 return unless $self->dateofbirth;
1248 my $date_of_birth = dt_from_string( $self->dateofbirth );
1249 my $today = dt_from_string->truncate( to => 'day' );
1251 return $today->subtract_datetime( $date_of_birth )->years;
1256 my $is_valid = $patron->is_valid_age
1258 Return 1 if patron's age is between allowed limits, returns 0 if it's not.
1264 my $age = $self->get_age;
1266 my $patroncategory = $self->category;
1267 my ($low,$high) = ($patroncategory->dateofbirthrequired, $patroncategory->upperagelimit);
1269 return (defined($age) && (($high && ($age > $high)) or ($low && ($age < $low)))) ? 0 : 1;
1274 my $account = $patron->account
1280 return Koha::Account->new( { patron_id => $self->borrowernumber } );
1285 my $holds = $patron->holds
1287 Return all the holds placed by this patron
1293 my $holds_rs = $self->_result->reserves->search( {}, { order_by => 'reservedate' } );
1294 return Koha::Holds->_new_from_dbic($holds_rs);
1299 my $old_holds = $patron->old_holds
1301 Return all the historical holds for this patron
1307 my $old_holds_rs = $self->_result->old_reserves->search( {}, { order_by => 'reservedate' } );
1308 return Koha::Old::Holds->_new_from_dbic($old_holds_rs);
1311 =head3 return_claims
1313 my $return_claims = $patron->return_claims
1319 my $return_claims = $self->_result->return_claims_borrowernumbers;
1320 return Koha::Checkouts::ReturnClaims->_new_from_dbic( $return_claims );
1323 =head3 notice_email_address
1325 my $email = $patron->notice_email_address;
1327 Return the email address of patron used for notices.
1328 Returns the empty string if no email address.
1332 sub notice_email_address{
1335 my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
1336 # if syspref is set to 'first valid' (value == OFF), look up email address
1337 if ( $which_address eq 'OFF' ) {
1338 return $self->first_valid_email_address;
1341 return $self->$which_address || '';
1344 =head3 first_valid_email_address
1346 my $first_valid_email_address = $patron->first_valid_email_address
1348 Return the first valid email address for a patron.
1349 For now, the order is defined as email, emailpro, B_email.
1350 Returns the empty string if the borrower has no email addresses.
1354 sub first_valid_email_address {
1357 return $self->email() || $self->emailpro() || $self->B_email() || q{};
1360 =head3 get_club_enrollments
1364 sub get_club_enrollments {
1367 return Koha::Club::Enrollments->search( { borrowernumber => $self->borrowernumber(), date_canceled => undef } );
1370 =head3 get_enrollable_clubs
1374 sub get_enrollable_clubs {
1375 my ( $self, $is_enrollable_from_opac ) = @_;
1378 $params->{is_enrollable_from_opac} = $is_enrollable_from_opac
1379 if $is_enrollable_from_opac;
1380 $params->{is_email_required} = 0 unless $self->first_valid_email_address();
1382 $params->{borrower} = $self;
1384 return Koha::Clubs->get_enrollable($params);
1387 =head3 account_locked
1389 my $is_locked = $patron->account_locked
1391 Return true if the patron has reached the maximum number of login attempts
1392 (see pref FailedLoginAttempts). If login_attempts is < 0, this is interpreted
1393 as an administrative lockout (independent of FailedLoginAttempts; see also
1394 Koha::Patron->lock).
1395 Otherwise return false.
1396 If the pref is not set (empty string, null or 0), the feature is considered as
1401 sub account_locked {
1403 my $FailedLoginAttempts = C4::Context->preference('FailedLoginAttempts');
1404 return 1 if $FailedLoginAttempts
1405 and $self->login_attempts
1406 and $self->login_attempts >= $FailedLoginAttempts;
1407 return 1 if ($self->login_attempts || 0) < 0; # administrative lockout
1411 =head3 can_see_patron_infos
1413 my $can_see = $patron->can_see_patron_infos( $patron );
1415 Return true if the patron (usually the logged in user) can see the patron's infos for a given patron
1419 sub can_see_patron_infos {
1420 my ( $self, $patron ) = @_;
1421 return unless $patron;
1422 return $self->can_see_patrons_from( $patron->branchcode );
1425 =head3 can_see_patrons_from
1427 my $can_see = $patron->can_see_patrons_from( $branchcode );
1429 Return true if the patron (usually the logged in user) can see the patron's infos from a given library
1433 sub can_see_patrons_from {
1434 my ( $self, $branchcode ) = @_;
1436 if ( $self->branchcode eq $branchcode ) {
1438 } elsif ( $self->has_permission( { borrowers => 'view_borrower_infos_from_any_libraries' } ) ) {
1440 } elsif ( my $library_groups = $self->library->library_groups ) {
1441 while ( my $library_group = $library_groups->next ) {
1442 if ( $library_group->parent->has_child( $branchcode ) ) {
1453 my $can_log_into = $patron->can_log_into( $library );
1455 Given a I<Koha::Library> object, it returns a boolean representing
1456 the fact the patron can log into a the library.
1461 my ( $self, $library ) = @_;
1465 if ( C4::Context->preference('IndependentBranches') ) {
1467 if $self->is_superlibrarian
1468 or $self->branchcode eq $library->id;
1478 =head3 libraries_where_can_see_patrons
1480 my $libraries = $patron-libraries_where_can_see_patrons;
1482 Return the list of branchcodes(!) of libraries the patron is allowed to see other patron's infos.
1483 The branchcodes are arbitrarily returned sorted.
1484 We are supposing here that the object is related to the logged in patron (use of C4::Context::only_my_library)
1486 An empty array means no restriction, the patron can see patron's infos from any libraries.
1490 sub libraries_where_can_see_patrons {
1492 my $userenv = C4::Context->userenv;
1494 return () unless $userenv; # For tests, but userenv should be defined in tests...
1496 my @restricted_branchcodes;
1497 if (C4::Context::only_my_library) {
1498 push @restricted_branchcodes, $self->branchcode;
1502 $self->has_permission(
1503 { borrowers => 'view_borrower_infos_from_any_libraries' }
1507 my $library_groups = $self->library->library_groups({ ft_hide_patron_info => 1 });
1508 if ( $library_groups->count )
1510 while ( my $library_group = $library_groups->next ) {
1511 my $parent = $library_group->parent;
1512 if ( $parent->has_child( $self->branchcode ) ) {
1513 push @restricted_branchcodes, $parent->children->get_column('branchcode');
1518 @restricted_branchcodes = ( $self->branchcode ) unless @restricted_branchcodes;
1522 @restricted_branchcodes = grep { defined $_ } @restricted_branchcodes;
1523 @restricted_branchcodes = uniq(@restricted_branchcodes);
1524 @restricted_branchcodes = sort(@restricted_branchcodes);
1525 return @restricted_branchcodes;
1528 =head3 has_permission
1530 my $permission = $patron->has_permission($required);
1532 See C4::Auth::haspermission for details of syntax for $required
1536 sub has_permission {
1537 my ( $self, $flagsrequired ) = @_;
1538 return unless $self->userid;
1539 # TODO code from haspermission needs to be moved here!
1540 return C4::Auth::haspermission( $self->userid, $flagsrequired );
1543 =head3 is_superlibrarian
1545 my $is_superlibrarian = $patron->is_superlibrarian;
1547 Return true if the patron is a superlibrarian.
1551 sub is_superlibrarian {
1553 return $self->has_permission( { superlibrarian => 1 } ) ? 1 : 0;
1558 my $is_adult = $patron->is_adult
1560 Return true if the patron has a category with a type Adult (A) or Organization (I)
1566 return $self->category->category_type =~ /^(A|I)$/ ? 1 : 0;
1571 my $is_child = $patron->is_child
1573 Return true if the patron has a category with a type Child (C)
1579 return $self->category->category_type eq 'C' ? 1 : 0;
1582 =head3 has_valid_userid
1584 my $patron = Koha::Patrons->find(42);
1585 $patron->userid( $new_userid );
1586 my $has_a_valid_userid = $patron->has_valid_userid
1588 my $patron = Koha::Patron->new( $params );
1589 my $has_a_valid_userid = $patron->has_valid_userid
1591 Return true if the current userid of this patron is valid/unique, otherwise false.
1593 Note that this should be done in $self->store instead and raise an exception if needed.
1597 sub has_valid_userid {
1600 return 0 unless $self->userid;
1602 return 0 if ( $self->userid eq C4::Context->config('user') ); # DB user
1604 my $already_exists = Koha::Patrons->search(
1606 userid => $self->userid,
1609 ? ( borrowernumber => { '!=' => $self->borrowernumber } )
1614 return $already_exists ? 0 : 1;
1617 =head3 generate_userid
1619 my $patron = Koha::Patron->new( $params );
1620 $patron->generate_userid
1622 Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
1624 Set a generated userid ($firstname.$surname if there is a $firstname, or $surname if there is no value in $firstname) plus offset (0 if the $userid is unique, or a higher numeric value if not unique).
1628 sub generate_userid {
1631 my $firstname = $self->firstname // q{};
1632 my $surname = $self->surname // q{};
1633 #The script will "do" the following code and increment the $offset until the generated userid is unique
1635 $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1636 $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1637 my $userid = lc(($firstname)? "$firstname.$surname" : $surname);
1638 $userid = NFKD( $userid );
1639 $userid =~ s/\p{NonspacingMark}//g;
1640 $userid .= $offset unless $offset == 0;
1641 $self->userid( $userid );
1643 } while (! $self->has_valid_userid );
1648 =head3 add_extended_attribute
1652 sub add_extended_attribute {
1653 my ($self, $attribute) = @_;
1655 return Koha::Patron::Attribute->new(
1658 ( borrowernumber => $self->borrowernumber ),
1664 =head3 extended_attributes
1666 Return object of Koha::Patron::Attributes type with all attributes set for this patron
1672 sub extended_attributes {
1673 my ( $self, $attributes ) = @_;
1674 if ($attributes) { # setter
1675 my $schema = $self->_result->result_source->schema;
1678 # Remove the existing one
1679 $self->extended_attributes->filter_by_branch_limitations->delete;
1681 # Insert the new ones
1683 for my $attribute (@$attributes) {
1684 $self->add_extended_attribute($attribute);
1685 $new_types->{$attribute->{code}} = 1;
1688 # Check globally mandatory types
1689 my @required_attribute_types =
1690 Koha::Patron::Attribute::Types->search(
1693 'borrower_attribute_types_branches.b_branchcode' =>
1696 { join => 'borrower_attribute_types_branches' }
1697 )->get_column('code');
1698 for my $type ( @required_attribute_types ) {
1699 Koha::Exceptions::Patron::MissingMandatoryExtendedAttribute->throw(
1701 ) if !$new_types->{$type};
1707 my $rs = $self->_result->borrower_attributes;
1708 # We call search to use the filters in Koha::Patron::Attributes->search
1709 return Koha::Patron::Attributes->_new_from_dbic($rs)->search;
1714 my $messages = $patron->messages;
1716 Return the message attached to the patron.
1722 my $messages_rs = $self->_result->messages_borrowernumbers->search;
1723 return Koha::Patron::Messages->_new_from_dbic($messages_rs);
1728 Koha::Patrons->find($id)->lock({ expire => 1, remove => 1 });
1730 Lock and optionally expire a patron account.
1731 Remove holds and article requests if remove flag set.
1732 In order to distinguish from locking by entering a wrong password, let's
1733 call this an administrative lockout.
1738 my ( $self, $params ) = @_;
1739 $self->login_attempts( ADMINISTRATIVE_LOCKOUT );
1740 if( $params->{expire} ) {
1741 $self->dateexpiry( dt_from_string->subtract(days => 1) );
1744 if( $params->{remove} ) {
1745 $self->holds->delete;
1746 $self->article_requests->delete;
1753 Koha::Patrons->find($id)->anonymize;
1755 Anonymize or clear borrower fields. Fields in BorrowerMandatoryField
1756 are randomized, other personal data is cleared too.
1757 Patrons with issues are skipped.
1763 if( $self->_result->issues->count ) {
1764 warn "Exiting anonymize: patron ".$self->borrowernumber." still has issues";
1767 # Mandatory fields come from the corresponding pref, but email fields
1768 # are removed since scrambled email addresses only generate errors
1769 my $mandatory = { map { (lc $_, 1); } grep { !/email/ }
1770 split /\s*\|\s*/, C4::Context->preference('BorrowerMandatoryField') };
1771 $mandatory->{userid} = 1; # needed since sub store does not clear field
1772 my @columns = $self->_result->result_source->columns;
1773 @columns = grep { !/borrowernumber|branchcode|categorycode|^date|password|flags|updated_on|lastseen|lang|login_attempts|anonymized|auth_method/ } @columns;
1774 push @columns, 'dateofbirth'; # add this date back in
1775 foreach my $col (@columns) {
1776 $self->_anonymize_column($col, $mandatory->{lc $col} );
1778 $self->anonymized(1)->store;
1781 sub _anonymize_column {
1782 my ( $self, $col, $mandatory ) = @_;
1783 my $col_info = $self->_result->result_source->column_info($col);
1784 my $type = $col_info->{data_type};
1785 my $nullable = $col_info->{is_nullable};
1787 if( $type =~ /char|text/ ) {
1789 ? Koha::Token->new->generate({ pattern => '\w{10}' })
1793 } elsif( $type =~ /integer|int$|float|dec|double/ ) {
1794 $val = $nullable ? undef : 0;
1795 } elsif( $type =~ /date|time/ ) {
1796 $val = $nullable ? undef : dt_from_string;
1801 =head3 add_guarantor
1803 my $relationship = $patron->add_guarantor(
1805 borrowernumber => $borrowernumber,
1806 relationships => $relationship,
1810 Adds a new guarantor to a patron.
1815 my ( $self, $params ) = @_;
1817 my $guarantor_id = $params->{guarantor_id};
1818 my $relationship = $params->{relationship};
1820 return Koha::Patron::Relationship->new(
1822 guarantee_id => $self->id,
1823 guarantor_id => $guarantor_id,
1824 relationship => $relationship
1829 =head3 get_extended_attribute
1831 my $attribute_value = $patron->get_extended_attribute( $code );
1833 Return the attribute for the code passed in parameter.
1835 It not exist it returns undef
1837 Note that this will not work for repeatable attribute types.
1839 Maybe you certainly not want to use this method, it is actually only used for SHOW_BARCODE
1840 (which should be a real patron's attribute (not extended)
1844 sub get_extended_attribute {
1845 my ( $self, $code, $value ) = @_;
1846 my $rs = $self->_result->borrower_attributes;
1848 my $attribute = $rs->search({ code => $code, ( $value ? ( attribute => $value ) : () ) });
1849 return unless $attribute->count;
1850 return $attribute->next;
1855 my $json = $patron->to_api;
1857 Overloaded method that returns a JSON representation of the Koha::Patron object,
1858 suitable for API output.
1863 my ( $self, $params ) = @_;
1865 my $json_patron = $self->SUPER::to_api( $params );
1867 $json_patron->{restricted} = ( $self->is_debarred )
1869 : Mojo::JSON->false;
1871 return $json_patron;
1874 =head3 to_api_mapping
1876 This method returns the mapping for representing a Koha::Patron object
1881 sub to_api_mapping {
1883 borrowernotes => 'staff_notes',
1884 borrowernumber => 'patron_id',
1885 branchcode => 'library_id',
1886 categorycode => 'category_id',
1887 checkprevcheckout => 'check_previous_checkout',
1888 contactfirstname => undef, # Unused
1889 contactname => undef, # Unused
1890 contactnote => 'altaddress_notes',
1891 contacttitle => undef, # Unused
1892 dateenrolled => 'date_enrolled',
1893 dateexpiry => 'expiry_date',
1894 dateofbirth => 'date_of_birth',
1895 debarred => undef, # replaced by 'restricted'
1896 debarredcomment => undef, # calculated, API consumers will use /restrictions instead
1897 emailpro => 'secondary_email',
1898 flags => undef, # permissions manipulation handled in /permissions
1899 gonenoaddress => 'incorrect_address',
1900 lastseen => 'last_seen',
1901 lost => 'patron_card_lost',
1902 opacnote => 'opac_notes',
1903 othernames => 'other_name',
1904 password => undef, # password manipulation handled in /password
1905 phonepro => 'secondary_phone',
1906 relationship => 'relationship_type',
1908 smsalertnumber => 'sms_number',
1909 sort1 => 'statistics_1',
1910 sort2 => 'statistics_2',
1911 autorenew_checkouts => 'autorenew_checkouts',
1912 streetnumber => 'street_number',
1913 streettype => 'street_type',
1914 zipcode => 'postal_code',
1915 B_address => 'altaddress_address',
1916 B_address2 => 'altaddress_address2',
1917 B_city => 'altaddress_city',
1918 B_country => 'altaddress_country',
1919 B_email => 'altaddress_email',
1920 B_phone => 'altaddress_phone',
1921 B_state => 'altaddress_state',
1922 B_streetnumber => 'altaddress_street_number',
1923 B_streettype => 'altaddress_street_type',
1924 B_zipcode => 'altaddress_postal_code',
1925 altcontactaddress1 => 'altcontact_address',
1926 altcontactaddress2 => 'altcontact_address2',
1927 altcontactaddress3 => 'altcontact_city',
1928 altcontactcountry => 'altcontact_country',
1929 altcontactfirstname => 'altcontact_firstname',
1930 altcontactphone => 'altcontact_phone',
1931 altcontactsurname => 'altcontact_surname',
1932 altcontactstate => 'altcontact_state',
1933 altcontactzipcode => 'altcontact_postal_code',
1934 primary_contact_method => undef,
1936 auth_method => undef,
1942 Koha::Patrons->queue_notice({ letter_params => $letter_params, message_name => 'DUE'});
1943 Koha::Patrons->queue_notice({ letter_params => $letter_params, message_transports => \@message_transports });
1944 Koha::Patrons->queue_notice({ letter_params => $letter_params, message_transports => \@message_transports, test_mode => 1 });
1946 Queue messages to a patron. Can pass a message that is part of the message_attributes
1947 table or supply the transport to use.
1949 If passed a message name we retrieve the patrons preferences for transports
1950 Otherwise we use the supplied transport. In the case of email or sms we fall back to print if
1951 we have no address/number for sending
1953 $letter_params is a hashref of the values to be passed to GetPreparedLetter
1955 test_mode will only report which notices would be sent, but nothing will be queued
1960 my ( $self, $params ) = @_;
1961 my $letter_params = $params->{letter_params};
1962 my $test_mode = $params->{test_mode};
1964 return unless $letter_params;
1965 return unless exists $params->{message_name} xor $params->{message_transports}; # We only want one of these
1967 my $library = Koha::Libraries->find( $letter_params->{branchcode} );
1968 my $from_email_address = $library->from_email_address;
1970 my @message_transports;
1972 $letter_code = $letter_params->{letter_code};
1973 if( $params->{message_name} ){
1974 my $messaging_prefs = C4::Members::Messaging::GetMessagingPreferences( {
1975 borrowernumber => $letter_params->{borrowernumber},
1976 message_name => $params->{message_name}
1978 @message_transports = ( keys %{ $messaging_prefs->{transports} } );
1979 $letter_code = $messaging_prefs->{transports}->{$message_transports[0]} unless $letter_code;
1981 @message_transports = @{$params->{message_transports}};
1983 return unless defined $letter_code;
1984 $letter_params->{letter_code} = $letter_code;
1987 foreach my $mtt (@message_transports){
1988 next if ($mtt eq 'itiva' and C4::Context->preference('TalkingTechItivaPhoneNotification') );
1989 # Notice is handled by TalkingTech_itiva_outbound.pl
1990 if ( ( $mtt eq 'email' and not $self->notice_email_address )
1991 or ( $mtt eq 'sms' and not $self->smsalertnumber )
1992 or ( $mtt eq 'phone' and not $self->phone ) )
1994 push @{ $return{fallback} }, $mtt;
1997 next if $mtt eq 'print' && $print_sent;
1998 $letter_params->{message_transport_type} = $mtt;
1999 my $letter = C4::Letters::GetPreparedLetter( %$letter_params );
2000 C4::Letters::EnqueueLetter({
2002 borrowernumber => $self->borrowernumber,
2003 from_address => $from_email_address,
2004 message_transport_type => $mtt
2005 }) unless $test_mode;
2006 push @{$return{sent}}, $mtt;
2007 $print_sent = 1 if $mtt eq 'print';
2012 =head3 safe_to_delete
2014 my $result = $patron->safe_to_delete;
2015 if ( $result eq 'has_guarantees' ) { ... }
2016 elsif ( $result ) { ... }
2017 else { # cannot delete }
2019 This method tells if the Koha:Patron object can be deleted. Possible return values
2025 =item 'has_checkouts'
2029 =item 'has_guarantees'
2031 =item 'is_anonymous_patron'
2037 sub safe_to_delete {
2040 my $anonymous_patron = C4::Context->preference('AnonymousPatron');
2044 if ( $anonymous_patron && $self->id eq $anonymous_patron ) {
2045 $error = 'is_anonymous_patron';
2047 elsif ( $self->checkouts->count ) {
2048 $error = 'has_checkouts';
2050 elsif ( $self->account->outstanding_debits->total_outstanding > 0 ) {
2051 $error = 'has_debt';
2053 elsif ( $self->guarantee_relationships->count ) {
2054 $error = 'has_guarantees';
2058 return Koha::Result::Boolean->new(0)->add_message({ message => $error });
2061 return Koha::Result::Boolean->new(1);
2066 my $recalls = $patron->recalls;
2068 Return the patron's recalls.
2075 return Koha::Recalls->search({ borrowernumber => $self->borrowernumber });
2078 =head3 account_balance
2080 my $balance = $patron->account_balance
2082 Return the patron's account balance
2086 sub account_balance {
2088 return $self->account->balance;
2092 =head3 has_messaging_preference
2094 my $bool = $patron->has_messaging_preference({
2095 message_name => $message_name, # A value from message_attributes.message_name
2096 message_transport_type => $message_transport_type, # email, sms, phone, itiva, etc...
2097 wants_digest => $wants_digest, # 1 if you are looking for the digest version, don't pass if you just want either
2102 sub has_messaging_preference {
2103 my ( $self, $params ) = @_;
2105 my $message_name = $params->{message_name};
2106 my $message_transport_type = $params->{message_transport_type};
2107 my $wants_digest = $params->{wants_digest};
2109 return $self->_result->search_related_rs(
2110 'borrower_message_preferences',
2114 [ 'borrower_message_transport_preferences', 'message_attribute' ]
2119 =head3 can_patron_change_staff_only_lists
2121 $patron->can_patron_change_staff_only_lists;
2123 Return 1 if a patron has 'Superlibrarian' or 'Catalogue' permission.
2124 Otherwise, return 0.
2128 sub can_patron_change_staff_only_lists {
2129 my ( $self, $params ) = @_;
2130 return 1 if C4::Auth::haspermission( $self->userid, { 'catalogue' => 1 });
2136 $patron->encode_secret($secret32);
2138 Secret (TwoFactorAuth expects it in base32 format) is encrypted.
2139 You still need to call ->store.
2144 my ( $self, $secret ) = @_;
2146 return $self->secret( Koha::Encryption->new->encrypt_hex($secret) );
2148 return $self->secret($secret);
2153 my $secret32 = $patron->decoded_secret;
2155 Decode the patron secret. We expect to get back a base32 string, but this
2156 is not checked here. Caller of encode_secret is responsible for that.
2160 sub decoded_secret {
2162 if( $self->secret ) {
2163 return Koha::Encryption->new->decrypt_hex( $self->secret );
2165 return $self->secret;
2168 =head2 Internal methods
2180 Kyle M Hall <kyle@bywatersolutions.com>
2181 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
2182 Martin Renvoize <martin.renvoize@ptfs-europe.com>