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     my $address;
1585     my $guarantor_address;
1586
1587     my $which_address = C4::Context->preference("EmailFieldPrimary");
1588     # if syspref is set to 'first valid' (value == OFF), look up email address
1589     if ( $which_address eq 'OFF' ) {
1590         $address = $self->first_valid_email_address;
1591     } else {
1592         $address = $self->$which_address || '';
1593     }
1594
1595     my $use_guarantor = C4::Context->preference('RedirectGuaranteeEmail');
1596     if ($use_guarantor) {
1597         my @guarantors = map { $_->guarantors->as_list } $self->guarantor_relationships();
1598         if (@guarantors) {
1599             foreach my $guarantor (@guarantors) {
1600                 if ( $which_address eq 'OFF' ) {
1601                     $guarantor_address = $guarantor->first_valid_email_address;
1602                 } else {
1603                     $guarantor_address = $guarantor->$which_address || '';
1604                 }
1605                 if ($address){
1606                     $address .= ', ';
1607                 }
1608                 $address .=  $guarantor_address if $guarantor_address;
1609             }
1610         }
1611     }
1612     return $address;
1613 }
1614
1615 =head3 first_valid_email_address
1616
1617 my $first_valid_email_address = $patron->first_valid_email_address
1618
1619 Return the first valid email address for a patron.
1620 For now, the order  is defined as email, emailpro, B_email.
1621 Returns the empty string if the borrower has no email addresses.
1622
1623 =cut
1624
1625 sub first_valid_email_address {
1626     my ($self) = @_;
1627
1628     my $email = q{};
1629
1630     my @fields = split /\s*\|\s*/,
1631       C4::Context->preference('EmailFieldPrecedence');
1632     for my $field (@fields) {
1633         $email = $self->$field;
1634         last if ($email);
1635     }
1636
1637     return $email;
1638 }
1639
1640 =head3 get_club_enrollments
1641
1642 =cut
1643
1644 sub get_club_enrollments {
1645     my ( $self ) = @_;
1646
1647     return Koha::Club::Enrollments->search( { borrowernumber => $self->borrowernumber(), date_canceled => undef } );
1648 }
1649
1650 =head3 get_enrollable_clubs
1651
1652 =cut
1653
1654 sub get_enrollable_clubs {
1655     my ( $self, $is_enrollable_from_opac ) = @_;
1656
1657     my $params;
1658     $params->{is_enrollable_from_opac} = $is_enrollable_from_opac
1659       if $is_enrollable_from_opac;
1660     $params->{is_email_required} = 0 unless $self->first_valid_email_address();
1661
1662     $params->{borrower} = $self;
1663
1664     return Koha::Clubs->get_enrollable($params);
1665 }
1666
1667 =head3 account_locked
1668
1669 my $is_locked = $patron->account_locked
1670
1671 Return true if the patron has reached the maximum number of login attempts
1672 (see pref FailedLoginAttempts). If login_attempts is < 0, this is interpreted
1673 as an administrative lockout (independent of FailedLoginAttempts; see also
1674 Koha::Patron->lock).
1675 Otherwise return false.
1676 If the pref is not set (empty string, null or 0), the feature is considered as
1677 disabled.
1678
1679 =cut
1680
1681 sub account_locked {
1682     my ($self) = @_;
1683     my $FailedLoginAttempts = C4::Context->preference('FailedLoginAttempts');
1684     return 1 if $FailedLoginAttempts
1685           and $self->login_attempts
1686           and $self->login_attempts >= $FailedLoginAttempts;
1687     return 1 if ($self->login_attempts || 0) < 0; # administrative lockout
1688     return 0;
1689 }
1690
1691 =head3 can_see_patron_infos
1692
1693 my $can_see = $patron->can_see_patron_infos( $patron );
1694
1695 Return true if the patron (usually the logged in user) can see the patron's infos for a given patron
1696
1697 =cut
1698
1699 sub can_see_patron_infos {
1700     my ( $self, $patron ) = @_;
1701     return unless $patron;
1702     return $self->can_see_patrons_from( $patron->branchcode );
1703 }
1704
1705 =head3 can_see_patrons_from
1706
1707 my $can_see = $patron->can_see_patrons_from( $branchcode );
1708
1709 Return true if the patron (usually the logged in user) can see the patron's infos from a given library
1710
1711 =cut
1712
1713 sub can_see_patrons_from {
1714     my ( $self, $branchcode ) = @_;
1715
1716     return $self->can_see_things_from(
1717         {
1718             branchcode => $branchcode,
1719             permission => 'borrowers',
1720             subpermission => 'view_borrower_infos_from_any_libraries',
1721         }
1722     );
1723 }
1724
1725 =head3 can_edit_items_from
1726
1727     my $can_edit = $patron->can_edit_items_from( $branchcode );
1728
1729 Return true if the I<Koha::Patron> can edit items from the given branchcode
1730
1731 =cut
1732
1733 sub can_edit_items_from {
1734     my ( $self, $branchcode ) = @_;
1735
1736     return 1 if C4::Context->IsSuperLibrarian();
1737
1738     my $userenv = C4::Context->userenv();
1739     if ( $userenv && C4::Context->preference('IndependentBranches') ) {
1740         return $userenv->{branch} eq $branchcode;
1741     }
1742
1743     return $self->can_see_things_from(
1744         {
1745             branchcode    => $branchcode,
1746             permission    => 'editcatalogue',
1747             subpermission => 'edit_any_item',
1748         }
1749     );
1750 }
1751
1752 =head3 libraries_where_can_edit_items
1753
1754     my $libraries = $patron->libraries_where_can_edit_items;
1755
1756 Return the list of branchcodes(!) of libraries the patron is allowed to items for.
1757 The branchcodes are arbitrarily returned sorted.
1758 We are supposing here that the object is related to the logged in patron (use of C4::Context::only_my_library)
1759
1760 An empty array means no restriction, the user can edit any item.
1761
1762 =cut
1763
1764 sub libraries_where_can_edit_items {
1765     my ($self) = @_;
1766
1767     return $self->libraries_where_can_see_things(
1768         {
1769             permission    => 'editcatalogue',
1770             subpermission => 'edit_any_item',
1771             group_feature => 'ft_limit_item_editing',
1772         }
1773     );
1774 }
1775
1776 =head3 libraries_where_can_see_patrons
1777
1778 my $libraries = $patron->libraries_where_can_see_patrons;
1779
1780 Return the list of branchcodes(!) of libraries the patron is allowed to see other patron's infos.
1781 The branchcodes are arbitrarily returned sorted.
1782 We are supposing here that the object is related to the logged in patron (use of C4::Context::only_my_library)
1783
1784 An empty array means no restriction, the patron can see patron's infos from any libraries.
1785
1786 =cut
1787
1788 sub libraries_where_can_see_patrons {
1789     my ($self) = @_;
1790
1791     return $self->libraries_where_can_see_things(
1792         {
1793             permission    => 'borrowers',
1794             subpermission => 'view_borrower_infos_from_any_libraries',
1795             group_feature => 'ft_hide_patron_info',
1796         }
1797     );
1798 }
1799
1800 =head3 can_see_things_from
1801
1802 my $can_see = $patron->can_see_things_from( $branchcode );
1803
1804 Return true if the I<Koha::Patron> can perform some action on the given thing
1805
1806 =cut
1807
1808 sub can_see_things_from {
1809     my ( $self, $params ) = @_;
1810
1811     my $branchcode    = $params->{branchcode};
1812     my $permission    = $params->{permission};
1813     my $subpermission = $params->{subpermission};
1814
1815     return 1 if C4::Context->IsSuperLibrarian();
1816
1817     my $can = 0;
1818     if ( $self->branchcode eq $branchcode ) {
1819         $can = 1;
1820     } elsif ( $self->has_permission( { $permission => $subpermission } ) ) {
1821         $can = 1;
1822     } elsif ( my $library_groups = $self->library->library_groups ) {
1823         while ( my $library_group = $library_groups->next ) {
1824             if ( $library_group->parent->has_child( $branchcode ) ) {
1825                 $can = 1;
1826                 last;
1827             }
1828         }
1829     }
1830     return $can;
1831 }
1832
1833 =head3 can_log_into
1834
1835 my $can_log_into = $patron->can_log_into( $library );
1836
1837 Given a I<Koha::Library> object, it returns a boolean representing
1838 the fact the patron can log into a the library.
1839
1840 =cut
1841
1842 sub can_log_into {
1843     my ( $self, $library ) = @_;
1844
1845     my $can = 0;
1846
1847     if ( C4::Context->preference('IndependentBranches') ) {
1848         $can = 1
1849           if $self->is_superlibrarian
1850           or $self->branchcode eq $library->id;
1851     }
1852     else {
1853         # no restrictions
1854         $can = 1;
1855     }
1856
1857    return $can;
1858 }
1859
1860 =head3 libraries_where_can_see_things
1861
1862     my $libraries = $patron->libraries_where_can_see_things;
1863
1864 Returns a list of libraries where an aribitarary action is allowed to be taken by the logged in librarian
1865 against an object based on some branchcode related to the object ( patron branchcode, item homebranch, etc ).
1866
1867 We are supposing here that the object is related to the logged in librarian (use of C4::Context::only_my_library)
1868
1869 An empty array means no restriction, the thing can see thing's infos from any libraries.
1870
1871 =cut
1872
1873 sub libraries_where_can_see_things {
1874     my ( $self, $params ) = @_;
1875     my $permission    = $params->{permission};
1876     my $subpermission = $params->{subpermission};
1877     my $group_feature = $params->{group_feature};
1878
1879     my $userenv = C4::Context->userenv;
1880
1881     return () unless $userenv; # For tests, but userenv should be defined in tests...
1882
1883     my @restricted_branchcodes;
1884     if (C4::Context::only_my_library) {
1885         push @restricted_branchcodes, $self->branchcode;
1886     }
1887     else {
1888         unless (
1889             $self->has_permission(
1890                 { $permission => $subpermission }
1891             )
1892           )
1893         {
1894             my $library_groups = $self->library->library_groups({ $group_feature => 1 });
1895             if ( $library_groups->count )
1896             {
1897                 while ( my $library_group = $library_groups->next ) {
1898                     my $parent = $library_group->parent;
1899                     if ( $parent->has_child( $self->branchcode ) ) {
1900                         push @restricted_branchcodes, $parent->children->get_column('branchcode');
1901                     }
1902                 }
1903             }
1904
1905             @restricted_branchcodes = ( $self->branchcode ) unless @restricted_branchcodes;
1906         }
1907     }
1908
1909     @restricted_branchcodes = grep { defined $_ } @restricted_branchcodes;
1910     @restricted_branchcodes = uniq(@restricted_branchcodes);
1911     @restricted_branchcodes = sort(@restricted_branchcodes);
1912     return @restricted_branchcodes;
1913 }
1914
1915 =head3 has_permission
1916
1917 my $permission = $patron->has_permission($required);
1918
1919 See C4::Auth::haspermission for details of syntax for $required
1920
1921 =cut
1922
1923 sub has_permission {
1924     my ( $self, $flagsrequired ) = @_;
1925     return unless $self->userid;
1926     # TODO code from haspermission needs to be moved here!
1927     return C4::Auth::haspermission( $self->userid, $flagsrequired );
1928 }
1929
1930 =head3 is_superlibrarian
1931
1932   my $is_superlibrarian = $patron->is_superlibrarian;
1933
1934 Return true if the patron is a superlibrarian.
1935
1936 =cut
1937
1938 sub is_superlibrarian {
1939     my ($self) = @_;
1940     return $self->has_permission( { superlibrarian => 1 } ) ? 1 : 0;
1941 }
1942
1943 =head3 is_adult
1944
1945 my $is_adult = $patron->is_adult
1946
1947 Return true if the patron has a category with a type Adult (A) or Organization (I)
1948
1949 =cut
1950
1951 sub is_adult {
1952     my ( $self ) = @_;
1953     return $self->category->category_type =~ /^(A|I)$/ ? 1 : 0;
1954 }
1955
1956 =head3 is_child
1957
1958 my $is_child = $patron->is_child
1959
1960 Return true if the patron has a category with a type Child (C)
1961
1962 =cut
1963
1964 sub is_child {
1965     my( $self ) = @_;
1966     return $self->category->category_type eq 'C' ? 1 : 0;
1967 }
1968
1969 =head3 has_valid_userid
1970
1971 my $patron = Koha::Patrons->find(42);
1972 $patron->userid( $new_userid );
1973 my $has_a_valid_userid = $patron->has_valid_userid
1974
1975 my $patron = Koha::Patron->new( $params );
1976 my $has_a_valid_userid = $patron->has_valid_userid
1977
1978 Return true if the current userid of this patron is valid/unique, otherwise false.
1979
1980 Note that this should be done in $self->store instead and raise an exception if needed.
1981
1982 =cut
1983
1984 sub has_valid_userid {
1985     my ($self) = @_;
1986
1987     return 0 unless $self->userid;
1988
1989     return 0 if ( $self->userid eq C4::Context->config('user') );    # DB user
1990
1991     my $already_exists = Koha::Patrons->search(
1992         {
1993             userid => $self->userid,
1994             (
1995                 $self->in_storage
1996                 ? ( borrowernumber => { '!=' => $self->borrowernumber } )
1997                 : ()
1998             ),
1999         }
2000     )->count;
2001     return $already_exists ? 0 : 1;
2002 }
2003
2004 =head3 generate_userid
2005
2006     $patron->generate_userid;
2007
2008     If you do not have a plugin for generating a userid, we will call
2009     the internal method here that returns firstname.surname[.number],
2010     where number is an optional suffix to make the userid unique.
2011     (Its behavior has not been changed on bug 32426.)
2012
2013     If you have plugin(s), the first valid response will be used.
2014     A plugin is assumed to return a valid userid as suggestion, but not
2015     assumed to save it already.
2016     Does not fallback to internal (you could arrange for that in your plugin).
2017     Clears userid when there are no valid plugin responses.
2018
2019 =cut
2020
2021 sub generate_userid {
2022     my ( $self ) = @_;
2023     my @responses = Koha::Plugins->call(
2024         'patron_generate_userid', { patron => $self },
2025     );
2026     unless( @responses ) {
2027         # Empty list only possible when there are NO enabled plugins for this method.
2028         # In that case we provide internal response.
2029         return $self->_generate_userid_internal;
2030     }
2031     # If a plugin returned false value or invalid value, we do however not return
2032     # internal response. The plugins should deal with that themselves. So we prevent
2033     # unexpected/unwelcome internal codes for plugin failures.
2034     foreach my $response ( grep { $_ } @responses ) {
2035         $self->userid( $response );
2036         return $self if $self->has_valid_userid;
2037     }
2038     $self->userid(undef);
2039     return $self;
2040 }
2041
2042 sub _generate_userid_internal { # as we always did
2043     my ($self) = @_;
2044     my $offset = 0;
2045     my $firstname = $self->firstname // q{};
2046     my $surname = $self->surname // q{};
2047     #The script will "do" the following code and increment the $offset until the generated userid is unique
2048     do {
2049       $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
2050       $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
2051       my $userid = lc(($firstname)? "$firstname.$surname" : $surname);
2052       $userid = NFKD( $userid );
2053       $userid =~ s/\p{NonspacingMark}//g;
2054       $userid .= $offset unless $offset == 0;
2055       $self->userid( $userid );
2056       $offset++;
2057      } while (! $self->has_valid_userid );
2058
2059      return $self;
2060 }
2061
2062 =head3 add_extended_attribute
2063
2064 =cut
2065
2066 sub add_extended_attribute {
2067     my ($self, $attribute) = @_;
2068
2069     return Koha::Patron::Attribute->new(
2070         {
2071             %$attribute,
2072             ( borrowernumber => $self->borrowernumber ),
2073         }
2074     )->store;
2075
2076 }
2077
2078 =head3 extended_attributes
2079
2080 Return object of Koha::Patron::Attributes type with all attributes set for this patron
2081
2082 Or setter FIXME
2083
2084 =cut
2085
2086 sub extended_attributes {
2087     my ( $self, $attributes ) = @_;
2088     if ($attributes) {    # setter
2089         my $schema = $self->_result->result_source->schema;
2090         $schema->txn_do(
2091             sub {
2092                 # Remove the existing one
2093                 $self->extended_attributes->filter_by_branch_limitations->delete;
2094
2095                 # Insert the new ones
2096                 my $new_types = {};
2097                 for my $attribute (@$attributes) {
2098                     $self->add_extended_attribute($attribute);
2099                     $new_types->{$attribute->{code}} = 1;
2100                 }
2101
2102                 # Check globally mandatory types
2103                 my @required_attribute_types =
2104                     Koha::Patron::Attribute::Types->search(
2105                         {
2106                             mandatory => 1,
2107                             category_code => [ undef, $self->categorycode ],
2108                             'borrower_attribute_types_branches.b_branchcode' =>
2109                               undef,
2110                         },
2111                         { join => 'borrower_attribute_types_branches' }
2112                     )->get_column('code');
2113                 for my $type ( @required_attribute_types ) {
2114                     Koha::Exceptions::Patron::MissingMandatoryExtendedAttribute->throw(
2115                         type => $type,
2116                     ) if !$new_types->{$type};
2117                 }
2118             }
2119         );
2120     }
2121
2122     my $rs = $self->_result->borrower_attributes;
2123     # We call search to use the filters in Koha::Patron::Attributes->search
2124     return Koha::Patron::Attributes->_new_from_dbic($rs)->search;
2125 }
2126
2127 =head3 messages
2128
2129     my $messages = $patron->messages;
2130
2131 Return the message attached to the patron.
2132
2133 =cut
2134
2135 sub messages {
2136     my ( $self ) = @_;
2137     my $messages_rs = $self->_result->messages_borrowernumbers->search;
2138     return Koha::Patron::Messages->_new_from_dbic($messages_rs);
2139 }
2140
2141 =head3 lock
2142
2143     Koha::Patrons->find($id)->lock({ expire => 1, remove => 1 });
2144
2145     Lock and optionally expire a patron account.
2146     Remove holds and article requests if remove flag set.
2147     In order to distinguish from locking by entering a wrong password, let's
2148     call this an administrative lockout.
2149
2150 =cut
2151
2152 sub lock {
2153     my ( $self, $params ) = @_;
2154     $self->login_attempts( ADMINISTRATIVE_LOCKOUT );
2155     if( $params->{expire} ) {
2156         $self->dateexpiry( dt_from_string->subtract(days => 1) );
2157     }
2158     $self->store;
2159     if( $params->{remove} ) {
2160         $self->holds->delete;
2161         $self->article_requests->delete;
2162     }
2163     return $self;
2164 }
2165
2166 =head3 anonymize
2167
2168     Koha::Patrons->find($id)->anonymize;
2169
2170     Anonymize or clear borrower fields. Fields in BorrowerMandatoryField
2171     are randomized, other personal data is cleared too.
2172     Patrons with issues are skipped.
2173
2174 =cut
2175
2176 sub anonymize {
2177     my ( $self ) = @_;
2178     if( $self->_result->issues->count ) {
2179         warn "Exiting anonymize: patron ".$self->borrowernumber." still has issues";
2180         return;
2181     }
2182     # Mandatory fields come from the corresponding pref, but email fields
2183     # are removed since scrambled email addresses only generate errors
2184     my $mandatory = { map { (lc $_, 1); } grep { !/email/ }
2185         split /\s*\|\s*/, C4::Context->preference('BorrowerMandatoryField') };
2186     $mandatory->{userid} = 1; # needed since sub store does not clear field
2187     my @columns = $self->_result->result_source->columns;
2188     @columns = grep { !/borrowernumber|branchcode|categorycode|^date|password|flags|updated_on|lastseen|lang|login_attempts|anonymized|auth_method/ } @columns;
2189     push @columns, 'dateofbirth'; # add this date back in
2190     foreach my $col (@columns) {
2191         $self->_anonymize_column($col, $mandatory->{lc $col} );
2192     }
2193     $self->anonymized(1)->store;
2194 }
2195
2196 sub _anonymize_column {
2197     my ( $self, $col, $mandatory ) = @_;
2198     my $col_info = $self->_result->result_source->column_info($col);
2199     my $type = $col_info->{data_type};
2200     my $nullable = $col_info->{is_nullable};
2201     my $val;
2202     if( $type =~ /char|text/ ) {
2203         $val = $mandatory
2204             ? Koha::Token->new->generate({ pattern => '\w{10}' })
2205             : $nullable
2206             ? undef
2207             : q{};
2208     } elsif( $type =~ /integer|int$|float|dec|double/ ) {
2209         $val = $nullable ? undef : 0;
2210     } elsif( $type =~ /date|time/ ) {
2211         $val = $nullable ? undef : dt_from_string;
2212     }
2213     $self->$col($val);
2214 }
2215
2216 =head3 add_guarantor
2217
2218     my $relationship = $patron->add_guarantor(
2219         {
2220             borrowernumber => $borrowernumber,
2221             relationships  => $relationship,
2222         }
2223     );
2224
2225     Adds a new guarantor to a patron.
2226
2227 =cut
2228
2229 sub add_guarantor {
2230     my ( $self, $params ) = @_;
2231
2232     my $guarantor_id = $params->{guarantor_id};
2233     my $relationship = $params->{relationship};
2234
2235     return Koha::Patron::Relationship->new(
2236         {
2237             guarantee_id => $self->id,
2238             guarantor_id => $guarantor_id,
2239             relationship => $relationship
2240         }
2241     )->store();
2242 }
2243
2244 =head3 get_extended_attribute
2245
2246 my $attribute_value = $patron->get_extended_attribute( $code );
2247
2248 Return the attribute for the code passed in parameter.
2249
2250 It not exist it returns undef
2251
2252 Note that this will not work for repeatable attribute types.
2253
2254 Maybe you certainly not want to use this method, it is actually only used for SHOW_BARCODE
2255 (which should be a real patron's attribute (not extended)
2256
2257 =cut
2258
2259 sub get_extended_attribute {
2260     my ( $self, $code, $value ) = @_;
2261     my $rs = $self->_result->borrower_attributes;
2262     return unless $rs;
2263     my $attribute = $rs->search({ code => $code, ( $value ? ( attribute => $value ) : () ) });
2264     return unless $attribute->count;
2265     return $attribute->next;
2266 }
2267
2268 =head3 set_default_messaging_preferences
2269
2270     $patron->set_default_messaging_preferences
2271
2272 Sets default messaging preferences on patron.
2273
2274 See Koha::Patron::MessagePreference(s) for more documentation, especially on
2275 thrown exceptions.
2276
2277 =cut
2278
2279 sub set_default_messaging_preferences {
2280     my ($self, $categorycode) = @_;
2281
2282     my $options = Koha::Patron::MessagePreferences->get_options;
2283
2284     foreach my $option (@$options) {
2285         # Check that this option has preference configuration for this category
2286         unless (Koha::Patron::MessagePreferences->search({
2287             message_attribute_id => $option->{message_attribute_id},
2288             categorycode         => $categorycode || $self->categorycode,
2289         })->count) {
2290             next;
2291         }
2292
2293         # Delete current setting
2294         Koha::Patron::MessagePreferences->search({
2295              borrowernumber => $self->borrowernumber,
2296              message_attribute_id => $option->{message_attribute_id},
2297         })->delete;
2298
2299         Koha::Patron::MessagePreference->new_from_default({
2300             borrowernumber => $self->borrowernumber,
2301             categorycode   => $categorycode || $self->categorycode,
2302             message_attribute_id => $option->{message_attribute_id},
2303         });
2304     }
2305
2306     return $self;
2307 }
2308
2309 =head3 to_api
2310
2311     my $json = $patron->to_api;
2312
2313 Overloaded method that returns a JSON representation of the Koha::Patron object,
2314 suitable for API output.
2315
2316 =cut
2317
2318 sub to_api {
2319     my ( $self, $params ) = @_;
2320
2321     my $json_patron = $self->SUPER::to_api( $params );
2322
2323     $json_patron->{restricted} = ( $self->is_debarred )
2324                                     ? Mojo::JSON->true
2325                                     : Mojo::JSON->false;
2326
2327     return $json_patron;
2328 }
2329
2330 =head3 to_api_mapping
2331
2332 This method returns the mapping for representing a Koha::Patron object
2333 on the API.
2334
2335 =cut
2336
2337 sub to_api_mapping {
2338     return {
2339         borrowernotes       => 'staff_notes',
2340         borrowernumber      => 'patron_id',
2341         branchcode          => 'library_id',
2342         categorycode        => 'category_id',
2343         checkprevcheckout   => 'check_previous_checkout',
2344         contactfirstname    => undef,                     # Unused
2345         contactname         => undef,                     # Unused
2346         contactnote         => 'altaddress_notes',
2347         contacttitle        => undef,                     # Unused
2348         dateenrolled        => 'date_enrolled',
2349         dateexpiry          => 'expiry_date',
2350         dateofbirth         => 'date_of_birth',
2351         debarred            => undef,                     # replaced by 'restricted'
2352         debarredcomment     => undef,    # calculated, API consumers will use /restrictions instead
2353         emailpro            => 'secondary_email',
2354         flags               => undef,    # permissions manipulation handled in /permissions
2355         gonenoaddress       => 'incorrect_address',
2356         lastseen            => 'last_seen',
2357         lost                => 'patron_card_lost',
2358         opacnote            => 'opac_notes',
2359         othernames          => 'other_name',
2360         password            => undef,            # password manipulation handled in /password
2361         phonepro            => 'secondary_phone',
2362         relationship        => 'relationship_type',
2363         sex                 => 'gender',
2364         smsalertnumber      => 'sms_number',
2365         sort1               => 'statistics_1',
2366         sort2               => 'statistics_2',
2367         autorenew_checkouts => 'autorenew_checkouts',
2368         streetnumber        => 'street_number',
2369         streettype          => 'street_type',
2370         zipcode             => 'postal_code',
2371         B_address           => 'altaddress_address',
2372         B_address2          => 'altaddress_address2',
2373         B_city              => 'altaddress_city',
2374         B_country           => 'altaddress_country',
2375         B_email             => 'altaddress_email',
2376         B_phone             => 'altaddress_phone',
2377         B_state             => 'altaddress_state',
2378         B_streetnumber      => 'altaddress_street_number',
2379         B_streettype        => 'altaddress_street_type',
2380         B_zipcode           => 'altaddress_postal_code',
2381         altcontactaddress1  => 'altcontact_address',
2382         altcontactaddress2  => 'altcontact_address2',
2383         altcontactaddress3  => 'altcontact_city',
2384         altcontactcountry   => 'altcontact_country',
2385         altcontactfirstname => 'altcontact_firstname',
2386         altcontactphone     => 'altcontact_phone',
2387         altcontactsurname   => 'altcontact_surname',
2388         altcontactstate     => 'altcontact_state',
2389         altcontactzipcode   => 'altcontact_postal_code',
2390         password_expiration_date => undef,
2391         primary_contact_method => undef,
2392         secret              => undef,
2393         auth_method         => undef,
2394     };
2395 }
2396
2397 =head3 queue_notice
2398
2399     Koha::Patrons->queue_notice({ letter_params => $letter_params, message_name => 'DUE'});
2400     Koha::Patrons->queue_notice({ letter_params => $letter_params, message_transports => \@message_transports });
2401     Koha::Patrons->queue_notice({ letter_params => $letter_params, message_transports => \@message_transports, test_mode => 1 });
2402
2403     Queue messages to a patron. Can pass a message that is part of the message_attributes
2404     table or supply the transport to use.
2405
2406     If passed a message name we retrieve the patrons preferences for transports
2407     Otherwise we use the supplied transport. In the case of email or sms we fall back to print if
2408     we have no address/number for sending
2409
2410     $letter_params is a hashref of the values to be passed to GetPreparedLetter
2411
2412     test_mode will only report which notices would be sent, but nothing will be queued
2413
2414 =cut
2415
2416 sub queue_notice {
2417     my ( $self, $params ) = @_;
2418     my $letter_params = $params->{letter_params};
2419     my $test_mode = $params->{test_mode};
2420
2421     return unless $letter_params;
2422     return unless exists $params->{message_name} xor $params->{message_transports}; # We only want one of these
2423
2424     my $library = Koha::Libraries->find( $letter_params->{branchcode} );
2425     my $from_email_address = $library->from_email_address;
2426
2427     my @message_transports;
2428     my $letter_code;
2429     $letter_code = $letter_params->{letter_code};
2430     if( $params->{message_name} ){
2431         my $messaging_prefs = C4::Members::Messaging::GetMessagingPreferences( {
2432                 borrowernumber => $letter_params->{borrowernumber},
2433                 message_name => $params->{message_name}
2434         } );
2435         @message_transports = ( keys %{ $messaging_prefs->{transports} } );
2436         $letter_code = $messaging_prefs->{transports}->{$message_transports[0]} unless $letter_code;
2437     } else {
2438         @message_transports = @{$params->{message_transports}};
2439     }
2440     return unless defined $letter_code;
2441     $letter_params->{letter_code} = $letter_code;
2442     my $print_sent = 0;
2443     my %return;
2444     foreach my $mtt (@message_transports){
2445         next if ($mtt eq 'itiva' and C4::Context->preference('TalkingTechItivaPhoneNotification') );
2446         # Notice is handled by TalkingTech_itiva_outbound.pl
2447         if (   ( $mtt eq 'email' and not $self->notice_email_address )
2448             or ( $mtt eq 'sms'   and not $self->smsalertnumber )
2449             or ( $mtt eq 'phone' and not $self->phone ) )
2450         {
2451             push @{ $return{fallback} }, $mtt;
2452             $mtt = 'print';
2453         }
2454         next if $mtt eq 'print' && $print_sent;
2455         $letter_params->{message_transport_type} = $mtt;
2456         my $letter = C4::Letters::GetPreparedLetter( %$letter_params );
2457         C4::Letters::EnqueueLetter({
2458             letter => $letter,
2459             borrowernumber => $self->borrowernumber,
2460             from_address   => $from_email_address,
2461             message_transport_type => $mtt
2462         }) unless $test_mode;
2463         push @{$return{sent}}, $mtt;
2464         $print_sent = 1 if $mtt eq 'print';
2465     }
2466     return \%return;
2467 }
2468
2469 =head3 safe_to_delete
2470
2471     my $result = $patron->safe_to_delete;
2472     if ( $result eq 'has_guarantees' ) { ... }
2473     elsif ( $result ) { ... }
2474     else { # cannot delete }
2475
2476 This method tells if the Koha:Patron object can be deleted. Possible return values
2477
2478 =over 4
2479
2480 =item 'ok'
2481
2482 =item 'has_checkouts'
2483
2484 =item 'has_debt'
2485
2486 =item 'has_guarantees'
2487
2488 =item 'is_anonymous_patron'
2489
2490 =back
2491
2492 =cut
2493
2494 sub safe_to_delete {
2495     my ($self) = @_;
2496
2497     my $anonymous_patron = C4::Context->preference('AnonymousPatron');
2498
2499     my $error;
2500
2501     if ( $anonymous_patron && $self->id eq $anonymous_patron ) {
2502         $error = 'is_anonymous_patron';
2503     }
2504     elsif ( $self->checkouts->count ) {
2505         $error = 'has_checkouts';
2506     }
2507     elsif ( $self->account->outstanding_debits->total_outstanding > 0 ) {
2508         $error = 'has_debt';
2509     }
2510     elsif ( $self->guarantee_relationships->count ) {
2511         $error = 'has_guarantees';
2512     }
2513
2514     if ( $error ) {
2515         return Koha::Result::Boolean->new(0)->add_message({ message => $error });
2516     }
2517
2518     return Koha::Result::Boolean->new(1);
2519 }
2520
2521 =head3 recalls
2522
2523     my $recalls = $patron->recalls;
2524
2525 Return the patron's recalls.
2526
2527 =cut
2528
2529 sub recalls {
2530     my ( $self ) = @_;
2531
2532     return Koha::Recalls->search({ patron_id => $self->borrowernumber });
2533 }
2534
2535 =head3 account_balance
2536
2537     my $balance = $patron->account_balance
2538
2539 Return the patron's account balance
2540
2541 =cut
2542
2543 sub account_balance {
2544     my ($self) = @_;
2545     return $self->account->balance;
2546 }
2547
2548 =head3 notify_library_of_registration
2549
2550 $patron->notify_library_of_registration( $email_patron_registrations );
2551
2552 Send patron registration email to library if EmailPatronRegistrations system preference is enabled.
2553
2554 =cut
2555
2556 sub notify_library_of_registration {
2557     my ( $self, $email_patron_registrations ) = @_;
2558
2559     if (
2560         my $letter = C4::Letters::GetPreparedLetter(
2561             module      => 'members',
2562             letter_code => 'OPAC_REG',
2563             branchcode  => $self->branchcode,
2564             lang        => $self->lang || 'default',
2565             tables      => {
2566                 'borrowers' => $self->borrowernumber
2567             },
2568         )
2569     ) {
2570         my $to_address;
2571         if ( $email_patron_registrations eq "BranchEmailAddress" ) {
2572             my $library = Koha::Libraries->find( $self->branchcode );
2573             $to_address = $library->inbound_email_address;
2574         }
2575         elsif ( $email_patron_registrations eq "KohaAdminEmailAddress" ) {
2576             $to_address = C4::Context->preference('ReplytoDefault')
2577             || C4::Context->preference('KohaAdminEmailAddress');
2578         }
2579         else {
2580             $to_address =
2581                 C4::Context->preference('EmailAddressForPatronRegistrations')
2582                 || C4::Context->preference('ReplytoDefault')
2583                 || C4::Context->preference('KohaAdminEmailAddress');
2584         }
2585
2586         my $message_id = C4::Letters::EnqueueLetter(
2587             {
2588                 letter                 => $letter,
2589                 borrowernumber         => $self->borrowernumber,
2590                 to_address             => $to_address,
2591                 message_transport_type => 'email'
2592             }
2593         ) or warn "can't enqueue letter $letter";
2594         if ( $message_id ) {
2595             return 1;
2596         }
2597     }
2598 }
2599
2600 =head3 has_messaging_preference
2601
2602 my $bool = $patron->has_messaging_preference({
2603     message_name => $message_name, # A value from message_attributes.message_name
2604     message_transport_type => $message_transport_type, # email, sms, phone, itiva, etc...
2605     wants_digest => $wants_digest, # 1 if you are looking for the digest version, don't pass if you just want either
2606 });
2607
2608 =cut
2609
2610 sub has_messaging_preference {
2611     my ( $self, $params ) = @_;
2612
2613     my $message_name           = $params->{message_name};
2614     my $message_transport_type = $params->{message_transport_type};
2615     my $wants_digest           = $params->{wants_digest};
2616
2617     return $self->_result->search_related_rs(
2618         'borrower_message_preferences',
2619         $params,
2620         {
2621             prefetch =>
2622               [ 'borrower_message_transport_preferences', 'message_attribute' ]
2623         }
2624     )->count;
2625 }
2626
2627 =head3 can_patron_change_staff_only_lists
2628
2629 $patron->can_patron_change_staff_only_lists;
2630
2631 Return 1 if a patron has 'Superlibrarian' or 'Catalogue' permission.
2632 Otherwise, return 0.
2633
2634 =cut
2635
2636 sub can_patron_change_staff_only_lists {
2637     my ( $self, $params ) = @_;
2638     return 1 if C4::Auth::haspermission( $self->userid, { 'catalogue' => 1 });
2639     return 0;
2640 }
2641
2642 =head3 can_patron_change_permitted_staff_lists
2643
2644 $patron->can_patron_change_permitted_staff_lists;
2645
2646 Return 1 if a patron has 'Superlibrarian' or 'Catalogue' and 'edit_public_list_contents' permissions.
2647 Otherwise, return 0.
2648
2649 =cut
2650
2651 sub can_patron_change_permitted_staff_lists {
2652     my ( $self, $params ) = @_;
2653     return 1 if C4::Auth::haspermission( $self->userid, { 'catalogue' => 1, lists => 'edit_public_list_contents' } );
2654     return 0;
2655 }
2656
2657 =head3 encode_secret
2658
2659   $patron->encode_secret($secret32);
2660
2661 Secret (TwoFactorAuth expects it in base32 format) is encrypted.
2662 You still need to call ->store.
2663
2664 =cut
2665
2666 sub encode_secret {
2667     my ( $self, $secret ) = @_;
2668     if( $secret ) {
2669         return $self->secret( Koha::Encryption->new->encrypt_hex($secret) );
2670     }
2671     return $self->secret($secret);
2672 }
2673
2674 =head3 decoded_secret
2675
2676   my $secret32 = $patron->decoded_secret;
2677
2678 Decode the patron secret. We expect to get back a base32 string, but this
2679 is not checked here. Caller of encode_secret is responsible for that.
2680
2681 =cut
2682
2683 sub decoded_secret {
2684     my ( $self ) = @_;
2685     if( $self->secret ) {
2686         return Koha::Encryption->new->decrypt_hex( $self->secret );
2687     }
2688     return $self->secret;
2689 }
2690
2691 =head3 virtualshelves
2692
2693     my $shelves = $patron->virtualshelves;
2694
2695 =cut
2696
2697 sub virtualshelves {
2698     my $self = shift;
2699     return Koha::Virtualshelves->_new_from_dbic( scalar $self->_result->virtualshelves );
2700 }
2701
2702 =head3 get_savings
2703
2704     my $savings = $patron->get_savings;
2705
2706 Use the replacement price of patron's old and current issues to calculate how much they have 'saved' by using the library.
2707
2708 =cut
2709
2710 sub get_savings {
2711     my ($self) = @_;
2712
2713     my @itemnumbers = grep { defined $_ } ( $self->old_checkouts->get_column('itemnumber'), $self->checkouts->get_column('itemnumber') );
2714
2715     return Koha::Items->search(
2716         { itemnumber => { -in => \@itemnumbers } },
2717         {   select => [ { sum => 'me.replacementprice' } ],
2718             as     => ['total_savings']
2719         }
2720     )->next->get_column('total_savings') // 0;
2721 }
2722
2723 =head2 Internal methods
2724
2725 =head3 _type
2726
2727 =cut
2728
2729 sub _type {
2730     return 'Borrower';
2731 }
2732
2733 =head1 AUTHORS
2734
2735 Kyle M Hall <kyle@bywatersolutions.com>
2736 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
2737 Martin Renvoize <martin.renvoize@ptfs-europe.com>
2738
2739 =cut
2740
2741 1;