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::Messages;
  48 use Koha::Patron::Modifications;
  49 use Koha::Patron::Relationships;
  50 use Koha::Patrons;
  51 use Koha::Plugins;
  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_requests
1008
1009     my $article_requests = $patron->article_requests;
1010
1011 Returns the patron article requests.
1012
1013 =cut
1014
1015 sub article_requests {
1016     my ($self) = @_;
1017
1018     return Koha::ArticleRequests->_new_from_dbic( scalar $self->_result->article_requests );
1019 }
1020
1021 =head3 add_enrolment_fee_if_needed
1022
1023 my $enrolment_fee = $patron->add_enrolment_fee_if_needed($renewal);
1024
1025 Add enrolment fee for a patron if needed.
1026
1027 $renewal - boolean denoting whether this is an account renewal or not
1028
1029 =cut
1030
1031 sub add_enrolment_fee_if_needed {
1032     my ($self, $renewal) = @_;
1033     my $enrolment_fee = $self->category->enrolmentfee;
1034     if ( $enrolment_fee && $enrolment_fee > 0 ) {
1035         my $type = $renewal ? 'ACCOUNT_RENEW' : 'ACCOUNT';
1036         $self->account->add_debit(
1037             {
1038                 amount     => $enrolment_fee,
1039                 user_id    => C4::Context->userenv ? C4::Context->userenv->{'number'} : undef,
1040                 interface  => C4::Context->interface,
1041                 library_id => C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef,
1042                 type       => $type
1043             }
1044         );
1045     }
1046     return $enrolment_fee || 0;
1047 }
1048
1049 =head3 checkouts
1050
1051 my $checkouts = $patron->checkouts
1052
1053 =cut
1054
1055 sub checkouts {
1056     my ($self) = @_;
1057     my $checkouts = $self->_result->issues;
1058     return Koha::Checkouts->_new_from_dbic( $checkouts );
1059 }
1060
1061 =head3 pending_checkouts
1062
1063 my $pending_checkouts = $patron->pending_checkouts
1064
1065 This method will return the same as $self->checkouts, but with a prefetch on
1066 items, biblio and biblioitems.
1067
1068 It has been introduced to replaced the C4::Members::GetPendingIssues subroutine
1069
1070 It should not be used directly, prefer to access fields you need instead of
1071 retrieving all these fields in one go.
1072
1073 =cut
1074
1075 sub pending_checkouts {
1076     my( $self ) = @_;
1077     my $checkouts = $self->_result->issues->search(
1078         {},
1079         {
1080             order_by => [
1081                 { -desc => 'me.timestamp' },
1082                 { -desc => 'issuedate' },
1083                 { -desc => 'issue_id' }, # Sort by issue_id should be enough
1084             ],
1085             prefetch => { item => { biblio => 'biblioitems' } },
1086         }
1087     );
1088     return Koha::Checkouts->_new_from_dbic( $checkouts );
1089 }
1090
1091 =head3 old_checkouts
1092
1093 my $old_checkouts = $patron->old_checkouts
1094
1095 =cut
1096
1097 sub old_checkouts {
1098     my ($self) = @_;
1099     my $old_checkouts = $self->_result->old_issues;
1100     return Koha::Old::Checkouts->_new_from_dbic( $old_checkouts );
1101 }
1102
1103 =head3 get_overdues
1104
1105 my $overdue_items = $patron->get_overdues
1106
1107 Return the overdue items
1108
1109 =cut
1110
1111 sub get_overdues {
1112     my ($self) = @_;
1113     my $dtf = Koha::Database->new->schema->storage->datetime_parser;
1114     return $self->checkouts->search(
1115         {
1116             'me.date_due' => { '<' => $dtf->format_datetime(dt_from_string) },
1117         },
1118         {
1119             prefetch => { item => { biblio => 'biblioitems' } },
1120         }
1121     );
1122 }
1123
1124 =head3 get_routing_lists
1125
1126 my @routinglists = $patron->get_routing_lists
1127
1128 Returns the routing lists a patron is subscribed to.
1129
1130 =cut
1131
1132 sub get_routing_lists {
1133     my ($self) = @_;
1134     my $routing_list_rs = $self->_result->subscriptionroutinglists;
1135     return Koha::Subscription::Routinglists->_new_from_dbic($routing_list_rs);
1136 }
1137
1138 =head3 get_age
1139
1140 my $age = $patron->get_age
1141
1142 Return the age of the patron
1143
1144 =cut
1145
1146 sub get_age {
1147     my ($self)    = @_;
1148     my $today_str = dt_from_string->strftime("%Y-%m-%d");
1149     return unless $self->dateofbirth;
1150     my $dob_str   = dt_from_string( $self->dateofbirth )->strftime("%Y-%m-%d");
1151
1152     my ( $dob_y,   $dob_m,   $dob_d )   = split /-/, $dob_str;
1153     my ( $today_y, $today_m, $today_d ) = split /-/, $today_str;
1154
1155     my $age = $today_y - $dob_y;
1156     if ( $dob_m . $dob_d > $today_m . $today_d ) {
1157         $age--;
1158     }
1159
1160     return $age;
1161 }
1162
1163 =head3 is_valid_age
1164
1165 my $is_valid = $patron->is_valid_age
1166
1167 Return 1 if patron's age is between allowed limits, returns 0 if it's not.
1168
1169 =cut
1170
1171 sub is_valid_age {
1172     my ($self) = @_;
1173     my $age = $self->get_age;
1174
1175     my $patroncategory = $self->category;
1176     my ($low,$high) = ($patroncategory->dateofbirthrequired, $patroncategory->upperagelimit);
1177
1178     return (defined($age) && (($high && ($age > $high)) or ($low && ($age < $low)))) ? 0 : 1;
1179 }
1180
1181 =head3 account
1182
1183 my $account = $patron->account
1184
1185 =cut
1186
1187 sub account {
1188     my ($self) = @_;
1189     return Koha::Account->new( { patron_id => $self->borrowernumber } );
1190 }
1191
1192 =head3 holds
1193
1194 my $holds = $patron->holds
1195
1196 Return all the holds placed by this patron
1197
1198 =cut
1199
1200 sub holds {
1201     my ($self) = @_;
1202     my $holds_rs = $self->_result->reserves->search( {}, { order_by => 'reservedate' } );
1203     return Koha::Holds->_new_from_dbic($holds_rs);
1204 }
1205
1206 =head3 old_holds
1207
1208 my $old_holds = $patron->old_holds
1209
1210 Return all the historical holds for this patron
1211
1212 =cut
1213
1214 sub old_holds {
1215     my ($self) = @_;
1216     my $old_holds_rs = $self->_result->old_reserves->search( {}, { order_by => 'reservedate' } );
1217     return Koha::Old::Holds->_new_from_dbic($old_holds_rs);
1218 }
1219
1220 =head3 return_claims
1221
1222 my $return_claims = $patron->return_claims
1223
1224 =cut
1225
1226 sub return_claims {
1227     my ($self) = @_;
1228     my $return_claims = $self->_result->return_claims_borrowernumbers;
1229     return Koha::Checkouts::ReturnClaims->_new_from_dbic( $return_claims );
1230 }
1231
1232 =head3 notice_email_address
1233
1234   my $email = $patron->notice_email_address;
1235
1236 Return the email address of patron used for notices.
1237 Returns the empty string if no email address.
1238
1239 =cut
1240
1241 sub notice_email_address{
1242     my ( $self ) = @_;
1243
1244     my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
1245     # if syspref is set to 'first valid' (value == OFF), look up email address
1246     if ( $which_address eq 'OFF' ) {
1247         return $self->first_valid_email_address;
1248     }
1249
1250     return $self->$which_address || '';
1251 }
1252
1253 =head3 first_valid_email_address
1254
1255 my $first_valid_email_address = $patron->first_valid_email_address
1256
1257 Return the first valid email address for a patron.
1258 For now, the order  is defined as email, emailpro, B_email.
1259 Returns the empty string if the borrower has no email addresses.
1260
1261 =cut
1262
1263 sub first_valid_email_address {
1264     my ($self) = @_;
1265
1266     return $self->email() || $self->emailpro() || $self->B_email() || q{};
1267 }
1268
1269 =head3 get_club_enrollments
1270
1271 =cut
1272
1273 sub get_club_enrollments {
1274     my ( $self, $return_scalar ) = @_;
1275
1276     my $e = Koha::Club::Enrollments->search( { borrowernumber => $self->borrowernumber(), date_canceled => undef } );
1277
1278     return $e if $return_scalar;
1279
1280     return wantarray ? $e->as_list : $e;
1281 }
1282
1283 =head3 get_enrollable_clubs
1284
1285 =cut
1286
1287 sub get_enrollable_clubs {
1288     my ( $self, $is_enrollable_from_opac, $return_scalar ) = @_;
1289
1290     my $params;
1291     $params->{is_enrollable_from_opac} = $is_enrollable_from_opac
1292       if $is_enrollable_from_opac;
1293     $params->{is_email_required} = 0 unless $self->first_valid_email_address();
1294
1295     $params->{borrower} = $self;
1296
1297     my $e = Koha::Clubs->get_enrollable($params);
1298
1299     return $e if $return_scalar;
1300
1301     return wantarray ? $e->as_list : $e;
1302 }
1303
1304 =head3 account_locked
1305
1306 my $is_locked = $patron->account_locked
1307
1308 Return true if the patron has reached the maximum number of login attempts
1309 (see pref FailedLoginAttempts). If login_attempts is < 0, this is interpreted
1310 as an administrative lockout (independent of FailedLoginAttempts; see also
1311 Koha::Patron->lock).
1312 Otherwise return false.
1313 If the pref is not set (empty string, null or 0), the feature is considered as
1314 disabled.
1315
1316 =cut
1317
1318 sub account_locked {
1319     my ($self) = @_;
1320     my $FailedLoginAttempts = C4::Context->preference('FailedLoginAttempts');
1321     return 1 if $FailedLoginAttempts
1322           and $self->login_attempts
1323           and $self->login_attempts >= $FailedLoginAttempts;
1324     return 1 if ($self->login_attempts || 0) < 0; # administrative lockout
1325     return 0;
1326 }
1327
1328 =head3 can_see_patron_infos
1329
1330 my $can_see = $patron->can_see_patron_infos( $patron );
1331
1332 Return true if the patron (usually the logged in user) can see the patron's infos for a given patron
1333
1334 =cut
1335
1336 sub can_see_patron_infos {
1337     my ( $self, $patron ) = @_;
1338     return unless $patron;
1339     return $self->can_see_patrons_from( $patron->branchcode );
1340 }
1341
1342 =head3 can_see_patrons_from
1343
1344 my $can_see = $patron->can_see_patrons_from( $branchcode );
1345
1346 Return true if the patron (usually the logged in user) can see the patron's infos from a given library
1347
1348 =cut
1349
1350 sub can_see_patrons_from {
1351     my ( $self, $branchcode ) = @_;
1352     my $can = 0;
1353     if ( $self->branchcode eq $branchcode ) {
1354         $can = 1;
1355     } elsif ( $self->has_permission( { borrowers => 'view_borrower_infos_from_any_libraries' } ) ) {
1356         $can = 1;
1357     } elsif ( my $library_groups = $self->library->library_groups ) {
1358         while ( my $library_group = $library_groups->next ) {
1359             if ( $library_group->parent->has_child( $branchcode ) ) {
1360                 $can = 1;
1361                 last;
1362             }
1363         }
1364     }
1365     return $can;
1366 }
1367
1368 =head3 can_log_into
1369
1370 my $can_log_into = $patron->can_log_into( $library );
1371
1372 Given a I<Koha::Library> object, it returns a boolean representing
1373 the fact the patron can log into a the library.
1374
1375 =cut
1376
1377 sub can_log_into {
1378     my ( $self, $library ) = @_;
1379
1380     my $can = 0;
1381
1382     if ( C4::Context->preference('IndependentBranches') ) {
1383         $can = 1
1384           if $self->is_superlibrarian
1385           or $self->branchcode eq $library->id;
1386     }
1387     else {
1388         # no restrictions
1389         $can = 1;
1390     }
1391
1392    return $can;
1393 }
1394
1395 =head3 libraries_where_can_see_patrons
1396
1397 my $libraries = $patron-libraries_where_can_see_patrons;
1398
1399 Return the list of branchcodes(!) of libraries the patron is allowed to see other patron's infos.
1400 The branchcodes are arbitrarily returned sorted.
1401 We are supposing here that the object is related to the logged in patron (use of C4::Context::only_my_library)
1402
1403 An empty array means no restriction, the patron can see patron's infos from any libraries.
1404
1405 =cut
1406
1407 sub libraries_where_can_see_patrons {
1408     my ( $self ) = @_;
1409     my $userenv = C4::Context->userenv;
1410
1411     return () unless $userenv; # For tests, but userenv should be defined in tests...
1412
1413     my @restricted_branchcodes;
1414     if (C4::Context::only_my_library) {
1415         push @restricted_branchcodes, $self->branchcode;
1416     }
1417     else {
1418         unless (
1419             $self->has_permission(
1420                 { borrowers => 'view_borrower_infos_from_any_libraries' }
1421             )
1422           )
1423         {
1424             my $library_groups = $self->library->library_groups({ ft_hide_patron_info => 1 });
1425             if ( $library_groups->count )
1426             {
1427                 while ( my $library_group = $library_groups->next ) {
1428                     my $parent = $library_group->parent;
1429                     if ( $parent->has_child( $self->branchcode ) ) {
1430                         push @restricted_branchcodes, $parent->children->get_column('branchcode');
1431                     }
1432                 }
1433             }
1434
1435             @restricted_branchcodes = ( $self->branchcode ) unless @restricted_branchcodes;
1436         }
1437     }
1438
1439     @restricted_branchcodes = grep { defined $_ } @restricted_branchcodes;
1440     @restricted_branchcodes = uniq(@restricted_branchcodes);
1441     @restricted_branchcodes = sort(@restricted_branchcodes);
1442     return @restricted_branchcodes;
1443 }
1444
1445 =head3 has_permission
1446
1447 my $permission = $patron->has_permission($required);
1448
1449 See C4::Auth::haspermission for details of syntax for $required
1450
1451 =cut
1452
1453 sub has_permission {
1454     my ( $self, $flagsrequired ) = @_;
1455     return unless $self->userid;
1456     # TODO code from haspermission needs to be moved here!
1457     return C4::Auth::haspermission( $self->userid, $flagsrequired );
1458 }
1459
1460 =head3 is_superlibrarian
1461
1462   my $is_superlibrarian = $patron->is_superlibrarian;
1463
1464 Return true if the patron is a superlibrarian.
1465
1466 =cut
1467
1468 sub is_superlibrarian {
1469     my ($self) = @_;
1470     return $self->has_permission( { superlibrarian => 1 } ) ? 1 : 0;
1471 }
1472
1473 =head3 is_adult
1474
1475 my $is_adult = $patron->is_adult
1476
1477 Return true if the patron has a category with a type Adult (A) or Organization (I)
1478
1479 =cut
1480
1481 sub is_adult {
1482     my ( $self ) = @_;
1483     return $self->category->category_type =~ /^(A|I)$/ ? 1 : 0;
1484 }
1485
1486 =head3 is_child
1487
1488 my $is_child = $patron->is_child
1489
1490 Return true if the patron has a category with a type Child (C)
1491
1492 =cut
1493
1494 sub is_child {
1495     my( $self ) = @_;
1496     return $self->category->category_type eq 'C' ? 1 : 0;
1497 }
1498
1499 =head3 has_valid_userid
1500
1501 my $patron = Koha::Patrons->find(42);
1502 $patron->userid( $new_userid );
1503 my $has_a_valid_userid = $patron->has_valid_userid
1504
1505 my $patron = Koha::Patron->new( $params );
1506 my $has_a_valid_userid = $patron->has_valid_userid
1507
1508 Return true if the current userid of this patron is valid/unique, otherwise false.
1509
1510 Note that this should be done in $self->store instead and raise an exception if needed.
1511
1512 =cut
1513
1514 sub has_valid_userid {
1515     my ($self) = @_;
1516
1517     return 0 unless $self->userid;
1518
1519     return 0 if ( $self->userid eq C4::Context->config('user') );    # DB user
1520
1521     my $already_exists = Koha::Patrons->search(
1522         {
1523             userid => $self->userid,
1524             (
1525                 $self->in_storage
1526                 ? ( borrowernumber => { '!=' => $self->borrowernumber } )
1527                 : ()
1528             ),
1529         }
1530     )->count;
1531     return $already_exists ? 0 : 1;
1532 }
1533
1534 =head3 generate_userid
1535
1536 my $patron = Koha::Patron->new( $params );
1537 $patron->generate_userid
1538
1539 Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
1540
1541 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).
1542
1543 =cut
1544
1545 sub generate_userid {
1546     my ($self) = @_;
1547     my $offset = 0;
1548     my $firstname = $self->firstname // q{};
1549     my $surname = $self->surname // q{};
1550     #The script will "do" the following code and increment the $offset until the generated userid is unique
1551     do {
1552       $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1553       $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1554       my $userid = lc(($firstname)? "$firstname.$surname" : $surname);
1555       $userid = NFKD( $userid );
1556       $userid =~ s/\p{NonspacingMark}//g;
1557       $userid .= $offset unless $offset == 0;
1558       $self->userid( $userid );
1559       $offset++;
1560      } while (! $self->has_valid_userid );
1561
1562      return $self;
1563 }
1564
1565 =head3 add_extended_attribute
1566
1567 =cut
1568
1569 sub add_extended_attribute {
1570     my ($self, $attribute) = @_;
1571
1572     return Koha::Patron::Attribute->new(
1573         {
1574             %$attribute,
1575             ( borrowernumber => $self->borrowernumber ),
1576         }
1577     )->store;
1578
1579 }
1580
1581 =head3 extended_attributes
1582
1583 Return object of Koha::Patron::Attributes type with all attributes set for this patron
1584
1585 Or setter FIXME
1586
1587 =cut
1588
1589 sub extended_attributes {
1590     my ( $self, $attributes ) = @_;
1591     if ($attributes) {    # setter
1592         my $schema = $self->_result->result_source->schema;
1593         $schema->txn_do(
1594             sub {
1595                 # Remove the existing one
1596                 $self->extended_attributes->filter_by_branch_limitations->delete;
1597
1598                 # Insert the new ones
1599                 my $new_types = {};
1600                 for my $attribute (@$attributes) {
1601                     $self->add_extended_attribute($attribute);
1602                     $new_types->{$attribute->{code}} = 1;
1603                 }
1604
1605                 # Check globally mandatory types
1606                 my @required_attribute_types =
1607                     Koha::Patron::Attribute::Types->search(
1608                         {
1609                             mandatory => 1,
1610                             category_code => [ undef, $self->categorycode ],
1611                             'borrower_attribute_types_branches.b_branchcode' =>
1612                               undef,
1613                         },
1614                         { join => 'borrower_attribute_types_branches' }
1615                     )->get_column('code');
1616                 for my $type ( @required_attribute_types ) {
1617                     Koha::Exceptions::Patron::MissingMandatoryExtendedAttribute->throw(
1618                         type => $type,
1619                     ) if !$new_types->{$type};
1620                 }
1621             }
1622         );
1623     }
1624
1625     my $rs = $self->_result->borrower_attributes;
1626     # We call search to use the filters in Koha::Patron::Attributes->search
1627     return Koha::Patron::Attributes->_new_from_dbic($rs)->search;
1628 }
1629
1630 =head3 messages
1631
1632     my $messages = $patron->messages;
1633
1634 Return the message attached to the patron.
1635
1636 =cut
1637
1638 sub messages {
1639     my ( $self ) = @_;
1640     my $messages_rs = $self->_result->messages_borrowernumbers->search;
1641     return Koha::Patron::Messages->_new_from_dbic($messages_rs);
1642 }
1643
1644 =head3 lock
1645
1646     Koha::Patrons->find($id)->lock({ expire => 1, remove => 1 });
1647
1648     Lock and optionally expire a patron account.
1649     Remove holds and article requests if remove flag set.
1650     In order to distinguish from locking by entering a wrong password, let's
1651     call this an administrative lockout.
1652
1653 =cut
1654
1655 sub lock {
1656     my ( $self, $params ) = @_;
1657     $self->login_attempts( ADMINISTRATIVE_LOCKOUT );
1658     if( $params->{expire} ) {
1659         $self->dateexpiry( dt_from_string->subtract(days => 1) );
1660     }
1661     $self->store;
1662     if( $params->{remove} ) {
1663         $self->holds->delete;
1664         $self->article_requests->delete;
1665     }
1666     return $self;
1667 }
1668
1669 =head3 anonymize
1670
1671     Koha::Patrons->find($id)->anonymize;
1672
1673     Anonymize or clear borrower fields. Fields in BorrowerMandatoryField
1674     are randomized, other personal data is cleared too.
1675     Patrons with issues are skipped.
1676
1677 =cut
1678
1679 sub anonymize {
1680     my ( $self ) = @_;
1681     if( $self->_result->issues->count ) {
1682         warn "Exiting anonymize: patron ".$self->borrowernumber." still has issues";
1683         return;
1684     }
1685     # Mandatory fields come from the corresponding pref, but email fields
1686     # are removed since scrambled email addresses only generate errors
1687     my $mandatory = { map { (lc $_, 1); } grep { !/email/ }
1688         split /\s*\|\s*/, C4::Context->preference('BorrowerMandatoryField') };
1689     $mandatory->{userid} = 1; # needed since sub store does not clear field
1690     my @columns = $self->_result->result_source->columns;
1691     @columns = grep { !/borrowernumber|branchcode|categorycode|^date|password|flags|updated_on|lastseen|lang|login_attempts|anonymized/ } @columns;
1692     push @columns, 'dateofbirth'; # add this date back in
1693     foreach my $col (@columns) {
1694         $self->_anonymize_column($col, $mandatory->{lc $col} );
1695     }
1696     $self->anonymized(1)->store;
1697 }
1698
1699 sub _anonymize_column {
1700     my ( $self, $col, $mandatory ) = @_;
1701     my $col_info = $self->_result->result_source->column_info($col);
1702     my $type = $col_info->{data_type};
1703     my $nullable = $col_info->{is_nullable};
1704     my $val;
1705     if( $type =~ /char|text/ ) {
1706         $val = $mandatory
1707             ? Koha::Token->new->generate({ pattern => '\w{10}' })
1708             : $nullable
1709             ? undef
1710             : q{};
1711     } elsif( $type =~ /integer|int$|float|dec|double/ ) {
1712         $val = $nullable ? undef : 0;
1713     } elsif( $type =~ /date|time/ ) {
1714         $val = $nullable ? undef : dt_from_string;
1715     }
1716     $self->$col($val);
1717 }
1718
1719 =head3 add_guarantor
1720
1721     my @relationships = $patron->add_guarantor(
1722         {
1723             borrowernumber => $borrowernumber,
1724             relationships  => $relationship,
1725         }
1726     );
1727
1728     Adds a new guarantor to a patron.
1729
1730 =cut
1731
1732 sub add_guarantor {
1733     my ( $self, $params ) = @_;
1734
1735     my $guarantor_id = $params->{guarantor_id};
1736     my $relationship = $params->{relationship};
1737
1738     return Koha::Patron::Relationship->new(
1739         {
1740             guarantee_id => $self->id,
1741             guarantor_id => $guarantor_id,
1742             relationship => $relationship
1743         }
1744     )->store();
1745 }
1746
1747 =head3 get_extended_attribute
1748
1749 my $attribute_value = $patron->get_extended_attribute( $code );
1750
1751 Return the attribute for the code passed in parameter.
1752
1753 It not exist it returns undef
1754
1755 Note that this will not work for repeatable attribute types.
1756
1757 Maybe you certainly not want to use this method, it is actually only used for SHOW_BARCODE
1758 (which should be a real patron's attribute (not extended)
1759
1760 =cut
1761
1762 sub get_extended_attribute {
1763     my ( $self, $code, $value ) = @_;
1764     my $rs = $self->_result->borrower_attributes;
1765     return unless $rs;
1766     my $attribute = $rs->search({ code => $code, ( $value ? ( attribute => $value ) : () ) });
1767     return unless $attribute->count;
1768     return $attribute->next;
1769 }
1770
1771 =head3 to_api
1772
1773     my $json = $patron->to_api;
1774
1775 Overloaded method that returns a JSON representation of the Koha::Patron object,
1776 suitable for API output.
1777
1778 =cut
1779
1780 sub to_api {
1781     my ( $self, $params ) = @_;
1782
1783     my $json_patron = $self->SUPER::to_api( $params );
1784
1785     $json_patron->{restricted} = ( $self->is_debarred )
1786                                     ? Mojo::JSON->true
1787                                     : Mojo::JSON->false;
1788
1789     return $json_patron;
1790 }
1791
1792 =head3 to_api_mapping
1793
1794 This method returns the mapping for representing a Koha::Patron object
1795 on the API.
1796
1797 =cut
1798
1799 sub to_api_mapping {
1800     return {
1801         borrowernotes       => 'staff_notes',
1802         borrowernumber      => 'patron_id',
1803         branchcode          => 'library_id',
1804         categorycode        => 'category_id',
1805         checkprevcheckout   => 'check_previous_checkout',
1806         contactfirstname    => undef,                     # Unused
1807         contactname         => undef,                     # Unused
1808         contactnote         => 'altaddress_notes',
1809         contacttitle        => undef,                     # Unused
1810         dateenrolled        => 'date_enrolled',
1811         dateexpiry          => 'expiry_date',
1812         dateofbirth         => 'date_of_birth',
1813         debarred            => undef,                     # replaced by 'restricted'
1814         debarredcomment     => undef,    # calculated, API consumers will use /restrictions instead
1815         emailpro            => 'secondary_email',
1816         flags               => undef,    # permissions manipulation handled in /permissions
1817         gonenoaddress       => 'incorrect_address',
1818         lastseen            => 'last_seen',
1819         lost                => 'patron_card_lost',
1820         opacnote            => 'opac_notes',
1821         othernames          => 'other_name',
1822         password            => undef,            # password manipulation handled in /password
1823         phonepro            => 'secondary_phone',
1824         relationship        => 'relationship_type',
1825         sex                 => 'gender',
1826         smsalertnumber      => 'sms_number',
1827         sort1               => 'statistics_1',
1828         sort2               => 'statistics_2',
1829         autorenew_checkouts => 'autorenew_checkouts',
1830         streetnumber        => 'street_number',
1831         streettype          => 'street_type',
1832         zipcode             => 'postal_code',
1833         B_address           => 'altaddress_address',
1834         B_address2          => 'altaddress_address2',
1835         B_city              => 'altaddress_city',
1836         B_country           => 'altaddress_country',
1837         B_email             => 'altaddress_email',
1838         B_phone             => 'altaddress_phone',
1839         B_state             => 'altaddress_state',
1840         B_streetnumber      => 'altaddress_street_number',
1841         B_streettype        => 'altaddress_street_type',
1842         B_zipcode           => 'altaddress_postal_code',
1843         altcontactaddress1  => 'altcontact_address',
1844         altcontactaddress2  => 'altcontact_address2',
1845         altcontactaddress3  => 'altcontact_city',
1846         altcontactcountry   => 'altcontact_country',
1847         altcontactfirstname => 'altcontact_firstname',
1848         altcontactphone     => 'altcontact_phone',
1849         altcontactsurname   => 'altcontact_surname',
1850         altcontactstate     => 'altcontact_state',
1851         altcontactzipcode   => 'altcontact_postal_code',
1852         primary_contact_method => undef,
1853     };
1854 }
1855
1856 =head3 queue_notice
1857
1858     Koha::Patrons->queue_notice({ letter_params => $letter_params, message_name => 'DUE'});
1859     Koha::Patrons->queue_notice({ letter_params => $letter_params, message_transports => \@message_transports });
1860     Koha::Patrons->queue_notice({ letter_params => $letter_params, message_transports => \@message_transports, test_mode => 1 });
1861
1862     Queue messages to a patron. Can pass a message that is part of the message_attributes
1863     table or supply the transport to use.
1864
1865     If passed a message name we retrieve the patrons preferences for transports
1866     Otherwise we use the supplied transport. In the case of email or sms we fall back to print if
1867     we have no address/number for sending
1868
1869     $letter_params is a hashref of the values to be passed to GetPreparedLetter
1870
1871     test_mode will only report which notices would be sent, but nothing will be queued
1872
1873 =cut
1874
1875 sub queue_notice {
1876     my ( $self, $params ) = @_;
1877     my $letter_params = $params->{letter_params};
1878     my $test_mode = $params->{test_mode};
1879
1880     return unless $letter_params;
1881     return unless exists $params->{message_name} xor $params->{message_transports}; # We only want one of these
1882
1883     my $library = Koha::Libraries->find( $letter_params->{branchcode} );
1884     my $from_email_address = $library->from_email_address;
1885
1886     my @message_transports;
1887     my $letter_code;
1888     $letter_code = $letter_params->{letter_code};
1889     if( $params->{message_name} ){
1890         my $messaging_prefs = C4::Members::Messaging::GetMessagingPreferences( {
1891                 borrowernumber => $letter_params->{borrowernumber},
1892                 message_name => $params->{message_name}
1893         } );
1894         @message_transports = ( keys %{ $messaging_prefs->{transports} } );
1895         $letter_code = $messaging_prefs->{transports}->{$message_transports[0]} unless $letter_code;
1896     } else {
1897         @message_transports = @{$params->{message_transports}};
1898     }
1899     return unless defined $letter_code;
1900     $letter_params->{letter_code} = $letter_code;
1901     my $print_sent = 0;
1902     my %return;
1903     foreach my $mtt (@message_transports){
1904         next if ($mtt eq 'itiva' and C4::Context->preference('TalkingTechItivaPhoneNotification') );
1905         # Notice is handled by TalkingTech_itiva_outbound.pl
1906         if (   ( $mtt eq 'email' and not $self->notice_email_address )
1907             or ( $mtt eq 'sms'   and not $self->smsalertnumber )
1908             or ( $mtt eq 'phone' and not $self->phone ) )
1909         {
1910             push @{ $return{fallback} }, $mtt;
1911             $mtt = 'print';
1912         }
1913         next if $mtt eq 'print' && $print_sent;
1914         $letter_params->{message_transport_type} = $mtt;
1915         my $letter = C4::Letters::GetPreparedLetter( %$letter_params );
1916         C4::Letters::EnqueueLetter({
1917             letter => $letter,
1918             borrowernumber => $self->borrowernumber,
1919             from_address   => $from_email_address,
1920             message_transport_type => $mtt
1921         }) unless $test_mode;
1922         push @{$return{sent}}, $mtt;
1923         $print_sent = 1 if $mtt eq 'print';
1924     }
1925     return \%return;
1926 }
1927
1928 =head3 safe_to_delete
1929
1930     my $result = $patron->safe_to_delete;
1931     if ( $result eq 'has_guarantees' ) { ... }
1932     elsif ( $result ) { ... }
1933     else { # cannot delete }
1934
1935 This method tells if the Koha:Patron object can be deleted. Possible return values
1936
1937 =over 4
1938
1939 =item 'ok'
1940
1941 =item 'has_checkouts'
1942
1943 =item 'has_debt'
1944
1945 =item 'has_guarantees'
1946
1947 =item 'is_anonymous_patron'
1948
1949 =back
1950
1951 =cut
1952
1953 sub safe_to_delete {
1954     my ($self) = @_;
1955
1956     my $anonymous_patron = C4::Context->preference('AnonymousPatron');
1957
1958     return 'is_anonymous_patron'
1959         if $anonymous_patron && $self->id eq $anonymous_patron;
1960
1961     return 'has_checkouts'
1962         if $self->checkouts->count;
1963
1964     return 'has_debt'
1965         if $self->account->outstanding_debits->total_outstanding > 0;
1966
1967     return 'has_guarantees'
1968         if $self->guarantee_relationships->count;
1969
1970     return 'ok';
1971 }
1972
1973 =head2 Internal methods
1974
1975 =head3 _type
1976
1977 =cut
1978
1979 sub _type {
1980     return 'Borrower';
1981 }
1982
1983 =head1 AUTHORS
1984
1985 Kyle M Hall <kyle@bywatersolutions.com>
1986 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
1987 Martin Renvoize <martin.renvoize@ptfs-europe.com>
1988
1989 =cut
1990
1991 1;