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