Koha/Patron.pm

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