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