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