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