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