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