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