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 use Try::Tiny;
  27 use DateTime ();
  28
  29 use C4::Auth qw( checkpw_hash );
  30 use C4::Context;
  31 use C4::Letters qw( GetPreparedLetter EnqueueLetter SendQueuedMessages );
  32 use C4::Log qw( logaction );
  33 use Koha::Account;
  34 use Koha::ArticleRequests;
  35 use Koha::AuthUtils;
  36 use Koha::Caches;
  37 use Koha::Checkouts;
  38 use Koha::CirculationRules;
  39 use Koha::Club::Enrollments;
  40 use Koha::CurbsidePickups;
  41 use Koha::Database;
  42 use Koha::DateUtils qw( dt_from_string );
  43 use Koha::Encryption;
  44 use Koha::Exceptions::Password;
  45 use Koha::Holds;
  46 use Koha::Old::Checkouts;
  47 use Koha::OverdueRules;
  48 use Koha::Patron::Attributes;
  49 use Koha::Patron::Categories;
  50 use Koha::Patron::Consents;
  51 use Koha::Patron::Debarments;
  52 use Koha::Patron::HouseboundProfile;
  53 use Koha::Patron::HouseboundRole;
  54 use Koha::Patron::Images;
  55 use Koha::Patron::Messages;
  56 use Koha::Patron::Modifications;
  57 use Koha::Patron::MessagePreferences;
  58 use Koha::Patron::Relationships;
  59 use Koha::Patron::Restrictions;
  60 use Koha::Patrons;
  61 use Koha::Plugins;
  62 use Koha::Recalls;
  63 use Koha::Result::Boolean;
  64 use Koha::Subscription::Routinglists;
  65 use Koha::Token;
  66 use Koha::Virtualshelves;
  67
  68 use base qw(Koha::Object);
  69
  70 use constant ADMINISTRATIVE_LOCKOUT => -1;
  71
  72 our $RESULTSET_PATRON_ID_MAPPING = {
  73     Accountline          => 'borrowernumber',
  74     Aqbasketuser         => 'borrowernumber',
  75     Aqbudget             => 'budget_owner_id',
  76     Aqbudgetborrower     => 'borrowernumber',
  77     ArticleRequest       => 'borrowernumber',
  78     BorrowerDebarment    => 'borrowernumber',
  79     BorrowerFile         => 'borrowernumber',
  80     BorrowerModification => 'borrowernumber',
  81     ClubEnrollment       => 'borrowernumber',
  82     Issue                => 'borrowernumber',
  83     ItemsLastBorrower    => 'borrowernumber',
  84     Linktracker          => 'borrowernumber',
  85     Message              => 'borrowernumber',
  86     MessageQueue         => 'borrowernumber',
  87     OldIssue             => 'borrowernumber',
  88     OldReserve           => 'borrowernumber',
  89     Rating               => 'borrowernumber',
  90     Reserve              => 'borrowernumber',
  91     Review               => 'borrowernumber',
  92     SearchHistory        => 'userid',
  93     Statistic            => 'borrowernumber',
  94     Suggestion           => 'suggestedby',
  95     TagAll               => 'borrowernumber',
  96     Virtualshelfcontent  => 'borrowernumber',
  97     Virtualshelfshare    => 'borrowernumber',
  98     Virtualshelve        => 'owner',
  99 };
 100
 101 =head1 NAME
 102
 103 Koha::Patron - Koha Patron Object class
 104
 105 =head1 API
 106
 107 =head2 Class Methods
 108
 109 =head3 new
 110
 111 =cut
 112
 113 sub new {
 114     my ( $class, $params ) = @_;
 115
 116     return $class->SUPER::new($params);
 117 }
 118
 119 =head3 fixup_cardnumber
 120
 121 Autogenerate next cardnumber from highest value found in database
 122
 123 =cut
 124
 125 sub fixup_cardnumber {
 126     my ( $self ) = @_;
 127
 128     my $max = $self->cardnumber;
 129     Koha::Plugins->call( 'patron_barcode_transform', \$max );
 130
 131     $max ||= Koha::Patrons->search({
 132         cardnumber => {-regexp => '^-?[0-9]+$'}
 133     }, {
 134         select => \'CAST(cardnumber AS SIGNED)',
 135         as => ['cast_cardnumber']
 136     })->_resultset->get_column('cast_cardnumber')->max;
 137     $self->cardnumber(($max || 0) +1);
 138 }
 139
 140 =head3 trim_whitespace
 141
 142 trim whitespace from data which has some non-whitespace in it.
 143 Could be moved to Koha::Object if need to be reused
 144
 145 =cut
 146
 147 sub trim_whitespaces {
 148     my( $self ) = @_;
 149
 150     my $schema  = Koha::Database->new->schema;
 151     my @columns = $schema->source($self->_type)->columns;
 152
 153     for my $column( @columns ) {
 154         my $value = $self->$column;
 155         if ( defined $value ) {
 156             $value =~ s/^\s*|\s*$//g;
 157             $self->$column($value);
 158         }
 159     }
 160     return $self;
 161 }
 162
 163 =head3 plain_text_password
 164
 165 $patron->plain_text_password( $password );
 166
 167 stores a copy of the unencrypted password in the object
 168 for use in code before encrypting for db
 169
 170 =cut
 171
 172 sub plain_text_password {
 173     my ( $self, $password ) = @_;
 174     if ( $password ) {
 175         $self->{_plain_text_password} = $password;
 176         return $self;
 177     }
 178     return $self->{_plain_text_password}
 179         if $self->{_plain_text_password};
 180
 181     return;
 182 }
 183
 184 =head3 store
 185
 186 Patron specific store method to cleanup record
 187 and do other necessary things before saving
 188 to db
 189
 190 =cut
 191
 192 sub store {
 193     my ($self) = @_;
 194
 195     $self->_result->result_source->schema->txn_do(
 196         sub {
 197             if (
 198                 C4::Context->preference("autoMemberNum")
 199                 and ( not defined $self->cardnumber
 200                     or $self->cardnumber eq '' )
 201               )
 202             {
 203                 # Warning: The caller is responsible for locking the members table in write
 204                 # mode, to avoid database corruption.
 205                 # We are in a transaction but the table is not locked
 206                 $self->fixup_cardnumber;
 207             }
 208
 209             unless( $self->category->in_storage ) {
 210                 Koha::Exceptions::Object::FKConstraint->throw(
 211                     broken_fk => 'categorycode',
 212                     value     => $self->categorycode,
 213                 );
 214             }
 215
 216             $self->trim_whitespaces;
 217
 218             my $new_cardnumber = $self->cardnumber;
 219             Koha::Plugins->call( 'patron_barcode_transform', \$new_cardnumber );
 220             $self->cardnumber( $new_cardnumber );
 221
 222             # Set surname to uppercase if uppercasesurname is true
 223             $self->surname( uc($self->surname) )
 224                 if C4::Context->preference("uppercasesurnames");
 225
 226             $self->relationship(undef) # We do not want to store an empty string in this field
 227               if defined $self->relationship
 228                      and $self->relationship eq "";
 229
 230             unless ( $self->in_storage ) {    #AddMember
 231
 232                 # Generate a valid userid/login if needed
 233                 $self->generate_userid unless $self->userid;
 234                 Koha::Exceptions::Patron::InvalidUserid->throw( userid => $self->userid )
 235                     unless $self->has_valid_userid;
 236
 237                 # Add expiration date if it isn't already there
 238                 unless ( $self->dateexpiry ) {
 239                     $self->dateexpiry( $self->category->get_expiry_date );
 240                 }
 241
 242                 # Add enrollment date if it isn't already there
 243                 unless ( $self->dateenrolled ) {
 244                     $self->dateenrolled(dt_from_string);
 245                 }
 246
 247                 # Set the privacy depending on the patron's category
 248                 my $default_privacy = $self->category->default_privacy || q{};
 249                 $default_privacy =
 250                     $default_privacy eq 'default' ? 1
 251                   : $default_privacy eq 'never'   ? 2
 252                   : $default_privacy eq 'forever' ? 0
 253                   :                                                   undef;
 254                 $self->privacy($default_privacy);
 255
 256                 # Call any check_password plugins if password is passed
 257                 if ( C4::Context->config("enable_plugins") && $self->password ) {
 258                     my @plugins = Koha::Plugins->new()->GetPlugins({
 259                         method => 'check_password',
 260                     });
 261                     foreach my $plugin ( @plugins ) {
 262                         # This plugin hook will also be used by a plugin for the Norwegian national
 263                         # patron database. This is why we need to pass both the password and the
 264                         # borrowernumber to the plugin.
 265                         my $ret = $plugin->check_password(
 266                             {
 267                                 password       => $self->password,
 268                                 borrowernumber => $self->borrowernumber
 269                             }
 270                         );
 271                         if ( $ret->{'error'} == 1 ) {
 272                             Koha::Exceptions::Password::Plugin->throw();
 273                         }
 274                     }
 275                 }
 276
 277                 # Make a copy of the plain text password for later use
 278                 $self->plain_text_password( $self->password );
 279
 280                 $self->password_expiration_date( $self->password
 281                     ? $self->category->get_password_expiry_date || undef
 282                     : undef );
 283                 # Create a disabled account if no password provided
 284                 $self->password( $self->password
 285                     ? Koha::AuthUtils::hash_password( $self->password )
 286                     : '!' );
 287
 288                 $self->borrowernumber(undef);
 289
 290                 $self = $self->SUPER::store;
 291
 292                 $self->add_enrolment_fee_if_needed(0);
 293
 294                 logaction( "MEMBERS", "CREATE", $self->borrowernumber, "" )
 295                   if C4::Context->preference("BorrowersLog");
 296             }
 297             else {    #ModMember
 298
 299                 my $self_from_storage = $self->get_from_storage;
 300
 301                 # Do not accept invalid userid here
 302                 $self->generate_userid unless $self->userid;
 303                 Koha::Exceptions::Patron::InvalidUserid->throw( userid => $self->userid )
 304                       unless $self->has_valid_userid;
 305
 306                 # If a borrower has set their privacy to never we should immediately anonymize
 307                 # their checkouts
 308                 if( $self->privacy() == 2 && $self_from_storage->privacy() != 2 ){
 309                     try{
 310                         $self->old_checkouts->anonymize;
 311                     }
 312                     catch {
 313                         Koha::Exceptions::Patron::FailedAnonymizing->throw(
 314                             error => @_
 315                         );
 316                     };
 317                 }
 318
 319                 # Password must be updated using $self->set_password
 320                 $self->password($self_from_storage->password);
 321
 322                 if ( $self->category->categorycode ne
 323                     $self_from_storage->category->categorycode )
 324                 {
 325                     # Add enrolement fee on category change if required
 326                     $self->add_enrolment_fee_if_needed(1)
 327                       if C4::Context->preference('FeeOnChangePatronCategory');
 328
 329                     # Clean up guarantors on category change if required
 330                     $self->guarantor_relationships->delete
 331                       unless ( $self->category->can_be_guarantee );
 332
 333                 }
 334
 335                 # Actionlogs
 336                 if ( C4::Context->preference("BorrowersLog") ) {
 337                     my $info;
 338                     my $from_storage = $self_from_storage->unblessed;
 339                     my $from_object  = $self->unblessed;
 340                     my @skip_fields  = (qw/lastseen updated_on/);
 341                     for my $key ( keys %{$from_storage} ) {
 342                         next if any { /$key/ } @skip_fields;
 343                         if (
 344                             (
 345                                   !defined( $from_storage->{$key} )
 346                                 && defined( $from_object->{$key} )
 347                             )
 348                             || ( defined( $from_storage->{$key} )
 349                                 && !defined( $from_object->{$key} ) )
 350                             || (
 351                                    defined( $from_storage->{$key} )
 352                                 && defined( $from_object->{$key} )
 353                                 && ( $from_storage->{$key} ne
 354                                     $from_object->{$key} )
 355                             )
 356                           )
 357                         {
 358                             $info->{$key} = {
 359                                 before => $from_storage->{$key},
 360                                 after  => $from_object->{$key}
 361                             };
 362                         }
 363                     }
 364
 365                     if ( defined($info) ) {
 366                         logaction(
 367                             "MEMBERS",
 368                             "MODIFY",
 369                             $self->borrowernumber,
 370                             to_json(
 371                                 $info,
 372                                 { utf8 => 1, pretty => 1, canonical => 1 }
 373                             )
 374                         );
 375                     }
 376                 }
 377
 378                 # Final store
 379                 $self = $self->SUPER::store;
 380             }
 381         }
 382     );
 383     return $self;
 384 }
 385
 386 =head3 delete
 387
 388 $patron->delete
 389
 390 Delete patron's holds, lists and finally the patron.
 391
 392 Lists owned by the borrower are deleted or ownership is transferred depending on the
 393 ListOwnershipUponPatronDeletion pref, but entries from the borrower to other lists are kept.
 394
 395 =cut
 396
 397 sub delete {
 398     my ($self) = @_;
 399
 400     my $anonymous_patron = C4::Context->preference("AnonymousPatron");
 401     Koha::Exceptions::Patron::FailedDeleteAnonymousPatron->throw() if $anonymous_patron && $self->id eq $anonymous_patron;
 402
 403     $self->_result->result_source->schema->txn_do(
 404         sub {
 405             # Cancel Patron's holds
 406             my $holds = $self->holds;
 407             while( my $hold = $holds->next ){
 408                 $hold->cancel;
 409             }
 410
 411             # Handle lists (virtualshelves)
 412             $self->virtualshelves->disown_or_delete;
 413
 414             # We cannot have a FK on borrower_modifications.borrowernumber, the table is also used
 415             # for patron selfreg
 416             $_->delete for Koha::Patron::Modifications->search( { borrowernumber => $self->borrowernumber } )->as_list;
 417
 418             $self->SUPER::delete;
 419
 420             logaction( "MEMBERS", "DELETE", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog");
 421         }
 422     );
 423     return $self;
 424 }
 425
 426 =head3 category
 427
 428 my $patron_category = $patron->category
 429
 430 Return the patron category for this patron
 431
 432 =cut
 433
 434 sub category {
 435     my ( $self ) = @_;
 436     return Koha::Patron::Category->_new_from_dbic( $self->_result->categorycode );
 437 }
 438
 439 =head3 image
 440
 441 =cut
 442
 443 sub image {
 444     my ( $self ) = @_;
 445
 446     return Koha::Patron::Images->find( $self->borrowernumber );
 447 }
 448
 449 =head3 library
 450
 451 Returns a Koha::Library object representing the patron's home library.
 452
 453 =cut
 454
 455 sub library {
 456     my ( $self ) = @_;
 457     return Koha::Library->_new_from_dbic($self->_result->branchcode);
 458 }
 459
 460 =head3 sms_provider
 461
 462 Returns a Koha::SMS::Provider object representing the patron's SMS provider.
 463
 464 =cut
 465
 466 sub sms_provider {
 467     my ( $self ) = @_;
 468     my $sms_provider_rs = $self->_result->sms_provider;
 469     return unless $sms_provider_rs;
 470     return Koha::SMS::Provider->_new_from_dbic($sms_provider_rs);
 471 }
 472
 473 =head3 guarantor_relationships
 474
 475 Returns Koha::Patron::Relationships object for this patron's guarantors
 476
 477 Returns the set of relationships for the patrons that are guarantors for this patron.
 478
 479 Note that a guarantor should exist as a patron in Koha; it was not possible
 480 to add them without a guarantor_id in the interface for some time. Bug 30472
 481 restricts it on db level.
 482
 483 =cut
 484
 485 sub guarantor_relationships {
 486     my ($self) = @_;
 487
 488     return Koha::Patron::Relationships->search( { guarantee_id => $self->id } );
 489 }
 490
 491 =head3 guarantee_relationships
 492
 493 Returns Koha::Patron::Relationships object for this patron's guarantors
 494
 495 Returns the set of relationships for the patrons that are guarantees for this patron.
 496
 497 The method returns Koha::Patron::Relationship objects for the sake
 498 of consistency with the guantors method.
 499 A guarantee by definition must exist as a patron in Koha.
 500
 501 =cut
 502
 503 sub guarantee_relationships {
 504     my ($self) = @_;
 505
 506     return Koha::Patron::Relationships->search(
 507         { guarantor_id => $self->id },
 508         {
 509             prefetch => 'guarantee',
 510             order_by => { -asc => [ 'guarantee.surname', 'guarantee.firstname' ] },
 511         }
 512     );
 513 }
 514
 515 =head3 relationships_debt
 516
 517 Returns the amount owed by the patron's guarantors *and* the other guarantees of those guarantors
 518
 519 =cut
 520
 521 sub relationships_debt {
 522     my ($self, $params) = @_;
 523
 524     my $include_guarantors  = $params->{include_guarantors};
 525     my $only_this_guarantor = $params->{only_this_guarantor};
 526     my $include_this_patron = $params->{include_this_patron};
 527
 528     my @guarantors;
 529     if ( $only_this_guarantor ) {
 530         @guarantors = $self->guarantee_relationships->count ? ( $self ) : ();
 531         Koha::Exceptions::BadParameter->throw( { parameter => 'only_this_guarantor' } ) unless @guarantors;
 532     } elsif ( $self->guarantor_relationships->count ) {
 533         # I am a guarantee, just get all my guarantors
 534         @guarantors = $self->guarantor_relationships->guarantors->as_list;
 535     } else {
 536         # I am a guarantor, I need to get all the guarantors of all my guarantees
 537         @guarantors = map { $_->guarantor_relationships->guarantors->as_list } $self->guarantee_relationships->guarantees->as_list;
 538     }
 539
 540     my $non_issues_charges = 0;
 541     my $seen = $include_this_patron ? {} : { $self->id => 1 }; # For tracking members already added to the total
 542     foreach my $guarantor (@guarantors) {
 543         $non_issues_charges += $guarantor->account->non_issues_charges if $include_guarantors && !$seen->{ $guarantor->id };
 544
 545         # We've added what the guarantor owes, not added in that guarantor's guarantees as well
 546         my @guarantees = map { $_->guarantee } $guarantor->guarantee_relationships->as_list;
 547         my $guarantees_non_issues_charges = 0;
 548         foreach my $guarantee (@guarantees) {
 549             next if $seen->{ $guarantee->id };
 550             $guarantees_non_issues_charges += $guarantee->account->non_issues_charges;
 551             # Mark this guarantee as seen so we don't double count a guarantee linked to multiple guarantors
 552             $seen->{ $guarantee->id } = 1;
 553         }
 554
 555         $non_issues_charges += $guarantees_non_issues_charges;
 556         $seen->{ $guarantor->id } = 1;
 557     }
 558
 559     return $non_issues_charges;
 560 }
 561
 562 =head3 housebound_profile
 563
 564 Returns the HouseboundProfile associated with this patron.
 565
 566 =cut
 567
 568 sub housebound_profile {
 569     my ( $self ) = @_;
 570     my $profile = $self->_result->housebound_profile;
 571     return Koha::Patron::HouseboundProfile->_new_from_dbic($profile)
 572         if ( $profile );
 573     return;
 574 }
 575
 576 =head3 housebound_role
 577
 578 Returns the HouseboundRole associated with this patron.
 579
 580 =cut
 581
 582 sub housebound_role {
 583     my ( $self ) = @_;
 584
 585     my $role = $self->_result->housebound_role;
 586     return Koha::Patron::HouseboundRole->_new_from_dbic($role) if ( $role );
 587     return;
 588 }
 589
 590 =head3 siblings
 591
 592 Returns the siblings of this patron.
 593
 594 =cut
 595
 596 sub siblings {
 597     my ($self) = @_;
 598
 599     my @guarantors = $self->guarantor_relationships()->guarantors()->as_list;
 600
 601     return unless @guarantors;
 602
 603     my @siblings =
 604       map { $_->guarantee_relationships()->guarantees()->as_list } @guarantors;
 605
 606     return unless @siblings;
 607
 608     my %seen;
 609     @siblings =
 610       grep { !$seen{ $_->id }++ && ( $_->id != $self->id ) } @siblings;
 611
 612     return Koha::Patrons->search( { borrowernumber => { -in => [ map { $_->id } @siblings ] } } );
 613 }
 614
 615 =head3 merge_with
 616
 617     my $patron = Koha::Patrons->find($id);
 618     $patron->merge_with( \@patron_ids );
 619
 620     This subroutine merges a list of patrons into the patron record. This is accomplished by finding
 621     all related patron ids for the patrons to be merged in other tables and changing the ids to be that
 622     of the keeper patron.
 623
 624 =cut
 625
 626 sub merge_with {
 627     my ( $self, $patron_ids ) = @_;
 628
 629     my $anonymous_patron = C4::Context->preference("AnonymousPatron");
 630     return if $anonymous_patron && $self->id eq $anonymous_patron;
 631
 632     my @patron_ids = @{ $patron_ids };
 633
 634     # Ensure the keeper isn't in the list of patrons to merge
 635     @patron_ids = grep { $_ ne $self->id } @patron_ids;
 636
 637     my $schema = Koha::Database->new()->schema();
 638
 639     my $results;
 640
 641     $self->_result->result_source->schema->txn_do( sub {
 642         foreach my $patron_id (@patron_ids) {
 643
 644             next if $patron_id eq $anonymous_patron;
 645
 646             my $patron = Koha::Patrons->find( $patron_id );
 647
 648             next unless $patron;
 649
 650             # Unbless for safety, the patron will end up being deleted
 651             $results->{merged}->{$patron_id}->{patron} = $patron->unblessed;
 652
 653             my $attributes = $patron->extended_attributes;
 654             my $new_attributes = [
 655                 map { { code => $_->code, attribute => $_->attribute } }
 656                     $attributes->as_list
 657             ];
 658             $attributes->delete; # We need to delete before trying to merge them to prevent exception on unique and repeatable
 659             for my $attribute ( @$new_attributes ) {
 660                 try {
 661                     $self->add_extended_attribute($attribute);
 662                 } catch {
 663                     # Don't block the merge if there is a non-repeatable attribute that cannot be added to the current patron.
 664                     unless ( $_->isa('Koha::Exceptions::Patron::Attribute::NonRepeatable') ) {
 665                         $_->rethrow;
 666                     }
 667                 };
 668             }
 669
 670             while (my ($r, $field) = each(%$RESULTSET_PATRON_ID_MAPPING)) {
 671                 my $rs = $schema->resultset($r)->search({ $field => $patron_id });
 672                 $results->{merged}->{ $patron_id }->{updated}->{$r} = $rs->count();
 673                 $rs->update({ $field => $self->id });
 674                 if ( $r eq 'BorrowerDebarment' ) {
 675                     Koha::Patron::Debarments::UpdateBorrowerDebarmentFlags($self->id);
 676                 }
 677             }
 678
 679             $patron->move_to_deleted();
 680             $patron->delete();
 681         }
 682     });
 683
 684     return $results;
 685 }
 686
 687
 688 =head3 messaging_preferences
 689
 690     my $patron = Koha::Patrons->find($id);
 691     $patron->messaging_preferences();
 692
 693 =cut
 694
 695 sub messaging_preferences {
 696     my ( $self ) = @_;
 697
 698     return Koha::Patron::MessagePreferences->search({
 699         borrowernumber => $self->borrowernumber,
 700     });
 701 }
 702
 703 =head3 wants_check_for_previous_checkout
 704
 705     $wants_check = $patron->wants_check_for_previous_checkout;
 706
 707 Return 1 if Koha needs to perform PrevIssue checking, else 0.
 708
 709 =cut
 710
 711 sub wants_check_for_previous_checkout {
 712     my ( $self ) = @_;
 713     my $syspref = C4::Context->preference("checkPrevCheckout");
 714
 715     # Simple cases
 716     ## Hard syspref trumps all
 717     return 1 if ($syspref eq 'hardyes');
 718     return 0 if ($syspref eq 'hardno');
 719     ## Now, patron pref trumps all
 720     return 1 if ($self->checkprevcheckout eq 'yes');
 721     return 0 if ($self->checkprevcheckout eq 'no');
 722
 723     # More complex: patron inherits -> determine category preference
 724     my $checkPrevCheckoutByCat = $self->category->checkprevcheckout;
 725     return 1 if ($checkPrevCheckoutByCat eq 'yes');
 726     return 0 if ($checkPrevCheckoutByCat eq 'no');
 727
 728     # Finally: category preference is inherit, default to 0
 729     if ($syspref eq 'softyes') {
 730         return 1;
 731     } else {
 732         return 0;
 733     }
 734 }
 735
 736 =head3 do_check_for_previous_checkout
 737
 738     $do_check = $patron->do_check_for_previous_checkout($item);
 739
 740 Return 1 if the bib associated with $ITEM has previously been checked out to
 741 $PATRON, 0 otherwise.
 742
 743 =cut
 744
 745 sub do_check_for_previous_checkout {
 746     my ( $self, $item ) = @_;
 747
 748     my @item_nos;
 749     my $biblio = Koha::Biblios->find( $item->{biblionumber} );
 750     if ( $biblio->is_serial ) {
 751         push @item_nos, $item->{itemnumber};
 752     } else {
 753         # Get all itemnumbers for given bibliographic record.
 754         @item_nos = $biblio->items->get_column( 'itemnumber' );
 755     }
 756
 757     # Create (old)issues search criteria
 758     my $criteria = {
 759         borrowernumber => $self->borrowernumber,
 760         itemnumber => \@item_nos,
 761     };
 762
 763     my $delay = C4::Context->preference('CheckPrevCheckoutDelay') || 0;
 764     if ($delay) {
 765         my $dtf = Koha::Database->new->schema->storage->datetime_parser;
 766         my $newer_than = dt_from_string()->subtract( days => $delay );
 767         $criteria->{'returndate'} = { '>'   =>  $dtf->format_datetime($newer_than), };
 768     }
 769
 770     # Check current issues table
 771     my $issues = Koha::Checkouts->search($criteria);
 772     return 1 if $issues->count; # 0 || N
 773
 774     # Check old issues table
 775     my $old_issues = Koha::Old::Checkouts->search($criteria);
 776     return $old_issues->count;  # 0 || N
 777 }
 778
 779 =head3 is_debarred
 780
 781 my $debarment_expiration = $patron->is_debarred;
 782
 783 Returns the date a patron debarment will expire, or undef if the patron is not
 784 debarred
 785
 786 =cut
 787
 788 sub is_debarred {
 789     my ($self) = @_;
 790
 791     return unless $self->debarred;
 792     return $self->debarred
 793       if $self->debarred =~ '^9999'
 794       or dt_from_string( $self->debarred ) > dt_from_string;
 795     return;
 796 }
 797
 798 =head3 is_expired
 799
 800 my $is_expired = $patron->is_expired;
 801
 802 Returns 1 if the patron is expired or 0;
 803
 804 =cut
 805
 806 sub is_expired {
 807     my ($self) = @_;
 808     return 0 unless $self->dateexpiry;
 809     return 0 if $self->dateexpiry =~ '^9999';
 810     return 1 if dt_from_string( $self->dateexpiry ) < dt_from_string->truncate( to => 'day' );
 811     return 0;
 812 }
 813
 814 =head3 is_active
 815
 816 $patron->is_active({ [ since => $date ], [ days|weeks|months|years => $value ] })
 817
 818 A patron is considered 'active' if the following conditions hold:
 819
 820     - account did not expire
 821     - account has not been anonymized
 822     - enrollment or lastseen within period specified
 823
 824 Note: lastseen is updated for triggers defined in preference
 825 TrackLastPatronActivityTriggers. This includes logins, issues, holds, etc.
 826
 827 The period to check is defined by $date or $value in days, weeks or months. You should
 828 pass one of those; otherwise an exception is thrown.
 829
 830 =cut
 831
 832 sub is_active {
 833     my ( $self, $params ) = @_;
 834     return 0 if $self->is_expired or $self->anonymized;
 835
 836     my $dt;
 837     if ( $params->{since} ) {
 838         $dt = dt_from_string( $params->{since}, 'iso' );
 839     } elsif ( grep { $params->{$_} } qw(days weeks months years) ) {
 840         $dt = dt_from_string();
 841         foreach my $duration (qw(days weeks months years)) {
 842             $dt = $dt->subtract( $duration => $params->{$duration} ) if $params->{$duration};
 843         }
 844     } else {
 845         Koha::Exceptions::MissingParameter->throw('is_active needs date or period');
 846     }
 847
 848     # Enrollment within this period?
 849     return 1 if DateTime->compare( dt_from_string( $self->dateenrolled ), $dt ) > -1;
 850
 851     # We look at lastseen regardless of TrackLastPatronActivityTriggers. If lastseen is set
 852     # recently, the triggers may have been removed after that, etc.
 853     return 1 if $self->lastseen && DateTime->compare( dt_from_string( $self->lastseen ), $dt ) > -1;
 854
 855     return 0;
 856 }
 857
 858 =head3 password_expired
 859
 860 my $password_expired = $patron->password_expired;
 861
 862 Returns 1 if the patron's password is expired or 0;
 863
 864 =cut
 865
 866 sub password_expired {
 867     my ($self) = @_;
 868     return 0 unless $self->password_expiration_date;
 869     return 1 if dt_from_string( $self->password_expiration_date ) <= dt_from_string->truncate( to => 'day' );
 870     return 0;
 871 }
 872
 873 =head3 is_going_to_expire
 874
 875 my $is_going_to_expire = $patron->is_going_to_expire;
 876
 877 Returns 1 if the patron is going to expired, depending on the NotifyBorrowerDeparture pref or 0
 878
 879 =cut
 880
 881 sub is_going_to_expire {
 882     my ($self) = @_;
 883
 884     my $delay = C4::Context->preference('NotifyBorrowerDeparture') || 0;
 885
 886     return 0 unless $delay;
 887     return 0 unless $self->dateexpiry;
 888     return 0 if $self->dateexpiry =~ '^9999';
 889     return 1 if dt_from_string( $self->dateexpiry, undef, 'floating' )->subtract( days => $delay ) < dt_from_string(undef, undef, 'floating')->truncate( to => 'day' );
 890     return 0;
 891 }
 892
 893 =head3 set_password
 894
 895     $patron->set_password({ password => $plain_text_password [, skip_validation => 1 ] });
 896
 897 Set the patron's password.
 898
 899 =head4 Exceptions
 900
 901 The passed string is validated against the current password enforcement policy.
 902 Validation can be skipped by passing the I<skip_validation> parameter.
 903
 904 Exceptions are thrown if the password is not good enough.
 905
 906 =over 4
 907
 908 =item Koha::Exceptions::Password::TooShort
 909
 910 =item Koha::Exceptions::Password::WhitespaceCharacters
 911
 912 =item Koha::Exceptions::Password::TooWeak
 913
 914 =item Koha::Exceptions::Password::Plugin (if a "check password" plugin is enabled)
 915
 916 =back
 917
 918 =cut
 919
 920 sub set_password {
 921     my ( $self, $args ) = @_;
 922
 923     my $password = $args->{password};
 924
 925     unless ( $args->{skip_validation} ) {
 926         my ( $is_valid, $error ) = Koha::AuthUtils::is_password_valid( $password, $self->category );
 927
 928         if ( !$is_valid ) {
 929             if ( $error eq 'too_short' ) {
 930                 my $min_length = $self->category->effective_min_password_length;
 931                 $min_length = 3 if not $min_length or $min_length < 3;
 932
 933                 my $password_length = length($password);
 934                 Koha::Exceptions::Password::TooShort->throw(
 935                     length => $password_length, min_length => $min_length );
 936             }
 937             elsif ( $error eq 'has_whitespaces' ) {
 938                 Koha::Exceptions::Password::WhitespaceCharacters->throw();
 939             }
 940             elsif ( $error eq 'too_weak' ) {
 941                 Koha::Exceptions::Password::TooWeak->throw();
 942             }
 943         }
 944     }
 945
 946     if ( C4::Context->config("enable_plugins") ) {
 947         # Call any check_password plugins
 948         my @plugins = Koha::Plugins->new()->GetPlugins({
 949             method => 'check_password',
 950         });
 951         foreach my $plugin ( @plugins ) {
 952             # This plugin hook will also be used by a plugin for the Norwegian national
 953             # patron database. This is why we need to pass both the password and the
 954             # borrowernumber to the plugin.
 955             my $ret = $plugin->check_password(
 956                 {
 957                     password       => $password,
 958                     borrowernumber => $self->borrowernumber
 959                 }
 960             );
 961             # This plugin hook will also be used by a plugin for the Norwegian national
 962             # patron database. This is why we need to call the actual plugins and then
 963             # check skip_validation afterwards.
 964             if ( $ret->{'error'} == 1 && !$args->{skip_validation} ) {
 965                 Koha::Exceptions::Password::Plugin->throw();
 966             }
 967         }
 968     }
 969
 970     if ( C4::Context->preference('NotifyPasswordChange') ) {
 971         my $self_from_storage = $self->get_from_storage;
 972         if ( !C4::Auth::checkpw_hash( $password, $self_from_storage->password ) ) {
 973             my $emailaddr = $self_from_storage->notice_email_address;
 974
 975             # if we manage to find a valid email address, send notice
 976             if ($emailaddr) {
 977                 my $letter = C4::Letters::GetPreparedLetter(
 978                     module      => 'members',
 979                     letter_code => 'PASSWORD_CHANGE',
 980                     branchcode  => $self_from_storage->branchcode,
 981                     ,
 982                     lang   => $self_from_storage->lang || 'default',
 983                     tables => {
 984                         'branches'  => $self_from_storage->branchcode,
 985                         'borrowers' => $self_from_storage->borrowernumber,
 986                     },
 987                     want_librarian => 1,
 988                 ) or return;
 989
 990                 my $message_id = C4::Letters::EnqueueLetter(
 991                     {
 992                         letter                 => $letter,
 993                         borrowernumber         => $self_from_storage->id,
 994                         to_address             => $emailaddr,
 995                         message_transport_type => 'email'
 996                     }
 997                 );
 998                 C4::Letters::SendQueuedMessages( { message_id => $message_id } ) if $message_id;
 999             }
1000         }
1001     }
1002
1003     my $digest = Koha::AuthUtils::hash_password($password);
1004
1005     $self->password_expiration_date( $self->category->get_password_expiry_date || undef );
1006
1007     # We do not want to call $self->store and retrieve password from DB
1008     $self->password($digest);
1009     $self->login_attempts(0);
1010     $self->SUPER::store;
1011
1012     logaction( "MEMBERS", "CHANGE PASS", $self->borrowernumber, "" )
1013         if C4::Context->preference("BorrowersLog");
1014
1015     return $self;
1016 }
1017
1018
1019 =head3 renew_account
1020
1021 my $new_expiry_date = $patron->renew_account
1022
1023 Extending the subscription to the expiry date.
1024
1025 =cut
1026
1027 sub renew_account {
1028     my ($self) = @_;
1029     my $date;
1030     if ( C4::Context->preference('BorrowerRenewalPeriodBase') eq 'combination' ) {
1031         $date = ( dt_from_string gt dt_from_string( $self->dateexpiry ) ) ? dt_from_string : dt_from_string( $self->dateexpiry );
1032     } else {
1033         $date =
1034             C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry'
1035             ? dt_from_string( $self->dateexpiry )
1036             : dt_from_string;
1037     }
1038     my $expiry_date = $self->category->get_expiry_date($date);
1039
1040     $self->dateexpiry($expiry_date);
1041     $self->date_renewed( dt_from_string() );
1042     $self->store();
1043
1044     $self->add_enrolment_fee_if_needed(1);
1045
1046     logaction( "MEMBERS", "RENEW", $self->borrowernumber, "Membership renewed" ) if C4::Context->preference("BorrowersLog");
1047     return dt_from_string( $expiry_date )->truncate( to => 'day' );
1048 }
1049
1050 =head3 has_overdues
1051
1052 my $has_overdues = $patron->has_overdues;
1053
1054 Returns the number of patron's overdues
1055
1056 =cut
1057
1058 sub has_overdues {
1059     my ($self) = @_;
1060     my $date = dt_from_string();
1061     my $dtf = Koha::Database->new->schema->storage->datetime_parser;
1062     return $self->_result->issues->search({ date_due => { '<' => $dtf->format_datetime($date) } })->count;
1063 }
1064
1065
1066
1067 =head3 has_restricting_overdues
1068
1069 my $has_restricting_overdues = $patron->has_restricting_overdues({ issue_branchcode => $branchcode });
1070
1071 Returns true if patron has overdues that would result in debarment.
1072
1073 =cut
1074
1075 sub has_restricting_overdues {
1076     my ( $self, $params ) = @_;
1077     $params //= {};
1078     my $date = dt_from_string()->truncate( to => 'day' );
1079
1080     # If ignoring unrestricted overdues, calculate which delay value for
1081     # overdue messages is set with restrictions. Then only include overdue
1082     # issues older than that date when counting.
1083     #TODO: bail out/throw exception if $params->{issue_branchcode} not set?
1084     my $debarred_delay = _get_overdue_debarred_delay( $params->{issue_branchcode}, $self->categorycode() );
1085     return 0 unless defined $debarred_delay;
1086
1087     # Emulate the conditions in overdue_notices.pl.
1088     # The overdue_notices-script effectively truncates both issues.date_due and current date
1089     # to days when selecting overdue issues.
1090     # Hours and minutes for issues.date_due is usually set to 23 and 59 respectively, though can theoretically
1091     # be set to any other value (truncated to minutes, except if CalcDateDue gets a $startdate)
1092     #
1093     # No matter what time of day date_due is set to, overdue_notices.pl will select all issues that are due
1094     # the current date or later. We can emulate this query by instead of truncating both to days in the SQL-query,
1095     # using the condition that date_due must be less then the current date truncated to days (time set to 00:00:00)
1096     # offset by one day in the future.
1097
1098     $date->add( days => 1 );
1099
1100     my $calendar;
1101     if ( C4::Context->preference('OverdueNoticeCalendar') ) {
1102         $calendar = Koha::Calendar->new( branchcode => $params->{issue_branchcode} );
1103     }
1104
1105     my $dtf    = Koha::Database->new->schema->storage->datetime_parser;
1106     my $issues = $self->_result->issues->search( { date_due => { '<' => $dtf->format_datetime($date) } } );
1107     my $now    = dt_from_string();
1108
1109     while ( my $issue = $issues->next ) {
1110         my $days_between =
1111             C4::Context->preference('OverdueNoticeCalendar')
1112             ? $calendar->days_between( dt_from_string( $issue->date_due ), $now )->in_units('days')
1113             : $now->delta_days( dt_from_string( $issue->date_due ) )->in_units('days');
1114         if ( $days_between >= $debarred_delay ) {
1115             return 1;
1116         }
1117     }
1118     return 0;
1119 }
1120
1121 # Fetch first delayX value from overduerules where debarredX is set, or 0 for no delay
1122 sub _get_overdue_debarred_delay {
1123     my ( $branchcode, $categorycode ) = @_;
1124     my $dbh = C4::Context->dbh();
1125
1126     # We get default rules if there is no rule for this branch
1127     my $rule = Koha::OverdueRules->find(
1128         {
1129             branchcode   => $branchcode,
1130             categorycode => $categorycode
1131         }
1132         )
1133         || Koha::OverdueRules->find(
1134         {
1135             branchcode   => q{},
1136             categorycode => $categorycode
1137         }
1138         );
1139
1140     if ($rule) {
1141         return $rule->delay1 if $rule->debarred1;
1142         return $rule->delay2 if $rule->debarred2;
1143         return $rule->delay3 if $rule->debarred3;
1144     }
1145 }
1146
1147 =head3 update_lastseen
1148
1149   $patron->update_lastseen('activity');
1150
1151 Updates the lastseen field, limited to one update per day, whenever the activity passed is
1152 listed in TrackLastPatronActivityTriggers.
1153
1154 The method should be called upon successful completion of the activity.
1155
1156 =cut
1157
1158 sub update_lastseen {
1159     my ( $self, $activity ) = @_;
1160     my $tracked_activities = {
1161         map { ( lc $_, 1 ); } split /\s*\,\s*/,
1162         C4::Context->preference('TrackLastPatronActivityTriggers')
1163     };
1164     return $self unless $tracked_activities->{$activity};
1165
1166     my $cache     = Koha::Caches->get_instance();
1167     my $cache_key = "track_activity_" . $self->borrowernumber;
1168     my $cached    = $cache->get_from_cache($cache_key);
1169     my $now       = dt_from_string();
1170     return $self if $cached && $cached eq $now->ymd;
1171
1172     $self->lastseen($now)->store;
1173     $cache->set_in_cache( $cache_key, $now->ymd );
1174     return $self;
1175 }
1176
1177 =head3 move_to_deleted
1178
1179 my $is_moved = $patron->move_to_deleted;
1180
1181 Move a patron to the deletedborrowers table.
1182 This can be done before deleting a patron, to make sure the data are not completely deleted.
1183
1184 =cut
1185
1186 sub move_to_deleted {
1187     my ($self) = @_;
1188     my $patron_infos = $self->unblessed;
1189     delete $patron_infos->{updated_on}; #This ensures the updated_on date in deletedborrowers will be set to the current timestamp
1190     return Koha::Database->new->schema->resultset('Deletedborrower')->create($patron_infos);
1191 }
1192
1193 =head3 can_request_article
1194
1195     if ( $patron->can_request_article( $library->id ) ) { ... }
1196
1197 Returns true if the patron can request articles. As limits apply for the patron
1198 on the same day, those completed the same day are considered as current.
1199
1200 A I<library_id> can be passed as parameter, falling back to userenv if absent.
1201
1202 =cut
1203
1204 sub can_request_article {
1205     my ($self, $library_id) = @_;
1206
1207     $library_id //= C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef;
1208
1209     my $rule = Koha::CirculationRules->get_effective_rule(
1210         {
1211             branchcode   => $library_id,
1212             categorycode => $self->categorycode,
1213             rule_name    => 'open_article_requests_limit'
1214         }
1215     );
1216
1217     my $limit = ($rule) ? $rule->rule_value : undef;
1218
1219     return 1 unless defined $limit;
1220
1221     my $count = Koha::ArticleRequests->search(
1222         [   { borrowernumber => $self->borrowernumber, status => [ 'REQUESTED', 'PENDING', 'PROCESSING' ] },
1223             { borrowernumber => $self->borrowernumber, status => 'COMPLETED', updated_on => { '>=' => \'CAST(NOW() AS DATE)' } },
1224         ]
1225     )->count;
1226     return $count < $limit ? 1 : 0;
1227 }
1228
1229 =head3 article_request_fee
1230
1231     my $fee = $patron->article_request_fee(
1232         {
1233           [ library_id => $library->id, ]
1234         }
1235     );
1236
1237 Returns the fee to be charged to the patron when it places an article request.
1238
1239 A I<library_id> can be passed as parameter, falling back to userenv if absent.
1240
1241 =cut
1242
1243 sub article_request_fee {
1244     my ($self, $params) = @_;
1245
1246     my $library_id = $params->{library_id};
1247
1248     $library_id //= C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef;
1249
1250     my $rule = Koha::CirculationRules->get_effective_rule(
1251         {
1252             branchcode   => $library_id,
1253             categorycode => $self->categorycode,
1254             rule_name    => 'article_request_fee'
1255         }
1256     );
1257
1258     my $fee = ($rule) ? $rule->rule_value + 0 : 0;
1259
1260     return $fee;
1261 }
1262
1263 =head3 add_article_request_fee_if_needed
1264
1265     my $fee = $patron->add_article_request_fee_if_needed(
1266         {
1267           [ item_id    => $item->id,
1268             library_id => $library->id, ]
1269         }
1270     );
1271
1272 If an article request fee needs to be charged, it adds a debit to the patron's
1273 account.
1274
1275 Returns the fee line.
1276
1277 A I<library_id> can be passed as parameter, falling back to userenv if absent.
1278
1279 =cut
1280
1281 sub add_article_request_fee_if_needed {
1282     my ($self, $params) = @_;
1283
1284     my $library_id = $params->{library_id};
1285     my $item_id    = $params->{item_id};
1286
1287     $library_id //= C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef;
1288
1289     my $amount = $self->article_request_fee(
1290         {
1291             library_id => $library_id,
1292         }
1293     );
1294
1295     my $debit_line;
1296
1297     if ( $amount > 0 ) {
1298         $debit_line = $self->account->add_debit(
1299             {
1300                 amount     => $amount,
1301                 user_id    => C4::Context->userenv ? C4::Context->userenv->{'number'} : undef,
1302                 interface  => C4::Context->interface,
1303                 library_id => $library_id,
1304                 type       => 'ARTICLE_REQUEST',
1305                 item_id    => $item_id,
1306             }
1307         );
1308     }
1309
1310     return $debit_line;
1311 }
1312
1313 =head3 article_requests
1314
1315     my $article_requests = $patron->article_requests;
1316
1317 Returns the patron article requests.
1318
1319 =cut
1320
1321 sub article_requests {
1322     my ($self) = @_;
1323
1324     return Koha::ArticleRequests->_new_from_dbic( scalar $self->_result->article_requests );
1325 }
1326
1327 =head3 add_enrolment_fee_if_needed
1328
1329 my $enrolment_fee = $patron->add_enrolment_fee_if_needed($renewal);
1330
1331 Add enrolment fee for a patron if needed.
1332
1333 $renewal - boolean denoting whether this is an account renewal or not
1334
1335 =cut
1336
1337 sub add_enrolment_fee_if_needed {
1338     my ($self, $renewal) = @_;
1339     my $enrolment_fee = $self->category->enrolmentfee;
1340     if ( $enrolment_fee && $enrolment_fee > 0 ) {
1341         my $type = $renewal ? 'ACCOUNT_RENEW' : 'ACCOUNT';
1342         $self->account->add_debit(
1343             {
1344                 amount     => $enrolment_fee,
1345                 user_id    => C4::Context->userenv ? C4::Context->userenv->{'number'} : undef,
1346                 interface  => C4::Context->interface,
1347                 library_id => C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef,
1348                 type       => $type
1349             }
1350         );
1351     }
1352     return $enrolment_fee || 0;
1353 }
1354
1355 =head3 checkouts
1356
1357 my $checkouts = $patron->checkouts
1358
1359 =cut
1360
1361 sub checkouts {
1362     my ($self) = @_;
1363     my $checkouts = $self->_result->issues;
1364     return Koha::Checkouts->_new_from_dbic( $checkouts );
1365 }
1366
1367 =head3 pending_checkouts
1368
1369 my $pending_checkouts = $patron->pending_checkouts
1370
1371 This method will return the same as $self->checkouts, but with a prefetch on
1372 items, biblio and biblioitems.
1373
1374 It has been introduced to replaced the C4::Members::GetPendingIssues subroutine
1375
1376 It should not be used directly, prefer to access fields you need instead of
1377 retrieving all these fields in one go.
1378
1379 =cut
1380
1381 sub pending_checkouts {
1382     my( $self ) = @_;
1383     my $checkouts = $self->_result->issues->search(
1384         {},
1385         {
1386             order_by => [
1387                 { -desc => 'me.timestamp' },
1388                 { -desc => 'issuedate' },
1389                 { -desc => 'issue_id' }, # Sort by issue_id should be enough
1390             ],
1391             prefetch => { item => { biblio => 'biblioitems' } },
1392         }
1393     );
1394     return Koha::Checkouts->_new_from_dbic( $checkouts );
1395 }
1396
1397 =head3 old_checkouts
1398
1399 my $old_checkouts = $patron->old_checkouts
1400
1401 =cut
1402
1403 sub old_checkouts {
1404     my ($self) = @_;
1405     my $old_checkouts = $self->_result->old_issues;
1406     return Koha::Old::Checkouts->_new_from_dbic( $old_checkouts );
1407 }
1408
1409 =head3 overdues
1410
1411 my $overdue_items = $patron->overdues
1412
1413 Return the overdue items
1414
1415 =cut
1416
1417 sub overdues {
1418     my ($self) = @_;
1419     my $dtf = Koha::Database->new->schema->storage->datetime_parser;
1420     return $self->checkouts->search(
1421         {
1422             'me.date_due' => { '<' => $dtf->format_datetime(dt_from_string) },
1423         },
1424         {
1425             prefetch => { item => { biblio => 'biblioitems' } },
1426         }
1427     );
1428 }
1429
1430
1431 =head3 restrictions
1432
1433   my $restrictions = $patron->restrictions;
1434
1435 Returns the patron restrictions.
1436
1437 =cut
1438
1439 sub restrictions {
1440     my ($self) = @_;
1441     my $restrictions_rs = $self->_result->restrictions;
1442     return Koha::Patron::Restrictions->_new_from_dbic($restrictions_rs);
1443 }
1444
1445 =head3 get_routing_lists
1446
1447 my $routinglists = $patron->get_routing_lists
1448
1449 Returns the routing lists a patron is subscribed to.
1450
1451 =cut
1452
1453 sub get_routing_lists {
1454     my ($self) = @_;
1455     my $routing_list_rs = $self->_result->subscriptionroutinglists;
1456     return Koha::Subscription::Routinglists->_new_from_dbic($routing_list_rs);
1457 }
1458
1459 =head3 get_age
1460
1461     my $age = $patron->get_age
1462
1463 Return the age of the patron
1464
1465 =cut
1466
1467 sub get_age {
1468     my ($self)    = @_;
1469
1470     return unless $self->dateofbirth;
1471
1472     #Set timezone to floating to avoid any datetime math issues caused by DST
1473     my $date_of_birth = dt_from_string( $self->dateofbirth, undef, 'floating' );
1474     my $today         = dt_from_string(undef, undef, 'floating')->truncate( to => 'day' );
1475
1476     return $today->subtract_datetime( $date_of_birth )->years;
1477 }
1478
1479 =head3 is_valid_age
1480
1481 my $is_valid = $patron->is_valid_age
1482
1483 Return 1 if patron's age is between allowed limits, returns 0 if it's not.
1484
1485 =cut
1486
1487 sub is_valid_age {
1488     my ($self) = @_;
1489     my $age = $self->get_age;
1490
1491     my $patroncategory = $self->category;
1492     my ($low,$high) = ($patroncategory->dateofbirthrequired, $patroncategory->upperagelimit);
1493
1494     return (defined($age) && (($high && ($age > $high)) or ($low && ($age < $low)))) ? 0 : 1;
1495 }
1496
1497 =head3 account
1498
1499 my $account = $patron->account
1500
1501 =cut
1502
1503 sub account {
1504     my ($self) = @_;
1505     return Koha::Account->new( { patron_id => $self->borrowernumber } );
1506 }
1507
1508 =head3 holds
1509
1510 my $holds = $patron->holds
1511
1512 Return all the holds placed by this patron
1513
1514 =cut
1515
1516 sub holds {
1517     my ($self) = @_;
1518     my $holds_rs = $self->_result->reserves->search( {}, { order_by => 'reservedate' } );
1519     return Koha::Holds->_new_from_dbic($holds_rs);
1520 }
1521
1522 =head3 old_holds
1523
1524 my $old_holds = $patron->old_holds
1525
1526 Return all the historical holds for this patron
1527
1528 =cut
1529
1530 sub old_holds {
1531     my ($self) = @_;
1532     my $old_holds_rs = $self->_result->old_reserves->search( {}, { order_by => 'reservedate' } );
1533     return Koha::Old::Holds->_new_from_dbic($old_holds_rs);
1534 }
1535
1536 =head3 curbside_pickups
1537
1538 my $curbside_pickups = $patron->curbside_pickups;
1539
1540 Return all the curbside pickups for this patron
1541
1542 =cut
1543
1544 sub curbside_pickups {
1545     my ($self) = @_;
1546     my $curbside_pickups_rs = $self->_result->curbside_pickups_borrowernumbers->search;
1547     return Koha::CurbsidePickups->_new_from_dbic($curbside_pickups_rs);
1548 }
1549
1550 =head3 return_claims
1551
1552 my $return_claims = $patron->return_claims
1553
1554 =cut
1555
1556 sub return_claims {
1557     my ($self) = @_;
1558     my $return_claims = $self->_result->return_claims_borrowernumbers;
1559     return Koha::Checkouts::ReturnClaims->_new_from_dbic( $return_claims );
1560 }
1561
1562 =head3 notice_email_address
1563
1564   my $email = $patron->notice_email_address;
1565
1566 Return the email address of patron used for notices.
1567 Returns the empty string if no email address.
1568
1569 =cut
1570
1571 sub notice_email_address{
1572     my ( $self ) = @_;
1573
1574     my $which_address = C4::Context->preference("EmailFieldPrimary");
1575     # if syspref is set to 'first valid' (value == OFF), look up email address
1576     if ( $which_address eq 'OFF' ) {
1577         return $self->first_valid_email_address;
1578     }
1579
1580     return $self->$which_address || '';
1581 }
1582
1583 =head3 first_valid_email_address
1584
1585 my $first_valid_email_address = $patron->first_valid_email_address
1586
1587 Return the first valid email address for a patron.
1588 For now, the order  is defined as email, emailpro, B_email.
1589 Returns the empty string if the borrower has no email addresses.
1590
1591 =cut
1592
1593 sub first_valid_email_address {
1594     my ($self) = @_;
1595
1596     my $email = q{};
1597
1598     my @fields = split /\s*\|\s*/,
1599       C4::Context->preference('EmailFieldPrecedence');
1600     for my $field (@fields) {
1601         $email = $self->$field;
1602         last if ($email);
1603     }
1604
1605     return $email;
1606 }
1607
1608 =head3 get_club_enrollments
1609
1610 =cut
1611
1612 sub get_club_enrollments {
1613     my ( $self ) = @_;
1614
1615     return Koha::Club::Enrollments->search( { borrowernumber => $self->borrowernumber(), date_canceled => undef } );
1616 }
1617
1618 =head3 get_enrollable_clubs
1619
1620 =cut
1621
1622 sub get_enrollable_clubs {
1623     my ( $self, $is_enrollable_from_opac ) = @_;
1624
1625     my $params;
1626     $params->{is_enrollable_from_opac} = $is_enrollable_from_opac
1627       if $is_enrollable_from_opac;
1628     $params->{is_email_required} = 0 unless $self->first_valid_email_address();
1629
1630     $params->{borrower} = $self;
1631
1632     return Koha::Clubs->get_enrollable($params);
1633 }
1634
1635 =head3 account_locked
1636
1637 my $is_locked = $patron->account_locked
1638
1639 Return true if the patron has reached the maximum number of login attempts
1640 (see pref FailedLoginAttempts). If login_attempts is < 0, this is interpreted
1641 as an administrative lockout (independent of FailedLoginAttempts; see also
1642 Koha::Patron->lock).
1643 Otherwise return false.
1644 If the pref is not set (empty string, null or 0), the feature is considered as
1645 disabled.
1646
1647 =cut
1648
1649 sub account_locked {
1650     my ($self) = @_;
1651     my $FailedLoginAttempts = C4::Context->preference('FailedLoginAttempts');
1652     return 1 if $FailedLoginAttempts
1653           and $self->login_attempts
1654           and $self->login_attempts >= $FailedLoginAttempts;
1655     return 1 if ($self->login_attempts || 0) < 0; # administrative lockout
1656     return 0;
1657 }
1658
1659 =head3 can_see_patron_infos
1660
1661 my $can_see = $patron->can_see_patron_infos( $patron );
1662
1663 Return true if the patron (usually the logged in user) can see the patron's infos for a given patron
1664
1665 =cut
1666
1667 sub can_see_patron_infos {
1668     my ( $self, $patron ) = @_;
1669     return unless $patron;
1670     return $self->can_see_patrons_from( $patron->branchcode );
1671 }
1672
1673 =head3 can_see_patrons_from
1674
1675 my $can_see = $patron->can_see_patrons_from( $branchcode );
1676
1677 Return true if the patron (usually the logged in user) can see the patron's infos from a given library
1678
1679 =cut
1680
1681 sub can_see_patrons_from {
1682     my ( $self, $branchcode ) = @_;
1683
1684     return $self->can_see_things_from(
1685         {
1686             branchcode => $branchcode,
1687             permission => 'borrowers',
1688             subpermission => 'view_borrower_infos_from_any_libraries',
1689         }
1690     );
1691 }
1692
1693 =head3 can_edit_items_from
1694
1695     my $can_edit = $patron->can_edit_items_from( $branchcode );
1696
1697 Return true if the I<Koha::Patron> can edit items from the given branchcode
1698
1699 =cut
1700
1701 sub can_edit_items_from {
1702     my ( $self, $branchcode ) = @_;
1703
1704     return 1 if C4::Context->IsSuperLibrarian();
1705
1706     my $userenv = C4::Context->userenv();
1707     if ( $userenv && C4::Context->preference('IndependentBranches') ) {
1708         return $userenv->{branch} eq $branchcode;
1709     }
1710
1711     return $self->can_see_things_from(
1712         {
1713             branchcode    => $branchcode,
1714             permission    => 'editcatalogue',
1715             subpermission => 'edit_any_item',
1716         }
1717     );
1718 }
1719
1720 =head3 libraries_where_can_edit_items
1721
1722     my $libraries = $patron->libraries_where_can_edit_items;
1723
1724 Return the list of branchcodes(!) of libraries the patron is allowed to items for.
1725 The branchcodes are arbitrarily returned sorted.
1726 We are supposing here that the object is related to the logged in patron (use of C4::Context::only_my_library)
1727
1728 An empty array means no restriction, the user can edit any item.
1729
1730 =cut
1731
1732 sub libraries_where_can_edit_items {
1733     my ($self) = @_;
1734
1735     return $self->libraries_where_can_see_things(
1736         {
1737             permission    => 'editcatalogue',
1738             subpermission => 'edit_any_item',
1739             group_feature => 'ft_limit_item_editing',
1740         }
1741     );
1742 }
1743
1744 =head3 libraries_where_can_see_patrons
1745
1746 my $libraries = $patron->libraries_where_can_see_patrons;
1747
1748 Return the list of branchcodes(!) of libraries the patron is allowed to see other patron's infos.
1749 The branchcodes are arbitrarily returned sorted.
1750 We are supposing here that the object is related to the logged in patron (use of C4::Context::only_my_library)
1751
1752 An empty array means no restriction, the patron can see patron's infos from any libraries.
1753
1754 =cut
1755
1756 sub libraries_where_can_see_patrons {
1757     my ($self) = @_;
1758
1759     return $self->libraries_where_can_see_things(
1760         {
1761             permission    => 'borrowers',
1762             subpermission => 'view_borrower_infos_from_any_libraries',
1763             group_feature => 'ft_hide_patron_info',
1764         }
1765     );
1766 }
1767
1768 =head3 can_see_things_from
1769
1770 my $can_see = $patron->can_see_things_from( $branchcode );
1771
1772 Return true if the I<Koha::Patron> can perform some action on the given thing
1773
1774 =cut
1775
1776 sub can_see_things_from {
1777     my ( $self, $params ) = @_;
1778
1779     my $branchcode    = $params->{branchcode};
1780     my $permission    = $params->{permission};
1781     my $subpermission = $params->{subpermission};
1782
1783     return 1 if C4::Context->IsSuperLibrarian();
1784
1785     my $can = 0;
1786     if ( $self->branchcode eq $branchcode ) {
1787         $can = 1;
1788     } elsif ( $self->has_permission( { $permission => $subpermission } ) ) {
1789         $can = 1;
1790     } elsif ( my $library_groups = $self->library->library_groups ) {
1791         while ( my $library_group = $library_groups->next ) {
1792             if ( $library_group->parent->has_child( $branchcode ) ) {
1793                 $can = 1;
1794                 last;
1795             }
1796         }
1797     }
1798     return $can;
1799 }
1800
1801 =head3 can_log_into
1802
1803 my $can_log_into = $patron->can_log_into( $library );
1804
1805 Given a I<Koha::Library> object, it returns a boolean representing
1806 the fact the patron can log into a the library.
1807
1808 =cut
1809
1810 sub can_log_into {
1811     my ( $self, $library ) = @_;
1812
1813     my $can = 0;
1814
1815     if ( C4::Context->preference('IndependentBranches') ) {
1816         $can = 1
1817           if $self->is_superlibrarian
1818           or $self->branchcode eq $library->id;
1819     }
1820     else {
1821         # no restrictions
1822         $can = 1;
1823     }
1824
1825    return $can;
1826 }
1827
1828 =head3 libraries_where_can_see_things
1829
1830     my $libraries = $patron->libraries_where_can_see_things;
1831
1832 Returns a list of libraries where an aribitarary action is allowed to be taken by the logged in librarian
1833 against an object based on some branchcode related to the object ( patron branchcode, item homebranch, etc ).
1834
1835 We are supposing here that the object is related to the logged in librarian (use of C4::Context::only_my_library)
1836
1837 An empty array means no restriction, the thing can see thing's infos from any libraries.
1838
1839 =cut
1840
1841 sub libraries_where_can_see_things {
1842     my ( $self, $params ) = @_;
1843     my $permission    = $params->{permission};
1844     my $subpermission = $params->{subpermission};
1845     my $group_feature = $params->{group_feature};
1846
1847     my $userenv = C4::Context->userenv;
1848
1849     return () unless $userenv; # For tests, but userenv should be defined in tests...
1850
1851     my @restricted_branchcodes;
1852     if (C4::Context::only_my_library) {
1853         push @restricted_branchcodes, $self->branchcode;
1854     }
1855     else {
1856         unless (
1857             $self->has_permission(
1858                 { $permission => $subpermission }
1859             )
1860           )
1861         {
1862             my $library_groups = $self->library->library_groups({ $group_feature => 1 });
1863             if ( $library_groups->count )
1864             {
1865                 while ( my $library_group = $library_groups->next ) {
1866                     my $parent = $library_group->parent;
1867                     if ( $parent->has_child( $self->branchcode ) ) {
1868                         push @restricted_branchcodes, $parent->children->get_column('branchcode');
1869                     }
1870                 }
1871             }
1872
1873             @restricted_branchcodes = ( $self->branchcode ) unless @restricted_branchcodes;
1874         }
1875     }
1876
1877     @restricted_branchcodes = grep { defined $_ } @restricted_branchcodes;
1878     @restricted_branchcodes = uniq(@restricted_branchcodes);
1879     @restricted_branchcodes = sort(@restricted_branchcodes);
1880     return @restricted_branchcodes;
1881 }
1882
1883 =head3 has_permission
1884
1885 my $permission = $patron->has_permission($required);
1886
1887 See C4::Auth::haspermission for details of syntax for $required
1888
1889 =cut
1890
1891 sub has_permission {
1892     my ( $self, $flagsrequired ) = @_;
1893     return unless $self->userid;
1894     # TODO code from haspermission needs to be moved here!
1895     return C4::Auth::haspermission( $self->userid, $flagsrequired );
1896 }
1897
1898 =head3 is_superlibrarian
1899
1900   my $is_superlibrarian = $patron->is_superlibrarian;
1901
1902 Return true if the patron is a superlibrarian.
1903
1904 =cut
1905
1906 sub is_superlibrarian {
1907     my ($self) = @_;
1908     return $self->has_permission( { superlibrarian => 1 } ) ? 1 : 0;
1909 }
1910
1911 =head3 is_adult
1912
1913 my $is_adult = $patron->is_adult
1914
1915 Return true if the patron has a category with a type Adult (A) or Organization (I)
1916
1917 =cut
1918
1919 sub is_adult {
1920     my ( $self ) = @_;
1921     return $self->category->category_type =~ /^(A|I)$/ ? 1 : 0;
1922 }
1923
1924 =head3 is_child
1925
1926 my $is_child = $patron->is_child
1927
1928 Return true if the patron has a category with a type Child (C)
1929
1930 =cut
1931
1932 sub is_child {
1933     my( $self ) = @_;
1934     return $self->category->category_type eq 'C' ? 1 : 0;
1935 }
1936
1937 =head3 has_valid_userid
1938
1939 my $patron = Koha::Patrons->find(42);
1940 $patron->userid( $new_userid );
1941 my $has_a_valid_userid = $patron->has_valid_userid
1942
1943 my $patron = Koha::Patron->new( $params );
1944 my $has_a_valid_userid = $patron->has_valid_userid
1945
1946 Return true if the current userid of this patron is valid/unique, otherwise false.
1947
1948 Note that this should be done in $self->store instead and raise an exception if needed.
1949
1950 =cut
1951
1952 sub has_valid_userid {
1953     my ($self) = @_;
1954
1955     return 0 unless $self->userid;
1956
1957     return 0 if ( $self->userid eq C4::Context->config('user') );    # DB user
1958
1959     my $already_exists = Koha::Patrons->search(
1960         {
1961             userid => $self->userid,
1962             (
1963                 $self->in_storage
1964                 ? ( borrowernumber => { '!=' => $self->borrowernumber } )
1965                 : ()
1966             ),
1967         }
1968     )->count;
1969     return $already_exists ? 0 : 1;
1970 }
1971
1972 =head3 generate_userid
1973
1974     $patron->generate_userid;
1975
1976     If you do not have a plugin for generating a userid, we will call
1977     the internal method here that returns firstname.surname[.number],
1978     where number is an optional suffix to make the userid unique.
1979     (Its behavior has not been changed on bug 32426.)
1980
1981     If you have plugin(s), the first valid response will be used.
1982     A plugin is assumed to return a valid userid as suggestion, but not
1983     assumed to save it already.
1984     Does not fallback to internal (you could arrange for that in your plugin).
1985     Clears userid when there are no valid plugin responses.
1986
1987 =cut
1988
1989 sub generate_userid {
1990     my ( $self ) = @_;
1991     my @responses = Koha::Plugins->call(
1992         'patron_generate_userid', { patron => $self },
1993     );
1994     unless( @responses ) {
1995         # Empty list only possible when there are NO enabled plugins for this method.
1996         # In that case we provide internal response.
1997         return $self->_generate_userid_internal;
1998     }
1999     # If a plugin returned false value or invalid value, we do however not return
2000     # internal response. The plugins should deal with that themselves. So we prevent
2001     # unexpected/unwelcome internal codes for plugin failures.
2002     foreach my $response ( grep { $_ } @responses ) {
2003         $self->userid( $response );
2004         return $self if $self->has_valid_userid;
2005     }
2006     $self->userid(undef);
2007     return $self;
2008 }
2009
2010 sub _generate_userid_internal { # as we always did
2011     my ($self) = @_;
2012     my $offset = 0;
2013     my $firstname = $self->firstname // q{};
2014     my $surname = $self->surname // q{};
2015     #The script will "do" the following code and increment the $offset until the generated userid is unique
2016     do {
2017       $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
2018       $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
2019       my $userid = lc(($firstname)? "$firstname.$surname" : $surname);
2020       $userid = NFKD( $userid );
2021       $userid =~ s/\p{NonspacingMark}//g;
2022       $userid .= $offset unless $offset == 0;
2023       $self->userid( $userid );
2024       $offset++;
2025      } while (! $self->has_valid_userid );
2026
2027      return $self;
2028 }
2029
2030 =head3 add_extended_attribute
2031
2032 =cut
2033
2034 sub add_extended_attribute {
2035     my ($self, $attribute) = @_;
2036
2037     return Koha::Patron::Attribute->new(
2038         {
2039             %$attribute,
2040             ( borrowernumber => $self->borrowernumber ),
2041         }
2042     )->store;
2043
2044 }
2045
2046 =head3 extended_attributes
2047
2048 Return object of Koha::Patron::Attributes type with all attributes set for this patron
2049
2050 Or setter FIXME
2051
2052 =cut
2053
2054 sub extended_attributes {
2055     my ( $self, $attributes ) = @_;
2056     if ($attributes) {    # setter
2057         my $schema = $self->_result->result_source->schema;
2058         $schema->txn_do(
2059             sub {
2060                 # Remove the existing one
2061                 $self->extended_attributes->filter_by_branch_limitations->delete;
2062
2063                 # Insert the new ones
2064                 my $new_types = {};
2065                 for my $attribute (@$attributes) {
2066                     $self->add_extended_attribute($attribute);
2067                     $new_types->{$attribute->{code}} = 1;
2068                 }
2069
2070                 # Check globally mandatory types
2071                 my @required_attribute_types =
2072                     Koha::Patron::Attribute::Types->search(
2073                         {
2074                             mandatory => 1,
2075                             category_code => [ undef, $self->categorycode ],
2076                             'borrower_attribute_types_branches.b_branchcode' =>
2077                               undef,
2078                         },
2079                         { join => 'borrower_attribute_types_branches' }
2080                     )->get_column('code');
2081                 for my $type ( @required_attribute_types ) {
2082                     Koha::Exceptions::Patron::MissingMandatoryExtendedAttribute->throw(
2083                         type => $type,
2084                     ) if !$new_types->{$type};
2085                 }
2086             }
2087         );
2088     }
2089
2090     my $rs = $self->_result->borrower_attributes;
2091     # We call search to use the filters in Koha::Patron::Attributes->search
2092     return Koha::Patron::Attributes->_new_from_dbic($rs)->search;
2093 }
2094
2095 =head3 messages
2096
2097     my $messages = $patron->messages;
2098
2099 Return the message attached to the patron.
2100
2101 =cut
2102
2103 sub messages {
2104     my ( $self ) = @_;
2105     my $messages_rs = $self->_result->messages_borrowernumbers->search;
2106     return Koha::Patron::Messages->_new_from_dbic($messages_rs);
2107 }
2108
2109 =head3 lock
2110
2111     Koha::Patrons->find($id)->lock({ expire => 1, remove => 1 });
2112
2113     Lock and optionally expire a patron account.
2114     Remove holds and article requests if remove flag set.
2115     In order to distinguish from locking by entering a wrong password, let's
2116     call this an administrative lockout.
2117
2118 =cut
2119
2120 sub lock {
2121     my ( $self, $params ) = @_;
2122     $self->login_attempts( ADMINISTRATIVE_LOCKOUT );
2123     if( $params->{expire} ) {
2124         $self->dateexpiry( dt_from_string->subtract(days => 1) );
2125     }
2126     $self->store;
2127     if( $params->{remove} ) {
2128         $self->holds->delete;
2129         $self->article_requests->delete;
2130     }
2131     return $self;
2132 }
2133
2134 =head3 anonymize
2135
2136     Koha::Patrons->find($id)->anonymize;
2137
2138     Anonymize or clear borrower fields. Fields in BorrowerMandatoryField
2139     are randomized, other personal data is cleared too.
2140     Patrons with issues are skipped.
2141
2142 =cut
2143
2144 sub anonymize {
2145     my ( $self ) = @_;
2146     if( $self->_result->issues->count ) {
2147         warn "Exiting anonymize: patron ".$self->borrowernumber." still has issues";
2148         return;
2149     }
2150     # Mandatory fields come from the corresponding pref, but email fields
2151     # are removed since scrambled email addresses only generate errors
2152     my $mandatory = { map { (lc $_, 1); } grep { !/email/ }
2153         split /\s*\|\s*/, C4::Context->preference('BorrowerMandatoryField') };
2154     $mandatory->{userid} = 1; # needed since sub store does not clear field
2155     my @columns = $self->_result->result_source->columns;
2156     @columns = grep { !/borrowernumber|branchcode|categorycode|^date|password|flags|updated_on|lastseen|lang|login_attempts|anonymized|auth_method/ } @columns;
2157     push @columns, 'dateofbirth'; # add this date back in
2158     foreach my $col (@columns) {
2159         $self->_anonymize_column($col, $mandatory->{lc $col} );
2160     }
2161     $self->anonymized(1)->store;
2162 }
2163
2164 sub _anonymize_column {
2165     my ( $self, $col, $mandatory ) = @_;
2166     my $col_info = $self->_result->result_source->column_info($col);
2167     my $type = $col_info->{data_type};
2168     my $nullable = $col_info->{is_nullable};
2169     my $val;
2170     if( $type =~ /char|text/ ) {
2171         $val = $mandatory
2172             ? Koha::Token->new->generate({ pattern => '\w{10}' })
2173             : $nullable
2174             ? undef
2175             : q{};
2176     } elsif( $type =~ /integer|int$|float|dec|double/ ) {
2177         $val = $nullable ? undef : 0;
2178     } elsif( $type =~ /date|time/ ) {
2179         $val = $nullable ? undef : dt_from_string;
2180     }
2181     $self->$col($val);
2182 }
2183
2184 =head3 add_guarantor
2185
2186     my $relationship = $patron->add_guarantor(
2187         {
2188             borrowernumber => $borrowernumber,
2189             relationships  => $relationship,
2190         }
2191     );
2192
2193     Adds a new guarantor to a patron.
2194
2195 =cut
2196
2197 sub add_guarantor {
2198     my ( $self, $params ) = @_;
2199
2200     my $guarantor_id = $params->{guarantor_id};
2201     my $relationship = $params->{relationship};
2202
2203     return Koha::Patron::Relationship->new(
2204         {
2205             guarantee_id => $self->id,
2206             guarantor_id => $guarantor_id,
2207             relationship => $relationship
2208         }
2209     )->store();
2210 }
2211
2212 =head3 get_extended_attribute
2213
2214 my $attribute_value = $patron->get_extended_attribute( $code );
2215
2216 Return the attribute for the code passed in parameter.
2217
2218 It not exist it returns undef
2219
2220 Note that this will not work for repeatable attribute types.
2221
2222 Maybe you certainly not want to use this method, it is actually only used for SHOW_BARCODE
2223 (which should be a real patron's attribute (not extended)
2224
2225 =cut
2226
2227 sub get_extended_attribute {
2228     my ( $self, $code, $value ) = @_;
2229     my $rs = $self->_result->borrower_attributes;
2230     return unless $rs;
2231     my $attribute = $rs->search({ code => $code, ( $value ? ( attribute => $value ) : () ) });
2232     return unless $attribute->count;
2233     return $attribute->next;
2234 }
2235
2236 =head3 set_default_messaging_preferences
2237
2238     $patron->set_default_messaging_preferences
2239
2240 Sets default messaging preferences on patron.
2241
2242 See Koha::Patron::MessagePreference(s) for more documentation, especially on
2243 thrown exceptions.
2244
2245 =cut
2246
2247 sub set_default_messaging_preferences {
2248     my ($self, $categorycode) = @_;
2249
2250     my $options = Koha::Patron::MessagePreferences->get_options;
2251
2252     foreach my $option (@$options) {
2253         # Check that this option has preference configuration for this category
2254         unless (Koha::Patron::MessagePreferences->search({
2255             message_attribute_id => $option->{message_attribute_id},
2256             categorycode         => $categorycode || $self->categorycode,
2257         })->count) {
2258             next;
2259         }
2260
2261         # Delete current setting
2262         Koha::Patron::MessagePreferences->search({
2263              borrowernumber => $self->borrowernumber,
2264              message_attribute_id => $option->{message_attribute_id},
2265         })->delete;
2266
2267         Koha::Patron::MessagePreference->new_from_default({
2268             borrowernumber => $self->borrowernumber,
2269             categorycode   => $categorycode || $self->categorycode,
2270             message_attribute_id => $option->{message_attribute_id},
2271         });
2272     }
2273
2274     return $self;
2275 }
2276
2277 =head3 is_accessible
2278
2279     if ( $patron->is_accessible({ user => $logged_in_user }) ) { ... }
2280
2281 This overloaded method validates wether the current I<Koha::Patron> object can be accessed
2282 by the logged in user.
2283
2284 Returns 0 if the I<user> parameter is missing.
2285
2286 =cut
2287
2288 sub is_accessible {
2289     my ( $self, $params ) = @_;
2290
2291     # FIXME? It felt tempting to return 0 instead
2292     # but it would mean needing to explicitly add the 'user'
2293     # param in all tests...
2294     return 1
2295       unless $params->{user};
2296
2297     my $consumer = $params->{user};
2298     return $consumer->can_see_patron_infos($self);
2299 }
2300
2301 =head3 to_api
2302
2303     my $json = $patron->to_api;
2304
2305 Overloaded method that returns a JSON representation of the Koha::Patron object,
2306 suitable for API output.
2307
2308 =cut
2309
2310 sub to_api {
2311     my ( $self, $params ) = @_;
2312
2313     my $json_patron = $self->SUPER::to_api( $params );
2314
2315     return unless $json_patron;
2316
2317     $json_patron->{restricted} = ( $self->is_debarred )
2318                                     ? Mojo::JSON->true
2319                                     : Mojo::JSON->false;
2320
2321     return $json_patron;
2322 }
2323
2324 =head3 to_api_mapping
2325
2326 This method returns the mapping for representing a Koha::Patron object
2327 on the API.
2328
2329 =cut
2330
2331 sub to_api_mapping {
2332     return {
2333         borrowernotes       => 'staff_notes',
2334         borrowernumber      => 'patron_id',
2335         branchcode          => 'library_id',
2336         categorycode        => 'category_id',
2337         checkprevcheckout   => 'check_previous_checkout',
2338         contactfirstname    => undef,                     # Unused
2339         contactname         => undef,                     # Unused
2340         contactnote         => 'altaddress_notes',
2341         contacttitle        => undef,                     # Unused
2342         dateenrolled        => 'date_enrolled',
2343         dateexpiry          => 'expiry_date',
2344         dateofbirth         => 'date_of_birth',
2345         debarred            => undef,                     # replaced by 'restricted'
2346         debarredcomment     => undef,    # calculated, API consumers will use /restrictions instead
2347         emailpro            => 'secondary_email',
2348         flags               => undef,    # permissions manipulation handled in /permissions
2349         gonenoaddress       => 'incorrect_address',
2350         lastseen            => 'last_seen',
2351         lost                => 'patron_card_lost',
2352         opacnote            => 'opac_notes',
2353         othernames          => 'other_name',
2354         password            => undef,            # password manipulation handled in /password
2355         phonepro            => 'secondary_phone',
2356         relationship        => 'relationship_type',
2357         sex                 => 'gender',
2358         smsalertnumber      => 'sms_number',
2359         sort1               => 'statistics_1',
2360         sort2               => 'statistics_2',
2361         autorenew_checkouts => 'autorenew_checkouts',
2362         streetnumber        => 'street_number',
2363         streettype          => 'street_type',
2364         zipcode             => 'postal_code',
2365         B_address           => 'altaddress_address',
2366         B_address2          => 'altaddress_address2',
2367         B_city              => 'altaddress_city',
2368         B_country           => 'altaddress_country',
2369         B_email             => 'altaddress_email',
2370         B_phone             => 'altaddress_phone',
2371         B_state             => 'altaddress_state',
2372         B_streetnumber      => 'altaddress_street_number',
2373         B_streettype        => 'altaddress_street_type',
2374         B_zipcode           => 'altaddress_postal_code',
2375         altcontactaddress1  => 'altcontact_address',
2376         altcontactaddress2  => 'altcontact_address2',
2377         altcontactaddress3  => 'altcontact_city',
2378         altcontactcountry   => 'altcontact_country',
2379         altcontactfirstname => 'altcontact_firstname',
2380         altcontactphone     => 'altcontact_phone',
2381         altcontactsurname   => 'altcontact_surname',
2382         altcontactstate     => 'altcontact_state',
2383         altcontactzipcode   => 'altcontact_postal_code',
2384         password_expiration_date => undef,
2385         primary_contact_method => undef,
2386         secret              => undef,
2387         auth_method         => undef,
2388     };
2389 }
2390
2391 =head3 queue_notice
2392
2393     Koha::Patrons->queue_notice({ letter_params => $letter_params, message_name => 'DUE'});
2394     Koha::Patrons->queue_notice({ letter_params => $letter_params, message_transports => \@message_transports });
2395     Koha::Patrons->queue_notice({ letter_params => $letter_params, message_transports => \@message_transports, test_mode => 1 });
2396
2397     Queue messages to a patron. Can pass a message that is part of the message_attributes
2398     table or supply the transport to use.
2399
2400     If passed a message name we retrieve the patrons preferences for transports
2401     Otherwise we use the supplied transport. In the case of email or sms we fall back to print if
2402     we have no address/number for sending
2403
2404     $letter_params is a hashref of the values to be passed to GetPreparedLetter
2405
2406     test_mode will only report which notices would be sent, but nothing will be queued
2407
2408 =cut
2409
2410 sub queue_notice {
2411     my ( $self, $params ) = @_;
2412     my $letter_params = $params->{letter_params};
2413     my $test_mode = $params->{test_mode};
2414
2415     return unless $letter_params;
2416     return unless exists $params->{message_name} xor $params->{message_transports}; # We only want one of these
2417
2418     my $library = Koha::Libraries->find( $letter_params->{branchcode} );
2419     my $from_email_address = $library->from_email_address;
2420
2421     my @message_transports;
2422     my $letter_code;
2423     $letter_code = $letter_params->{letter_code};
2424     if( $params->{message_name} ){
2425         my $messaging_prefs = C4::Members::Messaging::GetMessagingPreferences( {
2426                 borrowernumber => $letter_params->{borrowernumber},
2427                 message_name => $params->{message_name}
2428         } );
2429         @message_transports = ( keys %{ $messaging_prefs->{transports} } );
2430         $letter_code = $messaging_prefs->{transports}->{$message_transports[0]} unless $letter_code;
2431     } else {
2432         @message_transports = @{$params->{message_transports}};
2433     }
2434     return unless defined $letter_code;
2435     $letter_params->{letter_code} = $letter_code;
2436     my $print_sent = 0;
2437     my %return;
2438     foreach my $mtt (@message_transports){
2439         next if ($mtt eq 'itiva' and C4::Context->preference('TalkingTechItivaPhoneNotification') );
2440         # Notice is handled by TalkingTech_itiva_outbound.pl
2441         if (   ( $mtt eq 'email' and not $self->notice_email_address )
2442             or ( $mtt eq 'sms'   and not $self->smsalertnumber )
2443             or ( $mtt eq 'phone' and not $self->phone ) )
2444         {
2445             push @{ $return{fallback} }, $mtt;
2446             $mtt = 'print';
2447         }
2448         next if $mtt eq 'print' && $print_sent;
2449         $letter_params->{message_transport_type} = $mtt;
2450         my $letter = C4::Letters::GetPreparedLetter( %$letter_params );
2451         C4::Letters::EnqueueLetter({
2452             letter => $letter,
2453             borrowernumber => $self->borrowernumber,
2454             from_address   => $from_email_address,
2455             message_transport_type => $mtt
2456         }) unless $test_mode;
2457         push @{$return{sent}}, $mtt;
2458         $print_sent = 1 if $mtt eq 'print';
2459     }
2460     return \%return;
2461 }
2462
2463 =head3 safe_to_delete
2464
2465     my $result = $patron->safe_to_delete;
2466     if ( $result eq 'has_guarantees' ) { ... }
2467     elsif ( $result ) { ... }
2468     else { # cannot delete }
2469
2470 This method tells if the Koha:Patron object can be deleted. Possible return values
2471
2472 =over 4
2473
2474 =item 'ok'
2475
2476 =item 'has_checkouts'
2477
2478 =item 'has_debt'
2479
2480 =item 'has_guarantees'
2481
2482 =item 'is_anonymous_patron'
2483
2484 =back
2485
2486 =cut
2487
2488 sub safe_to_delete {
2489     my ($self) = @_;
2490
2491     my $anonymous_patron = C4::Context->preference('AnonymousPatron');
2492
2493     my $error;
2494
2495     if ( $anonymous_patron && $self->id eq $anonymous_patron ) {
2496         $error = 'is_anonymous_patron';
2497     }
2498     elsif ( $self->checkouts->count ) {
2499         $error = 'has_checkouts';
2500     }
2501     elsif ( $self->account->outstanding_debits->total_outstanding > 0 ) {
2502         $error = 'has_debt';
2503     }
2504     elsif ( $self->guarantee_relationships->count ) {
2505         $error = 'has_guarantees';
2506     }
2507
2508     if ( $error ) {
2509         return Koha::Result::Boolean->new(0)->add_message({ message => $error });
2510     }
2511
2512     return Koha::Result::Boolean->new(1);
2513 }
2514
2515 =head3 recalls
2516
2517     my $recalls = $patron->recalls;
2518
2519 Return the patron's recalls.
2520
2521 =cut
2522
2523 sub recalls {
2524     my ( $self ) = @_;
2525
2526     return Koha::Recalls->search({ patron_id => $self->borrowernumber });
2527 }
2528
2529 =head3 account_balance
2530
2531     my $balance = $patron->account_balance
2532
2533 Return the patron's account balance
2534
2535 =cut
2536
2537 sub account_balance {
2538     my ($self) = @_;
2539     return $self->account->balance;
2540 }
2541
2542 =head3 notify_library_of_registration
2543
2544 $patron->notify_library_of_registration( $email_patron_registrations );
2545
2546 Send patron registration email to library if EmailPatronRegistrations system preference is enabled.
2547
2548 =cut
2549
2550 sub notify_library_of_registration {
2551     my ( $self, $email_patron_registrations ) = @_;
2552
2553     if (
2554         my $letter = C4::Letters::GetPreparedLetter(
2555             module      => 'members',
2556             letter_code => 'OPAC_REG',
2557             branchcode  => $self->branchcode,
2558             lang        => $self->lang || 'default',
2559             tables      => {
2560                 'borrowers' => $self->borrowernumber
2561             },
2562         )
2563     ) {
2564         my $to_address;
2565         if ( $email_patron_registrations eq "BranchEmailAddress" ) {
2566             my $library = Koha::Libraries->find( $self->branchcode );
2567             $to_address = $library->inbound_email_address;
2568         }
2569         elsif ( $email_patron_registrations eq "KohaAdminEmailAddress" ) {
2570             $to_address = C4::Context->preference('ReplytoDefault')
2571             || C4::Context->preference('KohaAdminEmailAddress');
2572         }
2573         else {
2574             $to_address =
2575                 C4::Context->preference('EmailAddressForPatronRegistrations')
2576                 || C4::Context->preference('ReplytoDefault')
2577                 || C4::Context->preference('KohaAdminEmailAddress');
2578         }
2579
2580         my $message_id = C4::Letters::EnqueueLetter(
2581             {
2582                 letter                 => $letter,
2583                 borrowernumber         => $self->borrowernumber,
2584                 to_address             => $to_address,
2585                 message_transport_type => 'email'
2586             }
2587         ) or warn "can't enqueue letter $letter";
2588         if ( $message_id ) {
2589             return 1;
2590         }
2591     }
2592 }
2593
2594 =head3 has_messaging_preference
2595
2596 my $bool = $patron->has_messaging_preference({
2597     message_name => $message_name, # A value from message_attributes.message_name
2598     message_transport_type => $message_transport_type, # email, sms, phone, itiva, etc...
2599     wants_digest => $wants_digest, # 1 if you are looking for the digest version, don't pass if you just want either
2600 });
2601
2602 =cut
2603
2604 sub has_messaging_preference {
2605     my ( $self, $params ) = @_;
2606
2607     my $message_name           = $params->{message_name};
2608     my $message_transport_type = $params->{message_transport_type};
2609     my $wants_digest           = $params->{wants_digest};
2610
2611     return $self->_result->search_related_rs(
2612         'borrower_message_preferences',
2613         $params,
2614         {
2615             prefetch =>
2616               [ 'borrower_message_transport_preferences', 'message_attribute' ]
2617         }
2618     )->count;
2619 }
2620
2621 =head3 can_patron_change_staff_only_lists
2622
2623 $patron->can_patron_change_staff_only_lists;
2624
2625 Return 1 if a patron has 'Superlibrarian' or 'Catalogue' permission.
2626 Otherwise, return 0.
2627
2628 =cut
2629
2630 sub can_patron_change_staff_only_lists {
2631     my ( $self, $params ) = @_;
2632     return 1 if C4::Auth::haspermission( $self->userid, { 'catalogue' => 1 });
2633     return 0;
2634 }
2635
2636 =head3 can_patron_change_permitted_staff_lists
2637
2638 $patron->can_patron_change_permitted_staff_lists;
2639
2640 Return 1 if a patron has 'Superlibrarian' or 'Catalogue' and 'edit_public_list_contents' permissions.
2641 Otherwise, return 0.
2642
2643 =cut
2644
2645 sub can_patron_change_permitted_staff_lists {
2646     my ( $self, $params ) = @_;
2647     return 1 if C4::Auth::haspermission( $self->userid, { 'catalogue' => 1, lists => 'edit_public_list_contents' } );
2648     return 0;
2649 }
2650
2651 =head3 encode_secret
2652
2653   $patron->encode_secret($secret32);
2654
2655 Secret (TwoFactorAuth expects it in base32 format) is encrypted.
2656 You still need to call ->store.
2657
2658 =cut
2659
2660 sub encode_secret {
2661     my ( $self, $secret ) = @_;
2662     if( $secret ) {
2663         return $self->secret( Koha::Encryption->new->encrypt_hex($secret) );
2664     }
2665     return $self->secret($secret);
2666 }
2667
2668 =head3 decoded_secret
2669
2670   my $secret32 = $patron->decoded_secret;
2671
2672 Decode the patron secret. We expect to get back a base32 string, but this
2673 is not checked here. Caller of encode_secret is responsible for that.
2674
2675 =cut
2676
2677 sub decoded_secret {
2678     my ( $self ) = @_;
2679     if( $self->secret ) {
2680         return Koha::Encryption->new->decrypt_hex( $self->secret );
2681     }
2682     return $self->secret;
2683 }
2684
2685 =head3 virtualshelves
2686
2687     my $shelves = $patron->virtualshelves;
2688
2689 =cut
2690
2691 sub virtualshelves {
2692     my $self = shift;
2693     return Koha::Virtualshelves->_new_from_dbic( scalar $self->_result->virtualshelves );
2694 }
2695
2696 =head3 get_savings
2697
2698     my $savings = $patron->get_savings;
2699
2700 Use the replacement price of patron's old and current issues to calculate how much they have 'saved' by using the library.
2701
2702 =cut
2703
2704 sub get_savings {
2705     my ($self) = @_;
2706
2707     my @itemnumbers = grep { defined $_ } ( $self->old_checkouts->get_column('itemnumber'), $self->checkouts->get_column('itemnumber') );
2708
2709     return Koha::Items->search(
2710         { itemnumber => { -in => \@itemnumbers } },
2711         {   select => [ { sum => 'me.replacementprice' } ],
2712             as     => ['total_savings']
2713         }
2714     )->next->get_column('total_savings') // 0;
2715 }
2716
2717 =head3 alert_subscriptions
2718
2719     my $subscriptions = $patron->alert_subscriptions;
2720
2721 Return a Koha::Subscriptions object containing subscriptions for which the patron has subscribed to email alerts.
2722
2723 =cut
2724
2725 sub alert_subscriptions {
2726     my ($self) = @_;
2727
2728     my @alerts           = $self->_result->alerts;
2729     my @subscription_ids = map { $_->externalid } @alerts;
2730
2731     return Koha::Subscriptions->search( { subscriptionid => \@subscription_ids } );
2732 }
2733
2734 =head3 consent
2735
2736     my $consent = $patron->consent(TYPE);
2737
2738     Returns the first consent of type TYPE (there should be only one) or a new instance
2739     of Koha::Patron::Consent.
2740
2741 =cut
2742
2743 sub consent {
2744     my ( $self, $type ) = @_;
2745     Koha::Exceptions::MissingParameter->throw('Missing consent type') if !$type;
2746     my $consents = Koha::Patron::Consents->search(
2747         {
2748             borrowernumber => $self->borrowernumber,
2749             type           => $type,
2750         }
2751     );
2752     return $consents && $consents->count
2753         ? $consents->next
2754         : Koha::Patron::Consent->new( { borrowernumber => $self->borrowernumber, type => $type } );
2755 }
2756
2757 =head2 Internal methods
2758
2759 =head3 _type
2760
2761 =cut
2762
2763 sub _type {
2764     return 'Borrower';
2765 }
2766
2767 =head1 AUTHORS
2768
2769 Kyle M Hall <kyle@bywatersolutions.com>
2770 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
2771 Martin Renvoize <martin.renvoize@ptfs-europe.com>
2772
2773 =cut
2774
2775 1;