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)->store;
 370
 371     $self->add_enrolment_fee_if_needed;
 372
 373     logaction( "MEMBERS", "RENEW", $self->borrowernumber, "Membership renewed" ) if C4::Context->preference("BorrowersLog");
 374     return dt_from_string( $expiry_date )->truncate( to => 'day' );
 375 }
 376
 377 =head3 has_overdues
 378
 379 my $has_overdues = $patron->has_overdues;
 380
 381 Returns the number of patron's overdues
 382
 383 =cut
 384
 385 sub has_overdues {
 386     my ($self) = @_;
 387     my $dtf = Koha::Database->new->schema->storage->datetime_parser;
 388     return $self->_result->issues->search({ date_due => { '<' => $dtf->format_datetime( dt_from_string() ) } })->count;
 389 }
 390
 391 =head3 track_login
 392
 393     $patron->track_login;
 394     $patron->track_login({ force => 1 });
 395
 396     Tracks a (successful) login attempt.
 397     The preference TrackLastPatronActivity must be enabled. Or you
 398     should pass the force parameter.
 399
 400 =cut
 401
 402 sub track_login {
 403     my ( $self, $params ) = @_;
 404     return if
 405         !$params->{force} &&
 406         !C4::Context->preference('TrackLastPatronActivity');
 407     $self->lastseen( dt_from_string() )->store;
 408 }
 409
 410 =head3 move_to_deleted
 411
 412 my $is_moved = $patron->move_to_deleted;
 413
 414 Move a patron to the deletedborrowers table.
 415 This can be done before deleting a patron, to make sure the data are not completely deleted.
 416
 417 =cut
 418
 419 sub move_to_deleted {
 420     my ($self) = @_;
 421     my $patron_infos = $self->unblessed;
 422     delete $patron_infos->{updated_on}; #This ensures the updated_on date in deletedborrowers will be set to the current timestamp
 423     return Koha::Database->new->schema->resultset('Deletedborrower')->create($patron_infos);
 424 }
 425
 426 =head3 article_requests
 427
 428 my @requests = $borrower->article_requests();
 429 my $requests = $borrower->article_requests();
 430
 431 Returns either a list of ArticleRequests objects,
 432 or an ArtitleRequests object, depending on the
 433 calling context.
 434
 435 =cut
 436
 437 sub article_requests {
 438     my ( $self ) = @_;
 439
 440     $self->{_article_requests} ||= Koha::ArticleRequests->search({ borrowernumber => $self->borrowernumber() });
 441
 442     return $self->{_article_requests};
 443 }
 444
 445 =head3 article_requests_current
 446
 447 my @requests = $patron->article_requests_current
 448
 449 Returns the article requests associated with this patron that are incomplete
 450
 451 =cut
 452
 453 sub article_requests_current {
 454     my ( $self ) = @_;
 455
 456     $self->{_article_requests_current} ||= Koha::ArticleRequests->search(
 457         {
 458             borrowernumber => $self->id(),
 459             -or          => [
 460                 { status => Koha::ArticleRequest::Status::Pending },
 461                 { status => Koha::ArticleRequest::Status::Processing }
 462             ]
 463         }
 464     );
 465
 466     return $self->{_article_requests_current};
 467 }
 468
 469 =head3 article_requests_finished
 470
 471 my @requests = $biblio->article_requests_finished
 472
 473 Returns the article requests associated with this patron that are completed
 474
 475 =cut
 476
 477 sub article_requests_finished {
 478     my ( $self, $borrower ) = @_;
 479
 480     $self->{_article_requests_finished} ||= Koha::ArticleRequests->search(
 481         {
 482             borrowernumber => $self->id(),
 483             -or          => [
 484                 { status => Koha::ArticleRequest::Status::Completed },
 485                 { status => Koha::ArticleRequest::Status::Canceled }
 486             ]
 487         }
 488     );
 489
 490     return $self->{_article_requests_finished};
 491 }
 492
 493 =head3 add_enrolment_fee_if_needed
 494
 495 my $enrolment_fee = $patron->add_enrolment_fee_if_needed;
 496
 497 Add enrolment fee for a patron if needed.
 498
 499 =cut
 500
 501 sub add_enrolment_fee_if_needed {
 502     my ($self) = @_;
 503     my $enrolment_fee = $self->category->enrolmentfee;
 504     if ( $enrolment_fee && $enrolment_fee > 0 ) {
 505         # insert fee in patron debts
 506         C4::Accounts::manualinvoice( $self->borrowernumber, '', '', 'A', $enrolment_fee );
 507     }
 508     return $enrolment_fee || 0;
 509 }
 510
 511 =head3 checkouts
 512
 513 my $issues = $patron->checkouts
 514
 515 =cut
 516
 517 sub checkouts {
 518     my ($self) = @_;
 519     my $issues = $self->_result->issues;
 520     return Koha::Checkouts->_new_from_dbic( $issues );
 521 }
 522
 523 =head3 get_overdues
 524
 525 my $overdue_items = $patron->get_overdues
 526
 527 Return the overdued items
 528
 529 =cut
 530
 531 sub get_overdues {
 532     my ($self) = @_;
 533     my $dtf = Koha::Database->new->schema->storage->datetime_parser;
 534     return $self->checkouts->search(
 535         {
 536             'me.date_due' => { '<' => $dtf->format_datetime(dt_from_string) },
 537         },
 538         {
 539             prefetch => { item => { biblio => 'biblioitems' } },
 540         }
 541     );
 542 }
 543
 544 =head3 get_age
 545
 546 my $age = $patron->get_age
 547
 548 Return the age of the patron
 549
 550 =cut
 551
 552 sub get_age {
 553     my ($self)    = @_;
 554     my $today_str = dt_from_string->strftime("%Y-%m-%d");
 555     return unless $self->dateofbirth;
 556     my $dob_str   = dt_from_string( $self->dateofbirth )->strftime("%Y-%m-%d");
 557
 558     my ( $dob_y,   $dob_m,   $dob_d )   = split /-/, $dob_str;
 559     my ( $today_y, $today_m, $today_d ) = split /-/, $today_str;
 560
 561     my $age = $today_y - $dob_y;
 562     if ( $dob_m . $dob_d > $today_m . $today_d ) {
 563         $age--;
 564     }
 565
 566     return $age;
 567 }
 568
 569 =head3 account
 570
 571 my $account = $patron->account
 572
 573 =cut
 574
 575 sub account {
 576     my ($self) = @_;
 577     return Koha::Account->new( { patron_id => $self->borrowernumber } );
 578 }
 579
 580 =head3 holds
 581
 582 my $holds = $patron->holds
 583
 584 Return all the holds placed by this patron
 585
 586 =cut
 587
 588 sub holds {
 589     my ($self) = @_;
 590     my $holds_rs = $self->_result->reserves->search( {}, { order_by => 'reservedate' } );
 591     return Koha::Holds->_new_from_dbic($holds_rs);
 592 }
 593
 594 =head3 first_valid_email_address
 595
 596 =cut
 597
 598 sub first_valid_email_address {
 599     my ($self) = @_;
 600
 601     return $self->email() || $self->emailpro() || $self->B_email() || q{};
 602 }
 603
 604 =head3 get_club_enrollments
 605
 606 =cut
 607
 608 sub get_club_enrollments {
 609     my ( $self, $return_scalar ) = @_;
 610
 611     my $e = Koha::Club::Enrollments->search( { borrowernumber => $self->borrowernumber(), date_canceled => undef } );
 612
 613     return $e if $return_scalar;
 614
 615     return wantarray ? $e->as_list : $e;
 616 }
 617
 618 =head3 get_enrollable_clubs
 619
 620 =cut
 621
 622 sub get_enrollable_clubs {
 623     my ( $self, $is_enrollable_from_opac, $return_scalar ) = @_;
 624
 625     my $params;
 626     $params->{is_enrollable_from_opac} = $is_enrollable_from_opac
 627       if $is_enrollable_from_opac;
 628     $params->{is_email_required} = 0 unless $self->first_valid_email_address();
 629
 630     $params->{borrower} = $self;
 631
 632     my $e = Koha::Clubs->get_enrollable($params);
 633
 634     return $e if $return_scalar;
 635
 636     return wantarray ? $e->as_list : $e;
 637 }
 638
 639 =head3 account_locked
 640
 641 my $is_locked = $patron->account_locked
 642
 643 Return true if the patron has reach the maximum number of login attempts (see pref FailedLoginAttempts).
 644 Otherwise return false.
 645 If the pref is not set (empty string, null or 0), the feature is considered as disabled.
 646
 647 =cut
 648
 649 sub account_locked {
 650     my ($self) = @_;
 651     my $FailedLoginAttempts = C4::Context->preference('FailedLoginAttempts');
 652     return ( $FailedLoginAttempts
 653           and $self->login_attempts
 654           and $self->login_attempts >= $FailedLoginAttempts )? 1 : 0;
 655 }
 656
 657 =head3 type
 658
 659 =cut
 660
 661 sub _type {
 662     return 'Borrower';
 663 }
 664
 665 =head1 AUTHOR
 666
 667 Kyle M Hall <kyle@bywatersolutions.com>
 668 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
 669
 670 =cut
 671
 672 1;