Koha/Patron.pm

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