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