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