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 $issues = $patron->checkouts
 516
 517 =cut
 518
 519 sub checkouts {
 520     my ($self) = @_;
 521     my $issues = $self->_result->issues;
 522     return Koha::Checkouts->_new_from_dbic( $issues );
 523 }
 524
 525 =head3 get_overdues
 526
 527 my $overdue_items = $patron->get_overdues
 528
 529 Return the overdued items
 530
 531 =cut
 532
 533 sub get_overdues {
 534     my ($self) = @_;
 535     my $dtf = Koha::Database->new->schema->storage->datetime_parser;
 536     return $self->checkouts->search(
 537         {
 538             'me.date_due' => { '<' => $dtf->format_datetime(dt_from_string) },
 539         },
 540         {
 541             prefetch => { item => { biblio => 'biblioitems' } },
 542         }
 543     );
 544 }
 545
 546 =head3 get_age
 547
 548 my $age = $patron->get_age
 549
 550 Return the age of the patron
 551
 552 =cut
 553
 554 sub get_age {
 555     my ($self)    = @_;
 556     my $today_str = dt_from_string->strftime("%Y-%m-%d");
 557     return unless $self->dateofbirth;
 558     my $dob_str   = dt_from_string( $self->dateofbirth )->strftime("%Y-%m-%d");
 559
 560     my ( $dob_y,   $dob_m,   $dob_d )   = split /-/, $dob_str;
 561     my ( $today_y, $today_m, $today_d ) = split /-/, $today_str;
 562
 563     my $age = $today_y - $dob_y;
 564     if ( $dob_m . $dob_d > $today_m . $today_d ) {
 565         $age--;
 566     }
 567
 568     return $age;
 569 }
 570
 571 =head3 account
 572
 573 my $account = $patron->account
 574
 575 =cut
 576
 577 sub account {
 578     my ($self) = @_;
 579     return Koha::Account->new( { patron_id => $self->borrowernumber } );
 580 }
 581
 582 =head3 holds
 583
 584 my $holds = $patron->holds
 585
 586 Return all the holds placed by this patron
 587
 588 =cut
 589
 590 sub holds {
 591     my ($self) = @_;
 592     my $holds_rs = $self->_result->reserves->search( {}, { order_by => 'reservedate' } );
 593     return Koha::Holds->_new_from_dbic($holds_rs);
 594 }
 595
 596 =head3 old_holds
 597
 598 my $old_holds = $patron->old_holds
 599
 600 Return all the historical holds for this patron
 601
 602 =cut
 603
 604 sub old_holds {
 605     my ($self) = @_;
 606     my $old_holds_rs = $self->_result->old_reserves->search( {}, { order_by => 'reservedate' } );
 607     return Koha::Old::Holds->_new_from_dbic($old_holds_rs);
 608 }
 609
 610 =head3 first_valid_email_address
 611
 612 =cut
 613
 614 sub first_valid_email_address {
 615     my ($self) = @_;
 616
 617     return $self->email() || $self->emailpro() || $self->B_email() || q{};
 618 }
 619
 620 =head3 get_club_enrollments
 621
 622 =cut
 623
 624 sub get_club_enrollments {
 625     my ( $self, $return_scalar ) = @_;
 626
 627     my $e = Koha::Club::Enrollments->search( { borrowernumber => $self->borrowernumber(), date_canceled => undef } );
 628
 629     return $e if $return_scalar;
 630
 631     return wantarray ? $e->as_list : $e;
 632 }
 633
 634 =head3 get_enrollable_clubs
 635
 636 =cut
 637
 638 sub get_enrollable_clubs {
 639     my ( $self, $is_enrollable_from_opac, $return_scalar ) = @_;
 640
 641     my $params;
 642     $params->{is_enrollable_from_opac} = $is_enrollable_from_opac
 643       if $is_enrollable_from_opac;
 644     $params->{is_email_required} = 0 unless $self->first_valid_email_address();
 645
 646     $params->{borrower} = $self;
 647
 648     my $e = Koha::Clubs->get_enrollable($params);
 649
 650     return $e if $return_scalar;
 651
 652     return wantarray ? $e->as_list : $e;
 653 }
 654
 655 =head3 account_locked
 656
 657 my $is_locked = $patron->account_locked
 658
 659 Return true if the patron has reach the maximum number of login attempts (see pref FailedLoginAttempts).
 660 Otherwise return false.
 661 If the pref is not set (empty string, null or 0), the feature is considered as disabled.
 662
 663 =cut
 664
 665 sub account_locked {
 666     my ($self) = @_;
 667     my $FailedLoginAttempts = C4::Context->preference('FailedLoginAttempts');
 668     return ( $FailedLoginAttempts
 669           and $self->login_attempts
 670           and $self->login_attempts >= $FailedLoginAttempts )? 1 : 0;
 671 }
 672
 673 =head3 type
 674
 675 =cut
 676
 677 sub _type {
 678     return 'Borrower';
 679 }
 680
 681 =head1 AUTHOR
 682
 683 Kyle M Hall <kyle@bywatersolutions.com>
 684 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
 685
 686 =cut
 687
 688 1;