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