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