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