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