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