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 under the
   9 # terms of the GNU General Public License as published by the Free Software
  10 # Foundation; either version 3 of the License, or (at your option) any later
  11 # version.
  12 #
  13 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  14 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  15 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License along
  18 # with Koha; if not, write to the Free Software Foundation, Inc.,
  19 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  20
  21 use Modern::Perl;
  22
  23 use Carp;
  24 use List::MoreUtils qw( any uniq );
  25 use JSON qw( to_json );
  26 use Text::Unaccent qw( unac_string );
  27
  28 use C4::Context;
  29 use C4::Log;
  30 use Koha::AuthUtils;
  31 use Koha::Checkouts;
  32 use Koha::Database;
  33 use Koha::DateUtils;
  34 use Koha::Exceptions::Password;
  35 use Koha::Holds;
  36 use Koha::Old::Checkouts;
  37 use Koha::Patron::Attributes;
  38 use Koha::Patron::Categories;
  39 use Koha::Patron::HouseboundProfile;
  40 use Koha::Patron::HouseboundRole;
  41 use Koha::Patron::Images;
  42 use Koha::Patrons;
  43 use Koha::Virtualshelves;
  44 use Koha::Club::Enrollments;
  45 use Koha::Account;
  46 use Koha::Subscription::Routinglists;
  47 use Koha::Token;
  48
  49 use base qw(Koha::Object);
  50
  51 use constant ADMINISTRATIVE_LOCKOUT => -1;
  52
  53 our $RESULTSET_PATRON_ID_MAPPING = {
  54     Accountline          => 'borrowernumber',
  55     Aqbasketuser         => 'borrowernumber',
  56     Aqbudget             => 'budget_owner_id',
  57     Aqbudgetborrower     => 'borrowernumber',
  58     ArticleRequest       => 'borrowernumber',
  59     BorrowerAttribute    => 'borrowernumber',
  60     BorrowerDebarment    => 'borrowernumber',
  61     BorrowerFile         => 'borrowernumber',
  62     BorrowerModification => 'borrowernumber',
  63     ClubEnrollment       => 'borrowernumber',
  64     Issue                => 'borrowernumber',
  65     ItemsLastBorrower    => 'borrowernumber',
  66     Linktracker          => 'borrowernumber',
  67     Message              => 'borrowernumber',
  68     MessageQueue         => 'borrowernumber',
  69     OldIssue             => 'borrowernumber',
  70     OldReserve           => 'borrowernumber',
  71     Rating               => 'borrowernumber',
  72     Reserve              => 'borrowernumber',
  73     Review               => 'borrowernumber',
  74     SearchHistory        => 'userid',
  75     Statistic            => 'borrowernumber',
  76     Suggestion           => 'suggestedby',
  77     TagAll               => 'borrowernumber',
  78     Virtualshelfcontent  => 'borrowernumber',
  79     Virtualshelfshare    => 'borrowernumber',
  80     Virtualshelve        => 'owner',
  81 };
  82
  83 =head1 NAME
  84
  85 Koha::Patron - Koha Patron Object class
  86
  87 =head1 API
  88
  89 =head2 Class Methods
  90
  91 =head3 new
  92
  93 =cut
  94
  95 sub new {
  96     my ( $class, $params ) = @_;
  97
  98     return $class->SUPER::new($params);
  99 }
 100
 101 =head3 fixup_cardnumber
 102
 103 Autogenerate next cardnumber from highest value found in database
 104
 105 =cut
 106
 107 sub fixup_cardnumber {
 108     my ( $self ) = @_;
 109     my $max = Koha::Patrons->search({
 110         cardnumber => {-regexp => '^-?[0-9]+$'}
 111     }, {
 112         select => \'CAST(cardnumber AS SIGNED)',
 113         as => ['cast_cardnumber']
 114     })->_resultset->get_column('cast_cardnumber')->max;
 115     $self->cardnumber(($max || 0) +1);
 116 }
 117
 118 =head3 trim_whitespace
 119
 120 trim whitespace from data which has some non-whitespace in it.
 121 Could be moved to Koha::Object if need to be reused
 122
 123 =cut
 124
 125 sub trim_whitespaces {
 126     my( $self ) = @_;
 127
 128     my $schema  = Koha::Database->new->schema;
 129     my @columns = $schema->source($self->_type)->columns;
 130
 131     for my $column( @columns ) {
 132         my $value = $self->$column;
 133         if ( defined $value ) {
 134             $value =~ s/^\s*|\s*$//g;
 135             $self->$column($value);
 136         }
 137     }
 138     return $self;
 139 }
 140
 141 =head3 plain_text_password
 142
 143 $patron->plain_text_password( $password );
 144
 145 stores a copy of the unencrypted password in the object
 146 for use in code before encrypting for db
 147
 148 =cut
 149
 150 sub plain_text_password {
 151     my ( $self, $password ) = @_;
 152     if ( $password ) {
 153         $self->{_plain_text_password} = $password;
 154         return $self;
 155     }
 156     return $self->{_plain_text_password}
 157         if $self->{_plain_text_password};
 158
 159     return;
 160 }
 161
 162 =head3 store
 163
 164 Patron specific store method to cleanup record
 165 and do other necessary things before saving
 166 to db
 167
 168 =cut
 169
 170 sub store {
 171     my ($self) = @_;
 172
 173     $self->_result->result_source->schema->txn_do(
 174         sub {
 175             if (
 176                 C4::Context->preference("autoMemberNum")
 177                 and ( not defined $self->cardnumber
 178                     or $self->cardnumber eq '' )
 179               )
 180             {
 181                 # Warning: The caller is responsible for locking the members table in write
 182                 # mode, to avoid database corruption.
 183                 # We are in a transaction but the table is not locked
 184                 $self->fixup_cardnumber;
 185             }
 186
 187             unless( $self->category->in_storage ) {
 188                 Koha::Exceptions::Object::FKConstraint->throw(
 189                     broken_fk => 'categorycode',
 190                     value     => $self->categorycode,
 191                 );
 192             }
 193
 194             $self->trim_whitespaces;
 195
 196             unless ( $self->in_storage ) {    #AddMember
 197
 198                 # Generate a valid userid/login if needed
 199                 $self->generate_userid
 200                   if not $self->userid or not $self->has_valid_userid;
 201
 202                 # Add expiration date if it isn't already there
 203                 unless ( $self->dateexpiry ) {
 204                     $self->dateexpiry( $self->category->get_expiry_date );
 205                 }
 206
 207                 # Add enrollment date if it isn't already there
 208                 unless ( $self->dateenrolled ) {
 209                     $self->dateenrolled(dt_from_string);
 210                 }
 211
 212                 # Set the privacy depending on the patron's category
 213                 my $default_privacy = $self->category->default_privacy || q{};
 214                 $default_privacy =
 215                     $default_privacy eq 'default' ? 1
 216                   : $default_privacy eq 'never'   ? 2
 217                   : $default_privacy eq 'forever' ? 0
 218                   :                                                   undef;
 219                 $self->privacy($default_privacy);
 220
 221
 222                 # Make a copy of the plain text password for later use
 223                 $self->plain_text_password( $self->password );
 224
 225                 # Create a disabled account if no password provided
 226                 $self->password( $self->password
 227                     ? Koha::AuthUtils::hash_password( $self->password )
 228                     : '!' );
 229
 230                 $self->borrowernumber(undef);
 231
 232                 $self = $self->SUPER::store;
 233
 234                 $self->add_enrolment_fee_if_needed;
 235
 236                 logaction( "MEMBERS", "CREATE", $self->borrowernumber, "" )
 237                   if C4::Context->preference("BorrowersLog");
 238             }
 239             else {    #ModMember
 240
 241                 my $self_from_storage = $self->get_from_storage;
 242                 # FIXME We should not deal with that here, callers have to do this job
 243                 # Moved from ModMember to prevent regressions
 244                 unless ( $self->userid ) {
 245                     my $stored_userid = $self_from_storage->userid;
 246                     $self->userid($stored_userid);
 247                 }
 248
 249                 # Password must be updated using $self->set_password
 250                 $self->password($self_from_storage->password);
 251
 252                 if ( C4::Context->preference('FeeOnChangePatronCategory')
 253                     and $self->category->categorycode ne
 254                     $self_from_storage->category->categorycode )
 255                 {
 256                     $self->add_enrolment_fee_if_needed;
 257                 }
 258
 259                 # Actionlogs
 260                 if ( C4::Context->preference("BorrowersLog") ) {
 261                     my $info;
 262                     my $from_storage = $self_from_storage->unblessed;
 263                     my $from_object  = $self->unblessed;
 264                     my @skip_fields  = (qw/lastseen/);
 265                     for my $key ( keys %{$from_storage} ) {
 266                         next if any { /$key/ } @skip_fields;
 267                         if (
 268                             (
 269                                   !defined( $from_storage->{$key} )
 270                                 && defined( $from_object->{$key} )
 271                             )
 272                             || ( defined( $from_storage->{$key} )
 273                                 && !defined( $from_object->{$key} ) )
 274                             || (
 275                                    defined( $from_storage->{$key} )
 276                                 && defined( $from_object->{$key} )
 277                                 && ( $from_storage->{$key} ne
 278                                     $from_object->{$key} )
 279                             )
 280                           )
 281                         {
 282                             $info->{$key} = {
 283                                 before => $from_storage->{$key},
 284                                 after  => $from_object->{$key}
 285                             };
 286                         }
 287                     }
 288
 289                     if ( defined($info) ) {
 290                         logaction(
 291                             "MEMBERS",
 292                             "MODIFY",
 293                             $self->borrowernumber,
 294                             to_json(
 295                                 $info,
 296                                 { utf8 => 1, pretty => 1, canonical => 1 }
 297                             )
 298                         );
 299                     }
 300                 }
 301
 302                 # Final store
 303                 $self = $self->SUPER::store;
 304             }
 305         }
 306     );
 307     return $self;
 308 }
 309
 310 =head3 delete
 311
 312 $patron->delete
 313
 314 Delete patron's holds, lists and finally the patron.
 315
 316 Lists owned by the borrower are deleted, but entries from the borrower to
 317 other lists are kept.
 318
 319 =cut
 320
 321 sub delete {
 322     my ($self) = @_;
 323
 324     my $deleted;
 325     $self->_result->result_source->schema->txn_do(
 326         sub {
 327             # Delete Patron's holds
 328             $self->holds->delete;
 329
 330             # Delete all lists and all shares of this borrower
 331             # Consistent with the approach Koha uses on deleting individual lists
 332             # Note that entries in virtualshelfcontents added by this borrower to
 333             # lists of others will be handled by a table constraint: the borrower
 334             # is set to NULL in those entries.
 335             # NOTE:
 336             # We could handle the above deletes via a constraint too.
 337             # But a new BZ report 11889 has been opened to discuss another approach.
 338             # Instead of deleting we could also disown lists (based on a pref).
 339             # In that way we could save shared and public lists.
 340             # The current table constraints support that idea now.
 341             # This pref should then govern the results of other routines/methods such as
 342             # Koha::Virtualshelf->new->delete too.
 343             # FIXME Could be $patron->get_lists
 344             $_->delete for Koha::Virtualshelves->search( { owner => $self->borrowernumber } );
 345
 346             $deleted = $self->SUPER::delete;
 347
 348             logaction( "MEMBERS", "DELETE", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog");
 349         }
 350     );
 351     return $deleted;
 352 }
 353
 354
 355 =head3 category
 356
 357 my $patron_category = $patron->category
 358
 359 Return the patron category for this patron
 360
 361 =cut
 362
 363 sub category {
 364     my ( $self ) = @_;
 365     return Koha::Patron::Category->_new_from_dbic( $self->_result->categorycode );
 366 }
 367
 368 =head3 guarantor
 369
 370 Returns a Koha::Patron object for this patron's guarantor
 371
 372 =cut
 373
 374 sub guarantor {
 375     my ( $self ) = @_;
 376
 377     return unless $self->guarantorid();
 378
 379     return Koha::Patrons->find( $self->guarantorid() );
 380 }
 381
 382 sub image {
 383     my ( $self ) = @_;
 384
 385     return scalar Koha::Patron::Images->find( $self->borrowernumber );
 386 }
 387
 388 sub library {
 389     my ( $self ) = @_;
 390     return Koha::Library->_new_from_dbic($self->_result->branchcode);
 391 }
 392
 393 =head3 guarantees
 394
 395 Returns the guarantees (list of Koha::Patron) of this patron
 396
 397 =cut
 398
 399 sub guarantees {
 400     my ( $self ) = @_;
 401
 402     return Koha::Patrons->search( { guarantorid => $self->borrowernumber }, { order_by => { -asc => ['surname','firstname'] } } );
 403 }
 404
 405 =head3 housebound_profile
 406
 407 Returns the HouseboundProfile associated with this patron.
 408
 409 =cut
 410
 411 sub housebound_profile {
 412     my ( $self ) = @_;
 413     my $profile = $self->_result->housebound_profile;
 414     return Koha::Patron::HouseboundProfile->_new_from_dbic($profile)
 415         if ( $profile );
 416     return;
 417 }
 418
 419 =head3 housebound_role
 420
 421 Returns the HouseboundRole associated with this patron.
 422
 423 =cut
 424
 425 sub housebound_role {
 426     my ( $self ) = @_;
 427
 428     my $role = $self->_result->housebound_role;
 429     return Koha::Patron::HouseboundRole->_new_from_dbic($role) if ( $role );
 430     return;
 431 }
 432
 433 =head3 siblings
 434
 435 Returns the siblings of this patron.
 436
 437 =cut
 438
 439 sub siblings {
 440     my ( $self ) = @_;
 441
 442     my $guarantor = $self->guarantor;
 443
 444     return unless $guarantor;
 445
 446     return Koha::Patrons->search(
 447         {
 448             guarantorid => {
 449                 '!=' => undef,
 450                 '=' => $guarantor->id,
 451             },
 452             borrowernumber => {
 453                 '!=' => $self->borrowernumber,
 454             }
 455         }
 456     );
 457 }
 458
 459 =head3 merge_with
 460
 461     my $patron = Koha::Patrons->find($id);
 462     $patron->merge_with( \@patron_ids );
 463
 464     This subroutine merges a list of patrons into the patron record. This is accomplished by finding
 465     all related patron ids for the patrons to be merged in other tables and changing the ids to be that
 466     of the keeper patron.
 467
 468 =cut
 469
 470 sub merge_with {
 471     my ( $self, $patron_ids ) = @_;
 472
 473     my @patron_ids = @{ $patron_ids };
 474
 475     # Ensure the keeper isn't in the list of patrons to merge
 476     @patron_ids = grep { $_ ne $self->id } @patron_ids;
 477
 478     my $schema = Koha::Database->new()->schema();
 479
 480     my $results;
 481
 482     $self->_result->result_source->schema->txn_do( sub {
 483         foreach my $patron_id (@patron_ids) {
 484             my $patron = Koha::Patrons->find( $patron_id );
 485
 486             next unless $patron;
 487
 488             # Unbless for safety, the patron will end up being deleted
 489             $results->{merged}->{$patron_id}->{patron} = $patron->unblessed;
 490
 491             while (my ($r, $field) = each(%$RESULTSET_PATRON_ID_MAPPING)) {
 492                 my $rs = $schema->resultset($r)->search({ $field => $patron_id });
 493                 $results->{merged}->{ $patron_id }->{updated}->{$r} = $rs->count();
 494                 $rs->update({ $field => $self->id });
 495             }
 496
 497             $patron->move_to_deleted();
 498             $patron->delete();
 499         }
 500     });
 501
 502     return $results;
 503 }
 504
 505
 506
 507 =head3 wants_check_for_previous_checkout
 508
 509     $wants_check = $patron->wants_check_for_previous_checkout;
 510
 511 Return 1 if Koha needs to perform PrevIssue checking, else 0.
 512
 513 =cut
 514
 515 sub wants_check_for_previous_checkout {
 516     my ( $self ) = @_;
 517     my $syspref = C4::Context->preference("checkPrevCheckout");
 518
 519     # Simple cases
 520     ## Hard syspref trumps all
 521     return 1 if ($syspref eq 'hardyes');
 522     return 0 if ($syspref eq 'hardno');
 523     ## Now, patron pref trumps all
 524     return 1 if ($self->checkprevcheckout eq 'yes');
 525     return 0 if ($self->checkprevcheckout eq 'no');
 526
 527     # More complex: patron inherits -> determine category preference
 528     my $checkPrevCheckoutByCat = $self->category->checkprevcheckout;
 529     return 1 if ($checkPrevCheckoutByCat eq 'yes');
 530     return 0 if ($checkPrevCheckoutByCat eq 'no');
 531
 532     # Finally: category preference is inherit, default to 0
 533     if ($syspref eq 'softyes') {
 534         return 1;
 535     } else {
 536         return 0;
 537     }
 538 }
 539
 540 =head3 do_check_for_previous_checkout
 541
 542     $do_check = $patron->do_check_for_previous_checkout($item);
 543
 544 Return 1 if the bib associated with $ITEM has previously been checked out to
 545 $PATRON, 0 otherwise.
 546
 547 =cut
 548
 549 sub do_check_for_previous_checkout {
 550     my ( $self, $item ) = @_;
 551
 552     # Find all items for bib and extract item numbers.
 553     my @items = Koha::Items->search({biblionumber => $item->{biblionumber}});
 554     my @item_nos;
 555     foreach my $item (@items) {
 556         push @item_nos, $item->itemnumber;
 557     }
 558
 559     # Create (old)issues search criteria
 560     my $criteria = {
 561         borrowernumber => $self->borrowernumber,
 562         itemnumber => \@item_nos,
 563     };
 564
 565     # Check current issues table
 566     my $issues = Koha::Checkouts->search($criteria);
 567     return 1 if $issues->count; # 0 || N
 568
 569     # Check old issues table
 570     my $old_issues = Koha::Old::Checkouts->search($criteria);
 571     return $old_issues->count;  # 0 || N
 572 }
 573
 574 =head3 is_debarred
 575
 576 my $debarment_expiration = $patron->is_debarred;
 577
 578 Returns the date a patron debarment will expire, or undef if the patron is not
 579 debarred
 580
 581 =cut
 582
 583 sub is_debarred {
 584     my ($self) = @_;
 585
 586     return unless $self->debarred;
 587     return $self->debarred
 588       if $self->debarred =~ '^9999'
 589       or dt_from_string( $self->debarred ) > dt_from_string;
 590     return;
 591 }
 592
 593 =head3 is_expired
 594
 595 my $is_expired = $patron->is_expired;
 596
 597 Returns 1 if the patron is expired or 0;
 598
 599 =cut
 600
 601 sub is_expired {
 602     my ($self) = @_;
 603     return 0 unless $self->dateexpiry;
 604     return 0 if $self->dateexpiry =~ '^9999';
 605     return 1 if dt_from_string( $self->dateexpiry ) < dt_from_string->truncate( to => 'day' );
 606     return 0;
 607 }
 608
 609 =head3 is_going_to_expire
 610
 611 my $is_going_to_expire = $patron->is_going_to_expire;
 612
 613 Returns 1 if the patron is going to expired, depending on the NotifyBorrowerDeparture pref or 0
 614
 615 =cut
 616
 617 sub is_going_to_expire {
 618     my ($self) = @_;
 619
 620     my $delay = C4::Context->preference('NotifyBorrowerDeparture') || 0;
 621
 622     return 0 unless $delay;
 623     return 0 unless $self->dateexpiry;
 624     return 0 if $self->dateexpiry =~ '^9999';
 625     return 1 if dt_from_string( $self->dateexpiry )->subtract( days => $delay ) < dt_from_string->truncate( to => 'day' );
 626     return 0;
 627 }
 628
 629 =head3 set_password
 630
 631     $patron->set_password({ password => $plain_text_password [, skip_validation => 1 ] });
 632
 633 Set the patron's password.
 634
 635 =head4 Exceptions
 636
 637 The passed string is validated against the current password enforcement policy.
 638 Validation can be skipped by passing the I<skip_validation> parameter.
 639
 640 Exceptions are thrown if the password is not good enough.
 641
 642 =over 4
 643
 644 =item Koha::Exceptions::Password::TooShort
 645
 646 =item Koha::Exceptions::Password::WhitespaceCharacters
 647
 648 =item Koha::Exceptions::Password::TooWeak
 649
 650 =back
 651
 652 =cut
 653
 654 sub set_password {
 655     my ( $self, $args ) = @_;
 656
 657     my $password = $args->{password};
 658
 659     unless ( $args->{skip_validation} ) {
 660         my ( $is_valid, $error ) = Koha::AuthUtils::is_password_valid( $password );
 661
 662         if ( !$is_valid ) {
 663             if ( $error eq 'too_short' ) {
 664                 my $min_length = C4::Context->preference('minPasswordLength');
 665                 $min_length = 3 if not $min_length or $min_length < 3;
 666
 667                 my $password_length = length($password);
 668                 Koha::Exceptions::Password::TooShort->throw(
 669                     length => $password_length, min_length => $min_length );
 670             }
 671             elsif ( $error eq 'has_whitespaces' ) {
 672                 Koha::Exceptions::Password::WhitespaceCharacters->throw();
 673             }
 674             elsif ( $error eq 'too_weak' ) {
 675                 Koha::Exceptions::Password::TooWeak->throw();
 676             }
 677         }
 678     }
 679
 680     my $digest = Koha::AuthUtils::hash_password($password);
 681     $self->update(
 682         {   password       => $digest,
 683             login_attempts => 0,
 684         }
 685     );
 686
 687     logaction( "MEMBERS", "CHANGE PASS", $self->borrowernumber, "" )
 688         if C4::Context->preference("BorrowersLog");
 689
 690     return $self;
 691 }
 692
 693
 694 =head3 renew_account
 695
 696 my $new_expiry_date = $patron->renew_account
 697
 698 Extending the subscription to the expiry date.
 699
 700 =cut
 701
 702 sub renew_account {
 703     my ($self) = @_;
 704     my $date;
 705     if ( C4::Context->preference('BorrowerRenewalPeriodBase') eq 'combination' ) {
 706         $date = ( dt_from_string gt dt_from_string( $self->dateexpiry ) ) ? dt_from_string : dt_from_string( $self->dateexpiry );
 707     } else {
 708         $date =
 709             C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry'
 710             ? dt_from_string( $self->dateexpiry )
 711             : dt_from_string;
 712     }
 713     my $expiry_date = $self->category->get_expiry_date($date);
 714
 715     $self->dateexpiry($expiry_date);
 716     $self->date_renewed( dt_from_string() );
 717     $self->store();
 718
 719     $self->add_enrolment_fee_if_needed;
 720
 721     logaction( "MEMBERS", "RENEW", $self->borrowernumber, "Membership renewed" ) if C4::Context->preference("BorrowersLog");
 722     return dt_from_string( $expiry_date )->truncate( to => 'day' );
 723 }
 724
 725 =head3 has_overdues
 726
 727 my $has_overdues = $patron->has_overdues;
 728
 729 Returns the number of patron's overdues
 730
 731 =cut
 732
 733 sub has_overdues {
 734     my ($self) = @_;
 735     my $dtf = Koha::Database->new->schema->storage->datetime_parser;
 736     return $self->_result->issues->search({ date_due => { '<' => $dtf->format_datetime( dt_from_string() ) } })->count;
 737 }
 738
 739 =head3 track_login
 740
 741     $patron->track_login;
 742     $patron->track_login({ force => 1 });
 743
 744     Tracks a (successful) login attempt.
 745     The preference TrackLastPatronActivity must be enabled. Or you
 746     should pass the force parameter.
 747
 748 =cut
 749
 750 sub track_login {
 751     my ( $self, $params ) = @_;
 752     return if
 753         !$params->{force} &&
 754         !C4::Context->preference('TrackLastPatronActivity');
 755     $self->lastseen( dt_from_string() )->store;
 756 }
 757
 758 =head3 move_to_deleted
 759
 760 my $is_moved = $patron->move_to_deleted;
 761
 762 Move a patron to the deletedborrowers table.
 763 This can be done before deleting a patron, to make sure the data are not completely deleted.
 764
 765 =cut
 766
 767 sub move_to_deleted {
 768     my ($self) = @_;
 769     my $patron_infos = $self->unblessed;
 770     delete $patron_infos->{updated_on}; #This ensures the updated_on date in deletedborrowers will be set to the current timestamp
 771     return Koha::Database->new->schema->resultset('Deletedborrower')->create($patron_infos);
 772 }
 773
 774 =head3 article_requests
 775
 776 my @requests = $borrower->article_requests();
 777 my $requests = $borrower->article_requests();
 778
 779 Returns either a list of ArticleRequests objects,
 780 or an ArtitleRequests object, depending on the
 781 calling context.
 782
 783 =cut
 784
 785 sub article_requests {
 786     my ( $self ) = @_;
 787
 788     $self->{_article_requests} ||= Koha::ArticleRequests->search({ borrowernumber => $self->borrowernumber() });
 789
 790     return $self->{_article_requests};
 791 }
 792
 793 =head3 article_requests_current
 794
 795 my @requests = $patron->article_requests_current
 796
 797 Returns the article requests associated with this patron that are incomplete
 798
 799 =cut
 800
 801 sub article_requests_current {
 802     my ( $self ) = @_;
 803
 804     $self->{_article_requests_current} ||= Koha::ArticleRequests->search(
 805         {
 806             borrowernumber => $self->id(),
 807             -or          => [
 808                 { status => Koha::ArticleRequest::Status::Pending },
 809                 { status => Koha::ArticleRequest::Status::Processing }
 810             ]
 811         }
 812     );
 813
 814     return $self->{_article_requests_current};
 815 }
 816
 817 =head3 article_requests_finished
 818
 819 my @requests = $biblio->article_requests_finished
 820
 821 Returns the article requests associated with this patron that are completed
 822
 823 =cut
 824
 825 sub article_requests_finished {
 826     my ( $self, $borrower ) = @_;
 827
 828     $self->{_article_requests_finished} ||= Koha::ArticleRequests->search(
 829         {
 830             borrowernumber => $self->id(),
 831             -or          => [
 832                 { status => Koha::ArticleRequest::Status::Completed },
 833                 { status => Koha::ArticleRequest::Status::Canceled }
 834             ]
 835         }
 836     );
 837
 838     return $self->{_article_requests_finished};
 839 }
 840
 841 =head3 add_enrolment_fee_if_needed
 842
 843 my $enrolment_fee = $patron->add_enrolment_fee_if_needed;
 844
 845 Add enrolment fee for a patron if needed.
 846
 847 =cut
 848
 849 sub add_enrolment_fee_if_needed {
 850     my ($self) = @_;
 851     my $enrolment_fee = $self->category->enrolmentfee;
 852     if ( $enrolment_fee && $enrolment_fee > 0 ) {
 853         $self->account->add_debit(
 854             {
 855                 amount     => $enrolment_fee,
 856                 user_id    => C4::Context->userenv ? C4::Context->userenv->{'number'} : undef,
 857                 interface  => C4::Context->interface,
 858                 library_id => C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef,
 859                 type       => 'account'
 860             }
 861         );
 862     }
 863     return $enrolment_fee || 0;
 864 }
 865
 866 =head3 checkouts
 867
 868 my $checkouts = $patron->checkouts
 869
 870 =cut
 871
 872 sub checkouts {
 873     my ($self) = @_;
 874     my $checkouts = $self->_result->issues;
 875     return Koha::Checkouts->_new_from_dbic( $checkouts );
 876 }
 877
 878 =head3 pending_checkouts
 879
 880 my $pending_checkouts = $patron->pending_checkouts
 881
 882 This method will return the same as $self->checkouts, but with a prefetch on
 883 items, biblio and biblioitems.
 884
 885 It has been introduced to replaced the C4::Members::GetPendingIssues subroutine
 886
 887 It should not be used directly, prefer to access fields you need instead of
 888 retrieving all these fields in one go.
 889
 890 =cut
 891
 892 sub pending_checkouts {
 893     my( $self ) = @_;
 894     my $checkouts = $self->_result->issues->search(
 895         {},
 896         {
 897             order_by => [
 898                 { -desc => 'me.timestamp' },
 899                 { -desc => 'issuedate' },
 900                 { -desc => 'issue_id' }, # Sort by issue_id should be enough
 901             ],
 902             prefetch => { item => { biblio => 'biblioitems' } },
 903         }
 904     );
 905     return Koha::Checkouts->_new_from_dbic( $checkouts );
 906 }
 907
 908 =head3 old_checkouts
 909
 910 my $old_checkouts = $patron->old_checkouts
 911
 912 =cut
 913
 914 sub old_checkouts {
 915     my ($self) = @_;
 916     my $old_checkouts = $self->_result->old_issues;
 917     return Koha::Old::Checkouts->_new_from_dbic( $old_checkouts );
 918 }
 919
 920 =head3 get_overdues
 921
 922 my $overdue_items = $patron->get_overdues
 923
 924 Return the overdue items
 925
 926 =cut
 927
 928 sub get_overdues {
 929     my ($self) = @_;
 930     my $dtf = Koha::Database->new->schema->storage->datetime_parser;
 931     return $self->checkouts->search(
 932         {
 933             'me.date_due' => { '<' => $dtf->format_datetime(dt_from_string) },
 934         },
 935         {
 936             prefetch => { item => { biblio => 'biblioitems' } },
 937         }
 938     );
 939 }
 940
 941 =head3 get_routing_lists
 942
 943 my @routinglists = $patron->get_routing_lists
 944
 945 Returns the routing lists a patron is subscribed to.
 946
 947 =cut
 948
 949 sub get_routing_lists {
 950     my ($self) = @_;
 951     my $routing_list_rs = $self->_result->subscriptionroutinglists;
 952     return Koha::Subscription::Routinglists->_new_from_dbic($routing_list_rs);
 953 }
 954
 955 =head3 get_age
 956
 957 my $age = $patron->get_age
 958
 959 Return the age of the patron
 960
 961 =cut
 962
 963 sub get_age {
 964     my ($self)    = @_;
 965     my $today_str = dt_from_string->strftime("%Y-%m-%d");
 966     return unless $self->dateofbirth;
 967     my $dob_str   = dt_from_string( $self->dateofbirth )->strftime("%Y-%m-%d");
 968
 969     my ( $dob_y,   $dob_m,   $dob_d )   = split /-/, $dob_str;
 970     my ( $today_y, $today_m, $today_d ) = split /-/, $today_str;
 971
 972     my $age = $today_y - $dob_y;
 973     if ( $dob_m . $dob_d > $today_m . $today_d ) {
 974         $age--;
 975     }
 976
 977     return $age;
 978 }
 979
 980 =head3 account
 981
 982 my $account = $patron->account
 983
 984 =cut
 985
 986 sub account {
 987     my ($self) = @_;
 988     return Koha::Account->new( { patron_id => $self->borrowernumber } );
 989 }
 990
 991 =head3 holds
 992
 993 my $holds = $patron->holds
 994
 995 Return all the holds placed by this patron
 996
 997 =cut
 998
 999 sub holds {
1000     my ($self) = @_;
1001     my $holds_rs = $self->_result->reserves->search( {}, { order_by => 'reservedate' } );
1002     return Koha::Holds->_new_from_dbic($holds_rs);
1003 }
1004
1005 =head3 old_holds
1006
1007 my $old_holds = $patron->old_holds
1008
1009 Return all the historical holds for this patron
1010
1011 =cut
1012
1013 sub old_holds {
1014     my ($self) = @_;
1015     my $old_holds_rs = $self->_result->old_reserves->search( {}, { order_by => 'reservedate' } );
1016     return Koha::Old::Holds->_new_from_dbic($old_holds_rs);
1017 }
1018
1019 =head3 notice_email_address
1020
1021   my $email = $patron->notice_email_address;
1022
1023 Return the email address of patron used for notices.
1024 Returns the empty string if no email address.
1025
1026 =cut
1027
1028 sub notice_email_address{
1029     my ( $self ) = @_;
1030
1031     my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
1032     # if syspref is set to 'first valid' (value == OFF), look up email address
1033     if ( $which_address eq 'OFF' ) {
1034         return $self->first_valid_email_address;
1035     }
1036
1037     return $self->$which_address || '';
1038 }
1039
1040 =head3 first_valid_email_address
1041
1042 my $first_valid_email_address = $patron->first_valid_email_address
1043
1044 Return the first valid email address for a patron.
1045 For now, the order  is defined as email, emailpro, B_email.
1046 Returns the empty string if the borrower has no email addresses.
1047
1048 =cut
1049
1050 sub first_valid_email_address {
1051     my ($self) = @_;
1052
1053     return $self->email() || $self->emailpro() || $self->B_email() || q{};
1054 }
1055
1056 =head3 get_club_enrollments
1057
1058 =cut
1059
1060 sub get_club_enrollments {
1061     my ( $self, $return_scalar ) = @_;
1062
1063     my $e = Koha::Club::Enrollments->search( { borrowernumber => $self->borrowernumber(), date_canceled => undef } );
1064
1065     return $e if $return_scalar;
1066
1067     return wantarray ? $e->as_list : $e;
1068 }
1069
1070 =head3 get_enrollable_clubs
1071
1072 =cut
1073
1074 sub get_enrollable_clubs {
1075     my ( $self, $is_enrollable_from_opac, $return_scalar ) = @_;
1076
1077     my $params;
1078     $params->{is_enrollable_from_opac} = $is_enrollable_from_opac
1079       if $is_enrollable_from_opac;
1080     $params->{is_email_required} = 0 unless $self->first_valid_email_address();
1081
1082     $params->{borrower} = $self;
1083
1084     my $e = Koha::Clubs->get_enrollable($params);
1085
1086     return $e if $return_scalar;
1087
1088     return wantarray ? $e->as_list : $e;
1089 }
1090
1091 =head3 account_locked
1092
1093 my $is_locked = $patron->account_locked
1094
1095 Return true if the patron has reached the maximum number of login attempts
1096 (see pref FailedLoginAttempts). If login_attempts is < 0, this is interpreted
1097 as an administrative lockout (independent of FailedLoginAttempts; see also
1098 Koha::Patron->lock).
1099 Otherwise return false.
1100 If the pref is not set (empty string, null or 0), the feature is considered as
1101 disabled.
1102
1103 =cut
1104
1105 sub account_locked {
1106     my ($self) = @_;
1107     my $FailedLoginAttempts = C4::Context->preference('FailedLoginAttempts');
1108     return 1 if $FailedLoginAttempts
1109           and $self->login_attempts
1110           and $self->login_attempts >= $FailedLoginAttempts;
1111     return 1 if ($self->login_attempts || 0) < 0; # administrative lockout
1112     return 0;
1113 }
1114
1115 =head3 can_see_patron_infos
1116
1117 my $can_see = $patron->can_see_patron_infos( $patron );
1118
1119 Return true if the patron (usually the logged in user) can see the patron's infos for a given patron
1120
1121 =cut
1122
1123 sub can_see_patron_infos {
1124     my ( $self, $patron ) = @_;
1125     return unless $patron;
1126     return $self->can_see_patrons_from( $patron->library->branchcode );
1127 }
1128
1129 =head3 can_see_patrons_from
1130
1131 my $can_see = $patron->can_see_patrons_from( $branchcode );
1132
1133 Return true if the patron (usually the logged in user) can see the patron's infos from a given library
1134
1135 =cut
1136
1137 sub can_see_patrons_from {
1138     my ( $self, $branchcode ) = @_;
1139     my $can = 0;
1140     if ( $self->branchcode eq $branchcode ) {
1141         $can = 1;
1142     } elsif ( $self->has_permission( { borrowers => 'view_borrower_infos_from_any_libraries' } ) ) {
1143         $can = 1;
1144     } elsif ( my $library_groups = $self->library->library_groups ) {
1145         while ( my $library_group = $library_groups->next ) {
1146             if ( $library_group->parent->has_child( $branchcode ) ) {
1147                 $can = 1;
1148                 last;
1149             }
1150         }
1151     }
1152     return $can;
1153 }
1154
1155 =head3 libraries_where_can_see_patrons
1156
1157 my $libraries = $patron-libraries_where_can_see_patrons;
1158
1159 Return the list of branchcodes(!) of libraries the patron is allowed to see other patron's infos.
1160 The branchcodes are arbitrarily returned sorted.
1161 We are supposing here that the object is related to the logged in patron (use of C4::Context::only_my_library)
1162
1163 An empty array means no restriction, the patron can see patron's infos from any libraries.
1164
1165 =cut
1166
1167 sub libraries_where_can_see_patrons {
1168     my ( $self ) = @_;
1169     my $userenv = C4::Context->userenv;
1170
1171     return () unless $userenv; # For tests, but userenv should be defined in tests...
1172
1173     my @restricted_branchcodes;
1174     if (C4::Context::only_my_library) {
1175         push @restricted_branchcodes, $self->branchcode;
1176     }
1177     else {
1178         unless (
1179             $self->has_permission(
1180                 { borrowers => 'view_borrower_infos_from_any_libraries' }
1181             )
1182           )
1183         {
1184             my $library_groups = $self->library->library_groups({ ft_hide_patron_info => 1 });
1185             if ( $library_groups->count )
1186             {
1187                 while ( my $library_group = $library_groups->next ) {
1188                     my $parent = $library_group->parent;
1189                     if ( $parent->has_child( $self->branchcode ) ) {
1190                         push @restricted_branchcodes, $parent->children->get_column('branchcode');
1191                     }
1192                 }
1193             }
1194
1195             @restricted_branchcodes = ( $self->branchcode ) unless @restricted_branchcodes;
1196         }
1197     }
1198
1199     @restricted_branchcodes = grep { defined $_ } @restricted_branchcodes;
1200     @restricted_branchcodes = uniq(@restricted_branchcodes);
1201     @restricted_branchcodes = sort(@restricted_branchcodes);
1202     return @restricted_branchcodes;
1203 }
1204
1205 sub has_permission {
1206     my ( $self, $flagsrequired ) = @_;
1207     return unless $self->userid;
1208     # TODO code from haspermission needs to be moved here!
1209     return C4::Auth::haspermission( $self->userid, $flagsrequired );
1210 }
1211
1212 =head3 is_adult
1213
1214 my $is_adult = $patron->is_adult
1215
1216 Return true if the patron has a category with a type Adult (A) or Organization (I)
1217
1218 =cut
1219
1220 sub is_adult {
1221     my ( $self ) = @_;
1222     return $self->category->category_type =~ /^(A|I)$/ ? 1 : 0;
1223 }
1224
1225 =head3 is_child
1226
1227 my $is_child = $patron->is_child
1228
1229 Return true if the patron has a category with a type Child (C)
1230
1231 =cut
1232
1233 sub is_child {
1234     my( $self ) = @_;
1235     return $self->category->category_type eq 'C' ? 1 : 0;
1236 }
1237
1238 =head3 has_valid_userid
1239
1240 my $patron = Koha::Patrons->find(42);
1241 $patron->userid( $new_userid );
1242 my $has_a_valid_userid = $patron->has_valid_userid
1243
1244 my $patron = Koha::Patron->new( $params );
1245 my $has_a_valid_userid = $patron->has_valid_userid
1246
1247 Return true if the current userid of this patron is valid/unique, otherwise false.
1248
1249 Note that this should be done in $self->store instead and raise an exception if needed.
1250
1251 =cut
1252
1253 sub has_valid_userid {
1254     my ($self) = @_;
1255
1256     return 0 unless $self->userid;
1257
1258     return 0 if ( $self->userid eq C4::Context->config('user') );    # DB user
1259
1260     my $already_exists = Koha::Patrons->search(
1261         {
1262             userid => $self->userid,
1263             (
1264                 $self->in_storage
1265                 ? ( borrowernumber => { '!=' => $self->borrowernumber } )
1266                 : ()
1267             ),
1268         }
1269     )->count;
1270     return $already_exists ? 0 : 1;
1271 }
1272
1273 =head3 generate_userid
1274
1275 my $patron = Koha::Patron->new( $params );
1276 $patron->generate_userid
1277
1278 Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
1279
1280 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).
1281
1282 =cut
1283
1284 sub generate_userid {
1285     my ($self) = @_;
1286     my $offset = 0;
1287     my $firstname = $self->firstname // q{};
1288     my $surname = $self->surname // q{};
1289     #The script will "do" the following code and increment the $offset until the generated userid is unique
1290     do {
1291       $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1292       $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1293       my $userid = lc(($firstname)? "$firstname.$surname" : $surname);
1294       $userid = unac_string('utf-8',$userid);
1295       $userid .= $offset unless $offset == 0;
1296       $self->userid( $userid );
1297       $offset++;
1298      } while (! $self->has_valid_userid );
1299
1300      return $self;
1301
1302 }
1303
1304 =head3 attributes
1305
1306 my $attributes = $patron->attributes
1307
1308 Return object of Koha::Patron::Attributes type with all attributes set for this patron
1309
1310 =cut
1311
1312 sub attributes {
1313     my ( $self ) = @_;
1314     return Koha::Patron::Attributes->search({
1315         borrowernumber => $self->borrowernumber,
1316         branchcode     => $self->branchcode,
1317     });
1318 }
1319
1320 =head3 lock
1321
1322     Koha::Patrons->find($id)->lock({ expire => 1, remove => 1 });
1323
1324     Lock and optionally expire a patron account.
1325     Remove holds and article requests if remove flag set.
1326     In order to distinguish from locking by entering a wrong password, let's
1327     call this an administrative lockout.
1328
1329 =cut
1330
1331 sub lock {
1332     my ( $self, $params ) = @_;
1333     $self->login_attempts( ADMINISTRATIVE_LOCKOUT );
1334     if( $params->{expire} ) {
1335         $self->dateexpiry( dt_from_string->subtract(days => 1) );
1336     }
1337     $self->store;
1338     if( $params->{remove} ) {
1339         $self->holds->delete;
1340         $self->article_requests->delete;
1341     }
1342     return $self;
1343 }
1344
1345 =head3 anonymize
1346
1347     Koha::Patrons->find($id)->anonymize;
1348
1349     Anonymize or clear borrower fields. Fields in BorrowerMandatoryField
1350     are randomized, other personal data is cleared too.
1351     Patrons with issues are skipped.
1352
1353 =cut
1354
1355 sub anonymize {
1356     my ( $self ) = @_;
1357     if( $self->_result->issues->count ) {
1358         warn "Exiting anonymize: patron ".$self->borrowernumber." still has issues";
1359         return;
1360     }
1361     # Mandatory fields come from the corresponding pref, but email fields
1362     # are removed since scrambled email addresses only generate errors
1363     my $mandatory = { map { (lc $_, 1); } grep { !/email/ }
1364         split /\s*\|\s*/, C4::Context->preference('BorrowerMandatoryField') };
1365     $mandatory->{userid} = 1; # needed since sub store does not clear field
1366     my @columns = $self->_result->result_source->columns;
1367     @columns = grep { !/borrowernumber|branchcode|categorycode|^date|password|flags|updated_on|lastseen|lang|login_attempts|anonymized/ } @columns;
1368     push @columns, 'dateofbirth'; # add this date back in
1369     foreach my $col (@columns) {
1370         $self->_anonymize_column($col, $mandatory->{lc $col} );
1371     }
1372     $self->anonymized(1)->store;
1373 }
1374
1375 sub _anonymize_column {
1376     my ( $self, $col, $mandatory ) = @_;
1377     my $col_info = $self->_result->result_source->column_info($col);
1378     my $type = $col_info->{data_type};
1379     my $nullable = $col_info->{is_nullable};
1380     my $val;
1381     if( $type =~ /char|text/ ) {
1382         $val = $mandatory
1383             ? Koha::Token->new->generate({ pattern => '\w{10}' })
1384             : $nullable
1385             ? undef
1386             : q{};
1387     } elsif( $type =~ /integer|int$|float|dec|double/ ) {
1388         $val = $nullable ? undef : 0;
1389     } elsif( $type =~ /date|time/ ) {
1390         $val = $nullable ? undef : dt_from_string;
1391     }
1392     $self->$col($val);
1393 }
1394
1395 =head2 Internal methods
1396
1397 =head3 _type
1398
1399 =cut
1400
1401 sub _type {
1402     return 'Borrower';
1403 }
1404
1405 =head1 AUTHORS
1406
1407 Kyle M Hall <kyle@bywatersolutions.com>
1408 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
1409 Martin Renvoize <martin.renvoize@ptfs-europe.com>
1410
1411 =cut
1412
1413 1;