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