Koha/Patron.pm

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