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