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