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