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