Koha/Patron.pm

   1 package Koha::Patron;
   2
   3 # Copyright ByWater Solutions 2014
   4 # Copyright PTFS Europe 2016
   5 #
   6 # This file is part of Koha.
   7 #
   8 # Koha is free software; you can redistribute it and/or modify it
   9 # under the terms of the GNU General Public License as published by
  10 # the Free Software Foundation; either version 3 of the License, or
  11 # (at your option) any later version.
  12 #
  13 # Koha is distributed in the hope that it will be useful, but
  14 # WITHOUT ANY WARRANTY; without even the implied warranty of
  15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  16 # GNU General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU General Public License
  19 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  20
  21 use Modern::Perl;
  22
  23 use List::MoreUtils qw( any uniq );
  24 use JSON qw( to_json );
  25 use Unicode::Normalize qw( NFKD );
  26 use Try::Tiny;
  27
  28 use C4::Context;
  29 use C4::Log qw( logaction );
  30 use C4::Scrubber;
  31 use Koha::Account;
  32 use Koha::ArticleRequests;
  33 use C4::Letters;
  34 use Koha::AuthUtils;
  35 use Koha::Checkouts;
  36 use Koha::CirculationRules;
  37 use Koha::Club::Enrollments;
  38 use Koha::Database;
  39 use Koha::DateUtils qw( dt_from_string );
  40 use Koha::Encryption;
  41 use Koha::Exceptions::Password;
  42 use Koha::Holds;
  43 use Koha::Old::Checkouts;
  44 use Koha::Patron::Attributes;
  45 use Koha::Patron::Categories;
  46 use Koha::Patron::Debarments;
  47 use Koha::Patron::HouseboundProfile;
  48 use Koha::Patron::HouseboundRole;
  49 use Koha::Patron::Images;
  50 use Koha::Patron::Messages;
  51 use Koha::Patron::Modifications;
  52 use Koha::Patron::Relationships;
  53 use Koha::Patrons;
  54 use Koha::Plugins;
  55 use Koha::Recalls;
  56 use Koha::Result::Boolean;
  57 use Koha::Subscription::Routinglists;
  58 use Koha::Token;
  59 use Koha::Virtualshelves;
  60
  61 use base qw(Koha::Object);
  62
  63 use constant ADMINISTRATIVE_LOCKOUT => -1;
  64
  65 our $RESULTSET_PATRON_ID_MAPPING = {
  66     Accountline          => 'borrowernumber',
  67     Aqbasketuser         => 'borrowernumber',
  68     Aqbudget             => 'budget_owner_id',
  69     Aqbudgetborrower     => 'borrowernumber',
  70     ArticleRequest       => 'borrowernumber',
  71     BorrowerDebarment    => 'borrowernumber',
  72     BorrowerFile         => 'borrowernumber',
  73     BorrowerModification => 'borrowernumber',
  74     ClubEnrollment       => 'borrowernumber',
  75     Issue                => 'borrowernumber',
  76     ItemsLastBorrower    => 'borrowernumber',
  77     Linktracker          => 'borrowernumber',
  78     Message              => 'borrowernumber',
  79     MessageQueue         => 'borrowernumber',
  80     OldIssue             => 'borrowernumber',
  81     OldReserve           => 'borrowernumber',
  82     Rating               => 'borrowernumber',
  83     Reserve              => 'borrowernumber',
  84     Review               => 'borrowernumber',
  85     SearchHistory        => 'userid',
  86     Statistic            => 'borrowernumber',
  87     Suggestion           => 'suggestedby',
  88     TagAll               => 'borrowernumber',
  89     Virtualshelfcontent  => 'borrowernumber',
  90     Virtualshelfshare    => 'borrowernumber',
  91     Virtualshelve        => 'owner',
  92 };
  93
  94 =head1 NAME
  95
  96 Koha::Patron - Koha Patron Object class
  97
  98 =head1 API
  99
 100 =head2 Class Methods
 101
 102 =head3 new
 103
 104 =cut
 105
 106 sub new {
 107     my ( $class, $params ) = @_;
 108
 109     return $class->SUPER::new($params);
 110 }
 111
 112 =head3 fixup_cardnumber
 113
 114 Autogenerate next cardnumber from highest value found in database
 115
 116 =cut
 117
 118 sub fixup_cardnumber {
 119     my ( $self ) = @_;
 120
 121     my $max = $self->cardnumber;
 122     Koha::Plugins->call( 'patron_barcode_transform', \$max );
 123
 124     $max ||= Koha::Patrons->search({
 125         cardnumber => {-regexp => '^-?[0-9]+$'}
 126     }, {
 127         select => \'CAST(cardnumber AS SIGNED)',
 128         as => ['cast_cardnumber']
 129     })->_resultset->get_column('cast_cardnumber')->max;
 130     $self->cardnumber(($max || 0) +1);
 131 }
 132
 133 =head3 trim_whitespace
 134
 135 trim whitespace from data which has some non-whitespace in it.
 136 Could be moved to Koha::Object if need to be reused
 137
 138 =cut
 139
 140 sub trim_whitespaces {
 141     my( $self ) = @_;
 142
 143     my $schema  = Koha::Database->new->schema;
 144     my @columns = $schema->source($self->_type)->columns;
 145
 146     for my $column( @columns ) {
 147         my $value = $self->$column;
 148         if ( defined $value ) {
 149             $value =~ s/^\s*|\s*$//g;
 150             $self->$column($value);
 151         }
 152     }
 153     return $self;
 154 }
 155
 156 =head3 plain_text_password
 157
 158 $patron->plain_text_password( $password );
 159
 160 stores a copy of the unencrypted password in the object
 161 for use in code before encrypting for db
 162
 163 =cut
 164
 165 sub plain_text_password {
 166     my ( $self, $password ) = @_;
 167     if ( $password ) {
 168         $self->{_plain_text_password} = $password;
 169         return $self;
 170     }
 171     return $self->{_plain_text_password}
 172         if $self->{_plain_text_password};
 173
 174     return;
 175 }
 176
 177 =head3 store
 178
 179 Patron specific store method to cleanup record
 180 and do other necessary things before saving
 181 to db
 182
 183 =cut
 184
 185 sub store {
 186     my ($self) = @_;
 187
 188     $self->_result->result_source->schema->txn_do(
 189         sub {
 190             if (
 191                 C4::Context->preference("autoMemberNum")
 192                 and ( not defined $self->cardnumber
 193                     or $self->cardnumber eq '' )
 194               )
 195             {
 196                 # Warning: The caller is responsible for locking the members table in write
 197                 # mode, to avoid database corruption.
 198                 # We are in a transaction but the table is not locked
 199                 $self->fixup_cardnumber;
 200             }
 201
 202             unless( $self->category->in_storage ) {
 203                 Koha::Exceptions::Object::FKConstraint->throw(
 204                     broken_fk => 'categorycode',
 205                     value     => $self->categorycode,
 206                 );
 207             }
 208
 209             $self->trim_whitespaces;
 210
 211             my $new_cardnumber = $self->cardnumber;
 212             Koha::Plugins->call( 'patron_barcode_transform', \$new_cardnumber );
 213             $self->cardnumber( $new_cardnumber );
 214
 215             # Set surname to uppercase if uppercasesurname is true
 216             $self->surname( uc($self->surname) )
 217                 if C4::Context->preference("uppercasesurnames");
 218
 219             $self->relationship(undef) # We do not want to store an empty string in this field
 220               if defined $self->relationship
 221                      and $self->relationship eq "";
 222
 223             for my $note_field ( qw( borrowernotes opacnote ) ) {
 224                 if ( !$self->in_storage || $self->_result->is_column_changed($note_field) ) {
 225                     $self->$note_field(C4::Scrubber->new('comment')->scrub($self->$note_field));
 226                 }
 227             }
 228
 229             unless ( $self->in_storage ) {    #AddMember
 230
 231                 # Generate a valid userid/login if needed
 232                 $self->generate_userid
 233                   if not $self->userid or not $self->has_valid_userid;
 234
 235                 # Add expiration date if it isn't already there
 236                 unless ( $self->dateexpiry ) {
 237                     $self->dateexpiry( $self->category->get_expiry_date );
 238                 }
 239
 240                 # Add enrollment date if it isn't already there
 241                 unless ( $self->dateenrolled ) {
 242                     $self->dateenrolled(dt_from_string);
 243                 }
 244
 245                 # Set the privacy depending on the patron's category
 246                 my $default_privacy = $self->category->default_privacy || q{};
 247                 $default_privacy =
 248                     $default_privacy eq 'default' ? 1
 249                   : $default_privacy eq 'never'   ? 2
 250                   : $default_privacy eq 'forever' ? 0
 251                   :                                                   undef;
 252                 $self->privacy($default_privacy);
 253
 254                 # Call any check_password plugins if password is passed
 255                 if ( C4::Context->config("enable_plugins") && $self->password ) {
 256                     my @plugins = Koha::Plugins->new()->GetPlugins({
 257                         method => 'check_password',
 258                     });
 259                     foreach my $plugin ( @plugins ) {
 260                         # This plugin hook will also be used by a plugin for the Norwegian national
 261                         # patron database. This is why we need to pass both the password and the
 262                         # borrowernumber to the plugin.
 263                         my $ret = $plugin->check_password(
 264                             {
 265                                 password       => $self->password,
 266                                 borrowernumber => $self->borrowernumber
 267                             }
 268                         );
 269                         if ( $ret->{'error'} == 1 ) {
 270                             Koha::Exceptions::Password::Plugin->throw();
 271                         }
 272                     }
 273                 }
 274
 275                 # Make a copy of the plain text password for later use
 276                 $self->plain_text_password( $self->password );
 277
 278                 $self->password_expiration_date( $self->password
 279                     ? $self->category->get_password_expiry_date || undef
 280                     : undef );
 281                 # Create a disabled account if no password provided
 282                 $self->password( $self->password
 283                     ? Koha::AuthUtils::hash_password( $self->password )
 284                     : '!' );
 285
 286                 $self->borrowernumber(undef);
 287
 288                 $self = $self->SUPER::store;
 289
 290                 $self->add_enrolment_fee_if_needed(0);
 291
 292                 logaction( "MEMBERS", "CREATE", $self->borrowernumber, "" )
 293                   if C4::Context->preference("BorrowersLog");
 294             }
 295             else {    #ModMember
 296
 297                 my $self_from_storage = $self->get_from_storage;
 298                 # FIXME We should not deal with that here, callers have to do this job
 299                 # Moved from ModMember to prevent regressions
 300                 unless ( $self->userid ) {
 301                     my $stored_userid = $self_from_storage->userid;
 302                     $self->userid($stored_userid);
 303                 }
 304
 305                 # Password must be updated using $self->set_password
 306                 $self->password($self_from_storage->password);
 307
 308                 if ( $self->category->categorycode ne
 309                     $self_from_storage->category->categorycode )
 310                 {
 311                     # Add enrolement fee on category change if required
 312                     $self->add_enrolment_fee_if_needed(1)
 313                       if C4::Context->preference('FeeOnChangePatronCategory');
 314
 315                     # Clean up guarantors on category change if required
 316                     $self->guarantor_relationships->delete
 317                       if ( $self->category->category_type ne 'C'
 318                         && $self->category->category_type ne 'P' );
 319
 320                 }
 321
 322                 # Actionlogs
 323                 if ( C4::Context->preference("BorrowersLog") ) {
 324                     my $info;
 325                     my $from_storage = $self_from_storage->unblessed;
 326                     my $from_object  = $self->unblessed;
 327                     my @skip_fields  = (qw/lastseen updated_on/);
 328                     for my $key ( keys %{$from_storage} ) {
 329                         next if any { /$key/ } @skip_fields;
 330                         if (
 331                             (
 332                                   !defined( $from_storage->{$key} )
 333                                 && defined( $from_object->{$key} )
 334                             )
 335                             || ( defined( $from_storage->{$key} )
 336                                 && !defined( $from_object->{$key} ) )
 337                             || (
 338                                    defined( $from_storage->{$key} )
 339                                 && defined( $from_object->{$key} )
 340                                 && ( $from_storage->{$key} ne
 341                                     $from_object->{$key} )
 342                             )
 343                           )
 344                         {
 345                             $info->{$key} = {
 346                                 before => $from_storage->{$key},
 347                                 after  => $from_object->{$key}
 348                             };
 349                         }
 350                     }
 351
 352                     if ( defined($info) ) {
 353                         logaction(
 354                             "MEMBERS",
 355                             "MODIFY",
 356                             $self->borrowernumber,
 357                             to_json(
 358                                 $info,
 359                                 { utf8 => 1, pretty => 1, canonical => 1 }
 360                             )
 361                         );
 362                     }
 363                 }
 364
 365                 # Final store
 366                 $self = $self->SUPER::store;
 367             }
 368         }
 369     );
 370     return $self;
 371 }
 372
 373 =head3 delete
 374
 375 $patron->delete
 376
 377 Delete patron's holds, lists and finally the patron.
 378
 379 Lists owned by the borrower are deleted, but entries from the borrower to
 380 other lists are kept.
 381
 382 =cut
 383
 384 sub delete {
 385     my ($self) = @_;
 386
 387     my $anonymous_patron = C4::Context->preference("AnonymousPatron");
 388     Koha::Exceptions::Patron::FailedDeleteAnonymousPatron->throw() if $anonymous_patron && $self->id eq $anonymous_patron;
 389
 390     $self->_result->result_source->schema->txn_do(
 391         sub {
 392             # Cancel Patron's holds
 393             my $holds = $self->holds;
 394             while( my $hold = $holds->next ){
 395                 $hold->cancel;
 396             }
 397
 398             # Delete all lists and all shares of this borrower
 399             # Consistent with the approach Koha uses on deleting individual lists
 400             # Note that entries in virtualshelfcontents added by this borrower to
 401             # lists of others will be handled by a table constraint: the borrower
 402             # is set to NULL in those entries.
 403             # NOTE:
 404             # We could handle the above deletes via a constraint too.
 405             # But a new BZ report 11889 has been opened to discuss another approach.
 406             # Instead of deleting we could also disown lists (based on a pref).
 407             # In that way we could save shared and public lists.
 408             # The current table constraints support that idea now.
 409             # This pref should then govern the results of other routines/methods such as
 410             # Koha::Virtualshelf->new->delete too.
 411             # FIXME Could be $patron->get_lists
 412             $_->delete for Koha::Virtualshelves->search( { owner => $self->borrowernumber } )->as_list;
 413
 414             # We cannot have a FK on borrower_modifications.borrowernumber, the table is also used
 415             # for patron selfreg
 416             $_->delete for Koha::Patron::Modifications->search( { borrowernumber => $self->borrowernumber } )->as_list;
 417
 418             $self->SUPER::delete;
 419
 420             logaction( "MEMBERS", "DELETE", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog");
 421         }
 422     );
 423     return $self;
 424 }
 425
 426
 427 =head3 category
 428
 429 my $patron_category = $patron->category
 430
 431 Return the patron category for this patron
 432
 433 =cut
 434
 435 sub category {
 436     my ( $self ) = @_;
 437     return Koha::Patron::Category->_new_from_dbic( $self->_result->categorycode );
 438 }
 439
 440 =head3 image
 441
 442 =cut
 443
 444 sub image {
 445     my ( $self ) = @_;
 446
 447     return Koha::Patron::Images->find( $self->borrowernumber );
 448 }
 449
 450 =head3 library
 451
 452 Returns a Koha::Library object representing the patron's home library.
 453
 454 =cut
 455
 456 sub library {
 457     my ( $self ) = @_;
 458     return Koha::Library->_new_from_dbic($self->_result->branchcode);
 459 }
 460
 461 =head3 sms_provider
 462
 463 Returns a Koha::SMS::Provider object representing the patron's SMS provider.
 464
 465 =cut
 466
 467 sub sms_provider {
 468     my ( $self ) = @_;
 469     my $sms_provider_rs = $self->_result->sms_provider;
 470     return unless $sms_provider_rs;
 471     return Koha::SMS::Provider->_new_from_dbic($sms_provider_rs);
 472 }
 473
 474 =head3 guarantor_relationships
 475
 476 Returns Koha::Patron::Relationships object for this patron's guarantors
 477
 478 Returns the set of relationships for the patrons that are guarantors for this patron.
 479
 480 This is returned instead of a Koha::Patron object because the guarantor
 481 may not exist as a patron in Koha. If this is true, the guarantors name
 482 exists in the Koha::Patron::Relationship object and will have no guarantor_id.
 483
 484 =cut
 485
 486 sub guarantor_relationships {
 487     my ($self) = @_;
 488
 489     return Koha::Patron::Relationships->search( { guarantee_id => $self->id } );
 490 }
 491
 492 =head3 guarantee_relationships
 493
 494 Returns Koha::Patron::Relationships object for this patron's guarantors
 495
 496 Returns the set of relationships for the patrons that are guarantees for this patron.
 497
 498 The method returns Koha::Patron::Relationship objects for the sake
 499 of consistency with the guantors method.
 500 A guarantee by definition must exist as a patron in Koha.
 501
 502 =cut
 503
 504 sub guarantee_relationships {
 505     my ($self) = @_;
 506
 507     return Koha::Patron::Relationships->search(
 508         { guarantor_id => $self->id },
 509         {
 510             prefetch => 'guarantee',
 511             order_by => { -asc => [ 'guarantee.surname', 'guarantee.firstname' ] },
 512         }
 513     );
 514 }
 515
 516 =head3 relationships_debt
 517
 518 Returns the amount owed by the patron's guarantors *and* the other guarantees of those guarantors
 519
 520 =cut
 521
 522 sub relationships_debt {
 523     my ($self, $params) = @_;
 524
 525     my $include_guarantors  = $params->{include_guarantors};
 526     my $only_this_guarantor = $params->{only_this_guarantor};
 527     my $include_this_patron = $params->{include_this_patron};
 528
 529     my @guarantors;
 530     if ( $only_this_guarantor ) {
 531         @guarantors = $self->guarantee_relationships->count ? ( $self ) : ();
 532         Koha::Exceptions::BadParameter->throw( { parameter => 'only_this_guarantor' } ) unless @guarantors;
 533     } elsif ( $self->guarantor_relationships->count ) {
 534         # I am a guarantee, just get all my guarantors
 535         @guarantors = $self->guarantor_relationships->guarantors->as_list;
 536     } else {
 537         # I am a guarantor, I need to get all the guarantors of all my guarantees
 538         @guarantors = map { $_->guarantor_relationships->guarantors->as_list } $self->guarantee_relationships->guarantees->as_list;
 539     }
 540
 541     my $non_issues_charges = 0;
 542     my $seen = $include_this_patron ? {} : { $self->id => 1 }; # For tracking members already added to the total
 543     foreach my $guarantor (@guarantors) {
 544         $non_issues_charges += $guarantor->account->non_issues_charges if $include_guarantors && !$seen->{ $guarantor->id };
 545
 546         # We've added what the guarantor owes, not added in that guarantor's guarantees as well
 547         my @guarantees = map { $_->guarantee } $guarantor->guarantee_relationships->as_list;
 548         my $guarantees_non_issues_charges = 0;
 549         foreach my $guarantee (@guarantees) {
 550             next if $seen->{ $guarantee->id };
 551             $guarantees_non_issues_charges += $guarantee->account->non_issues_charges;
 552             # Mark this guarantee as seen so we don't double count a guarantee linked to multiple guarantors
 553             $seen->{ $guarantee->id } = 1;
 554         }
 555
 556         $non_issues_charges += $guarantees_non_issues_charges;
 557         $seen->{ $guarantor->id } = 1;
 558     }
 559
 560     return $non_issues_charges;
 561 }
 562
 563 =head3 housebound_profile
 564
 565 Returns the HouseboundProfile associated with this patron.
 566
 567 =cut
 568
 569 sub housebound_profile {
 570     my ( $self ) = @_;
 571     my $profile = $self->_result->housebound_profile;
 572     return Koha::Patron::HouseboundProfile->_new_from_dbic($profile)
 573         if ( $profile );
 574     return;
 575 }
 576
 577 =head3 housebound_role
 578
 579 Returns the HouseboundRole associated with this patron.
 580
 581 =cut
 582
 583 sub housebound_role {
 584     my ( $self ) = @_;
 585
 586     my $role = $self->_result->housebound_role;
 587     return Koha::Patron::HouseboundRole->_new_from_dbic($role) if ( $role );
 588     return;
 589 }
 590
 591 =head3 siblings
 592
 593 Returns the siblings of this patron.
 594
 595 =cut
 596
 597 sub siblings {
 598     my ($self) = @_;
 599
 600     my @guarantors = $self->guarantor_relationships()->guarantors()->as_list;
 601
 602     return unless @guarantors;
 603
 604     my @siblings =
 605       map { $_->guarantee_relationships()->guarantees()->as_list } @guarantors;
 606
 607     return unless @siblings;
 608
 609     my %seen;
 610     @siblings =
 611       grep { !$seen{ $_->id }++ && ( $_->id != $self->id ) } @siblings;
 612
 613     return Koha::Patrons->search( { borrowernumber => { -in => [ map { $_->id } @siblings ] } } );
 614 }
 615
 616 =head3 merge_with
 617
 618     my $patron = Koha::Patrons->find($id);
 619     $patron->merge_with( \@patron_ids );
 620
 621     This subroutine merges a list of patrons into the patron record. This is accomplished by finding
 622     all related patron ids for the patrons to be merged in other tables and changing the ids to be that
 623     of the keeper patron.
 624
 625 =cut
 626
 627 sub merge_with {
 628     my ( $self, $patron_ids ) = @_;
 629
 630     my $anonymous_patron = C4::Context->preference("AnonymousPatron");
 631     return if $anonymous_patron && $self->id eq $anonymous_patron;
 632
 633     my @patron_ids = @{ $patron_ids };
 634
 635     # Ensure the keeper isn't in the list of patrons to merge
 636     @patron_ids = grep { $_ ne $self->id } @patron_ids;
 637
 638     my $schema = Koha::Database->new()->schema();
 639
 640     my $results;
 641
 642     $self->_result->result_source->schema->txn_do( sub {
 643         foreach my $patron_id (@patron_ids) {
 644
 645             next if $patron_id eq $anonymous_patron;
 646
 647             my $patron = Koha::Patrons->find( $patron_id );
 648
 649             next unless $patron;
 650
 651             # Unbless for safety, the patron will end up being deleted
 652             $results->{merged}->{$patron_id}->{patron} = $patron->unblessed;
 653
 654             my $attributes = $patron->extended_attributes;
 655             my $new_attributes = [
 656                 map { { code => $_->code, attribute => $_->attribute } }
 657                     $attributes->as_list
 658             ];
 659             $attributes->delete; # We need to delete before trying to merge them to prevent exception on unique and repeatable
 660             for my $attribute ( @$new_attributes ) {
 661                 try {
 662                     $self->add_extended_attribute($attribute);
 663                 } catch {
 664                     # Don't block the merge if there is a non-repeatable attribute that cannot be added to the current patron.
 665                     unless ( $_->isa('Koha::Exceptions::Patron::Attribute::NonRepeatable') ) {
 666                         $_->rethrow;
 667                     }
 668                 };
 669             }
 670
 671             while (my ($r, $field) = each(%$RESULTSET_PATRON_ID_MAPPING)) {
 672                 my $rs = $schema->resultset($r)->search({ $field => $patron_id });
 673                 $results->{merged}->{ $patron_id }->{updated}->{$r} = $rs->count();
 674                 $rs->update({ $field => $self->id });
 675                 if ( $r eq 'BorrowerDebarment' ) {
 676                     Koha::Patron::Debarments::UpdateBorrowerDebarmentFlags($self->id);
 677                 }
 678             }
 679
 680             $patron->move_to_deleted();
 681             $patron->delete();
 682         }
 683     });
 684
 685     return $results;
 686 }
 687
 688
 689
 690 =head3 wants_check_for_previous_checkout
 691
 692     $wants_check = $patron->wants_check_for_previous_checkout;
 693
 694 Return 1 if Koha needs to perform PrevIssue checking, else 0.
 695
 696 =cut
 697
 698 sub wants_check_for_previous_checkout {
 699     my ( $self ) = @_;
 700     my $syspref = C4::Context->preference("checkPrevCheckout");
 701
 702     # Simple cases
 703     ## Hard syspref trumps all
 704     return 1 if ($syspref eq 'hardyes');
 705     return 0 if ($syspref eq 'hardno');
 706     ## Now, patron pref trumps all
 707     return 1 if ($self->checkprevcheckout eq 'yes');
 708     return 0 if ($self->checkprevcheckout eq 'no');
 709
 710     # More complex: patron inherits -> determine category preference
 711     my $checkPrevCheckoutByCat = $self->category->checkprevcheckout;
 712     return 1 if ($checkPrevCheckoutByCat eq 'yes');
 713     return 0 if ($checkPrevCheckoutByCat eq 'no');
 714
 715     # Finally: category preference is inherit, default to 0
 716     if ($syspref eq 'softyes') {
 717         return 1;
 718     } else {
 719         return 0;
 720     }
 721 }
 722
 723 =head3 do_check_for_previous_checkout
 724
 725     $do_check = $patron->do_check_for_previous_checkout($item);
 726
 727 Return 1 if the bib associated with $ITEM has previously been checked out to
 728 $PATRON, 0 otherwise.
 729
 730 =cut
 731
 732 sub do_check_for_previous_checkout {
 733     my ( $self, $item ) = @_;
 734
 735     my @item_nos;
 736     my $biblio = Koha::Biblios->find( $item->{biblionumber} );
 737     if ( $biblio->is_serial ) {
 738         push @item_nos, $item->{itemnumber};
 739     } else {
 740         # Get all itemnumbers for given bibliographic record.
 741         @item_nos = $biblio->items->get_column( 'itemnumber' );
 742     }
 743
 744     # Create (old)issues search criteria
 745     my $criteria = {
 746         borrowernumber => $self->borrowernumber,
 747         itemnumber => \@item_nos,
 748     };
 749
 750     my $delay = C4::Context->preference('CheckPrevCheckoutDelay') || 0;
 751     if ($delay) {
 752         my $dtf = Koha::Database->new->schema->storage->datetime_parser;
 753         my $newer_than = dt_from_string()->subtract( days => $delay );
 754         $criteria->{'returndate'} = { '>'   =>  $dtf->format_datetime($newer_than), };
 755     }
 756
 757     # Check current issues table
 758     my $issues = Koha::Checkouts->search($criteria);
 759     return 1 if $issues->count; # 0 || N
 760
 761     # Check old issues table
 762     my $old_issues = Koha::Old::Checkouts->search($criteria);
 763     return $old_issues->count;  # 0 || N
 764 }
 765
 766 =head3 is_debarred
 767
 768 my $debarment_expiration = $patron->is_debarred;
 769
 770 Returns the date a patron debarment will expire, or undef if the patron is not
 771 debarred
 772
 773 =cut
 774
 775 sub is_debarred {
 776     my ($self) = @_;
 777
 778     return unless $self->debarred;
 779     return $self->debarred
 780       if $self->debarred =~ '^9999'
 781       or dt_from_string( $self->debarred ) > dt_from_string;
 782     return;
 783 }
 784
 785 =head3 is_expired
 786
 787 my $is_expired = $patron->is_expired;
 788
 789 Returns 1 if the patron is expired or 0;
 790
 791 =cut
 792
 793 sub is_expired {
 794     my ($self) = @_;
 795     return 0 unless $self->dateexpiry;
 796     return 0 if $self->dateexpiry =~ '^9999';
 797     return 1 if dt_from_string( $self->dateexpiry ) < dt_from_string->truncate( to => 'day' );
 798     return 0;
 799 }
 800
 801 =head3 password_expired
 802
 803 my $password_expired = $patron->password_expired;
 804
 805 Returns 1 if the patron's password is expired or 0;
 806
 807 =cut
 808
 809 sub password_expired {
 810     my ($self) = @_;
 811     return 0 unless $self->password_expiration_date;
 812     return 1 if dt_from_string( $self->password_expiration_date ) <= dt_from_string->truncate( to => 'day' );
 813     return 0;
 814 }
 815
 816 =head3 is_going_to_expire
 817
 818 my $is_going_to_expire = $patron->is_going_to_expire;
 819
 820 Returns 1 if the patron is going to expired, depending on the NotifyBorrowerDeparture pref or 0
 821
 822 =cut
 823
 824 sub is_going_to_expire {
 825     my ($self) = @_;
 826
 827     my $delay = C4::Context->preference('NotifyBorrowerDeparture') || 0;
 828
 829     return 0 unless $delay;
 830     return 0 unless $self->dateexpiry;
 831     return 0 if $self->dateexpiry =~ '^9999';
 832     return 1 if dt_from_string( $self->dateexpiry, undef, 'floating' )->subtract( days => $delay ) < dt_from_string(undef, undef, 'floating')->truncate( to => 'day' );
 833     return 0;
 834 }
 835
 836 =head3 set_password
 837
 838     $patron->set_password({ password => $plain_text_password [, skip_validation => 1 ] });
 839
 840 Set the patron's password.
 841
 842 =head4 Exceptions
 843
 844 The passed string is validated against the current password enforcement policy.
 845 Validation can be skipped by passing the I<skip_validation> parameter.
 846
 847 Exceptions are thrown if the password is not good enough.
 848
 849 =over 4
 850
 851 =item Koha::Exceptions::Password::TooShort
 852
 853 =item Koha::Exceptions::Password::WhitespaceCharacters
 854
 855 =item Koha::Exceptions::Password::TooWeak
 856
 857 =item Koha::Exceptions::Password::Plugin (if a "check password" plugin is enabled)
 858
 859 =back
 860
 861 =cut
 862
 863 sub set_password {
 864     my ( $self, $args ) = @_;
 865
 866     my $password = $args->{password};
 867
 868     unless ( $args->{skip_validation} ) {
 869         my ( $is_valid, $error ) = Koha::AuthUtils::is_password_valid( $password, $self->category );
 870
 871         if ( !$is_valid ) {
 872             if ( $error eq 'too_short' ) {
 873                 my $min_length = $self->category->effective_min_password_length;
 874                 $min_length = 3 if not $min_length or $min_length < 3;
 875
 876                 my $password_length = length($password);
 877                 Koha::Exceptions::Password::TooShort->throw(
 878                     length => $password_length, min_length => $min_length );
 879             }
 880             elsif ( $error eq 'has_whitespaces' ) {
 881                 Koha::Exceptions::Password::WhitespaceCharacters->throw();
 882             }
 883             elsif ( $error eq 'too_weak' ) {
 884                 Koha::Exceptions::Password::TooWeak->throw();
 885             }
 886         }
 887     }
 888
 889     if ( C4::Context->config("enable_plugins") ) {
 890         # Call any check_password plugins
 891         my @plugins = Koha::Plugins->new()->GetPlugins({
 892             method => 'check_password',
 893         });
 894         foreach my $plugin ( @plugins ) {
 895             # This plugin hook will also be used by a plugin for the Norwegian national
 896             # patron database. This is why we need to pass both the password and the
 897             # borrowernumber to the plugin.
 898             my $ret = $plugin->check_password(
 899                 {
 900                     password       => $password,
 901                     borrowernumber => $self->borrowernumber
 902                 }
 903             );
 904             # This plugin hook will also be used by a plugin for the Norwegian national
 905             # patron database. This is why we need to call the actual plugins and then
 906             # check skip_validation afterwards.
 907             if ( $ret->{'error'} == 1 && !$args->{skip_validation} ) {
 908                 Koha::Exceptions::Password::Plugin->throw();
 909             }
 910         }
 911     }
 912
 913     my $digest = Koha::AuthUtils::hash_password($password);
 914
 915     $self->password_expiration_date( $self->category->get_password_expiry_date || undef );
 916
 917     # We do not want to call $self->store and retrieve password from DB
 918     $self->password($digest);
 919     $self->login_attempts(0);
 920     $self->SUPER::store;
 921
 922     logaction( "MEMBERS", "CHANGE PASS", $self->borrowernumber, "" )
 923         if C4::Context->preference("BorrowersLog");
 924
 925     return $self;
 926 }
 927
 928
 929 =head3 renew_account
 930
 931 my $new_expiry_date = $patron->renew_account
 932
 933 Extending the subscription to the expiry date.
 934
 935 =cut
 936
 937 sub renew_account {
 938     my ($self) = @_;
 939     my $date;
 940     if ( C4::Context->preference('BorrowerRenewalPeriodBase') eq 'combination' ) {
 941         $date = ( dt_from_string gt dt_from_string( $self->dateexpiry ) ) ? dt_from_string : dt_from_string( $self->dateexpiry );
 942     } else {
 943         $date =
 944             C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry'
 945             ? dt_from_string( $self->dateexpiry )
 946             : dt_from_string;
 947     }
 948     my $expiry_date = $self->category->get_expiry_date($date);
 949
 950     $self->dateexpiry($expiry_date);
 951     $self->date_renewed( dt_from_string() );
 952     $self->store();
 953
 954     $self->add_enrolment_fee_if_needed(1);
 955
 956     logaction( "MEMBERS", "RENEW", $self->borrowernumber, "Membership renewed" ) if C4::Context->preference("BorrowersLog");
 957     return dt_from_string( $expiry_date )->truncate( to => 'day' );
 958 }
 959
 960 =head3 has_overdues
 961
 962 my $has_overdues = $patron->has_overdues;
 963
 964 Returns the number of patron's overdues
 965
 966 =cut
 967
 968 sub has_overdues {
 969     my ($self) = @_;
 970     my $dtf = Koha::Database->new->schema->storage->datetime_parser;
 971     return $self->_result->issues->search({ date_due => { '<' => $dtf->format_datetime( dt_from_string() ) } })->count;
 972 }
 973
 974 =head3 track_login
 975
 976     $patron->track_login;
 977     $patron->track_login({ force => 1 });
 978
 979     Tracks a (successful) login attempt.
 980     The preference TrackLastPatronActivity must be enabled. Or you
 981     should pass the force parameter.
 982
 983 =cut
 984
 985 sub track_login {
 986     my ( $self, $params ) = @_;
 987     return if
 988         !$params->{force} &&
 989         !C4::Context->preference('TrackLastPatronActivity');
 990     $self->lastseen( dt_from_string() )->store;
 991 }
 992
 993 =head3 move_to_deleted
 994
 995 my $is_moved = $patron->move_to_deleted;
 996
 997 Move a patron to the deletedborrowers table.
 998 This can be done before deleting a patron, to make sure the data are not completely deleted.
 999
1000 =cut
1001
1002 sub move_to_deleted {
1003     my ($self) = @_;
1004     my $patron_infos = $self->unblessed;
1005     delete $patron_infos->{updated_on}; #This ensures the updated_on date in deletedborrowers will be set to the current timestamp
1006     return Koha::Database->new->schema->resultset('Deletedborrower')->create($patron_infos);
1007 }
1008
1009 =head3 can_request_article
1010
1011     if ( $patron->can_request_article( $library->id ) ) { ... }
1012
1013 Returns true if the patron can request articles. As limits apply for the patron
1014 on the same day, those completed the same day are considered as current.
1015
1016 A I<library_id> can be passed as parameter, falling back to userenv if absent.
1017
1018 =cut
1019
1020 sub can_request_article {
1021     my ($self, $library_id) = @_;
1022
1023     $library_id //= C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef;
1024
1025     my $rule = Koha::CirculationRules->get_effective_rule(
1026         {
1027             branchcode   => $library_id,
1028             categorycode => $self->categorycode,
1029             rule_name    => 'open_article_requests_limit'
1030         }
1031     );
1032
1033     my $limit = ($rule) ? $rule->rule_value : undef;
1034
1035     return 1 unless defined $limit;
1036
1037     my $count = Koha::ArticleRequests->search(
1038         [   { borrowernumber => $self->borrowernumber, status => [ 'REQUESTED', 'PENDING', 'PROCESSING' ] },
1039             { borrowernumber => $self->borrowernumber, status => 'COMPLETED', updated_on => { '>=' => \'CAST(NOW() AS DATE)' } },
1040         ]
1041     )->count;
1042     return $count < $limit ? 1 : 0;
1043 }
1044
1045 =head3 article_request_fee
1046
1047     my $fee = $patron->article_request_fee(
1048         {
1049           [ library_id => $library->id, ]
1050         }
1051     );
1052
1053 Returns the fee to be charged to the patron when it places an article request.
1054
1055 A I<library_id> can be passed as parameter, falling back to userenv if absent.
1056
1057 =cut
1058
1059 sub article_request_fee {
1060     my ($self, $params) = @_;
1061
1062     my $library_id = $params->{library_id};
1063
1064     $library_id //= C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef;
1065
1066     my $rule = Koha::CirculationRules->get_effective_rule(
1067         {
1068             branchcode   => $library_id,
1069             categorycode => $self->categorycode,
1070             rule_name    => 'article_request_fee'
1071         }
1072     );
1073
1074     my $fee = ($rule) ? $rule->rule_value + 0 : 0;
1075
1076     return $fee;
1077 }
1078
1079 =head3 add_article_request_fee_if_needed
1080
1081     my $fee = $patron->add_article_request_fee_if_needed(
1082         {
1083           [ item_id    => $item->id,
1084             library_id => $library->id, ]
1085         }
1086     );
1087
1088 If an article request fee needs to be charged, it adds a debit to the patron's
1089 account.
1090
1091 Returns the fee line.
1092
1093 A I<library_id> can be passed as parameter, falling back to userenv if absent.
1094
1095 =cut
1096
1097 sub add_article_request_fee_if_needed {
1098     my ($self, $params) = @_;
1099
1100     my $library_id = $params->{library_id};
1101     my $item_id    = $params->{item_id};
1102
1103     $library_id //= C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef;
1104
1105     my $amount = $self->article_request_fee(
1106         {
1107             library_id => $library_id,
1108         }
1109     );
1110
1111     my $debit_line;
1112
1113     if ( $amount > 0 ) {
1114         $debit_line = $self->account->add_debit(
1115             {
1116                 amount     => $amount,
1117                 user_id    => C4::Context->userenv ? C4::Context->userenv->{'number'} : undef,
1118                 interface  => C4::Context->interface,
1119                 library_id => $library_id,
1120                 type       => 'ARTICLE_REQUEST',
1121                 item_id    => $item_id,
1122             }
1123         );
1124     }
1125
1126     return $debit_line;
1127 }
1128
1129 =head3 article_requests
1130
1131     my $article_requests = $patron->article_requests;
1132
1133 Returns the patron article requests.
1134
1135 =cut
1136
1137 sub article_requests {
1138     my ($self) = @_;
1139
1140     return Koha::ArticleRequests->_new_from_dbic( scalar $self->_result->article_requests );
1141 }
1142
1143 =head3 add_enrolment_fee_if_needed
1144
1145 my $enrolment_fee = $patron->add_enrolment_fee_if_needed($renewal);
1146
1147 Add enrolment fee for a patron if needed.
1148
1149 $renewal - boolean denoting whether this is an account renewal or not
1150
1151 =cut
1152
1153 sub add_enrolment_fee_if_needed {
1154     my ($self, $renewal) = @_;
1155     my $enrolment_fee = $self->category->enrolmentfee;
1156     if ( $enrolment_fee && $enrolment_fee > 0 ) {
1157         my $type = $renewal ? 'ACCOUNT_RENEW' : 'ACCOUNT';
1158         $self->account->add_debit(
1159             {
1160                 amount     => $enrolment_fee,
1161                 user_id    => C4::Context->userenv ? C4::Context->userenv->{'number'} : undef,
1162                 interface  => C4::Context->interface,
1163                 library_id => C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef,
1164                 type       => $type
1165             }
1166         );
1167     }
1168     return $enrolment_fee || 0;
1169 }
1170
1171 =head3 checkouts
1172
1173 my $checkouts = $patron->checkouts
1174
1175 =cut
1176
1177 sub checkouts {
1178     my ($self) = @_;
1179     my $checkouts = $self->_result->issues;
1180     return Koha::Checkouts->_new_from_dbic( $checkouts );
1181 }
1182
1183 =head3 pending_checkouts
1184
1185 my $pending_checkouts = $patron->pending_checkouts
1186
1187 This method will return the same as $self->checkouts, but with a prefetch on
1188 items, biblio and biblioitems.
1189
1190 It has been introduced to replaced the C4::Members::GetPendingIssues subroutine
1191
1192 It should not be used directly, prefer to access fields you need instead of
1193 retrieving all these fields in one go.
1194
1195 =cut
1196
1197 sub pending_checkouts {
1198     my( $self ) = @_;
1199     my $checkouts = $self->_result->issues->search(
1200         {},
1201         {
1202             order_by => [
1203                 { -desc => 'me.timestamp' },
1204                 { -desc => 'issuedate' },
1205                 { -desc => 'issue_id' }, # Sort by issue_id should be enough
1206             ],
1207             prefetch => { item => { biblio => 'biblioitems' } },
1208         }
1209     );
1210     return Koha::Checkouts->_new_from_dbic( $checkouts );
1211 }
1212
1213 =head3 old_checkouts
1214
1215 my $old_checkouts = $patron->old_checkouts
1216
1217 =cut
1218
1219 sub old_checkouts {
1220     my ($self) = @_;
1221     my $old_checkouts = $self->_result->old_issues;
1222     return Koha::Old::Checkouts->_new_from_dbic( $old_checkouts );
1223 }
1224
1225 =head3 get_overdues
1226
1227 my $overdue_items = $patron->get_overdues
1228
1229 Return the overdue items
1230
1231 =cut
1232
1233 sub get_overdues {
1234     my ($self) = @_;
1235     my $dtf = Koha::Database->new->schema->storage->datetime_parser;
1236     return $self->checkouts->search(
1237         {
1238             'me.date_due' => { '<' => $dtf->format_datetime(dt_from_string) },
1239         },
1240         {
1241             prefetch => { item => { biblio => 'biblioitems' } },
1242         }
1243     );
1244 }
1245
1246 sub overdues { my $self = shift; return $self->get_overdues(@_); }
1247
1248 =head3 get_routing_lists
1249
1250 my $routinglists = $patron->get_routing_lists
1251
1252 Returns the routing lists a patron is subscribed to.
1253
1254 =cut
1255
1256 sub get_routing_lists {
1257     my ($self) = @_;
1258     my $routing_list_rs = $self->_result->subscriptionroutinglists;
1259     return Koha::Subscription::Routinglists->_new_from_dbic($routing_list_rs);
1260 }
1261
1262 =head3 get_age
1263
1264     my $age = $patron->get_age
1265
1266 Return the age of the patron
1267
1268 =cut
1269
1270 sub get_age {
1271     my ($self)    = @_;
1272
1273     return unless $self->dateofbirth;
1274
1275     #Set timezone to floating to avoid any datetime math issues caused by DST
1276     my $date_of_birth = dt_from_string( $self->dateofbirth, undef, 'floating' );
1277     my $today         = dt_from_string(undef, undef, 'floating')->truncate( to => 'day' );
1278
1279     return $today->subtract_datetime( $date_of_birth )->years;
1280 }
1281
1282 =head3 is_valid_age
1283
1284 my $is_valid = $patron->is_valid_age
1285
1286 Return 1 if patron's age is between allowed limits, returns 0 if it's not.
1287
1288 =cut
1289
1290 sub is_valid_age {
1291     my ($self) = @_;
1292     my $age = $self->get_age;
1293
1294     my $patroncategory = $self->category;
1295     my ($low,$high) = ($patroncategory->dateofbirthrequired, $patroncategory->upperagelimit);
1296
1297     return (defined($age) && (($high && ($age > $high)) or ($low && ($age < $low)))) ? 0 : 1;
1298 }
1299
1300 =head3 account
1301
1302 my $account = $patron->account
1303
1304 =cut
1305
1306 sub account {
1307     my ($self) = @_;
1308     return Koha::Account->new( { patron_id => $self->borrowernumber } );
1309 }
1310
1311 =head3 holds
1312
1313 my $holds = $patron->holds
1314
1315 Return all the holds placed by this patron
1316
1317 =cut
1318
1319 sub holds {
1320     my ($self) = @_;
1321     my $holds_rs = $self->_result->reserves->search( {}, { order_by => 'reservedate' } );
1322     return Koha::Holds->_new_from_dbic($holds_rs);
1323 }
1324
1325 =head3 old_holds
1326
1327 my $old_holds = $patron->old_holds
1328
1329 Return all the historical holds for this patron
1330
1331 =cut
1332
1333 sub old_holds {
1334     my ($self) = @_;
1335     my $old_holds_rs = $self->_result->old_reserves->search( {}, { order_by => 'reservedate' } );
1336     return Koha::Old::Holds->_new_from_dbic($old_holds_rs);
1337 }
1338
1339 =head3 return_claims
1340
1341 my $return_claims = $patron->return_claims
1342
1343 =cut
1344
1345 sub return_claims {
1346     my ($self) = @_;
1347     my $return_claims = $self->_result->return_claims_borrowernumbers;
1348     return Koha::Checkouts::ReturnClaims->_new_from_dbic( $return_claims );
1349 }
1350
1351 =head3 notice_email_address
1352
1353   my $email = $patron->notice_email_address;
1354
1355 Return the email address of patron used for notices.
1356 Returns the empty string if no email address.
1357
1358 =cut
1359
1360 sub notice_email_address{
1361     my ( $self ) = @_;
1362
1363     my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
1364     # if syspref is set to 'first valid' (value == OFF), look up email address
1365     if ( $which_address eq 'OFF' ) {
1366         return $self->first_valid_email_address;
1367     }
1368
1369     return $self->$which_address || '';
1370 }
1371
1372 =head3 first_valid_email_address
1373
1374 my $first_valid_email_address = $patron->first_valid_email_address
1375
1376 Return the first valid email address for a patron.
1377 For now, the order  is defined as email, emailpro, B_email.
1378 Returns the empty string if the borrower has no email addresses.
1379
1380 =cut
1381
1382 sub first_valid_email_address {
1383     my ($self) = @_;
1384
1385     return $self->email() || $self->emailpro() || $self->B_email() || q{};
1386 }
1387
1388 =head3 get_club_enrollments
1389
1390 =cut
1391
1392 sub get_club_enrollments {
1393     my ( $self ) = @_;
1394
1395     return Koha::Club::Enrollments->search( { borrowernumber => $self->borrowernumber(), date_canceled => undef } );
1396 }
1397
1398 =head3 get_enrollable_clubs
1399
1400 =cut
1401
1402 sub get_enrollable_clubs {
1403     my ( $self, $is_enrollable_from_opac ) = @_;
1404
1405     my $params;
1406     $params->{is_enrollable_from_opac} = $is_enrollable_from_opac
1407       if $is_enrollable_from_opac;
1408     $params->{is_email_required} = 0 unless $self->first_valid_email_address();
1409
1410     $params->{borrower} = $self;
1411
1412     return Koha::Clubs->get_enrollable($params);
1413 }
1414
1415 =head3 account_locked
1416
1417 my $is_locked = $patron->account_locked
1418
1419 Return true if the patron has reached the maximum number of login attempts
1420 (see pref FailedLoginAttempts). If login_attempts is < 0, this is interpreted
1421 as an administrative lockout (independent of FailedLoginAttempts; see also
1422 Koha::Patron->lock).
1423 Otherwise return false.
1424 If the pref is not set (empty string, null or 0), the feature is considered as
1425 disabled.
1426
1427 =cut
1428
1429 sub account_locked {
1430     my ($self) = @_;
1431     my $FailedLoginAttempts = C4::Context->preference('FailedLoginAttempts');
1432     return 1 if $FailedLoginAttempts
1433           and $self->login_attempts
1434           and $self->login_attempts >= $FailedLoginAttempts;
1435     return 1 if ($self->login_attempts || 0) < 0; # administrative lockout
1436     return 0;
1437 }
1438
1439 =head3 can_see_patron_infos
1440
1441 my $can_see = $patron->can_see_patron_infos( $patron );
1442
1443 Return true if the patron (usually the logged in user) can see the patron's infos for a given patron
1444
1445 =cut
1446
1447 sub can_see_patron_infos {
1448     my ( $self, $patron ) = @_;
1449     return unless $patron;
1450     return $self->can_see_patrons_from( $patron->branchcode );
1451 }
1452
1453 =head3 can_see_patrons_from
1454
1455 my $can_see = $patron->can_see_patrons_from( $branchcode );
1456
1457 Return true if the patron (usually the logged in user) can see the patron's infos from a given library
1458
1459 =cut
1460
1461 sub can_see_patrons_from {
1462     my ( $self, $branchcode ) = @_;
1463     my $can = 0;
1464     if ( $self->branchcode eq $branchcode ) {
1465         $can = 1;
1466     } elsif ( $self->has_permission( { borrowers => 'view_borrower_infos_from_any_libraries' } ) ) {
1467         $can = 1;
1468     } elsif ( my $library_groups = $self->library->library_groups ) {
1469         while ( my $library_group = $library_groups->next ) {
1470             if ( $library_group->parent->has_child( $branchcode ) ) {
1471                 $can = 1;
1472                 last;
1473             }
1474         }
1475     }
1476     return $can;
1477 }
1478
1479 =head3 can_log_into
1480
1481 my $can_log_into = $patron->can_log_into( $library );
1482
1483 Given a I<Koha::Library> object, it returns a boolean representing
1484 the fact the patron can log into a the library.
1485
1486 =cut
1487
1488 sub can_log_into {
1489     my ( $self, $library ) = @_;
1490
1491     my $can = 0;
1492
1493     if ( C4::Context->preference('IndependentBranches') ) {
1494         $can = 1
1495           if $self->is_superlibrarian
1496           or $self->branchcode eq $library->id;
1497     }
1498     else {
1499         # no restrictions
1500         $can = 1;
1501     }
1502
1503    return $can;
1504 }
1505
1506 =head3 libraries_where_can_see_patrons
1507
1508 my $libraries = $patron-libraries_where_can_see_patrons;
1509
1510 Return the list of branchcodes(!) of libraries the patron is allowed to see other patron's infos.
1511 The branchcodes are arbitrarily returned sorted.
1512 We are supposing here that the object is related to the logged in patron (use of C4::Context::only_my_library)
1513
1514 An empty array means no restriction, the patron can see patron's infos from any libraries.
1515
1516 =cut
1517
1518 sub libraries_where_can_see_patrons {
1519     my ( $self ) = @_;
1520     my $userenv = C4::Context->userenv;
1521
1522     return () unless $userenv; # For tests, but userenv should be defined in tests...
1523
1524     my @restricted_branchcodes;
1525     if (C4::Context::only_my_library) {
1526         push @restricted_branchcodes, $self->branchcode;
1527     }
1528     else {
1529         unless (
1530             $self->has_permission(
1531                 { borrowers => 'view_borrower_infos_from_any_libraries' }
1532             )
1533           )
1534         {
1535             my $library_groups = $self->library->library_groups({ ft_hide_patron_info => 1 });
1536             if ( $library_groups->count )
1537             {
1538                 while ( my $library_group = $library_groups->next ) {
1539                     my $parent = $library_group->parent;
1540                     if ( $parent->has_child( $self->branchcode ) ) {
1541                         push @restricted_branchcodes, $parent->children->get_column('branchcode');
1542                     }
1543                 }
1544             }
1545
1546             @restricted_branchcodes = ( $self->branchcode ) unless @restricted_branchcodes;
1547         }
1548     }
1549
1550     @restricted_branchcodes = grep { defined $_ } @restricted_branchcodes;
1551     @restricted_branchcodes = uniq(@restricted_branchcodes);
1552     @restricted_branchcodes = sort(@restricted_branchcodes);
1553     return @restricted_branchcodes;
1554 }
1555
1556 =head3 has_permission
1557
1558 my $permission = $patron->has_permission($required);
1559
1560 See C4::Auth::haspermission for details of syntax for $required
1561
1562 =cut
1563
1564 sub has_permission {
1565     my ( $self, $flagsrequired ) = @_;
1566     return unless $self->userid;
1567     # TODO code from haspermission needs to be moved here!
1568     return C4::Auth::haspermission( $self->userid, $flagsrequired );
1569 }
1570
1571 =head3 is_superlibrarian
1572
1573   my $is_superlibrarian = $patron->is_superlibrarian;
1574
1575 Return true if the patron is a superlibrarian.
1576
1577 =cut
1578
1579 sub is_superlibrarian {
1580     my ($self) = @_;
1581     return $self->has_permission( { superlibrarian => 1 } ) ? 1 : 0;
1582 }
1583
1584 =head3 is_adult
1585
1586 my $is_adult = $patron->is_adult
1587
1588 Return true if the patron has a category with a type Adult (A) or Organization (I)
1589
1590 =cut
1591
1592 sub is_adult {
1593     my ( $self ) = @_;
1594     return $self->category->category_type =~ /^(A|I)$/ ? 1 : 0;
1595 }
1596
1597 =head3 is_child
1598
1599 my $is_child = $patron->is_child
1600
1601 Return true if the patron has a category with a type Child (C)
1602
1603 =cut
1604
1605 sub is_child {
1606     my( $self ) = @_;
1607     return $self->category->category_type eq 'C' ? 1 : 0;
1608 }
1609
1610 =head3 has_valid_userid
1611
1612 my $patron = Koha::Patrons->find(42);
1613 $patron->userid( $new_userid );
1614 my $has_a_valid_userid = $patron->has_valid_userid
1615
1616 my $patron = Koha::Patron->new( $params );
1617 my $has_a_valid_userid = $patron->has_valid_userid
1618
1619 Return true if the current userid of this patron is valid/unique, otherwise false.
1620
1621 Note that this should be done in $self->store instead and raise an exception if needed.
1622
1623 =cut
1624
1625 sub has_valid_userid {
1626     my ($self) = @_;
1627
1628     return 0 unless $self->userid;
1629
1630     return 0 if ( $self->userid eq C4::Context->config('user') );    # DB user
1631
1632     my $already_exists = Koha::Patrons->search(
1633         {
1634             userid => $self->userid,
1635             (
1636                 $self->in_storage
1637                 ? ( borrowernumber => { '!=' => $self->borrowernumber } )
1638                 : ()
1639             ),
1640         }
1641     )->count;
1642     return $already_exists ? 0 : 1;
1643 }
1644
1645 =head3 generate_userid
1646
1647 my $patron = Koha::Patron->new( $params );
1648 $patron->generate_userid
1649
1650 Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
1651
1652 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).
1653
1654 =cut
1655
1656 sub generate_userid {
1657     my ($self) = @_;
1658     my $offset = 0;
1659     my $firstname = $self->firstname // q{};
1660     my $surname = $self->surname // q{};
1661     #The script will "do" the following code and increment the $offset until the generated userid is unique
1662     do {
1663       $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1664       $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1665       my $userid = lc(($firstname)? "$firstname.$surname" : $surname);
1666       $userid = NFKD( $userid );
1667       $userid =~ s/\p{NonspacingMark}//g;
1668       $userid .= $offset unless $offset == 0;
1669       $self->userid( $userid );
1670       $offset++;
1671      } while (! $self->has_valid_userid );
1672
1673      return $self;
1674 }
1675
1676 =head3 add_extended_attribute
1677
1678 =cut
1679
1680 sub add_extended_attribute {
1681     my ($self, $attribute) = @_;
1682
1683     return Koha::Patron::Attribute->new(
1684         {
1685             %$attribute,
1686             ( borrowernumber => $self->borrowernumber ),
1687         }
1688     )->store;
1689
1690 }
1691
1692 =head3 extended_attributes
1693
1694 Return object of Koha::Patron::Attributes type with all attributes set for this patron
1695
1696 Or setter FIXME
1697
1698 =cut
1699
1700 sub extended_attributes {
1701     my ( $self, $attributes ) = @_;
1702     if ($attributes) {    # setter
1703         my $schema = $self->_result->result_source->schema;
1704         $schema->txn_do(
1705             sub {
1706                 # Remove the existing one
1707                 $self->extended_attributes->filter_by_branch_limitations->delete;
1708
1709                 # Insert the new ones
1710                 my $new_types = {};
1711                 for my $attribute (@$attributes) {
1712                     $self->add_extended_attribute($attribute);
1713                     $new_types->{$attribute->{code}} = 1;
1714                 }
1715
1716                 # Check globally mandatory types
1717                 my @required_attribute_types =
1718                     Koha::Patron::Attribute::Types->search(
1719                         {
1720                             mandatory => 1,
1721                             category_code => [ undef, $self->categorycode ],
1722                             'borrower_attribute_types_branches.b_branchcode' =>
1723                               undef,
1724                         },
1725                         { join => 'borrower_attribute_types_branches' }
1726                     )->get_column('code');
1727                 for my $type ( @required_attribute_types ) {
1728                     Koha::Exceptions::Patron::MissingMandatoryExtendedAttribute->throw(
1729                         type => $type,
1730                     ) if !$new_types->{$type};
1731                 }
1732             }
1733         );
1734     }
1735
1736     my $rs = $self->_result->borrower_attributes;
1737     # We call search to use the filters in Koha::Patron::Attributes->search
1738     return Koha::Patron::Attributes->_new_from_dbic($rs)->search;
1739 }
1740
1741 =head3 messages
1742
1743     my $messages = $patron->messages;
1744
1745 Return the message attached to the patron.
1746
1747 =cut
1748
1749 sub messages {
1750     my ( $self ) = @_;
1751     my $messages_rs = $self->_result->messages_borrowernumbers->search;
1752     return Koha::Patron::Messages->_new_from_dbic($messages_rs);
1753 }
1754
1755 =head3 lock
1756
1757     Koha::Patrons->find($id)->lock({ expire => 1, remove => 1 });
1758
1759     Lock and optionally expire a patron account.
1760     Remove holds and article requests if remove flag set.
1761     In order to distinguish from locking by entering a wrong password, let's
1762     call this an administrative lockout.
1763
1764 =cut
1765
1766 sub lock {
1767     my ( $self, $params ) = @_;
1768     $self->login_attempts( ADMINISTRATIVE_LOCKOUT );
1769     if( $params->{expire} ) {
1770         $self->dateexpiry( dt_from_string->subtract(days => 1) );
1771     }
1772     $self->store;
1773     if( $params->{remove} ) {
1774         $self->holds->delete;
1775         $self->article_requests->delete;
1776     }
1777     return $self;
1778 }
1779
1780 =head3 anonymize
1781
1782     Koha::Patrons->find($id)->anonymize;
1783
1784     Anonymize or clear borrower fields. Fields in BorrowerMandatoryField
1785     are randomized, other personal data is cleared too.
1786     Patrons with issues are skipped.
1787
1788 =cut
1789
1790 sub anonymize {
1791     my ( $self ) = @_;
1792     if( $self->_result->issues->count ) {
1793         warn "Exiting anonymize: patron ".$self->borrowernumber." still has issues";
1794         return;
1795     }
1796     # Mandatory fields come from the corresponding pref, but email fields
1797     # are removed since scrambled email addresses only generate errors
1798     my $mandatory = { map { (lc $_, 1); } grep { !/email/ }
1799         split /\s*\|\s*/, C4::Context->preference('BorrowerMandatoryField') };
1800     $mandatory->{userid} = 1; # needed since sub store does not clear field
1801     my @columns = $self->_result->result_source->columns;
1802     @columns = grep { !/borrowernumber|branchcode|categorycode|^date|password|flags|updated_on|lastseen|lang|login_attempts|anonymized|auth_method/ } @columns;
1803     push @columns, 'dateofbirth'; # add this date back in
1804     foreach my $col (@columns) {
1805         $self->_anonymize_column($col, $mandatory->{lc $col} );
1806     }
1807     $self->anonymized(1)->store;
1808 }
1809
1810 sub _anonymize_column {
1811     my ( $self, $col, $mandatory ) = @_;
1812     my $col_info = $self->_result->result_source->column_info($col);
1813     my $type = $col_info->{data_type};
1814     my $nullable = $col_info->{is_nullable};
1815     my $val;
1816     if( $type =~ /char|text/ ) {
1817         $val = $mandatory
1818             ? Koha::Token->new->generate({ pattern => '\w{10}' })
1819             : $nullable
1820             ? undef
1821             : q{};
1822     } elsif( $type =~ /integer|int$|float|dec|double/ ) {
1823         $val = $nullable ? undef : 0;
1824     } elsif( $type =~ /date|time/ ) {
1825         $val = $nullable ? undef : dt_from_string;
1826     }
1827     $self->$col($val);
1828 }
1829
1830 =head3 add_guarantor
1831
1832     my $relationship = $patron->add_guarantor(
1833         {
1834             borrowernumber => $borrowernumber,
1835             relationships  => $relationship,
1836         }
1837     );
1838
1839     Adds a new guarantor to a patron.
1840
1841 =cut
1842
1843 sub add_guarantor {
1844     my ( $self, $params ) = @_;
1845
1846     my $guarantor_id = $params->{guarantor_id};
1847     my $relationship = $params->{relationship};
1848
1849     return Koha::Patron::Relationship->new(
1850         {
1851             guarantee_id => $self->id,
1852             guarantor_id => $guarantor_id,
1853             relationship => $relationship
1854         }
1855     )->store();
1856 }
1857
1858 =head3 get_extended_attribute
1859
1860 my $attribute_value = $patron->get_extended_attribute( $code );
1861
1862 Return the attribute for the code passed in parameter.
1863
1864 It not exist it returns undef
1865
1866 Note that this will not work for repeatable attribute types.
1867
1868 Maybe you certainly not want to use this method, it is actually only used for SHOW_BARCODE
1869 (which should be a real patron's attribute (not extended)
1870
1871 =cut
1872
1873 sub get_extended_attribute {
1874     my ( $self, $code, $value ) = @_;
1875     my $rs = $self->_result->borrower_attributes;
1876     return unless $rs;
1877     my $attribute = $rs->search({ code => $code, ( $value ? ( attribute => $value ) : () ) });
1878     return unless $attribute->count;
1879     return $attribute->next;
1880 }
1881
1882 =head3 to_api
1883
1884     my $json = $patron->to_api;
1885
1886 Overloaded method that returns a JSON representation of the Koha::Patron object,
1887 suitable for API output.
1888
1889 =cut
1890
1891 sub to_api {
1892     my ( $self, $params ) = @_;
1893
1894     my $json_patron = $self->SUPER::to_api( $params );
1895
1896     $json_patron->{restricted} = ( $self->is_debarred )
1897                                     ? Mojo::JSON->true
1898                                     : Mojo::JSON->false;
1899
1900     return $json_patron;
1901 }
1902
1903 =head3 to_api_mapping
1904
1905 This method returns the mapping for representing a Koha::Patron object
1906 on the API.
1907
1908 =cut
1909
1910 sub to_api_mapping {
1911     return {
1912         borrowernotes       => 'staff_notes',
1913         borrowernumber      => 'patron_id',
1914         branchcode          => 'library_id',
1915         categorycode        => 'category_id',
1916         checkprevcheckout   => 'check_previous_checkout',
1917         contactfirstname    => undef,                     # Unused
1918         contactname         => undef,                     # Unused
1919         contactnote         => 'altaddress_notes',
1920         contacttitle        => undef,                     # Unused
1921         dateenrolled        => 'date_enrolled',
1922         dateexpiry          => 'expiry_date',
1923         dateofbirth         => 'date_of_birth',
1924         debarred            => undef,                     # replaced by 'restricted'
1925         debarredcomment     => undef,    # calculated, API consumers will use /restrictions instead
1926         emailpro            => 'secondary_email',
1927         flags               => undef,    # permissions manipulation handled in /permissions
1928         gonenoaddress       => 'incorrect_address',
1929         lastseen            => 'last_seen',
1930         lost                => 'patron_card_lost',
1931         opacnote            => 'opac_notes',
1932         othernames          => 'other_name',
1933         password            => undef,            # password manipulation handled in /password
1934         phonepro            => 'secondary_phone',
1935         relationship        => 'relationship_type',
1936         sex                 => 'gender',
1937         smsalertnumber      => 'sms_number',
1938         sort1               => 'statistics_1',
1939         sort2               => 'statistics_2',
1940         autorenew_checkouts => 'autorenew_checkouts',
1941         streetnumber        => 'street_number',
1942         streettype          => 'street_type',
1943         zipcode             => 'postal_code',
1944         B_address           => 'altaddress_address',
1945         B_address2          => 'altaddress_address2',
1946         B_city              => 'altaddress_city',
1947         B_country           => 'altaddress_country',
1948         B_email             => 'altaddress_email',
1949         B_phone             => 'altaddress_phone',
1950         B_state             => 'altaddress_state',
1951         B_streetnumber      => 'altaddress_street_number',
1952         B_streettype        => 'altaddress_street_type',
1953         B_zipcode           => 'altaddress_postal_code',
1954         altcontactaddress1  => 'altcontact_address',
1955         altcontactaddress2  => 'altcontact_address2',
1956         altcontactaddress3  => 'altcontact_city',
1957         altcontactcountry   => 'altcontact_country',
1958         altcontactfirstname => 'altcontact_firstname',
1959         altcontactphone     => 'altcontact_phone',
1960         altcontactsurname   => 'altcontact_surname',
1961         altcontactstate     => 'altcontact_state',
1962         altcontactzipcode   => 'altcontact_postal_code',
1963         password_expiration_date => undef,
1964         primary_contact_method => undef,
1965         secret              => undef,
1966         auth_method         => undef,
1967     };
1968 }
1969
1970 =head3 queue_notice
1971
1972     Koha::Patrons->queue_notice({ letter_params => $letter_params, message_name => 'DUE'});
1973     Koha::Patrons->queue_notice({ letter_params => $letter_params, message_transports => \@message_transports });
1974     Koha::Patrons->queue_notice({ letter_params => $letter_params, message_transports => \@message_transports, test_mode => 1 });
1975
1976     Queue messages to a patron. Can pass a message that is part of the message_attributes
1977     table or supply the transport to use.
1978
1979     If passed a message name we retrieve the patrons preferences for transports
1980     Otherwise we use the supplied transport. In the case of email or sms we fall back to print if
1981     we have no address/number for sending
1982
1983     $letter_params is a hashref of the values to be passed to GetPreparedLetter
1984
1985     test_mode will only report which notices would be sent, but nothing will be queued
1986
1987 =cut
1988
1989 sub queue_notice {
1990     my ( $self, $params ) = @_;
1991     my $letter_params = $params->{letter_params};
1992     my $test_mode = $params->{test_mode};
1993
1994     return unless $letter_params;
1995     return unless exists $params->{message_name} xor $params->{message_transports}; # We only want one of these
1996
1997     my $library = Koha::Libraries->find( $letter_params->{branchcode} );
1998     my $from_email_address = $library->from_email_address;
1999
2000     my @message_transports;
2001     my $letter_code;
2002     $letter_code = $letter_params->{letter_code};
2003     if( $params->{message_name} ){
2004         my $messaging_prefs = C4::Members::Messaging::GetMessagingPreferences( {
2005                 borrowernumber => $letter_params->{borrowernumber},
2006                 message_name => $params->{message_name}
2007         } );
2008         @message_transports = ( keys %{ $messaging_prefs->{transports} } );
2009         $letter_code = $messaging_prefs->{transports}->{$message_transports[0]} unless $letter_code;
2010     } else {
2011         @message_transports = @{$params->{message_transports}};
2012     }
2013     return unless defined $letter_code;
2014     $letter_params->{letter_code} = $letter_code;
2015     my $print_sent = 0;
2016     my %return;
2017     foreach my $mtt (@message_transports){
2018         next if ($mtt eq 'itiva' and C4::Context->preference('TalkingTechItivaPhoneNotification') );
2019         # Notice is handled by TalkingTech_itiva_outbound.pl
2020         if (   ( $mtt eq 'email' and not $self->notice_email_address )
2021             or ( $mtt eq 'sms'   and not $self->smsalertnumber )
2022             or ( $mtt eq 'phone' and not $self->phone ) )
2023         {
2024             push @{ $return{fallback} }, $mtt;
2025             $mtt = 'print';
2026         }
2027         next if $mtt eq 'print' && $print_sent;
2028         $letter_params->{message_transport_type} = $mtt;
2029         my $letter = C4::Letters::GetPreparedLetter( %$letter_params );
2030         C4::Letters::EnqueueLetter({
2031             letter => $letter,
2032             borrowernumber => $self->borrowernumber,
2033             from_address   => $from_email_address,
2034             message_transport_type => $mtt
2035         }) unless $test_mode;
2036         push @{$return{sent}}, $mtt;
2037         $print_sent = 1 if $mtt eq 'print';
2038     }
2039     return \%return;
2040 }
2041
2042 =head3 safe_to_delete
2043
2044     my $result = $patron->safe_to_delete;
2045     if ( $result eq 'has_guarantees' ) { ... }
2046     elsif ( $result ) { ... }
2047     else { # cannot delete }
2048
2049 This method tells if the Koha:Patron object can be deleted. Possible return values
2050
2051 =over 4
2052
2053 =item 'ok'
2054
2055 =item 'has_checkouts'
2056
2057 =item 'has_debt'
2058
2059 =item 'has_guarantees'
2060
2061 =item 'is_anonymous_patron'
2062
2063 =back
2064
2065 =cut
2066
2067 sub safe_to_delete {
2068     my ($self) = @_;
2069
2070     my $anonymous_patron = C4::Context->preference('AnonymousPatron');
2071
2072     my $error;
2073
2074     if ( $anonymous_patron && $self->id eq $anonymous_patron ) {
2075         $error = 'is_anonymous_patron';
2076     }
2077     elsif ( $self->checkouts->count ) {
2078         $error = 'has_checkouts';
2079     }
2080     elsif ( $self->account->outstanding_debits->total_outstanding > 0 ) {
2081         $error = 'has_debt';
2082     }
2083     elsif ( $self->guarantee_relationships->count ) {
2084         $error = 'has_guarantees';
2085     }
2086
2087     if ( $error ) {
2088         return Koha::Result::Boolean->new(0)->add_message({ message => $error });
2089     }
2090
2091     return Koha::Result::Boolean->new(1);
2092 }
2093
2094 =head3 recalls
2095
2096     my $recalls = $patron->recalls;
2097
2098 Return the patron's recalls.
2099
2100 =cut
2101
2102 sub recalls {
2103     my ( $self ) = @_;
2104
2105     return Koha::Recalls->search({ patron_id => $self->borrowernumber });
2106 }
2107
2108 =head3 account_balance
2109
2110     my $balance = $patron->account_balance
2111
2112 Return the patron's account balance
2113
2114 =cut
2115
2116 sub account_balance {
2117     my ($self) = @_;
2118     return $self->account->balance;
2119 }
2120
2121
2122 =head3 has_messaging_preference
2123
2124 my $bool = $patron->has_messaging_preference({
2125     message_name => $message_name, # A value from message_attributes.message_name
2126     message_transport_type => $message_transport_type, # email, sms, phone, itiva, etc...
2127     wants_digest => $wants_digest, # 1 if you are looking for the digest version, don't pass if you just want either
2128 });
2129
2130 =cut
2131
2132 sub has_messaging_preference {
2133     my ( $self, $params ) = @_;
2134
2135     my $message_name           = $params->{message_name};
2136     my $message_transport_type = $params->{message_transport_type};
2137     my $wants_digest           = $params->{wants_digest};
2138
2139     return $self->_result->search_related_rs(
2140         'borrower_message_preferences',
2141         $params,
2142         {
2143             prefetch =>
2144               [ 'borrower_message_transport_preferences', 'message_attribute' ]
2145         }
2146     )->count;
2147 }
2148
2149 =head3 can_patron_change_staff_only_lists
2150
2151 $patron->can_patron_change_staff_only_lists;
2152
2153 Return 1 if a patron has 'Superlibrarian' or 'Catalogue' permission.
2154 Otherwise, return 0.
2155
2156 =cut
2157
2158 sub can_patron_change_staff_only_lists {
2159     my ( $self, $params ) = @_;
2160     return 1 if C4::Auth::haspermission( $self->userid, { 'catalogue' => 1 });
2161     return 0;
2162 }
2163
2164 =head3 encode_secret
2165
2166   $patron->encode_secret($secret32);
2167
2168 Secret (TwoFactorAuth expects it in base32 format) is encrypted.
2169 You still need to call ->store.
2170
2171 =cut
2172
2173 sub encode_secret {
2174     my ( $self, $secret ) = @_;
2175     if( $secret ) {
2176         return $self->secret( Koha::Encryption->new->encrypt_hex($secret) );
2177     }
2178     return $self->secret($secret);
2179 }
2180
2181 =head3 decoded_secret
2182
2183   my $secret32 = $patron->decoded_secret;
2184
2185 Decode the patron secret. We expect to get back a base32 string, but this
2186 is not checked here. Caller of encode_secret is responsible for that.
2187
2188 =cut
2189
2190 sub decoded_secret {
2191     my ( $self ) = @_;
2192     if( $self->secret ) {
2193         return Koha::Encryption->new->decrypt_hex( $self->secret );
2194     }
2195     return $self->secret;
2196 }
2197
2198 =head2 update_lastseen
2199
2200     $patron->update_lastseen();
2201
2202     Patron method to update lastseen field in borrower
2203     to record that patron has been seen via sip connection
2204
2205 =cut
2206
2207 sub update_lastseen {
2208     my ( $self ) = @_;
2209     $self->track_login;
2210 }
2211
2212 =head2 Internal methods
2213
2214 =head3 _type
2215
2216 =cut
2217
2218 sub _type {
2219     return 'Borrower';
2220 }
2221
2222 =head1 AUTHORS
2223
2224 Kyle M Hall <kyle@bywatersolutions.com>
2225 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
2226 Martin Renvoize <martin.renvoize@ptfs-europe.com>
2227
2228 =cut
2229
2230 1;