Koha/Patron.pm

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