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 bookings
1605
1606   my $bookings = $item->bookings();
1607
1608 Returns the bookings for this patron.
1609
1610 =cut
1611
1612 sub bookings {
1613     my ( $self, $params ) = @_;
1614     my $bookings_rs = $self->_result->bookings->search($params);
1615     return Koha::Bookings->_new_from_dbic( $bookings_rs );
1616 }
1617
1618 =head3 return_claims
1619
1620 my $return_claims = $patron->return_claims
1621
1622 =cut
1623
1624 sub return_claims {
1625     my ($self) = @_;
1626     my $return_claims = $self->_result->return_claims_borrowernumbers;
1627     return Koha::Checkouts::ReturnClaims->_new_from_dbic( $return_claims );
1628 }
1629
1630 =head3 notice_email_address
1631
1632   my $email = $patron->notice_email_address;
1633
1634 Return the email address of patron used for notices.
1635 Returns the empty string if no email address.
1636
1637 =cut
1638
1639 sub notice_email_address{
1640     my ( $self ) = @_;
1641
1642     my $which_address = C4::Context->preference("EmailFieldPrimary");
1643
1644     # if syspref is set to 'first valid' (value == OFF), look up email address
1645     if ( $which_address eq 'OFF' ) {
1646         return $self->first_valid_email_address;
1647     }
1648
1649     # if syspref is set to 'selected addresses' (value == MULTI), look up email addresses
1650     if ( $which_address eq 'MULTI' ) {
1651         my @addresses;
1652         my $selected_fields = C4::Context->preference("EmailFieldSelection");
1653         for my $email_field ( split ",", $selected_fields ) {
1654             my $email_address = $self->$email_field;
1655             push @addresses, $email_address if $email_address;
1656         }
1657         return join(",",@addresses);
1658     }
1659
1660     return $self->$which_address || '';
1661
1662 }
1663
1664 =head3 first_valid_email_address
1665
1666 my $first_valid_email_address = $patron->first_valid_email_address
1667
1668 Return the first valid email address for a patron.
1669 For now, the order  is defined as email, emailpro, B_email.
1670 Returns the empty string if the borrower has no email addresses.
1671
1672 =cut
1673
1674 sub first_valid_email_address {
1675     my ($self) = @_;
1676
1677     my $email = q{};
1678
1679     my @fields = split /\s*\|\s*/,
1680       C4::Context->preference('EmailFieldPrecedence');
1681     for my $field (@fields) {
1682         $email = $self->$field;
1683         last if ($email);
1684     }
1685
1686     return $email;
1687 }
1688
1689 =head3 get_club_enrollments
1690
1691 =cut
1692
1693 sub get_club_enrollments {
1694     my ( $self ) = @_;
1695
1696     return Koha::Club::Enrollments->search( { borrowernumber => $self->borrowernumber(), date_canceled => undef } );
1697 }
1698
1699 =head3 get_enrollable_clubs
1700
1701 =cut
1702
1703 sub get_enrollable_clubs {
1704     my ( $self, $is_enrollable_from_opac ) = @_;
1705
1706     my $params;
1707     $params->{is_enrollable_from_opac} = $is_enrollable_from_opac
1708       if $is_enrollable_from_opac;
1709     $params->{is_email_required} = 0 unless $self->first_valid_email_address();
1710
1711     $params->{borrower} = $self;
1712
1713     return Koha::Clubs->get_enrollable($params);
1714 }
1715
1716
1717 =head3 get_lists_with_patron
1718
1719     my @lists = $patron->get_lists_with_patron;
1720
1721 FIXME: This method returns a DBIC resultset instead of a Koha::Objects-based
1722 iterator.
1723
1724 =cut
1725
1726 sub get_lists_with_patron {
1727     my ( $self ) = @_;
1728     my $borrowernumber = $self->borrowernumber;
1729
1730     return Koha::Database->new()->schema()->resultset('PatronList')->search(
1731         {
1732             'patron_list_patrons.borrowernumber' => $borrowernumber,
1733         },
1734         {
1735             join => 'patron_list_patrons',
1736             collapse => 1,
1737             order_by => 'name',
1738         }
1739     );
1740 }
1741
1742 =head3 account_locked
1743
1744 my $is_locked = $patron->account_locked
1745
1746 Return true if the patron has reached the maximum number of login attempts
1747 (see pref FailedLoginAttempts). If login_attempts is < 0, this is interpreted
1748 as an administrative lockout (independent of FailedLoginAttempts; see also
1749 Koha::Patron->lock).
1750 Otherwise return false.
1751 If the pref is not set (empty string, null or 0), the feature is considered as
1752 disabled.
1753
1754 =cut
1755
1756 sub account_locked {
1757     my ($self) = @_;
1758     my $FailedLoginAttempts = C4::Context->preference('FailedLoginAttempts');
1759     return 1 if $FailedLoginAttempts
1760           and $self->login_attempts
1761           and $self->login_attempts >= $FailedLoginAttempts;
1762     return 1 if ($self->login_attempts || 0) < 0; # administrative lockout
1763     return 0;
1764 }
1765
1766 =head3 can_see_patron_infos
1767
1768 my $can_see = $patron->can_see_patron_infos( $patron );
1769
1770 Return true if the patron (usually the logged in user) can see the patron's infos for a given patron
1771
1772 =cut
1773
1774 sub can_see_patron_infos {
1775     my ( $self, $patron ) = @_;
1776     return unless $patron;
1777     return $self->can_see_patrons_from( $patron->branchcode );
1778 }
1779
1780 =head3 can_see_patrons_from
1781
1782 my $can_see = $patron->can_see_patrons_from( $branchcode );
1783
1784 Return true if the patron (usually the logged in user) can see the patron's infos from a given library
1785
1786 =cut
1787
1788 sub can_see_patrons_from {
1789     my ( $self, $branchcode ) = @_;
1790
1791     return $self->can_see_things_from(
1792         {
1793             branchcode => $branchcode,
1794             permission => 'borrowers',
1795             subpermission => 'view_borrower_infos_from_any_libraries',
1796         }
1797     );
1798 }
1799
1800 =head3 can_edit_items_from
1801
1802     my $can_edit = $patron->can_edit_items_from( $branchcode );
1803
1804 Return true if the I<Koha::Patron> can edit items from the given branchcode
1805
1806 =cut
1807
1808 sub can_edit_items_from {
1809     my ( $self, $branchcode ) = @_;
1810
1811     return 1 if C4::Context->IsSuperLibrarian();
1812
1813     my $userenv = C4::Context->userenv();
1814     if ( $userenv && C4::Context->preference('IndependentBranches') ) {
1815         return $userenv->{branch} eq $branchcode;
1816     }
1817
1818     return $self->can_see_things_from(
1819         {
1820             branchcode    => $branchcode,
1821             permission    => 'editcatalogue',
1822             subpermission => 'edit_any_item',
1823         }
1824     );
1825 }
1826
1827 =head3 libraries_where_can_edit_items
1828
1829     my $libraries = $patron->libraries_where_can_edit_items;
1830
1831 Return the list of branchcodes(!) of libraries the patron is allowed to items for.
1832 The branchcodes are arbitrarily returned sorted.
1833 We are supposing here that the object is related to the logged in patron (use of C4::Context::only_my_library)
1834
1835 An empty array means no restriction, the user can edit any item.
1836
1837 =cut
1838
1839 sub libraries_where_can_edit_items {
1840     my ($self) = @_;
1841
1842     return $self->libraries_where_can_see_things(
1843         {
1844             permission    => 'editcatalogue',
1845             subpermission => 'edit_any_item',
1846             group_feature => 'ft_limit_item_editing',
1847         }
1848     );
1849 }
1850
1851 =head3 libraries_where_can_see_patrons
1852
1853 my $libraries = $patron->libraries_where_can_see_patrons;
1854
1855 Return the list of branchcodes(!) of libraries the patron is allowed to see other patron's infos.
1856 The branchcodes are arbitrarily returned sorted.
1857 We are supposing here that the object is related to the logged in patron (use of C4::Context::only_my_library)
1858
1859 An empty array means no restriction, the patron can see patron's infos from any libraries.
1860
1861 =cut
1862
1863 sub libraries_where_can_see_patrons {
1864     my ($self) = @_;
1865
1866     return $self->libraries_where_can_see_things(
1867         {
1868             permission    => 'borrowers',
1869             subpermission => 'view_borrower_infos_from_any_libraries',
1870             group_feature => 'ft_hide_patron_info',
1871         }
1872     );
1873 }
1874
1875 =head3 can_see_things_from
1876
1877 my $can_see = $patron->can_see_things_from( $branchcode );
1878
1879 Return true if the I<Koha::Patron> can perform some action on the given thing
1880
1881 =cut
1882
1883 sub can_see_things_from {
1884     my ( $self, $params ) = @_;
1885
1886     my $branchcode    = $params->{branchcode};
1887     my $permission    = $params->{permission};
1888     my $subpermission = $params->{subpermission};
1889
1890     return 1 if C4::Context->IsSuperLibrarian();
1891
1892     my $can = 0;
1893     if ( $self->branchcode eq $branchcode ) {
1894         $can = 1;
1895     } elsif ( $self->has_permission( { $permission => $subpermission } ) ) {
1896         $can = 1;
1897     } elsif ( my @branches = $self->libraries_where_can_see_patrons ) {
1898         $can = ( any { $_ eq $branchcode } @branches ) ? 1 : 0;
1899     }
1900     return $can;
1901 }
1902
1903 =head3 can_log_into
1904
1905 my $can_log_into = $patron->can_log_into( $library );
1906
1907 Given a I<Koha::Library> object, it returns a boolean representing
1908 the fact the patron can log into a the library.
1909
1910 =cut
1911
1912 sub can_log_into {
1913     my ( $self, $library ) = @_;
1914
1915     my $can = 0;
1916
1917     if ( C4::Context->preference('IndependentBranches') ) {
1918         $can = 1
1919           if $self->is_superlibrarian
1920           or $self->branchcode eq $library->id;
1921     }
1922     else {
1923         # no restrictions
1924         $can = 1;
1925     }
1926
1927    return $can;
1928 }
1929
1930 =head3 libraries_where_can_see_things
1931
1932     my $libraries = $patron->libraries_where_can_see_things;
1933
1934 Returns a list of libraries where an aribitarary action is allowed to be taken by the logged in librarian
1935 against an object based on some branchcode related to the object ( patron branchcode, item homebranch, etc ).
1936
1937 We are supposing here that the object is related to the logged in librarian (use of C4::Context::only_my_library)
1938
1939 An empty array means no restriction, the thing can see thing's infos from any libraries.
1940
1941 =cut
1942
1943 sub libraries_where_can_see_things {
1944     my ( $self, $params ) = @_;
1945     my $permission    = $params->{permission};
1946     my $subpermission = $params->{subpermission};
1947     my $group_feature = $params->{group_feature};
1948
1949     return $self->{"_restricted_branchcodes:$permission:$subpermission:$group_feature"}
1950         if exists( $self->{"_restricted_branchcodes:$permission:$subpermission:$group_feature"} );
1951
1952     my $userenv = C4::Context->userenv;
1953
1954     return () unless $userenv; # For tests, but userenv should be defined in tests...
1955
1956     my @restricted_branchcodes;
1957     if (C4::Context::only_my_library) {
1958         push @restricted_branchcodes, $self->branchcode;
1959     }
1960     else {
1961         unless (
1962             $self->has_permission(
1963                 { $permission => $subpermission }
1964             )
1965           )
1966         {
1967             my $library_groups = $self->library->library_groups({ $group_feature => 1 });
1968             if ( $library_groups->count )
1969             {
1970                 while ( my $library_group = $library_groups->next ) {
1971                     my $parent = $library_group->parent;
1972                     if ( $parent->has_child( $self->branchcode ) ) {
1973                         push @restricted_branchcodes, $parent->children->get_column('branchcode');
1974                     }
1975                 }
1976             }
1977
1978             @restricted_branchcodes = ( $self->branchcode ) unless @restricted_branchcodes;
1979         }
1980     }
1981
1982     @restricted_branchcodes = grep { defined $_ } @restricted_branchcodes;
1983     @restricted_branchcodes = uniq(@restricted_branchcodes);
1984     @restricted_branchcodes = sort(@restricted_branchcodes);
1985
1986     $self->{"_restricted_branchcodes:$permission:$subpermission:$group_feature"} = \@restricted_branchcodes;
1987     return @{ $self->{"_restricted_branchcodes:$permission:$subpermission:$group_feature"} };
1988 }
1989
1990 =head3 has_permission
1991
1992 my $permission = $patron->has_permission($required);
1993
1994 See C4::Auth::haspermission for details of syntax for $required
1995
1996 =cut
1997
1998 sub has_permission {
1999     my ( $self, $flagsrequired ) = @_;
2000     return unless $self->userid;
2001     # TODO code from haspermission needs to be moved here!
2002     return C4::Auth::haspermission( $self->userid, $flagsrequired );
2003 }
2004
2005 =head3 is_superlibrarian
2006
2007   my $is_superlibrarian = $patron->is_superlibrarian;
2008
2009 Return true if the patron is a superlibrarian.
2010
2011 =cut
2012
2013 sub is_superlibrarian {
2014     my ($self) = @_;
2015     return $self->has_permission( { superlibrarian => 1 } ) ? 1 : 0;
2016 }
2017
2018 =head3 is_adult
2019
2020 my $is_adult = $patron->is_adult
2021
2022 Return true if the patron has a category with a type Adult (A) or Organization (I)
2023
2024 =cut
2025
2026 sub is_adult {
2027     my ( $self ) = @_;
2028     return $self->category->category_type =~ /^(A|I)$/ ? 1 : 0;
2029 }
2030
2031 =head3 is_child
2032
2033 my $is_child = $patron->is_child
2034
2035 Return true if the patron has a category with a type Child (C)
2036
2037 =cut
2038
2039 sub is_child {
2040     my( $self ) = @_;
2041     return $self->category->category_type eq 'C' ? 1 : 0;
2042 }
2043
2044 =head3 has_valid_userid
2045
2046 my $patron = Koha::Patrons->find(42);
2047 $patron->userid( $new_userid );
2048 my $has_a_valid_userid = $patron->has_valid_userid
2049
2050 my $patron = Koha::Patron->new( $params );
2051 my $has_a_valid_userid = $patron->has_valid_userid
2052
2053 Return true if the current userid of this patron is valid/unique, otherwise false.
2054
2055 Note that this should be done in $self->store instead and raise an exception if needed.
2056
2057 =cut
2058
2059 sub has_valid_userid {
2060     my ($self) = @_;
2061
2062     return 0 unless $self->userid;
2063
2064     return 0 if ( $self->userid eq C4::Context->config('user') );    # DB user
2065
2066     my $already_exists = Koha::Patrons->search(
2067         {
2068             userid => $self->userid,
2069             (
2070                 $self->in_storage
2071                 ? ( borrowernumber => { '!=' => $self->borrowernumber } )
2072                 : ()
2073             ),
2074         }
2075     )->count;
2076     return $already_exists ? 0 : 1;
2077 }
2078
2079 =head3 generate_userid
2080
2081     $patron->generate_userid;
2082
2083     If you do not have a plugin for generating a userid, we will call
2084     the internal method here that returns firstname.surname[.number],
2085     where number is an optional suffix to make the userid unique.
2086     (Its behavior has not been changed on bug 32426.)
2087
2088     If you have plugin(s), the first valid response will be used.
2089     A plugin is assumed to return a valid userid as suggestion, but not
2090     assumed to save it already.
2091     Does not fallback to internal (you could arrange for that in your plugin).
2092     Clears userid when there are no valid plugin responses.
2093
2094 =cut
2095
2096 sub generate_userid {
2097     my ( $self ) = @_;
2098     my @responses = Koha::Plugins->call(
2099         'patron_generate_userid',
2100         {
2101             patron  => $self,                 #FIXME To be deprecated
2102             payload => { patron => $self },
2103         },
2104     );
2105     unless( @responses ) {
2106         # Empty list only possible when there are NO enabled plugins for this method.
2107         # In that case we provide internal response.
2108         return $self->_generate_userid_internal;
2109     }
2110     # If a plugin returned false value or invalid value, we do however not return
2111     # internal response. The plugins should deal with that themselves. So we prevent
2112     # unexpected/unwelcome internal codes for plugin failures.
2113     foreach my $response ( grep { $_ } @responses ) {
2114         $self->userid( $response );
2115         return $self if $self->has_valid_userid;
2116     }
2117     $self->userid(undef);
2118     return $self;
2119 }
2120
2121 sub _generate_userid_internal { # as we always did
2122     my ($self) = @_;
2123     my $offset = 0;
2124     my $firstname = $self->firstname // q{};
2125     my $surname = $self->surname // q{};
2126     #The script will "do" the following code and increment the $offset until the generated userid is unique
2127     do {
2128       $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
2129       $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
2130       my $userid = lc(($firstname)? "$firstname.$surname" : $surname);
2131       $userid = NFKD( $userid );
2132       $userid =~ s/\p{NonspacingMark}//g;
2133       $userid .= $offset unless $offset == 0;
2134       $self->userid( $userid );
2135       $offset++;
2136      } while (! $self->has_valid_userid );
2137
2138      return $self;
2139 }
2140
2141 =head3 add_extended_attribute
2142
2143 =cut
2144
2145 sub add_extended_attribute {
2146     my ($self, $attribute) = @_;
2147
2148     return Koha::Patron::Attribute->new(
2149         {
2150             %$attribute,
2151             ( borrowernumber => $self->borrowernumber ),
2152         }
2153     )->store;
2154
2155 }
2156
2157 =head3 extended_attributes
2158
2159 Return object of Koha::Patron::Attributes type with all attributes set for this patron
2160
2161 Or setter FIXME
2162
2163 =cut
2164
2165 sub extended_attributes {
2166     my ( $self, $attributes ) = @_;
2167     if ($attributes) {    # setter
2168         my $schema = $self->_result->result_source->schema;
2169         $schema->txn_do(
2170             sub {
2171                 # Remove the existing one
2172                 $self->extended_attributes->filter_by_branch_limitations->delete;
2173
2174                 # Insert the new ones
2175                 my $new_types = {};
2176                 for my $attribute (@$attributes) {
2177                     $self->add_extended_attribute($attribute);
2178                     $new_types->{$attribute->{code}} = 1;
2179                 }
2180
2181                 # Check globally mandatory types
2182                 my @required_attribute_types =
2183                     Koha::Patron::Attribute::Types->search(
2184                         {
2185                             mandatory => 1,
2186                             category_code => [ undef, $self->categorycode ],
2187                             'borrower_attribute_types_branches.b_branchcode' =>
2188                               undef,
2189                         },
2190                         { join => 'borrower_attribute_types_branches' }
2191                     )->get_column('code');
2192                 for my $type ( @required_attribute_types ) {
2193                     Koha::Exceptions::Patron::MissingMandatoryExtendedAttribute->throw(
2194                         type => $type,
2195                     ) if !$new_types->{$type};
2196                 }
2197             }
2198         );
2199     }
2200
2201     my $rs = $self->_result->borrower_attributes;
2202     # We call search to use the filters in Koha::Patron::Attributes->search
2203     return Koha::Patron::Attributes->_new_from_dbic($rs)->search;
2204 }
2205
2206 =head3 messages
2207
2208     my $messages = $patron->messages;
2209
2210 Return the message attached to the patron.
2211
2212 =cut
2213
2214 sub messages {
2215     my ( $self ) = @_;
2216     my $messages_rs = $self->_result->messages_borrowernumbers->search;
2217     return Koha::Patron::Messages->_new_from_dbic($messages_rs);
2218 }
2219
2220 =head3 lock
2221
2222     Koha::Patrons->find($id)->lock({ expire => 1, remove => 1 });
2223
2224     Lock and optionally expire a patron account.
2225     Remove holds and article requests if remove flag set.
2226     In order to distinguish from locking by entering a wrong password, let's
2227     call this an administrative lockout.
2228
2229 =cut
2230
2231 sub lock {
2232     my ( $self, $params ) = @_;
2233     $self->login_attempts( ADMINISTRATIVE_LOCKOUT );
2234     if( $params->{expire} ) {
2235         $self->dateexpiry( dt_from_string->subtract(days => 1) );
2236     }
2237     $self->store;
2238     if( $params->{remove} ) {
2239         $self->holds->delete;
2240         $self->article_requests->delete;
2241     }
2242     return $self;
2243 }
2244
2245 =head3 anonymize
2246
2247     Koha::Patrons->find($id)->anonymize;
2248
2249     Anonymize or clear borrower fields. Fields in BorrowerMandatoryField
2250     are randomized, other personal data is cleared too.
2251     Patrons with issues are skipped.
2252
2253 =cut
2254
2255 sub anonymize {
2256     my ( $self ) = @_;
2257     if( $self->_result->issues->count ) {
2258         warn "Exiting anonymize: patron ".$self->borrowernumber." still has issues";
2259         return;
2260     }
2261     # Mandatory fields come from the corresponding pref, but email fields
2262     # are removed since scrambled email addresses only generate errors
2263     my $mandatory = { map { (lc $_, 1); } grep { !/email/ }
2264         split /\s*\|\s*/, C4::Context->preference('BorrowerMandatoryField') };
2265     $mandatory->{userid} = 1; # needed since sub store does not clear field
2266     my @columns = $self->_result->result_source->columns;
2267     @columns = grep { !/borrowernumber|branchcode|categorycode|^date|password|flags|updated_on|lastseen|lang|login_attempts|anonymized|auth_method/ } @columns;
2268     push @columns, 'dateofbirth'; # add this date back in
2269     foreach my $col (@columns) {
2270         $self->_anonymize_column($col, $mandatory->{lc $col} );
2271     }
2272     $self->anonymized(1)->store;
2273 }
2274
2275 sub _anonymize_column {
2276     my ( $self, $col, $mandatory ) = @_;
2277     my $col_info = $self->_result->result_source->column_info($col);
2278     my $type = $col_info->{data_type};
2279     my $nullable = $col_info->{is_nullable};
2280     my $val;
2281     if( $type =~ /char|text/ ) {
2282         $val = $mandatory
2283             ? Koha::Token->new->generate({ pattern => '\w{10}' })
2284             : $nullable
2285             ? undef
2286             : q{};
2287     } elsif( $type =~ /integer|int$|float|dec|double/ ) {
2288         $val = $nullable ? undef : 0;
2289     } elsif( $type =~ /date|time/ ) {
2290         $val = $nullable ? undef : dt_from_string;
2291     }
2292     $self->$col($val);
2293 }
2294
2295 =head3 add_guarantor
2296
2297     my $relationship = $patron->add_guarantor(
2298         {
2299             borrowernumber => $borrowernumber,
2300             relationships  => $relationship,
2301         }
2302     );
2303
2304     Adds a new guarantor to a patron.
2305
2306 =cut
2307
2308 sub add_guarantor {
2309     my ( $self, $params ) = @_;
2310
2311     my $guarantor_id = $params->{guarantor_id};
2312     my $relationship = $params->{relationship};
2313
2314     return Koha::Patron::Relationship->new(
2315         {
2316             guarantee_id => $self->id,
2317             guarantor_id => $guarantor_id,
2318             relationship => $relationship
2319         }
2320     )->store();
2321 }
2322
2323 =head3 get_extended_attribute
2324
2325 my $attribute_value = $patron->get_extended_attribute( $code );
2326
2327 Return the attribute for the code passed in parameter.
2328
2329 It not exist it returns undef
2330
2331 Note that this will not work for repeatable attribute types.
2332
2333 Maybe you certainly not want to use this method, it is actually only used for SHOW_BARCODE
2334 (which should be a real patron's attribute (not extended)
2335
2336 =cut
2337
2338 sub get_extended_attribute {
2339     my ( $self, $code, $value ) = @_;
2340     my $rs = $self->_result->borrower_attributes;
2341     return unless $rs;
2342     my $attribute = $rs->search({ code => $code, ( $value ? ( attribute => $value ) : () ) });
2343     return unless $attribute->count;
2344     return $attribute->next;
2345 }
2346
2347 =head3 set_default_messaging_preferences
2348
2349     $patron->set_default_messaging_preferences
2350
2351 Sets default messaging preferences on patron.
2352
2353 See Koha::Patron::MessagePreference(s) for more documentation, especially on
2354 thrown exceptions.
2355
2356 =cut
2357
2358 sub set_default_messaging_preferences {
2359     my ($self, $categorycode) = @_;
2360
2361     my $options = Koha::Patron::MessagePreferences->get_options;
2362
2363     foreach my $option (@$options) {
2364         # Check that this option has preference configuration for this category
2365         unless (Koha::Patron::MessagePreferences->search({
2366             message_attribute_id => $option->{message_attribute_id},
2367             categorycode         => $categorycode || $self->categorycode,
2368         })->count) {
2369             next;
2370         }
2371
2372         # Delete current setting
2373         Koha::Patron::MessagePreferences->search({
2374              borrowernumber => $self->borrowernumber,
2375              message_attribute_id => $option->{message_attribute_id},
2376         })->delete;
2377
2378         Koha::Patron::MessagePreference->new_from_default({
2379             borrowernumber => $self->borrowernumber,
2380             categorycode   => $categorycode || $self->categorycode,
2381             message_attribute_id => $option->{message_attribute_id},
2382         });
2383     }
2384
2385     return $self;
2386 }
2387
2388 =head3 is_accessible
2389
2390     if ( $patron->is_accessible({ user => $logged_in_user }) ) { ... }
2391
2392 This overloaded method validates whether the current I<Koha::Patron> object can be accessed
2393 by the logged in user.
2394
2395 Returns 0 if the I<user> parameter is missing.
2396
2397 =cut
2398
2399 sub is_accessible {
2400     my ( $self, $params ) = @_;
2401
2402     unless ( defined( $params->{user} ) ) {
2403         Koha::Exceptions::MissingParameter->throw( error => "The `user` parameter is mandatory" );
2404     }
2405
2406     my $consumer = $params->{user};
2407     return $consumer->can_see_patron_infos($self);
2408 }
2409
2410 =head3 unredact_list
2411
2412 This method returns the list of database fields that should be visible, even for restricted users,
2413 for both API and UI output purposes
2414
2415 =cut
2416
2417 sub unredact_list {
2418     return ['branchcode'];
2419 }
2420
2421 =head3 to_api
2422
2423     my $json = $patron->to_api;
2424
2425 Overloaded method that returns a JSON representation of the Koha::Patron object,
2426 suitable for API output.
2427
2428 =cut
2429
2430 sub to_api {
2431     my ( $self, $params ) = @_;
2432
2433     my $json_patron = $self->SUPER::to_api( $params );
2434
2435     return unless $json_patron;
2436
2437     $json_patron->{restricted} = ( $self->is_debarred )
2438                                     ? Mojo::JSON->true
2439                                     : Mojo::JSON->false;
2440
2441     return $json_patron;
2442 }
2443
2444 =head3 to_api_mapping
2445
2446 This method returns the mapping for representing a Koha::Patron object
2447 on the API.
2448
2449 =cut
2450
2451 sub to_api_mapping {
2452     return {
2453         borrowernotes       => 'staff_notes',
2454         borrowernumber      => 'patron_id',
2455         branchcode          => 'library_id',
2456         categorycode        => 'category_id',
2457         checkprevcheckout   => 'check_previous_checkout',
2458         contactfirstname    => undef,                     # Unused
2459         contactname         => undef,                     # Unused
2460         contactnote         => 'altaddress_notes',
2461         contacttitle        => undef,                     # Unused
2462         dateenrolled        => 'date_enrolled',
2463         dateexpiry          => 'expiry_date',
2464         dateofbirth         => 'date_of_birth',
2465         debarred            => undef,                     # replaced by 'restricted'
2466         debarredcomment     => undef,    # calculated, API consumers will use /restrictions instead
2467         emailpro            => 'secondary_email',
2468         flags               => undef,    # permissions manipulation handled in /permissions
2469         gonenoaddress       => 'incorrect_address',
2470         lastseen            => 'last_seen',
2471         lost                => 'patron_card_lost',
2472         opacnote            => 'opac_notes',
2473         othernames          => 'other_name',
2474         password            => undef,            # password manipulation handled in /password
2475         phonepro            => 'secondary_phone',
2476         relationship        => 'relationship_type',
2477         sex                 => 'gender',
2478         smsalertnumber      => 'sms_number',
2479         sort1               => 'statistics_1',
2480         sort2               => 'statistics_2',
2481         autorenew_checkouts => 'autorenew_checkouts',
2482         streetnumber        => 'street_number',
2483         streettype          => 'street_type',
2484         zipcode             => 'postal_code',
2485         B_address           => 'altaddress_address',
2486         B_address2          => 'altaddress_address2',
2487         B_city              => 'altaddress_city',
2488         B_country           => 'altaddress_country',
2489         B_email             => 'altaddress_email',
2490         B_phone             => 'altaddress_phone',
2491         B_state             => 'altaddress_state',
2492         B_streetnumber      => 'altaddress_street_number',
2493         B_streettype        => 'altaddress_street_type',
2494         B_zipcode           => 'altaddress_postal_code',
2495         altcontactaddress1  => 'altcontact_address',
2496         altcontactaddress2  => 'altcontact_address2',
2497         altcontactaddress3  => 'altcontact_city',
2498         altcontactcountry   => 'altcontact_country',
2499         altcontactfirstname => 'altcontact_firstname',
2500         altcontactphone     => 'altcontact_phone',
2501         altcontactsurname   => 'altcontact_surname',
2502         altcontactstate     => 'altcontact_state',
2503         altcontactzipcode   => 'altcontact_postal_code',
2504         password_expiration_date => undef,
2505         primary_contact_method => undef,
2506         secret              => undef,
2507         auth_method         => undef,
2508     };
2509 }
2510
2511 =head3 strings_map
2512
2513 Returns a map of column name to string representations including the string.
2514
2515 =cut
2516
2517 sub strings_map {
2518     my ( $self, $params ) = @_;
2519
2520     return {
2521         library_id => {
2522             str  => $self->library->branchname,
2523             type => 'library',
2524         },
2525         category_id => {
2526             str  => $self->category->description,
2527             type => 'patron_category',
2528         }
2529     };
2530 }
2531
2532 =head3 queue_notice
2533
2534     Koha::Patrons->queue_notice({ letter_params => $letter_params, message_name => 'DUE'});
2535     Koha::Patrons->queue_notice({ letter_params => $letter_params, message_transports => \@message_transports });
2536     Koha::Patrons->queue_notice({ letter_params => $letter_params, message_transports => \@message_transports, test_mode => 1 });
2537
2538     Queue messages to a patron. Can pass a message that is part of the message_attributes
2539     table or supply the transport to use.
2540
2541     If passed a message name we retrieve the patrons preferences for transports
2542     Otherwise we use the supplied transport. In the case of email or sms we fall back to print if
2543     we have no address/number for sending
2544
2545     $letter_params is a hashref of the values to be passed to GetPreparedLetter
2546
2547     test_mode will only report which notices would be sent, but nothing will be queued
2548
2549 =cut
2550
2551 sub queue_notice {
2552     my ( $self, $params ) = @_;
2553     my $letter_params = $params->{letter_params};
2554     my $test_mode = $params->{test_mode};
2555
2556     return unless $letter_params;
2557     return unless exists $params->{message_name} xor $params->{message_transports}; # We only want one of these
2558
2559     my $library = Koha::Libraries->find( $letter_params->{branchcode} );
2560     my $from_email_address = $library->from_email_address;
2561
2562     my @message_transports;
2563     my $letter_code;
2564     $letter_code = $letter_params->{letter_code};
2565     if( $params->{message_name} ){
2566         my $messaging_prefs = C4::Members::Messaging::GetMessagingPreferences( {
2567                 borrowernumber => $letter_params->{borrowernumber},
2568                 message_name => $params->{message_name}
2569         } );
2570         @message_transports = ( keys %{ $messaging_prefs->{transports} } );
2571         $letter_code = $messaging_prefs->{transports}->{$message_transports[0]} unless $letter_code;
2572     } else {
2573         @message_transports = @{$params->{message_transports}};
2574     }
2575     return unless defined $letter_code;
2576     $letter_params->{letter_code} = $letter_code;
2577     my $print_sent = 0;
2578     my %return;
2579     foreach my $mtt (@message_transports){
2580         next if ($mtt eq 'itiva' and C4::Context->preference('TalkingTechItivaPhoneNotification') );
2581         # Notice is handled by TalkingTech_itiva_outbound.pl
2582         if (   ( $mtt eq 'email' and not $self->notice_email_address )
2583             or ( $mtt eq 'sms'   and not $self->smsalertnumber )
2584             or ( $mtt eq 'phone' and not $self->phone ) )
2585         {
2586             push @{ $return{fallback} }, $mtt;
2587             $mtt = 'print';
2588         }
2589         next if $mtt eq 'print' && $print_sent;
2590         $letter_params->{message_transport_type} = $mtt;
2591         my $letter = C4::Letters::GetPreparedLetter( %$letter_params );
2592         C4::Letters::EnqueueLetter({
2593             letter => $letter,
2594             borrowernumber => $self->borrowernumber,
2595             from_address   => $from_email_address,
2596             message_transport_type => $mtt
2597         }) unless $test_mode;
2598         push @{$return{sent}}, $mtt;
2599         $print_sent = 1 if $mtt eq 'print';
2600     }
2601     return \%return;
2602 }
2603
2604 =head3 safe_to_delete
2605
2606     my $result = $patron->safe_to_delete;
2607     if ( $result eq 'has_guarantees' ) { ... }
2608     elsif ( $result ) { ... }
2609     else { # cannot delete }
2610
2611 This method tells if the Koha:Patron object can be deleted. Possible return values
2612
2613 =over 4
2614
2615 =item 'ok'
2616
2617 =item 'has_checkouts'
2618
2619 =item 'has_debt'
2620
2621 =item 'has_guarantees'
2622
2623 =item 'is_anonymous_patron'
2624
2625 =item 'is_protected'
2626
2627 =back
2628
2629 =cut
2630
2631 sub safe_to_delete {
2632     my ($self) = @_;
2633
2634     my $anonymous_patron = C4::Context->preference('AnonymousPatron');
2635
2636     my $error;
2637
2638     if ( $anonymous_patron && $self->id eq $anonymous_patron ) {
2639         $error = 'is_anonymous_patron';
2640     }
2641     elsif ( $self->checkouts->count ) {
2642         $error = 'has_checkouts';
2643     }
2644     elsif ( $self->account->outstanding_debits->total_outstanding > 0 ) {
2645         $error = 'has_debt';
2646     }
2647     elsif ( $self->guarantee_relationships->count ) {
2648         $error = 'has_guarantees';
2649     }
2650     elsif ( $self->protected ) {
2651         $error = 'is_protected';
2652     }
2653
2654     if ( $error ) {
2655         return Koha::Result::Boolean->new(0)->add_message({ message => $error });
2656     }
2657
2658     return Koha::Result::Boolean->new(1);
2659 }
2660
2661 =head3 recalls
2662
2663     my $recalls = $patron->recalls;
2664
2665 Return the patron's recalls.
2666
2667 =cut
2668
2669 sub recalls {
2670     my ( $self ) = @_;
2671
2672     return Koha::Recalls->search({ patron_id => $self->borrowernumber });
2673 }
2674
2675 =head3 account_balance
2676
2677     my $balance = $patron->account_balance
2678
2679 Return the patron's account balance
2680
2681 =cut
2682
2683 sub account_balance {
2684     my ($self) = @_;
2685     return $self->account->balance;
2686 }
2687
2688 =head3 notify_library_of_registration
2689
2690 $patron->notify_library_of_registration( $email_patron_registrations );
2691
2692 Send patron registration email to library if EmailPatronRegistrations system preference is enabled.
2693
2694 =cut
2695
2696 sub notify_library_of_registration {
2697     my ( $self, $email_patron_registrations ) = @_;
2698
2699     if (
2700         my $letter = C4::Letters::GetPreparedLetter(
2701             module      => 'members',
2702             letter_code => 'OPAC_REG',
2703             branchcode  => $self->branchcode,
2704             lang        => $self->lang || 'default',
2705             tables      => {
2706                 'borrowers' => $self->borrowernumber
2707             },
2708         )
2709     ) {
2710         my $to_address;
2711         if ( $email_patron_registrations eq "BranchEmailAddress" ) {
2712             my $library = Koha::Libraries->find( $self->branchcode );
2713             $to_address = $library->inbound_email_address;
2714         }
2715         elsif ( $email_patron_registrations eq "KohaAdminEmailAddress" ) {
2716             $to_address = C4::Context->preference('ReplytoDefault')
2717             || C4::Context->preference('KohaAdminEmailAddress');
2718         }
2719         else {
2720             $to_address =
2721                 C4::Context->preference('EmailAddressForPatronRegistrations')
2722                 || C4::Context->preference('ReplytoDefault')
2723                 || C4::Context->preference('KohaAdminEmailAddress');
2724         }
2725
2726         my $message_id = C4::Letters::EnqueueLetter(
2727             {
2728                 letter                 => $letter,
2729                 borrowernumber         => $self->borrowernumber,
2730                 to_address             => $to_address,
2731                 message_transport_type => 'email'
2732             }
2733         ) or warn "can't enqueue letter $letter";
2734         if ( $message_id ) {
2735             return 1;
2736         }
2737     }
2738 }
2739
2740 =head3 has_messaging_preference
2741
2742 my $bool = $patron->has_messaging_preference({
2743     message_name => $message_name, # A value from message_attributes.message_name
2744     message_transport_type => $message_transport_type, # email, sms, phone, itiva, etc...
2745     wants_digest => $wants_digest, # 1 if you are looking for the digest version, don't pass if you just want either
2746 });
2747
2748 =cut
2749
2750 sub has_messaging_preference {
2751     my ( $self, $params ) = @_;
2752
2753     my $message_name           = $params->{message_name};
2754     my $message_transport_type = $params->{message_transport_type};
2755     my $wants_digest           = $params->{wants_digest};
2756
2757     return $self->_result->search_related_rs(
2758         'borrower_message_preferences',
2759         $params,
2760         {
2761             prefetch =>
2762               [ 'borrower_message_transport_preferences', 'message_attribute' ]
2763         }
2764     )->count;
2765 }
2766
2767 =head3 can_patron_change_staff_only_lists
2768
2769 $patron->can_patron_change_staff_only_lists;
2770
2771 Return 1 if a patron has 'Superlibrarian' or 'Catalogue' permission.
2772 Otherwise, return 0.
2773
2774 =cut
2775
2776 sub can_patron_change_staff_only_lists {
2777     my ( $self, $params ) = @_;
2778     return 1 if C4::Auth::haspermission( $self->userid, { 'catalogue' => 1 });
2779     return 0;
2780 }
2781
2782 =head3 can_patron_change_permitted_staff_lists
2783
2784 $patron->can_patron_change_permitted_staff_lists;
2785
2786 Return 1 if a patron has 'Superlibrarian' or 'Catalogue' and 'edit_public_list_contents' permissions.
2787 Otherwise, return 0.
2788
2789 =cut
2790
2791 sub can_patron_change_permitted_staff_lists {
2792     my ( $self, $params ) = @_;
2793     return 1 if C4::Auth::haspermission( $self->userid, { 'catalogue' => 1, lists => 'edit_public_list_contents' } );
2794     return 0;
2795 }
2796
2797 =head3 encode_secret
2798
2799   $patron->encode_secret($secret32);
2800
2801 Secret (TwoFactorAuth expects it in base32 format) is encrypted.
2802 You still need to call ->store.
2803
2804 =cut
2805
2806 sub encode_secret {
2807     my ( $self, $secret ) = @_;
2808     if( $secret ) {
2809         return $self->secret( Koha::Encryption->new->encrypt_hex($secret) );
2810     }
2811     return $self->secret($secret);
2812 }
2813
2814 =head3 decoded_secret
2815
2816   my $secret32 = $patron->decoded_secret;
2817
2818 Decode the patron secret. We expect to get back a base32 string, but this
2819 is not checked here. Caller of encode_secret is responsible for that.
2820
2821 =cut
2822
2823 sub decoded_secret {
2824     my ( $self ) = @_;
2825     if( $self->secret ) {
2826         return Koha::Encryption->new->decrypt_hex( $self->secret );
2827     }
2828     return $self->secret;
2829 }
2830
2831 =head3 virtualshelves
2832
2833     my $shelves = $patron->virtualshelves;
2834
2835 =cut
2836
2837 sub virtualshelves {
2838     my $self = shift;
2839     return Koha::Virtualshelves->_new_from_dbic( scalar $self->_result->virtualshelves );
2840 }
2841
2842 =head3 get_savings
2843
2844     my $savings = $patron->get_savings;
2845
2846 Use the replacement price of patron's old and current issues to calculate how much they have 'saved' by using the library.
2847
2848 =cut
2849
2850 sub get_savings {
2851     my ($self) = @_;
2852
2853     my @itemnumbers = grep { defined $_ } ( $self->old_checkouts->get_column('itemnumber'), $self->checkouts->get_column('itemnumber') );
2854
2855     return Koha::Items->search(
2856         { itemnumber => { -in => \@itemnumbers } },
2857         {   select => [ { sum => 'me.replacementprice' } ],
2858             as     => ['total_savings']
2859         }
2860     )->next->get_column('total_savings') // 0;
2861 }
2862
2863 =head3 alert_subscriptions
2864
2865     my $subscriptions = $patron->alert_subscriptions;
2866
2867 Return a Koha::Subscriptions object containing subscriptions for which the patron has subscribed to email alerts.
2868
2869 =cut
2870
2871 sub alert_subscriptions {
2872     my ($self) = @_;
2873
2874     my @alerts           = $self->_result->alerts;
2875     my @subscription_ids = map { $_->externalid } @alerts;
2876
2877     return Koha::Subscriptions->search( { subscriptionid => \@subscription_ids } );
2878 }
2879
2880 =head3 consent
2881
2882     my $consent = $patron->consent(TYPE);
2883
2884     Returns the first consent of type TYPE (there should be only one) or a new instance
2885     of Koha::Patron::Consent.
2886
2887 =cut
2888
2889 sub consent {
2890     my ( $self, $type ) = @_;
2891     Koha::Exceptions::MissingParameter->throw('Missing consent type') if !$type;
2892     my $consents = Koha::Patron::Consents->search(
2893         {
2894             borrowernumber => $self->borrowernumber,
2895             type           => $type,
2896         }
2897     );
2898     return $consents && $consents->count
2899         ? $consents->next
2900         : Koha::Patron::Consent->new( { borrowernumber => $self->borrowernumber, type => $type } );
2901 }
2902
2903 =head2 Internal methods
2904
2905 =head3 _type
2906
2907 =cut
2908
2909 sub _type {
2910     return 'Borrower';
2911 }
2912
2913 =head1 AUTHORS
2914
2915 Kyle M Hall <kyle@bywatersolutions.com>
2916 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
2917 Martin Renvoize <martin.renvoize@ptfs-europe.com>
2918
2919 =cut
2920
2921 1;