use Modern::Perl;
-use Carp;
use List::MoreUtils qw( any uniq );
use JSON qw( to_json );
-use Unicode::Normalize;
+use Unicode::Normalize qw( NFKD );
+use Try::Tiny;
use C4::Context;
-use C4::Log;
+use C4::Auth qw( checkpw_hash );
+use C4::Log qw( logaction );
use Koha::Account;
use Koha::ArticleRequests;
-use C4::Letters qw( GetPreparedLetter EnqueueLetter );
+use C4::Letters qw( GetPreparedLetter EnqueueLetter SendQueuedMessages );
use Koha::AuthUtils;
use Koha::Checkouts;
+use Koha::CirculationRules;
use Koha::Club::Enrollments;
use Koha::Database;
-use Koha::DateUtils;
+use Koha::DateUtils qw( dt_from_string );
+use Koha::Encryption;
use Koha::Exceptions::Password;
use Koha::Holds;
+use Koha::CurbsidePickups;
use Koha::Old::Checkouts;
use Koha::Patron::Attributes;
use Koha::Patron::Categories;
use Koha::Patron::HouseboundProfile;
use Koha::Patron::HouseboundRole;
use Koha::Patron::Images;
+use Koha::Patron::Messages;
use Koha::Patron::Modifications;
use Koha::Patron::Relationships;
+use Koha::Patron::Restrictions;
use Koha::Patrons;
use Koha::Plugins;
+use Koha::Recalls;
+use Koha::Result::Boolean;
use Koha::Subscription::Routinglists;
use Koha::Token;
use Koha::Virtualshelves;
sub fixup_cardnumber {
my ( $self ) = @_;
- my $max = Koha::Patrons->search({
+
+ my $max = $self->cardnumber;
+ Koha::Plugins->call( 'patron_barcode_transform', \$max );
+
+ $max ||= Koha::Patrons->search({
cardnumber => {-regexp => '^-?[0-9]+$'}
}, {
select => \'CAST(cardnumber AS SIGNED)',
$self->trim_whitespaces;
+ my $new_cardnumber = $self->cardnumber;
+ Koha::Plugins->call( 'patron_barcode_transform', \$new_cardnumber );
+ $self->cardnumber( $new_cardnumber );
+
# Set surname to uppercase if uppercasesurname is true
$self->surname( uc($self->surname) )
if C4::Context->preference("uppercasesurnames");
+ $self->relationship(undef) # We do not want to store an empty string in this field
+ if defined $self->relationship
+ and $self->relationship eq "";
+
unless ( $self->in_storage ) { #AddMember
# Generate a valid userid/login if needed
- $self->generate_userid
- if not $self->userid or not $self->has_valid_userid;
+ $self->generate_userid unless $self->userid;
+ Koha::Exceptions::Patron::InvalidUserid->throw( userid => $self->userid )
+ unless $self->has_valid_userid;
# Add expiration date if it isn't already there
unless ( $self->dateexpiry ) {
# Make a copy of the plain text password for later use
$self->plain_text_password( $self->password );
+ $self->password_expiration_date( $self->password
+ ? $self->category->get_password_expiry_date || undef
+ : undef );
# Create a disabled account if no password provided
$self->password( $self->password
? Koha::AuthUtils::hash_password( $self->password )
else { #ModMember
my $self_from_storage = $self->get_from_storage;
- # FIXME We should not deal with that here, callers have to do this job
- # Moved from ModMember to prevent regressions
- unless ( $self->userid ) {
- my $stored_userid = $self_from_storage->userid;
- $self->userid($stored_userid);
- }
+
+ # Do not accept invalid userid here
+ $self->generate_userid unless $self->userid;
+ Koha::Exceptions::Patron::InvalidUserid->throw( userid => $self->userid )
+ unless $self->has_valid_userid;
# Password must be updated using $self->set_password
$self->password($self_from_storage->password);
# Clean up guarantors on category change if required
$self->guarantor_relationships->delete
- if ( $self->category->category_type ne 'C'
- && $self->category->category_type ne 'P' );
+ unless ( $self->category->can_be_guarantee );
}
Delete patron's holds, lists and finally the patron.
-Lists owned by the borrower are deleted, but entries from the borrower to
-other lists are kept.
+Lists owned by the borrower are deleted or ownership is transferred depending on the
+ListOwnershipUponPatronDeletion pref, but entries from the borrower to other lists are kept.
=cut
$hold->cancel;
}
- # Delete all lists and all shares of this borrower
- # Consistent with the approach Koha uses on deleting individual lists
- # Note that entries in virtualshelfcontents added by this borrower to
- # lists of others will be handled by a table constraint: the borrower
- # is set to NULL in those entries.
- # NOTE:
- # We could handle the above deletes via a constraint too.
- # But a new BZ report 11889 has been opened to discuss another approach.
- # Instead of deleting we could also disown lists (based on a pref).
- # In that way we could save shared and public lists.
- # The current table constraints support that idea now.
- # This pref should then govern the results of other routines/methods such as
- # Koha::Virtualshelf->new->delete too.
- # FIXME Could be $patron->get_lists
- $_->delete for Koha::Virtualshelves->search( { owner => $self->borrowernumber } );
+ # Handle lists (virtualshelves)
+ $self->virtualshelves->disown_or_delete;
# We cannot have a FK on borrower_modifications.borrowernumber, the table is also used
# for patron selfreg
- $_->delete for Koha::Patron::Modifications->search( { borrowernumber => $self->borrowernumber } );
+ $_->delete for Koha::Patron::Modifications->search( { borrowernumber => $self->borrowernumber } )->as_list;
$self->SUPER::delete;
return $self;
}
-
=head3 category
my $patron_category = $patron->category
Koha::Exceptions::BadParameter->throw( { parameter => 'only_this_guarantor' } ) unless @guarantors;
} elsif ( $self->guarantor_relationships->count ) {
# I am a guarantee, just get all my guarantors
- @guarantors = $self->guarantor_relationships->guarantors;
+ @guarantors = $self->guarantor_relationships->guarantors->as_list;
} else {
# I am a guarantor, I need to get all the guarantors of all my guarantees
- @guarantors = map { $_->guarantor_relationships->guarantors } $self->guarantee_relationships->guarantees;
+ @guarantors = map { $_->guarantor_relationships->guarantors->as_list } $self->guarantee_relationships->guarantees->as_list;
}
my $non_issues_charges = 0;
$non_issues_charges += $guarantor->account->non_issues_charges if $include_guarantors && !$seen->{ $guarantor->id };
# We've added what the guarantor owes, not added in that guarantor's guarantees as well
- my @guarantees = map { $_->guarantee } $guarantor->guarantee_relationships();
+ my @guarantees = map { $_->guarantee } $guarantor->guarantee_relationships->as_list;
my $guarantees_non_issues_charges = 0;
foreach my $guarantee (@guarantees) {
next if $seen->{ $guarantee->id };
sub siblings {
my ($self) = @_;
- my @guarantors = $self->guarantor_relationships()->guarantors();
+ my @guarantors = $self->guarantor_relationships()->guarantors()->as_list;
return unless @guarantors;
my @siblings =
- map { $_->guarantee_relationships()->guarantees() } @guarantors;
+ map { $_->guarantee_relationships()->guarantees()->as_list } @guarantors;
return unless @siblings;
@siblings =
grep { !$seen{ $_->id }++ && ( $_->id != $self->id ) } @siblings;
- return wantarray ? @siblings : Koha::Patrons->search( { borrowernumber => { -in => [ map { $_->id } @siblings ] } } );
+ return Koha::Patrons->search( { borrowernumber => { -in => [ map { $_->id } @siblings ] } } );
}
=head3 merge_with
];
$attributes->delete; # We need to delete before trying to merge them to prevent exception on unique and repeatable
for my $attribute ( @$new_attributes ) {
- $self->add_extended_attribute($attribute);
+ try {
+ $self->add_extended_attribute($attribute);
+ } catch {
+ # Don't block the merge if there is a non-repeatable attribute that cannot be added to the current patron.
+ unless ( $_->isa('Koha::Exceptions::Patron::Attribute::NonRepeatable') ) {
+ $_->rethrow;
+ }
+ };
}
while (my ($r, $field) = each(%$RESULTSET_PATRON_ID_MAPPING)) {
return 0;
}
+=head3 password_expired
+
+my $password_expired = $patron->password_expired;
+
+Returns 1 if the patron's password is expired or 0;
+
+=cut
+
+sub password_expired {
+ my ($self) = @_;
+ return 0 unless $self->password_expiration_date;
+ return 1 if dt_from_string( $self->password_expiration_date ) <= dt_from_string->truncate( to => 'day' );
+ return 0;
+}
+
=head3 is_going_to_expire
my $is_going_to_expire = $patron->is_going_to_expire;
}
}
+ if ( C4::Context->preference('NotifyPasswordChange') ) {
+ my $self_from_storage = $self->get_from_storage;
+ if ( !C4::Auth::checkpw_hash( $password, $self_from_storage->password ) ) {
+ my $emailaddr = $self_from_storage->notice_email_address;
+
+ # if we manage to find a valid email address, send notice
+ if ($emailaddr) {
+ my $letter = C4::Letters::GetPreparedLetter(
+ module => 'members',
+ letter_code => 'PASSWORD_CHANGE',
+ branchcode => $self_from_storage->branchcode,
+ ,
+ lang => $self_from_storage->lang || 'default',
+ tables => {
+ 'branches' => $self_from_storage->branchcode,
+ 'borrowers' => $self_from_storage->borrowernumber,
+ },
+ want_librarian => 1,
+ ) or return;
+
+ my $message_id = C4::Letters::EnqueueLetter(
+ {
+ letter => $letter,
+ borrowernumber => $self_from_storage->id,
+ to_address => $emailaddr,
+ message_transport_type => 'email'
+ }
+ );
+ C4::Letters::SendQueuedMessages( { message_id => $message_id } );
+ }
+ }
+ }
+
my $digest = Koha::AuthUtils::hash_password($password);
+ $self->password_expiration_date( $self->category->get_password_expiry_date || undef );
+
# We do not want to call $self->store and retrieve password from DB
$self->password($digest);
$self->login_attempts(0);
return Koha::Database->new->schema->resultset('Deletedborrower')->create($patron_infos);
}
-=head3 article_requests
+=head3 can_request_article
+
+ if ( $patron->can_request_article( $library->id ) ) { ... }
-my @requests = $borrower->article_requests();
-my $requests = $borrower->article_requests();
+Returns true if the patron can request articles. As limits apply for the patron
+on the same day, those completed the same day are considered as current.
-Returns either a list of ArticleRequests objects,
-or an ArtitleRequests object, depending on the
-calling context.
+A I<library_id> can be passed as parameter, falling back to userenv if absent.
=cut
-sub article_requests {
- my ( $self ) = @_;
+sub can_request_article {
+ my ($self, $library_id) = @_;
- $self->{_article_requests} ||= Koha::ArticleRequests->search({ borrowernumber => $self->borrowernumber() });
+ $library_id //= C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef;
- return $self->{_article_requests};
+ my $rule = Koha::CirculationRules->get_effective_rule(
+ {
+ branchcode => $library_id,
+ categorycode => $self->categorycode,
+ rule_name => 'open_article_requests_limit'
+ }
+ );
+
+ my $limit = ($rule) ? $rule->rule_value : undef;
+
+ return 1 unless defined $limit;
+
+ my $count = Koha::ArticleRequests->search(
+ [ { borrowernumber => $self->borrowernumber, status => [ 'REQUESTED', 'PENDING', 'PROCESSING' ] },
+ { borrowernumber => $self->borrowernumber, status => 'COMPLETED', updated_on => { '>=' => \'CAST(NOW() AS DATE)' } },
+ ]
+ )->count;
+ return $count < $limit ? 1 : 0;
}
-=head3 article_requests_current
+=head3 article_request_fee
+
+ my $fee = $patron->article_request_fee(
+ {
+ [ library_id => $library->id, ]
+ }
+ );
-my @requests = $patron->article_requests_current
+Returns the fee to be charged to the patron when it places an article request.
-Returns the article requests associated with this patron that are incomplete
+A I<library_id> can be passed as parameter, falling back to userenv if absent.
=cut
-sub article_requests_current {
- my ( $self ) = @_;
+sub article_request_fee {
+ my ($self, $params) = @_;
+
+ my $library_id = $params->{library_id};
- $self->{_article_requests_current} ||= Koha::ArticleRequests->search(
+ $library_id //= C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef;
+
+ my $rule = Koha::CirculationRules->get_effective_rule(
{
- borrowernumber => $self->id(),
- -or => [
- { status => Koha::ArticleRequest::Status::Pending },
- { status => Koha::ArticleRequest::Status::Processing }
- ]
+ branchcode => $library_id,
+ categorycode => $self->categorycode,
+ rule_name => 'article_request_fee'
}
);
- return $self->{_article_requests_current};
+ my $fee = ($rule) ? $rule->rule_value + 0 : 0;
+
+ return $fee;
}
-=head3 article_requests_finished
+=head3 add_article_request_fee_if_needed
-my @requests = $biblio->article_requests_finished
+ my $fee = $patron->add_article_request_fee_if_needed(
+ {
+ [ item_id => $item->id,
+ library_id => $library->id, ]
+ }
+ );
-Returns the article requests associated with this patron that are completed
+If an article request fee needs to be charged, it adds a debit to the patron's
+account.
+
+Returns the fee line.
+
+A I<library_id> can be passed as parameter, falling back to userenv if absent.
=cut
-sub article_requests_finished {
- my ( $self, $borrower ) = @_;
+sub add_article_request_fee_if_needed {
+ my ($self, $params) = @_;
+
+ my $library_id = $params->{library_id};
+ my $item_id = $params->{item_id};
+
+ $library_id //= C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef;
- $self->{_article_requests_finished} ||= Koha::ArticleRequests->search(
+ my $amount = $self->article_request_fee(
{
- borrowernumber => $self->id(),
- -or => [
- { status => Koha::ArticleRequest::Status::Completed },
- { status => Koha::ArticleRequest::Status::Canceled }
- ]
+ library_id => $library_id,
}
);
- return $self->{_article_requests_finished};
+ my $debit_line;
+
+ if ( $amount > 0 ) {
+ $debit_line = $self->account->add_debit(
+ {
+ amount => $amount,
+ user_id => C4::Context->userenv ? C4::Context->userenv->{'number'} : undef,
+ interface => C4::Context->interface,
+ library_id => $library_id,
+ type => 'ARTICLE_REQUEST',
+ item_id => $item_id,
+ }
+ );
+ }
+
+ return $debit_line;
+}
+
+=head3 article_requests
+
+ my $article_requests = $patron->article_requests;
+
+Returns the patron article requests.
+
+=cut
+
+sub article_requests {
+ my ($self) = @_;
+
+ return Koha::ArticleRequests->_new_from_dbic( scalar $self->_result->article_requests );
}
=head3 add_enrolment_fee_if_needed
return Koha::Old::Checkouts->_new_from_dbic( $old_checkouts );
}
-=head3 get_overdues
+=head3 overdues
-my $overdue_items = $patron->get_overdues
+my $overdue_items = $patron->overdues
Return the overdue items
=cut
-sub get_overdues {
+sub overdues {
my ($self) = @_;
my $dtf = Koha::Database->new->schema->storage->datetime_parser;
return $self->checkouts->search(
);
}
+
+=head3 restrictions
+
+ my $restrictions = $patron->restrictions;
+
+Returns the patron restrictions.
+
+=cut
+
+sub restrictions {
+ my ($self) = @_;
+ my $restrictions_rs = $self->_result->restrictions;
+ return Koha::Patron::Restrictions->_new_from_dbic($restrictions_rs);
+}
+
=head3 get_routing_lists
-my @routinglists = $patron->get_routing_lists
+my $routinglists = $patron->get_routing_lists
Returns the routing lists a patron is subscribed to.
=head3 get_age
-my $age = $patron->get_age
+ my $age = $patron->get_age
Return the age of the patron
sub get_age {
my ($self) = @_;
- my $today_str = dt_from_string->strftime("%Y-%m-%d");
- return unless $self->dateofbirth;
- my $dob_str = dt_from_string( $self->dateofbirth )->strftime("%Y-%m-%d");
- my ( $dob_y, $dob_m, $dob_d ) = split /-/, $dob_str;
- my ( $today_y, $today_m, $today_d ) = split /-/, $today_str;
+ return unless $self->dateofbirth;
- my $age = $today_y - $dob_y;
- if ( $dob_m . $dob_d > $today_m . $today_d ) {
- $age--;
- }
+ my $date_of_birth = dt_from_string( $self->dateofbirth );
+ my $today = dt_from_string->truncate( to => 'day' );
- return $age;
+ return $today->subtract_datetime( $date_of_birth )->years;
}
=head3 is_valid_age
return Koha::Old::Holds->_new_from_dbic($old_holds_rs);
}
+=head3 curbside_pickups
+
+my $curbside_pickups = $patron->curbside_pickups;
+
+Return all the curbside pickups for this patron
+
+=cut
+
+sub curbside_pickups {
+ my ($self) = @_;
+ my $curbside_pickups_rs = $self->_result->curbside_pickups_borrowernumbers->search;
+ return Koha::CurbsidePickups->_new_from_dbic($curbside_pickups_rs);
+}
+
=head3 return_claims
my $return_claims = $patron->return_claims
=cut
sub get_club_enrollments {
- my ( $self, $return_scalar ) = @_;
-
- my $e = Koha::Club::Enrollments->search( { borrowernumber => $self->borrowernumber(), date_canceled => undef } );
-
- return $e if $return_scalar;
+ my ( $self ) = @_;
- return wantarray ? $e->as_list : $e;
+ return Koha::Club::Enrollments->search( { borrowernumber => $self->borrowernumber(), date_canceled => undef } );
}
=head3 get_enrollable_clubs
=cut
sub get_enrollable_clubs {
- my ( $self, $is_enrollable_from_opac, $return_scalar ) = @_;
+ my ( $self, $is_enrollable_from_opac ) = @_;
my $params;
$params->{is_enrollable_from_opac} = $is_enrollable_from_opac
$params->{borrower} = $self;
- my $e = Koha::Clubs->get_enrollable($params);
-
- return $e if $return_scalar;
-
- return wantarray ? $e->as_list : $e;
+ return Koha::Clubs->get_enrollable($params);
}
=head3 account_locked
sub can_see_patron_infos {
my ( $self, $patron ) = @_;
return unless $patron;
- return $self->can_see_patrons_from( $patron->library->branchcode );
+ return $self->can_see_patrons_from( $patron->branchcode );
}
=head3 can_see_patrons_from
sub can_see_patrons_from {
my ( $self, $branchcode ) = @_;
+
+ return $self->can_see_things_from(
+ {
+ branchcode => $branchcode,
+ permission => 'borrowers',
+ subpermission => 'view_borrower_infos_from_any_libraries',
+ }
+ );
+}
+
+=head3 can_edit_items_from
+
+ my $can_edit = $patron->can_edit_items_from( $branchcode );
+
+Return true if the I<Koha::Patron> can edit items from the given branchcode
+
+=cut
+
+sub can_edit_items_from {
+ my ( $self, $branchcode ) = @_;
+
+ return 1 if C4::Context->IsSuperLibrarian();
+
+ my $userenv = C4::Context->userenv();
+ if ( $userenv && C4::Context->preference('IndependentBranches') ) {
+ return $userenv->{branch} eq $branchcode;
+ }
+
+ return $self->can_see_things_from(
+ {
+ branchcode => $branchcode,
+ permission => 'editcatalogue',
+ subpermission => 'edit_any_item',
+ }
+ );
+}
+
+=head3 libraries_where_can_edit_items
+
+ my $libraries = $patron->libraries_where_can_edit_items;
+
+Return the list of branchcodes(!) of libraries the patron is allowed to items for.
+The branchcodes are arbitrarily returned sorted.
+We are supposing here that the object is related to the logged in patron (use of C4::Context::only_my_library)
+
+An empty array means no restriction, the user can edit any item.
+
+=cut
+
+sub libraries_where_can_edit_items {
+ my ($self) = @_;
+
+ return $self->libraries_where_can_see_things(
+ {
+ permission => 'editcatalogue',
+ subpermission => 'edit_any_item',
+ group_feature => 'ft_limit_item_editing',
+ }
+ );
+}
+
+=head3 libraries_where_can_see_patrons
+
+my $libraries = $patron->libraries_where_can_see_patrons;
+
+Return the list of branchcodes(!) of libraries the patron is allowed to see other patron's infos.
+The branchcodes are arbitrarily returned sorted.
+We are supposing here that the object is related to the logged in patron (use of C4::Context::only_my_library)
+
+An empty array means no restriction, the patron can see patron's infos from any libraries.
+
+=cut
+
+sub libraries_where_can_see_patrons {
+ my ($self) = @_;
+
+ return $self->libraries_where_can_see_things(
+ {
+ permission => 'borrowers',
+ subpermission => 'view_borrower_infos_from_any_libraries',
+ group_feature => 'ft_hide_patron_info',
+ }
+ );
+}
+
+=head3 can_see_things_from
+
+my $can_see = $patron->can_see_things_from( $branchcode );
+
+Return true if the I<Koha::Patron> can perform some action on the given thing
+
+=cut
+
+sub can_see_things_from {
+ my ( $self, $params ) = @_;
+
+ my $branchcode = $params->{branchcode};
+ my $permission = $params->{permission};
+ my $subpermission = $params->{subpermission};
+
+ return 1 if C4::Context->IsSuperLibrarian();
+
my $can = 0;
if ( $self->branchcode eq $branchcode ) {
$can = 1;
- } elsif ( $self->has_permission( { borrowers => 'view_borrower_infos_from_any_libraries' } ) ) {
+ } elsif ( $self->has_permission( { $permission => $subpermission } ) ) {
$can = 1;
} elsif ( my $library_groups = $self->library->library_groups ) {
while ( my $library_group = $library_groups->next ) {
return $can;
}
-=head3 libraries_where_can_see_patrons
+=head3 libraries_where_can_see_things
-my $libraries = $patron-libraries_where_can_see_patrons;
+ my $libraries = $patron->libraries_where_can_see_things;
-Return the list of branchcodes(!) of libraries the patron is allowed to see other patron's infos.
-The branchcodes are arbitrarily returned sorted.
-We are supposing here that the object is related to the logged in patron (use of C4::Context::only_my_library)
+Returns a list of libraries where an aribitarary action is allowed to be taken by the logged in librarian
+against an object based on some branchcode related to the object ( patron branchcode, item homebranch, etc ).
-An empty array means no restriction, the patron can see patron's infos from any libraries.
+We are supposing here that the object is related to the logged in librarian (use of C4::Context::only_my_library)
+
+An empty array means no restriction, the thing can see thing's infos from any libraries.
=cut
-sub libraries_where_can_see_patrons {
- my ( $self ) = @_;
+sub libraries_where_can_see_things {
+ my ( $self, $params ) = @_;
+ my $permission = $params->{permission};
+ my $subpermission = $params->{subpermission};
+ my $group_feature = $params->{group_feature};
+
my $userenv = C4::Context->userenv;
return () unless $userenv; # For tests, but userenv should be defined in tests...
else {
unless (
$self->has_permission(
- { borrowers => 'view_borrower_infos_from_any_libraries' }
+ { $permission => $subpermission }
)
)
{
- my $library_groups = $self->library->library_groups({ ft_hide_patron_info => 1 });
+ my $library_groups = $self->library->library_groups({ $group_feature => 1 });
if ( $library_groups->count )
{
while ( my $library_group = $library_groups->next ) {
=head3 generate_userid
-my $patron = Koha::Patron->new( $params );
-$patron->generate_userid
+ $patron->generate_userid;
-Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
+ If you do not have a plugin for generating a userid, we will call
+ the internal method here that returns firstname.surname[.number],
+ where number is an optional suffix to make the userid unique.
+ (Its behavior has not been changed on bug 32426.)
-Set a generated 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).
+ If you have plugin(s), the first valid response will be used.
+ A plugin is assumed to return a valid userid as suggestion, but not
+ assumed to save it already.
+ Does not fallback to internal (you could arrange for that in your plugin).
+ Clears userid when there are no valid plugin responses.
=cut
sub generate_userid {
+ my ( $self ) = @_;
+ my @responses = Koha::Plugins->call(
+ 'patron_generate_userid', { patron => $self },
+ );
+ unless( @responses ) {
+ # Empty list only possible when there are NO enabled plugins for this method.
+ # In that case we provide internal response.
+ return $self->_generate_userid_internal;
+ }
+ # If a plugin returned false value or invalid value, we do however not return
+ # internal response. The plugins should deal with that themselves. So we prevent
+ # unexpected/unwelcome internal codes for plugin failures.
+ foreach my $response ( grep { $_ } @responses ) {
+ $self->userid( $response );
+ return $self if $self->has_valid_userid;
+ }
+ $self->userid(undef);
+ return $self;
+}
+
+sub _generate_userid_internal { # as we always did
my ($self) = @_;
my $offset = 0;
my $firstname = $self->firstname // q{};
Koha::Patron::Attribute::Types->search(
{
mandatory => 1,
+ category_code => [ undef, $self->categorycode ],
'borrower_attribute_types_branches.b_branchcode' =>
- undef
+ undef,
},
{ join => 'borrower_attribute_types_branches' }
)->get_column('code');
return Koha::Patron::Attributes->_new_from_dbic($rs)->search;
}
+=head3 messages
+
+ my $messages = $patron->messages;
+
+Return the message attached to the patron.
+
+=cut
+
+sub messages {
+ my ( $self ) = @_;
+ my $messages_rs = $self->_result->messages_borrowernumbers->search;
+ return Koha::Patron::Messages->_new_from_dbic($messages_rs);
+}
+
=head3 lock
Koha::Patrons->find($id)->lock({ expire => 1, remove => 1 });
split /\s*\|\s*/, C4::Context->preference('BorrowerMandatoryField') };
$mandatory->{userid} = 1; # needed since sub store does not clear field
my @columns = $self->_result->result_source->columns;
- @columns = grep { !/borrowernumber|branchcode|categorycode|^date|password|flags|updated_on|lastseen|lang|login_attempts|anonymized/ } @columns;
+ @columns = grep { !/borrowernumber|branchcode|categorycode|^date|password|flags|updated_on|lastseen|lang|login_attempts|anonymized|auth_method/ } @columns;
push @columns, 'dateofbirth'; # add this date back in
foreach my $col (@columns) {
$self->_anonymize_column($col, $mandatory->{lc $col} );
=head3 add_guarantor
- my @relationships = $patron->add_guarantor(
+ my $relationship = $patron->add_guarantor(
{
borrowernumber => $borrowernumber,
relationships => $relationship,
emailpro => 'secondary_email',
flags => undef, # permissions manipulation handled in /permissions
gonenoaddress => 'incorrect_address',
- guarantorid => 'guarantor_id',
lastseen => 'last_seen',
lost => 'patron_card_lost',
opacnote => 'opac_notes',
altcontactphone => 'altcontact_phone',
altcontactsurname => 'altcontact_surname',
altcontactstate => 'altcontact_state',
- altcontactzipcode => 'altcontact_postal_code'
+ altcontactzipcode => 'altcontact_postal_code',
+ password_expiration_date => undef,
+ primary_contact_method => undef,
+ secret => undef,
+ auth_method => undef,
};
}
return unless exists $params->{message_name} xor $params->{message_transports}; # We only want one of these
my $library = Koha::Libraries->find( $letter_params->{branchcode} );
- my $admin_email_address = $library->inbound_email_address;
+ my $from_email_address = $library->from_email_address;
my @message_transports;
my $letter_code;
C4::Letters::EnqueueLetter({
letter => $letter,
borrowernumber => $self->borrowernumber,
- from_address => $admin_email_address,
+ from_address => $from_email_address,
message_transport_type => $mtt
}) unless $test_mode;
push @{$return{sent}}, $mtt;
return \%return;
}
+=head3 safe_to_delete
+
+ my $result = $patron->safe_to_delete;
+ if ( $result eq 'has_guarantees' ) { ... }
+ elsif ( $result ) { ... }
+ else { # cannot delete }
+
+This method tells if the Koha:Patron object can be deleted. Possible return values
+
+=over 4
+
+=item 'ok'
+
+=item 'has_checkouts'
+
+=item 'has_debt'
+
+=item 'has_guarantees'
+
+=item 'is_anonymous_patron'
+
+=back
+
+=cut
+
+sub safe_to_delete {
+ my ($self) = @_;
+
+ my $anonymous_patron = C4::Context->preference('AnonymousPatron');
+
+ my $error;
+
+ if ( $anonymous_patron && $self->id eq $anonymous_patron ) {
+ $error = 'is_anonymous_patron';
+ }
+ elsif ( $self->checkouts->count ) {
+ $error = 'has_checkouts';
+ }
+ elsif ( $self->account->outstanding_debits->total_outstanding > 0 ) {
+ $error = 'has_debt';
+ }
+ elsif ( $self->guarantee_relationships->count ) {
+ $error = 'has_guarantees';
+ }
+
+ if ( $error ) {
+ return Koha::Result::Boolean->new(0)->add_message({ message => $error });
+ }
+
+ return Koha::Result::Boolean->new(1);
+}
+
+=head3 recalls
+
+ my $recalls = $patron->recalls;
+
+Return the patron's recalls.
+
+=cut
+
+sub recalls {
+ my ( $self ) = @_;
+
+ return Koha::Recalls->search({ patron_id => $self->borrowernumber });
+}
+
+=head3 account_balance
+
+ my $balance = $patron->account_balance
+
+Return the patron's account balance
+
+=cut
+
+sub account_balance {
+ my ($self) = @_;
+ return $self->account->balance;
+}
+
+=head3 notify_library_of_registration
+
+$patron->notify_library_of_registration( $email_patron_registrations );
+
+Send patron registration email to library if EmailPatronRegistrations system preference is enabled.
+
+=cut
+
+sub notify_library_of_registration {
+ my ( $self, $email_patron_registrations ) = @_;
+
+ if (
+ my $letter = C4::Letters::GetPreparedLetter(
+ module => 'members',
+ letter_code => 'OPAC_REG',
+ branchcode => $self->branchcode,
+ lang => $self->lang || 'default',
+ tables => {
+ 'borrowers' => $self->borrowernumber
+ },
+ )
+ ) {
+ my $to_address;
+ if ( $email_patron_registrations eq "BranchEmailAddress" ) {
+ my $library = Koha::Libraries->find( $self->branchcode );
+ $to_address = $library->inbound_email_address;
+ }
+ elsif ( $email_patron_registrations eq "KohaAdminEmailAddress" ) {
+ $to_address = C4::Context->preference('ReplytoDefault')
+ || C4::Context->preference('KohaAdminEmailAddress');
+ }
+ else {
+ $to_address =
+ C4::Context->preference('EmailAddressForPatronRegistrations')
+ || C4::Context->preference('ReplytoDefault')
+ || C4::Context->preference('KohaAdminEmailAddress');
+ }
+
+ my $message_id = C4::Letters::EnqueueLetter(
+ {
+ letter => $letter,
+ borrowernumber => $self->borrowernumber,
+ to_address => $to_address,
+ message_transport_type => 'email'
+ }
+ ) or warn "can't enqueue letter $letter";
+ if ( $message_id ) {
+ return 1;
+ }
+ }
+}
+
+=head3 has_messaging_preference
+
+my $bool = $patron->has_messaging_preference({
+ message_name => $message_name, # A value from message_attributes.message_name
+ message_transport_type => $message_transport_type, # email, sms, phone, itiva, etc...
+ wants_digest => $wants_digest, # 1 if you are looking for the digest version, don't pass if you just want either
+});
+
+=cut
+
+sub has_messaging_preference {
+ my ( $self, $params ) = @_;
+
+ my $message_name = $params->{message_name};
+ my $message_transport_type = $params->{message_transport_type};
+ my $wants_digest = $params->{wants_digest};
+
+ return $self->_result->search_related_rs(
+ 'borrower_message_preferences',
+ $params,
+ {
+ prefetch =>
+ [ 'borrower_message_transport_preferences', 'message_attribute' ]
+ }
+ )->count;
+}
+
+=head3 can_patron_change_staff_only_lists
+
+$patron->can_patron_change_staff_only_lists;
+
+Return 1 if a patron has 'Superlibrarian' or 'Catalogue' permission.
+Otherwise, return 0.
+
+=cut
+
+sub can_patron_change_staff_only_lists {
+ my ( $self, $params ) = @_;
+ return 1 if C4::Auth::haspermission( $self->userid, { 'catalogue' => 1 });
+ return 0;
+}
+
+=head3 encode_secret
+
+ $patron->encode_secret($secret32);
+
+Secret (TwoFactorAuth expects it in base32 format) is encrypted.
+You still need to call ->store.
+
+=cut
+
+sub encode_secret {
+ my ( $self, $secret ) = @_;
+ if( $secret ) {
+ return $self->secret( Koha::Encryption->new->encrypt_hex($secret) );
+ }
+ return $self->secret($secret);
+}
+
+=head3 decoded_secret
+
+ my $secret32 = $patron->decoded_secret;
+
+Decode the patron secret. We expect to get back a base32 string, but this
+is not checked here. Caller of encode_secret is responsible for that.
+
+=cut
+
+sub decoded_secret {
+ my ( $self ) = @_;
+ if( $self->secret ) {
+ return Koha::Encryption->new->decrypt_hex( $self->secret );
+ }
+ return $self->secret;
+}
+
+=head3 virtualshelves
+
+ my $shelves = $patron->virtualshelves;
+
+=cut
+
+sub virtualshelves {
+ my $self = shift;
+ return Koha::Virtualshelves->_new_from_dbic( scalar $self->_result->virtualshelves );
+}
+
+=head3 get_savings
+
+ my $savings = $patron->get_savings;
+
+Use the replacement price of patron's old and current issues to calculate how much they have 'saved' by using the library.
+
+=cut
+
+sub get_savings {
+ my ($self) = @_;
+
+ my @itemnumbers = grep { defined $_ } ( $self->old_checkouts->get_column('itemnumber'), $self->checkouts->get_column('itemnumber') );
+
+ return Koha::Items->search(
+ { itemnumber => { -in => \@itemnumbers } },
+ { select => [ { sum => 'me.replacementprice' } ],
+ as => ['total_savings']
+ }
+ )->next->get_column('total_savings') // 0;
+}
+
=head2 Internal methods
=head3 _type
projects / srvgit / blobdiff