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::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;
- $self->date_renewed(undef) unless $self->date_renewed;
- $self->lastseen(undef) unless $self->lastseen;
-
- if ( defined $self->updated_on and not $self->updated_on ) {
- $self->updated_on(undef);
- }
-
- # Set default values if not set
- $self->sms_provider_id(undef) unless $self->sms_provider_id;
- $self->guarantorid(undef) unless $self->guarantorid;
-
- # If flags == 0 or flags == '' => no permission
- $self->flags(undef) unless $self->flags;
-
- # tinyint or int
- $self->gonenoaddress(0) unless $self->gonenoaddress;
- $self->login_attempts(0) unless $self->login_attempts;
- $self->privacy_guarantor_checkouts(0) unless $self->privacy_guarantor_checkouts;
- $self->lost(0) unless $self->lost;
-
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->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;
}
}
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