use Modern::Perl;
use Carp;
-use List::MoreUtils qw( uniq );
+use List::MoreUtils qw( any uniq );
use JSON qw( to_json );
use Text::Unaccent qw( unac_string );
-use C4::Accounts;
use C4::Context;
use C4::Log;
use Koha::AuthUtils;
use Koha::Checkouts;
use Koha::Database;
use Koha::DateUtils;
+use Koha::Exceptions::Password;
use Koha::Holds;
use Koha::Old::Checkouts;
+use Koha::Patron::Attributes;
use Koha::Patron::Categories;
use Koha::Patron::HouseboundProfile;
use Koha::Patron::HouseboundRole;
=head2 Class Methods
-=cut
-
=head3 new
=cut
$self->trim_whitespaces;
- # We don't want invalid dates in the db (mysql has a bad habit of inserting 0000-00-00)
- $self->dateofbirth(undef) unless $self->dateofbirth;
- $self->debarred(undef) unless $self->debarred;
-
- # Set default values if not set
- $self->sms_provider_id(undef) unless $self->sms_provider_id;
- $self->guarantorid(undef) unless $self->guarantorid;
-
unless ( $self->in_storage ) { #AddMember
# Generate a valid userid/login if needed
: undef;
$self->privacy($default_privacy);
- unless ( defined $self->privacy_guarantor_checkouts ) {
- $self->privacy_guarantor_checkouts(0);
- }
# Make a copy of the plain text password for later use
$self->plain_text_password( $self->password );
}
else { #ModMember
- # Come from ModMember, but should not be possible (?)
- $self->dateenrolled(undef) unless $self->dateenrolled;
- $self->dateexpiry(undef) unless $self->dateexpiry;
-
-
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
$self->userid($stored_userid);
}
- # Password must be updated using $self->update_password
+ # Password must be updated using $self->set_password
$self->password($self_from_storage->password);
if ( C4::Context->preference('FeeOnChangePatronCategory')
$self->add_enrolment_fee_if_needed;
}
- my $borrowers_log = C4::Context->preference("BorrowersLog");
- my $previous_cardnumber = $self_from_storage->cardnumber;
- if ($borrowers_log
- && ( !defined $previous_cardnumber
- || $previous_cardnumber ne $self->cardnumber )
- )
- {
- logaction(
- "MEMBERS",
- "MODIFY",
- $self->borrowernumber,
- to_json(
- {
- cardnumber_replaced => {
- previous_cardnumber => $previous_cardnumber,
- new_cardnumber => $self->cardnumber,
- }
- },
- { utf8 => 1, pretty => 1 }
- )
- );
- }
+ # Actionlogs
+ if ( C4::Context->preference("BorrowersLog") ) {
+ my $info;
+ my $from_storage = $self_from_storage->unblessed;
+ my $from_object = $self->unblessed;
+ my @skip_fields = (qw/lastseen/);
+ for my $key ( keys %{$from_storage} ) {
+ next if any { /$key/ } @skip_fields;
+ if (
+ (
+ !defined( $from_storage->{$key} )
+ && defined( $from_object->{$key} )
+ )
+ || ( defined( $from_storage->{$key} )
+ && !defined( $from_object->{$key} ) )
+ || (
+ defined( $from_storage->{$key} )
+ && defined( $from_object->{$key} )
+ && ( $from_storage->{$key} ne
+ $from_object->{$key} )
+ )
+ )
+ {
+ $info->{$key} = {
+ before => $from_storage->{$key},
+ after => $from_object->{$key}
+ };
+ }
+ }
- logaction( "MEMBERS", "MODIFY", $self->borrowernumber,
- "UPDATE (executed w/ arg: " . $self->borrowernumber . ")" )
- if $borrowers_log;
+ if ( defined($info) ) {
+ logaction(
+ "MEMBERS",
+ "MODIFY",
+ $self->borrowernumber,
+ to_json(
+ $info,
+ { utf8 => 1, pretty => 1, canonical => 1 }
+ )
+ );
+ }
+ }
+ # Final store
$self = $self->SUPER::store;
}
}
return 0;
}
-=head3 update_password
+=head3 set_password
-my $updated = $patron->update_password( $userid, $password );
+ $patron->set_password({ password => $plain_text_password [, skip_validation => 1 ] });
-Update the userid and the password of a patron.
-If the userid already exists, returns and let DBIx::Class warns
-This will add an entry to action_logs if BorrowersLog is set.
+Set the patron's password.
+
+=head4 Exceptions
+
+The passed string is validated against the current password enforcement policy.
+Validation can be skipped by passing the I<skip_validation> parameter.
+
+Exceptions are thrown if the password is not good enough.
+
+=over 4
+
+=item Koha::Exceptions::Password::TooShort
+
+=item Koha::Exceptions::Password::WhitespaceCharacters
+
+=item Koha::Exceptions::Password::TooWeak
+
+=back
=cut
-sub update_password {
- my ( $self, $userid, $password ) = @_;
- eval { $self->userid($userid)->store; };
- return if $@; # Make sure the userid is not already in used by another patron
+sub set_password {
+ my ( $self, $args ) = @_;
+
+ my $password = $args->{password};
- return 0 if $password eq '****' or $password eq '';
+ unless ( $args->{skip_validation} ) {
+ my ( $is_valid, $error ) = Koha::AuthUtils::is_password_valid( $password );
+
+ if ( !$is_valid ) {
+ if ( $error eq 'too_short' ) {
+ my $min_length = C4::Context->preference('minPasswordLength');
+ $min_length = 3 if not $min_length or $min_length < 3;
+
+ my $password_length = length($password);
+ Koha::Exceptions::Password::TooShort->throw(
+ length => $password_length, min_length => $min_length );
+ }
+ elsif ( $error eq 'has_whitespaces' ) {
+ Koha::Exceptions::Password::WhitespaceCharacters->throw();
+ }
+ elsif ( $error eq 'too_weak' ) {
+ Koha::Exceptions::Password::TooWeak->throw();
+ }
+ }
+ }
my $digest = Koha::AuthUtils::hash_password($password);
$self->update(
- {
- password => $digest,
+ { password => $digest,
login_attempts => 0,
}
);
- logaction( "MEMBERS", "CHANGE PASS", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog");
- return $digest;
+ logaction( "MEMBERS", "CHANGE PASS", $self->borrowernumber, "" )
+ if C4::Context->preference("BorrowersLog");
+
+ return $self;
}
+
=head3 renew_account
my $new_expiry_date = $patron->renew_account
my ($self) = @_;
my $enrolment_fee = $self->category->enrolmentfee;
if ( $enrolment_fee && $enrolment_fee > 0 ) {
- # insert fee in patron debts
- C4::Accounts::manualinvoice( $self->borrowernumber, '', '', 'A', $enrolment_fee );
+ $self->account->add_debit(
+ {
+ amount => $enrolment_fee,
+ user_id => C4::Context->userenv ? C4::Context->userenv->{'number'} : undef,
+ interface => C4::Context->interface,
+ library_id => C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef,
+ type => 'account'
+ }
+ );
}
return $enrolment_fee || 0;
}
It should not be used directly, prefer to access fields you need instead of
retrieving all these fields in one go.
-
=cut
sub pending_checkouts {
my $is_locked = $patron->account_locked
-Return true if the patron has reach the maximum number of login attempts (see pref FailedLoginAttempts).
+Return true if the patron has reached the maximum number of login attempts
+(see pref FailedLoginAttempts). If login_attempts is < 0, this is interpreted
+as an administrative lockout (independent of FailedLoginAttempts; see also
+Koha::Patron->lock).
Otherwise return false.
-If the pref is not set (empty string, null or 0), the feature is considered as disabled.
+If the pref is not set (empty string, null or 0), the feature is considered as
+disabled.
=cut
sub account_locked {
my ($self) = @_;
my $FailedLoginAttempts = C4::Context->preference('FailedLoginAttempts');
- return ( $FailedLoginAttempts
+ return 1 if $FailedLoginAttempts
and $self->login_attempts
- and $self->login_attempts >= $FailedLoginAttempts )? 1 : 0;
+ and $self->login_attempts >= $FailedLoginAttempts;
+ return 1 if ($self->login_attempts || 0) < 0; # administrative lockout
+ return 0;
}
=head3 can_see_patron_infos
sub can_see_patron_infos {
my ( $self, $patron ) = @_;
+ return unless $patron;
return $self->can_see_patrons_from( $patron->library->branchcode );
}
Return true if the patron has a category with a type Child (C)
=cut
+
sub is_child {
my( $self ) = @_;
return $self->category->category_type eq 'C' ? 1 : 0;
}
+=head3 attributes
+
+my $attributes = $patron->attributes
+
+Return object of Koha::Patron::Attributes type with all attributes set for this patron
+
+=cut
+
+sub attributes {
+ my ( $self ) = @_;
+ return Koha::Patron::Attributes->search({
+ borrowernumber => $self->borrowernumber,
+ branchcode => $self->branchcode,
+ });
+}
+
=head2 Internal methods
=head3 _type
return 'Borrower';
}
-=head1 AUTHOR
+=head1 AUTHORS
Kyle M Hall <kyle@bywatersolutions.com>
Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
+Martin Renvoize <martin.renvoize@ptfs-europe.com>
=cut
projects / koha-equinox.git / blobdiff