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