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 Text::Unaccent qw( unac_string );
  26
  27 use C4::Context;
  28 use C4::Log;
  29 use Koha::Checkouts;
  30 use Koha::Database;
  31 use Koha::DateUtils;
  32 use Koha::Holds;
  33 use Koha::Old::Checkouts;
  34 use Koha::Patron::Categories;
  35 use Koha::Patron::HouseboundProfile;
  36 use Koha::Patron::HouseboundRole;
  37 use Koha::Patron::Images;
  38 use Koha::Patrons;
  39 use Koha::Virtualshelves;
  40 use Koha::Club::Enrollments;
  41 use Koha::Account;
  42
  43 use base qw(Koha::Object);
  44
  45 our $RESULTSET_PATRON_ID_MAPPING = {
  46     Accountline          => 'borrowernumber',
  47     ArticleRequest       => 'borrowernumber',
  48     BorrowerAttribute    => 'borrowernumber',
  49     BorrowerDebarment    => 'borrowernumber',
  50     BorrowerFile         => 'borrowernumber',
  51     BorrowerModification => 'borrowernumber',
  52     ClubEnrollment       => 'borrowernumber',
  53     Issue                => 'borrowernumber',
  54     ItemsLastBorrower    => 'borrowernumber',
  55     Linktracker          => 'borrowernumber',
  56     Message              => 'borrowernumber',
  57     MessageQueue         => 'borrowernumber',
  58     OldIssue             => 'borrowernumber',
  59     OldReserve           => 'borrowernumber',
  60     Rating               => 'borrowernumber',
  61     Reserve              => 'borrowernumber',
  62     Review               => 'borrowernumber',
  63     Statistic            => 'borrowernumber',
  64     SearchHistory        => 'userid',
  65     Suggestion           => 'suggestedby',
  66     TagAll               => 'borrowernumber',
  67     Virtualshelfcontent  => 'borrowernumber',
  68     Virtualshelfshare    => 'borrowernumber',
  69     Virtualshelve        => 'owner',
  70 };
  71
  72 =head1 NAME
  73
  74 Koha::Patron - Koha Patron Object class
  75
  76 =head1 API
  77
  78 =head2 Class Methods
  79
  80 =cut
  81
  82 =head3 delete
  83
  84 $patron->delete
  85
  86 Delete patron's holds, lists and finally the patron.
  87
  88 Lists owned by the borrower are deleted, but entries from the borrower to
  89 other lists are kept.
  90
  91 =cut
  92
  93 sub delete {
  94     my ($self) = @_;
  95
  96     my $deleted;
  97     $self->_result->result_source->schema->txn_do(
  98         sub {
  99             # Delete Patron's holds
 100             $self->holds->delete;
 101
 102             # Delete all lists and all shares of this borrower
 103             # Consistent with the approach Koha uses on deleting individual lists
 104             # Note that entries in virtualshelfcontents added by this borrower to
 105             # lists of others will be handled by a table constraint: the borrower
 106             # is set to NULL in those entries.
 107             # NOTE:
 108             # We could handle the above deletes via a constraint too.
 109             # But a new BZ report 11889 has been opened to discuss another approach.
 110             # Instead of deleting we could also disown lists (based on a pref).
 111             # In that way we could save shared and public lists.
 112             # The current table constraints support that idea now.
 113             # This pref should then govern the results of other routines/methods such as
 114             # Koha::Virtualshelf->new->delete too.
 115             # FIXME Could be $patron->get_lists
 116             $_->delete for Koha::Virtualshelves->search( { owner => $self->borrowernumber } );
 117
 118             $deleted = $self->SUPER::delete;
 119
 120             logaction( "MEMBERS", "DELETE", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog");
 121         }
 122     );
 123     return $deleted;
 124 }
 125
 126
 127 =head3 category
 128
 129 my $patron_category = $patron->category
 130
 131 Return the patron category for this patron
 132
 133 =cut
 134
 135 sub category {
 136     my ( $self ) = @_;
 137     return Koha::Patron::Category->_new_from_dbic( $self->_result->categorycode );
 138 }
 139
 140 =head3 guarantor
 141
 142 Returns a Koha::Patron object for this patron's guarantor
 143
 144 =cut
 145
 146 sub guarantor {
 147     my ( $self ) = @_;
 148
 149     return unless $self->guarantorid();
 150
 151     return Koha::Patrons->find( $self->guarantorid() );
 152 }
 153
 154 sub image {
 155     my ( $self ) = @_;
 156
 157     return scalar Koha::Patron::Images->find( $self->borrowernumber );
 158 }
 159
 160 sub library {
 161     my ( $self ) = @_;
 162     return Koha::Library->_new_from_dbic($self->_result->branchcode);
 163 }
 164
 165 =head3 guarantees
 166
 167 Returns the guarantees (list of Koha::Patron) of this patron
 168
 169 =cut
 170
 171 sub guarantees {
 172     my ( $self ) = @_;
 173
 174     return Koha::Patrons->search( { guarantorid => $self->borrowernumber } );
 175 }
 176
 177 =head3 housebound_profile
 178
 179 Returns the HouseboundProfile associated with this patron.
 180
 181 =cut
 182
 183 sub housebound_profile {
 184     my ( $self ) = @_;
 185     my $profile = $self->_result->housebound_profile;
 186     return Koha::Patron::HouseboundProfile->_new_from_dbic($profile)
 187         if ( $profile );
 188     return;
 189 }
 190
 191 =head3 housebound_role
 192
 193 Returns the HouseboundRole associated with this patron.
 194
 195 =cut
 196
 197 sub housebound_role {
 198     my ( $self ) = @_;
 199
 200     my $role = $self->_result->housebound_role;
 201     return Koha::Patron::HouseboundRole->_new_from_dbic($role) if ( $role );
 202     return;
 203 }
 204
 205 =head3 siblings
 206
 207 Returns the siblings of this patron.
 208
 209 =cut
 210
 211 sub siblings {
 212     my ( $self ) = @_;
 213
 214     my $guarantor = $self->guarantor;
 215
 216     return unless $guarantor;
 217
 218     return Koha::Patrons->search(
 219         {
 220             guarantorid => {
 221                 '!=' => undef,
 222                 '=' => $guarantor->id,
 223             },
 224             borrowernumber => {
 225                 '!=' => $self->borrowernumber,
 226             }
 227         }
 228     );
 229 }
 230
 231 =head3 merge_with
 232
 233     my $patron = Koha::Patrons->find($id);
 234     $patron->merge_with( \@patron_ids );
 235
 236     This subroutine merges a list of patrons into the patron record. This is accomplished by finding
 237     all related patron ids for the patrons to be merged in other tables and changing the ids to be that
 238     of the keeper patron.
 239
 240 =cut
 241
 242 sub merge_with {
 243     my ( $self, $patron_ids ) = @_;
 244
 245     my @patron_ids = @{ $patron_ids };
 246
 247     # Ensure the keeper isn't in the list of patrons to merge
 248     @patron_ids = grep { $_ ne $self->id } @patron_ids;
 249
 250     my $schema = Koha::Database->new()->schema();
 251
 252     my $results;
 253
 254     $self->_result->result_source->schema->txn_do( sub {
 255         foreach my $patron_id (@patron_ids) {
 256             my $patron = Koha::Patrons->find( $patron_id );
 257
 258             next unless $patron;
 259
 260             # Unbless for safety, the patron will end up being deleted
 261             $results->{merged}->{$patron_id}->{patron} = $patron->unblessed;
 262
 263             while (my ($r, $field) = each(%$RESULTSET_PATRON_ID_MAPPING)) {
 264                 my $rs = $schema->resultset($r)->search({ $field => $patron_id });
 265                 $results->{merged}->{ $patron_id }->{updated}->{$r} = $rs->count();
 266                 $rs->update({ $field => $self->id });
 267             }
 268
 269             $patron->move_to_deleted();
 270             $patron->delete();
 271         }
 272     });
 273
 274     return $results;
 275 }
 276
 277
 278
 279 =head3 wants_check_for_previous_checkout
 280
 281     $wants_check = $patron->wants_check_for_previous_checkout;
 282
 283 Return 1 if Koha needs to perform PrevIssue checking, else 0.
 284
 285 =cut
 286
 287 sub wants_check_for_previous_checkout {
 288     my ( $self ) = @_;
 289     my $syspref = C4::Context->preference("checkPrevCheckout");
 290
 291     # Simple cases
 292     ## Hard syspref trumps all
 293     return 1 if ($syspref eq 'hardyes');
 294     return 0 if ($syspref eq 'hardno');
 295     ## Now, patron pref trumps all
 296     return 1 if ($self->checkprevcheckout eq 'yes');
 297     return 0 if ($self->checkprevcheckout eq 'no');
 298
 299     # More complex: patron inherits -> determine category preference
 300     my $checkPrevCheckoutByCat = $self->category->checkprevcheckout;
 301     return 1 if ($checkPrevCheckoutByCat eq 'yes');
 302     return 0 if ($checkPrevCheckoutByCat eq 'no');
 303
 304     # Finally: category preference is inherit, default to 0
 305     if ($syspref eq 'softyes') {
 306         return 1;
 307     } else {
 308         return 0;
 309     }
 310 }
 311
 312 =head3 do_check_for_previous_checkout
 313
 314     $do_check = $patron->do_check_for_previous_checkout($item);
 315
 316 Return 1 if the bib associated with $ITEM has previously been checked out to
 317 $PATRON, 0 otherwise.
 318
 319 =cut
 320
 321 sub do_check_for_previous_checkout {
 322     my ( $self, $item ) = @_;
 323
 324     # Find all items for bib and extract item numbers.
 325     my @items = Koha::Items->search({biblionumber => $item->{biblionumber}});
 326     my @item_nos;
 327     foreach my $item (@items) {
 328         push @item_nos, $item->itemnumber;
 329     }
 330
 331     # Create (old)issues search criteria
 332     my $criteria = {
 333         borrowernumber => $self->borrowernumber,
 334         itemnumber => \@item_nos,
 335     };
 336
 337     # Check current issues table
 338     my $issues = Koha::Checkouts->search($criteria);
 339     return 1 if $issues->count; # 0 || N
 340
 341     # Check old issues table
 342     my $old_issues = Koha::Old::Checkouts->search($criteria);
 343     return $old_issues->count;  # 0 || N
 344 }
 345
 346 =head3 is_debarred
 347
 348 my $debarment_expiration = $patron->is_debarred;
 349
 350 Returns the date a patron debarment will expire, or undef if the patron is not
 351 debarred
 352
 353 =cut
 354
 355 sub is_debarred {
 356     my ($self) = @_;
 357
 358     return unless $self->debarred;
 359     return $self->debarred
 360       if $self->debarred =~ '^9999'
 361       or dt_from_string( $self->debarred ) > dt_from_string;
 362     return;
 363 }
 364
 365 =head3 is_expired
 366
 367 my $is_expired = $patron->is_expired;
 368
 369 Returns 1 if the patron is expired or 0;
 370
 371 =cut
 372
 373 sub is_expired {
 374     my ($self) = @_;
 375     return 0 unless $self->dateexpiry;
 376     return 0 if $self->dateexpiry =~ '^9999';
 377     return 1 if dt_from_string( $self->dateexpiry ) < dt_from_string->truncate( to => 'day' );
 378     return 0;
 379 }
 380
 381 =head3 is_going_to_expire
 382
 383 my $is_going_to_expire = $patron->is_going_to_expire;
 384
 385 Returns 1 if the patron is going to expired, depending on the NotifyBorrowerDeparture pref or 0
 386
 387 =cut
 388
 389 sub is_going_to_expire {
 390     my ($self) = @_;
 391
 392     my $delay = C4::Context->preference('NotifyBorrowerDeparture') || 0;
 393
 394     return 0 unless $delay;
 395     return 0 unless $self->dateexpiry;
 396     return 0 if $self->dateexpiry =~ '^9999';
 397     return 1 if dt_from_string( $self->dateexpiry )->subtract( days => $delay ) < dt_from_string->truncate( to => 'day' );
 398     return 0;
 399 }
 400
 401 =head3 update_password
 402
 403 my $updated = $patron->update_password( $userid, $password );
 404
 405 Update the userid and the password of a patron.
 406 If the userid already exists, returns and let DBIx::Class warns
 407 This will add an entry to action_logs if BorrowersLog is set.
 408
 409 =cut
 410
 411 sub update_password {
 412     my ( $self, $userid, $password ) = @_;
 413     eval { $self->userid($userid)->store; };
 414     return if $@; # Make sure the userid is not already in used by another patron
 415     $self->update(
 416         {
 417             password       => $password,
 418             login_attempts => 0,
 419         }
 420     );
 421     logaction( "MEMBERS", "CHANGE PASS", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog");
 422     return 1;
 423 }
 424
 425 =head3 renew_account
 426
 427 my $new_expiry_date = $patron->renew_account
 428
 429 Extending the subscription to the expiry date.
 430
 431 =cut
 432
 433 sub renew_account {
 434     my ($self) = @_;
 435     my $date;
 436     if ( C4::Context->preference('BorrowerRenewalPeriodBase') eq 'combination' ) {
 437         $date = ( dt_from_string gt dt_from_string( $self->dateexpiry ) ) ? dt_from_string : dt_from_string( $self->dateexpiry );
 438     } else {
 439         $date =
 440             C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry'
 441             ? dt_from_string( $self->dateexpiry )
 442             : dt_from_string;
 443     }
 444     my $expiry_date = $self->category->get_expiry_date($date);
 445
 446     $self->dateexpiry($expiry_date);
 447     $self->date_renewed( dt_from_string() );
 448     $self->store();
 449
 450     $self->add_enrolment_fee_if_needed;
 451
 452     logaction( "MEMBERS", "RENEW", $self->borrowernumber, "Membership renewed" ) if C4::Context->preference("BorrowersLog");
 453     return dt_from_string( $expiry_date )->truncate( to => 'day' );
 454 }
 455
 456 =head3 has_overdues
 457
 458 my $has_overdues = $patron->has_overdues;
 459
 460 Returns the number of patron's overdues
 461
 462 =cut
 463
 464 sub has_overdues {
 465     my ($self) = @_;
 466     my $dtf = Koha::Database->new->schema->storage->datetime_parser;
 467     return $self->_result->issues->search({ date_due => { '<' => $dtf->format_datetime( dt_from_string() ) } })->count;
 468 }
 469
 470 =head3 track_login
 471
 472     $patron->track_login;
 473     $patron->track_login({ force => 1 });
 474
 475     Tracks a (successful) login attempt.
 476     The preference TrackLastPatronActivity must be enabled. Or you
 477     should pass the force parameter.
 478
 479 =cut
 480
 481 sub track_login {
 482     my ( $self, $params ) = @_;
 483     return if
 484         !$params->{force} &&
 485         !C4::Context->preference('TrackLastPatronActivity');
 486     $self->lastseen( dt_from_string() )->store;
 487 }
 488
 489 =head3 move_to_deleted
 490
 491 my $is_moved = $patron->move_to_deleted;
 492
 493 Move a patron to the deletedborrowers table.
 494 This can be done before deleting a patron, to make sure the data are not completely deleted.
 495
 496 =cut
 497
 498 sub move_to_deleted {
 499     my ($self) = @_;
 500     my $patron_infos = $self->unblessed;
 501     delete $patron_infos->{updated_on}; #This ensures the updated_on date in deletedborrowers will be set to the current timestamp
 502     return Koha::Database->new->schema->resultset('Deletedborrower')->create($patron_infos);
 503 }
 504
 505 =head3 article_requests
 506
 507 my @requests = $borrower->article_requests();
 508 my $requests = $borrower->article_requests();
 509
 510 Returns either a list of ArticleRequests objects,
 511 or an ArtitleRequests object, depending on the
 512 calling context.
 513
 514 =cut
 515
 516 sub article_requests {
 517     my ( $self ) = @_;
 518
 519     $self->{_article_requests} ||= Koha::ArticleRequests->search({ borrowernumber => $self->borrowernumber() });
 520
 521     return $self->{_article_requests};
 522 }
 523
 524 =head3 article_requests_current
 525
 526 my @requests = $patron->article_requests_current
 527
 528 Returns the article requests associated with this patron that are incomplete
 529
 530 =cut
 531
 532 sub article_requests_current {
 533     my ( $self ) = @_;
 534
 535     $self->{_article_requests_current} ||= Koha::ArticleRequests->search(
 536         {
 537             borrowernumber => $self->id(),
 538             -or          => [
 539                 { status => Koha::ArticleRequest::Status::Pending },
 540                 { status => Koha::ArticleRequest::Status::Processing }
 541             ]
 542         }
 543     );
 544
 545     return $self->{_article_requests_current};
 546 }
 547
 548 =head3 article_requests_finished
 549
 550 my @requests = $biblio->article_requests_finished
 551
 552 Returns the article requests associated with this patron that are completed
 553
 554 =cut
 555
 556 sub article_requests_finished {
 557     my ( $self, $borrower ) = @_;
 558
 559     $self->{_article_requests_finished} ||= Koha::ArticleRequests->search(
 560         {
 561             borrowernumber => $self->id(),
 562             -or          => [
 563                 { status => Koha::ArticleRequest::Status::Completed },
 564                 { status => Koha::ArticleRequest::Status::Canceled }
 565             ]
 566         }
 567     );
 568
 569     return $self->{_article_requests_finished};
 570 }
 571
 572 =head3 add_enrolment_fee_if_needed
 573
 574 my $enrolment_fee = $patron->add_enrolment_fee_if_needed;
 575
 576 Add enrolment fee for a patron if needed.
 577
 578 =cut
 579
 580 sub add_enrolment_fee_if_needed {
 581     my ($self) = @_;
 582     my $enrolment_fee = $self->category->enrolmentfee;
 583     if ( $enrolment_fee && $enrolment_fee > 0 ) {
 584         # insert fee in patron debts
 585         C4::Accounts::manualinvoice( $self->borrowernumber, '', '', 'A', $enrolment_fee );
 586     }
 587     return $enrolment_fee || 0;
 588 }
 589
 590 =head3 checkouts
 591
 592 my $checkouts = $patron->checkouts
 593
 594 =cut
 595
 596 sub checkouts {
 597     my ($self) = @_;
 598     my $checkouts = $self->_result->issues;
 599     return Koha::Checkouts->_new_from_dbic( $checkouts );
 600 }
 601
 602 =head3 pending_checkouts
 603
 604 my $pending_checkouts = $patron->pending_checkouts
 605
 606 This method will return the same as $self->checkouts, but with a prefetch on
 607 items, biblio and biblioitems.
 608
 609 It has been introduced to replaced the C4::Members::GetPendingIssues subroutine
 610
 611 It should not be used directly, prefer to access fields you need instead of
 612 retrieving all these fields in one go.
 613
 614
 615 =cut
 616
 617 sub pending_checkouts {
 618     my( $self ) = @_;
 619     my $checkouts = $self->_result->issues->search(
 620         {},
 621         {
 622             order_by => [
 623                 { -desc => 'me.timestamp' },
 624                 { -desc => 'issuedate' },
 625                 { -desc => 'issue_id' }, # Sort by issue_id should be enough
 626             ],
 627             prefetch => { item => { biblio => 'biblioitems' } },
 628         }
 629     );
 630     return Koha::Checkouts->_new_from_dbic( $checkouts );
 631 }
 632
 633 =head3 old_checkouts
 634
 635 my $old_checkouts = $patron->old_checkouts
 636
 637 =cut
 638
 639 sub old_checkouts {
 640     my ($self) = @_;
 641     my $old_checkouts = $self->_result->old_issues;
 642     return Koha::Old::Checkouts->_new_from_dbic( $old_checkouts );
 643 }
 644
 645 =head3 get_overdues
 646
 647 my $overdue_items = $patron->get_overdues
 648
 649 Return the overdued items
 650
 651 =cut
 652
 653 sub get_overdues {
 654     my ($self) = @_;
 655     my $dtf = Koha::Database->new->schema->storage->datetime_parser;
 656     return $self->checkouts->search(
 657         {
 658             'me.date_due' => { '<' => $dtf->format_datetime(dt_from_string) },
 659         },
 660         {
 661             prefetch => { item => { biblio => 'biblioitems' } },
 662         }
 663     );
 664 }
 665
 666 =head3 get_age
 667
 668 my $age = $patron->get_age
 669
 670 Return the age of the patron
 671
 672 =cut
 673
 674 sub get_age {
 675     my ($self)    = @_;
 676     my $today_str = dt_from_string->strftime("%Y-%m-%d");
 677     return unless $self->dateofbirth;
 678     my $dob_str   = dt_from_string( $self->dateofbirth )->strftime("%Y-%m-%d");
 679
 680     my ( $dob_y,   $dob_m,   $dob_d )   = split /-/, $dob_str;
 681     my ( $today_y, $today_m, $today_d ) = split /-/, $today_str;
 682
 683     my $age = $today_y - $dob_y;
 684     if ( $dob_m . $dob_d > $today_m . $today_d ) {
 685         $age--;
 686     }
 687
 688     return $age;
 689 }
 690
 691 =head3 account
 692
 693 my $account = $patron->account
 694
 695 =cut
 696
 697 sub account {
 698     my ($self) = @_;
 699     return Koha::Account->new( { patron_id => $self->borrowernumber } );
 700 }
 701
 702 =head3 holds
 703
 704 my $holds = $patron->holds
 705
 706 Return all the holds placed by this patron
 707
 708 =cut
 709
 710 sub holds {
 711     my ($self) = @_;
 712     my $holds_rs = $self->_result->reserves->search( {}, { order_by => 'reservedate' } );
 713     return Koha::Holds->_new_from_dbic($holds_rs);
 714 }
 715
 716 =head3 old_holds
 717
 718 my $old_holds = $patron->old_holds
 719
 720 Return all the historical holds for this patron
 721
 722 =cut
 723
 724 sub old_holds {
 725     my ($self) = @_;
 726     my $old_holds_rs = $self->_result->old_reserves->search( {}, { order_by => 'reservedate' } );
 727     return Koha::Old::Holds->_new_from_dbic($old_holds_rs);
 728 }
 729
 730 =head3 notice_email_address
 731
 732   my $email = $patron->notice_email_address;
 733
 734 Return the email address of patron used for notices.
 735 Returns the empty string if no email address.
 736
 737 =cut
 738
 739 sub notice_email_address{
 740     my ( $self ) = @_;
 741
 742     my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
 743     # if syspref is set to 'first valid' (value == OFF), look up email address
 744     if ( $which_address eq 'OFF' ) {
 745         return $self->first_valid_email_address;
 746     }
 747
 748     return $self->$which_address || '';
 749 }
 750
 751 =head3 first_valid_email_address
 752
 753 my $first_valid_email_address = $patron->first_valid_email_address
 754
 755 Return the first valid email address for a patron.
 756 For now, the order  is defined as email, emailpro, B_email.
 757 Returns the empty string if the borrower has no email addresses.
 758
 759 =cut
 760
 761 sub first_valid_email_address {
 762     my ($self) = @_;
 763
 764     return $self->email() || $self->emailpro() || $self->B_email() || q{};
 765 }
 766
 767 =head3 get_club_enrollments
 768
 769 =cut
 770
 771 sub get_club_enrollments {
 772     my ( $self, $return_scalar ) = @_;
 773
 774     my $e = Koha::Club::Enrollments->search( { borrowernumber => $self->borrowernumber(), date_canceled => undef } );
 775
 776     return $e if $return_scalar;
 777
 778     return wantarray ? $e->as_list : $e;
 779 }
 780
 781 =head3 get_enrollable_clubs
 782
 783 =cut
 784
 785 sub get_enrollable_clubs {
 786     my ( $self, $is_enrollable_from_opac, $return_scalar ) = @_;
 787
 788     my $params;
 789     $params->{is_enrollable_from_opac} = $is_enrollable_from_opac
 790       if $is_enrollable_from_opac;
 791     $params->{is_email_required} = 0 unless $self->first_valid_email_address();
 792
 793     $params->{borrower} = $self;
 794
 795     my $e = Koha::Clubs->get_enrollable($params);
 796
 797     return $e if $return_scalar;
 798
 799     return wantarray ? $e->as_list : $e;
 800 }
 801
 802 =head3 account_locked
 803
 804 my $is_locked = $patron->account_locked
 805
 806 Return true if the patron has reach the maximum number of login attempts (see pref FailedLoginAttempts).
 807 Otherwise return false.
 808 If the pref is not set (empty string, null or 0), the feature is considered as disabled.
 809
 810 =cut
 811
 812 sub account_locked {
 813     my ($self) = @_;
 814     my $FailedLoginAttempts = C4::Context->preference('FailedLoginAttempts');
 815     return ( $FailedLoginAttempts
 816           and $self->login_attempts
 817           and $self->login_attempts >= $FailedLoginAttempts )? 1 : 0;
 818 }
 819
 820 =head3 can_see_patron_infos
 821
 822 my $can_see = $patron->can_see_patron_infos( $patron );
 823
 824 Return true if the patron (usually the logged in user) can see the patron's infos for a given patron
 825
 826 =cut
 827
 828 sub can_see_patron_infos {
 829     my ( $self, $patron ) = @_;
 830     return $self->can_see_patrons_from( $patron->library->branchcode );
 831 }
 832
 833 =head3 can_see_patrons_from
 834
 835 my $can_see = $patron->can_see_patrons_from( $branchcode );
 836
 837 Return true if the patron (usually the logged in user) can see the patron's infos from a given library
 838
 839 =cut
 840
 841 sub can_see_patrons_from {
 842     my ( $self, $branchcode ) = @_;
 843     my $can = 0;
 844     if ( $self->branchcode eq $branchcode ) {
 845         $can = 1;
 846     } elsif ( $self->has_permission( { borrowers => 'view_borrower_infos_from_any_libraries' } ) ) {
 847         $can = 1;
 848     } elsif ( my $library_groups = $self->library->library_groups ) {
 849         while ( my $library_group = $library_groups->next ) {
 850             if ( $library_group->parent->has_child( $branchcode ) ) {
 851                 $can = 1;
 852                 last;
 853             }
 854         }
 855     }
 856     return $can;
 857 }
 858
 859 =head3 libraries_where_can_see_patrons
 860
 861 my $libraries = $patron-libraries_where_can_see_patrons;
 862
 863 Return the list of branchcodes(!) of libraries the patron is allowed to see other patron's infos.
 864 The branchcodes are arbitrarily returned sorted.
 865 We are supposing here that the object is related to the logged in patron (use of C4::Context::only_my_library)
 866
 867 An empty array means no restriction, the patron can see patron's infos from any libraries.
 868
 869 =cut
 870
 871 sub libraries_where_can_see_patrons {
 872     my ( $self ) = @_;
 873     my $userenv = C4::Context->userenv;
 874
 875     return () unless $userenv; # For tests, but userenv should be defined in tests...
 876
 877     my @restricted_branchcodes;
 878     if (C4::Context::only_my_library) {
 879         push @restricted_branchcodes, $self->branchcode;
 880     }
 881     else {
 882         unless (
 883             $self->has_permission(
 884                 { borrowers => 'view_borrower_infos_from_any_libraries' }
 885             )
 886           )
 887         {
 888             my $library_groups = $self->library->library_groups({ ft_hide_patron_info => 1 });
 889             if ( $library_groups->count )
 890             {
 891                 while ( my $library_group = $library_groups->next ) {
 892                     my $parent = $library_group->parent;
 893                     if ( $parent->has_child( $self->branchcode ) ) {
 894                         push @restricted_branchcodes, $parent->children->get_column('branchcode');
 895                     }
 896                 }
 897             }
 898
 899             @restricted_branchcodes = ( $self->branchcode ) unless @restricted_branchcodes;
 900         }
 901     }
 902
 903     @restricted_branchcodes = grep { defined $_ } @restricted_branchcodes;
 904     @restricted_branchcodes = uniq(@restricted_branchcodes);
 905     @restricted_branchcodes = sort(@restricted_branchcodes);
 906     return @restricted_branchcodes;
 907 }
 908
 909 sub has_permission {
 910     my ( $self, $flagsrequired ) = @_;
 911     return unless $self->userid;
 912     # TODO code from haspermission needs to be moved here!
 913     return C4::Auth::haspermission( $self->userid, $flagsrequired );
 914 }
 915
 916 =head3 is_adult
 917
 918 my $is_adult = $patron->is_adult
 919
 920 Return true if the patron has a category with a type Adult (A) or Organization (I)
 921
 922 =cut
 923
 924 sub is_adult {
 925     my ( $self ) = @_;
 926     return $self->category->category_type =~ /^(A|I)$/ ? 1 : 0;
 927 }
 928
 929 =head3 is_child
 930
 931 my $is_child = $patron->is_child
 932
 933 Return true if the patron has a category with a type Child (C)
 934
 935 =cut
 936 sub is_child {
 937     my( $self ) = @_;
 938     return $self->category->category_type eq 'C' ? 1 : 0;
 939 }
 940
 941 =head3 has_valid_userid
 942
 943 my $patron = Koha::Patrons->find(42);
 944 $patron->userid( $new_userid );
 945 my $has_a_valid_userid = $patron->has_valid_userid
 946
 947 my $patron = Koha::Patron->new( $params );
 948 my $has_a_valid_userid = $patron->has_valid_userid
 949
 950 Return true if the current userid of this patron is valid/unique, otherwise false.
 951
 952 Note that this should be done in $self->store instead and raise an exception if needed.
 953
 954 =cut
 955
 956 sub has_valid_userid {
 957     my ($self) = @_;
 958
 959     return 0 unless $self->userid;
 960
 961     return 0 if ( $self->userid eq C4::Context->config('user') );    # DB user
 962
 963     my $already_exists = Koha::Patrons->search(
 964         {
 965             userid => $self->userid,
 966             (
 967                 $self->in_storage
 968                 ? ( borrowernumber => { '!=' => $self->borrowernumber } )
 969                 : ()
 970             ),
 971         }
 972     )->count;
 973     return $already_exists ? 0 : 1;
 974 }
 975
 976 =head3 generate_userid
 977
 978 my $patron = Koha::Patron->new( $params );
 979 my $userid = $patron->generate_userid
 980
 981 Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
 982
 983 Return the generate 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).
 984
 985 # Note: Should we set $self->userid with the generated value?
 986 # Certainly yes, but we AddMember and ModMember will be rewritten
 987
 988 =cut
 989
 990 sub generate_userid {
 991     my ($self) = @_;
 992     my $userid;
 993     my $offset = 0;
 994     my $existing_userid = $self->userid;
 995     my $firstname = $self->firstname // q{};
 996     my $surname = $self->surname // q{};
 997     #The script will "do" the following code and increment the $offset until the generated userid is unique
 998     do {
 999       $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1000       $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1001       $userid = lc(($firstname)? "$firstname.$surname" : $surname);
1002       $userid = unac_string('utf-8',$userid);
1003       $userid .= $offset unless $offset == 0;
1004       $self->userid( $userid );
1005       $offset++;
1006      } while (! $self->has_valid_userid );
1007
1008      # Resetting to the previous value as the callers do not expect
1009      # this method to modify the userid attribute
1010      # This will be done later (move of AddMember and ModMember)
1011      $self->userid( $existing_userid );
1012
1013      return $userid;
1014
1015 }
1016
1017 =head2 Internal methods
1018
1019 =head3 _type
1020
1021 =cut
1022
1023 sub _type {
1024     return 'Borrower';
1025 }
1026
1027 =head1 AUTHOR
1028
1029 Kyle M Hall <kyle@bywatersolutions.com>
1030 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
1031
1032 =cut
1033
1034 1;