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