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