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