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                 # Call any check_password plugins if password is passed
 228                 if (   C4::Context->preference('UseKohaPlugins')
 229                     && C4::Context->config("enable_plugins")
 230                     && $self->password )
 231                 {
 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->password,
 242                                 borrowernumber => $self->borrowernumber
 243                             }
 244                         );
 245                         if ( $ret->{'error'} == 1 ) {
 246                             Koha::Exceptions::Password::Plugin->throw();
 247                         }
 248                     }
 249                 }
 250
 251                 # Make a copy of the plain text password for later use
 252                 $self->plain_text_password( $self->password );
 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 = $plugin->check_password(
 758                 {
 759                     password       => $password,
 760                     borrowernumber => $self->borrowernumber
 761                 }
 762             );
 763             # This plugin hook will also be used by a plugin for the Norwegian national
 764             # patron database. This is why we need to call the actual plugins and then
 765             # check skip_validation afterwards.
 766             if ( $ret->{'error'} == 1 && !$args->{skip_validation} ) {
 767                 Koha::Exceptions::Password::Plugin->throw();
 768             }
 769         }
 770     }
 771
 772     my $digest = Koha::AuthUtils::hash_password($password);
 773     $self->update(
 774         {   password       => $digest,
 775             login_attempts => 0,
 776         }
 777     );
 778
 779     logaction( "MEMBERS", "CHANGE PASS", $self->borrowernumber, "" )
 780         if C4::Context->preference("BorrowersLog");
 781
 782     return $self;
 783 }
 784
 785
 786 =head3 renew_account
 787
 788 my $new_expiry_date = $patron->renew_account
 789
 790 Extending the subscription to the expiry date.
 791
 792 =cut
 793
 794 sub renew_account {
 795     my ($self) = @_;
 796     my $date;
 797     if ( C4::Context->preference('BorrowerRenewalPeriodBase') eq 'combination' ) {
 798         $date = ( dt_from_string gt dt_from_string( $self->dateexpiry ) ) ? dt_from_string : dt_from_string( $self->dateexpiry );
 799     } else {
 800         $date =
 801             C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry'
 802             ? dt_from_string( $self->dateexpiry )
 803             : dt_from_string;
 804     }
 805     my $expiry_date = $self->category->get_expiry_date($date);
 806
 807     $self->dateexpiry($expiry_date);
 808     $self->date_renewed( dt_from_string() );
 809     $self->store();
 810
 811     $self->add_enrolment_fee_if_needed(1);
 812
 813     logaction( "MEMBERS", "RENEW", $self->borrowernumber, "Membership renewed" ) if C4::Context->preference("BorrowersLog");
 814     return dt_from_string( $expiry_date )->truncate( to => 'day' );
 815 }
 816
 817 =head3 has_overdues
 818
 819 my $has_overdues = $patron->has_overdues;
 820
 821 Returns the number of patron's overdues
 822
 823 =cut
 824
 825 sub has_overdues {
 826     my ($self) = @_;
 827     my $dtf = Koha::Database->new->schema->storage->datetime_parser;
 828     return $self->_result->issues->search({ date_due => { '<' => $dtf->format_datetime( dt_from_string() ) } })->count;
 829 }
 830
 831 =head3 track_login
 832
 833     $patron->track_login;
 834     $patron->track_login({ force => 1 });
 835
 836     Tracks a (successful) login attempt.
 837     The preference TrackLastPatronActivity must be enabled. Or you
 838     should pass the force parameter.
 839
 840 =cut
 841
 842 sub track_login {
 843     my ( $self, $params ) = @_;
 844     return if
 845         !$params->{force} &&
 846         !C4::Context->preference('TrackLastPatronActivity');
 847     $self->lastseen( dt_from_string() )->store;
 848 }
 849
 850 =head3 move_to_deleted
 851
 852 my $is_moved = $patron->move_to_deleted;
 853
 854 Move a patron to the deletedborrowers table.
 855 This can be done before deleting a patron, to make sure the data are not completely deleted.
 856
 857 =cut
 858
 859 sub move_to_deleted {
 860     my ($self) = @_;
 861     my $patron_infos = $self->unblessed;
 862     delete $patron_infos->{updated_on}; #This ensures the updated_on date in deletedborrowers will be set to the current timestamp
 863     return Koha::Database->new->schema->resultset('Deletedborrower')->create($patron_infos);
 864 }
 865
 866 =head3 article_requests
 867
 868 my @requests = $borrower->article_requests();
 869 my $requests = $borrower->article_requests();
 870
 871 Returns either a list of ArticleRequests objects,
 872 or an ArtitleRequests object, depending on the
 873 calling context.
 874
 875 =cut
 876
 877 sub article_requests {
 878     my ( $self ) = @_;
 879
 880     $self->{_article_requests} ||= Koha::ArticleRequests->search({ borrowernumber => $self->borrowernumber() });
 881
 882     return $self->{_article_requests};
 883 }
 884
 885 =head3 article_requests_current
 886
 887 my @requests = $patron->article_requests_current
 888
 889 Returns the article requests associated with this patron that are incomplete
 890
 891 =cut
 892
 893 sub article_requests_current {
 894     my ( $self ) = @_;
 895
 896     $self->{_article_requests_current} ||= Koha::ArticleRequests->search(
 897         {
 898             borrowernumber => $self->id(),
 899             -or          => [
 900                 { status => Koha::ArticleRequest::Status::Pending },
 901                 { status => Koha::ArticleRequest::Status::Processing }
 902             ]
 903         }
 904     );
 905
 906     return $self->{_article_requests_current};
 907 }
 908
 909 =head3 article_requests_finished
 910
 911 my @requests = $biblio->article_requests_finished
 912
 913 Returns the article requests associated with this patron that are completed
 914
 915 =cut
 916
 917 sub article_requests_finished {
 918     my ( $self, $borrower ) = @_;
 919
 920     $self->{_article_requests_finished} ||= Koha::ArticleRequests->search(
 921         {
 922             borrowernumber => $self->id(),
 923             -or          => [
 924                 { status => Koha::ArticleRequest::Status::Completed },
 925                 { status => Koha::ArticleRequest::Status::Canceled }
 926             ]
 927         }
 928     );
 929
 930     return $self->{_article_requests_finished};
 931 }
 932
 933 =head3 add_enrolment_fee_if_needed
 934
 935 my $enrolment_fee = $patron->add_enrolment_fee_if_needed($renewal);
 936
 937 Add enrolment fee for a patron if needed.
 938
 939 $renewal - boolean denoting whether this is an account renewal or not
 940
 941 =cut
 942
 943 sub add_enrolment_fee_if_needed {
 944     my ($self, $renewal) = @_;
 945     my $enrolment_fee = $self->category->enrolmentfee;
 946     if ( $enrolment_fee && $enrolment_fee > 0 ) {
 947         my $type = $renewal ? 'ACCOUNT_RENEW' : 'ACCOUNT';
 948         $self->account->add_debit(
 949             {
 950                 amount     => $enrolment_fee,
 951                 user_id    => C4::Context->userenv ? C4::Context->userenv->{'number'} : undef,
 952                 interface  => C4::Context->interface,
 953                 library_id => C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef,
 954                 type       => $type
 955             }
 956         );
 957     }
 958     return $enrolment_fee || 0;
 959 }
 960
 961 =head3 checkouts
 962
 963 my $checkouts = $patron->checkouts
 964
 965 =cut
 966
 967 sub checkouts {
 968     my ($self) = @_;
 969     my $checkouts = $self->_result->issues;
 970     return Koha::Checkouts->_new_from_dbic( $checkouts );
 971 }
 972
 973 =head3 pending_checkouts
 974
 975 my $pending_checkouts = $patron->pending_checkouts
 976
 977 This method will return the same as $self->checkouts, but with a prefetch on
 978 items, biblio and biblioitems.
 979
 980 It has been introduced to replaced the C4::Members::GetPendingIssues subroutine
 981
 982 It should not be used directly, prefer to access fields you need instead of
 983 retrieving all these fields in one go.
 984
 985 =cut
 986
 987 sub pending_checkouts {
 988     my( $self ) = @_;
 989     my $checkouts = $self->_result->issues->search(
 990         {},
 991         {
 992             order_by => [
 993                 { -desc => 'me.timestamp' },
 994                 { -desc => 'issuedate' },
 995                 { -desc => 'issue_id' }, # Sort by issue_id should be enough
 996             ],
 997             prefetch => { item => { biblio => 'biblioitems' } },
 998         }
 999     );
1000     return Koha::Checkouts->_new_from_dbic( $checkouts );
1001 }
1002
1003 =head3 old_checkouts
1004
1005 my $old_checkouts = $patron->old_checkouts
1006
1007 =cut
1008
1009 sub old_checkouts {
1010     my ($self) = @_;
1011     my $old_checkouts = $self->_result->old_issues;
1012     return Koha::Old::Checkouts->_new_from_dbic( $old_checkouts );
1013 }
1014
1015 =head3 get_overdues
1016
1017 my $overdue_items = $patron->get_overdues
1018
1019 Return the overdue items
1020
1021 =cut
1022
1023 sub get_overdues {
1024     my ($self) = @_;
1025     my $dtf = Koha::Database->new->schema->storage->datetime_parser;
1026     return $self->checkouts->search(
1027         {
1028             'me.date_due' => { '<' => $dtf->format_datetime(dt_from_string) },
1029         },
1030         {
1031             prefetch => { item => { biblio => 'biblioitems' } },
1032         }
1033     );
1034 }
1035
1036 =head3 get_routing_lists
1037
1038 my @routinglists = $patron->get_routing_lists
1039
1040 Returns the routing lists a patron is subscribed to.
1041
1042 =cut
1043
1044 sub get_routing_lists {
1045     my ($self) = @_;
1046     my $routing_list_rs = $self->_result->subscriptionroutinglists;
1047     return Koha::Subscription::Routinglists->_new_from_dbic($routing_list_rs);
1048 }
1049
1050 =head3 get_age
1051
1052 my $age = $patron->get_age
1053
1054 Return the age of the patron
1055
1056 =cut
1057
1058 sub get_age {
1059     my ($self)    = @_;
1060     my $today_str = dt_from_string->strftime("%Y-%m-%d");
1061     return unless $self->dateofbirth;
1062     my $dob_str   = dt_from_string( $self->dateofbirth )->strftime("%Y-%m-%d");
1063
1064     my ( $dob_y,   $dob_m,   $dob_d )   = split /-/, $dob_str;
1065     my ( $today_y, $today_m, $today_d ) = split /-/, $today_str;
1066
1067     my $age = $today_y - $dob_y;
1068     if ( $dob_m . $dob_d > $today_m . $today_d ) {
1069         $age--;
1070     }
1071
1072     return $age;
1073 }
1074
1075 =head3 is_valid_age
1076
1077 my $is_valid = $patron->is_valid_age
1078
1079 Return 1 if patron's age is between allowed limits, returns 0 if it's not.
1080
1081 =cut
1082
1083 sub is_valid_age {
1084     my ($self) = @_;
1085     my $age = $self->get_age;
1086
1087     my $patroncategory = $self->category;
1088     my ($low,$high) = ($patroncategory->dateofbirthrequired, $patroncategory->upperagelimit);
1089
1090     return (defined($age) && (($high && ($age > $high)) or ($age < $low))) ? 0 : 1;
1091 }
1092
1093 =head3 account
1094
1095 my $account = $patron->account
1096
1097 =cut
1098
1099 sub account {
1100     my ($self) = @_;
1101     return Koha::Account->new( { patron_id => $self->borrowernumber } );
1102 }
1103
1104 =head3 holds
1105
1106 my $holds = $patron->holds
1107
1108 Return all the holds placed by this patron
1109
1110 =cut
1111
1112 sub holds {
1113     my ($self) = @_;
1114     my $holds_rs = $self->_result->reserves->search( {}, { order_by => 'reservedate' } );
1115     return Koha::Holds->_new_from_dbic($holds_rs);
1116 }
1117
1118 =head3 old_holds
1119
1120 my $old_holds = $patron->old_holds
1121
1122 Return all the historical holds for this patron
1123
1124 =cut
1125
1126 sub old_holds {
1127     my ($self) = @_;
1128     my $old_holds_rs = $self->_result->old_reserves->search( {}, { order_by => 'reservedate' } );
1129     return Koha::Old::Holds->_new_from_dbic($old_holds_rs);
1130 }
1131
1132 =head3 notice_email_address
1133
1134   my $email = $patron->notice_email_address;
1135
1136 Return the email address of patron used for notices.
1137 Returns the empty string if no email address.
1138
1139 =cut
1140
1141 sub notice_email_address{
1142     my ( $self ) = @_;
1143
1144     my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
1145     # if syspref is set to 'first valid' (value == OFF), look up email address
1146     if ( $which_address eq 'OFF' ) {
1147         return $self->first_valid_email_address;
1148     }
1149
1150     return $self->$which_address || '';
1151 }
1152
1153 =head3 first_valid_email_address
1154
1155 my $first_valid_email_address = $patron->first_valid_email_address
1156
1157 Return the first valid email address for a patron.
1158 For now, the order  is defined as email, emailpro, B_email.
1159 Returns the empty string if the borrower has no email addresses.
1160
1161 =cut
1162
1163 sub first_valid_email_address {
1164     my ($self) = @_;
1165
1166     return $self->email() || $self->emailpro() || $self->B_email() || q{};
1167 }
1168
1169 =head3 get_club_enrollments
1170
1171 =cut
1172
1173 sub get_club_enrollments {
1174     my ( $self, $return_scalar ) = @_;
1175
1176     my $e = Koha::Club::Enrollments->search( { borrowernumber => $self->borrowernumber(), date_canceled => undef } );
1177
1178     return $e if $return_scalar;
1179
1180     return wantarray ? $e->as_list : $e;
1181 }
1182
1183 =head3 get_enrollable_clubs
1184
1185 =cut
1186
1187 sub get_enrollable_clubs {
1188     my ( $self, $is_enrollable_from_opac, $return_scalar ) = @_;
1189
1190     my $params;
1191     $params->{is_enrollable_from_opac} = $is_enrollable_from_opac
1192       if $is_enrollable_from_opac;
1193     $params->{is_email_required} = 0 unless $self->first_valid_email_address();
1194
1195     $params->{borrower} = $self;
1196
1197     my $e = Koha::Clubs->get_enrollable($params);
1198
1199     return $e if $return_scalar;
1200
1201     return wantarray ? $e->as_list : $e;
1202 }
1203
1204 =head3 account_locked
1205
1206 my $is_locked = $patron->account_locked
1207
1208 Return true if the patron has reached the maximum number of login attempts
1209 (see pref FailedLoginAttempts). If login_attempts is < 0, this is interpreted
1210 as an administrative lockout (independent of FailedLoginAttempts; see also
1211 Koha::Patron->lock).
1212 Otherwise return false.
1213 If the pref is not set (empty string, null or 0), the feature is considered as
1214 disabled.
1215
1216 =cut
1217
1218 sub account_locked {
1219     my ($self) = @_;
1220     my $FailedLoginAttempts = C4::Context->preference('FailedLoginAttempts');
1221     return 1 if $FailedLoginAttempts
1222           and $self->login_attempts
1223           and $self->login_attempts >= $FailedLoginAttempts;
1224     return 1 if ($self->login_attempts || 0) < 0; # administrative lockout
1225     return 0;
1226 }
1227
1228 =head3 can_see_patron_infos
1229
1230 my $can_see = $patron->can_see_patron_infos( $patron );
1231
1232 Return true if the patron (usually the logged in user) can see the patron's infos for a given patron
1233
1234 =cut
1235
1236 sub can_see_patron_infos {
1237     my ( $self, $patron ) = @_;
1238     return unless $patron;
1239     return $self->can_see_patrons_from( $patron->library->branchcode );
1240 }
1241
1242 =head3 can_see_patrons_from
1243
1244 my $can_see = $patron->can_see_patrons_from( $branchcode );
1245
1246 Return true if the patron (usually the logged in user) can see the patron's infos from a given library
1247
1248 =cut
1249
1250 sub can_see_patrons_from {
1251     my ( $self, $branchcode ) = @_;
1252     my $can = 0;
1253     if ( $self->branchcode eq $branchcode ) {
1254         $can = 1;
1255     } elsif ( $self->has_permission( { borrowers => 'view_borrower_infos_from_any_libraries' } ) ) {
1256         $can = 1;
1257     } elsif ( my $library_groups = $self->library->library_groups ) {
1258         while ( my $library_group = $library_groups->next ) {
1259             if ( $library_group->parent->has_child( $branchcode ) ) {
1260                 $can = 1;
1261                 last;
1262             }
1263         }
1264     }
1265     return $can;
1266 }
1267
1268 =head3 libraries_where_can_see_patrons
1269
1270 my $libraries = $patron-libraries_where_can_see_patrons;
1271
1272 Return the list of branchcodes(!) of libraries the patron is allowed to see other patron's infos.
1273 The branchcodes are arbitrarily returned sorted.
1274 We are supposing here that the object is related to the logged in patron (use of C4::Context::only_my_library)
1275
1276 An empty array means no restriction, the patron can see patron's infos from any libraries.
1277
1278 =cut
1279
1280 sub libraries_where_can_see_patrons {
1281     my ( $self ) = @_;
1282     my $userenv = C4::Context->userenv;
1283
1284     return () unless $userenv; # For tests, but userenv should be defined in tests...
1285
1286     my @restricted_branchcodes;
1287     if (C4::Context::only_my_library) {
1288         push @restricted_branchcodes, $self->branchcode;
1289     }
1290     else {
1291         unless (
1292             $self->has_permission(
1293                 { borrowers => 'view_borrower_infos_from_any_libraries' }
1294             )
1295           )
1296         {
1297             my $library_groups = $self->library->library_groups({ ft_hide_patron_info => 1 });
1298             if ( $library_groups->count )
1299             {
1300                 while ( my $library_group = $library_groups->next ) {
1301                     my $parent = $library_group->parent;
1302                     if ( $parent->has_child( $self->branchcode ) ) {
1303                         push @restricted_branchcodes, $parent->children->get_column('branchcode');
1304                     }
1305                 }
1306             }
1307
1308             @restricted_branchcodes = ( $self->branchcode ) unless @restricted_branchcodes;
1309         }
1310     }
1311
1312     @restricted_branchcodes = grep { defined $_ } @restricted_branchcodes;
1313     @restricted_branchcodes = uniq(@restricted_branchcodes);
1314     @restricted_branchcodes = sort(@restricted_branchcodes);
1315     return @restricted_branchcodes;
1316 }
1317
1318 sub has_permission {
1319     my ( $self, $flagsrequired ) = @_;
1320     return unless $self->userid;
1321     # TODO code from haspermission needs to be moved here!
1322     return C4::Auth::haspermission( $self->userid, $flagsrequired );
1323 }
1324
1325 =head3 is_adult
1326
1327 my $is_adult = $patron->is_adult
1328
1329 Return true if the patron has a category with a type Adult (A) or Organization (I)
1330
1331 =cut
1332
1333 sub is_adult {
1334     my ( $self ) = @_;
1335     return $self->category->category_type =~ /^(A|I)$/ ? 1 : 0;
1336 }
1337
1338 =head3 is_child
1339
1340 my $is_child = $patron->is_child
1341
1342 Return true if the patron has a category with a type Child (C)
1343
1344 =cut
1345
1346 sub is_child {
1347     my( $self ) = @_;
1348     return $self->category->category_type eq 'C' ? 1 : 0;
1349 }
1350
1351 =head3 has_valid_userid
1352
1353 my $patron = Koha::Patrons->find(42);
1354 $patron->userid( $new_userid );
1355 my $has_a_valid_userid = $patron->has_valid_userid
1356
1357 my $patron = Koha::Patron->new( $params );
1358 my $has_a_valid_userid = $patron->has_valid_userid
1359
1360 Return true if the current userid of this patron is valid/unique, otherwise false.
1361
1362 Note that this should be done in $self->store instead and raise an exception if needed.
1363
1364 =cut
1365
1366 sub has_valid_userid {
1367     my ($self) = @_;
1368
1369     return 0 unless $self->userid;
1370
1371     return 0 if ( $self->userid eq C4::Context->config('user') );    # DB user
1372
1373     my $already_exists = Koha::Patrons->search(
1374         {
1375             userid => $self->userid,
1376             (
1377                 $self->in_storage
1378                 ? ( borrowernumber => { '!=' => $self->borrowernumber } )
1379                 : ()
1380             ),
1381         }
1382     )->count;
1383     return $already_exists ? 0 : 1;
1384 }
1385
1386 =head3 generate_userid
1387
1388 my $patron = Koha::Patron->new( $params );
1389 $patron->generate_userid
1390
1391 Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
1392
1393 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).
1394
1395 =cut
1396
1397 sub generate_userid {
1398     my ($self) = @_;
1399     my $offset = 0;
1400     my $firstname = $self->firstname // q{};
1401     my $surname = $self->surname // q{};
1402     #The script will "do" the following code and increment the $offset until the generated userid is unique
1403     do {
1404       $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1405       $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1406       my $userid = lc(($firstname)? "$firstname.$surname" : $surname);
1407       $userid = unac_string('utf-8',$userid);
1408       $userid .= $offset unless $offset == 0;
1409       $self->userid( $userid );
1410       $offset++;
1411      } while (! $self->has_valid_userid );
1412
1413      return $self;
1414
1415 }
1416
1417 =head3 attributes
1418
1419 my $attributes = $patron->attributes
1420
1421 Return object of Koha::Patron::Attributes type with all attributes set for this patron
1422
1423 =cut
1424
1425 sub attributes {
1426     my ( $self ) = @_;
1427     return Koha::Patron::Attributes->search({
1428         borrowernumber => $self->borrowernumber,
1429         branchcode     => $self->branchcode,
1430     });
1431 }
1432
1433 =head3 lock
1434
1435     Koha::Patrons->find($id)->lock({ expire => 1, remove => 1 });
1436
1437     Lock and optionally expire a patron account.
1438     Remove holds and article requests if remove flag set.
1439     In order to distinguish from locking by entering a wrong password, let's
1440     call this an administrative lockout.
1441
1442 =cut
1443
1444 sub lock {
1445     my ( $self, $params ) = @_;
1446     $self->login_attempts( ADMINISTRATIVE_LOCKOUT );
1447     if( $params->{expire} ) {
1448         $self->dateexpiry( dt_from_string->subtract(days => 1) );
1449     }
1450     $self->store;
1451     if( $params->{remove} ) {
1452         $self->holds->delete;
1453         $self->article_requests->delete;
1454     }
1455     return $self;
1456 }
1457
1458 =head3 anonymize
1459
1460     Koha::Patrons->find($id)->anonymize;
1461
1462     Anonymize or clear borrower fields. Fields in BorrowerMandatoryField
1463     are randomized, other personal data is cleared too.
1464     Patrons with issues are skipped.
1465
1466 =cut
1467
1468 sub anonymize {
1469     my ( $self ) = @_;
1470     if( $self->_result->issues->count ) {
1471         warn "Exiting anonymize: patron ".$self->borrowernumber." still has issues";
1472         return;
1473     }
1474     # Mandatory fields come from the corresponding pref, but email fields
1475     # are removed since scrambled email addresses only generate errors
1476     my $mandatory = { map { (lc $_, 1); } grep { !/email/ }
1477         split /\s*\|\s*/, C4::Context->preference('BorrowerMandatoryField') };
1478     $mandatory->{userid} = 1; # needed since sub store does not clear field
1479     my @columns = $self->_result->result_source->columns;
1480     @columns = grep { !/borrowernumber|branchcode|categorycode|^date|password|flags|updated_on|lastseen|lang|login_attempts|anonymized/ } @columns;
1481     push @columns, 'dateofbirth'; # add this date back in
1482     foreach my $col (@columns) {
1483         $self->_anonymize_column($col, $mandatory->{lc $col} );
1484     }
1485     $self->anonymized(1)->store;
1486 }
1487
1488 sub _anonymize_column {
1489     my ( $self, $col, $mandatory ) = @_;
1490     my $col_info = $self->_result->result_source->column_info($col);
1491     my $type = $col_info->{data_type};
1492     my $nullable = $col_info->{is_nullable};
1493     my $val;
1494     if( $type =~ /char|text/ ) {
1495         $val = $mandatory
1496             ? Koha::Token->new->generate({ pattern => '\w{10}' })
1497             : $nullable
1498             ? undef
1499             : q{};
1500     } elsif( $type =~ /integer|int$|float|dec|double/ ) {
1501         $val = $nullable ? undef : 0;
1502     } elsif( $type =~ /date|time/ ) {
1503         $val = $nullable ? undef : dt_from_string;
1504     }
1505     $self->$col($val);
1506 }
1507
1508 =head3 add_guarantor
1509
1510     my @relationships = $patron->add_guarantor(
1511         {
1512             borrowernumber => $borrowernumber,
1513             relationships  => $relationship,
1514         }
1515     );
1516
1517     Adds a new guarantor to a patron.
1518
1519 =cut
1520
1521 sub add_guarantor {
1522     my ( $self, $params ) = @_;
1523
1524     my $guarantor_id = $params->{guarantor_id};
1525     my $relationship = $params->{relationship};
1526
1527     return Koha::Patron::Relationship->new(
1528         {
1529             guarantee_id => $self->id,
1530             guarantor_id => $guarantor_id,
1531             relationship => $relationship
1532         }
1533     )->store();
1534 }
1535
1536 =head3 to_api
1537
1538     my $json = $patron->to_api;
1539
1540 Overloaded method that returns a JSON representation of the Koha::Patron object,
1541 suitable for API output.
1542
1543 =cut
1544
1545 sub to_api {
1546     my ( $self ) = @_;
1547
1548     my $json_patron = $self->SUPER::to_api;
1549
1550     $json_patron->{restricted} = ( $self->is_debarred )
1551                                     ? Mojo::JSON->true
1552                                     : Mojo::JSON->false;
1553
1554     return $json_patron;
1555 }
1556
1557 =head3 to_api_mapping
1558
1559 This method returns the mapping for representing a Koha::Patron object
1560 on the API.
1561
1562 =cut
1563
1564 sub to_api_mapping {
1565     return {
1566         borrowernotes       => 'staff_notes',
1567         borrowernumber      => 'patron_id',
1568         branchcode          => 'library_id',
1569         categorycode        => 'category_id',
1570         checkprevcheckout   => 'check_previous_checkout',
1571         contactfirstname    => undef,                     # Unused
1572         contactname         => undef,                     # Unused
1573         contactnote         => 'altaddress_notes',
1574         contacttitle        => undef,                     # Unused
1575         dateenrolled        => 'date_enrolled',
1576         dateexpiry          => 'expiry_date',
1577         dateofbirth         => 'date_of_birth',
1578         debarred            => undef,                     # replaced by 'restricted'
1579         debarredcomment     => undef,    # calculated, API consumers will use /restrictions instead
1580         emailpro            => 'secondary_email',
1581         flags               => undef,    # permissions manipulation handled in /permissions
1582         gonenoaddress       => 'incorrect_address',
1583         guarantorid         => 'guarantor_id',
1584         lastseen            => 'last_seen',
1585         lost                => 'patron_card_lost',
1586         opacnote            => 'opac_notes',
1587         othernames          => 'other_name',
1588         password            => undef,            # password manipulation handled in /password
1589         phonepro            => 'secondary_phone',
1590         relationship        => 'relationship_type',
1591         sex                 => 'gender',
1592         smsalertnumber      => 'sms_number',
1593         sort1               => 'statistics_1',
1594         sort2               => 'statistics_2',
1595         streetnumber        => 'street_number',
1596         streettype          => 'street_type',
1597         zipcode             => 'postal_code',
1598         B_address           => 'altaddress_address',
1599         B_address2          => 'altaddress_address2',
1600         B_city              => 'altaddress_city',
1601         B_country           => 'altaddress_country',
1602         B_email             => 'altaddress_email',
1603         B_phone             => 'altaddress_phone',
1604         B_state             => 'altaddress_state',
1605         B_streetnumber      => 'altaddress_street_number',
1606         B_streettype        => 'altaddress_street_type',
1607         B_zipcode           => 'altaddress_postal_code',
1608         altcontactaddress1  => 'altcontact_address',
1609         altcontactaddress2  => 'altcontact_address2',
1610         altcontactaddress3  => 'altcontact_city',
1611         altcontactcountry   => 'altcontact_country',
1612         altcontactfirstname => 'altcontact_firstname',
1613         altcontactphone     => 'altcontact_phone',
1614         altcontactsurname   => 'altcontact_surname',
1615         altcontactstate     => 'altcontact_state',
1616         altcontactzipcode   => 'altcontact_postal_code'
1617     };
1618 }
1619
1620 =head2 Internal methods
1621
1622 =head3 _type
1623
1624 =cut
1625
1626 sub _type {
1627     return 'Borrower';
1628 }
1629
1630 =head1 AUTHORS
1631
1632 Kyle M Hall <kyle@bywatersolutions.com>
1633 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
1634 Martin Renvoize <martin.renvoize@ptfs-europe.com>
1635
1636 =cut
1637
1638 1;