Koha/Patron.pm

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