Koha/Patron.pm

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