Koha/Patron.pm

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