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 Module::Load::Conditional qw( can_load );
  27 use Text::Unaccent qw( unac_string );
  28
  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::Holds;
  36 use Koha::Old::Checkouts;
  37 use Koha::Patron::Categories;
  38 use Koha::Patron::HouseboundProfile;
  39 use Koha::Patron::HouseboundRole;
  40 use Koha::Patron::Images;
  41 use Koha::Patrons;
  42 use Koha::Virtualshelves;
  43 use Koha::Club::Enrollments;
  44 use Koha::Account;
  45 use Koha::Subscription::Routinglists;
  46
  47 if ( ! can_load( modules => { 'Koha::NorwegianPatronDB' => undef } ) ) {
  48    warn "Unable to load Koha::NorwegianPatronDB";
  49 }
  50
  51 use base qw(Koha::Object);
  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 =cut
  92
  93 =head3 new
  94
  95 =cut
  96
  97 sub new {
  98     my ( $class, $params ) = @_;
  99
 100     return $class->SUPER::new($params);
 101 }
 102
 103 =head3 fixup_cardnumber
 104
 105 Autogenerate next cardnumber from highest value found in database
 106
 107 =cut
 108
 109 sub fixup_cardnumber {
 110     my ( $self ) = @_;
 111     my $max = Koha::Patrons->search({
 112         cardnumber => {-regexp => '^-?[0-9]+$'}
 113     }, {
 114         select => \'CAST(cardnumber AS SIGNED)',
 115         as => ['cast_cardnumber']
 116     })->_resultset->get_column('cast_cardnumber')->max;
 117     $self->cardnumber(($max || 0) +1);
 118 }
 119
 120 =head3 trim_whitespace
 121
 122 trim whitespace from data which has some non-whitespace in it.
 123 Could be moved to Koha::Object if need to be reused
 124
 125 =cut
 126
 127 sub trim_whitespaces {
 128     my( $self ) = @_;
 129
 130     my $schema  = Koha::Database->new->schema;
 131     my @columns = $schema->source($self->_type)->columns;
 132
 133     for my $column( @columns ) {
 134         my $value = $self->$column;
 135         if ( defined $value ) {
 136             $value =~ s/^\s*|\s*$//g;
 137             $self->$column($value);
 138         }
 139     }
 140     return $self;
 141 }
 142
 143 =head3 plain_text_password
 144
 145 $patron->plain_text_password( $password );
 146
 147 stores a copy of the unencrypted password in the object
 148 for use in code before encrypting for db
 149
 150 =cut
 151
 152 sub plain_text_password {
 153     my ( $self, $password ) = @_;
 154     if ( $password ) {
 155         $self->{_plain_text_password} = $password;
 156         return $self;
 157     }
 158     return $self->{_plain_text_password}
 159         if $self->{_plain_text_password};
 160
 161     return;
 162 }
 163
 164 =head3 store
 165
 166 Patron specific store method to cleanup record
 167 and do other necessary things before saving
 168 to db
 169
 170 =cut
 171
 172 sub store {
 173     my ($self) = @_;
 174
 175     $self->_result->result_source->schema->txn_do(
 176         sub {
 177             if (
 178                 C4::Context->preference("autoMemberNum")
 179                 and ( not defined $self->cardnumber
 180                     or $self->cardnumber eq '' )
 181               )
 182             {
 183                 # Warning: The caller is responsible for locking the members table in write
 184                 # mode, to avoid database corruption.
 185                 # We are in a transaction but the table is not locked
 186                 $self->fixup_cardnumber;
 187             }
 188
 189             unless( $self->category->in_storage ) {
 190                 Koha::Exceptions::Object::FKConstraint->throw(
 191                     broken_fk => 'categorycode',
 192                     value     => $self->categorycode,
 193                 );
 194             }
 195
 196             $self->trim_whitespaces;
 197
 198             # We don't want invalid dates in the db (mysql has a bad habit of inserting 0000-00-00)
 199             $self->dateofbirth(undef) unless $self->dateofbirth;
 200             $self->debarred(undef)    unless $self->debarred;
 201
 202             # Set default values if not set
 203             $self->sms_provider_id(undef) unless $self->sms_provider_id;
 204             $self->guarantorid(undef)     unless $self->guarantorid;
 205
 206             unless ( $self->in_storage ) {    #AddMember
 207
 208                 # Generate a valid userid/login if needed
 209                 $self->generate_userid
 210                   if not $self->userid or not $self->has_valid_userid;
 211
 212                 # Add expiration date if it isn't already there
 213                 unless ( $self->dateexpiry ) {
 214                     $self->dateexpiry( $self->category->get_expiry_date );
 215                 }
 216
 217                 # Add enrollment date if it isn't already there
 218                 unless ( $self->dateenrolled ) {
 219                     $self->dateenrolled(dt_from_string);
 220                 }
 221
 222                 # Set the privacy depending on the patron's category
 223                 my $default_privacy = $self->category->default_privacy || q{};
 224                 $default_privacy =
 225                     $default_privacy eq 'default' ? 1
 226                   : $default_privacy eq 'never'   ? 2
 227                   : $default_privacy eq 'forever' ? 0
 228                   :                                                   undef;
 229                 $self->privacy($default_privacy);
 230
 231                 unless ( defined $self->privacy_guarantor_checkouts ) {
 232                     $self->privacy_guarantor_checkouts(0);
 233                 }
 234
 235                 # Make a copy of the plain text password for later use
 236                 $self->plain_text_password( $self->password );
 237
 238                 # Create a disabled account if no password provided
 239                 $self->password( $self->password
 240                     ? Koha::AuthUtils::hash_password( $self->password )
 241                     : '!' );
 242
 243                 $self->borrowernumber(undef);
 244
 245                 $self = $self->SUPER::store;
 246
 247                 # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
 248                 # cronjob will use for syncing with NL
 249                 if (   C4::Context->preference('NorwegianPatronDBEnable')
 250                     && C4::Context->preference('NorwegianPatronDBEnable') == 1 )
 251                 {
 252                     Koha::Database->new->schema->resultset('BorrowerSync')
 253                       ->create(
 254                         {
 255                             'borrowernumber' => $self->borrowernumber,
 256                             'synctype'       => 'norwegianpatrondb',
 257                             'sync'           => 1,
 258                             'syncstatus'     => 'new',
 259                             'hashed_pin' =>
 260                               Koha::NorwegianPatronDB::NLEncryptPIN($self->plain_text_password),
 261                         }
 262                       );
 263                 }
 264
 265                 $self->add_enrolment_fee_if_needed;
 266
 267                 logaction( "MEMBERS", "CREATE", $self->borrowernumber, "" )
 268                   if C4::Context->preference("BorrowersLog");
 269             }
 270             else {    #ModMember
 271
 272                 # Come from ModMember, but should not be possible (?)
 273                 $self->dateenrolled(undef) unless $self->dateenrolled;
 274                 $self->dateexpiry(undef)   unless $self->dateexpiry;
 275
 276
 277                 my $self_from_storage = $self->get_from_storage;
 278                 # FIXME We should not deal with that here, callers have to do this job
 279                 # Moved from ModMember to prevent regressions
 280                 unless ( $self->userid ) {
 281                     my $stored_userid = $self_from_storage->userid;
 282                     $self->userid($stored_userid);
 283                 }
 284
 285                 # Password must be updated using $self->update_password
 286                 $self->password($self_from_storage->password);
 287
 288                 if ( C4::Context->preference('FeeOnChangePatronCategory')
 289                     and $self->category->categorycode ne
 290                     $self_from_storage->category->categorycode )
 291                 {
 292                     $self->add_enrolment_fee_if_needed;
 293                 }
 294
 295                 # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
 296                 # cronjob will use for syncing with NL
 297                 if (   C4::Context->preference('NorwegianPatronDBEnable')
 298                     && C4::Context->preference('NorwegianPatronDBEnable') == 1 )
 299                 {
 300                     my $borrowersync = Koha::Database->new->schema->resultset('BorrowerSync')->find({
 301                         'synctype'       => 'norwegianpatrondb',
 302                         'borrowernumber' => $self->borrowernumber,
 303                     });
 304                     # Do not set to "edited" if syncstatus is "new". We need to sync as new before
 305                     # we can sync as changed. And the "new sync" will pick up all changes since
 306                     # the patron was created anyway.
 307                     if ( $borrowersync->syncstatus ne 'new' && $borrowersync->syncstatus ne 'delete' ) {
 308                         $borrowersync->update( { 'syncstatus' => 'edited' } );
 309                     }
 310                     # Set the value of 'sync'
 311                     # FIXME THIS IS BROKEN # $borrowersync->update( { 'sync' => $data{'sync'} } );
 312
 313                     # Try to do the live sync
 314                     Koha::NorwegianPatronDB::NLSync({ 'borrowernumber' => $self->borrowernumber });
 315                 }
 316
 317                 my $borrowers_log = C4::Context->preference("BorrowersLog");
 318                 my $previous_cardnumber = $self_from_storage->cardnumber;
 319                 if ($borrowers_log
 320                     && ( !defined $previous_cardnumber
 321                         || $previous_cardnumber ne $self->cardnumber )
 322                     )
 323                 {
 324                     logaction(
 325                         "MEMBERS",
 326                         "MODIFY",
 327                         $self->borrowernumber,
 328                         to_json(
 329                             {
 330                                 cardnumber_replaced => {
 331                                     previous_cardnumber => $previous_cardnumber,
 332                                     new_cardnumber      => $self->cardnumber,
 333                                 }
 334                             },
 335                             { utf8 => 1, pretty => 1 }
 336                         )
 337                     );
 338                 }
 339
 340                 logaction( "MEMBERS", "MODIFY", $self->borrowernumber,
 341                     "UPDATE (executed w/ arg: " . $self->borrowernumber . ")" )
 342                   if $borrowers_log;
 343
 344                 $self = $self->SUPER::store;
 345             }
 346         }
 347     );
 348     return $self;
 349 }
 350
 351 =head3 delete
 352
 353 $patron->delete
 354
 355 Delete patron's holds, lists and finally the patron.
 356
 357 Lists owned by the borrower are deleted, but entries from the borrower to
 358 other lists are kept.
 359
 360 =cut
 361
 362 sub delete {
 363     my ($self) = @_;
 364
 365     my $deleted;
 366     $self->_result->result_source->schema->txn_do(
 367         sub {
 368             # Delete Patron's holds
 369             $self->holds->delete;
 370
 371             # Delete all lists and all shares of this borrower
 372             # Consistent with the approach Koha uses on deleting individual lists
 373             # Note that entries in virtualshelfcontents added by this borrower to
 374             # lists of others will be handled by a table constraint: the borrower
 375             # is set to NULL in those entries.
 376             # NOTE:
 377             # We could handle the above deletes via a constraint too.
 378             # But a new BZ report 11889 has been opened to discuss another approach.
 379             # Instead of deleting we could also disown lists (based on a pref).
 380             # In that way we could save shared and public lists.
 381             # The current table constraints support that idea now.
 382             # This pref should then govern the results of other routines/methods such as
 383             # Koha::Virtualshelf->new->delete too.
 384             # FIXME Could be $patron->get_lists
 385             $_->delete for Koha::Virtualshelves->search( { owner => $self->borrowernumber } );
 386
 387             $deleted = $self->SUPER::delete;
 388
 389             logaction( "MEMBERS", "DELETE", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog");
 390         }
 391     );
 392     return $deleted;
 393 }
 394
 395
 396 =head3 category
 397
 398 my $patron_category = $patron->category
 399
 400 Return the patron category for this patron
 401
 402 =cut
 403
 404 sub category {
 405     my ( $self ) = @_;
 406     return Koha::Patron::Category->_new_from_dbic( $self->_result->categorycode );
 407 }
 408
 409 =head3 guarantor
 410
 411 Returns a Koha::Patron object for this patron's guarantor
 412
 413 =cut
 414
 415 sub guarantor {
 416     my ( $self ) = @_;
 417
 418     return unless $self->guarantorid();
 419
 420     return Koha::Patrons->find( $self->guarantorid() );
 421 }
 422
 423 sub image {
 424     my ( $self ) = @_;
 425
 426     return scalar Koha::Patron::Images->find( $self->borrowernumber );
 427 }
 428
 429 sub library {
 430     my ( $self ) = @_;
 431     return Koha::Library->_new_from_dbic($self->_result->branchcode);
 432 }
 433
 434 =head3 guarantees
 435
 436 Returns the guarantees (list of Koha::Patron) of this patron
 437
 438 =cut
 439
 440 sub guarantees {
 441     my ( $self ) = @_;
 442
 443     return Koha::Patrons->search( { guarantorid => $self->borrowernumber } );
 444 }
 445
 446 =head3 housebound_profile
 447
 448 Returns the HouseboundProfile associated with this patron.
 449
 450 =cut
 451
 452 sub housebound_profile {
 453     my ( $self ) = @_;
 454     my $profile = $self->_result->housebound_profile;
 455     return Koha::Patron::HouseboundProfile->_new_from_dbic($profile)
 456         if ( $profile );
 457     return;
 458 }
 459
 460 =head3 housebound_role
 461
 462 Returns the HouseboundRole associated with this patron.
 463
 464 =cut
 465
 466 sub housebound_role {
 467     my ( $self ) = @_;
 468
 469     my $role = $self->_result->housebound_role;
 470     return Koha::Patron::HouseboundRole->_new_from_dbic($role) if ( $role );
 471     return;
 472 }
 473
 474 =head3 siblings
 475
 476 Returns the siblings of this patron.
 477
 478 =cut
 479
 480 sub siblings {
 481     my ( $self ) = @_;
 482
 483     my $guarantor = $self->guarantor;
 484
 485     return unless $guarantor;
 486
 487     return Koha::Patrons->search(
 488         {
 489             guarantorid => {
 490                 '!=' => undef,
 491                 '=' => $guarantor->id,
 492             },
 493             borrowernumber => {
 494                 '!=' => $self->borrowernumber,
 495             }
 496         }
 497     );
 498 }
 499
 500 =head3 merge_with
 501
 502     my $patron = Koha::Patrons->find($id);
 503     $patron->merge_with( \@patron_ids );
 504
 505     This subroutine merges a list of patrons into the patron record. This is accomplished by finding
 506     all related patron ids for the patrons to be merged in other tables and changing the ids to be that
 507     of the keeper patron.
 508
 509 =cut
 510
 511 sub merge_with {
 512     my ( $self, $patron_ids ) = @_;
 513
 514     my @patron_ids = @{ $patron_ids };
 515
 516     # Ensure the keeper isn't in the list of patrons to merge
 517     @patron_ids = grep { $_ ne $self->id } @patron_ids;
 518
 519     my $schema = Koha::Database->new()->schema();
 520
 521     my $results;
 522
 523     $self->_result->result_source->schema->txn_do( sub {
 524         foreach my $patron_id (@patron_ids) {
 525             my $patron = Koha::Patrons->find( $patron_id );
 526
 527             next unless $patron;
 528
 529             # Unbless for safety, the patron will end up being deleted
 530             $results->{merged}->{$patron_id}->{patron} = $patron->unblessed;
 531
 532             while (my ($r, $field) = each(%$RESULTSET_PATRON_ID_MAPPING)) {
 533                 my $rs = $schema->resultset($r)->search({ $field => $patron_id });
 534                 $results->{merged}->{ $patron_id }->{updated}->{$r} = $rs->count();
 535                 $rs->update({ $field => $self->id });
 536             }
 537
 538             $patron->move_to_deleted();
 539             $patron->delete();
 540         }
 541     });
 542
 543     return $results;
 544 }
 545
 546
 547
 548 =head3 wants_check_for_previous_checkout
 549
 550     $wants_check = $patron->wants_check_for_previous_checkout;
 551
 552 Return 1 if Koha needs to perform PrevIssue checking, else 0.
 553
 554 =cut
 555
 556 sub wants_check_for_previous_checkout {
 557     my ( $self ) = @_;
 558     my $syspref = C4::Context->preference("checkPrevCheckout");
 559
 560     # Simple cases
 561     ## Hard syspref trumps all
 562     return 1 if ($syspref eq 'hardyes');
 563     return 0 if ($syspref eq 'hardno');
 564     ## Now, patron pref trumps all
 565     return 1 if ($self->checkprevcheckout eq 'yes');
 566     return 0 if ($self->checkprevcheckout eq 'no');
 567
 568     # More complex: patron inherits -> determine category preference
 569     my $checkPrevCheckoutByCat = $self->category->checkprevcheckout;
 570     return 1 if ($checkPrevCheckoutByCat eq 'yes');
 571     return 0 if ($checkPrevCheckoutByCat eq 'no');
 572
 573     # Finally: category preference is inherit, default to 0
 574     if ($syspref eq 'softyes') {
 575         return 1;
 576     } else {
 577         return 0;
 578     }
 579 }
 580
 581 =head3 do_check_for_previous_checkout
 582
 583     $do_check = $patron->do_check_for_previous_checkout($item);
 584
 585 Return 1 if the bib associated with $ITEM has previously been checked out to
 586 $PATRON, 0 otherwise.
 587
 588 =cut
 589
 590 sub do_check_for_previous_checkout {
 591     my ( $self, $item ) = @_;
 592
 593     # Find all items for bib and extract item numbers.
 594     my @items = Koha::Items->search({biblionumber => $item->{biblionumber}});
 595     my @item_nos;
 596     foreach my $item (@items) {
 597         push @item_nos, $item->itemnumber;
 598     }
 599
 600     # Create (old)issues search criteria
 601     my $criteria = {
 602         borrowernumber => $self->borrowernumber,
 603         itemnumber => \@item_nos,
 604     };
 605
 606     # Check current issues table
 607     my $issues = Koha::Checkouts->search($criteria);
 608     return 1 if $issues->count; # 0 || N
 609
 610     # Check old issues table
 611     my $old_issues = Koha::Old::Checkouts->search($criteria);
 612     return $old_issues->count;  # 0 || N
 613 }
 614
 615 =head3 is_debarred
 616
 617 my $debarment_expiration = $patron->is_debarred;
 618
 619 Returns the date a patron debarment will expire, or undef if the patron is not
 620 debarred
 621
 622 =cut
 623
 624 sub is_debarred {
 625     my ($self) = @_;
 626
 627     return unless $self->debarred;
 628     return $self->debarred
 629       if $self->debarred =~ '^9999'
 630       or dt_from_string( $self->debarred ) > dt_from_string;
 631     return;
 632 }
 633
 634 =head3 is_expired
 635
 636 my $is_expired = $patron->is_expired;
 637
 638 Returns 1 if the patron is expired or 0;
 639
 640 =cut
 641
 642 sub is_expired {
 643     my ($self) = @_;
 644     return 0 unless $self->dateexpiry;
 645     return 0 if $self->dateexpiry =~ '^9999';
 646     return 1 if dt_from_string( $self->dateexpiry ) < dt_from_string->truncate( to => 'day' );
 647     return 0;
 648 }
 649
 650 =head3 is_going_to_expire
 651
 652 my $is_going_to_expire = $patron->is_going_to_expire;
 653
 654 Returns 1 if the patron is going to expired, depending on the NotifyBorrowerDeparture pref or 0
 655
 656 =cut
 657
 658 sub is_going_to_expire {
 659     my ($self) = @_;
 660
 661     my $delay = C4::Context->preference('NotifyBorrowerDeparture') || 0;
 662
 663     return 0 unless $delay;
 664     return 0 unless $self->dateexpiry;
 665     return 0 if $self->dateexpiry =~ '^9999';
 666     return 1 if dt_from_string( $self->dateexpiry )->subtract( days => $delay ) < dt_from_string->truncate( to => 'day' );
 667     return 0;
 668 }
 669
 670 =head3 update_password
 671
 672 my $updated = $patron->update_password( $userid, $password );
 673
 674 Update the userid and the password of a patron.
 675 If the userid already exists, returns and let DBIx::Class warns
 676 This will add an entry to action_logs if BorrowersLog is set.
 677
 678 =cut
 679
 680 sub update_password {
 681     my ( $self, $userid, $password ) = @_;
 682     eval { $self->userid($userid)->store; };
 683     return if $@; # Make sure the userid is not already in used by another patron
 684
 685     return 0 if $password eq '****' or $password eq '';
 686
 687     if ( C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
 688         # Update the hashed PIN in borrower_sync.hashed_pin, before Koha hashes it
 689         Koha::NorwegianPatronDB::NLUpdateHashedPIN( $self->borrowernumber, $password );
 690     }
 691
 692     my $digest = Koha::AuthUtils::hash_password($password);
 693     $self->update(
 694         {
 695             password       => $digest,
 696             login_attempts => 0,
 697         }
 698     );
 699
 700     logaction( "MEMBERS", "CHANGE PASS", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog");
 701     return $digest;
 702 }
 703
 704 =head3 renew_account
 705
 706 my $new_expiry_date = $patron->renew_account
 707
 708 Extending the subscription to the expiry date.
 709
 710 =cut
 711
 712 sub renew_account {
 713     my ($self) = @_;
 714     my $date;
 715     if ( C4::Context->preference('BorrowerRenewalPeriodBase') eq 'combination' ) {
 716         $date = ( dt_from_string gt dt_from_string( $self->dateexpiry ) ) ? dt_from_string : dt_from_string( $self->dateexpiry );
 717     } else {
 718         $date =
 719             C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry'
 720             ? dt_from_string( $self->dateexpiry )
 721             : dt_from_string;
 722     }
 723     my $expiry_date = $self->category->get_expiry_date($date);
 724
 725     $self->dateexpiry($expiry_date);
 726     $self->date_renewed( dt_from_string() );
 727     $self->store();
 728
 729     $self->add_enrolment_fee_if_needed;
 730
 731     logaction( "MEMBERS", "RENEW", $self->borrowernumber, "Membership renewed" ) if C4::Context->preference("BorrowersLog");
 732     return dt_from_string( $expiry_date )->truncate( to => 'day' );
 733 }
 734
 735 =head3 has_overdues
 736
 737 my $has_overdues = $patron->has_overdues;
 738
 739 Returns the number of patron's overdues
 740
 741 =cut
 742
 743 sub has_overdues {
 744     my ($self) = @_;
 745     my $dtf = Koha::Database->new->schema->storage->datetime_parser;
 746     return $self->_result->issues->search({ date_due => { '<' => $dtf->format_datetime( dt_from_string() ) } })->count;
 747 }
 748
 749 =head3 track_login
 750
 751     $patron->track_login;
 752     $patron->track_login({ force => 1 });
 753
 754     Tracks a (successful) login attempt.
 755     The preference TrackLastPatronActivity must be enabled. Or you
 756     should pass the force parameter.
 757
 758 =cut
 759
 760 sub track_login {
 761     my ( $self, $params ) = @_;
 762     return if
 763         !$params->{force} &&
 764         !C4::Context->preference('TrackLastPatronActivity');
 765     $self->lastseen( dt_from_string() )->store;
 766 }
 767
 768 =head3 move_to_deleted
 769
 770 my $is_moved = $patron->move_to_deleted;
 771
 772 Move a patron to the deletedborrowers table.
 773 This can be done before deleting a patron, to make sure the data are not completely deleted.
 774
 775 =cut
 776
 777 sub move_to_deleted {
 778     my ($self) = @_;
 779     my $patron_infos = $self->unblessed;
 780     delete $patron_infos->{updated_on}; #This ensures the updated_on date in deletedborrowers will be set to the current timestamp
 781     return Koha::Database->new->schema->resultset('Deletedborrower')->create($patron_infos);
 782 }
 783
 784 =head3 article_requests
 785
 786 my @requests = $borrower->article_requests();
 787 my $requests = $borrower->article_requests();
 788
 789 Returns either a list of ArticleRequests objects,
 790 or an ArtitleRequests object, depending on the
 791 calling context.
 792
 793 =cut
 794
 795 sub article_requests {
 796     my ( $self ) = @_;
 797
 798     $self->{_article_requests} ||= Koha::ArticleRequests->search({ borrowernumber => $self->borrowernumber() });
 799
 800     return $self->{_article_requests};
 801 }
 802
 803 =head3 article_requests_current
 804
 805 my @requests = $patron->article_requests_current
 806
 807 Returns the article requests associated with this patron that are incomplete
 808
 809 =cut
 810
 811 sub article_requests_current {
 812     my ( $self ) = @_;
 813
 814     $self->{_article_requests_current} ||= Koha::ArticleRequests->search(
 815         {
 816             borrowernumber => $self->id(),
 817             -or          => [
 818                 { status => Koha::ArticleRequest::Status::Pending },
 819                 { status => Koha::ArticleRequest::Status::Processing }
 820             ]
 821         }
 822     );
 823
 824     return $self->{_article_requests_current};
 825 }
 826
 827 =head3 article_requests_finished
 828
 829 my @requests = $biblio->article_requests_finished
 830
 831 Returns the article requests associated with this patron that are completed
 832
 833 =cut
 834
 835 sub article_requests_finished {
 836     my ( $self, $borrower ) = @_;
 837
 838     $self->{_article_requests_finished} ||= Koha::ArticleRequests->search(
 839         {
 840             borrowernumber => $self->id(),
 841             -or          => [
 842                 { status => Koha::ArticleRequest::Status::Completed },
 843                 { status => Koha::ArticleRequest::Status::Canceled }
 844             ]
 845         }
 846     );
 847
 848     return $self->{_article_requests_finished};
 849 }
 850
 851 =head3 add_enrolment_fee_if_needed
 852
 853 my $enrolment_fee = $patron->add_enrolment_fee_if_needed;
 854
 855 Add enrolment fee for a patron if needed.
 856
 857 =cut
 858
 859 sub add_enrolment_fee_if_needed {
 860     my ($self) = @_;
 861     my $enrolment_fee = $self->category->enrolmentfee;
 862     if ( $enrolment_fee && $enrolment_fee > 0 ) {
 863         # insert fee in patron debts
 864         C4::Accounts::manualinvoice( $self->borrowernumber, '', '', 'A', $enrolment_fee );
 865     }
 866     return $enrolment_fee || 0;
 867 }
 868
 869 =head3 checkouts
 870
 871 my $checkouts = $patron->checkouts
 872
 873 =cut
 874
 875 sub checkouts {
 876     my ($self) = @_;
 877     my $checkouts = $self->_result->issues;
 878     return Koha::Checkouts->_new_from_dbic( $checkouts );
 879 }
 880
 881 =head3 pending_checkouts
 882
 883 my $pending_checkouts = $patron->pending_checkouts
 884
 885 This method will return the same as $self->checkouts, but with a prefetch on
 886 items, biblio and biblioitems.
 887
 888 It has been introduced to replaced the C4::Members::GetPendingIssues subroutine
 889
 890 It should not be used directly, prefer to access fields you need instead of
 891 retrieving all these fields in one go.
 892
 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 reach the maximum number of login attempts (see pref FailedLoginAttempts).
1100 Otherwise return false.
1101 If the pref is not set (empty string, null or 0), the feature is considered as disabled.
1102
1103 =cut
1104
1105 sub account_locked {
1106     my ($self) = @_;
1107     my $FailedLoginAttempts = C4::Context->preference('FailedLoginAttempts');
1108     return ( $FailedLoginAttempts
1109           and $self->login_attempts
1110           and $self->login_attempts >= $FailedLoginAttempts )? 1 : 0;
1111 }
1112
1113 =head3 can_see_patron_infos
1114
1115 my $can_see = $patron->can_see_patron_infos( $patron );
1116
1117 Return true if the patron (usually the logged in user) can see the patron's infos for a given patron
1118
1119 =cut
1120
1121 sub can_see_patron_infos {
1122     my ( $self, $patron ) = @_;
1123     return $self->can_see_patrons_from( $patron->library->branchcode );
1124 }
1125
1126 =head3 can_see_patrons_from
1127
1128 my $can_see = $patron->can_see_patrons_from( $branchcode );
1129
1130 Return true if the patron (usually the logged in user) can see the patron's infos from a given library
1131
1132 =cut
1133
1134 sub can_see_patrons_from {
1135     my ( $self, $branchcode ) = @_;
1136     my $can = 0;
1137     if ( $self->branchcode eq $branchcode ) {
1138         $can = 1;
1139     } elsif ( $self->has_permission( { borrowers => 'view_borrower_infos_from_any_libraries' } ) ) {
1140         $can = 1;
1141     } elsif ( my $library_groups = $self->library->library_groups ) {
1142         while ( my $library_group = $library_groups->next ) {
1143             if ( $library_group->parent->has_child( $branchcode ) ) {
1144                 $can = 1;
1145                 last;
1146             }
1147         }
1148     }
1149     return $can;
1150 }
1151
1152 =head3 libraries_where_can_see_patrons
1153
1154 my $libraries = $patron-libraries_where_can_see_patrons;
1155
1156 Return the list of branchcodes(!) of libraries the patron is allowed to see other patron's infos.
1157 The branchcodes are arbitrarily returned sorted.
1158 We are supposing here that the object is related to the logged in patron (use of C4::Context::only_my_library)
1159
1160 An empty array means no restriction, the patron can see patron's infos from any libraries.
1161
1162 =cut
1163
1164 sub libraries_where_can_see_patrons {
1165     my ( $self ) = @_;
1166     my $userenv = C4::Context->userenv;
1167
1168     return () unless $userenv; # For tests, but userenv should be defined in tests...
1169
1170     my @restricted_branchcodes;
1171     if (C4::Context::only_my_library) {
1172         push @restricted_branchcodes, $self->branchcode;
1173     }
1174     else {
1175         unless (
1176             $self->has_permission(
1177                 { borrowers => 'view_borrower_infos_from_any_libraries' }
1178             )
1179           )
1180         {
1181             my $library_groups = $self->library->library_groups({ ft_hide_patron_info => 1 });
1182             if ( $library_groups->count )
1183             {
1184                 while ( my $library_group = $library_groups->next ) {
1185                     my $parent = $library_group->parent;
1186                     if ( $parent->has_child( $self->branchcode ) ) {
1187                         push @restricted_branchcodes, $parent->children->get_column('branchcode');
1188                     }
1189                 }
1190             }
1191
1192             @restricted_branchcodes = ( $self->branchcode ) unless @restricted_branchcodes;
1193         }
1194     }
1195
1196     @restricted_branchcodes = grep { defined $_ } @restricted_branchcodes;
1197     @restricted_branchcodes = uniq(@restricted_branchcodes);
1198     @restricted_branchcodes = sort(@restricted_branchcodes);
1199     return @restricted_branchcodes;
1200 }
1201
1202 sub has_permission {
1203     my ( $self, $flagsrequired ) = @_;
1204     return unless $self->userid;
1205     # TODO code from haspermission needs to be moved here!
1206     return C4::Auth::haspermission( $self->userid, $flagsrequired );
1207 }
1208
1209 =head3 is_adult
1210
1211 my $is_adult = $patron->is_adult
1212
1213 Return true if the patron has a category with a type Adult (A) or Organization (I)
1214
1215 =cut
1216
1217 sub is_adult {
1218     my ( $self ) = @_;
1219     return $self->category->category_type =~ /^(A|I)$/ ? 1 : 0;
1220 }
1221
1222 =head3 is_child
1223
1224 my $is_child = $patron->is_child
1225
1226 Return true if the patron has a category with a type Child (C)
1227
1228 =cut
1229 sub is_child {
1230     my( $self ) = @_;
1231     return $self->category->category_type eq 'C' ? 1 : 0;
1232 }
1233
1234 =head3 has_valid_userid
1235
1236 my $patron = Koha::Patrons->find(42);
1237 $patron->userid( $new_userid );
1238 my $has_a_valid_userid = $patron->has_valid_userid
1239
1240 my $patron = Koha::Patron->new( $params );
1241 my $has_a_valid_userid = $patron->has_valid_userid
1242
1243 Return true if the current userid of this patron is valid/unique, otherwise false.
1244
1245 Note that this should be done in $self->store instead and raise an exception if needed.
1246
1247 =cut
1248
1249 sub has_valid_userid {
1250     my ($self) = @_;
1251
1252     return 0 unless $self->userid;
1253
1254     return 0 if ( $self->userid eq C4::Context->config('user') );    # DB user
1255
1256     my $already_exists = Koha::Patrons->search(
1257         {
1258             userid => $self->userid,
1259             (
1260                 $self->in_storage
1261                 ? ( borrowernumber => { '!=' => $self->borrowernumber } )
1262                 : ()
1263             ),
1264         }
1265     )->count;
1266     return $already_exists ? 0 : 1;
1267 }
1268
1269 =head3 generate_userid
1270
1271 my $patron = Koha::Patron->new( $params );
1272 $patron->generate_userid
1273
1274 Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
1275
1276 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).
1277
1278 =cut
1279
1280 sub generate_userid {
1281     my ($self) = @_;
1282     my $offset = 0;
1283     my $firstname = $self->firstname // q{};
1284     my $surname = $self->surname // q{};
1285     #The script will "do" the following code and increment the $offset until the generated userid is unique
1286     do {
1287       $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1288       $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1289       my $userid = lc(($firstname)? "$firstname.$surname" : $surname);
1290       $userid = unac_string('utf-8',$userid);
1291       $userid .= $offset unless $offset == 0;
1292       $self->userid( $userid );
1293       $offset++;
1294      } while (! $self->has_valid_userid );
1295
1296      return $self;
1297
1298 }
1299
1300 =head2 Internal methods
1301
1302 =head3 _type
1303
1304 =cut
1305
1306 sub _type {
1307     return 'Borrower';
1308 }
1309
1310 =head1 AUTHOR
1311
1312 Kyle M Hall <kyle@bywatersolutions.com>
1313 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
1314
1315 =cut
1316
1317 1;