Koha/Patron.pm

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