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