Koha/Patron.pm

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