Koha/Patron.pm

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