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( uniq );
  25 use JSON qw( to_json );
  26 use Text::Unaccent qw( unac_string );
  27
  28 use C4::Accounts;
  29 use C4::Context;
  30 use C4::Log;
  31 use Koha::AuthUtils;
  32 use Koha::Checkouts;
  33 use Koha::Database;
  34 use Koha::DateUtils;
  35 use Koha::Holds;
  36 use Koha::Old::Checkouts;
  37 use Koha::Patron::Categories;
  38 use Koha::Patron::HouseboundProfile;
  39 use Koha::Patron::HouseboundRole;
  40 use Koha::Patron::Images;
  41 use Koha::Patrons;
  42 use Koha::Virtualshelves;
  43 use Koha::Club::Enrollments;
  44 use Koha::Account;
  45 use Koha::Subscription::Routinglists;
  46
  47 use base qw(Koha::Object);
  48
  49 our $RESULTSET_PATRON_ID_MAPPING = {
  50     Accountline          => 'borrowernumber',
  51     Aqbasketuser         => 'borrowernumber',
  52     Aqbudget             => 'budget_owner_id',
  53     Aqbudgetborrower     => 'borrowernumber',
  54     ArticleRequest       => 'borrowernumber',
  55     BorrowerAttribute    => 'borrowernumber',
  56     BorrowerDebarment    => 'borrowernumber',
  57     BorrowerFile         => 'borrowernumber',
  58     BorrowerModification => 'borrowernumber',
  59     ClubEnrollment       => 'borrowernumber',
  60     Issue                => 'borrowernumber',
  61     ItemsLastBorrower    => 'borrowernumber',
  62     Linktracker          => 'borrowernumber',
  63     Message              => 'borrowernumber',
  64     MessageQueue         => 'borrowernumber',
  65     OldIssue             => 'borrowernumber',
  66     OldReserve           => 'borrowernumber',
  67     Rating               => 'borrowernumber',
  68     Reserve              => 'borrowernumber',
  69     Review               => 'borrowernumber',
  70     SearchHistory        => 'userid',
  71     Statistic            => 'borrowernumber',
  72     Suggestion           => 'suggestedby',
  73     TagAll               => 'borrowernumber',
  74     Virtualshelfcontent  => 'borrowernumber',
  75     Virtualshelfshare    => 'borrowernumber',
  76     Virtualshelve        => 'owner',
  77 };
  78
  79 =head1 NAME
  80
  81 Koha::Patron - Koha Patron Object class
  82
  83 =head1 API
  84
  85 =head2 Class Methods
  86
  87 =cut
  88
  89 =head3 new
  90
  91 =cut
  92
  93 sub new {
  94     my ( $class, $params ) = @_;
  95
  96     return $class->SUPER::new($params);
  97 }
  98
  99 =head3 fixup_cardnumber
 100
 101 Autogenerate next cardnumber from highest value found in database
 102
 103 =cut
 104
 105 sub fixup_cardnumber {
 106     my ( $self ) = @_;
 107     my $max = Koha::Patrons->search({
 108         cardnumber => {-regexp => '^-?[0-9]+$'}
 109     }, {
 110         select => \'CAST(cardnumber AS SIGNED)',
 111         as => ['cast_cardnumber']
 112     })->_resultset->get_column('cast_cardnumber')->max;
 113     $self->cardnumber(($max || 0) +1);
 114 }
 115
 116 =head3 trim_whitespace
 117
 118 trim whitespace from data which has some non-whitespace in it.
 119 Could be moved to Koha::Object if need to be reused
 120
 121 =cut
 122
 123 sub trim_whitespaces {
 124     my( $self ) = @_;
 125
 126     my $schema  = Koha::Database->new->schema;
 127     my @columns = $schema->source($self->_type)->columns;
 128
 129     for my $column( @columns ) {
 130         my $value = $self->$column;
 131         if ( defined $value ) {
 132             $value =~ s/^\s*|\s*$//g;
 133             $self->$column($value);
 134         }
 135     }
 136     return $self;
 137 }
 138
 139 =head3 plain_text_password
 140
 141 $patron->plain_text_password( $password );
 142
 143 stores a copy of the unencrypted password in the object
 144 for use in code before encrypting for db
 145
 146 =cut
 147
 148 sub plain_text_password {
 149     my ( $self, $password ) = @_;
 150     if ( $password ) {
 151         $self->{_plain_text_password} = $password;
 152         return $self;
 153     }
 154     return $self->{_plain_text_password}
 155         if $self->{_plain_text_password};
 156
 157     return;
 158 }
 159
 160 =head3 store
 161
 162 Patron specific store method to cleanup record
 163 and do other necessary things before saving
 164 to db
 165
 166 =cut
 167
 168 sub store {
 169     my ($self) = @_;
 170
 171     $self->_result->result_source->schema->txn_do(
 172         sub {
 173             if (
 174                 C4::Context->preference("autoMemberNum")
 175                 and ( not defined $self->cardnumber
 176                     or $self->cardnumber eq '' )
 177               )
 178             {
 179                 # Warning: The caller is responsible for locking the members table in write
 180                 # mode, to avoid database corruption.
 181                 # We are in a transaction but the table is not locked
 182                 $self->fixup_cardnumber;
 183             }
 184
 185             unless( $self->category->in_storage ) {
 186                 Koha::Exceptions::Object::FKConstraint->throw(
 187                     broken_fk => 'categorycode',
 188                     value     => $self->categorycode,
 189                 );
 190             }
 191
 192             $self->trim_whitespaces;
 193
 194             # We don't want invalid dates in the db (mysql has a bad habit of inserting 0000-00-00)
 195             $self->dateofbirth(undef) unless $self->dateofbirth;
 196             $self->debarred(undef)    unless $self->debarred;
 197
 198             # Set default values if not set
 199             $self->sms_provider_id(undef) unless $self->sms_provider_id;
 200             $self->guarantorid(undef)     unless $self->guarantorid;
 201
 202             unless ( $self->in_storage ) {    #AddMember
 203
 204                 # Generate a valid userid/login if needed
 205                 $self->generate_userid
 206                   if not $self->userid or not $self->has_valid_userid;
 207
 208                 # Add expiration date if it isn't already there
 209                 unless ( $self->dateexpiry ) {
 210                     $self->dateexpiry( $self->category->get_expiry_date );
 211                 }
 212
 213                 # Add enrollment date if it isn't already there
 214                 unless ( $self->dateenrolled ) {
 215                     $self->dateenrolled(dt_from_string);
 216                 }
 217
 218                 # Set the privacy depending on the patron's category
 219                 my $default_privacy = $self->category->default_privacy || q{};
 220                 $default_privacy =
 221                     $default_privacy eq 'default' ? 1
 222                   : $default_privacy eq 'never'   ? 2
 223                   : $default_privacy eq 'forever' ? 0
 224                   :                                                   undef;
 225                 $self->privacy($default_privacy);
 226
 227                 unless ( defined $self->privacy_guarantor_checkouts ) {
 228                     $self->privacy_guarantor_checkouts(0);
 229                 }
 230
 231                 # Make a copy of the plain text password for later use
 232                 $self->plain_text_password( $self->password );
 233
 234                 # Create a disabled account if no password provided
 235                 $self->password( $self->password
 236                     ? Koha::AuthUtils::hash_password( $self->password )
 237                     : '!' );
 238
 239                 $self->borrowernumber(undef);
 240
 241                 $self = $self->SUPER::store;
 242
 243                 $self->add_enrolment_fee_if_needed;
 244
 245                 logaction( "MEMBERS", "CREATE", $self->borrowernumber, "" )
 246                   if C4::Context->preference("BorrowersLog");
 247             }
 248             else {    #ModMember
 249
 250                 # Come from ModMember, but should not be possible (?)
 251                 $self->dateenrolled(undef) unless $self->dateenrolled;
 252                 $self->dateexpiry(undef)   unless $self->dateexpiry;
 253
 254
 255                 my $self_from_storage = $self->get_from_storage;
 256                 # FIXME We should not deal with that here, callers have to do this job
 257                 # Moved from ModMember to prevent regressions
 258                 unless ( $self->userid ) {
 259                     my $stored_userid = $self_from_storage->userid;
 260                     $self->userid($stored_userid);
 261                 }
 262
 263                 # Password must be updated using $self->update_password
 264                 $self->password($self_from_storage->password);
 265
 266                 if ( C4::Context->preference('FeeOnChangePatronCategory')
 267                     and $self->category->categorycode ne
 268                     $self_from_storage->category->categorycode )
 269                 {
 270                     $self->add_enrolment_fee_if_needed;
 271                 }
 272
 273                 my $borrowers_log = C4::Context->preference("BorrowersLog");
 274                 my $previous_cardnumber = $self_from_storage->cardnumber;
 275                 if ($borrowers_log
 276                     && ( !defined $previous_cardnumber
 277                         || $previous_cardnumber ne $self->cardnumber )
 278                     )
 279                 {
 280                     logaction(
 281                         "MEMBERS",
 282                         "MODIFY",
 283                         $self->borrowernumber,
 284                         to_json(
 285                             {
 286                                 cardnumber_replaced => {
 287                                     previous_cardnumber => $previous_cardnumber,
 288                                     new_cardnumber      => $self->cardnumber,
 289                                 }
 290                             },
 291                             { utf8 => 1, pretty => 1 }
 292                         )
 293                     );
 294                 }
 295
 296                 logaction( "MEMBERS", "MODIFY", $self->borrowernumber,
 297                     "UPDATE (executed w/ arg: " . $self->borrowernumber . ")" )
 298                   if $borrowers_log;
 299
 300                 $self = $self->SUPER::store;
 301             }
 302         }
 303     );
 304     return $self;
 305 }
 306
 307 =head3 delete
 308
 309 $patron->delete
 310
 311 Delete patron's holds, lists and finally the patron.
 312
 313 Lists owned by the borrower are deleted, but entries from the borrower to
 314 other lists are kept.
 315
 316 =cut
 317
 318 sub delete {
 319     my ($self) = @_;
 320
 321     my $deleted;
 322     $self->_result->result_source->schema->txn_do(
 323         sub {
 324             # Delete Patron's holds
 325             $self->holds->delete;
 326
 327             # Delete all lists and all shares of this borrower
 328             # Consistent with the approach Koha uses on deleting individual lists
 329             # Note that entries in virtualshelfcontents added by this borrower to
 330             # lists of others will be handled by a table constraint: the borrower
 331             # is set to NULL in those entries.
 332             # NOTE:
 333             # We could handle the above deletes via a constraint too.
 334             # But a new BZ report 11889 has been opened to discuss another approach.
 335             # Instead of deleting we could also disown lists (based on a pref).
 336             # In that way we could save shared and public lists.
 337             # The current table constraints support that idea now.
 338             # This pref should then govern the results of other routines/methods such as
 339             # Koha::Virtualshelf->new->delete too.
 340             # FIXME Could be $patron->get_lists
 341             $_->delete for Koha::Virtualshelves->search( { owner => $self->borrowernumber } );
 342
 343             $deleted = $self->SUPER::delete;
 344
 345             logaction( "MEMBERS", "DELETE", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog");
 346         }
 347     );
 348     return $deleted;
 349 }
 350
 351
 352 =head3 category
 353
 354 my $patron_category = $patron->category
 355
 356 Return the patron category for this patron
 357
 358 =cut
 359
 360 sub category {
 361     my ( $self ) = @_;
 362     return Koha::Patron::Category->_new_from_dbic( $self->_result->categorycode );
 363 }
 364
 365 =head3 guarantor
 366
 367 Returns a Koha::Patron object for this patron's guarantor
 368
 369 =cut
 370
 371 sub guarantor {
 372     my ( $self ) = @_;
 373
 374     return unless $self->guarantorid();
 375
 376     return Koha::Patrons->find( $self->guarantorid() );
 377 }
 378
 379 sub image {
 380     my ( $self ) = @_;
 381
 382     return scalar Koha::Patron::Images->find( $self->borrowernumber );
 383 }
 384
 385 sub library {
 386     my ( $self ) = @_;
 387     return Koha::Library->_new_from_dbic($self->_result->branchcode);
 388 }
 389
 390 =head3 guarantees
 391
 392 Returns the guarantees (list of Koha::Patron) of this patron
 393
 394 =cut
 395
 396 sub guarantees {
 397     my ( $self ) = @_;
 398
 399     return Koha::Patrons->search( { guarantorid => $self->borrowernumber }, { order_by => { -asc => ['surname','firstname'] } } );
 400 }
 401
 402 =head3 housebound_profile
 403
 404 Returns the HouseboundProfile associated with this patron.
 405
 406 =cut
 407
 408 sub housebound_profile {
 409     my ( $self ) = @_;
 410     my $profile = $self->_result->housebound_profile;
 411     return Koha::Patron::HouseboundProfile->_new_from_dbic($profile)
 412         if ( $profile );
 413     return;
 414 }
 415
 416 =head3 housebound_role
 417
 418 Returns the HouseboundRole associated with this patron.
 419
 420 =cut
 421
 422 sub housebound_role {
 423     my ( $self ) = @_;
 424
 425     my $role = $self->_result->housebound_role;
 426     return Koha::Patron::HouseboundRole->_new_from_dbic($role) if ( $role );
 427     return;
 428 }
 429
 430 =head3 siblings
 431
 432 Returns the siblings of this patron.
 433
 434 =cut
 435
 436 sub siblings {
 437     my ( $self ) = @_;
 438
 439     my $guarantor = $self->guarantor;
 440
 441     return unless $guarantor;
 442
 443     return Koha::Patrons->search(
 444         {
 445             guarantorid => {
 446                 '!=' => undef,
 447                 '=' => $guarantor->id,
 448             },
 449             borrowernumber => {
 450                 '!=' => $self->borrowernumber,
 451             }
 452         }
 453     );
 454 }
 455
 456 =head3 merge_with
 457
 458     my $patron = Koha::Patrons->find($id);
 459     $patron->merge_with( \@patron_ids );
 460
 461     This subroutine merges a list of patrons into the patron record. This is accomplished by finding
 462     all related patron ids for the patrons to be merged in other tables and changing the ids to be that
 463     of the keeper patron.
 464
 465 =cut
 466
 467 sub merge_with {
 468     my ( $self, $patron_ids ) = @_;
 469
 470     my @patron_ids = @{ $patron_ids };
 471
 472     # Ensure the keeper isn't in the list of patrons to merge
 473     @patron_ids = grep { $_ ne $self->id } @patron_ids;
 474
 475     my $schema = Koha::Database->new()->schema();
 476
 477     my $results;
 478
 479     $self->_result->result_source->schema->txn_do( sub {
 480         foreach my $patron_id (@patron_ids) {
 481             my $patron = Koha::Patrons->find( $patron_id );
 482
 483             next unless $patron;
 484
 485             # Unbless for safety, the patron will end up being deleted
 486             $results->{merged}->{$patron_id}->{patron} = $patron->unblessed;
 487
 488             while (my ($r, $field) = each(%$RESULTSET_PATRON_ID_MAPPING)) {
 489                 my $rs = $schema->resultset($r)->search({ $field => $patron_id });
 490                 $results->{merged}->{ $patron_id }->{updated}->{$r} = $rs->count();
 491                 $rs->update({ $field => $self->id });
 492             }
 493
 494             $patron->move_to_deleted();
 495             $patron->delete();
 496         }
 497     });
 498
 499     return $results;
 500 }
 501
 502
 503
 504 =head3 wants_check_for_previous_checkout
 505
 506     $wants_check = $patron->wants_check_for_previous_checkout;
 507
 508 Return 1 if Koha needs to perform PrevIssue checking, else 0.
 509
 510 =cut
 511
 512 sub wants_check_for_previous_checkout {
 513     my ( $self ) = @_;
 514     my $syspref = C4::Context->preference("checkPrevCheckout");
 515
 516     # Simple cases
 517     ## Hard syspref trumps all
 518     return 1 if ($syspref eq 'hardyes');
 519     return 0 if ($syspref eq 'hardno');
 520     ## Now, patron pref trumps all
 521     return 1 if ($self->checkprevcheckout eq 'yes');
 522     return 0 if ($self->checkprevcheckout eq 'no');
 523
 524     # More complex: patron inherits -> determine category preference
 525     my $checkPrevCheckoutByCat = $self->category->checkprevcheckout;
 526     return 1 if ($checkPrevCheckoutByCat eq 'yes');
 527     return 0 if ($checkPrevCheckoutByCat eq 'no');
 528
 529     # Finally: category preference is inherit, default to 0
 530     if ($syspref eq 'softyes') {
 531         return 1;
 532     } else {
 533         return 0;
 534     }
 535 }
 536
 537 =head3 do_check_for_previous_checkout
 538
 539     $do_check = $patron->do_check_for_previous_checkout($item);
 540
 541 Return 1 if the bib associated with $ITEM has previously been checked out to
 542 $PATRON, 0 otherwise.
 543
 544 =cut
 545
 546 sub do_check_for_previous_checkout {
 547     my ( $self, $item ) = @_;
 548
 549     # Find all items for bib and extract item numbers.
 550     my @items = Koha::Items->search({biblionumber => $item->{biblionumber}});
 551     my @item_nos;
 552     foreach my $item (@items) {
 553         push @item_nos, $item->itemnumber;
 554     }
 555
 556     # Create (old)issues search criteria
 557     my $criteria = {
 558         borrowernumber => $self->borrowernumber,
 559         itemnumber => \@item_nos,
 560     };
 561
 562     # Check current issues table
 563     my $issues = Koha::Checkouts->search($criteria);
 564     return 1 if $issues->count; # 0 || N
 565
 566     # Check old issues table
 567     my $old_issues = Koha::Old::Checkouts->search($criteria);
 568     return $old_issues->count;  # 0 || N
 569 }
 570
 571 =head3 is_debarred
 572
 573 my $debarment_expiration = $patron->is_debarred;
 574
 575 Returns the date a patron debarment will expire, or undef if the patron is not
 576 debarred
 577
 578 =cut
 579
 580 sub is_debarred {
 581     my ($self) = @_;
 582
 583     return unless $self->debarred;
 584     return $self->debarred
 585       if $self->debarred =~ '^9999'
 586       or dt_from_string( $self->debarred ) > dt_from_string;
 587     return;
 588 }
 589
 590 =head3 is_expired
 591
 592 my $is_expired = $patron->is_expired;
 593
 594 Returns 1 if the patron is expired or 0;
 595
 596 =cut
 597
 598 sub is_expired {
 599     my ($self) = @_;
 600     return 0 unless $self->dateexpiry;
 601     return 0 if $self->dateexpiry =~ '^9999';
 602     return 1 if dt_from_string( $self->dateexpiry ) < dt_from_string->truncate( to => 'day' );
 603     return 0;
 604 }
 605
 606 =head3 is_going_to_expire
 607
 608 my $is_going_to_expire = $patron->is_going_to_expire;
 609
 610 Returns 1 if the patron is going to expired, depending on the NotifyBorrowerDeparture pref or 0
 611
 612 =cut
 613
 614 sub is_going_to_expire {
 615     my ($self) = @_;
 616
 617     my $delay = C4::Context->preference('NotifyBorrowerDeparture') || 0;
 618
 619     return 0 unless $delay;
 620     return 0 unless $self->dateexpiry;
 621     return 0 if $self->dateexpiry =~ '^9999';
 622     return 1 if dt_from_string( $self->dateexpiry )->subtract( days => $delay ) < dt_from_string->truncate( to => 'day' );
 623     return 0;
 624 }
 625
 626 =head3 update_password
 627
 628 my $updated = $patron->update_password( $userid, $password );
 629
 630 Update the userid and the password of a patron.
 631 If the userid already exists, returns and let DBIx::Class warns
 632 This will add an entry to action_logs if BorrowersLog is set.
 633
 634 =cut
 635
 636 sub update_password {
 637     my ( $self, $userid, $password ) = @_;
 638     eval { $self->userid($userid)->store; };
 639     return if $@; # Make sure the userid is not already in used by another patron
 640
 641     return 0 if $password eq '****' or $password eq '';
 642
 643     my $digest = Koha::AuthUtils::hash_password($password);
 644     $self->update(
 645         {
 646             password       => $digest,
 647             login_attempts => 0,
 648         }
 649     );
 650
 651     logaction( "MEMBERS", "CHANGE PASS", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog");
 652     return $digest;
 653 }
 654
 655 =head3 renew_account
 656
 657 my $new_expiry_date = $patron->renew_account
 658
 659 Extending the subscription to the expiry date.
 660
 661 =cut
 662
 663 sub renew_account {
 664     my ($self) = @_;
 665     my $date;
 666     if ( C4::Context->preference('BorrowerRenewalPeriodBase') eq 'combination' ) {
 667         $date = ( dt_from_string gt dt_from_string( $self->dateexpiry ) ) ? dt_from_string : dt_from_string( $self->dateexpiry );
 668     } else {
 669         $date =
 670             C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry'
 671             ? dt_from_string( $self->dateexpiry )
 672             : dt_from_string;
 673     }
 674     my $expiry_date = $self->category->get_expiry_date($date);
 675
 676     $self->dateexpiry($expiry_date);
 677     $self->date_renewed( dt_from_string() );
 678     $self->store();
 679
 680     $self->add_enrolment_fee_if_needed;
 681
 682     logaction( "MEMBERS", "RENEW", $self->borrowernumber, "Membership renewed" ) if C4::Context->preference("BorrowersLog");
 683     return dt_from_string( $expiry_date )->truncate( to => 'day' );
 684 }
 685
 686 =head3 has_overdues
 687
 688 my $has_overdues = $patron->has_overdues;
 689
 690 Returns the number of patron's overdues
 691
 692 =cut
 693
 694 sub has_overdues {
 695     my ($self) = @_;
 696     my $dtf = Koha::Database->new->schema->storage->datetime_parser;
 697     return $self->_result->issues->search({ date_due => { '<' => $dtf->format_datetime( dt_from_string() ) } })->count;
 698 }
 699
 700 =head3 track_login
 701
 702     $patron->track_login;
 703     $patron->track_login({ force => 1 });
 704
 705     Tracks a (successful) login attempt.
 706     The preference TrackLastPatronActivity must be enabled. Or you
 707     should pass the force parameter.
 708
 709 =cut
 710
 711 sub track_login {
 712     my ( $self, $params ) = @_;
 713     return if
 714         !$params->{force} &&
 715         !C4::Context->preference('TrackLastPatronActivity');
 716     $self->lastseen( dt_from_string() )->store;
 717 }
 718
 719 =head3 move_to_deleted
 720
 721 my $is_moved = $patron->move_to_deleted;
 722
 723 Move a patron to the deletedborrowers table.
 724 This can be done before deleting a patron, to make sure the data are not completely deleted.
 725
 726 =cut
 727
 728 sub move_to_deleted {
 729     my ($self) = @_;
 730     my $patron_infos = $self->unblessed;
 731     delete $patron_infos->{updated_on}; #This ensures the updated_on date in deletedborrowers will be set to the current timestamp
 732     return Koha::Database->new->schema->resultset('Deletedborrower')->create($patron_infos);
 733 }
 734
 735 =head3 article_requests
 736
 737 my @requests = $borrower->article_requests();
 738 my $requests = $borrower->article_requests();
 739
 740 Returns either a list of ArticleRequests objects,
 741 or an ArtitleRequests object, depending on the
 742 calling context.
 743
 744 =cut
 745
 746 sub article_requests {
 747     my ( $self ) = @_;
 748
 749     $self->{_article_requests} ||= Koha::ArticleRequests->search({ borrowernumber => $self->borrowernumber() });
 750
 751     return $self->{_article_requests};
 752 }
 753
 754 =head3 article_requests_current
 755
 756 my @requests = $patron->article_requests_current
 757
 758 Returns the article requests associated with this patron that are incomplete
 759
 760 =cut
 761
 762 sub article_requests_current {
 763     my ( $self ) = @_;
 764
 765     $self->{_article_requests_current} ||= Koha::ArticleRequests->search(
 766         {
 767             borrowernumber => $self->id(),
 768             -or          => [
 769                 { status => Koha::ArticleRequest::Status::Pending },
 770                 { status => Koha::ArticleRequest::Status::Processing }
 771             ]
 772         }
 773     );
 774
 775     return $self->{_article_requests_current};
 776 }
 777
 778 =head3 article_requests_finished
 779
 780 my @requests = $biblio->article_requests_finished
 781
 782 Returns the article requests associated with this patron that are completed
 783
 784 =cut
 785
 786 sub article_requests_finished {
 787     my ( $self, $borrower ) = @_;
 788
 789     $self->{_article_requests_finished} ||= Koha::ArticleRequests->search(
 790         {
 791             borrowernumber => $self->id(),
 792             -or          => [
 793                 { status => Koha::ArticleRequest::Status::Completed },
 794                 { status => Koha::ArticleRequest::Status::Canceled }
 795             ]
 796         }
 797     );
 798
 799     return $self->{_article_requests_finished};
 800 }
 801
 802 =head3 add_enrolment_fee_if_needed
 803
 804 my $enrolment_fee = $patron->add_enrolment_fee_if_needed;
 805
 806 Add enrolment fee for a patron if needed.
 807
 808 =cut
 809
 810 sub add_enrolment_fee_if_needed {
 811     my ($self) = @_;
 812     my $enrolment_fee = $self->category->enrolmentfee;
 813     if ( $enrolment_fee && $enrolment_fee > 0 ) {
 814         # insert fee in patron debts
 815         C4::Accounts::manualinvoice( $self->borrowernumber, '', '', 'A', $enrolment_fee );
 816     }
 817     return $enrolment_fee || 0;
 818 }
 819
 820 =head3 checkouts
 821
 822 my $checkouts = $patron->checkouts
 823
 824 =cut
 825
 826 sub checkouts {
 827     my ($self) = @_;
 828     my $checkouts = $self->_result->issues;
 829     return Koha::Checkouts->_new_from_dbic( $checkouts );
 830 }
 831
 832 =head3 pending_checkouts
 833
 834 my $pending_checkouts = $patron->pending_checkouts
 835
 836 This method will return the same as $self->checkouts, but with a prefetch on
 837 items, biblio and biblioitems.
 838
 839 It has been introduced to replaced the C4::Members::GetPendingIssues subroutine
 840
 841 It should not be used directly, prefer to access fields you need instead of
 842 retrieving all these fields in one go.
 843
 844
 845 =cut
 846
 847 sub pending_checkouts {
 848     my( $self ) = @_;
 849     my $checkouts = $self->_result->issues->search(
 850         {},
 851         {
 852             order_by => [
 853                 { -desc => 'me.timestamp' },
 854                 { -desc => 'issuedate' },
 855                 { -desc => 'issue_id' }, # Sort by issue_id should be enough
 856             ],
 857             prefetch => { item => { biblio => 'biblioitems' } },
 858         }
 859     );
 860     return Koha::Checkouts->_new_from_dbic( $checkouts );
 861 }
 862
 863 =head3 old_checkouts
 864
 865 my $old_checkouts = $patron->old_checkouts
 866
 867 =cut
 868
 869 sub old_checkouts {
 870     my ($self) = @_;
 871     my $old_checkouts = $self->_result->old_issues;
 872     return Koha::Old::Checkouts->_new_from_dbic( $old_checkouts );
 873 }
 874
 875 =head3 get_overdues
 876
 877 my $overdue_items = $patron->get_overdues
 878
 879 Return the overdue items
 880
 881 =cut
 882
 883 sub get_overdues {
 884     my ($self) = @_;
 885     my $dtf = Koha::Database->new->schema->storage->datetime_parser;
 886     return $self->checkouts->search(
 887         {
 888             'me.date_due' => { '<' => $dtf->format_datetime(dt_from_string) },
 889         },
 890         {
 891             prefetch => { item => { biblio => 'biblioitems' } },
 892         }
 893     );
 894 }
 895
 896 =head3 get_routing_lists
 897
 898 my @routinglists = $patron->get_routing_lists
 899
 900 Returns the routing lists a patron is subscribed to.
 901
 902 =cut
 903
 904 sub get_routing_lists {
 905     my ($self) = @_;
 906     my $routing_list_rs = $self->_result->subscriptionroutinglists;
 907     return Koha::Subscription::Routinglists->_new_from_dbic($routing_list_rs);
 908 }
 909
 910 =head3 get_age
 911
 912 my $age = $patron->get_age
 913
 914 Return the age of the patron
 915
 916 =cut
 917
 918 sub get_age {
 919     my ($self)    = @_;
 920     my $today_str = dt_from_string->strftime("%Y-%m-%d");
 921     return unless $self->dateofbirth;
 922     my $dob_str   = dt_from_string( $self->dateofbirth )->strftime("%Y-%m-%d");
 923
 924     my ( $dob_y,   $dob_m,   $dob_d )   = split /-/, $dob_str;
 925     my ( $today_y, $today_m, $today_d ) = split /-/, $today_str;
 926
 927     my $age = $today_y - $dob_y;
 928     if ( $dob_m . $dob_d > $today_m . $today_d ) {
 929         $age--;
 930     }
 931
 932     return $age;
 933 }
 934
 935 =head3 account
 936
 937 my $account = $patron->account
 938
 939 =cut
 940
 941 sub account {
 942     my ($self) = @_;
 943     return Koha::Account->new( { patron_id => $self->borrowernumber } );
 944 }
 945
 946 =head3 holds
 947
 948 my $holds = $patron->holds
 949
 950 Return all the holds placed by this patron
 951
 952 =cut
 953
 954 sub holds {
 955     my ($self) = @_;
 956     my $holds_rs = $self->_result->reserves->search( {}, { order_by => 'reservedate' } );
 957     return Koha::Holds->_new_from_dbic($holds_rs);
 958 }
 959
 960 =head3 old_holds
 961
 962 my $old_holds = $patron->old_holds
 963
 964 Return all the historical holds for this patron
 965
 966 =cut
 967
 968 sub old_holds {
 969     my ($self) = @_;
 970     my $old_holds_rs = $self->_result->old_reserves->search( {}, { order_by => 'reservedate' } );
 971     return Koha::Old::Holds->_new_from_dbic($old_holds_rs);
 972 }
 973
 974 =head3 notice_email_address
 975
 976   my $email = $patron->notice_email_address;
 977
 978 Return the email address of patron used for notices.
 979 Returns the empty string if no email address.
 980
 981 =cut
 982
 983 sub notice_email_address{
 984     my ( $self ) = @_;
 985
 986     my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
 987     # if syspref is set to 'first valid' (value == OFF), look up email address
 988     if ( $which_address eq 'OFF' ) {
 989         return $self->first_valid_email_address;
 990     }
 991
 992     return $self->$which_address || '';
 993 }
 994
 995 =head3 first_valid_email_address
 996
 997 my $first_valid_email_address = $patron->first_valid_email_address
 998
 999 Return the first valid email address for a patron.
1000 For now, the order  is defined as email, emailpro, B_email.
1001 Returns the empty string if the borrower has no email addresses.
1002
1003 =cut
1004
1005 sub first_valid_email_address {
1006     my ($self) = @_;
1007
1008     return $self->email() || $self->emailpro() || $self->B_email() || q{};
1009 }
1010
1011 =head3 get_club_enrollments
1012
1013 =cut
1014
1015 sub get_club_enrollments {
1016     my ( $self, $return_scalar ) = @_;
1017
1018     my $e = Koha::Club::Enrollments->search( { borrowernumber => $self->borrowernumber(), date_canceled => undef } );
1019
1020     return $e if $return_scalar;
1021
1022     return wantarray ? $e->as_list : $e;
1023 }
1024
1025 =head3 get_enrollable_clubs
1026
1027 =cut
1028
1029 sub get_enrollable_clubs {
1030     my ( $self, $is_enrollable_from_opac, $return_scalar ) = @_;
1031
1032     my $params;
1033     $params->{is_enrollable_from_opac} = $is_enrollable_from_opac
1034       if $is_enrollable_from_opac;
1035     $params->{is_email_required} = 0 unless $self->first_valid_email_address();
1036
1037     $params->{borrower} = $self;
1038
1039     my $e = Koha::Clubs->get_enrollable($params);
1040
1041     return $e if $return_scalar;
1042
1043     return wantarray ? $e->as_list : $e;
1044 }
1045
1046 =head3 account_locked
1047
1048 my $is_locked = $patron->account_locked
1049
1050 Return true if the patron has reach the maximum number of login attempts (see pref FailedLoginAttempts).
1051 Otherwise return false.
1052 If the pref is not set (empty string, null or 0), the feature is considered as disabled.
1053
1054 =cut
1055
1056 sub account_locked {
1057     my ($self) = @_;
1058     my $FailedLoginAttempts = C4::Context->preference('FailedLoginAttempts');
1059     return ( $FailedLoginAttempts
1060           and $self->login_attempts
1061           and $self->login_attempts >= $FailedLoginAttempts )? 1 : 0;
1062 }
1063
1064 =head3 can_see_patron_infos
1065
1066 my $can_see = $patron->can_see_patron_infos( $patron );
1067
1068 Return true if the patron (usually the logged in user) can see the patron's infos for a given patron
1069
1070 =cut
1071
1072 sub can_see_patron_infos {
1073     my ( $self, $patron ) = @_;
1074     return $self->can_see_patrons_from( $patron->library->branchcode );
1075 }
1076
1077 =head3 can_see_patrons_from
1078
1079 my $can_see = $patron->can_see_patrons_from( $branchcode );
1080
1081 Return true if the patron (usually the logged in user) can see the patron's infos from a given library
1082
1083 =cut
1084
1085 sub can_see_patrons_from {
1086     my ( $self, $branchcode ) = @_;
1087     my $can = 0;
1088     if ( $self->branchcode eq $branchcode ) {
1089         $can = 1;
1090     } elsif ( $self->has_permission( { borrowers => 'view_borrower_infos_from_any_libraries' } ) ) {
1091         $can = 1;
1092     } elsif ( my $library_groups = $self->library->library_groups ) {
1093         while ( my $library_group = $library_groups->next ) {
1094             if ( $library_group->parent->has_child( $branchcode ) ) {
1095                 $can = 1;
1096                 last;
1097             }
1098         }
1099     }
1100     return $can;
1101 }
1102
1103 =head3 libraries_where_can_see_patrons
1104
1105 my $libraries = $patron-libraries_where_can_see_patrons;
1106
1107 Return the list of branchcodes(!) of libraries the patron is allowed to see other patron's infos.
1108 The branchcodes are arbitrarily returned sorted.
1109 We are supposing here that the object is related to the logged in patron (use of C4::Context::only_my_library)
1110
1111 An empty array means no restriction, the patron can see patron's infos from any libraries.
1112
1113 =cut
1114
1115 sub libraries_where_can_see_patrons {
1116     my ( $self ) = @_;
1117     my $userenv = C4::Context->userenv;
1118
1119     return () unless $userenv; # For tests, but userenv should be defined in tests...
1120
1121     my @restricted_branchcodes;
1122     if (C4::Context::only_my_library) {
1123         push @restricted_branchcodes, $self->branchcode;
1124     }
1125     else {
1126         unless (
1127             $self->has_permission(
1128                 { borrowers => 'view_borrower_infos_from_any_libraries' }
1129             )
1130           )
1131         {
1132             my $library_groups = $self->library->library_groups({ ft_hide_patron_info => 1 });
1133             if ( $library_groups->count )
1134             {
1135                 while ( my $library_group = $library_groups->next ) {
1136                     my $parent = $library_group->parent;
1137                     if ( $parent->has_child( $self->branchcode ) ) {
1138                         push @restricted_branchcodes, $parent->children->get_column('branchcode');
1139                     }
1140                 }
1141             }
1142
1143             @restricted_branchcodes = ( $self->branchcode ) unless @restricted_branchcodes;
1144         }
1145     }
1146
1147     @restricted_branchcodes = grep { defined $_ } @restricted_branchcodes;
1148     @restricted_branchcodes = uniq(@restricted_branchcodes);
1149     @restricted_branchcodes = sort(@restricted_branchcodes);
1150     return @restricted_branchcodes;
1151 }
1152
1153 sub has_permission {
1154     my ( $self, $flagsrequired ) = @_;
1155     return unless $self->userid;
1156     # TODO code from haspermission needs to be moved here!
1157     return C4::Auth::haspermission( $self->userid, $flagsrequired );
1158 }
1159
1160 =head3 is_adult
1161
1162 my $is_adult = $patron->is_adult
1163
1164 Return true if the patron has a category with a type Adult (A) or Organization (I)
1165
1166 =cut
1167
1168 sub is_adult {
1169     my ( $self ) = @_;
1170     return $self->category->category_type =~ /^(A|I)$/ ? 1 : 0;
1171 }
1172
1173 =head3 is_child
1174
1175 my $is_child = $patron->is_child
1176
1177 Return true if the patron has a category with a type Child (C)
1178
1179 =cut
1180 sub is_child {
1181     my( $self ) = @_;
1182     return $self->category->category_type eq 'C' ? 1 : 0;
1183 }
1184
1185 =head3 has_valid_userid
1186
1187 my $patron = Koha::Patrons->find(42);
1188 $patron->userid( $new_userid );
1189 my $has_a_valid_userid = $patron->has_valid_userid
1190
1191 my $patron = Koha::Patron->new( $params );
1192 my $has_a_valid_userid = $patron->has_valid_userid
1193
1194 Return true if the current userid of this patron is valid/unique, otherwise false.
1195
1196 Note that this should be done in $self->store instead and raise an exception if needed.
1197
1198 =cut
1199
1200 sub has_valid_userid {
1201     my ($self) = @_;
1202
1203     return 0 unless $self->userid;
1204
1205     return 0 if ( $self->userid eq C4::Context->config('user') );    # DB user
1206
1207     my $already_exists = Koha::Patrons->search(
1208         {
1209             userid => $self->userid,
1210             (
1211                 $self->in_storage
1212                 ? ( borrowernumber => { '!=' => $self->borrowernumber } )
1213                 : ()
1214             ),
1215         }
1216     )->count;
1217     return $already_exists ? 0 : 1;
1218 }
1219
1220 =head3 generate_userid
1221
1222 my $patron = Koha::Patron->new( $params );
1223 $patron->generate_userid
1224
1225 Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
1226
1227 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).
1228
1229 =cut
1230
1231 sub generate_userid {
1232     my ($self) = @_;
1233     my $offset = 0;
1234     my $firstname = $self->firstname // q{};
1235     my $surname = $self->surname // q{};
1236     #The script will "do" the following code and increment the $offset until the generated userid is unique
1237     do {
1238       $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1239       $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1240       my $userid = lc(($firstname)? "$firstname.$surname" : $surname);
1241       $userid = unac_string('utf-8',$userid);
1242       $userid .= $offset unless $offset == 0;
1243       $self->userid( $userid );
1244       $offset++;
1245      } while (! $self->has_valid_userid );
1246
1247      return $self;
1248
1249 }
1250
1251 =head2 Internal methods
1252
1253 =head3 _type
1254
1255 =cut
1256
1257 sub _type {
1258     return 'Borrower';
1259 }
1260
1261 =head1 AUTHOR
1262
1263 Kyle M Hall <kyle@bywatersolutions.com>
1264 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
1265
1266 =cut
1267
1268 1;