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 is_valid_age
 981
 982 my $is_valid = $patron->is_valid_age
 983
 984 Return 1 if patron's age is between allowed limits, returns 0 if it's not.
 985
 986 =cut
 987
 988 sub is_valid_age {
 989     my ($self) = @_;
 990     my $age = $self->get_age;
 991
 992     my $patroncategory = $self->category;
 993     my ($low,$high) = ($patroncategory->dateofbirthrequired, $patroncategory->upperagelimit);
 994
 995     return (defined($age) && (($high && ($age > $high)) or ($age < $low))) ? 0 : 1;
 996 }
 997
 998 =head3 account
 999
1000 my $account = $patron->account
1001
1002 =cut
1003
1004 sub account {
1005     my ($self) = @_;
1006     return Koha::Account->new( { patron_id => $self->borrowernumber } );
1007 }
1008
1009 =head3 holds
1010
1011 my $holds = $patron->holds
1012
1013 Return all the holds placed by this patron
1014
1015 =cut
1016
1017 sub holds {
1018     my ($self) = @_;
1019     my $holds_rs = $self->_result->reserves->search( {}, { order_by => 'reservedate' } );
1020     return Koha::Holds->_new_from_dbic($holds_rs);
1021 }
1022
1023 =head3 old_holds
1024
1025 my $old_holds = $patron->old_holds
1026
1027 Return all the historical holds for this patron
1028
1029 =cut
1030
1031 sub old_holds {
1032     my ($self) = @_;
1033     my $old_holds_rs = $self->_result->old_reserves->search( {}, { order_by => 'reservedate' } );
1034     return Koha::Old::Holds->_new_from_dbic($old_holds_rs);
1035 }
1036
1037 =head3 notice_email_address
1038
1039   my $email = $patron->notice_email_address;
1040
1041 Return the email address of patron used for notices.
1042 Returns the empty string if no email address.
1043
1044 =cut
1045
1046 sub notice_email_address{
1047     my ( $self ) = @_;
1048
1049     my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
1050     # if syspref is set to 'first valid' (value == OFF), look up email address
1051     if ( $which_address eq 'OFF' ) {
1052         return $self->first_valid_email_address;
1053     }
1054
1055     return $self->$which_address || '';
1056 }
1057
1058 =head3 first_valid_email_address
1059
1060 my $first_valid_email_address = $patron->first_valid_email_address
1061
1062 Return the first valid email address for a patron.
1063 For now, the order  is defined as email, emailpro, B_email.
1064 Returns the empty string if the borrower has no email addresses.
1065
1066 =cut
1067
1068 sub first_valid_email_address {
1069     my ($self) = @_;
1070
1071     return $self->email() || $self->emailpro() || $self->B_email() || q{};
1072 }
1073
1074 =head3 get_club_enrollments
1075
1076 =cut
1077
1078 sub get_club_enrollments {
1079     my ( $self, $return_scalar ) = @_;
1080
1081     my $e = Koha::Club::Enrollments->search( { borrowernumber => $self->borrowernumber(), date_canceled => undef } );
1082
1083     return $e if $return_scalar;
1084
1085     return wantarray ? $e->as_list : $e;
1086 }
1087
1088 =head3 get_enrollable_clubs
1089
1090 =cut
1091
1092 sub get_enrollable_clubs {
1093     my ( $self, $is_enrollable_from_opac, $return_scalar ) = @_;
1094
1095     my $params;
1096     $params->{is_enrollable_from_opac} = $is_enrollable_from_opac
1097       if $is_enrollable_from_opac;
1098     $params->{is_email_required} = 0 unless $self->first_valid_email_address();
1099
1100     $params->{borrower} = $self;
1101
1102     my $e = Koha::Clubs->get_enrollable($params);
1103
1104     return $e if $return_scalar;
1105
1106     return wantarray ? $e->as_list : $e;
1107 }
1108
1109 =head3 account_locked
1110
1111 my $is_locked = $patron->account_locked
1112
1113 Return true if the patron has reached the maximum number of login attempts
1114 (see pref FailedLoginAttempts). If login_attempts is < 0, this is interpreted
1115 as an administrative lockout (independent of FailedLoginAttempts; see also
1116 Koha::Patron->lock).
1117 Otherwise return false.
1118 If the pref is not set (empty string, null or 0), the feature is considered as
1119 disabled.
1120
1121 =cut
1122
1123 sub account_locked {
1124     my ($self) = @_;
1125     my $FailedLoginAttempts = C4::Context->preference('FailedLoginAttempts');
1126     return 1 if $FailedLoginAttempts
1127           and $self->login_attempts
1128           and $self->login_attempts >= $FailedLoginAttempts;
1129     return 1 if ($self->login_attempts || 0) < 0; # administrative lockout
1130     return 0;
1131 }
1132
1133 =head3 can_see_patron_infos
1134
1135 my $can_see = $patron->can_see_patron_infos( $patron );
1136
1137 Return true if the patron (usually the logged in user) can see the patron's infos for a given patron
1138
1139 =cut
1140
1141 sub can_see_patron_infos {
1142     my ( $self, $patron ) = @_;
1143     return unless $patron;
1144     return $self->can_see_patrons_from( $patron->library->branchcode );
1145 }
1146
1147 =head3 can_see_patrons_from
1148
1149 my $can_see = $patron->can_see_patrons_from( $branchcode );
1150
1151 Return true if the patron (usually the logged in user) can see the patron's infos from a given library
1152
1153 =cut
1154
1155 sub can_see_patrons_from {
1156     my ( $self, $branchcode ) = @_;
1157     my $can = 0;
1158     if ( $self->branchcode eq $branchcode ) {
1159         $can = 1;
1160     } elsif ( $self->has_permission( { borrowers => 'view_borrower_infos_from_any_libraries' } ) ) {
1161         $can = 1;
1162     } elsif ( my $library_groups = $self->library->library_groups ) {
1163         while ( my $library_group = $library_groups->next ) {
1164             if ( $library_group->parent->has_child( $branchcode ) ) {
1165                 $can = 1;
1166                 last;
1167             }
1168         }
1169     }
1170     return $can;
1171 }
1172
1173 =head3 libraries_where_can_see_patrons
1174
1175 my $libraries = $patron-libraries_where_can_see_patrons;
1176
1177 Return the list of branchcodes(!) of libraries the patron is allowed to see other patron's infos.
1178 The branchcodes are arbitrarily returned sorted.
1179 We are supposing here that the object is related to the logged in patron (use of C4::Context::only_my_library)
1180
1181 An empty array means no restriction, the patron can see patron's infos from any libraries.
1182
1183 =cut
1184
1185 sub libraries_where_can_see_patrons {
1186     my ( $self ) = @_;
1187     my $userenv = C4::Context->userenv;
1188
1189     return () unless $userenv; # For tests, but userenv should be defined in tests...
1190
1191     my @restricted_branchcodes;
1192     if (C4::Context::only_my_library) {
1193         push @restricted_branchcodes, $self->branchcode;
1194     }
1195     else {
1196         unless (
1197             $self->has_permission(
1198                 { borrowers => 'view_borrower_infos_from_any_libraries' }
1199             )
1200           )
1201         {
1202             my $library_groups = $self->library->library_groups({ ft_hide_patron_info => 1 });
1203             if ( $library_groups->count )
1204             {
1205                 while ( my $library_group = $library_groups->next ) {
1206                     my $parent = $library_group->parent;
1207                     if ( $parent->has_child( $self->branchcode ) ) {
1208                         push @restricted_branchcodes, $parent->children->get_column('branchcode');
1209                     }
1210                 }
1211             }
1212
1213             @restricted_branchcodes = ( $self->branchcode ) unless @restricted_branchcodes;
1214         }
1215     }
1216
1217     @restricted_branchcodes = grep { defined $_ } @restricted_branchcodes;
1218     @restricted_branchcodes = uniq(@restricted_branchcodes);
1219     @restricted_branchcodes = sort(@restricted_branchcodes);
1220     return @restricted_branchcodes;
1221 }
1222
1223 sub has_permission {
1224     my ( $self, $flagsrequired ) = @_;
1225     return unless $self->userid;
1226     # TODO code from haspermission needs to be moved here!
1227     return C4::Auth::haspermission( $self->userid, $flagsrequired );
1228 }
1229
1230 =head3 is_adult
1231
1232 my $is_adult = $patron->is_adult
1233
1234 Return true if the patron has a category with a type Adult (A) or Organization (I)
1235
1236 =cut
1237
1238 sub is_adult {
1239     my ( $self ) = @_;
1240     return $self->category->category_type =~ /^(A|I)$/ ? 1 : 0;
1241 }
1242
1243 =head3 is_child
1244
1245 my $is_child = $patron->is_child
1246
1247 Return true if the patron has a category with a type Child (C)
1248
1249 =cut
1250
1251 sub is_child {
1252     my( $self ) = @_;
1253     return $self->category->category_type eq 'C' ? 1 : 0;
1254 }
1255
1256 =head3 has_valid_userid
1257
1258 my $patron = Koha::Patrons->find(42);
1259 $patron->userid( $new_userid );
1260 my $has_a_valid_userid = $patron->has_valid_userid
1261
1262 my $patron = Koha::Patron->new( $params );
1263 my $has_a_valid_userid = $patron->has_valid_userid
1264
1265 Return true if the current userid of this patron is valid/unique, otherwise false.
1266
1267 Note that this should be done in $self->store instead and raise an exception if needed.
1268
1269 =cut
1270
1271 sub has_valid_userid {
1272     my ($self) = @_;
1273
1274     return 0 unless $self->userid;
1275
1276     return 0 if ( $self->userid eq C4::Context->config('user') );    # DB user
1277
1278     my $already_exists = Koha::Patrons->search(
1279         {
1280             userid => $self->userid,
1281             (
1282                 $self->in_storage
1283                 ? ( borrowernumber => { '!=' => $self->borrowernumber } )
1284                 : ()
1285             ),
1286         }
1287     )->count;
1288     return $already_exists ? 0 : 1;
1289 }
1290
1291 =head3 generate_userid
1292
1293 my $patron = Koha::Patron->new( $params );
1294 $patron->generate_userid
1295
1296 Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
1297
1298 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).
1299
1300 =cut
1301
1302 sub generate_userid {
1303     my ($self) = @_;
1304     my $offset = 0;
1305     my $firstname = $self->firstname // q{};
1306     my $surname = $self->surname // q{};
1307     #The script will "do" the following code and increment the $offset until the generated userid is unique
1308     do {
1309       $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1310       $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1311       my $userid = lc(($firstname)? "$firstname.$surname" : $surname);
1312       $userid = unac_string('utf-8',$userid);
1313       $userid .= $offset unless $offset == 0;
1314       $self->userid( $userid );
1315       $offset++;
1316      } while (! $self->has_valid_userid );
1317
1318      return $self;
1319
1320 }
1321
1322 =head3 attributes
1323
1324 my $attributes = $patron->attributes
1325
1326 Return object of Koha::Patron::Attributes type with all attributes set for this patron
1327
1328 =cut
1329
1330 sub attributes {
1331     my ( $self ) = @_;
1332     return Koha::Patron::Attributes->search({
1333         borrowernumber => $self->borrowernumber,
1334         branchcode     => $self->branchcode,
1335     });
1336 }
1337
1338 =head3 lock
1339
1340     Koha::Patrons->find($id)->lock({ expire => 1, remove => 1 });
1341
1342     Lock and optionally expire a patron account.
1343     Remove holds and article requests if remove flag set.
1344     In order to distinguish from locking by entering a wrong password, let's
1345     call this an administrative lockout.
1346
1347 =cut
1348
1349 sub lock {
1350     my ( $self, $params ) = @_;
1351     $self->login_attempts( ADMINISTRATIVE_LOCKOUT );
1352     if( $params->{expire} ) {
1353         $self->dateexpiry( dt_from_string->subtract(days => 1) );
1354     }
1355     $self->store;
1356     if( $params->{remove} ) {
1357         $self->holds->delete;
1358         $self->article_requests->delete;
1359     }
1360     return $self;
1361 }
1362
1363 =head3 anonymize
1364
1365     Koha::Patrons->find($id)->anonymize;
1366
1367     Anonymize or clear borrower fields. Fields in BorrowerMandatoryField
1368     are randomized, other personal data is cleared too.
1369     Patrons with issues are skipped.
1370
1371 =cut
1372
1373 sub anonymize {
1374     my ( $self ) = @_;
1375     if( $self->_result->issues->count ) {
1376         warn "Exiting anonymize: patron ".$self->borrowernumber." still has issues";
1377         return;
1378     }
1379     # Mandatory fields come from the corresponding pref, but email fields
1380     # are removed since scrambled email addresses only generate errors
1381     my $mandatory = { map { (lc $_, 1); } grep { !/email/ }
1382         split /\s*\|\s*/, C4::Context->preference('BorrowerMandatoryField') };
1383     $mandatory->{userid} = 1; # needed since sub store does not clear field
1384     my @columns = $self->_result->result_source->columns;
1385     @columns = grep { !/borrowernumber|branchcode|categorycode|^date|password|flags|updated_on|lastseen|lang|login_attempts|anonymized/ } @columns;
1386     push @columns, 'dateofbirth'; # add this date back in
1387     foreach my $col (@columns) {
1388         $self->_anonymize_column($col, $mandatory->{lc $col} );
1389     }
1390     $self->anonymized(1)->store;
1391 }
1392
1393 sub _anonymize_column {
1394     my ( $self, $col, $mandatory ) = @_;
1395     my $col_info = $self->_result->result_source->column_info($col);
1396     my $type = $col_info->{data_type};
1397     my $nullable = $col_info->{is_nullable};
1398     my $val;
1399     if( $type =~ /char|text/ ) {
1400         $val = $mandatory
1401             ? Koha::Token->new->generate({ pattern => '\w{10}' })
1402             : $nullable
1403             ? undef
1404             : q{};
1405     } elsif( $type =~ /integer|int$|float|dec|double/ ) {
1406         $val = $nullable ? undef : 0;
1407     } elsif( $type =~ /date|time/ ) {
1408         $val = $nullable ? undef : dt_from_string;
1409     }
1410     $self->$col($val);
1411 }
1412
1413 =head2 Internal methods
1414
1415 =head3 _type
1416
1417 =cut
1418
1419 sub _type {
1420     return 'Borrower';
1421 }
1422
1423 =head1 AUTHORS
1424
1425 Kyle M Hall <kyle@bywatersolutions.com>
1426 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
1427 Martin Renvoize <martin.renvoize@ptfs-europe.com>
1428
1429 =cut
1430
1431 1;