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 );
28 use C4::Log qw( logaction );
30 use Koha::ArticleRequests;
34 use Koha::CirculationRules;
35 use Koha::Club::Enrollments;
37 use Koha::DateUtils qw( dt_from_string );
38 use Koha::Exceptions::Password;
40 use Koha::Old::Checkouts;
41 use Koha::Patron::Attributes;
42 use Koha::Patron::Categories;
43 use Koha::Patron::Debarments;
44 use Koha::Patron::HouseboundProfile;
45 use Koha::Patron::HouseboundRole;
46 use Koha::Patron::Images;
47 use Koha::Patron::Messages;
48 use Koha::Patron::Modifications;
49 use Koha::Patron::Relationships;
52 use Koha::Result::Boolean;
53 use Koha::Subscription::Routinglists;
55 use Koha::Virtualshelves;
57 use base qw(Koha::Object);
59 use constant ADMINISTRATIVE_LOCKOUT => -1;
61 our $RESULTSET_PATRON_ID_MAPPING = {
62 Accountline => 'borrowernumber',
63 Aqbasketuser => 'borrowernumber',
64 Aqbudget => 'budget_owner_id',
65 Aqbudgetborrower => 'borrowernumber',
66 ArticleRequest => 'borrowernumber',
67 BorrowerDebarment => 'borrowernumber',
68 BorrowerFile => 'borrowernumber',
69 BorrowerModification => 'borrowernumber',
70 ClubEnrollment => 'borrowernumber',
71 Issue => 'borrowernumber',
72 ItemsLastBorrower => 'borrowernumber',
73 Linktracker => 'borrowernumber',
74 Message => 'borrowernumber',
75 MessageQueue => 'borrowernumber',
76 OldIssue => 'borrowernumber',
77 OldReserve => 'borrowernumber',
78 Rating => 'borrowernumber',
79 Reserve => 'borrowernumber',
80 Review => 'borrowernumber',
81 SearchHistory => 'userid',
82 Statistic => 'borrowernumber',
83 Suggestion => 'suggestedby',
84 TagAll => 'borrowernumber',
85 Virtualshelfcontent => 'borrowernumber',
86 Virtualshelfshare => 'borrowernumber',
87 Virtualshelve => 'owner',
92 Koha::Patron - Koha Patron Object class
103 my ( $class, $params ) = @_;
105 return $class->SUPER::new($params);
108 =head3 fixup_cardnumber
110 Autogenerate next cardnumber from highest value found in database
114 sub fixup_cardnumber {
117 my $max = $self->cardnumber;
118 Koha::Plugins->call( 'patron_barcode_transform', \$max );
120 $max ||= Koha::Patrons->search({
121 cardnumber => {-regexp => '^-?[0-9]+$'}
123 select => \'CAST(cardnumber AS SIGNED)',
124 as => ['cast_cardnumber']
125 })->_resultset->get_column('cast_cardnumber')->max;
126 $self->cardnumber(($max || 0) +1);
129 =head3 trim_whitespace
131 trim whitespace from data which has some non-whitespace in it.
132 Could be moved to Koha::Object if need to be reused
136 sub trim_whitespaces {
139 my $schema = Koha::Database->new->schema;
140 my @columns = $schema->source($self->_type)->columns;
142 for my $column( @columns ) {
143 my $value = $self->$column;
144 if ( defined $value ) {
145 $value =~ s/^\s*|\s*$//g;
146 $self->$column($value);
152 =head3 plain_text_password
154 $patron->plain_text_password( $password );
156 stores a copy of the unencrypted password in the object
157 for use in code before encrypting for db
161 sub plain_text_password {
162 my ( $self, $password ) = @_;
164 $self->{_plain_text_password} = $password;
167 return $self->{_plain_text_password}
168 if $self->{_plain_text_password};
175 Patron specific store method to cleanup record
176 and do other necessary things before saving
184 $self->_result->result_source->schema->txn_do(
187 C4::Context->preference("autoMemberNum")
188 and ( not defined $self->cardnumber
189 or $self->cardnumber eq '' )
192 # Warning: The caller is responsible for locking the members table in write
193 # mode, to avoid database corruption.
194 # We are in a transaction but the table is not locked
195 $self->fixup_cardnumber;
198 unless( $self->category->in_storage ) {
199 Koha::Exceptions::Object::FKConstraint->throw(
200 broken_fk => 'categorycode',
201 value => $self->categorycode,
205 $self->trim_whitespaces;
207 my $new_cardnumber = $self->cardnumber;
208 Koha::Plugins->call( 'patron_barcode_transform', \$new_cardnumber );
209 $self->cardnumber( $new_cardnumber );
211 # Set surname to uppercase if uppercasesurname is true
212 $self->surname( uc($self->surname) )
213 if C4::Context->preference("uppercasesurnames");
215 $self->relationship(undef) # We do not want to store an empty string in this field
216 if defined $self->relationship
217 and $self->relationship eq "";
219 unless ( $self->in_storage ) { #AddMember
221 # Generate a valid userid/login if needed
222 $self->generate_userid
223 if not $self->userid or not $self->has_valid_userid;
225 # Add expiration date if it isn't already there
226 unless ( $self->dateexpiry ) {
227 $self->dateexpiry( $self->category->get_expiry_date );
230 # Add enrollment date if it isn't already there
231 unless ( $self->dateenrolled ) {
232 $self->dateenrolled(dt_from_string);
235 # Set the privacy depending on the patron's category
236 my $default_privacy = $self->category->default_privacy || q{};
238 $default_privacy eq 'default' ? 1
239 : $default_privacy eq 'never' ? 2
240 : $default_privacy eq 'forever' ? 0
242 $self->privacy($default_privacy);
244 # Call any check_password plugins if password is passed
245 if ( C4::Context->config("enable_plugins") && $self->password ) {
246 my @plugins = Koha::Plugins->new()->GetPlugins({
247 method => 'check_password',
249 foreach my $plugin ( @plugins ) {
250 # This plugin hook will also be used by a plugin for the Norwegian national
251 # patron database. This is why we need to pass both the password and the
252 # borrowernumber to the plugin.
253 my $ret = $plugin->check_password(
255 password => $self->password,
256 borrowernumber => $self->borrowernumber
259 if ( $ret->{'error'} == 1 ) {
260 Koha::Exceptions::Password::Plugin->throw();
265 # Make a copy of the plain text password for later use
266 $self->plain_text_password( $self->password );
268 # Create a disabled account if no password provided
269 $self->password( $self->password
270 ? Koha::AuthUtils::hash_password( $self->password )
273 $self->borrowernumber(undef);
275 $self = $self->SUPER::store;
277 $self->add_enrolment_fee_if_needed(0);
279 logaction( "MEMBERS", "CREATE", $self->borrowernumber, "" )
280 if C4::Context->preference("BorrowersLog");
284 my $self_from_storage = $self->get_from_storage;
285 # FIXME We should not deal with that here, callers have to do this job
286 # Moved from ModMember to prevent regressions
287 unless ( $self->userid ) {
288 my $stored_userid = $self_from_storage->userid;
289 $self->userid($stored_userid);
292 # Password must be updated using $self->set_password
293 $self->password($self_from_storage->password);
295 if ( $self->category->categorycode ne
296 $self_from_storage->category->categorycode )
298 # Add enrolement fee on category change if required
299 $self->add_enrolment_fee_if_needed(1)
300 if C4::Context->preference('FeeOnChangePatronCategory');
302 # Clean up guarantors on category change if required
303 $self->guarantor_relationships->delete
304 if ( $self->category->category_type ne 'C'
305 && $self->category->category_type ne 'P' );
310 if ( C4::Context->preference("BorrowersLog") ) {
312 my $from_storage = $self_from_storage->unblessed;
313 my $from_object = $self->unblessed;
314 my @skip_fields = (qw/lastseen updated_on/);
315 for my $key ( keys %{$from_storage} ) {
316 next if any { /$key/ } @skip_fields;
319 !defined( $from_storage->{$key} )
320 && defined( $from_object->{$key} )
322 || ( defined( $from_storage->{$key} )
323 && !defined( $from_object->{$key} ) )
325 defined( $from_storage->{$key} )
326 && defined( $from_object->{$key} )
327 && ( $from_storage->{$key} ne
328 $from_object->{$key} )
333 before => $from_storage->{$key},
334 after => $from_object->{$key}
339 if ( defined($info) ) {
343 $self->borrowernumber,
346 { utf8 => 1, pretty => 1, canonical => 1 }
353 $self = $self->SUPER::store;
364 Delete patron's holds, lists and finally the patron.
366 Lists owned by the borrower are deleted, but entries from the borrower to
367 other lists are kept.
374 my $anonymous_patron = C4::Context->preference("AnonymousPatron");
375 Koha::Exceptions::Patron::FailedDeleteAnonymousPatron->throw() if $anonymous_patron && $self->id eq $anonymous_patron;
377 $self->_result->result_source->schema->txn_do(
379 # Cancel Patron's holds
380 my $holds = $self->holds;
381 while( my $hold = $holds->next ){
385 # Delete all lists and all shares of this borrower
386 # Consistent with the approach Koha uses on deleting individual lists
387 # Note that entries in virtualshelfcontents added by this borrower to
388 # lists of others will be handled by a table constraint: the borrower
389 # is set to NULL in those entries.
391 # We could handle the above deletes via a constraint too.
392 # But a new BZ report 11889 has been opened to discuss another approach.
393 # Instead of deleting we could also disown lists (based on a pref).
394 # In that way we could save shared and public lists.
395 # The current table constraints support that idea now.
396 # This pref should then govern the results of other routines/methods such as
397 # Koha::Virtualshelf->new->delete too.
398 # FIXME Could be $patron->get_lists
399 $_->delete for Koha::Virtualshelves->search( { owner => $self->borrowernumber } )->as_list;
401 # We cannot have a FK on borrower_modifications.borrowernumber, the table is also used
403 $_->delete for Koha::Patron::Modifications->search( { borrowernumber => $self->borrowernumber } )->as_list;
405 $self->SUPER::delete;
407 logaction( "MEMBERS", "DELETE", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog");
416 my $patron_category = $patron->category
418 Return the patron category for this patron
424 return Koha::Patron::Category->_new_from_dbic( $self->_result->categorycode );
434 return Koha::Patron::Images->find( $self->borrowernumber );
439 Returns a Koha::Library object representing the patron's home library.
445 return Koha::Library->_new_from_dbic($self->_result->branchcode);
450 Returns a Koha::SMS::Provider object representing the patron's SMS provider.
456 my $sms_provider_rs = $self->_result->sms_provider;
457 return unless $sms_provider_rs;
458 return Koha::SMS::Provider->_new_from_dbic($sms_provider_rs);
461 =head3 guarantor_relationships
463 Returns Koha::Patron::Relationships object for this patron's guarantors
465 Returns the set of relationships for the patrons that are guarantors for this patron.
467 This is returned instead of a Koha::Patron object because the guarantor
468 may not exist as a patron in Koha. If this is true, the guarantors name
469 exists in the Koha::Patron::Relationship object and will have no guarantor_id.
473 sub guarantor_relationships {
476 return Koha::Patron::Relationships->search( { guarantee_id => $self->id } );
479 =head3 guarantee_relationships
481 Returns Koha::Patron::Relationships object for this patron's guarantors
483 Returns the set of relationships for the patrons that are guarantees for this patron.
485 The method returns Koha::Patron::Relationship objects for the sake
486 of consistency with the guantors method.
487 A guarantee by definition must exist as a patron in Koha.
491 sub guarantee_relationships {
494 return Koha::Patron::Relationships->search(
495 { guarantor_id => $self->id },
497 prefetch => 'guarantee',
498 order_by => { -asc => [ 'guarantee.surname', 'guarantee.firstname' ] },
503 =head3 relationships_debt
505 Returns the amount owed by the patron's guarantors *and* the other guarantees of those guarantors
509 sub relationships_debt {
510 my ($self, $params) = @_;
512 my $include_guarantors = $params->{include_guarantors};
513 my $only_this_guarantor = $params->{only_this_guarantor};
514 my $include_this_patron = $params->{include_this_patron};
517 if ( $only_this_guarantor ) {
518 @guarantors = $self->guarantee_relationships->count ? ( $self ) : ();
519 Koha::Exceptions::BadParameter->throw( { parameter => 'only_this_guarantor' } ) unless @guarantors;
520 } elsif ( $self->guarantor_relationships->count ) {
521 # I am a guarantee, just get all my guarantors
522 @guarantors = $self->guarantor_relationships->guarantors->as_list;
524 # I am a guarantor, I need to get all the guarantors of all my guarantees
525 @guarantors = map { $_->guarantor_relationships->guarantors->as_list } $self->guarantee_relationships->guarantees->as_list;
528 my $non_issues_charges = 0;
529 my $seen = $include_this_patron ? {} : { $self->id => 1 }; # For tracking members already added to the total
530 foreach my $guarantor (@guarantors) {
531 $non_issues_charges += $guarantor->account->non_issues_charges if $include_guarantors && !$seen->{ $guarantor->id };
533 # We've added what the guarantor owes, not added in that guarantor's guarantees as well
534 my @guarantees = map { $_->guarantee } $guarantor->guarantee_relationships->as_list;
535 my $guarantees_non_issues_charges = 0;
536 foreach my $guarantee (@guarantees) {
537 next if $seen->{ $guarantee->id };
538 $guarantees_non_issues_charges += $guarantee->account->non_issues_charges;
539 # Mark this guarantee as seen so we don't double count a guarantee linked to multiple guarantors
540 $seen->{ $guarantee->id } = 1;
543 $non_issues_charges += $guarantees_non_issues_charges;
544 $seen->{ $guarantor->id } = 1;
547 return $non_issues_charges;
550 =head3 housebound_profile
552 Returns the HouseboundProfile associated with this patron.
556 sub housebound_profile {
558 my $profile = $self->_result->housebound_profile;
559 return Koha::Patron::HouseboundProfile->_new_from_dbic($profile)
564 =head3 housebound_role
566 Returns the HouseboundRole associated with this patron.
570 sub housebound_role {
573 my $role = $self->_result->housebound_role;
574 return Koha::Patron::HouseboundRole->_new_from_dbic($role) if ( $role );
580 Returns the siblings of this patron.
587 my @guarantors = $self->guarantor_relationships()->guarantors()->as_list;
589 return unless @guarantors;
592 map { $_->guarantee_relationships()->guarantees()->as_list } @guarantors;
594 return unless @siblings;
598 grep { !$seen{ $_->id }++ && ( $_->id != $self->id ) } @siblings;
600 return Koha::Patrons->search( { borrowernumber => { -in => [ map { $_->id } @siblings ] } } );
605 my $patron = Koha::Patrons->find($id);
606 $patron->merge_with( \@patron_ids );
608 This subroutine merges a list of patrons into the patron record. This is accomplished by finding
609 all related patron ids for the patrons to be merged in other tables and changing the ids to be that
610 of the keeper patron.
615 my ( $self, $patron_ids ) = @_;
617 my $anonymous_patron = C4::Context->preference("AnonymousPatron");
618 return if $anonymous_patron && $self->id eq $anonymous_patron;
620 my @patron_ids = @{ $patron_ids };
622 # Ensure the keeper isn't in the list of patrons to merge
623 @patron_ids = grep { $_ ne $self->id } @patron_ids;
625 my $schema = Koha::Database->new()->schema();
629 $self->_result->result_source->schema->txn_do( sub {
630 foreach my $patron_id (@patron_ids) {
632 next if $patron_id eq $anonymous_patron;
634 my $patron = Koha::Patrons->find( $patron_id );
638 # Unbless for safety, the patron will end up being deleted
639 $results->{merged}->{$patron_id}->{patron} = $patron->unblessed;
641 my $attributes = $patron->extended_attributes;
642 my $new_attributes = [
643 map { { code => $_->code, attribute => $_->attribute } }
646 $attributes->delete; # We need to delete before trying to merge them to prevent exception on unique and repeatable
647 for my $attribute ( @$new_attributes ) {
648 $self->add_extended_attribute($attribute);
651 while (my ($r, $field) = each(%$RESULTSET_PATRON_ID_MAPPING)) {
652 my $rs = $schema->resultset($r)->search({ $field => $patron_id });
653 $results->{merged}->{ $patron_id }->{updated}->{$r} = $rs->count();
654 $rs->update({ $field => $self->id });
655 if ( $r eq 'BorrowerDebarment' ) {
656 Koha::Patron::Debarments::UpdateBorrowerDebarmentFlags($self->id);
660 $patron->move_to_deleted();
670 =head3 wants_check_for_previous_checkout
672 $wants_check = $patron->wants_check_for_previous_checkout;
674 Return 1 if Koha needs to perform PrevIssue checking, else 0.
678 sub wants_check_for_previous_checkout {
680 my $syspref = C4::Context->preference("checkPrevCheckout");
683 ## Hard syspref trumps all
684 return 1 if ($syspref eq 'hardyes');
685 return 0 if ($syspref eq 'hardno');
686 ## Now, patron pref trumps all
687 return 1 if ($self->checkprevcheckout eq 'yes');
688 return 0 if ($self->checkprevcheckout eq 'no');
690 # More complex: patron inherits -> determine category preference
691 my $checkPrevCheckoutByCat = $self->category->checkprevcheckout;
692 return 1 if ($checkPrevCheckoutByCat eq 'yes');
693 return 0 if ($checkPrevCheckoutByCat eq 'no');
695 # Finally: category preference is inherit, default to 0
696 if ($syspref eq 'softyes') {
703 =head3 do_check_for_previous_checkout
705 $do_check = $patron->do_check_for_previous_checkout($item);
707 Return 1 if the bib associated with $ITEM has previously been checked out to
708 $PATRON, 0 otherwise.
712 sub do_check_for_previous_checkout {
713 my ( $self, $item ) = @_;
716 my $biblio = Koha::Biblios->find( $item->{biblionumber} );
717 if ( $biblio->is_serial ) {
718 push @item_nos, $item->{itemnumber};
720 # Get all itemnumbers for given bibliographic record.
721 @item_nos = $biblio->items->get_column( 'itemnumber' );
724 # Create (old)issues search criteria
726 borrowernumber => $self->borrowernumber,
727 itemnumber => \@item_nos,
730 my $delay = C4::Context->preference('CheckPrevCheckoutDelay') || 0;
732 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
733 my $newer_than = dt_from_string()->subtract( days => $delay );
734 $criteria->{'returndate'} = { '>' => $dtf->format_datetime($newer_than), };
737 # Check current issues table
738 my $issues = Koha::Checkouts->search($criteria);
739 return 1 if $issues->count; # 0 || N
741 # Check old issues table
742 my $old_issues = Koha::Old::Checkouts->search($criteria);
743 return $old_issues->count; # 0 || N
748 my $debarment_expiration = $patron->is_debarred;
750 Returns the date a patron debarment will expire, or undef if the patron is not
758 return unless $self->debarred;
759 return $self->debarred
760 if $self->debarred =~ '^9999'
761 or dt_from_string( $self->debarred ) > dt_from_string;
767 my $is_expired = $patron->is_expired;
769 Returns 1 if the patron is expired or 0;
775 return 0 unless $self->dateexpiry;
776 return 0 if $self->dateexpiry =~ '^9999';
777 return 1 if dt_from_string( $self->dateexpiry ) < dt_from_string->truncate( to => 'day' );
781 =head3 is_going_to_expire
783 my $is_going_to_expire = $patron->is_going_to_expire;
785 Returns 1 if the patron is going to expired, depending on the NotifyBorrowerDeparture pref or 0
789 sub is_going_to_expire {
792 my $delay = C4::Context->preference('NotifyBorrowerDeparture') || 0;
794 return 0 unless $delay;
795 return 0 unless $self->dateexpiry;
796 return 0 if $self->dateexpiry =~ '^9999';
797 return 1 if dt_from_string( $self->dateexpiry, undef, 'floating' )->subtract( days => $delay ) < dt_from_string(undef, undef, 'floating')->truncate( to => 'day' );
803 $patron->set_password({ password => $plain_text_password [, skip_validation => 1 ] });
805 Set the patron's password.
809 The passed string is validated against the current password enforcement policy.
810 Validation can be skipped by passing the I<skip_validation> parameter.
812 Exceptions are thrown if the password is not good enough.
816 =item Koha::Exceptions::Password::TooShort
818 =item Koha::Exceptions::Password::WhitespaceCharacters
820 =item Koha::Exceptions::Password::TooWeak
822 =item Koha::Exceptions::Password::Plugin (if a "check password" plugin is enabled)
829 my ( $self, $args ) = @_;
831 my $password = $args->{password};
833 unless ( $args->{skip_validation} ) {
834 my ( $is_valid, $error ) = Koha::AuthUtils::is_password_valid( $password, $self->category );
837 if ( $error eq 'too_short' ) {
838 my $min_length = $self->category->effective_min_password_length;
839 $min_length = 3 if not $min_length or $min_length < 3;
841 my $password_length = length($password);
842 Koha::Exceptions::Password::TooShort->throw(
843 length => $password_length, min_length => $min_length );
845 elsif ( $error eq 'has_whitespaces' ) {
846 Koha::Exceptions::Password::WhitespaceCharacters->throw();
848 elsif ( $error eq 'too_weak' ) {
849 Koha::Exceptions::Password::TooWeak->throw();
854 if ( C4::Context->config("enable_plugins") ) {
855 # Call any check_password plugins
856 my @plugins = Koha::Plugins->new()->GetPlugins({
857 method => 'check_password',
859 foreach my $plugin ( @plugins ) {
860 # This plugin hook will also be used by a plugin for the Norwegian national
861 # patron database. This is why we need to pass both the password and the
862 # borrowernumber to the plugin.
863 my $ret = $plugin->check_password(
865 password => $password,
866 borrowernumber => $self->borrowernumber
869 # This plugin hook will also be used by a plugin for the Norwegian national
870 # patron database. This is why we need to call the actual plugins and then
871 # check skip_validation afterwards.
872 if ( $ret->{'error'} == 1 && !$args->{skip_validation} ) {
873 Koha::Exceptions::Password::Plugin->throw();
878 my $digest = Koha::AuthUtils::hash_password($password);
880 # We do not want to call $self->store and retrieve password from DB
881 $self->password($digest);
882 $self->login_attempts(0);
885 logaction( "MEMBERS", "CHANGE PASS", $self->borrowernumber, "" )
886 if C4::Context->preference("BorrowersLog");
894 my $new_expiry_date = $patron->renew_account
896 Extending the subscription to the expiry date.
903 if ( C4::Context->preference('BorrowerRenewalPeriodBase') eq 'combination' ) {
904 $date = ( dt_from_string gt dt_from_string( $self->dateexpiry ) ) ? dt_from_string : dt_from_string( $self->dateexpiry );
907 C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry'
908 ? dt_from_string( $self->dateexpiry )
911 my $expiry_date = $self->category->get_expiry_date($date);
913 $self->dateexpiry($expiry_date);
914 $self->date_renewed( dt_from_string() );
917 $self->add_enrolment_fee_if_needed(1);
919 logaction( "MEMBERS", "RENEW", $self->borrowernumber, "Membership renewed" ) if C4::Context->preference("BorrowersLog");
920 return dt_from_string( $expiry_date )->truncate( to => 'day' );
925 my $has_overdues = $patron->has_overdues;
927 Returns the number of patron's overdues
933 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
934 return $self->_result->issues->search({ date_due => { '<' => $dtf->format_datetime( dt_from_string() ) } })->count;
939 $patron->track_login;
940 $patron->track_login({ force => 1 });
942 Tracks a (successful) login attempt.
943 The preference TrackLastPatronActivity must be enabled. Or you
944 should pass the force parameter.
949 my ( $self, $params ) = @_;
952 !C4::Context->preference('TrackLastPatronActivity');
953 $self->lastseen( dt_from_string() )->store;
956 =head3 move_to_deleted
958 my $is_moved = $patron->move_to_deleted;
960 Move a patron to the deletedborrowers table.
961 This can be done before deleting a patron, to make sure the data are not completely deleted.
965 sub move_to_deleted {
967 my $patron_infos = $self->unblessed;
968 delete $patron_infos->{updated_on}; #This ensures the updated_on date in deletedborrowers will be set to the current timestamp
969 return Koha::Database->new->schema->resultset('Deletedborrower')->create($patron_infos);
972 =head3 can_request_article
974 if ( $patron->can_request_article( $library->id ) ) { ... }
976 Returns true if the patron can request articles. As limits apply for the patron
977 on the same day, those completed the same day are considered as current.
979 A I<library_id> can be passed as parameter, falling back to userenv if absent.
983 sub can_request_article {
984 my ($self, $library_id) = @_;
986 $library_id //= C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef;
988 my $rule = Koha::CirculationRules->get_effective_rule(
990 branchcode => $library_id,
991 categorycode => $self->categorycode,
992 rule_name => 'open_article_requests_limit'
996 my $limit = ($rule) ? $rule->rule_value : undef;
998 return 1 unless defined $limit;
1000 my $count = Koha::ArticleRequests->search(
1001 [ { borrowernumber => $self->borrowernumber, status => [ 'REQUESTED', 'PENDING', 'PROCESSING' ] },
1002 { borrowernumber => $self->borrowernumber, status => 'COMPLETED', updated_on => { '>=' => \'CAST(NOW() AS DATE)' } },
1005 return $count < $limit ? 1 : 0;
1008 =head3 article_request_fee
1010 my $fee = $patron->article_request_fee(
1012 [ library_id => $library->id, ]
1016 Returns the fee to be charged to the patron when it places an article request.
1018 A I<library_id> can be passed as parameter, falling back to userenv if absent.
1022 sub article_request_fee {
1023 my ($self, $params) = @_;
1025 my $library_id = $params->{library_id};
1027 $library_id //= C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef;
1029 my $rule = Koha::CirculationRules->get_effective_rule(
1031 branchcode => $library_id,
1032 categorycode => $self->categorycode,
1033 rule_name => 'article_request_fee'
1037 my $fee = ($rule) ? $rule->rule_value + 0 : 0;
1042 =head3 add_article_request_fee_if_needed
1044 my $fee = $patron->add_article_request_fee_if_needed(
1046 [ item_id => $item->id,
1047 library_id => $library->id, ]
1051 If an article request fee needs to be charged, it adds a debit to the patron's
1054 Returns the fee line.
1056 A I<library_id> can be passed as parameter, falling back to userenv if absent.
1060 sub add_article_request_fee_if_needed {
1061 my ($self, $params) = @_;
1063 my $library_id = $params->{library_id};
1064 my $item_id = $params->{item_id};
1066 $library_id //= C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef;
1068 my $amount = $self->article_request_fee(
1070 library_id => $library_id,
1076 if ( $amount > 0 ) {
1077 $debit_line = $self->account->add_debit(
1080 user_id => C4::Context->userenv ? C4::Context->userenv->{'number'} : undef,
1081 interface => C4::Context->interface,
1082 library_id => $library_id,
1083 type => 'ARTICLE_REQUEST',
1084 item_id => $item_id,
1092 =head3 article_requests
1094 my $article_requests = $patron->article_requests;
1096 Returns the patron article requests.
1100 sub article_requests {
1103 return Koha::ArticleRequests->_new_from_dbic( scalar $self->_result->article_requests );
1106 =head3 add_enrolment_fee_if_needed
1108 my $enrolment_fee = $patron->add_enrolment_fee_if_needed($renewal);
1110 Add enrolment fee for a patron if needed.
1112 $renewal - boolean denoting whether this is an account renewal or not
1116 sub add_enrolment_fee_if_needed {
1117 my ($self, $renewal) = @_;
1118 my $enrolment_fee = $self->category->enrolmentfee;
1119 if ( $enrolment_fee && $enrolment_fee > 0 ) {
1120 my $type = $renewal ? 'ACCOUNT_RENEW' : 'ACCOUNT';
1121 $self->account->add_debit(
1123 amount => $enrolment_fee,
1124 user_id => C4::Context->userenv ? C4::Context->userenv->{'number'} : undef,
1125 interface => C4::Context->interface,
1126 library_id => C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef,
1131 return $enrolment_fee || 0;
1136 my $checkouts = $patron->checkouts
1142 my $checkouts = $self->_result->issues;
1143 return Koha::Checkouts->_new_from_dbic( $checkouts );
1146 =head3 pending_checkouts
1148 my $pending_checkouts = $patron->pending_checkouts
1150 This method will return the same as $self->checkouts, but with a prefetch on
1151 items, biblio and biblioitems.
1153 It has been introduced to replaced the C4::Members::GetPendingIssues subroutine
1155 It should not be used directly, prefer to access fields you need instead of
1156 retrieving all these fields in one go.
1160 sub pending_checkouts {
1162 my $checkouts = $self->_result->issues->search(
1166 { -desc => 'me.timestamp' },
1167 { -desc => 'issuedate' },
1168 { -desc => 'issue_id' }, # Sort by issue_id should be enough
1170 prefetch => { item => { biblio => 'biblioitems' } },
1173 return Koha::Checkouts->_new_from_dbic( $checkouts );
1176 =head3 old_checkouts
1178 my $old_checkouts = $patron->old_checkouts
1184 my $old_checkouts = $self->_result->old_issues;
1185 return Koha::Old::Checkouts->_new_from_dbic( $old_checkouts );
1190 my $overdue_items = $patron->get_overdues
1192 Return the overdue items
1198 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
1199 return $self->checkouts->search(
1201 'me.date_due' => { '<' => $dtf->format_datetime(dt_from_string) },
1204 prefetch => { item => { biblio => 'biblioitems' } },
1209 =head3 get_routing_lists
1211 my $routinglists = $patron->get_routing_lists
1213 Returns the routing lists a patron is subscribed to.
1217 sub get_routing_lists {
1219 my $routing_list_rs = $self->_result->subscriptionroutinglists;
1220 return Koha::Subscription::Routinglists->_new_from_dbic($routing_list_rs);
1225 my $age = $patron->get_age
1227 Return the age of the patron
1233 my $today_str = dt_from_string->strftime("%Y-%m-%d");
1234 return unless $self->dateofbirth;
1235 my $dob_str = dt_from_string( $self->dateofbirth )->strftime("%Y-%m-%d");
1237 my ( $dob_y, $dob_m, $dob_d ) = split /-/, $dob_str;
1238 my ( $today_y, $today_m, $today_d ) = split /-/, $today_str;
1240 my $age = $today_y - $dob_y;
1241 if ( $dob_m . $dob_d > $today_m . $today_d ) {
1250 my $is_valid = $patron->is_valid_age
1252 Return 1 if patron's age is between allowed limits, returns 0 if it's not.
1258 my $age = $self->get_age;
1260 my $patroncategory = $self->category;
1261 my ($low,$high) = ($patroncategory->dateofbirthrequired, $patroncategory->upperagelimit);
1263 return (defined($age) && (($high && ($age > $high)) or ($low && ($age < $low)))) ? 0 : 1;
1268 my $account = $patron->account
1274 return Koha::Account->new( { patron_id => $self->borrowernumber } );
1279 my $holds = $patron->holds
1281 Return all the holds placed by this patron
1287 my $holds_rs = $self->_result->reserves->search( {}, { order_by => 'reservedate' } );
1288 return Koha::Holds->_new_from_dbic($holds_rs);
1293 my $old_holds = $patron->old_holds
1295 Return all the historical holds for this patron
1301 my $old_holds_rs = $self->_result->old_reserves->search( {}, { order_by => 'reservedate' } );
1302 return Koha::Old::Holds->_new_from_dbic($old_holds_rs);
1305 =head3 return_claims
1307 my $return_claims = $patron->return_claims
1313 my $return_claims = $self->_result->return_claims_borrowernumbers;
1314 return Koha::Checkouts::ReturnClaims->_new_from_dbic( $return_claims );
1317 =head3 notice_email_address
1319 my $email = $patron->notice_email_address;
1321 Return the email address of patron used for notices.
1322 Returns the empty string if no email address.
1326 sub notice_email_address{
1329 my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
1330 # if syspref is set to 'first valid' (value == OFF), look up email address
1331 if ( $which_address eq 'OFF' ) {
1332 return $self->first_valid_email_address;
1335 return $self->$which_address || '';
1338 =head3 first_valid_email_address
1340 my $first_valid_email_address = $patron->first_valid_email_address
1342 Return the first valid email address for a patron.
1343 For now, the order is defined as email, emailpro, B_email.
1344 Returns the empty string if the borrower has no email addresses.
1348 sub first_valid_email_address {
1351 return $self->email() || $self->emailpro() || $self->B_email() || q{};
1354 =head3 get_club_enrollments
1358 sub get_club_enrollments {
1361 return Koha::Club::Enrollments->search( { borrowernumber => $self->borrowernumber(), date_canceled => undef } );
1364 =head3 get_enrollable_clubs
1368 sub get_enrollable_clubs {
1369 my ( $self, $is_enrollable_from_opac ) = @_;
1372 $params->{is_enrollable_from_opac} = $is_enrollable_from_opac
1373 if $is_enrollable_from_opac;
1374 $params->{is_email_required} = 0 unless $self->first_valid_email_address();
1376 $params->{borrower} = $self;
1378 return Koha::Clubs->get_enrollable($params);
1381 =head3 account_locked
1383 my $is_locked = $patron->account_locked
1385 Return true if the patron has reached the maximum number of login attempts
1386 (see pref FailedLoginAttempts). If login_attempts is < 0, this is interpreted
1387 as an administrative lockout (independent of FailedLoginAttempts; see also
1388 Koha::Patron->lock).
1389 Otherwise return false.
1390 If the pref is not set (empty string, null or 0), the feature is considered as
1395 sub account_locked {
1397 my $FailedLoginAttempts = C4::Context->preference('FailedLoginAttempts');
1398 return 1 if $FailedLoginAttempts
1399 and $self->login_attempts
1400 and $self->login_attempts >= $FailedLoginAttempts;
1401 return 1 if ($self->login_attempts || 0) < 0; # administrative lockout
1405 =head3 can_see_patron_infos
1407 my $can_see = $patron->can_see_patron_infos( $patron );
1409 Return true if the patron (usually the logged in user) can see the patron's infos for a given patron
1413 sub can_see_patron_infos {
1414 my ( $self, $patron ) = @_;
1415 return unless $patron;
1416 return $self->can_see_patrons_from( $patron->branchcode );
1419 =head3 can_see_patrons_from
1421 my $can_see = $patron->can_see_patrons_from( $branchcode );
1423 Return true if the patron (usually the logged in user) can see the patron's infos from a given library
1427 sub can_see_patrons_from {
1428 my ( $self, $branchcode ) = @_;
1430 if ( $self->branchcode eq $branchcode ) {
1432 } elsif ( $self->has_permission( { borrowers => 'view_borrower_infos_from_any_libraries' } ) ) {
1434 } elsif ( my $library_groups = $self->library->library_groups ) {
1435 while ( my $library_group = $library_groups->next ) {
1436 if ( $library_group->parent->has_child( $branchcode ) ) {
1447 my $can_log_into = $patron->can_log_into( $library );
1449 Given a I<Koha::Library> object, it returns a boolean representing
1450 the fact the patron can log into a the library.
1455 my ( $self, $library ) = @_;
1459 if ( C4::Context->preference('IndependentBranches') ) {
1461 if $self->is_superlibrarian
1462 or $self->branchcode eq $library->id;
1472 =head3 libraries_where_can_see_patrons
1474 my $libraries = $patron-libraries_where_can_see_patrons;
1476 Return the list of branchcodes(!) of libraries the patron is allowed to see other patron's infos.
1477 The branchcodes are arbitrarily returned sorted.
1478 We are supposing here that the object is related to the logged in patron (use of C4::Context::only_my_library)
1480 An empty array means no restriction, the patron can see patron's infos from any libraries.
1484 sub libraries_where_can_see_patrons {
1486 my $userenv = C4::Context->userenv;
1488 return () unless $userenv; # For tests, but userenv should be defined in tests...
1490 my @restricted_branchcodes;
1491 if (C4::Context::only_my_library) {
1492 push @restricted_branchcodes, $self->branchcode;
1496 $self->has_permission(
1497 { borrowers => 'view_borrower_infos_from_any_libraries' }
1501 my $library_groups = $self->library->library_groups({ ft_hide_patron_info => 1 });
1502 if ( $library_groups->count )
1504 while ( my $library_group = $library_groups->next ) {
1505 my $parent = $library_group->parent;
1506 if ( $parent->has_child( $self->branchcode ) ) {
1507 push @restricted_branchcodes, $parent->children->get_column('branchcode');
1512 @restricted_branchcodes = ( $self->branchcode ) unless @restricted_branchcodes;
1516 @restricted_branchcodes = grep { defined $_ } @restricted_branchcodes;
1517 @restricted_branchcodes = uniq(@restricted_branchcodes);
1518 @restricted_branchcodes = sort(@restricted_branchcodes);
1519 return @restricted_branchcodes;
1522 =head3 has_permission
1524 my $permission = $patron->has_permission($required);
1526 See C4::Auth::haspermission for details of syntax for $required
1530 sub has_permission {
1531 my ( $self, $flagsrequired ) = @_;
1532 return unless $self->userid;
1533 # TODO code from haspermission needs to be moved here!
1534 return C4::Auth::haspermission( $self->userid, $flagsrequired );
1537 =head3 is_superlibrarian
1539 my $is_superlibrarian = $patron->is_superlibrarian;
1541 Return true if the patron is a superlibrarian.
1545 sub is_superlibrarian {
1547 return $self->has_permission( { superlibrarian => 1 } ) ? 1 : 0;
1552 my $is_adult = $patron->is_adult
1554 Return true if the patron has a category with a type Adult (A) or Organization (I)
1560 return $self->category->category_type =~ /^(A|I)$/ ? 1 : 0;
1565 my $is_child = $patron->is_child
1567 Return true if the patron has a category with a type Child (C)
1573 return $self->category->category_type eq 'C' ? 1 : 0;
1576 =head3 has_valid_userid
1578 my $patron = Koha::Patrons->find(42);
1579 $patron->userid( $new_userid );
1580 my $has_a_valid_userid = $patron->has_valid_userid
1582 my $patron = Koha::Patron->new( $params );
1583 my $has_a_valid_userid = $patron->has_valid_userid
1585 Return true if the current userid of this patron is valid/unique, otherwise false.
1587 Note that this should be done in $self->store instead and raise an exception if needed.
1591 sub has_valid_userid {
1594 return 0 unless $self->userid;
1596 return 0 if ( $self->userid eq C4::Context->config('user') ); # DB user
1598 my $already_exists = Koha::Patrons->search(
1600 userid => $self->userid,
1603 ? ( borrowernumber => { '!=' => $self->borrowernumber } )
1608 return $already_exists ? 0 : 1;
1611 =head3 generate_userid
1613 my $patron = Koha::Patron->new( $params );
1614 $patron->generate_userid
1616 Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
1618 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).
1622 sub generate_userid {
1625 my $firstname = $self->firstname // q{};
1626 my $surname = $self->surname // q{};
1627 #The script will "do" the following code and increment the $offset until the generated userid is unique
1629 $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1630 $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1631 my $userid = lc(($firstname)? "$firstname.$surname" : $surname);
1632 $userid = NFKD( $userid );
1633 $userid =~ s/\p{NonspacingMark}//g;
1634 $userid .= $offset unless $offset == 0;
1635 $self->userid( $userid );
1637 } while (! $self->has_valid_userid );
1642 =head3 add_extended_attribute
1646 sub add_extended_attribute {
1647 my ($self, $attribute) = @_;
1649 return Koha::Patron::Attribute->new(
1652 ( borrowernumber => $self->borrowernumber ),
1658 =head3 extended_attributes
1660 Return object of Koha::Patron::Attributes type with all attributes set for this patron
1666 sub extended_attributes {
1667 my ( $self, $attributes ) = @_;
1668 if ($attributes) { # setter
1669 my $schema = $self->_result->result_source->schema;
1672 # Remove the existing one
1673 $self->extended_attributes->filter_by_branch_limitations->delete;
1675 # Insert the new ones
1677 for my $attribute (@$attributes) {
1678 $self->add_extended_attribute($attribute);
1679 $new_types->{$attribute->{code}} = 1;
1682 # Check globally mandatory types
1683 my @required_attribute_types =
1684 Koha::Patron::Attribute::Types->search(
1687 'borrower_attribute_types_branches.b_branchcode' =>
1690 { join => 'borrower_attribute_types_branches' }
1691 )->get_column('code');
1692 for my $type ( @required_attribute_types ) {
1693 Koha::Exceptions::Patron::MissingMandatoryExtendedAttribute->throw(
1695 ) if !$new_types->{$type};
1701 my $rs = $self->_result->borrower_attributes;
1702 # We call search to use the filters in Koha::Patron::Attributes->search
1703 return Koha::Patron::Attributes->_new_from_dbic($rs)->search;
1708 my $messages = $patron->messages;
1710 Return the message attached to the patron.
1716 my $messages_rs = $self->_result->messages_borrowernumbers->search;
1717 return Koha::Patron::Messages->_new_from_dbic($messages_rs);
1722 Koha::Patrons->find($id)->lock({ expire => 1, remove => 1 });
1724 Lock and optionally expire a patron account.
1725 Remove holds and article requests if remove flag set.
1726 In order to distinguish from locking by entering a wrong password, let's
1727 call this an administrative lockout.
1732 my ( $self, $params ) = @_;
1733 $self->login_attempts( ADMINISTRATIVE_LOCKOUT );
1734 if( $params->{expire} ) {
1735 $self->dateexpiry( dt_from_string->subtract(days => 1) );
1738 if( $params->{remove} ) {
1739 $self->holds->delete;
1740 $self->article_requests->delete;
1747 Koha::Patrons->find($id)->anonymize;
1749 Anonymize or clear borrower fields. Fields in BorrowerMandatoryField
1750 are randomized, other personal data is cleared too.
1751 Patrons with issues are skipped.
1757 if( $self->_result->issues->count ) {
1758 warn "Exiting anonymize: patron ".$self->borrowernumber." still has issues";
1761 # Mandatory fields come from the corresponding pref, but email fields
1762 # are removed since scrambled email addresses only generate errors
1763 my $mandatory = { map { (lc $_, 1); } grep { !/email/ }
1764 split /\s*\|\s*/, C4::Context->preference('BorrowerMandatoryField') };
1765 $mandatory->{userid} = 1; # needed since sub store does not clear field
1766 my @columns = $self->_result->result_source->columns;
1767 @columns = grep { !/borrowernumber|branchcode|categorycode|^date|password|flags|updated_on|lastseen|lang|login_attempts|anonymized/ } @columns;
1768 push @columns, 'dateofbirth'; # add this date back in
1769 foreach my $col (@columns) {
1770 $self->_anonymize_column($col, $mandatory->{lc $col} );
1772 $self->anonymized(1)->store;
1775 sub _anonymize_column {
1776 my ( $self, $col, $mandatory ) = @_;
1777 my $col_info = $self->_result->result_source->column_info($col);
1778 my $type = $col_info->{data_type};
1779 my $nullable = $col_info->{is_nullable};
1781 if( $type =~ /char|text/ ) {
1783 ? Koha::Token->new->generate({ pattern => '\w{10}' })
1787 } elsif( $type =~ /integer|int$|float|dec|double/ ) {
1788 $val = $nullable ? undef : 0;
1789 } elsif( $type =~ /date|time/ ) {
1790 $val = $nullable ? undef : dt_from_string;
1795 =head3 add_guarantor
1797 my $relationship = $patron->add_guarantor(
1799 borrowernumber => $borrowernumber,
1800 relationships => $relationship,
1804 Adds a new guarantor to a patron.
1809 my ( $self, $params ) = @_;
1811 my $guarantor_id = $params->{guarantor_id};
1812 my $relationship = $params->{relationship};
1814 return Koha::Patron::Relationship->new(
1816 guarantee_id => $self->id,
1817 guarantor_id => $guarantor_id,
1818 relationship => $relationship
1823 =head3 get_extended_attribute
1825 my $attribute_value = $patron->get_extended_attribute( $code );
1827 Return the attribute for the code passed in parameter.
1829 It not exist it returns undef
1831 Note that this will not work for repeatable attribute types.
1833 Maybe you certainly not want to use this method, it is actually only used for SHOW_BARCODE
1834 (which should be a real patron's attribute (not extended)
1838 sub get_extended_attribute {
1839 my ( $self, $code, $value ) = @_;
1840 my $rs = $self->_result->borrower_attributes;
1842 my $attribute = $rs->search({ code => $code, ( $value ? ( attribute => $value ) : () ) });
1843 return unless $attribute->count;
1844 return $attribute->next;
1849 my $json = $patron->to_api;
1851 Overloaded method that returns a JSON representation of the Koha::Patron object,
1852 suitable for API output.
1857 my ( $self, $params ) = @_;
1859 my $json_patron = $self->SUPER::to_api( $params );
1861 $json_patron->{restricted} = ( $self->is_debarred )
1863 : Mojo::JSON->false;
1865 return $json_patron;
1868 =head3 to_api_mapping
1870 This method returns the mapping for representing a Koha::Patron object
1875 sub to_api_mapping {
1877 borrowernotes => 'staff_notes',
1878 borrowernumber => 'patron_id',
1879 branchcode => 'library_id',
1880 categorycode => 'category_id',
1881 checkprevcheckout => 'check_previous_checkout',
1882 contactfirstname => undef, # Unused
1883 contactname => undef, # Unused
1884 contactnote => 'altaddress_notes',
1885 contacttitle => undef, # Unused
1886 dateenrolled => 'date_enrolled',
1887 dateexpiry => 'expiry_date',
1888 dateofbirth => 'date_of_birth',
1889 debarred => undef, # replaced by 'restricted'
1890 debarredcomment => undef, # calculated, API consumers will use /restrictions instead
1891 emailpro => 'secondary_email',
1892 flags => undef, # permissions manipulation handled in /permissions
1893 gonenoaddress => 'incorrect_address',
1894 guarantorid => 'guarantor_id',
1895 lastseen => 'last_seen',
1896 lost => 'patron_card_lost',
1897 opacnote => 'opac_notes',
1898 othernames => 'other_name',
1899 password => undef, # password manipulation handled in /password
1900 phonepro => 'secondary_phone',
1901 relationship => 'relationship_type',
1903 smsalertnumber => 'sms_number',
1904 sort1 => 'statistics_1',
1905 sort2 => 'statistics_2',
1906 autorenew_checkouts => 'autorenew_checkouts',
1907 streetnumber => 'street_number',
1908 streettype => 'street_type',
1909 zipcode => 'postal_code',
1910 B_address => 'altaddress_address',
1911 B_address2 => 'altaddress_address2',
1912 B_city => 'altaddress_city',
1913 B_country => 'altaddress_country',
1914 B_email => 'altaddress_email',
1915 B_phone => 'altaddress_phone',
1916 B_state => 'altaddress_state',
1917 B_streetnumber => 'altaddress_street_number',
1918 B_streettype => 'altaddress_street_type',
1919 B_zipcode => 'altaddress_postal_code',
1920 altcontactaddress1 => 'altcontact_address',
1921 altcontactaddress2 => 'altcontact_address2',
1922 altcontactaddress3 => 'altcontact_city',
1923 altcontactcountry => 'altcontact_country',
1924 altcontactfirstname => 'altcontact_firstname',
1925 altcontactphone => 'altcontact_phone',
1926 altcontactsurname => 'altcontact_surname',
1927 altcontactstate => 'altcontact_state',
1928 altcontactzipcode => 'altcontact_postal_code',
1929 primary_contact_method => undef,
1935 Koha::Patrons->queue_notice({ letter_params => $letter_params, message_name => 'DUE'});
1936 Koha::Patrons->queue_notice({ letter_params => $letter_params, message_transports => \@message_transports });
1937 Koha::Patrons->queue_notice({ letter_params => $letter_params, message_transports => \@message_transports, test_mode => 1 });
1939 Queue messages to a patron. Can pass a message that is part of the message_attributes
1940 table or supply the transport to use.
1942 If passed a message name we retrieve the patrons preferences for transports
1943 Otherwise we use the supplied transport. In the case of email or sms we fall back to print if
1944 we have no address/number for sending
1946 $letter_params is a hashref of the values to be passed to GetPreparedLetter
1948 test_mode will only report which notices would be sent, but nothing will be queued
1953 my ( $self, $params ) = @_;
1954 my $letter_params = $params->{letter_params};
1955 my $test_mode = $params->{test_mode};
1957 return unless $letter_params;
1958 return unless exists $params->{message_name} xor $params->{message_transports}; # We only want one of these
1960 my $library = Koha::Libraries->find( $letter_params->{branchcode} );
1961 my $from_email_address = $library->from_email_address;
1963 my @message_transports;
1965 $letter_code = $letter_params->{letter_code};
1966 if( $params->{message_name} ){
1967 my $messaging_prefs = C4::Members::Messaging::GetMessagingPreferences( {
1968 borrowernumber => $letter_params->{borrowernumber},
1969 message_name => $params->{message_name}
1971 @message_transports = ( keys %{ $messaging_prefs->{transports} } );
1972 $letter_code = $messaging_prefs->{transports}->{$message_transports[0]} unless $letter_code;
1974 @message_transports = @{$params->{message_transports}};
1976 return unless defined $letter_code;
1977 $letter_params->{letter_code} = $letter_code;
1980 foreach my $mtt (@message_transports){
1981 next if ($mtt eq 'itiva' and C4::Context->preference('TalkingTechItivaPhoneNotification') );
1982 # Notice is handled by TalkingTech_itiva_outbound.pl
1983 if ( ( $mtt eq 'email' and not $self->notice_email_address )
1984 or ( $mtt eq 'sms' and not $self->smsalertnumber )
1985 or ( $mtt eq 'phone' and not $self->phone ) )
1987 push @{ $return{fallback} }, $mtt;
1990 next if $mtt eq 'print' && $print_sent;
1991 $letter_params->{message_transport_type} = $mtt;
1992 my $letter = C4::Letters::GetPreparedLetter( %$letter_params );
1993 C4::Letters::EnqueueLetter({
1995 borrowernumber => $self->borrowernumber,
1996 from_address => $from_email_address,
1997 message_transport_type => $mtt
1998 }) unless $test_mode;
1999 push @{$return{sent}}, $mtt;
2000 $print_sent = 1 if $mtt eq 'print';
2005 =head3 safe_to_delete
2007 my $result = $patron->safe_to_delete;
2008 if ( $result eq 'has_guarantees' ) { ... }
2009 elsif ( $result ) { ... }
2010 else { # cannot delete }
2012 This method tells if the Koha:Patron object can be deleted. Possible return values
2018 =item 'has_checkouts'
2022 =item 'has_guarantees'
2024 =item 'is_anonymous_patron'
2030 sub safe_to_delete {
2033 my $anonymous_patron = C4::Context->preference('AnonymousPatron');
2037 if ( $anonymous_patron && $self->id eq $anonymous_patron ) {
2038 $error = 'is_anonymous_patron';
2040 elsif ( $self->checkouts->count ) {
2041 $error = 'has_checkouts';
2043 elsif ( $self->account->outstanding_debits->total_outstanding > 0 ) {
2044 $error = 'has_debt';
2046 elsif ( $self->guarantee_relationships->count ) {
2047 $error = 'has_guarantees';
2051 return Koha::Result::Boolean->new(0)->add_message({ message => $error });
2054 return Koha::Result::Boolean->new(1);
2057 =head2 Internal methods
2069 Kyle M Hall <kyle@bywatersolutions.com>
2070 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
2071 Martin Renvoize <martin.renvoize@ptfs-europe.com>