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