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 Text::Unaccent qw( unac_string );
  26
  27 use C4::Context;
  28 use C4::Log;
  29 use Koha::Checkouts;
  30 use Koha::Database;
  31 use Koha::DateUtils;
  32 use Koha::Holds;
  33 use Koha::Old::Checkouts;
  34 use Koha::Patron::Categories;
  35 use Koha::Patron::HouseboundProfile;
  36 use Koha::Patron::HouseboundRole;
  37 use Koha::Patron::Images;
  38 use Koha::Patrons;
  39 use Koha::Virtualshelves;
  40 use Koha::Club::Enrollments;
  41 use Koha::Account;
  42
  43 use base qw(Koha::Object);
  44
  45 =head1 NAME
  46
  47 Koha::Patron - Koha Patron Object class
  48
  49 =head1 API
  50
  51 =head2 Class Methods
  52
  53 =cut
  54
  55 =head3 delete
  56
  57 $patron->delete
  58
  59 Delete patron's holds, lists and finally the patron.
  60
  61 Lists owned by the borrower are deleted, but entries from the borrower to
  62 other lists are kept.
  63
  64 =cut
  65
  66 sub delete {
  67     my ($self) = @_;
  68
  69     my $deleted;
  70     $self->_result->result_source->schema->txn_do(
  71         sub {
  72             # Delete Patron's holds
  73             $self->holds->delete;
  74
  75             # Delete all lists and all shares of this borrower
  76             # Consistent with the approach Koha uses on deleting individual lists
  77             # Note that entries in virtualshelfcontents added by this borrower to
  78             # lists of others will be handled by a table constraint: the borrower
  79             # is set to NULL in those entries.
  80             # NOTE:
  81             # We could handle the above deletes via a constraint too.
  82             # But a new BZ report 11889 has been opened to discuss another approach.
  83             # Instead of deleting we could also disown lists (based on a pref).
  84             # In that way we could save shared and public lists.
  85             # The current table constraints support that idea now.
  86             # This pref should then govern the results of other routines/methods such as
  87             # Koha::Virtualshelf->new->delete too.
  88             # FIXME Could be $patron->get_lists
  89             $_->delete for Koha::Virtualshelves->search( { owner => $self->borrowernumber } );
  90
  91             $deleted = $self->SUPER::delete;
  92
  93             logaction( "MEMBERS", "DELETE", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog");
  94         }
  95     );
  96     return $deleted;
  97 }
  98
  99
 100 =head3 category
 101
 102 my $patron_category = $patron->category
 103
 104 Return the patron category for this patron
 105
 106 =cut
 107
 108 sub category {
 109     my ( $self ) = @_;
 110     return Koha::Patron::Category->_new_from_dbic( $self->_result->categorycode );
 111 }
 112
 113 =head3 guarantor
 114
 115 Returns a Koha::Patron object for this patron's guarantor
 116
 117 =cut
 118
 119 sub guarantor {
 120     my ( $self ) = @_;
 121
 122     return unless $self->guarantorid();
 123
 124     return Koha::Patrons->find( $self->guarantorid() );
 125 }
 126
 127 sub image {
 128     my ( $self ) = @_;
 129
 130     return scalar Koha::Patron::Images->find( $self->borrowernumber );
 131 }
 132
 133 sub library {
 134     my ( $self ) = @_;
 135     return Koha::Library->_new_from_dbic($self->_result->branchcode);
 136 }
 137
 138 =head3 guarantees
 139
 140 Returns the guarantees (list of Koha::Patron) of this patron
 141
 142 =cut
 143
 144 sub guarantees {
 145     my ( $self ) = @_;
 146
 147     return Koha::Patrons->search( { guarantorid => $self->borrowernumber } );
 148 }
 149
 150 =head3 housebound_profile
 151
 152 Returns the HouseboundProfile associated with this patron.
 153
 154 =cut
 155
 156 sub housebound_profile {
 157     my ( $self ) = @_;
 158     my $profile = $self->_result->housebound_profile;
 159     return Koha::Patron::HouseboundProfile->_new_from_dbic($profile)
 160         if ( $profile );
 161     return;
 162 }
 163
 164 =head3 housebound_role
 165
 166 Returns the HouseboundRole associated with this patron.
 167
 168 =cut
 169
 170 sub housebound_role {
 171     my ( $self ) = @_;
 172
 173     my $role = $self->_result->housebound_role;
 174     return Koha::Patron::HouseboundRole->_new_from_dbic($role) if ( $role );
 175     return;
 176 }
 177
 178 =head3 siblings
 179
 180 Returns the siblings of this patron.
 181
 182 =cut
 183
 184 sub siblings {
 185     my ( $self ) = @_;
 186
 187     my $guarantor = $self->guarantor;
 188
 189     return unless $guarantor;
 190
 191     return Koha::Patrons->search(
 192         {
 193             guarantorid => {
 194                 '!=' => undef,
 195                 '=' => $guarantor->id,
 196             },
 197             borrowernumber => {
 198                 '!=' => $self->borrowernumber,
 199             }
 200         }
 201     );
 202 }
 203
 204 =head3 wants_check_for_previous_checkout
 205
 206     $wants_check = $patron->wants_check_for_previous_checkout;
 207
 208 Return 1 if Koha needs to perform PrevIssue checking, else 0.
 209
 210 =cut
 211
 212 sub wants_check_for_previous_checkout {
 213     my ( $self ) = @_;
 214     my $syspref = C4::Context->preference("checkPrevCheckout");
 215
 216     # Simple cases
 217     ## Hard syspref trumps all
 218     return 1 if ($syspref eq 'hardyes');
 219     return 0 if ($syspref eq 'hardno');
 220     ## Now, patron pref trumps all
 221     return 1 if ($self->checkprevcheckout eq 'yes');
 222     return 0 if ($self->checkprevcheckout eq 'no');
 223
 224     # More complex: patron inherits -> determine category preference
 225     my $checkPrevCheckoutByCat = $self->category->checkprevcheckout;
 226     return 1 if ($checkPrevCheckoutByCat eq 'yes');
 227     return 0 if ($checkPrevCheckoutByCat eq 'no');
 228
 229     # Finally: category preference is inherit, default to 0
 230     if ($syspref eq 'softyes') {
 231         return 1;
 232     } else {
 233         return 0;
 234     }
 235 }
 236
 237 =head3 do_check_for_previous_checkout
 238
 239     $do_check = $patron->do_check_for_previous_checkout($item);
 240
 241 Return 1 if the bib associated with $ITEM has previously been checked out to
 242 $PATRON, 0 otherwise.
 243
 244 =cut
 245
 246 sub do_check_for_previous_checkout {
 247     my ( $self, $item ) = @_;
 248
 249     # Find all items for bib and extract item numbers.
 250     my @items = Koha::Items->search({biblionumber => $item->{biblionumber}});
 251     my @item_nos;
 252     foreach my $item (@items) {
 253         push @item_nos, $item->itemnumber;
 254     }
 255
 256     # Create (old)issues search criteria
 257     my $criteria = {
 258         borrowernumber => $self->borrowernumber,
 259         itemnumber => \@item_nos,
 260     };
 261
 262     # Check current issues table
 263     my $issues = Koha::Checkouts->search($criteria);
 264     return 1 if $issues->count; # 0 || N
 265
 266     # Check old issues table
 267     my $old_issues = Koha::Old::Checkouts->search($criteria);
 268     return $old_issues->count;  # 0 || N
 269 }
 270
 271 =head3 is_debarred
 272
 273 my $debarment_expiration = $patron->is_debarred;
 274
 275 Returns the date a patron debarment will expire, or undef if the patron is not
 276 debarred
 277
 278 =cut
 279
 280 sub is_debarred {
 281     my ($self) = @_;
 282
 283     return unless $self->debarred;
 284     return $self->debarred
 285       if $self->debarred =~ '^9999'
 286       or dt_from_string( $self->debarred ) > dt_from_string;
 287     return;
 288 }
 289
 290 =head3 is_expired
 291
 292 my $is_expired = $patron->is_expired;
 293
 294 Returns 1 if the patron is expired or 0;
 295
 296 =cut
 297
 298 sub is_expired {
 299     my ($self) = @_;
 300     return 0 unless $self->dateexpiry;
 301     return 0 if $self->dateexpiry =~ '^9999';
 302     return 1 if dt_from_string( $self->dateexpiry ) < dt_from_string->truncate( to => 'day' );
 303     return 0;
 304 }
 305
 306 =head3 is_going_to_expire
 307
 308 my $is_going_to_expire = $patron->is_going_to_expire;
 309
 310 Returns 1 if the patron is going to expired, depending on the NotifyBorrowerDeparture pref or 0
 311
 312 =cut
 313
 314 sub is_going_to_expire {
 315     my ($self) = @_;
 316
 317     my $delay = C4::Context->preference('NotifyBorrowerDeparture') || 0;
 318
 319     return 0 unless $delay;
 320     return 0 unless $self->dateexpiry;
 321     return 0 if $self->dateexpiry =~ '^9999';
 322     return 1 if dt_from_string( $self->dateexpiry )->subtract( days => $delay ) < dt_from_string->truncate( to => 'day' );
 323     return 0;
 324 }
 325
 326 =head3 update_password
 327
 328 my $updated = $patron->update_password( $userid, $password );
 329
 330 Update the userid and the password of a patron.
 331 If the userid already exists, returns and let DBIx::Class warns
 332 This will add an entry to action_logs if BorrowersLog is set.
 333
 334 =cut
 335
 336 sub update_password {
 337     my ( $self, $userid, $password ) = @_;
 338     eval { $self->userid($userid)->store; };
 339     return if $@; # Make sure the userid is not already in used by another patron
 340     $self->update(
 341         {
 342             password       => $password,
 343             login_attempts => 0,
 344         }
 345     );
 346     logaction( "MEMBERS", "CHANGE PASS", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog");
 347     return 1;
 348 }
 349
 350 =head3 renew_account
 351
 352 my $new_expiry_date = $patron->renew_account
 353
 354 Extending the subscription to the expiry date.
 355
 356 =cut
 357
 358 sub renew_account {
 359     my ($self) = @_;
 360     my $date;
 361     if ( C4::Context->preference('BorrowerRenewalPeriodBase') eq 'combination' ) {
 362         $date = ( dt_from_string gt dt_from_string( $self->dateexpiry ) ) ? dt_from_string : dt_from_string( $self->dateexpiry );
 363     } else {
 364         $date =
 365             C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry'
 366             ? dt_from_string( $self->dateexpiry )
 367             : dt_from_string;
 368     }
 369     my $expiry_date = $self->category->get_expiry_date($date);
 370
 371     $self->dateexpiry($expiry_date);
 372     $self->date_renewed( dt_from_string() );
 373     $self->store();
 374
 375     $self->add_enrolment_fee_if_needed;
 376
 377     logaction( "MEMBERS", "RENEW", $self->borrowernumber, "Membership renewed" ) if C4::Context->preference("BorrowersLog");
 378     return dt_from_string( $expiry_date )->truncate( to => 'day' );
 379 }
 380
 381 =head3 has_overdues
 382
 383 my $has_overdues = $patron->has_overdues;
 384
 385 Returns the number of patron's overdues
 386
 387 =cut
 388
 389 sub has_overdues {
 390     my ($self) = @_;
 391     my $dtf = Koha::Database->new->schema->storage->datetime_parser;
 392     return $self->_result->issues->search({ date_due => { '<' => $dtf->format_datetime( dt_from_string() ) } })->count;
 393 }
 394
 395 =head3 track_login
 396
 397     $patron->track_login;
 398     $patron->track_login({ force => 1 });
 399
 400     Tracks a (successful) login attempt.
 401     The preference TrackLastPatronActivity must be enabled. Or you
 402     should pass the force parameter.
 403
 404 =cut
 405
 406 sub track_login {
 407     my ( $self, $params ) = @_;
 408     return if
 409         !$params->{force} &&
 410         !C4::Context->preference('TrackLastPatronActivity');
 411     $self->lastseen( dt_from_string() )->store;
 412 }
 413
 414 =head3 move_to_deleted
 415
 416 my $is_moved = $patron->move_to_deleted;
 417
 418 Move a patron to the deletedborrowers table.
 419 This can be done before deleting a patron, to make sure the data are not completely deleted.
 420
 421 =cut
 422
 423 sub move_to_deleted {
 424     my ($self) = @_;
 425     my $patron_infos = $self->unblessed;
 426     delete $patron_infos->{updated_on}; #This ensures the updated_on date in deletedborrowers will be set to the current timestamp
 427     return Koha::Database->new->schema->resultset('Deletedborrower')->create($patron_infos);
 428 }
 429
 430 =head3 article_requests
 431
 432 my @requests = $borrower->article_requests();
 433 my $requests = $borrower->article_requests();
 434
 435 Returns either a list of ArticleRequests objects,
 436 or an ArtitleRequests object, depending on the
 437 calling context.
 438
 439 =cut
 440
 441 sub article_requests {
 442     my ( $self ) = @_;
 443
 444     $self->{_article_requests} ||= Koha::ArticleRequests->search({ borrowernumber => $self->borrowernumber() });
 445
 446     return $self->{_article_requests};
 447 }
 448
 449 =head3 article_requests_current
 450
 451 my @requests = $patron->article_requests_current
 452
 453 Returns the article requests associated with this patron that are incomplete
 454
 455 =cut
 456
 457 sub article_requests_current {
 458     my ( $self ) = @_;
 459
 460     $self->{_article_requests_current} ||= Koha::ArticleRequests->search(
 461         {
 462             borrowernumber => $self->id(),
 463             -or          => [
 464                 { status => Koha::ArticleRequest::Status::Pending },
 465                 { status => Koha::ArticleRequest::Status::Processing }
 466             ]
 467         }
 468     );
 469
 470     return $self->{_article_requests_current};
 471 }
 472
 473 =head3 article_requests_finished
 474
 475 my @requests = $biblio->article_requests_finished
 476
 477 Returns the article requests associated with this patron that are completed
 478
 479 =cut
 480
 481 sub article_requests_finished {
 482     my ( $self, $borrower ) = @_;
 483
 484     $self->{_article_requests_finished} ||= Koha::ArticleRequests->search(
 485         {
 486             borrowernumber => $self->id(),
 487             -or          => [
 488                 { status => Koha::ArticleRequest::Status::Completed },
 489                 { status => Koha::ArticleRequest::Status::Canceled }
 490             ]
 491         }
 492     );
 493
 494     return $self->{_article_requests_finished};
 495 }
 496
 497 =head3 add_enrolment_fee_if_needed
 498
 499 my $enrolment_fee = $patron->add_enrolment_fee_if_needed;
 500
 501 Add enrolment fee for a patron if needed.
 502
 503 =cut
 504
 505 sub add_enrolment_fee_if_needed {
 506     my ($self) = @_;
 507     my $enrolment_fee = $self->category->enrolmentfee;
 508     if ( $enrolment_fee && $enrolment_fee > 0 ) {
 509         # insert fee in patron debts
 510         C4::Accounts::manualinvoice( $self->borrowernumber, '', '', 'A', $enrolment_fee );
 511     }
 512     return $enrolment_fee || 0;
 513 }
 514
 515 =head3 checkouts
 516
 517 my $checkouts = $patron->checkouts
 518
 519 =cut
 520
 521 sub checkouts {
 522     my ($self) = @_;
 523     my $checkouts = $self->_result->issues;
 524     return Koha::Checkouts->_new_from_dbic( $checkouts );
 525 }
 526
 527 =head3 pending_checkouts
 528
 529 my $pending_checkouts = $patron->pending_checkouts
 530
 531 This method will return the same as $self->checkouts, but with a prefetch on
 532 items, biblio and biblioitems.
 533
 534 It has been introduced to replaced the C4::Members::GetPendingIssues subroutine
 535
 536 It should not be used directly, prefer to access fields you need instead of
 537 retrieving all these fields in one go.
 538
 539
 540 =cut
 541
 542 sub pending_checkouts {
 543     my( $self ) = @_;
 544     my $checkouts = $self->_result->issues->search(
 545         {},
 546         {
 547             order_by => [
 548                 { -desc => 'me.timestamp' },
 549                 { -desc => 'issuedate' },
 550                 { -desc => 'issue_id' }, # Sort by issue_id should be enough
 551             ],
 552             prefetch => { item => { biblio => 'biblioitems' } },
 553         }
 554     );
 555     return Koha::Checkouts->_new_from_dbic( $checkouts );
 556 }
 557
 558 =head3 old_checkouts
 559
 560 my $old_checkouts = $patron->old_checkouts
 561
 562 =cut
 563
 564 sub old_checkouts {
 565     my ($self) = @_;
 566     my $old_checkouts = $self->_result->old_issues;
 567     return Koha::Old::Checkouts->_new_from_dbic( $old_checkouts );
 568 }
 569
 570 =head3 get_overdues
 571
 572 my $overdue_items = $patron->get_overdues
 573
 574 Return the overdued items
 575
 576 =cut
 577
 578 sub get_overdues {
 579     my ($self) = @_;
 580     my $dtf = Koha::Database->new->schema->storage->datetime_parser;
 581     return $self->checkouts->search(
 582         {
 583             'me.date_due' => { '<' => $dtf->format_datetime(dt_from_string) },
 584         },
 585         {
 586             prefetch => { item => { biblio => 'biblioitems' } },
 587         }
 588     );
 589 }
 590
 591 =head3 get_age
 592
 593 my $age = $patron->get_age
 594
 595 Return the age of the patron
 596
 597 =cut
 598
 599 sub get_age {
 600     my ($self)    = @_;
 601     my $today_str = dt_from_string->strftime("%Y-%m-%d");
 602     return unless $self->dateofbirth;
 603     my $dob_str   = dt_from_string( $self->dateofbirth )->strftime("%Y-%m-%d");
 604
 605     my ( $dob_y,   $dob_m,   $dob_d )   = split /-/, $dob_str;
 606     my ( $today_y, $today_m, $today_d ) = split /-/, $today_str;
 607
 608     my $age = $today_y - $dob_y;
 609     if ( $dob_m . $dob_d > $today_m . $today_d ) {
 610         $age--;
 611     }
 612
 613     return $age;
 614 }
 615
 616 =head3 account
 617
 618 my $account = $patron->account
 619
 620 =cut
 621
 622 sub account {
 623     my ($self) = @_;
 624     return Koha::Account->new( { patron_id => $self->borrowernumber } );
 625 }
 626
 627 =head3 holds
 628
 629 my $holds = $patron->holds
 630
 631 Return all the holds placed by this patron
 632
 633 =cut
 634
 635 sub holds {
 636     my ($self) = @_;
 637     my $holds_rs = $self->_result->reserves->search( {}, { order_by => 'reservedate' } );
 638     return Koha::Holds->_new_from_dbic($holds_rs);
 639 }
 640
 641 =head3 old_holds
 642
 643 my $old_holds = $patron->old_holds
 644
 645 Return all the historical holds for this patron
 646
 647 =cut
 648
 649 sub old_holds {
 650     my ($self) = @_;
 651     my $old_holds_rs = $self->_result->old_reserves->search( {}, { order_by => 'reservedate' } );
 652     return Koha::Old::Holds->_new_from_dbic($old_holds_rs);
 653 }
 654
 655 =head3 notice_email_address
 656
 657   my $email = $patron->notice_email_address;
 658
 659 Return the email address of patron used for notices.
 660 Returns the empty string if no email address.
 661
 662 =cut
 663
 664 sub notice_email_address{
 665     my ( $self ) = @_;
 666
 667     my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
 668     # if syspref is set to 'first valid' (value == OFF), look up email address
 669     if ( $which_address eq 'OFF' ) {
 670         return $self->first_valid_email_address;
 671     }
 672
 673     return $self->$which_address || '';
 674 }
 675
 676 =head3 first_valid_email_address
 677
 678 my $first_valid_email_address = $patron->first_valid_email_address
 679
 680 Return the first valid email address for a patron.
 681 For now, the order  is defined as email, emailpro, B_email.
 682 Returns the empty string if the borrower has no email addresses.
 683
 684 =cut
 685
 686 sub first_valid_email_address {
 687     my ($self) = @_;
 688
 689     return $self->email() || $self->emailpro() || $self->B_email() || q{};
 690 }
 691
 692 =head3 get_club_enrollments
 693
 694 =cut
 695
 696 sub get_club_enrollments {
 697     my ( $self, $return_scalar ) = @_;
 698
 699     my $e = Koha::Club::Enrollments->search( { borrowernumber => $self->borrowernumber(), date_canceled => undef } );
 700
 701     return $e if $return_scalar;
 702
 703     return wantarray ? $e->as_list : $e;
 704 }
 705
 706 =head3 get_enrollable_clubs
 707
 708 =cut
 709
 710 sub get_enrollable_clubs {
 711     my ( $self, $is_enrollable_from_opac, $return_scalar ) = @_;
 712
 713     my $params;
 714     $params->{is_enrollable_from_opac} = $is_enrollable_from_opac
 715       if $is_enrollable_from_opac;
 716     $params->{is_email_required} = 0 unless $self->first_valid_email_address();
 717
 718     $params->{borrower} = $self;
 719
 720     my $e = Koha::Clubs->get_enrollable($params);
 721
 722     return $e if $return_scalar;
 723
 724     return wantarray ? $e->as_list : $e;
 725 }
 726
 727 =head3 account_locked
 728
 729 my $is_locked = $patron->account_locked
 730
 731 Return true if the patron has reach the maximum number of login attempts (see pref FailedLoginAttempts).
 732 Otherwise return false.
 733 If the pref is not set (empty string, null or 0), the feature is considered as disabled.
 734
 735 =cut
 736
 737 sub account_locked {
 738     my ($self) = @_;
 739     my $FailedLoginAttempts = C4::Context->preference('FailedLoginAttempts');
 740     return ( $FailedLoginAttempts
 741           and $self->login_attempts
 742           and $self->login_attempts >= $FailedLoginAttempts )? 1 : 0;
 743 }
 744
 745 =head3 can_see_patron_infos
 746
 747 my $can_see = $patron->can_see_patron_infos( $patron );
 748
 749 Return true if the patron (usually the logged in user) can see the patron's infos for a given patron
 750
 751 =cut
 752
 753 sub can_see_patron_infos {
 754     my ( $self, $patron ) = @_;
 755     return $self->can_see_patrons_from( $patron->library->branchcode );
 756 }
 757
 758 =head3 can_see_patrons_from
 759
 760 my $can_see = $patron->can_see_patrons_from( $branchcode );
 761
 762 Return true if the patron (usually the logged in user) can see the patron's infos from a given library
 763
 764 =cut
 765
 766 sub can_see_patrons_from {
 767     my ( $self, $branchcode ) = @_;
 768     my $can = 0;
 769     if ( $self->branchcode eq $branchcode ) {
 770         $can = 1;
 771     } elsif ( $self->has_permission( { borrowers => 'view_borrower_infos_from_any_libraries' } ) ) {
 772         $can = 1;
 773     } elsif ( my $library_groups = $self->library->library_groups ) {
 774         while ( my $library_group = $library_groups->next ) {
 775             if ( $library_group->parent->has_child( $branchcode ) ) {
 776                 $can = 1;
 777                 last;
 778             }
 779         }
 780     }
 781     return $can;
 782 }
 783
 784 =head3 libraries_where_can_see_patrons
 785
 786 my $libraries = $patron-libraries_where_can_see_patrons;
 787
 788 Return the list of branchcodes(!) of libraries the patron is allowed to see other patron's infos.
 789 The branchcodes are arbitrarily returned sorted.
 790 We are supposing here that the object is related to the logged in patron (use of C4::Context::only_my_library)
 791
 792 An empty array means no restriction, the patron can see patron's infos from any libraries.
 793
 794 =cut
 795
 796 sub libraries_where_can_see_patrons {
 797     my ( $self ) = @_;
 798     my $userenv = C4::Context->userenv;
 799
 800     return () unless $userenv; # For tests, but userenv should be defined in tests...
 801
 802     my @restricted_branchcodes;
 803     if (C4::Context::only_my_library) {
 804         push @restricted_branchcodes, $self->branchcode;
 805     }
 806     else {
 807         unless (
 808             $self->has_permission(
 809                 { borrowers => 'view_borrower_infos_from_any_libraries' }
 810             )
 811           )
 812         {
 813             my $library_groups = $self->library->library_groups({ ft_hide_patron_info => 1 });
 814             if ( $library_groups->count )
 815             {
 816                 while ( my $library_group = $library_groups->next ) {
 817                     my $parent = $library_group->parent;
 818                     if ( $parent->has_child( $self->branchcode ) ) {
 819                         push @restricted_branchcodes, $parent->children->get_column('branchcode');
 820                     }
 821                 }
 822             }
 823
 824             @restricted_branchcodes = ( $self->branchcode ) unless @restricted_branchcodes;
 825         }
 826     }
 827
 828     @restricted_branchcodes = grep { defined $_ } @restricted_branchcodes;
 829     @restricted_branchcodes = uniq(@restricted_branchcodes);
 830     @restricted_branchcodes = sort(@restricted_branchcodes);
 831     return @restricted_branchcodes;
 832 }
 833
 834 sub has_permission {
 835     my ( $self, $flagsrequired ) = @_;
 836     return unless $self->userid;
 837     # TODO code from haspermission needs to be moved here!
 838     return C4::Auth::haspermission( $self->userid, $flagsrequired );
 839 }
 840
 841 =head3 is_adult
 842
 843 my $is_adult = $patron->is_adult
 844
 845 Return true if the patron has a category with a type Adult (A) or Organization (I)
 846
 847 =cut
 848
 849 sub is_adult {
 850     my ( $self ) = @_;
 851     return $self->category->category_type =~ /^(A|I)$/ ? 1 : 0;
 852 }
 853
 854 =head3 is_child
 855
 856 my $is_child = $patron->is_child
 857
 858 Return true if the patron has a category with a type Child (C)
 859
 860 =cut
 861 sub is_child {
 862     my( $self ) = @_;
 863     return $self->category->category_type eq 'C' ? 1 : 0;
 864 }
 865
 866 =head3 has_valid_userid
 867
 868 my $patron = Koha::Patrons->find(42);
 869 $patron->userid( $new_userid );
 870 my $has_a_valid_userid = $patron->has_valid_userid
 871
 872 my $patron = Koha::Patron->new( $params );
 873 my $has_a_valid_userid = $patron->has_valid_userid
 874
 875 Return true if the current userid of this patron is valid/unique, otherwise false.
 876
 877 Note that this should be done in $self->store instead and raise an exception if needed.
 878
 879 =cut
 880
 881 sub has_valid_userid {
 882     my ($self) = @_;
 883
 884     return 0 unless $self->userid;
 885
 886     return 0 if ( $self->userid eq C4::Context->config('user') );    # DB user
 887
 888     my $already_exists = Koha::Patrons->search(
 889         {
 890             userid => $self->userid,
 891             (
 892                 $self->in_storage
 893                 ? ( borrowernumber => { '!=' => $self->borrowernumber } )
 894                 : ()
 895             ),
 896         }
 897     )->count;
 898     return $already_exists ? 0 : 1;
 899 }
 900
 901 =head3 generate_userid
 902
 903 my $patron = Koha::Patron->new( $params );
 904 my $userid = $patron->generate_userid
 905
 906 Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
 907
 908 Return the generate 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).
 909
 910 # Note: Should we set $self->userid with the generated value?
 911 # Certainly yes, but we AddMember and ModMember will be rewritten
 912
 913 =cut
 914
 915 sub generate_userid {
 916     my ($self) = @_;
 917     my $userid;
 918     my $offset = 0;
 919     my $existing_userid = $self->userid;
 920     my $firstname = $self->firstname // q{};
 921     my $surname = $self->surname // q{};
 922     #The script will "do" the following code and increment the $offset until the generated userid is unique
 923     do {
 924       $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
 925       $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
 926       $userid = lc(($firstname)? "$firstname.$surname" : $surname);
 927       $userid = unac_string('utf-8',$userid);
 928       $userid .= $offset unless $offset == 0;
 929       $self->userid( $userid );
 930       $offset++;
 931      } while (! $self->has_valid_userid );
 932
 933      # Resetting to the previous value as the callers do not expect
 934      # this method to modify the userid attribute
 935      # This will be done later (move of AddMember and ModMember)
 936      $self->userid( $existing_userid );
 937
 938      return $userid;
 939
 940 }
 941
 942 =head2 Internal methods
 943
 944 =head3 _type
 945
 946 =cut
 947
 948 sub _type {
 949     return 'Borrower';
 950 }
 951
 952 =head1 AUTHOR
 953
 954 Kyle M Hall <kyle@bywatersolutions.com>
 955 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
 956
 957 =cut
 958
 959 1;