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
  25 use C4::Context;
  26 use C4::Log;
  27 use Koha::Checkouts;
  28 use Koha::Database;
  29 use Koha::DateUtils;
  30 use Koha::Holds;
  31 use Koha::Old::Checkouts;
  32 use Koha::Patron::Categories;
  33 use Koha::Patron::HouseboundProfile;
  34 use Koha::Patron::HouseboundRole;
  35 use Koha::Patron::Images;
  36 use Koha::Patrons;
  37 use Koha::Virtualshelves;
  38 use Koha::Club::Enrollments;
  39 use Koha::Account;
  40
  41 use base qw(Koha::Object);
  42
  43 =head1 NAME
  44
  45 Koha::Patron - Koha Patron Object class
  46
  47 =head1 API
  48
  49 =head2 Class Methods
  50
  51 =cut
  52
  53 =head3 delete
  54
  55 $patron->delete
  56
  57 Delete patron's holds, lists and finally the patron.
  58
  59 Lists owned by the borrower are deleted, but entries from the borrower to
  60 other lists are kept.
  61
  62 =cut
  63
  64 sub delete {
  65     my ($self) = @_;
  66
  67     my $deleted;
  68     $self->_result->result_source->schema->txn_do(
  69         sub {
  70             # Delete Patron's holds
  71             $self->holds->delete;
  72
  73             # Delete all lists and all shares of this borrower
  74             # Consistent with the approach Koha uses on deleting individual lists
  75             # Note that entries in virtualshelfcontents added by this borrower to
  76             # lists of others will be handled by a table constraint: the borrower
  77             # is set to NULL in those entries.
  78             # NOTE:
  79             # We could handle the above deletes via a constraint too.
  80             # But a new BZ report 11889 has been opened to discuss another approach.
  81             # Instead of deleting we could also disown lists (based on a pref).
  82             # In that way we could save shared and public lists.
  83             # The current table constraints support that idea now.
  84             # This pref should then govern the results of other routines/methods such as
  85             # Koha::Virtualshelf->new->delete too.
  86             # FIXME Could be $patron->get_lists
  87             $_->delete for Koha::Virtualshelves->search( { owner => $self->borrowernumber } );
  88
  89             $deleted = $self->SUPER::delete;
  90
  91             logaction( "MEMBERS", "DELETE", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog");
  92         }
  93     );
  94     return $deleted;
  95 }
  96
  97
  98 =head3 category
  99
 100 my $patron_category = $patron->category
 101
 102 Return the patron category for this patron
 103
 104 =cut
 105
 106 sub category {
 107     my ( $self ) = @_;
 108     return Koha::Patron::Category->_new_from_dbic( $self->_result->categorycode );
 109 }
 110
 111 =head3 guarantor
 112
 113 Returns a Koha::Patron object for this patron's guarantor
 114
 115 =cut
 116
 117 sub guarantor {
 118     my ( $self ) = @_;
 119
 120     return unless $self->guarantorid();
 121
 122     return Koha::Patrons->find( $self->guarantorid() );
 123 }
 124
 125 sub image {
 126     my ( $self ) = @_;
 127
 128     return Koha::Patron::Images->find( $self->borrowernumber );
 129 }
 130
 131 sub library {
 132     my ( $self ) = @_;
 133     return Koha::Library->_new_from_dbic($self->_result->branchcode);
 134 }
 135
 136 =head3 guarantees
 137
 138 Returns the guarantees (list of Koha::Patron) of this patron
 139
 140 =cut
 141
 142 sub guarantees {
 143     my ( $self ) = @_;
 144
 145     return Koha::Patrons->search( { guarantorid => $self->borrowernumber } );
 146 }
 147
 148 =head3 housebound_profile
 149
 150 Returns the HouseboundProfile associated with this patron.
 151
 152 =cut
 153
 154 sub housebound_profile {
 155     my ( $self ) = @_;
 156     my $profile = $self->_result->housebound_profile;
 157     return Koha::Patron::HouseboundProfile->_new_from_dbic($profile)
 158         if ( $profile );
 159     return;
 160 }
 161
 162 =head3 housebound_role
 163
 164 Returns the HouseboundRole associated with this patron.
 165
 166 =cut
 167
 168 sub housebound_role {
 169     my ( $self ) = @_;
 170
 171     my $role = $self->_result->housebound_role;
 172     return Koha::Patron::HouseboundRole->_new_from_dbic($role) if ( $role );
 173     return;
 174 }
 175
 176 =head3 siblings
 177
 178 Returns the siblings of this patron.
 179
 180 =cut
 181
 182 sub siblings {
 183     my ( $self ) = @_;
 184
 185     my $guarantor = $self->guarantor;
 186
 187     return unless $guarantor;
 188
 189     return Koha::Patrons->search(
 190         {
 191             guarantorid => {
 192                 '!=' => undef,
 193                 '=' => $guarantor->id,
 194             },
 195             borrowernumber => {
 196                 '!=' => $self->borrowernumber,
 197             }
 198         }
 199     );
 200 }
 201
 202 =head3 wants_check_for_previous_checkout
 203
 204     $wants_check = $patron->wants_check_for_previous_checkout;
 205
 206 Return 1 if Koha needs to perform PrevIssue checking, else 0.
 207
 208 =cut
 209
 210 sub wants_check_for_previous_checkout {
 211     my ( $self ) = @_;
 212     my $syspref = C4::Context->preference("checkPrevCheckout");
 213
 214     # Simple cases
 215     ## Hard syspref trumps all
 216     return 1 if ($syspref eq 'hardyes');
 217     return 0 if ($syspref eq 'hardno');
 218     ## Now, patron pref trumps all
 219     return 1 if ($self->checkprevcheckout eq 'yes');
 220     return 0 if ($self->checkprevcheckout eq 'no');
 221
 222     # More complex: patron inherits -> determine category preference
 223     my $checkPrevCheckoutByCat = $self->category->checkprevcheckout;
 224     return 1 if ($checkPrevCheckoutByCat eq 'yes');
 225     return 0 if ($checkPrevCheckoutByCat eq 'no');
 226
 227     # Finally: category preference is inherit, default to 0
 228     if ($syspref eq 'softyes') {
 229         return 1;
 230     } else {
 231         return 0;
 232     }
 233 }
 234
 235 =head3 do_check_for_previous_checkout
 236
 237     $do_check = $patron->do_check_for_previous_checkout($item);
 238
 239 Return 1 if the bib associated with $ITEM has previously been checked out to
 240 $PATRON, 0 otherwise.
 241
 242 =cut
 243
 244 sub do_check_for_previous_checkout {
 245     my ( $self, $item ) = @_;
 246
 247     # Find all items for bib and extract item numbers.
 248     my @items = Koha::Items->search({biblionumber => $item->{biblionumber}});
 249     my @item_nos;
 250     foreach my $item (@items) {
 251         push @item_nos, $item->itemnumber;
 252     }
 253
 254     # Create (old)issues search criteria
 255     my $criteria = {
 256         borrowernumber => $self->borrowernumber,
 257         itemnumber => \@item_nos,
 258     };
 259
 260     # Check current issues table
 261     my $issues = Koha::Checkouts->search($criteria);
 262     return 1 if $issues->count; # 0 || N
 263
 264     # Check old issues table
 265     my $old_issues = Koha::Old::Checkouts->search($criteria);
 266     return $old_issues->count;  # 0 || N
 267 }
 268
 269 =head3 is_debarred
 270
 271 my $debarment_expiration = $patron->is_debarred;
 272
 273 Returns the date a patron debarment will expire, or undef if the patron is not
 274 debarred
 275
 276 =cut
 277
 278 sub is_debarred {
 279     my ($self) = @_;
 280
 281     return unless $self->debarred;
 282     return $self->debarred
 283       if $self->debarred =~ '^9999'
 284       or dt_from_string( $self->debarred ) > dt_from_string;
 285     return;
 286 }
 287
 288 =head3 is_expired
 289
 290 my $is_expired = $patron->is_expired;
 291
 292 Returns 1 if the patron is expired or 0;
 293
 294 =cut
 295
 296 sub is_expired {
 297     my ($self) = @_;
 298     return 0 unless $self->dateexpiry;
 299     return 0 if $self->dateexpiry eq '0000-00-00';
 300     return 1 if dt_from_string( $self->dateexpiry ) < dt_from_string->truncate( to => 'day' );
 301     return 0;
 302 }
 303
 304 =head3 is_going_to_expire
 305
 306 my $is_going_to_expire = $patron->is_going_to_expire;
 307
 308 Returns 1 if the patron is going to expired, depending on the NotifyBorrowerDeparture pref or 0
 309
 310 =cut
 311
 312 sub is_going_to_expire {
 313     my ($self) = @_;
 314
 315     my $delay = C4::Context->preference('NotifyBorrowerDeparture') || 0;
 316
 317     return 0 unless $delay;
 318     return 0 unless $self->dateexpiry;
 319     return 0 if $self->dateexpiry eq '0000-00-00';
 320     return 1 if dt_from_string( $self->dateexpiry )->subtract( days => $delay ) < dt_from_string->truncate( to => 'day' );
 321     return 0;
 322 }
 323
 324 =head3 update_password
 325
 326 my $updated = $patron->update_password( $userid, $password );
 327
 328 Update the userid and the password of a patron.
 329 If the userid already exists, returns and let DBIx::Class warns
 330 This will add an entry to action_logs if BorrowersLog is set.
 331
 332 =cut
 333
 334 sub update_password {
 335     my ( $self, $userid, $password ) = @_;
 336     eval { $self->userid($userid)->store; };
 337     return if $@; # Make sure the userid is not already in used by another patron
 338     $self->update(
 339         {
 340             password       => $password,
 341             login_attempts => 0,
 342         }
 343     );
 344     logaction( "MEMBERS", "CHANGE PASS", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog");
 345     return 1;
 346 }
 347
 348 =head3 renew_account
 349
 350 my $new_expiry_date = $patron->renew_account
 351
 352 Extending the subscription to the expiry date.
 353
 354 =cut
 355
 356 sub renew_account {
 357     my ($self) = @_;
 358     my $date;
 359     if ( C4::Context->preference('BorrowerRenewalPeriodBase') eq 'combination' ) {
 360         $date = ( dt_from_string gt dt_from_string( $self->dateexpiry ) ) ? dt_from_string : dt_from_string( $self->dateexpiry );
 361     } else {
 362         $date =
 363             C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry'
 364             ? dt_from_string( $self->dateexpiry )
 365             : dt_from_string;
 366     }
 367     my $expiry_date = $self->category->get_expiry_date($date);
 368
 369     $self->dateexpiry($expiry_date);
 370     $self->date_renewed( dt_from_string() );
 371     $self->store();
 372
 373     $self->add_enrolment_fee_if_needed;
 374
 375     logaction( "MEMBERS", "RENEW", $self->borrowernumber, "Membership renewed" ) if C4::Context->preference("BorrowersLog");
 376     return dt_from_string( $expiry_date )->truncate( to => 'day' );
 377 }
 378
 379 =head3 has_overdues
 380
 381 my $has_overdues = $patron->has_overdues;
 382
 383 Returns the number of patron's overdues
 384
 385 =cut
 386
 387 sub has_overdues {
 388     my ($self) = @_;
 389     my $dtf = Koha::Database->new->schema->storage->datetime_parser;
 390     return $self->_result->issues->search({ date_due => { '<' => $dtf->format_datetime( dt_from_string() ) } })->count;
 391 }
 392
 393 =head3 track_login
 394
 395     $patron->track_login;
 396     $patron->track_login({ force => 1 });
 397
 398     Tracks a (successful) login attempt.
 399     The preference TrackLastPatronActivity must be enabled. Or you
 400     should pass the force parameter.
 401
 402 =cut
 403
 404 sub track_login {
 405     my ( $self, $params ) = @_;
 406     return if
 407         !$params->{force} &&
 408         !C4::Context->preference('TrackLastPatronActivity');
 409     $self->lastseen( dt_from_string() )->store;
 410 }
 411
 412 =head3 move_to_deleted
 413
 414 my $is_moved = $patron->move_to_deleted;
 415
 416 Move a patron to the deletedborrowers table.
 417 This can be done before deleting a patron, to make sure the data are not completely deleted.
 418
 419 =cut
 420
 421 sub move_to_deleted {
 422     my ($self) = @_;
 423     my $patron_infos = $self->unblessed;
 424     delete $patron_infos->{updated_on}; #This ensures the updated_on date in deletedborrowers will be set to the current timestamp
 425     return Koha::Database->new->schema->resultset('Deletedborrower')->create($patron_infos);
 426 }
 427
 428 =head3 article_requests
 429
 430 my @requests = $borrower->article_requests();
 431 my $requests = $borrower->article_requests();
 432
 433 Returns either a list of ArticleRequests objects,
 434 or an ArtitleRequests object, depending on the
 435 calling context.
 436
 437 =cut
 438
 439 sub article_requests {
 440     my ( $self ) = @_;
 441
 442     $self->{_article_requests} ||= Koha::ArticleRequests->search({ borrowernumber => $self->borrowernumber() });
 443
 444     return $self->{_article_requests};
 445 }
 446
 447 =head3 article_requests_current
 448
 449 my @requests = $patron->article_requests_current
 450
 451 Returns the article requests associated with this patron that are incomplete
 452
 453 =cut
 454
 455 sub article_requests_current {
 456     my ( $self ) = @_;
 457
 458     $self->{_article_requests_current} ||= Koha::ArticleRequests->search(
 459         {
 460             borrowernumber => $self->id(),
 461             -or          => [
 462                 { status => Koha::ArticleRequest::Status::Pending },
 463                 { status => Koha::ArticleRequest::Status::Processing }
 464             ]
 465         }
 466     );
 467
 468     return $self->{_article_requests_current};
 469 }
 470
 471 =head3 article_requests_finished
 472
 473 my @requests = $biblio->article_requests_finished
 474
 475 Returns the article requests associated with this patron that are completed
 476
 477 =cut
 478
 479 sub article_requests_finished {
 480     my ( $self, $borrower ) = @_;
 481
 482     $self->{_article_requests_finished} ||= Koha::ArticleRequests->search(
 483         {
 484             borrowernumber => $self->id(),
 485             -or          => [
 486                 { status => Koha::ArticleRequest::Status::Completed },
 487                 { status => Koha::ArticleRequest::Status::Canceled }
 488             ]
 489         }
 490     );
 491
 492     return $self->{_article_requests_finished};
 493 }
 494
 495 =head3 add_enrolment_fee_if_needed
 496
 497 my $enrolment_fee = $patron->add_enrolment_fee_if_needed;
 498
 499 Add enrolment fee for a patron if needed.
 500
 501 =cut
 502
 503 sub add_enrolment_fee_if_needed {
 504     my ($self) = @_;
 505     my $enrolment_fee = $self->category->enrolmentfee;
 506     if ( $enrolment_fee && $enrolment_fee > 0 ) {
 507         # insert fee in patron debts
 508         C4::Accounts::manualinvoice( $self->borrowernumber, '', '', 'A', $enrolment_fee );
 509     }
 510     return $enrolment_fee || 0;
 511 }
 512
 513 =head3 checkouts
 514
 515 my $checkouts = $patron->checkouts
 516
 517 =cut
 518
 519 sub checkouts {
 520     my ($self) = @_;
 521     my $checkouts = $self->_result->issues;
 522     return Koha::Checkouts->_new_from_dbic( $checkouts );
 523 }
 524
 525 =head3 old_checkouts
 526
 527 my $old_checkouts = $patron->old_checkouts
 528
 529 =cut
 530
 531 sub old_checkouts {
 532     my ($self) = @_;
 533     my $old_checkouts = $self->_result->old_issues;
 534     return Koha::Old::Checkouts->_new_from_dbic( $old_checkouts );
 535 }
 536
 537 =head3 get_overdues
 538
 539 my $overdue_items = $patron->get_overdues
 540
 541 Return the overdued items
 542
 543 =cut
 544
 545 sub get_overdues {
 546     my ($self) = @_;
 547     my $dtf = Koha::Database->new->schema->storage->datetime_parser;
 548     return $self->checkouts->search(
 549         {
 550             'me.date_due' => { '<' => $dtf->format_datetime(dt_from_string) },
 551         },
 552         {
 553             prefetch => { item => { biblio => 'biblioitems' } },
 554         }
 555     );
 556 }
 557
 558 =head3 get_age
 559
 560 my $age = $patron->get_age
 561
 562 Return the age of the patron
 563
 564 =cut
 565
 566 sub get_age {
 567     my ($self)    = @_;
 568     my $today_str = dt_from_string->strftime("%Y-%m-%d");
 569     return unless $self->dateofbirth;
 570     my $dob_str   = dt_from_string( $self->dateofbirth )->strftime("%Y-%m-%d");
 571
 572     my ( $dob_y,   $dob_m,   $dob_d )   = split /-/, $dob_str;
 573     my ( $today_y, $today_m, $today_d ) = split /-/, $today_str;
 574
 575     my $age = $today_y - $dob_y;
 576     if ( $dob_m . $dob_d > $today_m . $today_d ) {
 577         $age--;
 578     }
 579
 580     return $age;
 581 }
 582
 583 =head3 account
 584
 585 my $account = $patron->account
 586
 587 =cut
 588
 589 sub account {
 590     my ($self) = @_;
 591     return Koha::Account->new( { patron_id => $self->borrowernumber } );
 592 }
 593
 594 =head3 holds
 595
 596 my $holds = $patron->holds
 597
 598 Return all the holds placed by this patron
 599
 600 =cut
 601
 602 sub holds {
 603     my ($self) = @_;
 604     my $holds_rs = $self->_result->reserves->search( {}, { order_by => 'reservedate' } );
 605     return Koha::Holds->_new_from_dbic($holds_rs);
 606 }
 607
 608 =head3 old_holds
 609
 610 my $old_holds = $patron->old_holds
 611
 612 Return all the historical holds for this patron
 613
 614 =cut
 615
 616 sub old_holds {
 617     my ($self) = @_;
 618     my $old_holds_rs = $self->_result->old_reserves->search( {}, { order_by => 'reservedate' } );
 619     return Koha::Old::Holds->_new_from_dbic($old_holds_rs);
 620 }
 621
 622 =head3 first_valid_email_address
 623
 624 my $first_valid_email_address = $patron->first_valid_email_address
 625
 626 Return the first valid email address for a patron.
 627 For now, the order  is defined as email, emailpro, B_email.
 628 Returns the empty string if the borrower has no email addresses.
 629
 630 =cut
 631
 632 sub first_valid_email_address {
 633     my ($self) = @_;
 634
 635     return $self->email() || $self->emailpro() || $self->B_email() || q{};
 636 }
 637
 638 =head3 get_club_enrollments
 639
 640 =cut
 641
 642 sub get_club_enrollments {
 643     my ( $self, $return_scalar ) = @_;
 644
 645     my $e = Koha::Club::Enrollments->search( { borrowernumber => $self->borrowernumber(), date_canceled => undef } );
 646
 647     return $e if $return_scalar;
 648
 649     return wantarray ? $e->as_list : $e;
 650 }
 651
 652 =head3 get_enrollable_clubs
 653
 654 =cut
 655
 656 sub get_enrollable_clubs {
 657     my ( $self, $is_enrollable_from_opac, $return_scalar ) = @_;
 658
 659     my $params;
 660     $params->{is_enrollable_from_opac} = $is_enrollable_from_opac
 661       if $is_enrollable_from_opac;
 662     $params->{is_email_required} = 0 unless $self->first_valid_email_address();
 663
 664     $params->{borrower} = $self;
 665
 666     my $e = Koha::Clubs->get_enrollable($params);
 667
 668     return $e if $return_scalar;
 669
 670     return wantarray ? $e->as_list : $e;
 671 }
 672
 673 =head3 account_locked
 674
 675 my $is_locked = $patron->account_locked
 676
 677 Return true if the patron has reach the maximum number of login attempts (see pref FailedLoginAttempts).
 678 Otherwise return false.
 679 If the pref is not set (empty string, null or 0), the feature is considered as disabled.
 680
 681 =cut
 682
 683 sub account_locked {
 684     my ($self) = @_;
 685     my $FailedLoginAttempts = C4::Context->preference('FailedLoginAttempts');
 686     return ( $FailedLoginAttempts
 687           and $self->login_attempts
 688           and $self->login_attempts >= $FailedLoginAttempts )? 1 : 0;
 689 }
 690
 691 =head3 type
 692
 693 =cut
 694
 695 sub _type {
 696     return 'Borrower';
 697 }
 698
 699 =head1 AUTHOR
 700
 701 Kyle M Hall <kyle@bywatersolutions.com>
 702 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
 703
 704 =cut
 705
 706 1;