3 # Copyright ByWater Solutions 2014
4 # Copyright PTFS Europe 2016
5 # Copyright Koha-Suomi Oy 2017
7 # This file is part of Koha.
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
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.
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.
25 use List::MoreUtils qw( uniq );
33 use Koha::Old::Checkouts;
35 use Koha::Exceptions::Category;
36 use Koha::Exceptions::Library;
37 use Koha::Exceptions::Patron;
39 use Koha::Patron::Categories;
40 use Koha::Patron::HouseboundProfile;
41 use Koha::Patron::HouseboundRole;
42 use Koha::Patron::Images;
44 use Koha::Virtualshelves;
45 use Koha::Club::Enrollments;
48 use base qw(Koha::Object);
52 Koha::Patron - Koha Patron Object class
64 Delete patron's holds, lists and finally the patron.
66 Lists owned by the borrower are deleted, but entries from the borrower to
75 $self->_result->result_source->schema->txn_do(
77 # Delete Patron's holds
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.
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 } );
96 $deleted = $self->SUPER::delete;
98 logaction( "MEMBERS", "DELETE", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog");
107 my $patron_category = $patron->category
109 Return the patron category for this patron
115 return Koha::Patron::Category->_new_from_dbic( $self->_result->categorycode );
120 Returns a Koha::Patron object for this patron's guarantor
127 return unless $self->guarantorid();
129 return Koha::Patrons->find( $self->guarantorid() );
135 return scalar Koha::Patron::Images->find( $self->borrowernumber );
140 return Koha::Library->_new_from_dbic($self->_result->branchcode);
145 Returns the guarantees (list of Koha::Patron) of this patron
152 return Koha::Patrons->search( { guarantorid => $self->borrowernumber } );
155 =head3 housebound_profile
157 Returns the HouseboundProfile associated with this patron.
161 sub housebound_profile {
163 my $profile = $self->_result->housebound_profile;
164 return Koha::Patron::HouseboundProfile->_new_from_dbic($profile)
169 =head3 housebound_role
171 Returns the HouseboundRole associated with this patron.
175 sub housebound_role {
178 my $role = $self->_result->housebound_role;
179 return Koha::Patron::HouseboundRole->_new_from_dbic($role) if ( $role );
185 Returns the siblings of this patron.
192 my $guarantor = $self->guarantor;
194 return unless $guarantor;
196 return Koha::Patrons->search(
200 '=' => $guarantor->id,
203 '!=' => $self->borrowernumber,
209 =head3 wants_check_for_previous_checkout
211 $wants_check = $patron->wants_check_for_previous_checkout;
213 Return 1 if Koha needs to perform PrevIssue checking, else 0.
217 sub wants_check_for_previous_checkout {
219 my $syspref = C4::Context->preference("checkPrevCheckout");
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');
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');
234 # Finally: category preference is inherit, default to 0
235 if ($syspref eq 'softyes') {
242 =head3 do_check_for_previous_checkout
244 $do_check = $patron->do_check_for_previous_checkout($item);
246 Return 1 if the bib associated with $ITEM has previously been checked out to
247 $PATRON, 0 otherwise.
251 sub do_check_for_previous_checkout {
252 my ( $self, $item ) = @_;
254 # Find all items for bib and extract item numbers.
255 my @items = Koha::Items->search({biblionumber => $item->{biblionumber}});
257 foreach my $item (@items) {
258 push @item_nos, $item->itemnumber;
261 # Create (old)issues search criteria
263 borrowernumber => $self->borrowernumber,
264 itemnumber => \@item_nos,
267 # Check current issues table
268 my $issues = Koha::Checkouts->search($criteria);
269 return 1 if $issues->count; # 0 || N
271 # Check old issues table
272 my $old_issues = Koha::Old::Checkouts->search($criteria);
273 return $old_issues->count; # 0 || N
278 my $debarment_expiration = $patron->is_debarred;
280 Returns the date a patron debarment will expire, or undef if the patron is not
288 return unless $self->debarred;
289 return $self->debarred
290 if $self->debarred =~ '^9999'
291 or dt_from_string( $self->debarred ) > dt_from_string;
297 my $is_expired = $patron->is_expired;
299 Returns 1 if the patron is expired or 0;
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' );
311 =head3 is_going_to_expire
313 my $is_going_to_expire = $patron->is_going_to_expire;
315 Returns 1 if the patron is going to expired, depending on the NotifyBorrowerDeparture pref or 0
319 sub is_going_to_expire {
322 my $delay = C4::Context->preference('NotifyBorrowerDeparture') || 0;
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' );
331 =head3 update_password
333 my $updated = $patron->update_password( $userid, $password );
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.
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
347 password => $password,
351 logaction( "MEMBERS", "CHANGE PASS", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog");
357 my $new_expiry_date = $patron->renew_account
359 Extending the subscription to the expiry 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 );
370 C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry'
371 ? dt_from_string( $self->dateexpiry )
374 my $expiry_date = $self->category->get_expiry_date($date);
376 $self->dateexpiry($expiry_date);
377 $self->date_renewed( dt_from_string() );
380 $self->add_enrolment_fee_if_needed;
382 logaction( "MEMBERS", "RENEW", $self->borrowernumber, "Membership renewed" ) if C4::Context->preference("BorrowersLog");
383 return dt_from_string( $expiry_date )->truncate( to => 'day' );
388 my $has_overdues = $patron->has_overdues;
390 Returns the number of patron's overdues
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;
402 $patron->track_login;
403 $patron->track_login({ force => 1 });
405 Tracks a (successful) login attempt.
406 The preference TrackLastPatronActivity must be enabled. Or you
407 should pass the force parameter.
412 my ( $self, $params ) = @_;
415 !C4::Context->preference('TrackLastPatronActivity');
416 $self->lastseen( dt_from_string() )->store;
419 =head3 move_to_deleted
421 my $is_moved = $patron->move_to_deleted;
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.
428 sub move_to_deleted {
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);
435 =head3 article_requests
437 my @requests = $borrower->article_requests();
438 my $requests = $borrower->article_requests();
440 Returns either a list of ArticleRequests objects,
441 or an ArtitleRequests object, depending on the
446 sub article_requests {
449 $self->{_article_requests} ||= Koha::ArticleRequests->search({ borrowernumber => $self->borrowernumber() });
451 return $self->{_article_requests};
454 =head3 article_requests_current
456 my @requests = $patron->article_requests_current
458 Returns the article requests associated with this patron that are incomplete
462 sub article_requests_current {
465 $self->{_article_requests_current} ||= Koha::ArticleRequests->search(
467 borrowernumber => $self->id(),
469 { status => Koha::ArticleRequest::Status::Pending },
470 { status => Koha::ArticleRequest::Status::Processing }
475 return $self->{_article_requests_current};
478 =head3 article_requests_finished
480 my @requests = $biblio->article_requests_finished
482 Returns the article requests associated with this patron that are completed
486 sub article_requests_finished {
487 my ( $self, $borrower ) = @_;
489 $self->{_article_requests_finished} ||= Koha::ArticleRequests->search(
491 borrowernumber => $self->id(),
493 { status => Koha::ArticleRequest::Status::Completed },
494 { status => Koha::ArticleRequest::Status::Canceled }
499 return $self->{_article_requests_finished};
502 =head3 add_enrolment_fee_if_needed
504 my $enrolment_fee = $patron->add_enrolment_fee_if_needed;
506 Add enrolment fee for a patron if needed.
510 sub add_enrolment_fee_if_needed {
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 );
517 return $enrolment_fee || 0;
522 my $checkouts = $patron->checkouts
528 my $checkouts = $self->_result->issues;
529 return Koha::Checkouts->_new_from_dbic( $checkouts );
534 my $old_checkouts = $patron->old_checkouts
540 my $old_checkouts = $self->_result->old_issues;
541 return Koha::Old::Checkouts->_new_from_dbic( $old_checkouts );
546 my $overdue_items = $patron->get_overdues
548 Return the overdued items
554 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
555 return $self->checkouts->search(
557 'me.date_due' => { '<' => $dtf->format_datetime(dt_from_string) },
560 prefetch => { item => { biblio => 'biblioitems' } },
567 my $age = $patron->get_age
569 Return the age of the patron
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");
579 my ( $dob_y, $dob_m, $dob_d ) = split /-/, $dob_str;
580 my ( $today_y, $today_m, $today_d ) = split /-/, $today_str;
582 my $age = $today_y - $dob_y;
583 if ( $dob_m . $dob_d > $today_m . $today_d ) {
592 my $account = $patron->account
598 return Koha::Account->new( { patron_id => $self->borrowernumber } );
603 my $holds = $patron->holds
605 Return all the holds placed by this patron
611 my $holds_rs = $self->_result->reserves->search( {}, { order_by => 'reservedate' } );
612 return Koha::Holds->_new_from_dbic($holds_rs);
617 my $old_holds = $patron->old_holds
619 Return all the historical holds for this patron
625 my $old_holds_rs = $self->_result->old_reserves->search( {}, { order_by => 'reservedate' } );
626 return Koha::Old::Holds->_new_from_dbic($old_holds_rs);
629 =head3 notice_email_address
631 my $email = $patron->notice_email_address;
633 Return the email address of patron used for notices.
634 Returns the empty string if no email address.
638 sub notice_email_address{
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;
647 return $self->$which_address || '';
650 =head3 first_valid_email_address
652 my $first_valid_email_address = $patron->first_valid_email_address
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.
660 sub first_valid_email_address {
663 return $self->email() || $self->emailpro() || $self->B_email() || q{};
666 =head3 get_club_enrollments
670 sub get_club_enrollments {
671 my ( $self, $return_scalar ) = @_;
673 my $e = Koha::Club::Enrollments->search( { borrowernumber => $self->borrowernumber(), date_canceled => undef } );
675 return $e if $return_scalar;
677 return wantarray ? $e->as_list : $e;
680 =head3 get_enrollable_clubs
684 sub get_enrollable_clubs {
685 my ( $self, $is_enrollable_from_opac, $return_scalar ) = @_;
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();
692 $params->{borrower} = $self;
694 my $e = Koha::Clubs->get_enrollable($params);
696 return $e if $return_scalar;
698 return wantarray ? $e->as_list : $e;
701 =head3 account_locked
703 my $is_locked = $patron->account_locked
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.
713 my $FailedLoginAttempts = C4::Context->preference('FailedLoginAttempts');
714 return ( $FailedLoginAttempts
715 and $self->login_attempts
716 and $self->login_attempts >= $FailedLoginAttempts )? 1 : 0;
719 =head3 can_see_patron_infos
721 my $can_see = $patron->can_see_patron_infos( $patron );
723 Return true if the patron (usually the logged in user) can see the patron's infos for a given patron
727 sub can_see_patron_infos {
728 my ( $self, $patron ) = @_;
729 return $self->can_see_patrons_from( $patron->library->branchcode );
732 =head3 can_see_patrons_from
734 my $can_see = $patron->can_see_patrons_from( $branchcode );
736 Return true if the patron (usually the logged in user) can see the patron's infos from a given library
740 sub can_see_patrons_from {
741 my ( $self, $branchcode ) = @_;
743 if ( $self->branchcode eq $branchcode ) {
745 } elsif ( $self->has_permission( { borrowers => 'view_borrower_infos_from_any_libraries' } ) ) {
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 ) ) {
758 =head3 libraries_where_can_see_patrons
760 my $libraries = $patron-libraries_where_can_see_patrons;
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)
766 An empty array means no restriction, the patron can see patron's infos from any libraries.
770 sub libraries_where_can_see_patrons {
772 my $userenv = C4::Context->userenv;
774 return () unless $userenv; # For tests, but userenv should be defined in tests...
776 my @restricted_branchcodes;
777 if (C4::Context::only_my_library) {
778 push @restricted_branchcodes, $self->branchcode;
782 $self->has_permission(
783 { borrowers => 'view_borrower_infos_from_any_libraries' }
787 my $library_groups = $self->library->library_groups({ ft_hide_patron_info => 1 });
788 if ( $library_groups->count )
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');
798 @restricted_branchcodes = ( $self->branchcode ) unless @restricted_branchcodes;
802 @restricted_branchcodes = grep { defined $_ } @restricted_branchcodes;
803 @restricted_branchcodes = uniq(@restricted_branchcodes);
804 @restricted_branchcodes = sort(@restricted_branchcodes);
805 return @restricted_branchcodes;
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 );
817 my $is_adult = $patron->is_adult
819 Return true if the patron has a category with a type Adult (A) or Organization (I)
825 return $self->category->category_type =~ /^(A|I)$/ ? 1 : 0;
830 my $is_child = $patron->is_child
832 Return true if the patron has a category with a type Child (C)
837 return $self->category->category_type eq 'C' ? 1 : 0;
847 # $self->_validate();
849 return $self->SUPER::store();
860 =head2 Internal methods
862 =head3 _check_branchcode
864 Checks the existence of patron's branchcode and throws
865 Koha::Exceptions::Library::BranchcodeNotFound if branchcode is not found.
869 sub _check_branchcode {
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,
882 =head3 _check_categorycode
884 Checks the existence of patron's categorycode and throws
885 Koha::Exceptions::Category::CategorycodeNotFound if categorycode is not found.
889 sub _check_categorycode {
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,
902 =head3 _check_uniqueness
904 Checks patron's cardnumber and userid for uniqueness and throws
905 Koha::Exceptions::Patron::DuplicateObject if conflicting with another patron.
909 sub _check_uniqueness {
913 $select->{cardnumber} = $self->cardnumber if $self->cardnumber;
914 $select->{userid} = $self->userid if $self->userid;
916 return unless keys %$select;
918 # Find conflicting patrons
919 my $patrons = Koha::Patrons->search({
923 if ($patrons->count) {
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)
935 $conflict->{cardnumber} = $self->cardnumber;
937 if ($patron->userid && $self->userid &&
938 $patron->userid eq $self->userid)
940 $conflict->{userid} = $self->userid;
945 Koha::Exceptions::Patron::DuplicateObject->throw(
946 error => "Patron data conflicts with another patron",
947 conflict => $conflict
948 ) if keys %$conflict;
955 Performs a set of validations on this object and throws Koha::Exceptions if errors
963 $self->_check_branchcode;
964 $self->_check_categorycode;
965 $self->_check_uniqueness;
971 Kyle M Hall <kyle@bywatersolutions.com>
972 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>