3 # Copyright ByWater Solutions 2014
4 # Copyright PTFS Europe 2016
6 # This file is part of Koha.
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
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.
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.
31 use Koha
::Old
::Checkouts
;
32 use Koha
::Patron
::Categories
;
33 use Koha
::Patron
::HouseboundProfile
;
34 use Koha
::Patron
::HouseboundRole
;
35 use Koha
::Patron
::Images
;
37 use Koha
::Virtualshelves
;
38 use Koha
::Club
::Enrollments
;
40 use base
qw(Koha::Object);
44 Koha::Patron - Koha Patron Object class
56 Delete patron's holds, lists and finally the patron.
58 Lists owned by the borrower are deleted, but entries from the borrower to
67 $self->_result->result_source->schema->txn_do(
69 # Delete Patron's holds
72 # Delete all lists and all shares of this borrower
73 # Consistent with the approach Koha uses on deleting individual lists
74 # Note that entries in virtualshelfcontents added by this borrower to
75 # lists of others will be handled by a table constraint: the borrower
76 # is set to NULL in those entries.
78 # We could handle the above deletes via a constraint too.
79 # But a new BZ report 11889 has been opened to discuss another approach.
80 # Instead of deleting we could also disown lists (based on a pref).
81 # In that way we could save shared and public lists.
82 # The current table constraints support that idea now.
83 # This pref should then govern the results of other routines/methods such as
84 # Koha::Virtualshelf->new->delete too.
85 # FIXME Could be $patron->get_lists
86 $_->delete for Koha
::Virtualshelves
->search( { owner
=> $self->borrowernumber } );
88 $deleted = $self->SUPER::delete;
90 logaction
( "MEMBERS", "DELETE", $self->borrowernumber, "" ) if C4
::Context
->preference("BorrowersLog");
99 my $patron_category = $patron->category
101 Return the patron category for this patron
107 return Koha
::Patron
::Category
->_new_from_dbic( $self->_result->categorycode );
112 Returns a Koha::Patron object for this patron's guarantor
119 return unless $self->guarantorid();
121 return Koha
::Patrons
->find( $self->guarantorid() );
127 return Koha
::Patron
::Images
->find( $self->borrowernumber );
132 return Koha
::Library
->_new_from_dbic($self->_result->branchcode);
137 Returns the guarantees (list of Koha::Patron) of this patron
144 return Koha
::Patrons
->search( { guarantorid
=> $self->borrowernumber } );
147 =head3 housebound_profile
149 Returns the HouseboundProfile associated with this patron.
153 sub housebound_profile
{
155 my $profile = $self->_result->housebound_profile;
156 return Koha
::Patron
::HouseboundProfile
->_new_from_dbic($profile)
161 =head3 housebound_role
163 Returns the HouseboundRole associated with this patron.
167 sub housebound_role
{
170 my $role = $self->_result->housebound_role;
171 return Koha
::Patron
::HouseboundRole
->_new_from_dbic($role) if ( $role );
177 Returns the siblings of this patron.
184 my $guarantor = $self->guarantor;
186 return unless $guarantor;
188 return Koha
::Patrons
->search(
192 '=' => $guarantor->id,
195 '!=' => $self->borrowernumber,
201 =head3 wants_check_for_previous_checkout
203 $wants_check = $patron->wants_check_for_previous_checkout;
205 Return 1 if Koha needs to perform PrevIssue checking, else 0.
209 sub wants_check_for_previous_checkout
{
211 my $syspref = C4
::Context
->preference("checkPrevCheckout");
214 ## Hard syspref trumps all
215 return 1 if ($syspref eq 'hardyes');
216 return 0 if ($syspref eq 'hardno');
217 ## Now, patron pref trumps all
218 return 1 if ($self->checkprevcheckout eq 'yes');
219 return 0 if ($self->checkprevcheckout eq 'no');
221 # More complex: patron inherits -> determine category preference
222 my $checkPrevCheckoutByCat = $self->category->checkprevcheckout;
223 return 1 if ($checkPrevCheckoutByCat eq 'yes');
224 return 0 if ($checkPrevCheckoutByCat eq 'no');
226 # Finally: category preference is inherit, default to 0
227 if ($syspref eq 'softyes') {
234 =head3 do_check_for_previous_checkout
236 $do_check = $patron->do_check_for_previous_checkout($item);
238 Return 1 if the bib associated with $ITEM has previously been checked out to
239 $PATRON, 0 otherwise.
243 sub do_check_for_previous_checkout
{
244 my ( $self, $item ) = @_;
246 # Find all items for bib and extract item numbers.
247 my @items = Koha
::Items
->search({biblionumber
=> $item->{biblionumber
}});
249 foreach my $item (@items) {
250 push @item_nos, $item->itemnumber;
253 # Create (old)issues search criteria
255 borrowernumber
=> $self->borrowernumber,
256 itemnumber
=> \
@item_nos,
259 # Check current issues table
260 my $issues = Koha
::Checkouts
->search($criteria);
261 return 1 if $issues->count; # 0 || N
263 # Check old issues table
264 my $old_issues = Koha
::Old
::Checkouts
->search($criteria);
265 return $old_issues->count; # 0 || N
270 my $debarment_expiration = $patron->is_debarred;
272 Returns the date a patron debarment will expire, or undef if the patron is not
280 return unless $self->debarred;
281 return $self->debarred
282 if $self->debarred =~ '^9999'
283 or dt_from_string
( $self->debarred ) > dt_from_string
;
289 my $is_expired = $patron->is_expired;
291 Returns 1 if the patron is expired or 0;
297 return 0 unless $self->dateexpiry;
298 return 0 if $self->dateexpiry eq '0000-00-00';
299 return 1 if dt_from_string
( $self->dateexpiry ) < dt_from_string
->truncate( to
=> 'day' );
303 =head3 is_going_to_expire
305 my $is_going_to_expire = $patron->is_going_to_expire;
307 Returns 1 if the patron is going to expired, depending on the NotifyBorrowerDeparture pref or 0
311 sub is_going_to_expire
{
314 my $delay = C4
::Context
->preference('NotifyBorrowerDeparture') || 0;
316 return 0 unless $delay;
317 return 0 unless $self->dateexpiry;
318 return 0 if $self->dateexpiry eq '0000-00-00';
319 return 1 if dt_from_string
( $self->dateexpiry )->subtract( days
=> $delay ) < dt_from_string
->truncate( to
=> 'day' );
323 =head3 update_password
325 my $updated = $patron->update_password( $userid, $password );
327 Update the userid and the password of a patron.
328 If the userid already exists, returns and let DBIx::Class warns
329 This will add an entry to action_logs if BorrowersLog is set.
333 sub update_password
{
334 my ( $self, $userid, $password ) = @_;
335 eval { $self->userid($userid)->store; };
336 return if $@
; # Make sure the userid is not already in used by another patron
337 $self->password($password)->store;
338 logaction
( "MEMBERS", "CHANGE PASS", $self->borrowernumber, "" ) if C4
::Context
->preference("BorrowersLog");
344 my $new_expiry_date = $patron->renew_account
346 Extending the subscription to the expiry date.
353 if ( C4
::Context
->preference('BorrowerRenewalPeriodBase') eq 'combination' ) {
354 $date = ( dt_from_string
gt dt_from_string
( $self->dateexpiry ) ) ? dt_from_string
: dt_from_string
( $self->dateexpiry );
357 C4
::Context
->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry'
358 ? dt_from_string
( $self->dateexpiry )
361 my $expiry_date = $self->category->get_expiry_date($date);
363 $self->dateexpiry($expiry_date)->store;
365 $self->add_enrolment_fee_if_needed;
367 logaction
( "MEMBERS", "RENEW", $self->borrowernumber, "Membership renewed" ) if C4
::Context
->preference("BorrowersLog");
368 return dt_from_string
( $expiry_date )->truncate( to
=> 'day' );
373 my $has_overdues = $patron->has_overdues;
375 Returns the number of patron's overdues
381 my $dtf = Koha
::Database
->new->schema->storage->datetime_parser;
382 return $self->_result->issues->search({ date_due
=> { '<' => $dtf->format_datetime( dt_from_string
() ) } })->count;
387 $patron->track_login;
388 $patron->track_login({ force => 1 });
390 Tracks a (successful) login attempt.
391 The preference TrackLastPatronActivity must be enabled. Or you
392 should pass the force parameter.
397 my ( $self, $params ) = @_;
400 !C4
::Context
->preference('TrackLastPatronActivity');
401 $self->lastseen( dt_from_string
() )->store;
404 =head3 move_to_deleted
406 my $is_moved = $patron->move_to_deleted;
408 Move a patron to the deletedborrowers table.
409 This can be done before deleting a patron, to make sure the data are not completely deleted.
413 sub move_to_deleted
{
415 my $patron_infos = $self->unblessed;
416 delete $patron_infos->{updated_on
}; #This ensures the updated_on date in deletedborrowers will be set to the current timestamp
417 return Koha
::Database
->new->schema->resultset('Deletedborrower')->create($patron_infos);
420 =head3 article_requests
422 my @requests = $borrower->article_requests();
423 my $requests = $borrower->article_requests();
425 Returns either a list of ArticleRequests objects,
426 or an ArtitleRequests object, depending on the
431 sub article_requests
{
434 $self->{_article_requests
} ||= Koha
::ArticleRequests
->search({ borrowernumber
=> $self->borrowernumber() });
436 return $self->{_article_requests
};
439 =head3 article_requests_current
441 my @requests = $patron->article_requests_current
443 Returns the article requests associated with this patron that are incomplete
447 sub article_requests_current
{
450 $self->{_article_requests_current
} ||= Koha
::ArticleRequests
->search(
452 borrowernumber
=> $self->id(),
454 { status
=> Koha
::ArticleRequest
::Status
::Pending
},
455 { status
=> Koha
::ArticleRequest
::Status
::Processing
}
460 return $self->{_article_requests_current
};
463 =head3 article_requests_finished
465 my @requests = $biblio->article_requests_finished
467 Returns the article requests associated with this patron that are completed
471 sub article_requests_finished
{
472 my ( $self, $borrower ) = @_;
474 $self->{_article_requests_finished
} ||= Koha
::ArticleRequests
->search(
476 borrowernumber
=> $self->id(),
478 { status
=> Koha
::ArticleRequest
::Status
::Completed
},
479 { status
=> Koha
::ArticleRequest
::Status
::Canceled
}
484 return $self->{_article_requests_finished
};
487 =head3 add_enrolment_fee_if_needed
489 my $enrolment_fee = $patron->add_enrolment_fee_if_needed;
491 Add enrolment fee for a patron if needed.
495 sub add_enrolment_fee_if_needed
{
497 my $enrolment_fee = $self->category->enrolmentfee;
498 if ( $enrolment_fee && $enrolment_fee > 0 ) {
499 # insert fee in patron debts
500 C4
::Accounts
::manualinvoice
( $self->borrowernumber, '', '', 'A', $enrolment_fee );
502 return $enrolment_fee || 0;
507 my $issues = $patron->checkouts
513 my $issues = $self->_result->issues;
514 return Koha
::Checkouts
->_new_from_dbic( $issues );
519 my $overdue_items = $patron->get_overdues
521 Return the overdued items
527 my $dtf = Koha
::Database
->new->schema->storage->datetime_parser;
528 return $self->checkouts->search(
530 'me.date_due' => { '<' => $dtf->format_datetime(dt_from_string
) },
533 prefetch
=> { item
=> { biblio
=> 'biblioitems' } },
540 my $age = $patron->get_age
542 Return the age of the patron
548 my $today_str = dt_from_string
->strftime("%Y-%m-%d");
549 return unless $self->dateofbirth;
550 my $dob_str = dt_from_string
( $self->dateofbirth )->strftime("%Y-%m-%d");
552 my ( $dob_y, $dob_m, $dob_d ) = split /-/, $dob_str;
553 my ( $today_y, $today_m, $today_d ) = split /-/, $today_str;
555 my $age = $today_y - $dob_y;
556 if ( $dob_m . $dob_d > $today_m . $today_d ) {
565 my $account = $patron->account
571 return Koha
::Account
->new( { patron_id
=> $self->borrowernumber } );
576 my $holds = $patron->holds
578 Return all the holds placed by this patron
584 my $holds_rs = $self->_result->reserves->search( {}, { order_by
=> 'reservedate' } );
585 return Koha
::Holds
->_new_from_dbic($holds_rs);
588 =head3 first_valid_email_address
592 sub first_valid_email_address
{
595 return $self->email() || $self->emailpro() || $self->B_email() || q{};
598 =head3 get_club_enrollments
602 sub get_club_enrollments
{
603 my ( $self, $return_scalar ) = @_;
605 my $e = Koha
::Club
::Enrollments
->search( { borrowernumber
=> $self->borrowernumber(), date_canceled
=> undef } );
607 return $e if $return_scalar;
609 return wantarray ?
$e->as_list : $e;
612 =head3 get_enrollable_clubs
616 sub get_enrollable_clubs
{
617 my ( $self, $is_enrollable_from_opac, $return_scalar ) = @_;
620 $params->{is_enrollable_from_opac
} = $is_enrollable_from_opac
621 if $is_enrollable_from_opac;
622 $params->{is_email_required
} = 0 unless $self->first_valid_email_address();
624 $params->{borrower
} = $self;
626 my $e = Koha
::Clubs
->get_enrollable($params);
628 return $e if $return_scalar;
630 return wantarray ?
$e->as_list : $e;
643 Kyle M Hall <kyle@bywatersolutions.com>
644 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>