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