Koha-clms/Koha/Patrons.pm

807 lines
24 KiB
Perl

package Koha::Patrons;
# Copyright 2014 ByWater Solutions
# Copyright 2016 Koha Development Team
#
# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# Koha is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Koha; if not, see <https://www.gnu.org/licenses>.
use Modern::Perl;
use Koha::Database;
use Koha::DateUtils qw( dt_from_string );
use Koha::ArticleRequests;
use Koha::Patron;
use Koha::Exceptions::Patron;
use Koha::Exceptions::SysPref;
use Koha::Patron::Categories;
use Date::Calc qw( Today Add_Delta_Days);
use base qw(Koha::Objects::Mixin::ExtendedAttributes Koha::Objects);
=head1 NAME
Koha::Patron - Koha Patron Object class
=head1 API
=head2 Class methods
=cut
=head3 find_by_identifier
my $patron = Koha::Patrons->find_by_identifier($identifier);
Find a patron by either userid or cardnumber. Returns the first patron found
or undef if no patron matches the identifier.
This method searches first by userid, then by cardnumber if no match is found.
=cut
sub find_by_identifier {
my ( $self, $identifier ) = @_;
return unless defined $identifier && $identifier ne '';
# First try to find by userid
my $patron = $self->search( { userid => $identifier } )->next;
# If not found by userid, try cardnumber
$patron = $self->search( { cardnumber => $identifier } )->next unless $patron;
# If not found by cardnumber, try unique patron attributes
unless ($patron) {
$patron = $self->search(
{
'borrower_attributes.attribute' => $identifier,
'code.unique_id' => 1,
},
{
join => { 'borrower_attributes' => 'code' },
rows => 1,
}
)->single;
}
return $patron;
}
=head3 search_limited
my $patrons = Koha::Patrons->search_limit( $params, $attributes );
Returns all the patrons the logged in user is allowed to see
=cut
sub search_limited {
my ( $self, $params, $attributes ) = @_;
my $userenv = C4::Context->userenv;
my @restricted_branchcodes;
if ( $userenv and $userenv->{number} ) {
my $logged_in_user = Koha::Patrons->find( $userenv->{number} );
@restricted_branchcodes = $logged_in_user->libraries_where_can_see_patrons;
}
$params->{'me.branchcode'} = { -in => \@restricted_branchcodes } if @restricted_branchcodes;
return $self->search( $params, $attributes );
}
=head3 search_housebound_choosers
Returns all Patrons which are Housebound choosers.
=cut
sub search_housebound_choosers {
my ($self) = @_;
my $cho = $self->_resultset->search_related(
'housebound_role',
{
housebound_chooser => 1,
}
)->search_related('borrowernumber');
return Koha::Patrons->_new_from_dbic($cho);
}
=head3 search_housebound_deliverers
Returns all Patrons which are Housebound deliverers.
=cut
sub search_housebound_deliverers {
my ($self) = @_;
my $del = $self->_resultset->search_related(
'housebound_role',
{
housebound_deliverer => 1,
}
)->search_related('borrowernumber');
return Koha::Patrons->_new_from_dbic($del);
}
=head3 search_upcoming_membership_expires
my $patrons = Koha::Patrons->search_upcoming_membership_expires();
The 'before' and 'after' represent the number of days before/after the date
that is set by the preference MembershipExpiryDaysNotice.
If the pref is 14, before 2 and after 3 then you will get all expires
from 12 to 17 days.
=cut
sub search_upcoming_membership_expires {
my ( $self, $params ) = @_;
my $before = $params->{before} || 0;
my $after = $params->{after} || 0;
delete $params->{before};
delete $params->{after};
my $days = C4::Context->preference("MembershipExpiryDaysNotice") || 0;
my $date_before = dt_from_string->add( days => $days - $before );
my $date_after = dt_from_string->add( days => $days + $after );
my $dtf = Koha::Database->new->schema->storage->datetime_parser;
$params->{dateexpiry} = {
">=" => $dtf->format_date($date_before),
"<=" => $dtf->format_date($date_after),
};
return $self->SUPER::search( $params, { join => [ 'branchcode', 'categorycode' ] } );
}
=head3 search_patrons_to_anonymise
my $patrons = Koha::Patrons->search_patrons_to_anonymise( { before => $older_than_date, [ library => $library ] } );
This method returns all patrons who has an issue history older than a given date.
=cut
sub search_patrons_to_anonymise {
my ( $class, $params ) = @_;
my $older_than_date = $params->{before};
my $library = $params->{library};
$older_than_date = $older_than_date ? dt_from_string($older_than_date) : dt_from_string;
$library ||=
( C4::Context->preference('IndependentBranches')
&& C4::Context->userenv
&& !C4::Context->IsSuperLibrarian()
&& C4::Context->userenv->{branch} )
? C4::Context->userenv->{branch}
: undef;
my $anonymous_patron = C4::Context->preference('AnonymousPatron') || undef;
my $dtf = Koha::Database->new->schema->storage->datetime_parser;
my $rs = $class->_resultset->search(
{
returndate => { '<' => $dtf->format_datetime($older_than_date), },
'old_issues.borrowernumber' => { 'not' => undef },
privacy => { '<>' => 0 }, # Keep forever
( $library ? ( 'old_issues.branchcode' => $library ) : () ),
( $anonymous_patron ? ( 'old_issues.borrowernumber' => { '!=' => $anonymous_patron } ) : () ),
},
{
join => ["old_issues"],
distinct => 1,
}
);
return Koha::Patrons->_new_from_dbic($rs);
}
=head3 anonymize_last_borrowers
Koha::Patrons->search->anonymize_last_borrowers();
Anonymize items last borrower for all items_last_borrower older
than AnonymizeLastBorrowerDays.
=cut
sub anonymize_last_borrowers {
my ( $self, $params ) = @_;
return unless C4::Context->preference("AnonymizeLastBorrower");
my $anonymous_patron = C4::Context->preference('AnonymousPatron');
return unless $anonymous_patron;
my $anon_patron_obj = Koha::Patrons->find($anonymous_patron);
return unless $anon_patron_obj; # Invalid AnonymousPatron value
my $days = C4::Context->preference("AnonymizeLastBorrowerDays") || 0;
my ( $year, $month, $day ) = Today();
my ( $newyear, $newmonth, $newday ) = Add_Delta_Days( $year, $month, $day, (-1) * $days );
my $older_than_date = dt_from_string( sprintf "%4d-%02d-%02d", $newyear, $newmonth, $newday );
my $dtf = Koha::Database->new->schema->storage->datetime_parser;
# Perform bulk update directly on items_last_borrower table to avoid N+1 queries
my $schema = Koha::Database->new->schema;
my $items_last_borrower_rs = $schema->resultset('ItemsLastBorrower')->search(
{
created_on => { '<' => $dtf->format_datetime($older_than_date) },
borrowernumber => { '!=' => $anonymous_patron, 'not' => undef },
'itemnumber.damaged' => 0,
'itemnumber.itemlost' => 0,
'itemnumber.withdrawn' => 0,
},
{ join => 'itemnumber' }
);
return $items_last_borrower_rs->update( { borrowernumber => $anonymous_patron } );
}
=head3 delete
Koha::Patrons->search({ some filters here })->delete({ move => 1 });
Delete passed set of patron objects.
Wrapper for Koha::Patron->delete. (We do not want to bypass Koha::Patron
and let DBIx do the job without further housekeeping.)
Includes a move to deletedborrowers if move flag set.
Just like DBIx, the delete will only succeed when all entries could be
deleted. Returns true or throws an exception.
=cut
sub delete {
my ( $self, $params ) = @_;
my $patrons_deleted;
$self->_resultset->result_source->schema->txn_do(
sub {
my ( $set, $params ) = @_;
my $count = $set->count;
while ( my $patron = $set->next ) {
next unless $patron->in_storage;
$patron->move_to_deleted if $params->{move};
$patron->delete;
$patrons_deleted++;
}
},
$self,
$params
);
return $patrons_deleted;
}
=head3 filter_by_expiration_date
Koha::Patrons->filter_by_expiration_date{{ days => $x });
Returns set of Koha patron objects expired $x days.
=cut
sub filter_by_expiration_date {
my ( $class, $params ) = @_;
return $class->filter_by_last_update(
{
timestamp_column_name => 'dateexpiry',
min_days => $params->{days} || 0,
}
);
}
=head3 search_unsubscribed
Koha::Patrons->search_unsubscribed;
Returns a set of Koha patron objects for patrons that recently
unsubscribed and are not locked (candidates for locking).
Depends on UnsubscribeReflectionDelay.
=cut
sub search_unsubscribed {
my ($class) = @_;
my $delay = C4::Context->preference('UnsubscribeReflectionDelay');
if ( !defined($delay) || $delay eq q{} ) {
# return empty set
return $class->search( { borrowernumber => undef } );
}
my $parser = Koha::Database->new->schema->storage->datetime_parser;
my $dt = dt_from_string()->subtract( days => $delay );
my $str = $parser->format_datetime($dt);
my $fails = C4::Context->preference('FailedLoginAttempts') || 0;
my $cond = [ undef, 0, 1 .. $fails - 1 ]; # NULL, 0, 1..fails-1 (if fails>0)
return $class->search(
{
'patron_consents.refused_on' => { '<=' => $str },
'patron_consents.type' => 'GDPR_PROCESSING',
'login_attempts' => $cond,
},
{ join => 'patron_consents' },
);
}
=head3 search_anonymize_candidates
Koha::Patrons->search_anonymize_candidates({ locked => 1 });
Returns a set of Koha patron objects for patrons whose account is expired
and locked (if parameter set). These are candidates for anonymizing.
Depends on PatronAnonymizeDelay.
=cut
sub search_anonymize_candidates {
my ( $class, $params ) = @_;
my $delay = C4::Context->preference('PatronAnonymizeDelay');
if ( !defined($delay) || $delay eq q{} ) {
# return empty set
return $class->search( { borrowernumber => undef } );
}
my $cond = {};
my $parser = Koha::Database->new->schema->storage->datetime_parser;
my $dt = dt_from_string()->subtract( days => $delay );
my $str = $parser->format_datetime($dt);
$cond->{dateexpiry} = { '<=' => $str };
$cond->{anonymized} = 0; # not yet done
my $fails = C4::Context->preference('FailedLoginAttempts');
if ( $params->{locked} && $fails && $fails > 0 ) { # $fails should actually not be negative btw
$cond->{login_attempts} =
[ -and => { '!=' => undef }, { -not_in => [ 0, 1 .. $fails - 1 ] } ]; # -not_in does not like undef
} elsif ( $params->{locked} ) {
$cond->{login_attempts} = -1;
}
return $class->search($cond);
}
=head3 search_anonymized
Koha::Patrons->search_anonymized;
Returns a set of Koha patron objects for patron accounts that have been
anonymized before and could be removed.
Depends on PatronRemovalDelay.
=cut
sub search_anonymized {
my ($class) = @_;
my $delay = C4::Context->preference('PatronRemovalDelay');
if ( !defined($delay) || $delay eq q{} ) {
# return empty set
return $class->search( { borrowernumber => undef } );
}
my $cond = {};
my $parser = Koha::Database->new->schema->storage->datetime_parser;
my $dt = dt_from_string()->subtract( days => $delay );
my $str = $parser->format_datetime($dt);
$cond->{dateexpiry} = { '<=' => $str };
$cond->{anonymized} = 1;
return $class->search($cond);
}
=head3 lock
Koha::Patrons->search({ some filters })->lock({ expire => 1, remove => 1 })
Lock the passed set of patron objects. Optionally expire and remove holds.
Wrapper around Koha::Patron->lock.
=cut
sub lock {
my ( $self, $params ) = @_;
my $count = $self->count;
while ( my $patron = $self->next ) {
$patron->lock($params);
}
}
=head3 anonymize
Koha::Patrons->search({ some filters })->anonymize();
Anonymize passed set of patron objects.
Wrapper around Koha::Patron->anonymize.
=cut
sub anonymize {
my ($self) = @_;
my $count = $self->count;
while ( my $patron = $self->next ) {
$patron->anonymize;
}
}
=head3 search_patrons_to_update_category
my $patrons = Koha::Patrons->search_patrons_to_update_category( {
from => $from_category,
fine_max => $fine_max,
fine_min => $fin_min,
too_young => $too_young,
too_old => $too_old,
});
This method returns all patron who should be updated from one category to another meeting criteria:
from - borrower categorycode
fine_min - with fines totaling at least this amount
fine_max - with fines above this amount
too_young - if passed, select patrons who are under the age limit for the current category
too_old - if passed, select patrons who are over the age limit for the current category
too_young and too_old logically cannot be used in combination (One cannot be both too old and too young)
fine_min takes precedence over fine_max if both are passed
=cut
sub search_patrons_to_update_category {
my ( $self, $params ) = @_;
my %query;
my $search_params;
my $cat_from = Koha::Patron::Categories->find( $params->{from} );
$search_params->{categorycode} = $params->{from};
if ( $params->{too_young} || $params->{too_old} ) {
my $dtf = Koha::Database->new->schema->storage->datetime_parser;
if ( $cat_from->dateofbirthrequired && $params->{too_young} ) {
my $date_after = dt_from_string()->subtract( years => $cat_from->dateofbirthrequired );
$search_params->{dateofbirth}{'>'} = $dtf->format_datetime($date_after);
}
if ( $cat_from->upperagelimit && $params->{too_old} ) {
# Must be `upperagelimit + 1` years old (e.g., if limit is 17, query for 18+)
my $date_before = dt_from_string()->subtract( years => $cat_from->upperagelimit + 1 );
$search_params->{dateofbirth}{'<'} = $dtf->format_datetime($date_before);
}
}
if ( $params->{fine_min} || $params->{fine_max} ) {
$query{join} = ["accountlines"];
$query{columns} = ["borrowernumber"];
$query{group_by} = ["borrowernumber"];
$query{having} = \[ 'COALESCE(sum(accountlines.amountoutstanding),0) <= ?', $params->{fine_max} ]
if defined $params->{fine_max};
$query{having} = \[ 'COALESCE(sum(accountlines.amountoutstanding),0) >= ?', $params->{fine_min} ]
if defined $params->{fine_min};
}
return $self->search( $search_params, \%query );
}
=head3 update_category_to
Koha::Patrons->search->update_category_to( {
category => $to_category,
});
Update supplied patrons from current category to another and take care of guarantor info.
To make sure all the conditions are met, the caller has the responsibility to
call search_patrons_to_update to filter the Koha::Patrons set
=cut
sub update_category_to {
my ( $self, $params ) = @_;
my $counter = 0;
while ( my $patron = $self->next ) {
$patron->discard_changes;
$counter++;
$patron->categorycode( $params->{category} )->store();
}
return $counter;
}
=head3 filter_by_attribute_type
my $patrons = Koha::Patrons->filter_by_attribute_type($attribute_type_code);
Return a Koha::Patrons set with patrons having the attribute defined.
=cut
sub filter_by_attribute_type {
my ( $self, $attribute_type ) = @_;
my $rs =
Koha::Patron::Attributes->search( { code => $attribute_type } )->_resultset()->search_related('borrowernumber');
return Koha::Patrons->_new_from_dbic($rs);
}
=head3 filter_by_attribute_value
my $patrons = Koha::Patrons->filter_by_attribute_value($attribute_value);
Return a Koha::Patrons set with patrong having the attribute value passed in parameter.
=cut
sub filter_by_attribute_value {
my ( $self, $attribute_value ) = @_;
my $rs = Koha::Patron::Attributes->search(
{
'borrower_attribute_types.staff_searchable' => 1,
attribute => { like => "%$attribute_value%" }
},
{ join => 'borrower_attribute_types' }
)->_resultset()->search_related('borrowernumber');
return Koha::Patrons->_new_from_dbic($rs);
}
=head3 filter_by_amount_owed
Koha::Patrons->filter_by_amount_owed(
{
less_than => '2.00',
more_than => '0.50',
debit_type => $debit_type_code,
library => $branchcode
}
);
Returns patrons filtered by how much money they owe, between passed limits.
Optionally limit to debts of a particular debit_type or/and owed to a particular library.
=head4 arguments hashref
=over 4
=item less_than (optional) - filter out patrons who owe less than Amount
=item more_than (optional) - filter out patrons who owe more than Amount
=item debit_type (optional) - filter the amount owed by debit type
=item library (optional) - filter the amount owed to a particular branch
=back
=cut
sub filter_by_amount_owed {
my ( $self, $options ) = @_;
return $self
unless (
defined($options)
&& ( defined( $options->{less_than} )
|| defined( $options->{more_than} ) )
);
my $where = {};
my $group_by = [ map { 'me.' . $_ } $self->_resultset->result_source->columns ];
my $attrs = {
join => 'accountlines',
group_by => $group_by,
'+select' => { sum => 'accountlines.amountoutstanding', '-as' => 'outstanding' },
'+as' => 'outstanding'
};
$where->{'accountlines.debit_type_code'} = $options->{debit_type}
if defined( $options->{debit_type} );
$where->{'accountlines.branchcode'} = $options->{library}
if defined( $options->{library} );
$attrs->{'having'} = [
{ 'outstanding' => { '<' => $options->{less_than} } },
{ 'outstanding' => undef }
]
if ( defined( $options->{less_than} )
&& !defined( $options->{more_than} ) );
$attrs->{'having'} = { 'outstanding' => { '>' => $options->{more_than} } }
if ( !defined( $options->{less_than} )
&& defined( $options->{more_than} ) );
$attrs->{'having'}->{'-and'} = [
{ 'outstanding' => { '>' => $options->{more_than} } },
{ 'outstanding' => { '<' => $options->{less_than} } }
]
if ( defined( $options->{less_than} )
&& defined( $options->{more_than} ) );
return $self->search( $where, $attrs );
}
=head3 filter_by_have_permission
my $patrons = Koha::Patrons->search->filter_by_have_permission('suggestions.suggestions_manage');
my $patrons = Koha::Patrons->search->filter_by_have_permission('suggestions');
Filter patrons who have a given subpermission or the whole permission.
=cut
sub filter_by_have_permission {
my ( $self, $subpermission ) = @_;
my ( $p, $sp ) = split '\.', $subpermission;
my $perm = Koha::Database->new()->schema()->resultset('Userflag')->find( { flag => $p } );
Koha::Exceptions::ObjectNotFound->throw( sprintf( "Permission %s not found", $p ) )
unless $perm;
my $bit = $perm->bit;
return $self->search(
{
-and => [
-or => [
\"me.flags & (1 << $bit)",
{ 'me.flags' => 1 },
(
$sp
? {
-and => [
{ 'user_permissions.module_bit' => $bit },
{ 'user_permissions.code' => $sp }
]
}
: ()
)
]
]
},
{ prefetch => 'user_permissions' }
);
}
=head3 filter_by_expired_opac_registrations
my $expired_registrations = $patrons->filter_by_expired_opac_registrations;
Return patrons that have not upgraded from the 'temporary' category
=cut
sub filter_by_expired_opac_registrations {
my ($self) = @_;
my $category_code = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
Koha::Exceptions::SysPref::NotSet->throw( syspref => 'PatronSelfRegistrationDefaultCategory' )
unless $category_code;
my $delay = C4::Context->preference('PatronSelfRegistrationExpireTemporaryAccountsDelay');
Koha::Exceptions::SysPref::NotSet->throw( syspref => 'PatronSelfRegistrationExpireTemporaryAccountsDelay' )
unless $delay;
# DO NOT REMOVE test on delay here!
# Some libraries may not use a temporary category, but want to keep patrons.
# We should not delete patrons when the value is NULL, empty string or 0.
return $self->search(
{
categorycode => $category_code,
}
)->filter_by_last_update( { timestamp_column_name => 'dateenrolled', days => $delay } );
}
=head3 filter_by_safe_to_delete
my $safe_to_delete_patrons = $patrons->filter_by_safe_to_delete;
Return the patrons that are safe to delete
=cut
sub filter_by_safe_to_delete {
my ($self) = @_;
my @ids;
while ( my $patron = $self->next ) {
push @ids, $patron->borrowernumber
if $patron->safe_to_delete;
}
return Koha::Patrons->search( { borrowernumber => { -in => \@ids } } );
}
=head3 extended_attributes_config
=cut
sub extended_attributes_config {
my ($self) = @_;
return {
'id_field' => { 'foreign' => 'borrowernumber', 'self' => 'borrowernumber' },
'key_field' => 'code',
'schema_class' => 'Koha::Schema::Result::BorrowerAttribute',
};
}
=head3 check_for_existing_matches
my $match_result = Koha::Patrons->check_for_existing_matches( $patron_data );
Uses the fields from the PatronDuplicateMatchingAddFields preference to check for existing matches
A field that has no value is treated as unknown rather than as a mismatch, whichever
side of the comparison it is missing from. A blank value in the data being checked
means the field is not compared at all, and a blank value in an existing patron record
does not stop that record being reported as a possible duplicate.
=cut
sub check_for_existing_matches {
my ( $self, $new_patron_data ) = @_;
my @duplicate_match_fields = split '\|', C4::Context->preference('PatronDuplicateMatchingAddFields') // q{};
my $result_source = $self->_resultset->result_source;
my @match_conditions;
for my $field (@duplicate_match_fields) {
my $value = $new_patron_data->{$field};
next unless defined $value && $value ne q{};
# An empty value in the existing record is unknown, not a mismatch. Only text
# columns are compared against the empty string, it is not a valid value for
# date or numeric columns.
my @blank_values = (undef);
push @blank_values, q{} if $result_source->column_info($field)->{data_type} =~ /char|text/;
push @match_conditions, { -or => [ { $field => $value }, { $field => \@blank_values } ] };
}
# Without any usable conditions, Koha::Patrons->search would run
# unfiltered and match every patron in the system.
return { 'duplicate_found' => 0 } unless @match_conditions;
my $patrons = Koha::Patrons->search( { -and => \@match_conditions } );
if ( $patrons->count > 0 ) {
return {
'duplicate_found' => 1,
'matching_patrons' => $patrons
};
}
return { 'duplicate_found' => 0 };
}
=head3 _type
=cut
sub _type {
return 'Borrower';
}
=head3 object_class
=cut
sub object_class {
return 'Koha::Patron';
}
=head1 AUTHOR
Kyle M Hall <kyle@bywatersolutions.com>
=cut
1;