Koha/Patron.pm

   1 package Koha::Patron;
   2
   3 # Copyright ByWater Solutions 2014
   4 # Copyright PTFS Europe 2016
   5 #
   6 # This file is part of Koha.
   7 #
   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.
  12 #
  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.
  17 #
  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>.
  20
  21 use Modern::Perl;
  22
  23 use List::MoreUtils qw( any uniq );
  24 use JSON qw( to_json );
  25 use Unicode::Normalize qw( NFKD );
  26 use Try::Tiny;
  27 use DateTime ();
  28
  29 use C4::Auth qw( checkpw_hash );
  30 use C4::Context;
  31 use C4::Letters qw( GetPreparedLetter EnqueueLetter SendQueuedMessages );
  32 use C4::Log qw( logaction );
  33 use Koha::Account;
  34 use Koha::ArticleRequests;
  35 use Koha::AuthUtils;
  36 use Koha::Caches;
  37 use Koha::Checkouts;
  38 use Koha::CirculationRules;
  39 use Koha::Club::Enrollments;
  40 use Koha::CurbsidePickups;
  41 use Koha::Database;
  42 use Koha::DateUtils qw( dt_from_string );
  43 use Koha::Encryption;
  44 use Koha::Exceptions;
  45 use Koha::Exceptions::Password;
  46 use Koha::Holds;
  47 use Koha::Old::Checkouts;
  48 use Koha::OverdueRules;
  49 use Koha::Patron::Attributes;
  50 use Koha::Patron::Categories;
  51 use Koha::Patron::Consents;
  52 use Koha::Patron::Debarments;
  53 use Koha::Patron::HouseboundProfile;
  54 use Koha::Patron::HouseboundRole;
  55 use Koha::Patron::Images;
  56 use Koha::Patron::Messages;
  57 use Koha::Patron::Modifications;
  58 use Koha::Patron::MessagePreferences;
  59 use Koha::Patron::Relationships;
  60 use Koha::Patron::Restrictions;
  61 use Koha::Patrons;
  62 use Koha::Plugins;
  63 use Koha::Recalls;
  64 use Koha::Result::Boolean;
  65 use Koha::Subscription::Routinglists;
  66 use Koha::Token;
  67 use Koha::Virtualshelves;
  68
  69 use base qw(Koha::Object);
  70
  71 use constant ADMINISTRATIVE_LOCKOUT => -1;
  72
  73 our $RESULTSET_PATRON_ID_MAPPING = {
  74     Accountline          => 'borrowernumber',
  75     Aqbasketuser         => 'borrowernumber',
  76     Aqbudget             => 'budget_owner_id',
  77     Aqbudgetborrower     => 'borrowernumber',
  78     ArticleRequest       => 'borrowernumber',
  79     BorrowerDebarment    => 'borrowernumber',
  80     BorrowerFile         => 'borrowernumber',
  81     BorrowerModification => 'borrowernumber',
  82     ClubEnrollment       => 'borrowernumber',
  83     Issue                => 'borrowernumber',
  84     ItemsLastBorrower    => 'borrowernumber',
  85     Linktracker          => 'borrowernumber',
  86     Message              => 'borrowernumber',
  87     MessageQueue         => 'borrowernumber',
  88     OldIssue             => 'borrowernumber',
  89     OldReserve           => 'borrowernumber',
  90     Rating               => 'borrowernumber',
  91     Reserve              => 'borrowernumber',
  92     Review               => 'borrowernumber',
  93     SearchHistory        => 'userid',
  94     Statistic            => 'borrowernumber',
  95     Suggestion           => 'suggestedby',
  96     TagAll               => 'borrowernumber',
  97     Virtualshelfcontent  => 'borrowernumber',
  98     Virtualshelfshare    => 'borrowernumber',
  99     Virtualshelve        => 'owner',
 100 };
 101
 102 =head1 NAME
 103
 104 Koha::Patron - Koha Patron Object class
 105
 106 =head1 API
 107
 108 =head2 Class Methods
 109
 110 =head3 new
 111
 112 =cut
 113
 114 sub new {
 115     my ( $class, $params ) = @_;
 116
 117     return $class->SUPER::new($params);
 118 }
 119
 120 =head3 fixup_cardnumber
 121
 122 Autogenerate next cardnumber from highest value found in database
 123
 124 =cut
 125
 126 sub fixup_cardnumber {
 127     my ( $self ) = @_;
 128
 129     my $max = $self->cardnumber;
 130     Koha::Plugins->call( 'patron_barcode_transform', \$max );
 131
 132     $max ||= Koha::Patrons->search({
 133         cardnumber => {-regexp => '^-?[0-9]+$'}
 134     }, {
 135         select => \'CAST(cardnumber AS SIGNED)',
 136         as => ['cast_cardnumber']
 137     })->_resultset->get_column('cast_cardnumber')->max;
 138     $self->cardnumber(($max || 0) +1);
 139 }
 140
 141 =head3 trim_whitespace
 142
 143 trim whitespace from data which has some non-whitespace in it.
 144 Could be moved to Koha::Object if need to be reused
 145
 146 =cut
 147
 148 sub trim_whitespaces {
 149     my( $self ) = @_;
 150
 151     my $schema  = Koha::Database->new->schema;
 152     my @columns = $schema->source($self->_type)->columns;
 153
 154     for my $column( @columns ) {
 155         my $value = $self->$column;
 156         if ( defined $value ) {
 157             $value =~ s/^\s*|\s*$//g;
 158             $self->$column($value);
 159         }
 160     }
 161     return $self;
 162 }
 163
 164 =head3 plain_text_password
 165
 166 $patron->plain_text_password( $password );
 167
 168 stores a copy of the unencrypted password in the object
 169 for use in code before encrypting for db
 170
 171 =cut
 172
 173 sub plain_text_password {
 174     my ( $self, $password ) = @_;
 175     if ( $password ) {
 176         $self->{_plain_text_password} = $password;
 177         return $self;
 178     }
 179     return $self->{_plain_text_password}
 180         if $self->{_plain_text_password};
 181
 182     return;
 183 }
 184
 185 =head3 store
 186
 187 Patron specific store method to cleanup record
 188 and do other necessary things before saving
 189 to db
 190
 191 =cut
 192
 193 sub store {
 194     my $self = shift;
 195     my $params = @_ ? shift : {};
 196
 197     my $guarantors = $params->{guarantors} // [];
 198
 199     $self->_result->result_source->schema->txn_do(
 200         sub {
 201             if (
 202                 C4::Context->preference("autoMemberNum")
 203                 and ( not defined $self->cardnumber
 204                     or $self->cardnumber eq '' )
 205               )
 206             {
 207                 # Warning: The caller is responsible for locking the members table in write
 208                 # mode, to avoid database corruption.
 209                 # We are in a transaction but the table is not locked
 210                 $self->fixup_cardnumber;
 211             }
 212
 213             unless( $self->category->in_storage ) {
 214                 Koha::Exceptions::Object::FKConstraint->throw(
 215                     broken_fk => 'categorycode',
 216                     value     => $self->categorycode,
 217                 );
 218             }
 219
 220             $self->trim_whitespaces;
 221
 222             my $new_cardnumber = $self->cardnumber;
 223             Koha::Plugins->call( 'patron_barcode_transform', \$new_cardnumber );
 224             $self->cardnumber( $new_cardnumber );
 225
 226             # Set surname to uppercase if uppercasesurname is true
 227             $self->surname( uc($self->surname) )
 228                 if C4::Context->preference("uppercasesurnames");
 229
 230             $self->relationship(undef) # We do not want to store an empty string in this field
 231               if defined $self->relationship
 232                      and $self->relationship eq "";
 233
 234             unless ( $self->in_storage ) {    #AddMember
 235
 236                 # Generate a valid userid/login if needed
 237                 $self->generate_userid unless $self->userid;
 238                 Koha::Exceptions::Patron::InvalidUserid->throw( userid => $self->userid )
 239                     unless $self->has_valid_userid;
 240
 241                 # Add expiration date if it isn't already there
 242                 unless ( $self->dateexpiry ) {
 243                     $self->dateexpiry( $self->category->get_expiry_date );
 244                 }
 245
 246                 # Add enrollment date if it isn't already there
 247                 unless ( $self->dateenrolled ) {
 248                     $self->dateenrolled(dt_from_string);
 249                 }
 250
 251                 # Set the privacy depending on the patron's category
 252                 my $default_privacy = $self->category->default_privacy || q{};
 253                 $default_privacy =
 254                     $default_privacy eq 'default' ? 1
 255                   : $default_privacy eq 'never'   ? 2
 256                   : $default_privacy eq 'forever' ? 0
 257                   :                                                   undef;
 258                 $self->privacy($default_privacy);
 259
 260                 # Call any check_password plugins if password is passed
 261                 if ( C4::Context->config("enable_plugins") && $self->password ) {
 262                     my @plugins = Koha::Plugins->new()->GetPlugins({
 263                         method => 'check_password',
 264                     });
 265                     foreach my $plugin ( @plugins ) {
 266                         # This plugin hook will also be used by a plugin for the Norwegian national
 267                         # patron database. This is why we need to pass both the password and the
 268                         # borrowernumber to the plugin.
 269                         my $ret = $plugin->check_password(
 270                             {
 271                                 password       => $self->password,
 272                                 borrowernumber => $self->borrowernumber
 273                             }
 274                         );
 275                         if ( $ret->{'error'} == 1 ) {
 276                             Koha::Exceptions::Password::Plugin->throw();
 277                         }
 278                     }
 279                 }
 280
 281                 # Make a copy of the plain text password for later use
 282                 $self->plain_text_password( $self->password );
 283
 284                 $self->password_expiration_date( $self->password
 285                     ? $self->category->get_password_expiry_date || undef
 286                     : undef );
 287                 # Create a disabled account if no password provided
 288                 $self->password( $self->password
 289                     ? Koha::AuthUtils::hash_password( $self->password )
 290                     : '!' );
 291
 292                 $self->borrowernumber(undef);
 293
 294                 if ( C4::Context->preference('ChildNeedsGuarantor')
 295                     and ( $self->is_child or $self->category->can_be_guarantee )
 296                     and $self->contactname eq ""
 297                     and !@$guarantors )
 298                 {
 299                     Koha::Exceptions::Patron::Relationship::NoGuarantor->throw();
 300                 }
 301
 302                 foreach my $guarantor (@$guarantors) {
 303                     if ( $guarantor->is_child or $guarantor->category->can_be_guarantee) {
 304                         Koha::Exceptions::Patron::Relationship::InvalidRelationship
 305                         ->throw( invalid_guarantor => 1 );
 306                     }
 307                 }
 308
 309                 $self = $self->SUPER::store;
 310
 311                 $self->add_enrolment_fee_if_needed(0);
 312
 313                 logaction( "MEMBERS", "CREATE", $self->borrowernumber, "" )
 314                   if C4::Context->preference("BorrowersLog");
 315             }
 316             else {    #ModMember
 317
 318                 my $self_from_storage = $self->get_from_storage;
 319
 320                 # Do not accept invalid userid here
 321                 $self->generate_userid unless $self->userid;
 322                 Koha::Exceptions::Patron::InvalidUserid->throw( userid => $self->userid )
 323                       unless $self->has_valid_userid;
 324
 325                 # If a borrower has set their privacy to never we should immediately anonymize
 326                 # their checkouts
 327                 if( $self->privacy() == 2 && $self_from_storage->privacy() != 2 ){
 328                     try{
 329                         $self->old_checkouts->anonymize;
 330                     }
 331                     catch {
 332                         Koha::Exceptions::Patron::FailedAnonymizing->throw(
 333                             error => @_
 334                         );
 335                     };
 336                 }
 337
 338                 # Password must be updated using $self->set_password
 339                 $self->password($self_from_storage->password);
 340
 341                 if ( $self->category->categorycode ne
 342                     $self_from_storage->category->categorycode )
 343                 {
 344                     # Add enrolement fee on category change if required
 345                     $self->add_enrolment_fee_if_needed(1)
 346                       if C4::Context->preference('FeeOnChangePatronCategory');
 347
 348                     # Clean up guarantors on category change if required
 349                     $self->guarantor_relationships->delete
 350                       unless ( $self->category->can_be_guarantee );
 351
 352                 }
 353
 354                 my @existing_guarantors = $self->guarantor_relationships()->guarantors->as_list;
 355                 push @$guarantors, @existing_guarantors;
 356
 357                 if ( C4::Context->preference('ChildNeedsGuarantor')
 358                     and ( $self->is_child or $self->category->can_be_guarantee )
 359                     and $self->contactname eq ""
 360                     and !@$guarantors )
 361                 {
 362                     Koha::Exceptions::Patron::Relationship::NoGuarantor->throw();
 363                 }
 364
 365                 foreach my $guarantor (@$guarantors) {
 366                     if ( $guarantor->is_child or $guarantor->category->can_be_guarantee) {
 367                         Koha::Exceptions::Patron::Relationship::InvalidRelationship
 368                         ->throw( invalid_guarantor => 1 );
 369                     }
 370                 }
 371
 372                 # Actionlogs
 373                 if ( C4::Context->preference("BorrowersLog") ) {
 374                     my $info;
 375                     my $from_storage = $self_from_storage->unblessed;
 376                     my $from_object  = $self->unblessed;
 377                     my @skip_fields  = (qw/lastseen updated_on/);
 378                     for my $key ( keys %{$from_storage} ) {
 379                         next if any { /$key/ } @skip_fields;
 380                         if (
 381                             (
 382                                   !defined( $from_storage->{$key} )
 383                                 && defined( $from_object->{$key} )
 384                             )
 385                             || ( defined( $from_storage->{$key} )
 386                                 && !defined( $from_object->{$key} ) )
 387                             || (
 388                                    defined( $from_storage->{$key} )
 389                                 && defined( $from_object->{$key} )
 390                                 && ( $from_storage->{$key} ne
 391                                     $from_object->{$key} )
 392                             )
 393                           )
 394                         {
 395                             $info->{$key} = {
 396                                 before => $from_storage->{$key},
 397                                 after  => $from_object->{$key}
 398                             };
 399                         }
 400                     }
 401
 402                     if ( defined($info) ) {
 403                         logaction(
 404                             "MEMBERS",
 405                             "MODIFY",
 406                             $self->borrowernumber,
 407                             to_json(
 408                                 $info,
 409                                 { utf8 => 1, pretty => 1, canonical => 1 }
 410                             )
 411                         );
 412                     }
 413                 }
 414
 415                 # Final store
 416                 $self = $self->SUPER::store;
 417             }
 418         }
 419     );
 420     return $self;
 421 }
 422
 423 =head3 delete
 424
 425 $patron->delete
 426
 427 Delete patron's holds, lists and finally the patron.
 428
 429 Lists owned by the borrower are deleted or ownership is transferred depending on the
 430 ListOwnershipUponPatronDeletion pref, but entries from the borrower to other lists are kept.
 431
 432 =cut
 433
 434 sub delete {
 435     my ($self) = @_;
 436
 437     my $anonymous_patron = C4::Context->preference("AnonymousPatron");
 438     Koha::Exceptions::Patron::FailedDeleteAnonymousPatron->throw() if $anonymous_patron && $self->id eq $anonymous_patron;
 439
 440     # Check if patron is protected
 441     Koha::Exceptions::Patron::FailedDeleteProtectedPatron->throw() if $self->protected == 1;
 442
 443     $self->_result->result_source->schema->txn_do(
 444         sub {
 445             # Cancel Patron's holds
 446             my $holds = $self->holds;
 447             while( my $hold = $holds->next ){
 448                 $hold->cancel;
 449             }
 450
 451             # Handle lists (virtualshelves)
 452             $self->virtualshelves->disown_or_delete;
 453
 454             # We cannot have a FK on borrower_modifications.borrowernumber, the table is also used
 455             # for patron selfreg
 456             $_->delete for Koha::Patron::Modifications->search( { borrowernumber => $self->borrowernumber } )->as_list;
 457
 458             $self->SUPER::delete;
 459
 460             logaction( "MEMBERS", "DELETE", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog");
 461         }
 462     );
 463     return $self;
 464 }
 465
 466 =head3 category
 467
 468 my $patron_category = $patron->category
 469
 470 Return the patron category for this patron
 471
 472 =cut
 473
 474 sub category {
 475     my ( $self ) = @_;
 476     return Koha::Patron::Category->_new_from_dbic( $self->_result->categorycode );
 477 }
 478
 479 =head3 image
 480
 481 =cut
 482
 483 sub image {
 484     my ( $self ) = @_;
 485
 486     return Koha::Patron::Images->find( $self->borrowernumber );
 487 }
 488
 489 =head3 library
 490
 491 Returns a Koha::Library object representing the patron's home library.
 492
 493 =cut
 494
 495 sub library {
 496     my ( $self ) = @_;
 497     return Koha::Library->_new_from_dbic($self->_result->branchcode);
 498 }
 499
 500 =head3 sms_provider
 501
 502 Returns a Koha::SMS::Provider object representing the patron's SMS provider.
 503
 504 =cut
 505
 506 sub sms_provider {
 507     my ( $self ) = @_;
 508     my $sms_provider_rs = $self->_result->sms_provider;
 509     return unless $sms_provider_rs;
 510     return Koha::SMS::Provider->_new_from_dbic($sms_provider_rs);
 511 }
 512
 513 =head3 guarantor_relationships
 514
 515 Returns Koha::Patron::Relationships object for this patron's guarantors
 516
 517 Returns the set of relationships for the patrons that are guarantors for this patron.
 518
 519 Note that a guarantor should exist as a patron in Koha; it was not possible
 520 to add them without a guarantor_id in the interface for some time. Bug 30472
 521 restricts it on db level.
 522
 523 =cut
 524
 525 sub guarantor_relationships {
 526     my ($self) = @_;
 527
 528     return Koha::Patron::Relationships->search( { guarantee_id => $self->id } );
 529 }
 530
 531 =head3 guarantee_relationships
 532
 533 Returns Koha::Patron::Relationships object for this patron's guarantors
 534
 535 Returns the set of relationships for the patrons that are guarantees for this patron.
 536
 537 The method returns Koha::Patron::Relationship objects for the sake
 538 of consistency with the guantors method.
 539 A guarantee by definition must exist as a patron in Koha.
 540
 541 =cut
 542
 543 sub guarantee_relationships {
 544     my ($self) = @_;
 545
 546     return Koha::Patron::Relationships->search(
 547         { guarantor_id => $self->id },
 548         {
 549             prefetch => 'guarantee',
 550             order_by => { -asc => [ 'guarantee.surname', 'guarantee.firstname' ] },
 551         }
 552     );
 553 }
 554
 555 =head3 relationships_debt
 556
 557 Returns the amount owed by the patron's guarantors *and* the other guarantees of those guarantors
 558
 559 =cut
 560
 561 sub relationships_debt {
 562     my ($self, $params) = @_;
 563
 564     my $include_guarantors  = $params->{include_guarantors};
 565     my $only_this_guarantor = $params->{only_this_guarantor};
 566     my $include_this_patron = $params->{include_this_patron};
 567
 568     my @guarantors;
 569     if ( $only_this_guarantor ) {
 570         @guarantors = $self->guarantee_relationships->count ? ( $self ) : ();
 571         Koha::Exceptions::BadParameter->throw( { parameter => 'only_this_guarantor' } ) unless @guarantors;
 572     } elsif ( $self->guarantor_relationships->count ) {
 573         # I am a guarantee, just get all my guarantors
 574         @guarantors = $self->guarantor_relationships->guarantors->as_list;
 575     } else {
 576         # I am a guarantor, I need to get all the guarantors of all my guarantees
 577         @guarantors = map { $_->guarantor_relationships->guarantors->as_list } $self->guarantee_relationships->guarantees->as_list;
 578     }
 579
 580     my $non_issues_charges = 0;
 581     my $seen = $include_this_patron ? {} : { $self->id => 1 }; # For tracking members already added to the total
 582     foreach my $guarantor (@guarantors) {
 583         $non_issues_charges += $guarantor->account->non_issues_charges if $include_guarantors && !$seen->{ $guarantor->id };
 584
 585         # We've added what the guarantor owes, not added in that guarantor's guarantees as well
 586         my @guarantees = map { $_->guarantee } $guarantor->guarantee_relationships->as_list;
 587         my $guarantees_non_issues_charges = 0;
 588         foreach my $guarantee (@guarantees) {
 589             next if $seen->{ $guarantee->id };
 590             $guarantees_non_issues_charges += $guarantee->account->non_issues_charges;
 591             # Mark this guarantee as seen so we don't double count a guarantee linked to multiple guarantors
 592             $seen->{ $guarantee->id } = 1;
 593         }
 594
 595         $non_issues_charges += $guarantees_non_issues_charges;
 596         $seen->{ $guarantor->id } = 1;
 597     }
 598
 599     return $non_issues_charges;
 600 }
 601
 602 =head3 housebound_profile
 603
 604 Returns the HouseboundProfile associated with this patron.
 605
 606 =cut
 607
 608 sub housebound_profile {
 609     my ( $self ) = @_;
 610     my $profile = $self->_result->housebound_profile;
 611     return Koha::Patron::HouseboundProfile->_new_from_dbic($profile)
 612         if ( $profile );
 613     return;
 614 }
 615
 616 =head3 housebound_role
 617
 618 Returns the HouseboundRole associated with this patron.
 619
 620 =cut
 621
 622 sub housebound_role {
 623     my ( $self ) = @_;
 624
 625     my $role = $self->_result->housebound_role;
 626     return Koha::Patron::HouseboundRole->_new_from_dbic($role) if ( $role );
 627     return;
 628 }
 629
 630 =head3 siblings
 631
 632 Returns the siblings of this patron.
 633
 634 =cut
 635
 636 sub siblings {
 637     my ($self) = @_;
 638
 639     my @guarantors = $self->guarantor_relationships()->guarantors()->as_list;
 640
 641     return unless @guarantors;
 642
 643     my @siblings =
 644       map { $_->guarantee_relationships()->guarantees()->as_list } @guarantors;
 645
 646     return unless @siblings;
 647
 648     my %seen;
 649     @siblings =
 650       grep { !$seen{ $_->id }++ && ( $_->id != $self->id ) } @siblings;
 651
 652     return Koha::Patrons->search( { borrowernumber => { -in => [ map { $_->id } @siblings ] } } );
 653 }
 654
 655 =head3 merge_with
 656
 657     my $patron = Koha::Patrons->find($id);
 658     $patron->merge_with( \@patron_ids );
 659
 660     This subroutine merges a list of patrons into the patron record. This is accomplished by finding
 661     all related patron ids for the patrons to be merged in other tables and changing the ids to be that
 662     of the keeper patron.
 663
 664 =cut
 665
 666 sub merge_with {
 667     my ( $self, $patron_ids ) = @_;
 668
 669     my $anonymous_patron = C4::Context->preference("AnonymousPatron");
 670     return if $anonymous_patron && $self->id eq $anonymous_patron;
 671
 672     # Do not merge other patrons into a protected patron
 673     return if $self->protected;
 674
 675     my @patron_ids = @{ $patron_ids };
 676
 677     # Ensure the keeper isn't in the list of patrons to merge
 678     @patron_ids = grep { $_ ne $self->id } @patron_ids;
 679
 680     my $schema = Koha::Database->new()->schema();
 681
 682     my $results;
 683
 684     $self->_result->result_source->schema->txn_do( sub {
 685         foreach my $patron_id (@patron_ids) {
 686
 687             next if $patron_id eq $anonymous_patron;
 688
 689             my $patron = Koha::Patrons->find( $patron_id );
 690
 691             next unless $patron;
 692
 693             # Do not merge protected patrons into other patrons
 694             next if $patron->protected;
 695
 696             # Unbless for safety, the patron will end up being deleted
 697             $results->{merged}->{$patron_id}->{patron} = $patron->unblessed;
 698
 699             my $attributes = $patron->extended_attributes;
 700             my $new_attributes = [
 701                 map { { code => $_->code, attribute => $_->attribute } }
 702                     $attributes->as_list
 703             ];
 704             $attributes->delete; # We need to delete before trying to merge them to prevent exception on unique and repeatable
 705             for my $attribute ( @$new_attributes ) {
 706                 try {
 707                     $self->add_extended_attribute($attribute);
 708                 } catch {
 709                     # Don't block the merge if there is a non-repeatable attribute that cannot be added to the current patron.
 710                     unless ( $_->isa('Koha::Exceptions::Patron::Attribute::NonRepeatable') ) {
 711                         $_->rethrow;
 712                     }
 713                 };
 714             }
 715
 716             while (my ($r, $field) = each(%$RESULTSET_PATRON_ID_MAPPING)) {
 717                 my $rs = $schema->resultset($r)->search({ $field => $patron_id });
 718                 $results->{merged}->{ $patron_id }->{updated}->{$r} = $rs->count();
 719                 $rs->update({ $field => $self->id });
 720                 if ( $r eq 'BorrowerDebarment' ) {
 721                     Koha::Patron::Debarments::UpdateBorrowerDebarmentFlags($self->id);
 722                 }
 723             }
 724
 725             $patron->move_to_deleted();
 726             $patron->delete();
 727         }
 728     });
 729
 730     return $results;
 731 }
 732
 733
 734 =head3 messaging_preferences
 735
 736     my $patron = Koha::Patrons->find($id);
 737     $patron->messaging_preferences();
 738
 739 =cut
 740
 741 sub messaging_preferences {
 742     my ( $self ) = @_;
 743
 744     return Koha::Patron::MessagePreferences->search({
 745         borrowernumber => $self->borrowernumber,
 746     });
 747 }
 748
 749 =head3 wants_check_for_previous_checkout
 750
 751     $wants_check = $patron->wants_check_for_previous_checkout;
 752
 753 Return 1 if Koha needs to perform PrevIssue checking, else 0.
 754
 755 =cut
 756
 757 sub wants_check_for_previous_checkout {
 758     my ( $self ) = @_;
 759     my $syspref = C4::Context->preference("checkPrevCheckout");
 760
 761     # Simple cases
 762     ## Hard syspref trumps all
 763     return 1 if ($syspref eq 'hardyes');
 764     return 0 if ($syspref eq 'hardno');
 765     ## Now, patron pref trumps all
 766     return 1 if ($self->checkprevcheckout eq 'yes');
 767     return 0 if ($self->checkprevcheckout eq 'no');
 768
 769     # More complex: patron inherits -> determine category preference
 770     my $checkPrevCheckoutByCat = $self->category->checkprevcheckout;
 771     return 1 if ($checkPrevCheckoutByCat eq 'yes');
 772     return 0 if ($checkPrevCheckoutByCat eq 'no');
 773
 774     # Finally: category preference is inherit, default to 0
 775     if ($syspref eq 'softyes') {
 776         return 1;
 777     } else {
 778         return 0;
 779     }
 780 }
 781
 782 =head3 do_check_for_previous_checkout
 783
 784     $do_check = $patron->do_check_for_previous_checkout($item);
 785
 786 Return 1 if the bib associated with $ITEM has previously been checked out to
 787 $PATRON, 0 otherwise.
 788
 789 =cut
 790
 791 sub do_check_for_previous_checkout {
 792     my ( $self, $item ) = @_;
 793
 794     my @item_nos;
 795     my $biblio = Koha::Biblios->find( $item->{biblionumber} );
 796     if ( $biblio->is_serial ) {
 797         push @item_nos, $item->{itemnumber};
 798     } else {
 799         # Get all itemnumbers for given bibliographic record.
 800         @item_nos = $biblio->items->get_column( 'itemnumber' );
 801     }
 802
 803     # Create (old)issues search criteria
 804     my $criteria = {
 805         borrowernumber => $self->borrowernumber,
 806         itemnumber => \@item_nos,
 807     };
 808
 809     my $delay = C4::Context->preference('CheckPrevCheckoutDelay') || 0;
 810     if ($delay) {
 811         my $dtf = Koha::Database->new->schema->storage->datetime_parser;
 812         my $newer_than = dt_from_string()->subtract( days => $delay );
 813         $criteria->{'returndate'} = { '>'   =>  $dtf->format_datetime($newer_than), };
 814     }
 815
 816     # Check current issues table
 817     my $issues = Koha::Checkouts->search($criteria);
 818     return 1 if $issues->count; # 0 || N
 819
 820     # Check old issues table
 821     my $old_issues = Koha::Old::Checkouts->search($criteria);
 822     return $old_issues->count;  # 0 || N
 823 }
 824
 825 =head3 is_debarred
 826
 827 my $debarment_expiration = $patron->is_debarred;
 828
 829 Returns the date a patron debarment will expire, or undef if the patron is not
 830 debarred
 831
 832 =cut
 833
 834 sub is_debarred {
 835     my ($self) = @_;
 836
 837     return unless $self->debarred;
 838     return $self->debarred
 839       if $self->debarred =~ '^9999'
 840       or dt_from_string( $self->debarred ) > dt_from_string;
 841     return;
 842 }
 843
 844 =head3 is_expired
 845
 846 my $is_expired = $patron->is_expired;
 847
 848 Returns 1 if the patron is expired or 0;
 849
 850 =cut
 851
 852 sub is_expired {
 853     my ($self) = @_;
 854     return 0 unless $self->dateexpiry;
 855     return 0 if $self->dateexpiry =~ '^9999';
 856     return 1 if dt_from_string( $self->dateexpiry ) < dt_from_string->truncate( to => 'day' );
 857     return 0;
 858 }
 859
 860 =head3 is_active
 861
 862 $patron->is_active({ [ since => $date ], [ days|weeks|months|years => $value ] })
 863
 864 A patron is considered 'active' if the following conditions hold:
 865
 866     - account did not expire
 867     - account has not been anonymized
 868     - enrollment or lastseen within period specified
 869
 870 Note: lastseen is updated for triggers defined in preference
 871 TrackLastPatronActivityTriggers. This includes logins, issues, holds, etc.
 872
 873 The period to check is defined by $date or $value in days, weeks or months. You should
 874 pass one of those; otherwise an exception is thrown.
 875
 876 =cut
 877
 878 sub is_active {
 879     my ( $self, $params ) = @_;
 880     return 0 if $self->is_expired or $self->anonymized;
 881
 882     my $dt;
 883     if ( $params->{since} ) {
 884         $dt = dt_from_string( $params->{since}, 'iso' );
 885     } elsif ( grep { $params->{$_} } qw(days weeks months years) ) {
 886         $dt = dt_from_string();
 887         foreach my $duration (qw(days weeks months years)) {
 888             $dt = $dt->subtract( $duration => $params->{$duration} ) if $params->{$duration};
 889         }
 890     } else {
 891         Koha::Exceptions::MissingParameter->throw('is_active needs date or period');
 892     }
 893
 894     # Enrollment within this period?
 895     return 1 if DateTime->compare( dt_from_string( $self->dateenrolled ), $dt ) > -1;
 896
 897     # We look at lastseen regardless of TrackLastPatronActivityTriggers. If lastseen is set
 898     # recently, the triggers may have been removed after that, etc.
 899     return 1 if $self->lastseen && DateTime->compare( dt_from_string( $self->lastseen ), $dt ) > -1;
 900
 901     return 0;
 902 }
 903
 904 =head3 password_expired
 905
 906 my $password_expired = $patron->password_expired;
 907
 908 Returns 1 if the patron's password is expired or 0;
 909
 910 =cut
 911
 912 sub password_expired {
 913     my ($self) = @_;
 914     return 0 unless $self->password_expiration_date;
 915     return 1 if dt_from_string( $self->password_expiration_date ) <= dt_from_string->truncate( to => 'day' );
 916     return 0;
 917 }
 918
 919 =head3 is_going_to_expire
 920
 921 my $is_going_to_expire = $patron->is_going_to_expire;
 922
 923 Returns 1 if the patron is going to expired, depending on the NotifyBorrowerDeparture pref or 0
 924
 925 =cut
 926
 927 sub is_going_to_expire {
 928     my ($self) = @_;
 929
 930     my $delay = C4::Context->preference('NotifyBorrowerDeparture') || 0;
 931
 932     return 0 unless $delay;
 933     return 0 unless $self->dateexpiry;
 934     return 0 if $self->dateexpiry =~ '^9999';
 935     return 1 if dt_from_string( $self->dateexpiry, undef, 'floating' )->subtract( days => $delay ) < dt_from_string(undef, undef, 'floating')->truncate( to => 'day' );
 936     return 0;
 937 }
 938
 939 =head3 set_password
 940
 941     $patron->set_password({ password => $plain_text_password [, skip_validation => 1, action => NAME ] });
 942
 943 Set the patron's password.
 944
 945 Allows optional action parameter to change name of action logged (when enabled). Used for reset password.
 946
 947 =head4 Exceptions
 948
 949 The passed string is validated against the current password enforcement policy.
 950 Validation can be skipped by passing the I<skip_validation> parameter.
 951
 952 Exceptions are thrown if the password is not good enough.
 953
 954 =over 4
 955
 956 =item Koha::Exceptions::Password::TooShort
 957
 958 =item Koha::Exceptions::Password::WhitespaceCharacters
 959
 960 =item Koha::Exceptions::Password::TooWeak
 961
 962 =item Koha::Exceptions::Password::Plugin (if a "check password" plugin is enabled)
 963
 964 =back
 965
 966 =cut
 967
 968 sub set_password {
 969     my ( $self, $args ) = @_;
 970
 971     my $password = $args->{password};
 972     my $action   = $args->{action} || "CHANGE PASS";
 973
 974     unless ( $args->{skip_validation} ) {
 975         my ( $is_valid, $error ) = Koha::AuthUtils::is_password_valid( $password, $self->category );
 976
 977         if ( !$is_valid ) {
 978             if ( $error eq 'too_short' ) {
 979                 my $min_length = $self->category->effective_min_password_length;
 980                 $min_length = 3 if not $min_length or $min_length < 3;
 981
 982                 my $password_length = length($password);
 983                 Koha::Exceptions::Password::TooShort->throw(
 984                     length => $password_length, min_length => $min_length );
 985             }
 986             elsif ( $error eq 'has_whitespaces' ) {
 987                 Koha::Exceptions::Password::WhitespaceCharacters->throw();
 988             }
 989             elsif ( $error eq 'too_weak' ) {
 990                 Koha::Exceptions::Password::TooWeak->throw();
 991             }
 992         }
 993     }
 994
 995     if ( C4::Context->config("enable_plugins") ) {
 996         # Call any check_password plugins
 997         my @plugins = Koha::Plugins->new()->GetPlugins({
 998             method => 'check_password',
 999         });
1000         foreach my $plugin ( @plugins ) {
1001             # This plugin hook will also be used by a plugin for the Norwegian national
1002             # patron database. This is why we need to pass both the password and the
1003             # borrowernumber to the plugin.
1004             my $ret = $plugin->check_password(
1005                 {
1006                     password       => $password,
1007                     borrowernumber => $self->borrowernumber
1008                 }
1009             );
1010             # This plugin hook will also be used by a plugin for the Norwegian national
1011             # patron database. This is why we need to call the actual plugins and then
1012             # check skip_validation afterwards.
1013             if ( $ret->{'error'} == 1 && !$args->{skip_validation} ) {
1014                 Koha::Exceptions::Password::Plugin->throw();
1015             }
1016         }
1017     }
1018
1019     if ( C4::Context->preference('NotifyPasswordChange') ) {
1020         my $self_from_storage = $self->get_from_storage;
1021         if ( !C4::Auth::checkpw_hash( $password, $self_from_storage->password ) ) {
1022             my $emailaddr = $self_from_storage->notice_email_address;
1023
1024             # if we manage to find a valid email address, send notice
1025             if ($emailaddr) {
1026                 my $letter = C4::Letters::GetPreparedLetter(
1027                     module      => 'members',
1028                     letter_code => 'PASSWORD_CHANGE',
1029                     branchcode  => $self_from_storage->branchcode,
1030                     ,
1031                     lang   => $self_from_storage->lang || 'default',
1032                     tables => {
1033                         'branches'  => $self_from_storage->branchcode,
1034                         'borrowers' => $self_from_storage->borrowernumber,
1035                     },
1036                     want_librarian => 1,
1037                 ) or return;
1038
1039                 my $message_id = C4::Letters::EnqueueLetter(
1040                     {
1041                         letter                 => $letter,
1042                         borrowernumber         => $self_from_storage->id,
1043                         to_address             => $emailaddr,
1044                         message_transport_type => 'email'
1045                     }
1046                 );
1047                 C4::Letters::SendQueuedMessages( { message_id => $message_id } ) if $message_id;
1048             }
1049         }
1050     }
1051
1052     my $digest = Koha::AuthUtils::hash_password($password);
1053
1054     $self->password_expiration_date( $self->category->get_password_expiry_date || undef );
1055
1056     # We do not want to call $self->store and retrieve password from DB
1057     $self->password($digest);
1058     $self->login_attempts(0);
1059     $self->SUPER::store;
1060
1061     logaction( "MEMBERS", $action, $self->borrowernumber, "" )
1062         if C4::Context->preference("BorrowersLog");
1063
1064     return $self;
1065 }
1066
1067
1068 =head3 renew_account
1069
1070 my $new_expiry_date = $patron->renew_account
1071
1072 Extending the subscription to the expiry date.
1073
1074 =cut
1075
1076 sub renew_account {
1077     my ($self) = @_;
1078     my $date;
1079     if ( C4::Context->preference('BorrowerRenewalPeriodBase') eq 'combination' ) {
1080         $date = ( dt_from_string gt dt_from_string( $self->dateexpiry ) ) ? dt_from_string : dt_from_string( $self->dateexpiry );
1081     } else {
1082         $date =
1083             C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry'
1084             ? dt_from_string( $self->dateexpiry )
1085             : dt_from_string;
1086     }
1087     my $expiry_date = $self->category->get_expiry_date($date);
1088
1089     $self->dateexpiry($expiry_date);
1090     $self->date_renewed( dt_from_string() );
1091     $self->store();
1092
1093     $self->add_enrolment_fee_if_needed(1);
1094
1095     logaction( "MEMBERS", "RENEW", $self->borrowernumber, "Membership renewed" ) if C4::Context->preference("BorrowersLog");
1096     return dt_from_string( $expiry_date )->truncate( to => 'day' );
1097 }
1098
1099 =head3 has_overdues
1100
1101 my $has_overdues = $patron->has_overdues;
1102
1103 Returns the number of patron's overdues
1104
1105 =cut
1106
1107 sub has_overdues {
1108     my ($self) = @_;
1109     my $date = dt_from_string();
1110     my $dtf = Koha::Database->new->schema->storage->datetime_parser;
1111     return $self->_result->issues->search({ date_due => { '<' => $dtf->format_datetime($date) } })->count;
1112 }
1113
1114
1115
1116 =head3 has_restricting_overdues
1117
1118 my $has_restricting_overdues = $patron->has_restricting_overdues({ issue_branchcode => $branchcode });
1119
1120 Returns true if patron has overdues that would result in debarment.
1121
1122 =cut
1123
1124 sub has_restricting_overdues {
1125     my ( $self, $params ) = @_;
1126     $params //= {};
1127     my $date = dt_from_string()->truncate( to => 'day' );
1128
1129     # If ignoring unrestricted overdues, calculate which delay value for
1130     # overdue messages is set with restrictions. Then only include overdue
1131     # issues older than that date when counting.
1132     #TODO: bail out/throw exception if $params->{issue_branchcode} not set?
1133     my $debarred_delay = _get_overdue_debarred_delay( $params->{issue_branchcode}, $self->categorycode() );
1134     return 0 unless defined $debarred_delay;
1135
1136     # Emulate the conditions in overdue_notices.pl.
1137     # The overdue_notices-script effectively truncates both issues.date_due and current date
1138     # to days when selecting overdue issues.
1139     # Hours and minutes for issues.date_due is usually set to 23 and 59 respectively, though can theoretically
1140     # be set to any other value (truncated to minutes, except if CalcDateDue gets a $startdate)
1141     #
1142     # No matter what time of day date_due is set to, overdue_notices.pl will select all issues that are due
1143     # the current date or later. We can emulate this query by instead of truncating both to days in the SQL-query,
1144     # using the condition that date_due must be less then the current date truncated to days (time set to 00:00:00)
1145     # offset by one day in the future.
1146
1147     $date->add( days => 1 );
1148
1149     my $calendar;
1150     if ( C4::Context->preference('OverdueNoticeCalendar') ) {
1151         $calendar = Koha::Calendar->new( branchcode => $params->{issue_branchcode} );
1152     }
1153
1154     my $dtf    = Koha::Database->new->schema->storage->datetime_parser;
1155     my $issues = $self->_result->issues->search( { date_due => { '<' => $dtf->format_datetime($date) } } );
1156     my $now    = dt_from_string();
1157
1158     while ( my $issue = $issues->next ) {
1159         my $days_between =
1160             C4::Context->preference('OverdueNoticeCalendar')
1161             ? $calendar->days_between( dt_from_string( $issue->date_due ), $now )->in_units('days')
1162             : $now->delta_days( dt_from_string( $issue->date_due ) )->in_units('days');
1163         if ( $days_between >= $debarred_delay ) {
1164             return 1;
1165         }
1166     }
1167     return 0;
1168 }
1169
1170 # Fetch first delayX value from overduerules where debarredX is set, or 0 for no delay
1171 sub _get_overdue_debarred_delay {
1172     my ( $branchcode, $categorycode ) = @_;
1173     my $dbh = C4::Context->dbh();
1174
1175     # We get default rules if there is no rule for this branch
1176     my $rule = Koha::OverdueRules->find(
1177         {
1178             branchcode   => $branchcode,
1179             categorycode => $categorycode
1180         }
1181         )
1182         || Koha::OverdueRules->find(
1183         {
1184             branchcode   => q{},
1185             categorycode => $categorycode
1186         }
1187         );
1188
1189     if ($rule) {
1190         return $rule->delay1 if $rule->debarred1;
1191         return $rule->delay2 if $rule->debarred2;
1192         return $rule->delay3 if $rule->debarred3;
1193     }
1194 }
1195
1196 =head3 update_lastseen
1197
1198   $patron->update_lastseen('activity');
1199
1200 Updates the lastseen field, limited to one update per day, whenever the activity passed is
1201 listed in TrackLastPatronActivityTriggers.
1202
1203 The method should be called upon successful completion of the activity.
1204
1205 =cut
1206
1207 sub update_lastseen {
1208     my ( $self, $activity ) = @_;
1209     my $tracked_activities = {
1210         map { ( lc $_, 1 ); } split /\s*\,\s*/,
1211         C4::Context->preference('TrackLastPatronActivityTriggers')
1212     };
1213     return $self unless $tracked_activities->{$activity};
1214
1215     my $cache     = Koha::Caches->get_instance();
1216     my $cache_key = "track_activity_" . $self->borrowernumber;
1217     my $cached    = $cache->get_from_cache($cache_key);
1218     my $now       = dt_from_string();
1219     return $self if $cached && $cached eq $now->ymd;
1220
1221     $self->lastseen($now)->store;
1222     $cache->set_in_cache( $cache_key, $now->ymd );
1223     return $self;
1224 }
1225
1226 =head3 move_to_deleted
1227
1228 my $is_moved = $patron->move_to_deleted;
1229
1230 Move a patron to the deletedborrowers table.
1231 This can be done before deleting a patron, to make sure the data are not completely deleted.
1232
1233 =cut
1234
1235 sub move_to_deleted {
1236     my ($self) = @_;
1237     my $patron_infos = $self->unblessed;
1238     delete $patron_infos->{updated_on}; #This ensures the updated_on date in deletedborrowers will be set to the current timestamp
1239     return Koha::Database->new->schema->resultset('Deletedborrower')->create($patron_infos);
1240 }
1241
1242 =head3 can_request_article
1243
1244     if ( $patron->can_request_article( $library->id ) ) { ... }
1245
1246 Returns true if the patron can request articles. As limits apply for the patron
1247 on the same day, those completed the same day are considered as current.
1248
1249 A I<library_id> can be passed as parameter, falling back to userenv if absent.
1250
1251 =cut
1252
1253 sub can_request_article {
1254     my ($self, $library_id) = @_;
1255
1256     $library_id //= C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef;
1257
1258     my $rule = Koha::CirculationRules->get_effective_rule(
1259         {
1260             branchcode   => $library_id,
1261             categorycode => $self->categorycode,
1262             rule_name    => 'open_article_requests_limit'
1263         }
1264     );
1265
1266     my $limit = ($rule) ? $rule->rule_value : undef;
1267
1268     return 1 unless defined $limit;
1269
1270     my $count = Koha::ArticleRequests->search(
1271         [   { borrowernumber => $self->borrowernumber, status => [ 'REQUESTED', 'PENDING', 'PROCESSING' ] },
1272             { borrowernumber => $self->borrowernumber, status => 'COMPLETED', updated_on => { '>=' => \'CAST(NOW() AS DATE)' } },
1273         ]
1274     )->count;
1275     return $count < $limit ? 1 : 0;
1276 }
1277
1278 =head3 article_request_fee
1279
1280     my $fee = $patron->article_request_fee(
1281         {
1282           [ library_id => $library->id, ]
1283         }
1284     );
1285
1286 Returns the fee to be charged to the patron when it places an article request.
1287
1288 A I<library_id> can be passed as parameter, falling back to userenv if absent.
1289
1290 =cut
1291
1292 sub article_request_fee {
1293     my ($self, $params) = @_;
1294
1295     my $library_id = $params->{library_id};
1296
1297     $library_id //= C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef;
1298
1299     my $rule = Koha::CirculationRules->get_effective_rule(
1300         {
1301             branchcode   => $library_id,
1302             categorycode => $self->categorycode,
1303             rule_name    => 'article_request_fee'
1304         }
1305     );
1306
1307     my $fee = ($rule) ? $rule->rule_value + 0 : 0;
1308
1309     return $fee;
1310 }
1311
1312 =head3 add_article_request_fee_if_needed
1313
1314     my $fee = $patron->add_article_request_fee_if_needed(
1315         {
1316           [ item_id    => $item->id,
1317             library_id => $library->id, ]
1318         }
1319     );
1320
1321 If an article request fee needs to be charged, it adds a debit to the patron's
1322 account.
1323
1324 Returns the fee line.
1325
1326 A I<library_id> can be passed as parameter, falling back to userenv if absent.
1327
1328 =cut
1329
1330 sub add_article_request_fee_if_needed {
1331     my ($self, $params) = @_;
1332
1333     my $library_id = $params->{library_id};
1334     my $item_id    = $params->{item_id};
1335
1336     $library_id //= C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef;
1337
1338     my $amount = $self->article_request_fee(
1339         {
1340             library_id => $library_id,
1341         }
1342     );
1343
1344     my $debit_line;
1345
1346     if ( $amount > 0 ) {
1347         $debit_line = $self->account->add_debit(
1348             {
1349                 amount     => $amount,
1350                 user_id    => C4::Context->userenv ? C4::Context->userenv->{'number'} : undef,
1351                 interface  => C4::Context->interface,
1352                 library_id => $library_id,
1353                 type       => 'ARTICLE_REQUEST',
1354                 item_id    => $item_id,
1355             }
1356         );
1357     }
1358
1359     return $debit_line;
1360 }
1361
1362 =head3 article_requests
1363
1364     my $article_requests = $patron->article_requests;
1365
1366 Returns the patron article requests.
1367
1368 =cut
1369
1370 sub article_requests {
1371     my ($self) = @_;
1372
1373     return Koha::ArticleRequests->_new_from_dbic( scalar $self->_result->article_requests );
1374 }
1375
1376 =head3 add_enrolment_fee_if_needed
1377
1378 my $enrolment_fee = $patron->add_enrolment_fee_if_needed($renewal);
1379
1380 Add enrolment fee for a patron if needed.
1381
1382 $renewal - boolean denoting whether this is an account renewal or not
1383
1384 =cut
1385
1386 sub add_enrolment_fee_if_needed {
1387     my ($self, $renewal) = @_;
1388     my $enrolment_fee = $self->category->enrolmentfee;
1389     if ( $enrolment_fee && $enrolment_fee > 0 ) {
1390         my $type = $renewal ? 'ACCOUNT_RENEW' : 'ACCOUNT';
1391         $self->account->add_debit(
1392             {
1393                 amount     => $enrolment_fee,
1394                 user_id    => C4::Context->userenv ? C4::Context->userenv->{'number'} : undef,
1395                 interface  => C4::Context->interface,
1396                 library_id => C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef,
1397                 type       => $type
1398             }
1399         );
1400     }
1401     return $enrolment_fee || 0;
1402 }
1403
1404 =head3 checkouts
1405
1406 my $checkouts = $patron->checkouts
1407
1408 =cut
1409
1410 sub checkouts {
1411     my ($self) = @_;
1412     my $checkouts = $self->_result->issues;
1413     return Koha::Checkouts->_new_from_dbic( $checkouts );
1414 }
1415
1416 =head3 pending_checkouts
1417
1418 my $pending_checkouts = $patron->pending_checkouts
1419
1420 This method will return the same as $self->checkouts, but with a prefetch on
1421 items, biblio and biblioitems.
1422
1423 It has been introduced to replaced the C4::Members::GetPendingIssues subroutine
1424
1425 It should not be used directly, prefer to access fields you need instead of
1426 retrieving all these fields in one go.
1427
1428 =cut
1429
1430 sub pending_checkouts {
1431     my( $self ) = @_;
1432     my $checkouts = $self->_result->issues->search(
1433         {},
1434         {
1435             order_by => [
1436                 { -desc => 'me.timestamp' },
1437                 { -desc => 'issuedate' },
1438                 { -desc => 'issue_id' }, # Sort by issue_id should be enough
1439             ],
1440             prefetch => { item => { biblio => 'biblioitems' } },
1441         }
1442     );
1443     return Koha::Checkouts->_new_from_dbic( $checkouts );
1444 }
1445
1446 =head3 old_checkouts
1447
1448 my $old_checkouts = $patron->old_checkouts
1449
1450 =cut
1451
1452 sub old_checkouts {
1453     my ($self) = @_;
1454     my $old_checkouts = $self->_result->old_issues;
1455     return Koha::Old::Checkouts->_new_from_dbic( $old_checkouts );
1456 }
1457
1458 =head3 overdues
1459
1460 my $overdue_items = $patron->overdues
1461
1462 Return the overdue items
1463
1464 =cut
1465
1466 sub overdues {
1467     my ($self) = @_;
1468     my $dtf = Koha::Database->new->schema->storage->datetime_parser;
1469     return $self->checkouts->search(
1470         {
1471             'me.date_due' => { '<' => $dtf->format_datetime(dt_from_string) },
1472         },
1473         {
1474             prefetch => { item => { biblio => 'biblioitems' } },
1475         }
1476     );
1477 }
1478
1479
1480 =head3 restrictions
1481
1482   my $restrictions = $patron->restrictions;
1483
1484 Returns the patron restrictions.
1485
1486 =cut
1487
1488 sub restrictions {
1489     my ($self) = @_;
1490     my $restrictions_rs = $self->_result->restrictions;
1491     return Koha::Patron::Restrictions->_new_from_dbic($restrictions_rs);
1492 }
1493
1494 =head3 get_routing_lists
1495
1496 my $routinglists = $patron->get_routing_lists
1497
1498 Returns the routing lists a patron is subscribed to.
1499
1500 =cut
1501
1502 sub get_routing_lists {
1503     my ($self) = @_;
1504     my $routing_list_rs = $self->_result->subscriptionroutinglists;
1505     return Koha::Subscription::Routinglists->_new_from_dbic($routing_list_rs);
1506 }
1507
1508 =head3 get_age
1509
1510     my $age = $patron->get_age
1511
1512 Return the age of the patron
1513
1514 =cut
1515
1516 sub get_age {
1517     my ($self)    = @_;
1518
1519     return unless $self->dateofbirth;
1520
1521     #Set timezone to floating to avoid any datetime math issues caused by DST
1522     my $date_of_birth = dt_from_string( $self->dateofbirth, undef, 'floating' );
1523     my $today         = dt_from_string(undef, undef, 'floating')->truncate( to => 'day' );
1524
1525     return $today->subtract_datetime( $date_of_birth )->years;
1526 }
1527
1528 =head3 is_valid_age
1529
1530 my $is_valid = $patron->is_valid_age
1531
1532 Return 1 if patron's age is between allowed limits, returns 0 if it's not.
1533
1534 =cut
1535
1536 sub is_valid_age {
1537     my ($self) = @_;
1538     my $age = $self->get_age;
1539
1540     my $patroncategory = $self->category;
1541     my ($low,$high) = ($patroncategory->dateofbirthrequired, $patroncategory->upperagelimit);
1542
1543     return (defined($age) && (($high && ($age > $high)) or ($low && ($age < $low)))) ? 0 : 1;
1544 }
1545
1546 =head3 account
1547
1548 my $account = $patron->account
1549
1550 =cut
1551
1552 sub account {
1553     my ($self) = @_;
1554     return Koha::Account->new( { patron_id => $self->borrowernumber } );
1555 }
1556
1557 =head3 holds
1558
1559 my $holds = $patron->holds
1560
1561 Return all the holds placed by this patron
1562
1563 =cut
1564
1565 sub holds {
1566     my ($self) = @_;
1567     my $holds_rs = $self->_result->reserves->search( {}, { order_by => 'reservedate' } );
1568     return Koha::Holds->_new_from_dbic($holds_rs);
1569 }
1570
1571 =head3 old_holds
1572
1573 my $old_holds = $patron->old_holds
1574
1575 Return all the historical holds for this patron
1576
1577 =cut
1578
1579 sub old_holds {
1580     my ($self) = @_;
1581     my $old_holds_rs = $self->_result->old_reserves->search( {}, { order_by => 'reservedate' } );
1582     return Koha::Old::Holds->_new_from_dbic($old_holds_rs);
1583 }
1584
1585 =head3 curbside_pickups
1586
1587 my $curbside_pickups = $patron->curbside_pickups;
1588
1589 Return all the curbside pickups for this patron
1590
1591 =cut
1592
1593 sub curbside_pickups {
1594     my ($self) = @_;
1595     my $curbside_pickups_rs = $self->_result->curbside_pickups_borrowernumbers->search;
1596     return Koha::CurbsidePickups->_new_from_dbic($curbside_pickups_rs);
1597 }
1598
1599 =head3 return_claims
1600
1601 my $return_claims = $patron->return_claims
1602
1603 =cut
1604
1605 sub return_claims {
1606     my ($self) = @_;
1607     my $return_claims = $self->_result->return_claims_borrowernumbers;
1608     return Koha::Checkouts::ReturnClaims->_new_from_dbic( $return_claims );
1609 }
1610
1611 =head3 notice_email_address
1612
1613   my $email = $patron->notice_email_address;
1614
1615 Return the email address of patron used for notices.
1616 Returns the empty string if no email address.
1617
1618 =cut
1619
1620 sub notice_email_address{
1621     my ( $self ) = @_;
1622
1623     my $which_address = C4::Context->preference("EmailFieldPrimary");
1624     # if syspref is set to 'first valid' (value == OFF), look up email address
1625     if ( $which_address eq 'OFF' ) {
1626         return $self->first_valid_email_address;
1627     }
1628
1629     return $self->$which_address || '';
1630 }
1631
1632 =head3 first_valid_email_address
1633
1634 my $first_valid_email_address = $patron->first_valid_email_address
1635
1636 Return the first valid email address for a patron.
1637 For now, the order  is defined as email, emailpro, B_email.
1638 Returns the empty string if the borrower has no email addresses.
1639
1640 =cut
1641
1642 sub first_valid_email_address {
1643     my ($self) = @_;
1644
1645     my $email = q{};
1646
1647     my @fields = split /\s*\|\s*/,
1648       C4::Context->preference('EmailFieldPrecedence');
1649     for my $field (@fields) {
1650         $email = $self->$field;
1651         last if ($email);
1652     }
1653
1654     return $email;
1655 }
1656
1657 =head3 get_club_enrollments
1658
1659 =cut
1660
1661 sub get_club_enrollments {
1662     my ( $self ) = @_;
1663
1664     return Koha::Club::Enrollments->search( { borrowernumber => $self->borrowernumber(), date_canceled => undef } );
1665 }
1666
1667 =head3 get_enrollable_clubs
1668
1669 =cut
1670
1671 sub get_enrollable_clubs {
1672     my ( $self, $is_enrollable_from_opac ) = @_;
1673
1674     my $params;
1675     $params->{is_enrollable_from_opac} = $is_enrollable_from_opac
1676       if $is_enrollable_from_opac;
1677     $params->{is_email_required} = 0 unless $self->first_valid_email_address();
1678
1679     $params->{borrower} = $self;
1680
1681     return Koha::Clubs->get_enrollable($params);
1682 }
1683
1684
1685 =head3 get_lists_with_patron
1686
1687     my @lists = $patron->get_lists_with_patron;
1688
1689 FIXME: This method returns a DBIC resultset instead of a Koha::Objects-based
1690 iterator.
1691
1692 =cut
1693
1694 sub get_lists_with_patron {
1695     my ( $self ) = @_;
1696     my $borrowernumber = $self->borrowernumber;
1697
1698     return Koha::Database->new()->schema()->resultset('PatronList')->search(
1699         {
1700             'patron_list_patrons.borrowernumber' => $borrowernumber,
1701         },
1702         {
1703             join => 'patron_list_patrons',
1704             collapse => 1,
1705             order_by => 'name',
1706         }
1707     );
1708 }
1709
1710 =head3 account_locked
1711
1712 my $is_locked = $patron->account_locked
1713
1714 Return true if the patron has reached the maximum number of login attempts
1715 (see pref FailedLoginAttempts). If login_attempts is < 0, this is interpreted
1716 as an administrative lockout (independent of FailedLoginAttempts; see also
1717 Koha::Patron->lock).
1718 Otherwise return false.
1719 If the pref is not set (empty string, null or 0), the feature is considered as
1720 disabled.
1721
1722 =cut
1723
1724 sub account_locked {
1725     my ($self) = @_;
1726     my $FailedLoginAttempts = C4::Context->preference('FailedLoginAttempts');
1727     return 1 if $FailedLoginAttempts
1728           and $self->login_attempts
1729           and $self->login_attempts >= $FailedLoginAttempts;
1730     return 1 if ($self->login_attempts || 0) < 0; # administrative lockout
1731     return 0;
1732 }
1733
1734 =head3 can_see_patron_infos
1735
1736 my $can_see = $patron->can_see_patron_infos( $patron );
1737
1738 Return true if the patron (usually the logged in user) can see the patron's infos for a given patron
1739
1740 =cut
1741
1742 sub can_see_patron_infos {
1743     my ( $self, $patron ) = @_;
1744     return unless $patron;
1745     return $self->can_see_patrons_from( $patron->branchcode );
1746 }
1747
1748 =head3 can_see_patrons_from
1749
1750 my $can_see = $patron->can_see_patrons_from( $branchcode );
1751
1752 Return true if the patron (usually the logged in user) can see the patron's infos from a given library
1753
1754 =cut
1755
1756 sub can_see_patrons_from {
1757     my ( $self, $branchcode ) = @_;
1758
1759     return $self->can_see_things_from(
1760         {
1761             branchcode => $branchcode,
1762             permission => 'borrowers',
1763             subpermission => 'view_borrower_infos_from_any_libraries',
1764         }
1765     );
1766 }
1767
1768 =head3 can_edit_items_from
1769
1770     my $can_edit = $patron->can_edit_items_from( $branchcode );
1771
1772 Return true if the I<Koha::Patron> can edit items from the given branchcode
1773
1774 =cut
1775
1776 sub can_edit_items_from {
1777     my ( $self, $branchcode ) = @_;
1778
1779     return 1 if C4::Context->IsSuperLibrarian();
1780
1781     my $userenv = C4::Context->userenv();
1782     if ( $userenv && C4::Context->preference('IndependentBranches') ) {
1783         return $userenv->{branch} eq $branchcode;
1784     }
1785
1786     return $self->can_see_things_from(
1787         {
1788             branchcode    => $branchcode,
1789             permission    => 'editcatalogue',
1790             subpermission => 'edit_any_item',
1791         }
1792     );
1793 }
1794
1795 =head3 libraries_where_can_edit_items
1796
1797     my $libraries = $patron->libraries_where_can_edit_items;
1798
1799 Return the list of branchcodes(!) of libraries the patron is allowed to items for.
1800 The branchcodes are arbitrarily returned sorted.
1801 We are supposing here that the object is related to the logged in patron (use of C4::Context::only_my_library)
1802
1803 An empty array means no restriction, the user can edit any item.
1804
1805 =cut
1806
1807 sub libraries_where_can_edit_items {
1808     my ($self) = @_;
1809
1810     return $self->libraries_where_can_see_things(
1811         {
1812             permission    => 'editcatalogue',
1813             subpermission => 'edit_any_item',
1814             group_feature => 'ft_limit_item_editing',
1815         }
1816     );
1817 }
1818
1819 =head3 libraries_where_can_see_patrons
1820
1821 my $libraries = $patron->libraries_where_can_see_patrons;
1822
1823 Return the list of branchcodes(!) of libraries the patron is allowed to see other patron's infos.
1824 The branchcodes are arbitrarily returned sorted.
1825 We are supposing here that the object is related to the logged in patron (use of C4::Context::only_my_library)
1826
1827 An empty array means no restriction, the patron can see patron's infos from any libraries.
1828
1829 =cut
1830
1831 sub libraries_where_can_see_patrons {
1832     my ($self) = @_;
1833
1834     return $self->libraries_where_can_see_things(
1835         {
1836             permission    => 'borrowers',
1837             subpermission => 'view_borrower_infos_from_any_libraries',
1838             group_feature => 'ft_hide_patron_info',
1839         }
1840     );
1841 }
1842
1843 =head3 can_see_things_from
1844
1845 my $can_see = $patron->can_see_things_from( $branchcode );
1846
1847 Return true if the I<Koha::Patron> can perform some action on the given thing
1848
1849 =cut
1850
1851 sub can_see_things_from {
1852     my ( $self, $params ) = @_;
1853
1854     my $branchcode    = $params->{branchcode};
1855     my $permission    = $params->{permission};
1856     my $subpermission = $params->{subpermission};
1857
1858     return 1 if C4::Context->IsSuperLibrarian();
1859
1860     my $can = 0;
1861     if ( $self->branchcode eq $branchcode ) {
1862         $can = 1;
1863     } elsif ( $self->has_permission( { $permission => $subpermission } ) ) {
1864         $can = 1;
1865     } elsif ( my @branches = $self->libraries_where_can_see_patrons ) {
1866         $can = ( any { $_ eq $branchcode } @branches ) ? 1 : 0;
1867     }
1868     return $can;
1869 }
1870
1871 =head3 can_log_into
1872
1873 my $can_log_into = $patron->can_log_into( $library );
1874
1875 Given a I<Koha::Library> object, it returns a boolean representing
1876 the fact the patron can log into a the library.
1877
1878 =cut
1879
1880 sub can_log_into {
1881     my ( $self, $library ) = @_;
1882
1883     my $can = 0;
1884
1885     if ( C4::Context->preference('IndependentBranches') ) {
1886         $can = 1
1887           if $self->is_superlibrarian
1888           or $self->branchcode eq $library->id;
1889     }
1890     else {
1891         # no restrictions
1892         $can = 1;
1893     }
1894
1895    return $can;
1896 }
1897
1898 =head3 libraries_where_can_see_things
1899
1900     my $libraries = $patron->libraries_where_can_see_things;
1901
1902 Returns a list of libraries where an aribitarary action is allowed to be taken by the logged in librarian
1903 against an object based on some branchcode related to the object ( patron branchcode, item homebranch, etc ).
1904
1905 We are supposing here that the object is related to the logged in librarian (use of C4::Context::only_my_library)
1906
1907 An empty array means no restriction, the thing can see thing's infos from any libraries.
1908
1909 =cut
1910
1911 sub libraries_where_can_see_things {
1912     my ( $self, $params ) = @_;
1913     my $permission    = $params->{permission};
1914     my $subpermission = $params->{subpermission};
1915     my $group_feature = $params->{group_feature};
1916
1917     return $self->{"_restricted_branchcodes:$permission:$subpermission:$group_feature"}
1918         if exists( $self->{"_restricted_branchcodes:$permission:$subpermission:$group_feature"} );
1919
1920     my $userenv = C4::Context->userenv;
1921
1922     return () unless $userenv; # For tests, but userenv should be defined in tests...
1923
1924     my @restricted_branchcodes;
1925     if (C4::Context::only_my_library) {
1926         push @restricted_branchcodes, $self->branchcode;
1927     }
1928     else {
1929         unless (
1930             $self->has_permission(
1931                 { $permission => $subpermission }
1932             )
1933           )
1934         {
1935             my $library_groups = $self->library->library_groups({ $group_feature => 1 });
1936             if ( $library_groups->count )
1937             {
1938                 while ( my $library_group = $library_groups->next ) {
1939                     my $parent = $library_group->parent;
1940                     if ( $parent->has_child( $self->branchcode ) ) {
1941                         push @restricted_branchcodes, $parent->children->get_column('branchcode');
1942                     }
1943                 }
1944             }
1945
1946             @restricted_branchcodes = ( $self->branchcode ) unless @restricted_branchcodes;
1947         }
1948     }
1949
1950     @restricted_branchcodes = grep { defined $_ } @restricted_branchcodes;
1951     @restricted_branchcodes = uniq(@restricted_branchcodes);
1952     @restricted_branchcodes = sort(@restricted_branchcodes);
1953
1954     $self->{"_restricted_branchcodes:$permission:$subpermission:$group_feature"} = \@restricted_branchcodes;
1955     return @{ $self->{"_restricted_branchcodes:$permission:$subpermission:$group_feature"} };
1956 }
1957
1958 =head3 has_permission
1959
1960 my $permission = $patron->has_permission($required);
1961
1962 See C4::Auth::haspermission for details of syntax for $required
1963
1964 =cut
1965
1966 sub has_permission {
1967     my ( $self, $flagsrequired ) = @_;
1968     return unless $self->userid;
1969     # TODO code from haspermission needs to be moved here!
1970     return C4::Auth::haspermission( $self->userid, $flagsrequired );
1971 }
1972
1973 =head3 is_superlibrarian
1974
1975   my $is_superlibrarian = $patron->is_superlibrarian;
1976
1977 Return true if the patron is a superlibrarian.
1978
1979 =cut
1980
1981 sub is_superlibrarian {
1982     my ($self) = @_;
1983     return $self->has_permission( { superlibrarian => 1 } ) ? 1 : 0;
1984 }
1985
1986 =head3 is_adult
1987
1988 my $is_adult = $patron->is_adult
1989
1990 Return true if the patron has a category with a type Adult (A) or Organization (I)
1991
1992 =cut
1993
1994 sub is_adult {
1995     my ( $self ) = @_;
1996     return $self->category->category_type =~ /^(A|I)$/ ? 1 : 0;
1997 }
1998
1999 =head3 is_child
2000
2001 my $is_child = $patron->is_child
2002
2003 Return true if the patron has a category with a type Child (C)
2004
2005 =cut
2006
2007 sub is_child {
2008     my( $self ) = @_;
2009     return $self->category->category_type eq 'C' ? 1 : 0;
2010 }
2011
2012 =head3 has_valid_userid
2013
2014 my $patron = Koha::Patrons->find(42);
2015 $patron->userid( $new_userid );
2016 my $has_a_valid_userid = $patron->has_valid_userid
2017
2018 my $patron = Koha::Patron->new( $params );
2019 my $has_a_valid_userid = $patron->has_valid_userid
2020
2021 Return true if the current userid of this patron is valid/unique, otherwise false.
2022
2023 Note that this should be done in $self->store instead and raise an exception if needed.
2024
2025 =cut
2026
2027 sub has_valid_userid {
2028     my ($self) = @_;
2029
2030     return 0 unless $self->userid;
2031
2032     return 0 if ( $self->userid eq C4::Context->config('user') );    # DB user
2033
2034     my $already_exists = Koha::Patrons->search(
2035         {
2036             userid => $self->userid,
2037             (
2038                 $self->in_storage
2039                 ? ( borrowernumber => { '!=' => $self->borrowernumber } )
2040                 : ()
2041             ),
2042         }
2043     )->count;
2044     return $already_exists ? 0 : 1;
2045 }
2046
2047 =head3 generate_userid
2048
2049     $patron->generate_userid;
2050
2051     If you do not have a plugin for generating a userid, we will call
2052     the internal method here that returns firstname.surname[.number],
2053     where number is an optional suffix to make the userid unique.
2054     (Its behavior has not been changed on bug 32426.)
2055
2056     If you have plugin(s), the first valid response will be used.
2057     A plugin is assumed to return a valid userid as suggestion, but not
2058     assumed to save it already.
2059     Does not fallback to internal (you could arrange for that in your plugin).
2060     Clears userid when there are no valid plugin responses.
2061
2062 =cut
2063
2064 sub generate_userid {
2065     my ( $self ) = @_;
2066     my @responses = Koha::Plugins->call(
2067         'patron_generate_userid', { patron => $self },
2068     );
2069     unless( @responses ) {
2070         # Empty list only possible when there are NO enabled plugins for this method.
2071         # In that case we provide internal response.
2072         return $self->_generate_userid_internal;
2073     }
2074     # If a plugin returned false value or invalid value, we do however not return
2075     # internal response. The plugins should deal with that themselves. So we prevent
2076     # unexpected/unwelcome internal codes for plugin failures.
2077     foreach my $response ( grep { $_ } @responses ) {
2078         $self->userid( $response );
2079         return $self if $self->has_valid_userid;
2080     }
2081     $self->userid(undef);
2082     return $self;
2083 }
2084
2085 sub _generate_userid_internal { # as we always did
2086     my ($self) = @_;
2087     my $offset = 0;
2088     my $firstname = $self->firstname // q{};
2089     my $surname = $self->surname // q{};
2090     #The script will "do" the following code and increment the $offset until the generated userid is unique
2091     do {
2092       $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
2093       $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
2094       my $userid = lc(($firstname)? "$firstname.$surname" : $surname);
2095       $userid = NFKD( $userid );
2096       $userid =~ s/\p{NonspacingMark}//g;
2097       $userid .= $offset unless $offset == 0;
2098       $self->userid( $userid );
2099       $offset++;
2100      } while (! $self->has_valid_userid );
2101
2102      return $self;
2103 }
2104
2105 =head3 add_extended_attribute
2106
2107 =cut
2108
2109 sub add_extended_attribute {
2110     my ($self, $attribute) = @_;
2111
2112     return Koha::Patron::Attribute->new(
2113         {
2114             %$attribute,
2115             ( borrowernumber => $self->borrowernumber ),
2116         }
2117     )->store;
2118
2119 }
2120
2121 =head3 extended_attributes
2122
2123 Return object of Koha::Patron::Attributes type with all attributes set for this patron
2124
2125 Or setter FIXME
2126
2127 =cut
2128
2129 sub extended_attributes {
2130     my ( $self, $attributes ) = @_;
2131     if ($attributes) {    # setter
2132         my $schema = $self->_result->result_source->schema;
2133         $schema->txn_do(
2134             sub {
2135                 # Remove the existing one
2136                 $self->extended_attributes->filter_by_branch_limitations->delete;
2137
2138                 # Insert the new ones
2139                 my $new_types = {};
2140                 for my $attribute (@$attributes) {
2141                     $self->add_extended_attribute($attribute);
2142                     $new_types->{$attribute->{code}} = 1;
2143                 }
2144
2145                 # Check globally mandatory types
2146                 my @required_attribute_types =
2147                     Koha::Patron::Attribute::Types->search(
2148                         {
2149                             mandatory => 1,
2150                             category_code => [ undef, $self->categorycode ],
2151                             'borrower_attribute_types_branches.b_branchcode' =>
2152                               undef,
2153                         },
2154                         { join => 'borrower_attribute_types_branches' }
2155                     )->get_column('code');
2156                 for my $type ( @required_attribute_types ) {
2157                     Koha::Exceptions::Patron::MissingMandatoryExtendedAttribute->throw(
2158                         type => $type,
2159                     ) if !$new_types->{$type};
2160                 }
2161             }
2162         );
2163     }
2164
2165     my $rs = $self->_result->borrower_attributes;
2166     # We call search to use the filters in Koha::Patron::Attributes->search
2167     return Koha::Patron::Attributes->_new_from_dbic($rs)->search;
2168 }
2169
2170 =head3 messages
2171
2172     my $messages = $patron->messages;
2173
2174 Return the message attached to the patron.
2175
2176 =cut
2177
2178 sub messages {
2179     my ( $self ) = @_;
2180     my $messages_rs = $self->_result->messages_borrowernumbers->search;
2181     return Koha::Patron::Messages->_new_from_dbic($messages_rs);
2182 }
2183
2184 =head3 lock
2185
2186     Koha::Patrons->find($id)->lock({ expire => 1, remove => 1 });
2187
2188     Lock and optionally expire a patron account.
2189     Remove holds and article requests if remove flag set.
2190     In order to distinguish from locking by entering a wrong password, let's
2191     call this an administrative lockout.
2192
2193 =cut
2194
2195 sub lock {
2196     my ( $self, $params ) = @_;
2197     $self->login_attempts( ADMINISTRATIVE_LOCKOUT );
2198     if( $params->{expire} ) {
2199         $self->dateexpiry( dt_from_string->subtract(days => 1) );
2200     }
2201     $self->store;
2202     if( $params->{remove} ) {
2203         $self->holds->delete;
2204         $self->article_requests->delete;
2205     }
2206     return $self;
2207 }
2208
2209 =head3 anonymize
2210
2211     Koha::Patrons->find($id)->anonymize;
2212
2213     Anonymize or clear borrower fields. Fields in BorrowerMandatoryField
2214     are randomized, other personal data is cleared too.
2215     Patrons with issues are skipped.
2216
2217 =cut
2218
2219 sub anonymize {
2220     my ( $self ) = @_;
2221     if( $self->_result->issues->count ) {
2222         warn "Exiting anonymize: patron ".$self->borrowernumber." still has issues";
2223         return;
2224     }
2225     # Mandatory fields come from the corresponding pref, but email fields
2226     # are removed since scrambled email addresses only generate errors
2227     my $mandatory = { map { (lc $_, 1); } grep { !/email/ }
2228         split /\s*\|\s*/, C4::Context->preference('BorrowerMandatoryField') };
2229     $mandatory->{userid} = 1; # needed since sub store does not clear field
2230     my @columns = $self->_result->result_source->columns;
2231     @columns = grep { !/borrowernumber|branchcode|categorycode|^date|password|flags|updated_on|lastseen|lang|login_attempts|anonymized|auth_method/ } @columns;
2232     push @columns, 'dateofbirth'; # add this date back in
2233     foreach my $col (@columns) {
2234         $self->_anonymize_column($col, $mandatory->{lc $col} );
2235     }
2236     $self->anonymized(1)->store;
2237 }
2238
2239 sub _anonymize_column {
2240     my ( $self, $col, $mandatory ) = @_;
2241     my $col_info = $self->_result->result_source->column_info($col);
2242     my $type = $col_info->{data_type};
2243     my $nullable = $col_info->{is_nullable};
2244     my $val;
2245     if( $type =~ /char|text/ ) {
2246         $val = $mandatory
2247             ? Koha::Token->new->generate({ pattern => '\w{10}' })
2248             : $nullable
2249             ? undef
2250             : q{};
2251     } elsif( $type =~ /integer|int$|float|dec|double/ ) {
2252         $val = $nullable ? undef : 0;
2253     } elsif( $type =~ /date|time/ ) {
2254         $val = $nullable ? undef : dt_from_string;
2255     }
2256     $self->$col($val);
2257 }
2258
2259 =head3 add_guarantor
2260
2261     my $relationship = $patron->add_guarantor(
2262         {
2263             borrowernumber => $borrowernumber,
2264             relationships  => $relationship,
2265         }
2266     );
2267
2268     Adds a new guarantor to a patron.
2269
2270 =cut
2271
2272 sub add_guarantor {
2273     my ( $self, $params ) = @_;
2274
2275     my $guarantor_id = $params->{guarantor_id};
2276     my $relationship = $params->{relationship};
2277
2278     return Koha::Patron::Relationship->new(
2279         {
2280             guarantee_id => $self->id,
2281             guarantor_id => $guarantor_id,
2282             relationship => $relationship
2283         }
2284     )->store();
2285 }
2286
2287 =head3 get_extended_attribute
2288
2289 my $attribute_value = $patron->get_extended_attribute( $code );
2290
2291 Return the attribute for the code passed in parameter.
2292
2293 It not exist it returns undef
2294
2295 Note that this will not work for repeatable attribute types.
2296
2297 Maybe you certainly not want to use this method, it is actually only used for SHOW_BARCODE
2298 (which should be a real patron's attribute (not extended)
2299
2300 =cut
2301
2302 sub get_extended_attribute {
2303     my ( $self, $code, $value ) = @_;
2304     my $rs = $self->_result->borrower_attributes;
2305     return unless $rs;
2306     my $attribute = $rs->search({ code => $code, ( $value ? ( attribute => $value ) : () ) });
2307     return unless $attribute->count;
2308     return $attribute->next;
2309 }
2310
2311 =head3 set_default_messaging_preferences
2312
2313     $patron->set_default_messaging_preferences
2314
2315 Sets default messaging preferences on patron.
2316
2317 See Koha::Patron::MessagePreference(s) for more documentation, especially on
2318 thrown exceptions.
2319
2320 =cut
2321
2322 sub set_default_messaging_preferences {
2323     my ($self, $categorycode) = @_;
2324
2325     my $options = Koha::Patron::MessagePreferences->get_options;
2326
2327     foreach my $option (@$options) {
2328         # Check that this option has preference configuration for this category
2329         unless (Koha::Patron::MessagePreferences->search({
2330             message_attribute_id => $option->{message_attribute_id},
2331             categorycode         => $categorycode || $self->categorycode,
2332         })->count) {
2333             next;
2334         }
2335
2336         # Delete current setting
2337         Koha::Patron::MessagePreferences->search({
2338              borrowernumber => $self->borrowernumber,
2339              message_attribute_id => $option->{message_attribute_id},
2340         })->delete;
2341
2342         Koha::Patron::MessagePreference->new_from_default({
2343             borrowernumber => $self->borrowernumber,
2344             categorycode   => $categorycode || $self->categorycode,
2345             message_attribute_id => $option->{message_attribute_id},
2346         });
2347     }
2348
2349     return $self;
2350 }
2351
2352 =head3 is_accessible
2353
2354     if ( $patron->is_accessible({ user => $logged_in_user }) ) { ... }
2355
2356 This overloaded method validates whether the current I<Koha::Patron> object can be accessed
2357 by the logged in user.
2358
2359 Returns 0 if the I<user> parameter is missing.
2360
2361 =cut
2362
2363 sub is_accessible {
2364     my ( $self, $params ) = @_;
2365
2366     unless ( defined( $params->{user} ) ) {
2367         Koha::Exceptions::MissingParameter->throw( error => "The `user` parameter is mandatory" );
2368     }
2369
2370     my $consumer = $params->{user};
2371     return $consumer->can_see_patron_infos($self);
2372 }
2373
2374 =head3 unredact_list
2375
2376 This method returns the list of database fields that should be visible, even for restricted users,
2377 for both API and UI output purposes
2378
2379 =cut
2380
2381 sub unredact_list {
2382     return ['branchcode'];
2383 }
2384
2385 =head3 to_api
2386
2387     my $json = $patron->to_api;
2388
2389 Overloaded method that returns a JSON representation of the Koha::Patron object,
2390 suitable for API output.
2391
2392 =cut
2393
2394 sub to_api {
2395     my ( $self, $params ) = @_;
2396
2397     my $json_patron = $self->SUPER::to_api( $params );
2398
2399     return unless $json_patron;
2400
2401     $json_patron->{restricted} = ( $self->is_debarred )
2402                                     ? Mojo::JSON->true
2403                                     : Mojo::JSON->false;
2404
2405     return $json_patron;
2406 }
2407
2408 =head3 to_api_mapping
2409
2410 This method returns the mapping for representing a Koha::Patron object
2411 on the API.
2412
2413 =cut
2414
2415 sub to_api_mapping {
2416     return {
2417         borrowernotes       => 'staff_notes',
2418         borrowernumber      => 'patron_id',
2419         branchcode          => 'library_id',
2420         categorycode        => 'category_id',
2421         checkprevcheckout   => 'check_previous_checkout',
2422         contactfirstname    => undef,                     # Unused
2423         contactname         => undef,                     # Unused
2424         contactnote         => 'altaddress_notes',
2425         contacttitle        => undef,                     # Unused
2426         dateenrolled        => 'date_enrolled',
2427         dateexpiry          => 'expiry_date',
2428         dateofbirth         => 'date_of_birth',
2429         debarred            => undef,                     # replaced by 'restricted'
2430         debarredcomment     => undef,    # calculated, API consumers will use /restrictions instead
2431         emailpro            => 'secondary_email',
2432         flags               => undef,    # permissions manipulation handled in /permissions
2433         gonenoaddress       => 'incorrect_address',
2434         lastseen            => 'last_seen',
2435         lost                => 'patron_card_lost',
2436         opacnote            => 'opac_notes',
2437         othernames          => 'other_name',
2438         password            => undef,            # password manipulation handled in /password
2439         phonepro            => 'secondary_phone',
2440         relationship        => 'relationship_type',
2441         sex                 => 'gender',
2442         smsalertnumber      => 'sms_number',
2443         sort1               => 'statistics_1',
2444         sort2               => 'statistics_2',
2445         autorenew_checkouts => 'autorenew_checkouts',
2446         streetnumber        => 'street_number',
2447         streettype          => 'street_type',
2448         zipcode             => 'postal_code',
2449         B_address           => 'altaddress_address',
2450         B_address2          => 'altaddress_address2',
2451         B_city              => 'altaddress_city',
2452         B_country           => 'altaddress_country',
2453         B_email             => 'altaddress_email',
2454         B_phone             => 'altaddress_phone',
2455         B_state             => 'altaddress_state',
2456         B_streetnumber      => 'altaddress_street_number',
2457         B_streettype        => 'altaddress_street_type',
2458         B_zipcode           => 'altaddress_postal_code',
2459         altcontactaddress1  => 'altcontact_address',
2460         altcontactaddress2  => 'altcontact_address2',
2461         altcontactaddress3  => 'altcontact_city',
2462         altcontactcountry   => 'altcontact_country',
2463         altcontactfirstname => 'altcontact_firstname',
2464         altcontactphone     => 'altcontact_phone',
2465         altcontactsurname   => 'altcontact_surname',
2466         altcontactstate     => 'altcontact_state',
2467         altcontactzipcode   => 'altcontact_postal_code',
2468         password_expiration_date => undef,
2469         primary_contact_method => undef,
2470         secret              => undef,
2471         auth_method         => undef,
2472     };
2473 }
2474
2475 =head3 queue_notice
2476
2477     Koha::Patrons->queue_notice({ letter_params => $letter_params, message_name => 'DUE'});
2478     Koha::Patrons->queue_notice({ letter_params => $letter_params, message_transports => \@message_transports });
2479     Koha::Patrons->queue_notice({ letter_params => $letter_params, message_transports => \@message_transports, test_mode => 1 });
2480
2481     Queue messages to a patron. Can pass a message that is part of the message_attributes
2482     table or supply the transport to use.
2483
2484     If passed a message name we retrieve the patrons preferences for transports
2485     Otherwise we use the supplied transport. In the case of email or sms we fall back to print if
2486     we have no address/number for sending
2487
2488     $letter_params is a hashref of the values to be passed to GetPreparedLetter
2489
2490     test_mode will only report which notices would be sent, but nothing will be queued
2491
2492 =cut
2493
2494 sub queue_notice {
2495     my ( $self, $params ) = @_;
2496     my $letter_params = $params->{letter_params};
2497     my $test_mode = $params->{test_mode};
2498
2499     return unless $letter_params;
2500     return unless exists $params->{message_name} xor $params->{message_transports}; # We only want one of these
2501
2502     my $library = Koha::Libraries->find( $letter_params->{branchcode} );
2503     my $from_email_address = $library->from_email_address;
2504
2505     my @message_transports;
2506     my $letter_code;
2507     $letter_code = $letter_params->{letter_code};
2508     if( $params->{message_name} ){
2509         my $messaging_prefs = C4::Members::Messaging::GetMessagingPreferences( {
2510                 borrowernumber => $letter_params->{borrowernumber},
2511                 message_name => $params->{message_name}
2512         } );
2513         @message_transports = ( keys %{ $messaging_prefs->{transports} } );
2514         $letter_code = $messaging_prefs->{transports}->{$message_transports[0]} unless $letter_code;
2515     } else {
2516         @message_transports = @{$params->{message_transports}};
2517     }
2518     return unless defined $letter_code;
2519     $letter_params->{letter_code} = $letter_code;
2520     my $print_sent = 0;
2521     my %return;
2522     foreach my $mtt (@message_transports){
2523         next if ($mtt eq 'itiva' and C4::Context->preference('TalkingTechItivaPhoneNotification') );
2524         # Notice is handled by TalkingTech_itiva_outbound.pl
2525         if (   ( $mtt eq 'email' and not $self->notice_email_address )
2526             or ( $mtt eq 'sms'   and not $self->smsalertnumber )
2527             or ( $mtt eq 'phone' and not $self->phone ) )
2528         {
2529             push @{ $return{fallback} }, $mtt;
2530             $mtt = 'print';
2531         }
2532         next if $mtt eq 'print' && $print_sent;
2533         $letter_params->{message_transport_type} = $mtt;
2534         my $letter = C4::Letters::GetPreparedLetter( %$letter_params );
2535         C4::Letters::EnqueueLetter({
2536             letter => $letter,
2537             borrowernumber => $self->borrowernumber,
2538             from_address   => $from_email_address,
2539             message_transport_type => $mtt
2540         }) unless $test_mode;
2541         push @{$return{sent}}, $mtt;
2542         $print_sent = 1 if $mtt eq 'print';
2543     }
2544     return \%return;
2545 }
2546
2547 =head3 safe_to_delete
2548
2549     my $result = $patron->safe_to_delete;
2550     if ( $result eq 'has_guarantees' ) { ... }
2551     elsif ( $result ) { ... }
2552     else { # cannot delete }
2553
2554 This method tells if the Koha:Patron object can be deleted. Possible return values
2555
2556 =over 4
2557
2558 =item 'ok'
2559
2560 =item 'has_checkouts'
2561
2562 =item 'has_debt'
2563
2564 =item 'has_guarantees'
2565
2566 =item 'is_anonymous_patron'
2567
2568 =item 'is_protected'
2569
2570 =back
2571
2572 =cut
2573
2574 sub safe_to_delete {
2575     my ($self) = @_;
2576
2577     my $anonymous_patron = C4::Context->preference('AnonymousPatron');
2578
2579     my $error;
2580
2581     if ( $anonymous_patron && $self->id eq $anonymous_patron ) {
2582         $error = 'is_anonymous_patron';
2583     }
2584     elsif ( $self->checkouts->count ) {
2585         $error = 'has_checkouts';
2586     }
2587     elsif ( $self->account->outstanding_debits->total_outstanding > 0 ) {
2588         $error = 'has_debt';
2589     }
2590     elsif ( $self->guarantee_relationships->count ) {
2591         $error = 'has_guarantees';
2592     }
2593     elsif ( $self->protected ) {
2594         $error = 'is_protected';
2595     }
2596
2597     if ( $error ) {
2598         return Koha::Result::Boolean->new(0)->add_message({ message => $error });
2599     }
2600
2601     return Koha::Result::Boolean->new(1);
2602 }
2603
2604 =head3 recalls
2605
2606     my $recalls = $patron->recalls;
2607
2608 Return the patron's recalls.
2609
2610 =cut
2611
2612 sub recalls {
2613     my ( $self ) = @_;
2614
2615     return Koha::Recalls->search({ patron_id => $self->borrowernumber });
2616 }
2617
2618 =head3 account_balance
2619
2620     my $balance = $patron->account_balance
2621
2622 Return the patron's account balance
2623
2624 =cut
2625
2626 sub account_balance {
2627     my ($self) = @_;
2628     return $self->account->balance;
2629 }
2630
2631 =head3 notify_library_of_registration
2632
2633 $patron->notify_library_of_registration( $email_patron_registrations );
2634
2635 Send patron registration email to library if EmailPatronRegistrations system preference is enabled.
2636
2637 =cut
2638
2639 sub notify_library_of_registration {
2640     my ( $self, $email_patron_registrations ) = @_;
2641
2642     if (
2643         my $letter = C4::Letters::GetPreparedLetter(
2644             module      => 'members',
2645             letter_code => 'OPAC_REG',
2646             branchcode  => $self->branchcode,
2647             lang        => $self->lang || 'default',
2648             tables      => {
2649                 'borrowers' => $self->borrowernumber
2650             },
2651         )
2652     ) {
2653         my $to_address;
2654         if ( $email_patron_registrations eq "BranchEmailAddress" ) {
2655             my $library = Koha::Libraries->find( $self->branchcode );
2656             $to_address = $library->inbound_email_address;
2657         }
2658         elsif ( $email_patron_registrations eq "KohaAdminEmailAddress" ) {
2659             $to_address = C4::Context->preference('ReplytoDefault')
2660             || C4::Context->preference('KohaAdminEmailAddress');
2661         }
2662         else {
2663             $to_address =
2664                 C4::Context->preference('EmailAddressForPatronRegistrations')
2665                 || C4::Context->preference('ReplytoDefault')
2666                 || C4::Context->preference('KohaAdminEmailAddress');
2667         }
2668
2669         my $message_id = C4::Letters::EnqueueLetter(
2670             {
2671                 letter                 => $letter,
2672                 borrowernumber         => $self->borrowernumber,
2673                 to_address             => $to_address,
2674                 message_transport_type => 'email'
2675             }
2676         ) or warn "can't enqueue letter $letter";
2677         if ( $message_id ) {
2678             return 1;
2679         }
2680     }
2681 }
2682
2683 =head3 has_messaging_preference
2684
2685 my $bool = $patron->has_messaging_preference({
2686     message_name => $message_name, # A value from message_attributes.message_name
2687     message_transport_type => $message_transport_type, # email, sms, phone, itiva, etc...
2688     wants_digest => $wants_digest, # 1 if you are looking for the digest version, don't pass if you just want either
2689 });
2690
2691 =cut
2692
2693 sub has_messaging_preference {
2694     my ( $self, $params ) = @_;
2695
2696     my $message_name           = $params->{message_name};
2697     my $message_transport_type = $params->{message_transport_type};
2698     my $wants_digest           = $params->{wants_digest};
2699
2700     return $self->_result->search_related_rs(
2701         'borrower_message_preferences',
2702         $params,
2703         {
2704             prefetch =>
2705               [ 'borrower_message_transport_preferences', 'message_attribute' ]
2706         }
2707     )->count;
2708 }
2709
2710 =head3 can_patron_change_staff_only_lists
2711
2712 $patron->can_patron_change_staff_only_lists;
2713
2714 Return 1 if a patron has 'Superlibrarian' or 'Catalogue' permission.
2715 Otherwise, return 0.
2716
2717 =cut
2718
2719 sub can_patron_change_staff_only_lists {
2720     my ( $self, $params ) = @_;
2721     return 1 if C4::Auth::haspermission( $self->userid, { 'catalogue' => 1 });
2722     return 0;
2723 }
2724
2725 =head3 can_patron_change_permitted_staff_lists
2726
2727 $patron->can_patron_change_permitted_staff_lists;
2728
2729 Return 1 if a patron has 'Superlibrarian' or 'Catalogue' and 'edit_public_list_contents' permissions.
2730 Otherwise, return 0.
2731
2732 =cut
2733
2734 sub can_patron_change_permitted_staff_lists {
2735     my ( $self, $params ) = @_;
2736     return 1 if C4::Auth::haspermission( $self->userid, { 'catalogue' => 1, lists => 'edit_public_list_contents' } );
2737     return 0;
2738 }
2739
2740 =head3 encode_secret
2741
2742   $patron->encode_secret($secret32);
2743
2744 Secret (TwoFactorAuth expects it in base32 format) is encrypted.
2745 You still need to call ->store.
2746
2747 =cut
2748
2749 sub encode_secret {
2750     my ( $self, $secret ) = @_;
2751     if( $secret ) {
2752         return $self->secret( Koha::Encryption->new->encrypt_hex($secret) );
2753     }
2754     return $self->secret($secret);
2755 }
2756
2757 =head3 decoded_secret
2758
2759   my $secret32 = $patron->decoded_secret;
2760
2761 Decode the patron secret. We expect to get back a base32 string, but this
2762 is not checked here. Caller of encode_secret is responsible for that.
2763
2764 =cut
2765
2766 sub decoded_secret {
2767     my ( $self ) = @_;
2768     if( $self->secret ) {
2769         return Koha::Encryption->new->decrypt_hex( $self->secret );
2770     }
2771     return $self->secret;
2772 }
2773
2774 =head3 virtualshelves
2775
2776     my $shelves = $patron->virtualshelves;
2777
2778 =cut
2779
2780 sub virtualshelves {
2781     my $self = shift;
2782     return Koha::Virtualshelves->_new_from_dbic( scalar $self->_result->virtualshelves );
2783 }
2784
2785 =head3 get_savings
2786
2787     my $savings = $patron->get_savings;
2788
2789 Use the replacement price of patron's old and current issues to calculate how much they have 'saved' by using the library.
2790
2791 =cut
2792
2793 sub get_savings {
2794     my ($self) = @_;
2795
2796     my @itemnumbers = grep { defined $_ } ( $self->old_checkouts->get_column('itemnumber'), $self->checkouts->get_column('itemnumber') );
2797
2798     return Koha::Items->search(
2799         { itemnumber => { -in => \@itemnumbers } },
2800         {   select => [ { sum => 'me.replacementprice' } ],
2801             as     => ['total_savings']
2802         }
2803     )->next->get_column('total_savings') // 0;
2804 }
2805
2806 =head3 alert_subscriptions
2807
2808     my $subscriptions = $patron->alert_subscriptions;
2809
2810 Return a Koha::Subscriptions object containing subscriptions for which the patron has subscribed to email alerts.
2811
2812 =cut
2813
2814 sub alert_subscriptions {
2815     my ($self) = @_;
2816
2817     my @alerts           = $self->_result->alerts;
2818     my @subscription_ids = map { $_->externalid } @alerts;
2819
2820     return Koha::Subscriptions->search( { subscriptionid => \@subscription_ids } );
2821 }
2822
2823 =head3 consent
2824
2825     my $consent = $patron->consent(TYPE);
2826
2827     Returns the first consent of type TYPE (there should be only one) or a new instance
2828     of Koha::Patron::Consent.
2829
2830 =cut
2831
2832 sub consent {
2833     my ( $self, $type ) = @_;
2834     Koha::Exceptions::MissingParameter->throw('Missing consent type') if !$type;
2835     my $consents = Koha::Patron::Consents->search(
2836         {
2837             borrowernumber => $self->borrowernumber,
2838             type           => $type,
2839         }
2840     );
2841     return $consents && $consents->count
2842         ? $consents->next
2843         : Koha::Patron::Consent->new( { borrowernumber => $self->borrowernumber, type => $type } );
2844 }
2845
2846 =head2 Internal methods
2847
2848 =head3 _type
2849
2850 =cut
2851
2852 sub _type {
2853     return 'Borrower';
2854 }
2855
2856 =head1 AUTHORS
2857
2858 Kyle M Hall <kyle@bywatersolutions.com>
2859 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
2860 Martin Renvoize <martin.renvoize@ptfs-europe.com>
2861
2862 =cut
2863
2864 1;