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