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
   9 # under the terms of the GNU General Public License as published by
  10 # the Free Software Foundation; either version 3 of the License, or
  11 # (at your option) any later version.
  12 #
  13 # Koha is distributed in the hope that it will be useful, but
  14 # WITHOUT ANY WARRANTY; without even the implied warranty of
  15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  16 # GNU General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU General Public License
  19 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  20
  21 use Modern::Perl;
  22
  23 use List::MoreUtils qw( any uniq );
  24 use JSON qw( to_json );
  25 use Unicode::Normalize qw( NFKD );
  26
  27 use C4::Context;
  28 use C4::Log qw( logaction );
  29 use Koha::Account;
  30 use Koha::ArticleRequests;
  31 use C4::Letters;
  32 use Koha::AuthUtils;
  33 use Koha::Checkouts;
  34 use Koha::CirculationRules;
  35 use Koha::Club::Enrollments;
  36 use Koha::Database;
  37 use Koha::DateUtils qw( dt_from_string );
  38 use Koha::Exceptions::Password;
  39 use Koha::Holds;
  40 use Koha::Old::Checkouts;
  41 use Koha::Patron::Attributes;
  42 use Koha::Patron::Categories;
  43 use Koha::Patron::Debarments;
  44 use Koha::Patron::HouseboundProfile;
  45 use Koha::Patron::HouseboundRole;
  46 use Koha::Patron::Images;
  47 use Koha::Patron::Modifications;
  48 use Koha::Patron::Relationships;
  49 use Koha::Patrons;
  50 use Koha::Plugins;
  51 use Koha::Result::Boolean;
  52 use Koha::Subscription::Routinglists;
  53 use Koha::Token;
  54 use Koha::Virtualshelves;
  55
  56 use base qw(Koha::Object);
  57
  58 use constant ADMINISTRATIVE_LOCKOUT => -1;
  59
  60 our $RESULTSET_PATRON_ID_MAPPING = {
  61     Accountline          => 'borrowernumber',
  62     Aqbasketuser         => 'borrowernumber',
  63     Aqbudget             => 'budget_owner_id',
  64     Aqbudgetborrower     => 'borrowernumber',
  65     ArticleRequest       => 'borrowernumber',
  66     BorrowerDebarment    => 'borrowernumber',
  67     BorrowerFile         => 'borrowernumber',
  68     BorrowerModification => 'borrowernumber',
  69     ClubEnrollment       => 'borrowernumber',
  70     Issue                => 'borrowernumber',
  71     ItemsLastBorrower    => 'borrowernumber',
  72     Linktracker          => 'borrowernumber',
  73     Message              => 'borrowernumber',
  74     MessageQueue         => 'borrowernumber',
  75     OldIssue             => 'borrowernumber',
  76     OldReserve           => 'borrowernumber',
  77     Rating               => 'borrowernumber',
  78     Reserve              => 'borrowernumber',
  79     Review               => 'borrowernumber',
  80     SearchHistory        => 'userid',
  81     Statistic            => 'borrowernumber',
  82     Suggestion           => 'suggestedby',
  83     TagAll               => 'borrowernumber',
  84     Virtualshelfcontent  => 'borrowernumber',
  85     Virtualshelfshare    => 'borrowernumber',
  86     Virtualshelve        => 'owner',
  87 };
  88
  89 =head1 NAME
  90
  91 Koha::Patron - Koha Patron Object class
  92
  93 =head1 API
  94
  95 =head2 Class Methods
  96
  97 =head3 new
  98
  99 =cut
 100
 101 sub new {
 102     my ( $class, $params ) = @_;
 103
 104     return $class->SUPER::new($params);
 105 }
 106
 107 =head3 fixup_cardnumber
 108
 109 Autogenerate next cardnumber from highest value found in database
 110
 111 =cut
 112
 113 sub fixup_cardnumber {
 114     my ( $self ) = @_;
 115
 116     my $max = $self->cardnumber;
 117     Koha::Plugins->call( 'patron_barcode_transform', \$max );
 118
 119     $max ||= Koha::Patrons->search({
 120         cardnumber => {-regexp => '^-?[0-9]+$'}
 121     }, {
 122         select => \'CAST(cardnumber AS SIGNED)',
 123         as => ['cast_cardnumber']
 124     })->_resultset->get_column('cast_cardnumber')->max;
 125     $self->cardnumber(($max || 0) +1);
 126 }
 127
 128 =head3 trim_whitespace
 129
 130 trim whitespace from data which has some non-whitespace in it.
 131 Could be moved to Koha::Object if need to be reused
 132
 133 =cut
 134
 135 sub trim_whitespaces {
 136     my( $self ) = @_;
 137
 138     my $schema  = Koha::Database->new->schema;
 139     my @columns = $schema->source($self->_type)->columns;
 140
 141     for my $column( @columns ) {
 142         my $value = $self->$column;
 143         if ( defined $value ) {
 144             $value =~ s/^\s*|\s*$//g;
 145             $self->$column($value);
 146         }
 147     }
 148     return $self;
 149 }
 150
 151 =head3 plain_text_password
 152
 153 $patron->plain_text_password( $password );
 154
 155 stores a copy of the unencrypted password in the object
 156 for use in code before encrypting for db
 157
 158 =cut
 159
 160 sub plain_text_password {
 161     my ( $self, $password ) = @_;
 162     if ( $password ) {
 163         $self->{_plain_text_password} = $password;
 164         return $self;
 165     }
 166     return $self->{_plain_text_password}
 167         if $self->{_plain_text_password};
 168
 169     return;
 170 }
 171
 172 =head3 store
 173
 174 Patron specific store method to cleanup record
 175 and do other necessary things before saving
 176 to db
 177
 178 =cut
 179
 180 sub store {
 181     my ($self) = @_;
 182
 183     $self->_result->result_source->schema->txn_do(
 184         sub {
 185             if (
 186                 C4::Context->preference("autoMemberNum")
 187                 and ( not defined $self->cardnumber
 188                     or $self->cardnumber eq '' )
 189               )
 190             {
 191                 # Warning: The caller is responsible for locking the members table in write
 192                 # mode, to avoid database corruption.
 193                 # We are in a transaction but the table is not locked
 194                 $self->fixup_cardnumber;
 195             }
 196
 197             unless( $self->category->in_storage ) {
 198                 Koha::Exceptions::Object::FKConstraint->throw(
 199                     broken_fk => 'categorycode',
 200                     value     => $self->categorycode,
 201                 );
 202             }
 203
 204             $self->trim_whitespaces;
 205
 206             my $new_cardnumber = $self->cardnumber;
 207             Koha::Plugins->call( 'patron_barcode_transform', \$new_cardnumber );
 208             $self->cardnumber( $new_cardnumber );
 209
 210             # Set surname to uppercase if uppercasesurname is true
 211             $self->surname( uc($self->surname) )
 212                 if C4::Context->preference("uppercasesurnames");
 213
 214             $self->relationship(undef) # We do not want to store an empty string in this field
 215               if defined $self->relationship
 216                      and $self->relationship eq "";
 217
 218             unless ( $self->in_storage ) {    #AddMember
 219
 220                 # Generate a valid userid/login if needed
 221                 $self->generate_userid
 222                   if not $self->userid or not $self->has_valid_userid;
 223
 224                 # Add expiration date if it isn't already there
 225                 unless ( $self->dateexpiry ) {
 226                     $self->dateexpiry( $self->category->get_expiry_date );
 227                 }
 228
 229                 # Add enrollment date if it isn't already there
 230                 unless ( $self->dateenrolled ) {
 231                     $self->dateenrolled(dt_from_string);
 232                 }
 233
 234                 # Set the privacy depending on the patron's category
 235                 my $default_privacy = $self->category->default_privacy || q{};
 236                 $default_privacy =
 237                     $default_privacy eq 'default' ? 1
 238                   : $default_privacy eq 'never'   ? 2
 239                   : $default_privacy eq 'forever' ? 0
 240                   :                                                   undef;
 241                 $self->privacy($default_privacy);
 242
 243                 # Call any check_password plugins if password is passed
 244                 if ( C4::Context->config("enable_plugins") && $self->password ) {
 245                     my @plugins = Koha::Plugins->new()->GetPlugins({
 246                         method => 'check_password',
 247                     });
 248                     foreach my $plugin ( @plugins ) {
 249                         # This plugin hook will also be used by a plugin for the Norwegian national
 250                         # patron database. This is why we need to pass both the password and the
 251                         # borrowernumber to the plugin.
 252                         my $ret = $plugin->check_password(
 253                             {
 254                                 password       => $self->password,
 255                                 borrowernumber => $self->borrowernumber
 256                             }
 257                         );
 258                         if ( $ret->{'error'} == 1 ) {
 259                             Koha::Exceptions::Password::Plugin->throw();
 260                         }
 261                     }
 262                 }
 263
 264                 # Make a copy of the plain text password for later use
 265                 $self->plain_text_password( $self->password );
 266
 267                 # Create a disabled account if no password provided
 268                 $self->password( $self->password
 269                     ? Koha::AuthUtils::hash_password( $self->password )
 270                     : '!' );
 271
 272                 $self->borrowernumber(undef);
 273
 274                 $self = $self->SUPER::store;
 275
 276                 $self->add_enrolment_fee_if_needed(0);
 277
 278                 logaction( "MEMBERS", "CREATE", $self->borrowernumber, "" )
 279                   if C4::Context->preference("BorrowersLog");
 280             }
 281             else {    #ModMember
 282
 283                 my $self_from_storage = $self->get_from_storage;
 284                 # FIXME We should not deal with that here, callers have to do this job
 285                 # Moved from ModMember to prevent regressions
 286                 unless ( $self->userid ) {
 287                     my $stored_userid = $self_from_storage->userid;
 288                     $self->userid($stored_userid);
 289                 }
 290
 291                 # Password must be updated using $self->set_password
 292                 $self->password($self_from_storage->password);
 293
 294                 if ( $self->category->categorycode ne
 295                     $self_from_storage->category->categorycode )
 296                 {
 297                     # Add enrolement fee on category change if required
 298                     $self->add_enrolment_fee_if_needed(1)
 299                       if C4::Context->preference('FeeOnChangePatronCategory');
 300
 301                     # Clean up guarantors on category change if required
 302                     $self->guarantor_relationships->delete
 303                       if ( $self->category->category_type ne 'C'
 304                         && $self->category->category_type ne 'P' );
 305
 306                 }
 307
 308                 # Actionlogs
 309                 if ( C4::Context->preference("BorrowersLog") ) {
 310                     my $info;
 311                     my $from_storage = $self_from_storage->unblessed;
 312                     my $from_object  = $self->unblessed;
 313                     my @skip_fields  = (qw/lastseen updated_on/);
 314                     for my $key ( keys %{$from_storage} ) {
 315                         next if any { /$key/ } @skip_fields;
 316                         if (
 317                             (
 318                                   !defined( $from_storage->{$key} )
 319                                 && defined( $from_object->{$key} )
 320                             )
 321                             || ( defined( $from_storage->{$key} )
 322                                 && !defined( $from_object->{$key} ) )
 323                             || (
 324                                    defined( $from_storage->{$key} )
 325                                 && defined( $from_object->{$key} )
 326                                 && ( $from_storage->{$key} ne
 327                                     $from_object->{$key} )
 328                             )
 329                           )
 330                         {
 331                             $info->{$key} = {
 332                                 before => $from_storage->{$key},
 333                                 after  => $from_object->{$key}
 334                             };
 335                         }
 336                     }
 337
 338                     if ( defined($info) ) {
 339                         logaction(
 340                             "MEMBERS",
 341                             "MODIFY",
 342                             $self->borrowernumber,
 343                             to_json(
 344                                 $info,
 345                                 { utf8 => 1, pretty => 1, canonical => 1 }
 346                             )
 347                         );
 348                     }
 349                 }
 350
 351                 # Final store
 352                 $self = $self->SUPER::store;
 353             }
 354         }
 355     );
 356     return $self;
 357 }
 358
 359 =head3 delete
 360
 361 $patron->delete
 362
 363 Delete patron's holds, lists and finally the patron.
 364
 365 Lists owned by the borrower are deleted, but entries from the borrower to
 366 other lists are kept.
 367
 368 =cut
 369
 370 sub delete {
 371     my ($self) = @_;
 372
 373     my $anonymous_patron = C4::Context->preference("AnonymousPatron");
 374     Koha::Exceptions::Patron::FailedDeleteAnonymousPatron->throw() if $anonymous_patron && $self->id eq $anonymous_patron;
 375
 376     $self->_result->result_source->schema->txn_do(
 377         sub {
 378             # Cancel Patron's holds
 379             my $holds = $self->holds;
 380             while( my $hold = $holds->next ){
 381                 $hold->cancel;
 382             }
 383
 384             # Delete all lists and all shares of this borrower
 385             # Consistent with the approach Koha uses on deleting individual lists
 386             # Note that entries in virtualshelfcontents added by this borrower to
 387             # lists of others will be handled by a table constraint: the borrower
 388             # is set to NULL in those entries.
 389             # NOTE:
 390             # We could handle the above deletes via a constraint too.
 391             # But a new BZ report 11889 has been opened to discuss another approach.
 392             # Instead of deleting we could also disown lists (based on a pref).
 393             # In that way we could save shared and public lists.
 394             # The current table constraints support that idea now.
 395             # This pref should then govern the results of other routines/methods such as
 396             # Koha::Virtualshelf->new->delete too.
 397             # FIXME Could be $patron->get_lists
 398             $_->delete for Koha::Virtualshelves->search( { owner => $self->borrowernumber } );
 399
 400             # We cannot have a FK on borrower_modifications.borrowernumber, the table is also used
 401             # for patron selfreg
 402             $_->delete for Koha::Patron::Modifications->search( { borrowernumber => $self->borrowernumber } );
 403
 404             $self->SUPER::delete;
 405
 406             logaction( "MEMBERS", "DELETE", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog");
 407         }
 408     );
 409     return $self;
 410 }
 411
 412
 413 =head3 category
 414
 415 my $patron_category = $patron->category
 416
 417 Return the patron category for this patron
 418
 419 =cut
 420
 421 sub category {
 422     my ( $self ) = @_;
 423     return Koha::Patron::Category->_new_from_dbic( $self->_result->categorycode );
 424 }
 425
 426 =head3 image
 427
 428 =cut
 429
 430 sub image {
 431     my ( $self ) = @_;
 432
 433     return Koha::Patron::Images->find( $self->borrowernumber );
 434 }
 435
 436 =head3 library
 437
 438 Returns a Koha::Library object representing the patron's home library.
 439
 440 =cut
 441
 442 sub library {
 443     my ( $self ) = @_;
 444     return Koha::Library->_new_from_dbic($self->_result->branchcode);
 445 }
 446
 447 =head3 sms_provider
 448
 449 Returns a Koha::SMS::Provider object representing the patron's SMS provider.
 450
 451 =cut
 452
 453 sub sms_provider {
 454     my ( $self ) = @_;
 455     my $sms_provider_rs = $self->_result->sms_provider;
 456     return unless $sms_provider_rs;
 457     return Koha::SMS::Provider->_new_from_dbic($sms_provider_rs);
 458 }
 459
 460 =head3 guarantor_relationships
 461
 462 Returns Koha::Patron::Relationships object for this patron's guarantors
 463
 464 Returns the set of relationships for the patrons that are guarantors for this patron.
 465
 466 This is returned instead of a Koha::Patron object because the guarantor
 467 may not exist as a patron in Koha. If this is true, the guarantors name
 468 exists in the Koha::Patron::Relationship object and will have no guarantor_id.
 469
 470 =cut
 471
 472 sub guarantor_relationships {
 473     my ($self) = @_;
 474
 475     return Koha::Patron::Relationships->search( { guarantee_id => $self->id } );
 476 }
 477
 478 =head3 guarantee_relationships
 479
 480 Returns Koha::Patron::Relationships object for this patron's guarantors
 481
 482 Returns the set of relationships for the patrons that are guarantees for this patron.
 483
 484 The method returns Koha::Patron::Relationship objects for the sake
 485 of consistency with the guantors method.
 486 A guarantee by definition must exist as a patron in Koha.
 487
 488 =cut
 489
 490 sub guarantee_relationships {
 491     my ($self) = @_;
 492
 493     return Koha::Patron::Relationships->search(
 494         { guarantor_id => $self->id },
 495         {
 496             prefetch => 'guarantee',
 497             order_by => { -asc => [ 'guarantee.surname', 'guarantee.firstname' ] },
 498         }
 499     );
 500 }
 501
 502 =head3 relationships_debt
 503
 504 Returns the amount owed by the patron's guarantors *and* the other guarantees of those guarantors
 505
 506 =cut
 507
 508 sub relationships_debt {
 509     my ($self, $params) = @_;
 510
 511     my $include_guarantors  = $params->{include_guarantors};
 512     my $only_this_guarantor = $params->{only_this_guarantor};
 513     my $include_this_patron = $params->{include_this_patron};
 514
 515     my @guarantors;
 516     if ( $only_this_guarantor ) {
 517         @guarantors = $self->guarantee_relationships->count ? ( $self ) : ();
 518         Koha::Exceptions::BadParameter->throw( { parameter => 'only_this_guarantor' } ) unless @guarantors;
 519     } elsif ( $self->guarantor_relationships->count ) {
 520         # I am a guarantee, just get all my guarantors
 521         @guarantors = $self->guarantor_relationships->guarantors;
 522     } else {
 523         # I am a guarantor, I need to get all the guarantors of all my guarantees
 524         @guarantors = map { $_->guarantor_relationships->guarantors } $self->guarantee_relationships->guarantees;
 525     }
 526
 527     my $non_issues_charges = 0;
 528     my $seen = $include_this_patron ? {} : { $self->id => 1 }; # For tracking members already added to the total
 529     foreach my $guarantor (@guarantors) {
 530         $non_issues_charges += $guarantor->account->non_issues_charges if $include_guarantors && !$seen->{ $guarantor->id };
 531
 532         # We've added what the guarantor owes, not added in that guarantor's guarantees as well
 533         my @guarantees = map { $_->guarantee } $guarantor->guarantee_relationships();
 534         my $guarantees_non_issues_charges = 0;
 535         foreach my $guarantee (@guarantees) {
 536             next if $seen->{ $guarantee->id };
 537             $guarantees_non_issues_charges += $guarantee->account->non_issues_charges;
 538             # Mark this guarantee as seen so we don't double count a guarantee linked to multiple guarantors
 539             $seen->{ $guarantee->id } = 1;
 540         }
 541
 542         $non_issues_charges += $guarantees_non_issues_charges;
 543         $seen->{ $guarantor->id } = 1;
 544     }
 545
 546     return $non_issues_charges;
 547 }
 548
 549 =head3 housebound_profile
 550
 551 Returns the HouseboundProfile associated with this patron.
 552
 553 =cut
 554
 555 sub housebound_profile {
 556     my ( $self ) = @_;
 557     my $profile = $self->_result->housebound_profile;
 558     return Koha::Patron::HouseboundProfile->_new_from_dbic($profile)
 559         if ( $profile );
 560     return;
 561 }
 562
 563 =head3 housebound_role
 564
 565 Returns the HouseboundRole associated with this patron.
 566
 567 =cut
 568
 569 sub housebound_role {
 570     my ( $self ) = @_;
 571
 572     my $role = $self->_result->housebound_role;
 573     return Koha::Patron::HouseboundRole->_new_from_dbic($role) if ( $role );
 574     return;
 575 }
 576
 577 =head3 siblings
 578
 579 Returns the siblings of this patron.
 580
 581 =cut
 582
 583 sub siblings {
 584     my ($self) = @_;
 585
 586     my @guarantors = $self->guarantor_relationships()->guarantors();
 587
 588     return unless @guarantors;
 589
 590     my @siblings =
 591       map { $_->guarantee_relationships()->guarantees() } @guarantors;
 592
 593     return unless @siblings;
 594
 595     my %seen;
 596     @siblings =
 597       grep { !$seen{ $_->id }++ && ( $_->id != $self->id ) } @siblings;
 598
 599     return wantarray ? @siblings : Koha::Patrons->search( { borrowernumber => { -in => [ map { $_->id } @siblings ] } } );
 600 }
 601
 602 =head3 merge_with
 603
 604     my $patron = Koha::Patrons->find($id);
 605     $patron->merge_with( \@patron_ids );
 606
 607     This subroutine merges a list of patrons into the patron record. This is accomplished by finding
 608     all related patron ids for the patrons to be merged in other tables and changing the ids to be that
 609     of the keeper patron.
 610
 611 =cut
 612
 613 sub merge_with {
 614     my ( $self, $patron_ids ) = @_;
 615
 616     my $anonymous_patron = C4::Context->preference("AnonymousPatron");
 617     return if $anonymous_patron && $self->id eq $anonymous_patron;
 618
 619     my @patron_ids = @{ $patron_ids };
 620
 621     # Ensure the keeper isn't in the list of patrons to merge
 622     @patron_ids = grep { $_ ne $self->id } @patron_ids;
 623
 624     my $schema = Koha::Database->new()->schema();
 625
 626     my $results;
 627
 628     $self->_result->result_source->schema->txn_do( sub {
 629         foreach my $patron_id (@patron_ids) {
 630
 631             next if $patron_id eq $anonymous_patron;
 632
 633             my $patron = Koha::Patrons->find( $patron_id );
 634
 635             next unless $patron;
 636
 637             # Unbless for safety, the patron will end up being deleted
 638             $results->{merged}->{$patron_id}->{patron} = $patron->unblessed;
 639
 640             my $attributes = $patron->extended_attributes;
 641             my $new_attributes = [
 642                 map { { code => $_->code, attribute => $_->attribute } }
 643                     $attributes->as_list
 644             ];
 645             $attributes->delete; # We need to delete before trying to merge them to prevent exception on unique and repeatable
 646             for my $attribute ( @$new_attributes ) {
 647                 $self->add_extended_attribute($attribute);
 648             }
 649
 650             while (my ($r, $field) = each(%$RESULTSET_PATRON_ID_MAPPING)) {
 651                 my $rs = $schema->resultset($r)->search({ $field => $patron_id });
 652                 $results->{merged}->{ $patron_id }->{updated}->{$r} = $rs->count();
 653                 $rs->update({ $field => $self->id });
 654                 if ( $r eq 'BorrowerDebarment' ) {
 655                     Koha::Patron::Debarments::UpdateBorrowerDebarmentFlags($self->id);
 656                 }
 657             }
 658
 659             $patron->move_to_deleted();
 660             $patron->delete();
 661         }
 662     });
 663
 664     return $results;
 665 }
 666
 667
 668
 669 =head3 wants_check_for_previous_checkout
 670
 671     $wants_check = $patron->wants_check_for_previous_checkout;
 672
 673 Return 1 if Koha needs to perform PrevIssue checking, else 0.
 674
 675 =cut
 676
 677 sub wants_check_for_previous_checkout {
 678     my ( $self ) = @_;
 679     my $syspref = C4::Context->preference("checkPrevCheckout");
 680
 681     # Simple cases
 682     ## Hard syspref trumps all
 683     return 1 if ($syspref eq 'hardyes');
 684     return 0 if ($syspref eq 'hardno');
 685     ## Now, patron pref trumps all
 686     return 1 if ($self->checkprevcheckout eq 'yes');
 687     return 0 if ($self->checkprevcheckout eq 'no');
 688
 689     # More complex: patron inherits -> determine category preference
 690     my $checkPrevCheckoutByCat = $self->category->checkprevcheckout;
 691     return 1 if ($checkPrevCheckoutByCat eq 'yes');
 692     return 0 if ($checkPrevCheckoutByCat eq 'no');
 693
 694     # Finally: category preference is inherit, default to 0
 695     if ($syspref eq 'softyes') {
 696         return 1;
 697     } else {
 698         return 0;
 699     }
 700 }
 701
 702 =head3 do_check_for_previous_checkout
 703
 704     $do_check = $patron->do_check_for_previous_checkout($item);
 705
 706 Return 1 if the bib associated with $ITEM has previously been checked out to
 707 $PATRON, 0 otherwise.
 708
 709 =cut
 710
 711 sub do_check_for_previous_checkout {
 712     my ( $self, $item ) = @_;
 713
 714     my @item_nos;
 715     my $biblio = Koha::Biblios->find( $item->{biblionumber} );
 716     if ( $biblio->is_serial ) {
 717         push @item_nos, $item->{itemnumber};
 718     } else {
 719         # Get all itemnumbers for given bibliographic record.
 720         @item_nos = $biblio->items->get_column( 'itemnumber' );
 721     }
 722
 723     # Create (old)issues search criteria
 724     my $criteria = {
 725         borrowernumber => $self->borrowernumber,
 726         itemnumber => \@item_nos,
 727     };
 728
 729     my $delay = C4::Context->preference('CheckPrevCheckoutDelay') || 0;
 730     if ($delay) {
 731         my $dtf = Koha::Database->new->schema->storage->datetime_parser;
 732         my $newer_than = dt_from_string()->subtract( days => $delay );
 733         $criteria->{'returndate'} = { '>'   =>  $dtf->format_datetime($newer_than), };
 734     }
 735
 736     # Check current issues table
 737     my $issues = Koha::Checkouts->search($criteria);
 738     return 1 if $issues->count; # 0 || N
 739
 740     # Check old issues table
 741     my $old_issues = Koha::Old::Checkouts->search($criteria);
 742     return $old_issues->count;  # 0 || N
 743 }
 744
 745 =head3 is_debarred
 746
 747 my $debarment_expiration = $patron->is_debarred;
 748
 749 Returns the date a patron debarment will expire, or undef if the patron is not
 750 debarred
 751
 752 =cut
 753
 754 sub is_debarred {
 755     my ($self) = @_;
 756
 757     return unless $self->debarred;
 758     return $self->debarred
 759       if $self->debarred =~ '^9999'
 760       or dt_from_string( $self->debarred ) > dt_from_string;
 761     return;
 762 }
 763
 764 =head3 is_expired
 765
 766 my $is_expired = $patron->is_expired;
 767
 768 Returns 1 if the patron is expired or 0;
 769
 770 =cut
 771
 772 sub is_expired {
 773     my ($self) = @_;
 774     return 0 unless $self->dateexpiry;
 775     return 0 if $self->dateexpiry =~ '^9999';
 776     return 1 if dt_from_string( $self->dateexpiry ) < dt_from_string->truncate( to => 'day' );
 777     return 0;
 778 }
 779
 780 =head3 is_going_to_expire
 781
 782 my $is_going_to_expire = $patron->is_going_to_expire;
 783
 784 Returns 1 if the patron is going to expired, depending on the NotifyBorrowerDeparture pref or 0
 785
 786 =cut
 787
 788 sub is_going_to_expire {
 789     my ($self) = @_;
 790
 791     my $delay = C4::Context->preference('NotifyBorrowerDeparture') || 0;
 792
 793     return 0 unless $delay;
 794     return 0 unless $self->dateexpiry;
 795     return 0 if $self->dateexpiry =~ '^9999';
 796     return 1 if dt_from_string( $self->dateexpiry, undef, 'floating' )->subtract( days => $delay ) < dt_from_string(undef, undef, 'floating')->truncate( to => 'day' );
 797     return 0;
 798 }
 799
 800 =head3 set_password
 801
 802     $patron->set_password({ password => $plain_text_password [, skip_validation => 1 ] });
 803
 804 Set the patron's password.
 805
 806 =head4 Exceptions
 807
 808 The passed string is validated against the current password enforcement policy.
 809 Validation can be skipped by passing the I<skip_validation> parameter.
 810
 811 Exceptions are thrown if the password is not good enough.
 812
 813 =over 4
 814
 815 =item Koha::Exceptions::Password::TooShort
 816
 817 =item Koha::Exceptions::Password::WhitespaceCharacters
 818
 819 =item Koha::Exceptions::Password::TooWeak
 820
 821 =item Koha::Exceptions::Password::Plugin (if a "check password" plugin is enabled)
 822
 823 =back
 824
 825 =cut
 826
 827 sub set_password {
 828     my ( $self, $args ) = @_;
 829
 830     my $password = $args->{password};
 831
 832     unless ( $args->{skip_validation} ) {
 833         my ( $is_valid, $error ) = Koha::AuthUtils::is_password_valid( $password, $self->category );
 834
 835         if ( !$is_valid ) {
 836             if ( $error eq 'too_short' ) {
 837                 my $min_length = $self->category->effective_min_password_length;
 838                 $min_length = 3 if not $min_length or $min_length < 3;
 839
 840                 my $password_length = length($password);
 841                 Koha::Exceptions::Password::TooShort->throw(
 842                     length => $password_length, min_length => $min_length );
 843             }
 844             elsif ( $error eq 'has_whitespaces' ) {
 845                 Koha::Exceptions::Password::WhitespaceCharacters->throw();
 846             }
 847             elsif ( $error eq 'too_weak' ) {
 848                 Koha::Exceptions::Password::TooWeak->throw();
 849             }
 850         }
 851     }
 852
 853     if ( C4::Context->config("enable_plugins") ) {
 854         # Call any check_password plugins
 855         my @plugins = Koha::Plugins->new()->GetPlugins({
 856             method => 'check_password',
 857         });
 858         foreach my $plugin ( @plugins ) {
 859             # This plugin hook will also be used by a plugin for the Norwegian national
 860             # patron database. This is why we need to pass both the password and the
 861             # borrowernumber to the plugin.
 862             my $ret = $plugin->check_password(
 863                 {
 864                     password       => $password,
 865                     borrowernumber => $self->borrowernumber
 866                 }
 867             );
 868             # This plugin hook will also be used by a plugin for the Norwegian national
 869             # patron database. This is why we need to call the actual plugins and then
 870             # check skip_validation afterwards.
 871             if ( $ret->{'error'} == 1 && !$args->{skip_validation} ) {
 872                 Koha::Exceptions::Password::Plugin->throw();
 873             }
 874         }
 875     }
 876
 877     my $digest = Koha::AuthUtils::hash_password($password);
 878
 879     # We do not want to call $self->store and retrieve password from DB
 880     $self->password($digest);
 881     $self->login_attempts(0);
 882     $self->SUPER::store;
 883
 884     logaction( "MEMBERS", "CHANGE PASS", $self->borrowernumber, "" )
 885         if C4::Context->preference("BorrowersLog");
 886
 887     return $self;
 888 }
 889
 890
 891 =head3 renew_account
 892
 893 my $new_expiry_date = $patron->renew_account
 894
 895 Extending the subscription to the expiry date.
 896
 897 =cut
 898
 899 sub renew_account {
 900     my ($self) = @_;
 901     my $date;
 902     if ( C4::Context->preference('BorrowerRenewalPeriodBase') eq 'combination' ) {
 903         $date = ( dt_from_string gt dt_from_string( $self->dateexpiry ) ) ? dt_from_string : dt_from_string( $self->dateexpiry );
 904     } else {
 905         $date =
 906             C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry'
 907             ? dt_from_string( $self->dateexpiry )
 908             : dt_from_string;
 909     }
 910     my $expiry_date = $self->category->get_expiry_date($date);
 911
 912     $self->dateexpiry($expiry_date);
 913     $self->date_renewed( dt_from_string() );
 914     $self->store();
 915
 916     $self->add_enrolment_fee_if_needed(1);
 917
 918     logaction( "MEMBERS", "RENEW", $self->borrowernumber, "Membership renewed" ) if C4::Context->preference("BorrowersLog");
 919     return dt_from_string( $expiry_date )->truncate( to => 'day' );
 920 }
 921
 922 =head3 has_overdues
 923
 924 my $has_overdues = $patron->has_overdues;
 925
 926 Returns the number of patron's overdues
 927
 928 =cut
 929
 930 sub has_overdues {
 931     my ($self) = @_;
 932     my $dtf = Koha::Database->new->schema->storage->datetime_parser;
 933     return $self->_result->issues->search({ date_due => { '<' => $dtf->format_datetime( dt_from_string() ) } })->count;
 934 }
 935
 936 =head3 track_login
 937
 938     $patron->track_login;
 939     $patron->track_login({ force => 1 });
 940
 941     Tracks a (successful) login attempt.
 942     The preference TrackLastPatronActivity must be enabled. Or you
 943     should pass the force parameter.
 944
 945 =cut
 946
 947 sub track_login {
 948     my ( $self, $params ) = @_;
 949     return if
 950         !$params->{force} &&
 951         !C4::Context->preference('TrackLastPatronActivity');
 952     $self->lastseen( dt_from_string() )->store;
 953 }
 954
 955 =head3 move_to_deleted
 956
 957 my $is_moved = $patron->move_to_deleted;
 958
 959 Move a patron to the deletedborrowers table.
 960 This can be done before deleting a patron, to make sure the data are not completely deleted.
 961
 962 =cut
 963
 964 sub move_to_deleted {
 965     my ($self) = @_;
 966     my $patron_infos = $self->unblessed;
 967     delete $patron_infos->{updated_on}; #This ensures the updated_on date in deletedborrowers will be set to the current timestamp
 968     return Koha::Database->new->schema->resultset('Deletedborrower')->create($patron_infos);
 969 }
 970
 971 =head3 can_request_article
 972
 973     if ( $patron->can_request_article( $library->id ) ) { ... }
 974
 975 Returns true if the patron can request articles. As limits apply for the patron
 976 on the same day, those completed the same day are considered as current.
 977
 978 A I<library_id> can be passed as parameter, falling back to userenv if absent.
 979
 980 =cut
 981
 982 sub can_request_article {
 983     my ($self, $library_id) = @_;
 984
 985     $library_id //= C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef;
 986
 987     my $rule = Koha::CirculationRules->get_effective_rule(
 988         {
 989             branchcode   => $library_id,
 990             categorycode => $self->categorycode,
 991             rule_name    => 'open_article_requests_limit'
 992         }
 993     );
 994
 995     my $limit = ($rule) ? $rule->rule_value : undef;
 996
 997     return 1 unless defined $limit;
 998
 999     my $count = Koha::ArticleRequests->search(
1000         [   { borrowernumber => $self->borrowernumber, status => [ 'REQUESTED', 'PENDING', 'PROCESSING' ] },
1001             { borrowernumber => $self->borrowernumber, status => 'COMPLETED', updated_on => { '>=' => \'CAST(NOW() AS DATE)' } },
1002         ]
1003     )->count;
1004     return $count < $limit ? 1 : 0;
1005 }
1006
1007 =head3 article_request_fee
1008
1009     my $fee = $patron->article_request_fee(
1010         {
1011           [ library_id => $library->id, ]
1012         }
1013     );
1014
1015 Returns the fee to be charged to the patron when it places an article request.
1016
1017 A I<library_id> can be passed as parameter, falling back to userenv if absent.
1018
1019 =cut
1020
1021 sub article_request_fee {
1022     my ($self, $params) = @_;
1023
1024     my $library_id = $params->{library_id};
1025
1026     $library_id //= C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef;
1027
1028     my $rule = Koha::CirculationRules->get_effective_rule(
1029         {
1030             branchcode   => $library_id,
1031             categorycode => $self->categorycode,
1032             rule_name    => 'article_request_fee'
1033         }
1034     );
1035
1036     my $fee = ($rule) ? $rule->rule_value + 0 : 0;
1037
1038     return $fee;
1039 }
1040
1041 =head3 add_article_request_fee_if_needed
1042
1043     my $fee = $patron->add_article_request_fee_if_needed(
1044         {
1045           [ item_id    => $item->id,
1046             library_id => $library->id, ]
1047         }
1048     );
1049
1050 If an article request fee needs to be charged, it adds a debit to the patron's
1051 account.
1052
1053 Returns the fee line.
1054
1055 A I<library_id> can be passed as parameter, falling back to userenv if absent.
1056
1057 =cut
1058
1059 sub add_article_request_fee_if_needed {
1060     my ($self, $params) = @_;
1061
1062     my $library_id = $params->{library_id};
1063     my $item_id    = $params->{item_id};
1064
1065     $library_id //= C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef;
1066
1067     my $amount = $self->article_request_fee(
1068         {
1069             library_id => $library_id,
1070         }
1071     );
1072
1073     my $debit_line;
1074
1075     if ( $amount > 0 ) {
1076         $debit_line = $self->account->add_debit(
1077             {
1078                 amount     => $amount,
1079                 user_id    => C4::Context->userenv ? C4::Context->userenv->{'number'} : undef,
1080                 interface  => C4::Context->interface,
1081                 library_id => $library_id,
1082                 type       => 'ARTICLE_REQUEST',
1083                 item_id    => $item_id,
1084             }
1085         );
1086     }
1087
1088     return $debit_line;
1089 }
1090
1091 =head3 article_requests
1092
1093     my $article_requests = $patron->article_requests;
1094
1095 Returns the patron article requests.
1096
1097 =cut
1098
1099 sub article_requests {
1100     my ($self) = @_;
1101
1102     return Koha::ArticleRequests->_new_from_dbic( scalar $self->_result->article_requests );
1103 }
1104
1105 =head3 add_enrolment_fee_if_needed
1106
1107 my $enrolment_fee = $patron->add_enrolment_fee_if_needed($renewal);
1108
1109 Add enrolment fee for a patron if needed.
1110
1111 $renewal - boolean denoting whether this is an account renewal or not
1112
1113 =cut
1114
1115 sub add_enrolment_fee_if_needed {
1116     my ($self, $renewal) = @_;
1117     my $enrolment_fee = $self->category->enrolmentfee;
1118     if ( $enrolment_fee && $enrolment_fee > 0 ) {
1119         my $type = $renewal ? 'ACCOUNT_RENEW' : 'ACCOUNT';
1120         $self->account->add_debit(
1121             {
1122                 amount     => $enrolment_fee,
1123                 user_id    => C4::Context->userenv ? C4::Context->userenv->{'number'} : undef,
1124                 interface  => C4::Context->interface,
1125                 library_id => C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef,
1126                 type       => $type
1127             }
1128         );
1129     }
1130     return $enrolment_fee || 0;
1131 }
1132
1133 =head3 checkouts
1134
1135 my $checkouts = $patron->checkouts
1136
1137 =cut
1138
1139 sub checkouts {
1140     my ($self) = @_;
1141     my $checkouts = $self->_result->issues;
1142     return Koha::Checkouts->_new_from_dbic( $checkouts );
1143 }
1144
1145 =head3 pending_checkouts
1146
1147 my $pending_checkouts = $patron->pending_checkouts
1148
1149 This method will return the same as $self->checkouts, but with a prefetch on
1150 items, biblio and biblioitems.
1151
1152 It has been introduced to replaced the C4::Members::GetPendingIssues subroutine
1153
1154 It should not be used directly, prefer to access fields you need instead of
1155 retrieving all these fields in one go.
1156
1157 =cut
1158
1159 sub pending_checkouts {
1160     my( $self ) = @_;
1161     my $checkouts = $self->_result->issues->search(
1162         {},
1163         {
1164             order_by => [
1165                 { -desc => 'me.timestamp' },
1166                 { -desc => 'issuedate' },
1167                 { -desc => 'issue_id' }, # Sort by issue_id should be enough
1168             ],
1169             prefetch => { item => { biblio => 'biblioitems' } },
1170         }
1171     );
1172     return Koha::Checkouts->_new_from_dbic( $checkouts );
1173 }
1174
1175 =head3 old_checkouts
1176
1177 my $old_checkouts = $patron->old_checkouts
1178
1179 =cut
1180
1181 sub old_checkouts {
1182     my ($self) = @_;
1183     my $old_checkouts = $self->_result->old_issues;
1184     return Koha::Old::Checkouts->_new_from_dbic( $old_checkouts );
1185 }
1186
1187 =head3 get_overdues
1188
1189 my $overdue_items = $patron->get_overdues
1190
1191 Return the overdue items
1192
1193 =cut
1194
1195 sub get_overdues {
1196     my ($self) = @_;
1197     my $dtf = Koha::Database->new->schema->storage->datetime_parser;
1198     return $self->checkouts->search(
1199         {
1200             'me.date_due' => { '<' => $dtf->format_datetime(dt_from_string) },
1201         },
1202         {
1203             prefetch => { item => { biblio => 'biblioitems' } },
1204         }
1205     );
1206 }
1207
1208 =head3 get_routing_lists
1209
1210 my @routinglists = $patron->get_routing_lists
1211
1212 Returns the routing lists a patron is subscribed to.
1213
1214 =cut
1215
1216 sub get_routing_lists {
1217     my ($self) = @_;
1218     my $routing_list_rs = $self->_result->subscriptionroutinglists;
1219     return Koha::Subscription::Routinglists->_new_from_dbic($routing_list_rs);
1220 }
1221
1222 =head3 get_age
1223
1224 my $age = $patron->get_age
1225
1226 Return the age of the patron
1227
1228 =cut
1229
1230 sub get_age {
1231     my ($self)    = @_;
1232     my $today_str = dt_from_string->strftime("%Y-%m-%d");
1233     return unless $self->dateofbirth;
1234     my $dob_str   = dt_from_string( $self->dateofbirth )->strftime("%Y-%m-%d");
1235
1236     my ( $dob_y,   $dob_m,   $dob_d )   = split /-/, $dob_str;
1237     my ( $today_y, $today_m, $today_d ) = split /-/, $today_str;
1238
1239     my $age = $today_y - $dob_y;
1240     if ( $dob_m . $dob_d > $today_m . $today_d ) {
1241         $age--;
1242     }
1243
1244     return $age;
1245 }
1246
1247 =head3 is_valid_age
1248
1249 my $is_valid = $patron->is_valid_age
1250
1251 Return 1 if patron's age is between allowed limits, returns 0 if it's not.
1252
1253 =cut
1254
1255 sub is_valid_age {
1256     my ($self) = @_;
1257     my $age = $self->get_age;
1258
1259     my $patroncategory = $self->category;
1260     my ($low,$high) = ($patroncategory->dateofbirthrequired, $patroncategory->upperagelimit);
1261
1262     return (defined($age) && (($high && ($age > $high)) or ($low && ($age < $low)))) ? 0 : 1;
1263 }
1264
1265 =head3 account
1266
1267 my $account = $patron->account
1268
1269 =cut
1270
1271 sub account {
1272     my ($self) = @_;
1273     return Koha::Account->new( { patron_id => $self->borrowernumber } );
1274 }
1275
1276 =head3 holds
1277
1278 my $holds = $patron->holds
1279
1280 Return all the holds placed by this patron
1281
1282 =cut
1283
1284 sub holds {
1285     my ($self) = @_;
1286     my $holds_rs = $self->_result->reserves->search( {}, { order_by => 'reservedate' } );
1287     return Koha::Holds->_new_from_dbic($holds_rs);
1288 }
1289
1290 =head3 old_holds
1291
1292 my $old_holds = $patron->old_holds
1293
1294 Return all the historical holds for this patron
1295
1296 =cut
1297
1298 sub old_holds {
1299     my ($self) = @_;
1300     my $old_holds_rs = $self->_result->old_reserves->search( {}, { order_by => 'reservedate' } );
1301     return Koha::Old::Holds->_new_from_dbic($old_holds_rs);
1302 }
1303
1304 =head3 return_claims
1305
1306 my $return_claims = $patron->return_claims
1307
1308 =cut
1309
1310 sub return_claims {
1311     my ($self) = @_;
1312     my $return_claims = $self->_result->return_claims_borrowernumbers;
1313     return Koha::Checkouts::ReturnClaims->_new_from_dbic( $return_claims );
1314 }
1315
1316 =head3 notice_email_address
1317
1318   my $email = $patron->notice_email_address;
1319
1320 Return the email address of patron used for notices.
1321 Returns the empty string if no email address.
1322
1323 =cut
1324
1325 sub notice_email_address{
1326     my ( $self ) = @_;
1327
1328     my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
1329     # if syspref is set to 'first valid' (value == OFF), look up email address
1330     if ( $which_address eq 'OFF' ) {
1331         return $self->first_valid_email_address;
1332     }
1333
1334     return $self->$which_address || '';
1335 }
1336
1337 =head3 first_valid_email_address
1338
1339 my $first_valid_email_address = $patron->first_valid_email_address
1340
1341 Return the first valid email address for a patron.
1342 For now, the order  is defined as email, emailpro, B_email.
1343 Returns the empty string if the borrower has no email addresses.
1344
1345 =cut
1346
1347 sub first_valid_email_address {
1348     my ($self) = @_;
1349
1350     return $self->email() || $self->emailpro() || $self->B_email() || q{};
1351 }
1352
1353 =head3 get_club_enrollments
1354
1355 =cut
1356
1357 sub get_club_enrollments {
1358     my ( $self, $return_scalar ) = @_;
1359
1360     my $e = Koha::Club::Enrollments->search( { borrowernumber => $self->borrowernumber(), date_canceled => undef } );
1361
1362     return $e if $return_scalar;
1363
1364     return wantarray ? $e->as_list : $e;
1365 }
1366
1367 =head3 get_enrollable_clubs
1368
1369 =cut
1370
1371 sub get_enrollable_clubs {
1372     my ( $self, $is_enrollable_from_opac, $return_scalar ) = @_;
1373
1374     my $params;
1375     $params->{is_enrollable_from_opac} = $is_enrollable_from_opac
1376       if $is_enrollable_from_opac;
1377     $params->{is_email_required} = 0 unless $self->first_valid_email_address();
1378
1379     $params->{borrower} = $self;
1380
1381     my $e = Koha::Clubs->get_enrollable($params);
1382
1383     return $e if $return_scalar;
1384
1385     return wantarray ? $e->as_list : $e;
1386 }
1387
1388 =head3 account_locked
1389
1390 my $is_locked = $patron->account_locked
1391
1392 Return true if the patron has reached the maximum number of login attempts
1393 (see pref FailedLoginAttempts). If login_attempts is < 0, this is interpreted
1394 as an administrative lockout (independent of FailedLoginAttempts; see also
1395 Koha::Patron->lock).
1396 Otherwise return false.
1397 If the pref is not set (empty string, null or 0), the feature is considered as
1398 disabled.
1399
1400 =cut
1401
1402 sub account_locked {
1403     my ($self) = @_;
1404     my $FailedLoginAttempts = C4::Context->preference('FailedLoginAttempts');
1405     return 1 if $FailedLoginAttempts
1406           and $self->login_attempts
1407           and $self->login_attempts >= $FailedLoginAttempts;
1408     return 1 if ($self->login_attempts || 0) < 0; # administrative lockout
1409     return 0;
1410 }
1411
1412 =head3 can_see_patron_infos
1413
1414 my $can_see = $patron->can_see_patron_infos( $patron );
1415
1416 Return true if the patron (usually the logged in user) can see the patron's infos for a given patron
1417
1418 =cut
1419
1420 sub can_see_patron_infos {
1421     my ( $self, $patron ) = @_;
1422     return unless $patron;
1423     return $self->can_see_patrons_from( $patron->branchcode );
1424 }
1425
1426 =head3 can_see_patrons_from
1427
1428 my $can_see = $patron->can_see_patrons_from( $branchcode );
1429
1430 Return true if the patron (usually the logged in user) can see the patron's infos from a given library
1431
1432 =cut
1433
1434 sub can_see_patrons_from {
1435     my ( $self, $branchcode ) = @_;
1436     my $can = 0;
1437     if ( $self->branchcode eq $branchcode ) {
1438         $can = 1;
1439     } elsif ( $self->has_permission( { borrowers => 'view_borrower_infos_from_any_libraries' } ) ) {
1440         $can = 1;
1441     } elsif ( my $library_groups = $self->library->library_groups ) {
1442         while ( my $library_group = $library_groups->next ) {
1443             if ( $library_group->parent->has_child( $branchcode ) ) {
1444                 $can = 1;
1445                 last;
1446             }
1447         }
1448     }
1449     return $can;
1450 }
1451
1452 =head3 can_log_into
1453
1454 my $can_log_into = $patron->can_log_into( $library );
1455
1456 Given a I<Koha::Library> object, it returns a boolean representing
1457 the fact the patron can log into a the library.
1458
1459 =cut
1460
1461 sub can_log_into {
1462     my ( $self, $library ) = @_;
1463
1464     my $can = 0;
1465
1466     if ( C4::Context->preference('IndependentBranches') ) {
1467         $can = 1
1468           if $self->is_superlibrarian
1469           or $self->branchcode eq $library->id;
1470     }
1471     else {
1472         # no restrictions
1473         $can = 1;
1474     }
1475
1476    return $can;
1477 }
1478
1479 =head3 libraries_where_can_see_patrons
1480
1481 my $libraries = $patron-libraries_where_can_see_patrons;
1482
1483 Return the list of branchcodes(!) of libraries the patron is allowed to see other patron's infos.
1484 The branchcodes are arbitrarily returned sorted.
1485 We are supposing here that the object is related to the logged in patron (use of C4::Context::only_my_library)
1486
1487 An empty array means no restriction, the patron can see patron's infos from any libraries.
1488
1489 =cut
1490
1491 sub libraries_where_can_see_patrons {
1492     my ( $self ) = @_;
1493     my $userenv = C4::Context->userenv;
1494
1495     return () unless $userenv; # For tests, but userenv should be defined in tests...
1496
1497     my @restricted_branchcodes;
1498     if (C4::Context::only_my_library) {
1499         push @restricted_branchcodes, $self->branchcode;
1500     }
1501     else {
1502         unless (
1503             $self->has_permission(
1504                 { borrowers => 'view_borrower_infos_from_any_libraries' }
1505             )
1506           )
1507         {
1508             my $library_groups = $self->library->library_groups({ ft_hide_patron_info => 1 });
1509             if ( $library_groups->count )
1510             {
1511                 while ( my $library_group = $library_groups->next ) {
1512                     my $parent = $library_group->parent;
1513                     if ( $parent->has_child( $self->branchcode ) ) {
1514                         push @restricted_branchcodes, $parent->children->get_column('branchcode');
1515                     }
1516                 }
1517             }
1518
1519             @restricted_branchcodes = ( $self->branchcode ) unless @restricted_branchcodes;
1520         }
1521     }
1522
1523     @restricted_branchcodes = grep { defined $_ } @restricted_branchcodes;
1524     @restricted_branchcodes = uniq(@restricted_branchcodes);
1525     @restricted_branchcodes = sort(@restricted_branchcodes);
1526     return @restricted_branchcodes;
1527 }
1528
1529 =head3 has_permission
1530
1531 my $permission = $patron->has_permission($required);
1532
1533 See C4::Auth::haspermission for details of syntax for $required
1534
1535 =cut
1536
1537 sub has_permission {
1538     my ( $self, $flagsrequired ) = @_;
1539     return unless $self->userid;
1540     # TODO code from haspermission needs to be moved here!
1541     return C4::Auth::haspermission( $self->userid, $flagsrequired );
1542 }
1543
1544 =head3 is_superlibrarian
1545
1546   my $is_superlibrarian = $patron->is_superlibrarian;
1547
1548 Return true if the patron is a superlibrarian.
1549
1550 =cut
1551
1552 sub is_superlibrarian {
1553     my ($self) = @_;
1554     return $self->has_permission( { superlibrarian => 1 } ) ? 1 : 0;
1555 }
1556
1557 =head3 is_adult
1558
1559 my $is_adult = $patron->is_adult
1560
1561 Return true if the patron has a category with a type Adult (A) or Organization (I)
1562
1563 =cut
1564
1565 sub is_adult {
1566     my ( $self ) = @_;
1567     return $self->category->category_type =~ /^(A|I)$/ ? 1 : 0;
1568 }
1569
1570 =head3 is_child
1571
1572 my $is_child = $patron->is_child
1573
1574 Return true if the patron has a category with a type Child (C)
1575
1576 =cut
1577
1578 sub is_child {
1579     my( $self ) = @_;
1580     return $self->category->category_type eq 'C' ? 1 : 0;
1581 }
1582
1583 =head3 has_valid_userid
1584
1585 my $patron = Koha::Patrons->find(42);
1586 $patron->userid( $new_userid );
1587 my $has_a_valid_userid = $patron->has_valid_userid
1588
1589 my $patron = Koha::Patron->new( $params );
1590 my $has_a_valid_userid = $patron->has_valid_userid
1591
1592 Return true if the current userid of this patron is valid/unique, otherwise false.
1593
1594 Note that this should be done in $self->store instead and raise an exception if needed.
1595
1596 =cut
1597
1598 sub has_valid_userid {
1599     my ($self) = @_;
1600
1601     return 0 unless $self->userid;
1602
1603     return 0 if ( $self->userid eq C4::Context->config('user') );    # DB user
1604
1605     my $already_exists = Koha::Patrons->search(
1606         {
1607             userid => $self->userid,
1608             (
1609                 $self->in_storage
1610                 ? ( borrowernumber => { '!=' => $self->borrowernumber } )
1611                 : ()
1612             ),
1613         }
1614     )->count;
1615     return $already_exists ? 0 : 1;
1616 }
1617
1618 =head3 generate_userid
1619
1620 my $patron = Koha::Patron->new( $params );
1621 $patron->generate_userid
1622
1623 Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
1624
1625 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).
1626
1627 =cut
1628
1629 sub generate_userid {
1630     my ($self) = @_;
1631     my $offset = 0;
1632     my $firstname = $self->firstname // q{};
1633     my $surname = $self->surname // q{};
1634     #The script will "do" the following code and increment the $offset until the generated userid is unique
1635     do {
1636       $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1637       $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1638       my $userid = lc(($firstname)? "$firstname.$surname" : $surname);
1639       $userid = NFKD( $userid );
1640       $userid =~ s/\p{NonspacingMark}//g;
1641       $userid .= $offset unless $offset == 0;
1642       $self->userid( $userid );
1643       $offset++;
1644      } while (! $self->has_valid_userid );
1645
1646      return $self;
1647 }
1648
1649 =head3 add_extended_attribute
1650
1651 =cut
1652
1653 sub add_extended_attribute {
1654     my ($self, $attribute) = @_;
1655
1656     return Koha::Patron::Attribute->new(
1657         {
1658             %$attribute,
1659             ( borrowernumber => $self->borrowernumber ),
1660         }
1661     )->store;
1662
1663 }
1664
1665 =head3 extended_attributes
1666
1667 Return object of Koha::Patron::Attributes type with all attributes set for this patron
1668
1669 Or setter FIXME
1670
1671 =cut
1672
1673 sub extended_attributes {
1674     my ( $self, $attributes ) = @_;
1675     if ($attributes) {    # setter
1676         my $schema = $self->_result->result_source->schema;
1677         $schema->txn_do(
1678             sub {
1679                 # Remove the existing one
1680                 $self->extended_attributes->filter_by_branch_limitations->delete;
1681
1682                 # Insert the new ones
1683                 my $new_types = {};
1684                 for my $attribute (@$attributes) {
1685                     $self->add_extended_attribute($attribute);
1686                     $new_types->{$attribute->{code}} = 1;
1687                 }
1688
1689                 # Check globally mandatory types
1690                 my @required_attribute_types =
1691                     Koha::Patron::Attribute::Types->search(
1692                         {
1693                             mandatory => 1,
1694                             'borrower_attribute_types_branches.b_branchcode' =>
1695                               undef
1696                         },
1697                         { join => 'borrower_attribute_types_branches' }
1698                     )->get_column('code');
1699                 for my $type ( @required_attribute_types ) {
1700                     Koha::Exceptions::Patron::MissingMandatoryExtendedAttribute->throw(
1701                         type => $type,
1702                     ) if !$new_types->{$type};
1703                 }
1704             }
1705         );
1706     }
1707
1708     my $rs = $self->_result->borrower_attributes;
1709     # We call search to use the filters in Koha::Patron::Attributes->search
1710     return Koha::Patron::Attributes->_new_from_dbic($rs)->search;
1711 }
1712
1713 =head3 lock
1714
1715     Koha::Patrons->find($id)->lock({ expire => 1, remove => 1 });
1716
1717     Lock and optionally expire a patron account.
1718     Remove holds and article requests if remove flag set.
1719     In order to distinguish from locking by entering a wrong password, let's
1720     call this an administrative lockout.
1721
1722 =cut
1723
1724 sub lock {
1725     my ( $self, $params ) = @_;
1726     $self->login_attempts( ADMINISTRATIVE_LOCKOUT );
1727     if( $params->{expire} ) {
1728         $self->dateexpiry( dt_from_string->subtract(days => 1) );
1729     }
1730     $self->store;
1731     if( $params->{remove} ) {
1732         $self->holds->delete;
1733         $self->article_requests->delete;
1734     }
1735     return $self;
1736 }
1737
1738 =head3 anonymize
1739
1740     Koha::Patrons->find($id)->anonymize;
1741
1742     Anonymize or clear borrower fields. Fields in BorrowerMandatoryField
1743     are randomized, other personal data is cleared too.
1744     Patrons with issues are skipped.
1745
1746 =cut
1747
1748 sub anonymize {
1749     my ( $self ) = @_;
1750     if( $self->_result->issues->count ) {
1751         warn "Exiting anonymize: patron ".$self->borrowernumber." still has issues";
1752         return;
1753     }
1754     # Mandatory fields come from the corresponding pref, but email fields
1755     # are removed since scrambled email addresses only generate errors
1756     my $mandatory = { map { (lc $_, 1); } grep { !/email/ }
1757         split /\s*\|\s*/, C4::Context->preference('BorrowerMandatoryField') };
1758     $mandatory->{userid} = 1; # needed since sub store does not clear field
1759     my @columns = $self->_result->result_source->columns;
1760     @columns = grep { !/borrowernumber|branchcode|categorycode|^date|password|flags|updated_on|lastseen|lang|login_attempts|anonymized/ } @columns;
1761     push @columns, 'dateofbirth'; # add this date back in
1762     foreach my $col (@columns) {
1763         $self->_anonymize_column($col, $mandatory->{lc $col} );
1764     }
1765     $self->anonymized(1)->store;
1766 }
1767
1768 sub _anonymize_column {
1769     my ( $self, $col, $mandatory ) = @_;
1770     my $col_info = $self->_result->result_source->column_info($col);
1771     my $type = $col_info->{data_type};
1772     my $nullable = $col_info->{is_nullable};
1773     my $val;
1774     if( $type =~ /char|text/ ) {
1775         $val = $mandatory
1776             ? Koha::Token->new->generate({ pattern => '\w{10}' })
1777             : $nullable
1778             ? undef
1779             : q{};
1780     } elsif( $type =~ /integer|int$|float|dec|double/ ) {
1781         $val = $nullable ? undef : 0;
1782     } elsif( $type =~ /date|time/ ) {
1783         $val = $nullable ? undef : dt_from_string;
1784     }
1785     $self->$col($val);
1786 }
1787
1788 =head3 add_guarantor
1789
1790     my @relationships = $patron->add_guarantor(
1791         {
1792             borrowernumber => $borrowernumber,
1793             relationships  => $relationship,
1794         }
1795     );
1796
1797     Adds a new guarantor to a patron.
1798
1799 =cut
1800
1801 sub add_guarantor {
1802     my ( $self, $params ) = @_;
1803
1804     my $guarantor_id = $params->{guarantor_id};
1805     my $relationship = $params->{relationship};
1806
1807     return Koha::Patron::Relationship->new(
1808         {
1809             guarantee_id => $self->id,
1810             guarantor_id => $guarantor_id,
1811             relationship => $relationship
1812         }
1813     )->store();
1814 }
1815
1816 =head3 get_extended_attribute
1817
1818 my $attribute_value = $patron->get_extended_attribute( $code );
1819
1820 Return the attribute for the code passed in parameter.
1821
1822 It not exist it returns undef
1823
1824 Note that this will not work for repeatable attribute types.
1825
1826 Maybe you certainly not want to use this method, it is actually only used for SHOW_BARCODE
1827 (which should be a real patron's attribute (not extended)
1828
1829 =cut
1830
1831 sub get_extended_attribute {
1832     my ( $self, $code, $value ) = @_;
1833     my $rs = $self->_result->borrower_attributes;
1834     return unless $rs;
1835     my $attribute = $rs->search({ code => $code, ( $value ? ( attribute => $value ) : () ) });
1836     return unless $attribute->count;
1837     return $attribute->next;
1838 }
1839
1840 =head3 to_api
1841
1842     my $json = $patron->to_api;
1843
1844 Overloaded method that returns a JSON representation of the Koha::Patron object,
1845 suitable for API output.
1846
1847 =cut
1848
1849 sub to_api {
1850     my ( $self, $params ) = @_;
1851
1852     my $json_patron = $self->SUPER::to_api( $params );
1853
1854     $json_patron->{restricted} = ( $self->is_debarred )
1855                                     ? Mojo::JSON->true
1856                                     : Mojo::JSON->false;
1857
1858     return $json_patron;
1859 }
1860
1861 =head3 to_api_mapping
1862
1863 This method returns the mapping for representing a Koha::Patron object
1864 on the API.
1865
1866 =cut
1867
1868 sub to_api_mapping {
1869     return {
1870         borrowernotes       => 'staff_notes',
1871         borrowernumber      => 'patron_id',
1872         branchcode          => 'library_id',
1873         categorycode        => 'category_id',
1874         checkprevcheckout   => 'check_previous_checkout',
1875         contactfirstname    => undef,                     # Unused
1876         contactname         => undef,                     # Unused
1877         contactnote         => 'altaddress_notes',
1878         contacttitle        => undef,                     # Unused
1879         dateenrolled        => 'date_enrolled',
1880         dateexpiry          => 'expiry_date',
1881         dateofbirth         => 'date_of_birth',
1882         debarred            => undef,                     # replaced by 'restricted'
1883         debarredcomment     => undef,    # calculated, API consumers will use /restrictions instead
1884         emailpro            => 'secondary_email',
1885         flags               => undef,    # permissions manipulation handled in /permissions
1886         gonenoaddress       => 'incorrect_address',
1887         guarantorid         => 'guarantor_id',
1888         lastseen            => 'last_seen',
1889         lost                => 'patron_card_lost',
1890         opacnote            => 'opac_notes',
1891         othernames          => 'other_name',
1892         password            => undef,            # password manipulation handled in /password
1893         phonepro            => 'secondary_phone',
1894         relationship        => 'relationship_type',
1895         sex                 => 'gender',
1896         smsalertnumber      => 'sms_number',
1897         sort1               => 'statistics_1',
1898         sort2               => 'statistics_2',
1899         autorenew_checkouts => 'autorenew_checkouts',
1900         streetnumber        => 'street_number',
1901         streettype          => 'street_type',
1902         zipcode             => 'postal_code',
1903         B_address           => 'altaddress_address',
1904         B_address2          => 'altaddress_address2',
1905         B_city              => 'altaddress_city',
1906         B_country           => 'altaddress_country',
1907         B_email             => 'altaddress_email',
1908         B_phone             => 'altaddress_phone',
1909         B_state             => 'altaddress_state',
1910         B_streetnumber      => 'altaddress_street_number',
1911         B_streettype        => 'altaddress_street_type',
1912         B_zipcode           => 'altaddress_postal_code',
1913         altcontactaddress1  => 'altcontact_address',
1914         altcontactaddress2  => 'altcontact_address2',
1915         altcontactaddress3  => 'altcontact_city',
1916         altcontactcountry   => 'altcontact_country',
1917         altcontactfirstname => 'altcontact_firstname',
1918         altcontactphone     => 'altcontact_phone',
1919         altcontactsurname   => 'altcontact_surname',
1920         altcontactstate     => 'altcontact_state',
1921         altcontactzipcode   => 'altcontact_postal_code',
1922         primary_contact_method => undef,
1923     };
1924 }
1925
1926 =head3 queue_notice
1927
1928     Koha::Patrons->queue_notice({ letter_params => $letter_params, message_name => 'DUE'});
1929     Koha::Patrons->queue_notice({ letter_params => $letter_params, message_transports => \@message_transports });
1930     Koha::Patrons->queue_notice({ letter_params => $letter_params, message_transports => \@message_transports, test_mode => 1 });
1931
1932     Queue messages to a patron. Can pass a message that is part of the message_attributes
1933     table or supply the transport to use.
1934
1935     If passed a message name we retrieve the patrons preferences for transports
1936     Otherwise we use the supplied transport. In the case of email or sms we fall back to print if
1937     we have no address/number for sending
1938
1939     $letter_params is a hashref of the values to be passed to GetPreparedLetter
1940
1941     test_mode will only report which notices would be sent, but nothing will be queued
1942
1943 =cut
1944
1945 sub queue_notice {
1946     my ( $self, $params ) = @_;
1947     my $letter_params = $params->{letter_params};
1948     my $test_mode = $params->{test_mode};
1949
1950     return unless $letter_params;
1951     return unless exists $params->{message_name} xor $params->{message_transports}; # We only want one of these
1952
1953     my $library = Koha::Libraries->find( $letter_params->{branchcode} );
1954     my $from_email_address = $library->from_email_address;
1955
1956     my @message_transports;
1957     my $letter_code;
1958     $letter_code = $letter_params->{letter_code};
1959     if( $params->{message_name} ){
1960         my $messaging_prefs = C4::Members::Messaging::GetMessagingPreferences( {
1961                 borrowernumber => $letter_params->{borrowernumber},
1962                 message_name => $params->{message_name}
1963         } );
1964         @message_transports = ( keys %{ $messaging_prefs->{transports} } );
1965         $letter_code = $messaging_prefs->{transports}->{$message_transports[0]} unless $letter_code;
1966     } else {
1967         @message_transports = @{$params->{message_transports}};
1968     }
1969     return unless defined $letter_code;
1970     $letter_params->{letter_code} = $letter_code;
1971     my $print_sent = 0;
1972     my %return;
1973     foreach my $mtt (@message_transports){
1974         next if ($mtt eq 'itiva' and C4::Context->preference('TalkingTechItivaPhoneNotification') );
1975         # Notice is handled by TalkingTech_itiva_outbound.pl
1976         if (   ( $mtt eq 'email' and not $self->notice_email_address )
1977             or ( $mtt eq 'sms'   and not $self->smsalertnumber )
1978             or ( $mtt eq 'phone' and not $self->phone ) )
1979         {
1980             push @{ $return{fallback} }, $mtt;
1981             $mtt = 'print';
1982         }
1983         next if $mtt eq 'print' && $print_sent;
1984         $letter_params->{message_transport_type} = $mtt;
1985         my $letter = C4::Letters::GetPreparedLetter( %$letter_params );
1986         C4::Letters::EnqueueLetter({
1987             letter => $letter,
1988             borrowernumber => $self->borrowernumber,
1989             from_address   => $from_email_address,
1990             message_transport_type => $mtt
1991         }) unless $test_mode;
1992         push @{$return{sent}}, $mtt;
1993         $print_sent = 1 if $mtt eq 'print';
1994     }
1995     return \%return;
1996 }
1997
1998 =head3 safe_to_delete
1999
2000     my $result = $patron->safe_to_delete;
2001     if ( $result eq 'has_guarantees' ) { ... }
2002     elsif ( $result ) { ... }
2003     else { # cannot delete }
2004
2005 This method tells if the Koha:Patron object can be deleted. Possible return values
2006
2007 =over 4
2008
2009 =item 'ok'
2010
2011 =item 'has_checkouts'
2012
2013 =item 'has_debt'
2014
2015 =item 'has_guarantees'
2016
2017 =item 'is_anonymous_patron'
2018
2019 =back
2020
2021 =cut
2022
2023 sub safe_to_delete {
2024     my ($self) = @_;
2025
2026     my $anonymous_patron = C4::Context->preference('AnonymousPatron');
2027
2028     my $error;
2029
2030     if ( $anonymous_patron && $self->id eq $anonymous_patron ) {
2031         $error = 'is_anonymous_patron';
2032     }
2033     elsif ( $self->checkouts->count ) {
2034         $error = 'has_checkouts';
2035     }
2036     elsif ( $self->account->outstanding_debits->total_outstanding > 0 ) {
2037         $error = 'has_debt';
2038     }
2039     elsif ( $self->guarantee_relationships->count ) {
2040         $error = 'has_guarantees';
2041     }
2042
2043     if ( $error ) {
2044         return Koha::Result::Boolean->new(0)->add_message({ message => $error });
2045     }
2046
2047     return Koha::Result::Boolean->new(1);
2048 }
2049
2050 =head2 Internal methods
2051
2052 =head3 _type
2053
2054 =cut
2055
2056 sub _type {
2057     return 'Borrower';
2058 }
2059
2060 =head1 AUTHORS
2061
2062 Kyle M Hall <kyle@bywatersolutions.com>
2063 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
2064 Martin Renvoize <martin.renvoize@ptfs-europe.com>
2065
2066 =cut
2067
2068 1;