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