Koha/Patron.pm

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