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