X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=blobdiff_plain;f=Koha%2FPatron.pm;h=eeaf0e4dc27680db524a1f0516bdebfacc28ffb7;hb=a23577cefae2312efe4f91709dccdf39370504d9;hp=84592995e244330007c77f9880622e57f82376b3;hpb=43b60d6eed5a028fcc629b7db8b33e93d1dd680b;p=koha_ffzg diff --git a/Koha/Patron.pm b/Koha/Patron.pm index 84592995e2..eeaf0e4dc2 100644 --- a/Koha/Patron.pm +++ b/Koha/Patron.pm @@ -21,13 +21,17 @@ package Koha::Patron; 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::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::Categories; @@ -38,9 +42,40 @@ use Koha::Patrons; use Koha::Virtualshelves; use Koha::Club::Enrollments; use Koha::Account; +use Koha::Subscription::Routinglists; use base qw(Koha::Object); +our $RESULTSET_PATRON_ID_MAPPING = { + Accountline => 'borrowernumber', + Aqbasketuser => 'borrowernumber', + Aqbudget => 'budget_owner_id', + Aqbudgetborrower => 'borrowernumber', + ArticleRequest => 'borrowernumber', + BorrowerAttribute => 'borrowernumber', + BorrowerDebarment => 'borrowernumber', + BorrowerFile => 'borrowernumber', + BorrowerModification => 'borrowernumber', + ClubEnrollment => 'borrowernumber', + Issue => 'borrowernumber', + ItemsLastBorrower => 'borrowernumber', + Linktracker => 'borrowernumber', + Message => 'borrowernumber', + MessageQueue => 'borrowernumber', + OldIssue => 'borrowernumber', + OldReserve => 'borrowernumber', + Rating => 'borrowernumber', + Reserve => 'borrowernumber', + Review => 'borrowernumber', + SearchHistory => 'userid', + Statistic => 'borrowernumber', + Suggestion => 'suggestedby', + TagAll => 'borrowernumber', + Virtualshelfcontent => 'borrowernumber', + Virtualshelfshare => 'borrowernumber', + Virtualshelve => 'owner', +}; + =head1 NAME Koha::Patron - Koha Patron Object class @@ -49,8 +84,225 @@ Koha::Patron - Koha Patron Object class =head2 Class Methods +=head3 new + +=cut + +sub new { + my ( $class, $params ) = @_; + + return $class->SUPER::new($params); +} + +=head3 fixup_cardnumber + +Autogenerate next cardnumber from highest value found in database + =cut +sub fixup_cardnumber { + my ( $self ) = @_; + my $max = Koha::Patrons->search({ + cardnumber => {-regexp => '^-?[0-9]+$'} + }, { + select => \'CAST(cardnumber AS SIGNED)', + as => ['cast_cardnumber'] + })->_resultset->get_column('cast_cardnumber')->max; + $self->cardnumber(($max || 0) +1); +} + +=head3 trim_whitespace + +trim whitespace from data which has some non-whitespace in it. +Could be moved to Koha::Object if need to be reused + +=cut + +sub trim_whitespaces { + my( $self ) = @_; + + my $schema = Koha::Database->new->schema; + my @columns = $schema->source($self->_type)->columns; + + for my $column( @columns ) { + my $value = $self->$column; + if ( defined $value ) { + $value =~ s/^\s*|\s*$//g; + $self->$column($value); + } + } + return $self; +} + +=head3 plain_text_password + +$patron->plain_text_password( $password ); + +stores a copy of the unencrypted password in the object +for use in code before encrypting for db + +=cut + +sub plain_text_password { + my ( $self, $password ) = @_; + if ( $password ) { + $self->{_plain_text_password} = $password; + return $self; + } + return $self->{_plain_text_password} + if $self->{_plain_text_password}; + + return; +} + +=head3 store + +Patron specific store method to cleanup record +and do other necessary things before saving +to db + +=cut + +sub store { + my ($self) = @_; + + $self->_result->result_source->schema->txn_do( + sub { + if ( + C4::Context->preference("autoMemberNum") + and ( not defined $self->cardnumber + or $self->cardnumber eq '' ) + ) + { + # Warning: The caller is responsible for locking the members table in write + # mode, to avoid database corruption. + # We are in a transaction but the table is not locked + $self->fixup_cardnumber; + } + + unless( $self->category->in_storage ) { + Koha::Exceptions::Object::FKConstraint->throw( + broken_fk => 'categorycode', + value => $self->categorycode, + ); + } + + $self->trim_whitespaces; + + 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; + + # Add expiration date if it isn't already there + unless ( $self->dateexpiry ) { + $self->dateexpiry( $self->category->get_expiry_date ); + } + + # Add enrollment date if it isn't already there + unless ( $self->dateenrolled ) { + $self->dateenrolled(dt_from_string); + } + + # Set the privacy depending on the patron's category + my $default_privacy = $self->category->default_privacy || q{}; + $default_privacy = + $default_privacy eq 'default' ? 1 + : $default_privacy eq 'never' ? 2 + : $default_privacy eq 'forever' ? 0 + : undef; + $self->privacy($default_privacy); + + + # Make a copy of the plain text password for later use + $self->plain_text_password( $self->password ); + + # Create a disabled account if no password provided + $self->password( $self->password + ? Koha::AuthUtils::hash_password( $self->password ) + : '!' ); + + $self->borrowernumber(undef); + + $self = $self->SUPER::store; + + $self->add_enrolment_fee_if_needed; + + logaction( "MEMBERS", "CREATE", $self->borrowernumber, "" ) + if C4::Context->preference("BorrowersLog"); + } + 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); + } + + # Password must be updated using $self->set_password + $self->password($self_from_storage->password); + + if ( C4::Context->preference('FeeOnChangePatronCategory') + and $self->category->categorycode ne + $self_from_storage->category->categorycode ) + { + $self->add_enrolment_fee_if_needed; + } + + # 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} + }; + } + } + + if ( defined($info) ) { + logaction( + "MEMBERS", + "MODIFY", + $self->borrowernumber, + to_json( + $info, + { utf8 => 1, pretty => 1, canonical => 1 } + ) + ); + } + } + + # Final store + $self = $self->SUPER::store; + } + } + ); + return $self; +} + =head3 delete $patron->delete @@ -143,7 +395,7 @@ Returns the guarantees (list of Koha::Patron) of this patron sub guarantees { my ( $self ) = @_; - return Koha::Patrons->search( { guarantorid => $self->borrowernumber } ); + return Koha::Patrons->search( { guarantorid => $self->borrowernumber }, { order_by => { -asc => ['surname','firstname'] } } ); } =head3 housebound_profile @@ -200,6 +452,54 @@ sub siblings { ); } +=head3 merge_with + + my $patron = Koha::Patrons->find($id); + $patron->merge_with( \@patron_ids ); + + This subroutine merges a list of patrons into the patron record. This is accomplished by finding + all related patron ids for the patrons to be merged in other tables and changing the ids to be that + of the keeper patron. + +=cut + +sub merge_with { + my ( $self, $patron_ids ) = @_; + + my @patron_ids = @{ $patron_ids }; + + # Ensure the keeper isn't in the list of patrons to merge + @patron_ids = grep { $_ ne $self->id } @patron_ids; + + my $schema = Koha::Database->new()->schema(); + + my $results; + + $self->_result->result_source->schema->txn_do( sub { + foreach my $patron_id (@patron_ids) { + my $patron = Koha::Patrons->find( $patron_id ); + + next unless $patron; + + # Unbless for safety, the patron will end up being deleted + $results->{merged}->{$patron_id}->{patron} = $patron->unblessed; + + while (my ($r, $field) = each(%$RESULTSET_PATRON_ID_MAPPING)) { + my $rs = $schema->resultset($r)->search({ $field => $patron_id }); + $results->{merged}->{ $patron_id }->{updated}->{$r} = $rs->count(); + $rs->update({ $field => $self->id }); + } + + $patron->move_to_deleted(); + $patron->delete(); + } + }); + + return $results; +} + + + =head3 wants_check_for_previous_checkout $wants_check = $patron->wants_check_for_previous_checkout; @@ -297,7 +597,7 @@ Returns 1 if the patron is expired or 0; sub is_expired { my ($self) = @_; return 0 unless $self->dateexpiry; - return 0 if $self->dateexpiry eq '0000-00-00'; + return 0 if $self->dateexpiry =~ '^9999'; return 1 if dt_from_string( $self->dateexpiry ) < dt_from_string->truncate( to => 'day' ); return 0; } @@ -317,35 +617,76 @@ sub is_going_to_expire { return 0 unless $delay; return 0 unless $self->dateexpiry; - return 0 if $self->dateexpiry eq '0000-00-00'; + return 0 if $self->dateexpiry =~ '^9999'; return 1 if dt_from_string( $self->dateexpiry )->subtract( days => $delay ) < dt_from_string->truncate( to => 'day' ); return 0; } -=head3 update_password +=head3 set_password + + $patron->set_password({ password => $plain_text_password [, skip_validation => 1 ] }); + +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 parameter. + +Exceptions are thrown if the password is not good enough. -my $updated = $patron->update_password( $userid, $password ); +=over 4 -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. +=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}; + + 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 => $password, + { password => $digest, login_attempts => 0, } ); - logaction( "MEMBERS", "CHANGE PASS", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog"); - return 1; + + logaction( "MEMBERS", "CHANGE PASS", $self->borrowernumber, "" ) + if C4::Context->preference("BorrowersLog"); + + return $self; } + =head3 renew_account my $new_expiry_date = $patron->renew_account @@ -505,8 +846,14 @@ sub add_enrolment_fee_if_needed { 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'} : 0, + library_id => C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef, + type => 'account' + } + ); } return $enrolment_fee || 0; } @@ -523,6 +870,36 @@ sub checkouts { return Koha::Checkouts->_new_from_dbic( $checkouts ); } +=head3 pending_checkouts + +my $pending_checkouts = $patron->pending_checkouts + +This method will return the same as $self->checkouts, but with a prefetch on +items, biblio and biblioitems. + +It has been introduced to replaced the C4::Members::GetPendingIssues subroutine + +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( $self ) = @_; + my $checkouts = $self->_result->issues->search( + {}, + { + order_by => [ + { -desc => 'me.timestamp' }, + { -desc => 'issuedate' }, + { -desc => 'issue_id' }, # Sort by issue_id should be enough + ], + prefetch => { item => { biblio => 'biblioitems' } }, + } + ); + return Koha::Checkouts->_new_from_dbic( $checkouts ); +} + =head3 old_checkouts my $old_checkouts = $patron->old_checkouts @@ -539,7 +916,7 @@ sub old_checkouts { my $overdue_items = $patron->get_overdues -Return the overdued items +Return the overdue items =cut @@ -556,6 +933,20 @@ sub get_overdues { ); } +=head3 get_routing_lists + +my @routinglists = $patron->get_routing_lists + +Returns the routing lists a patron is subscribed to. + +=cut + +sub get_routing_lists { + my ($self) = @_; + my $routing_list_rs = $self->_result->subscriptionroutinglists; + return Koha::Subscription::Routinglists->_new_from_dbic($routing_list_rs); +} + =head3 get_age my $age = $patron->get_age @@ -720,6 +1111,7 @@ Return true if the patron (usually the logged in user) can see the patron's info sub can_see_patron_infos { my ( $self, $patron ) = @_; + return unless $patron; return $self->can_see_patrons_from( $patron->library->branchcode ); } @@ -806,17 +1198,101 @@ sub has_permission { return C4::Auth::haspermission( $self->userid, $flagsrequired ); } +=head3 is_adult + +my $is_adult = $patron->is_adult + +Return true if the patron has a category with a type Adult (A) or Organization (I) + +=cut + sub is_adult { my ( $self ) = @_; return $self->category->category_type =~ /^(A|I)$/ ? 1 : 0; } +=head3 is_child + +my $is_child = $patron->is_child + +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 type +=head3 has_valid_userid + +my $patron = Koha::Patrons->find(42); +$patron->userid( $new_userid ); +my $has_a_valid_userid = $patron->has_valid_userid + +my $patron = Koha::Patron->new( $params ); +my $has_a_valid_userid = $patron->has_valid_userid + +Return true if the current userid of this patron is valid/unique, otherwise false. + +Note that this should be done in $self->store instead and raise an exception if needed. + +=cut + +sub has_valid_userid { + my ($self) = @_; + + return 0 unless $self->userid; + + return 0 if ( $self->userid eq C4::Context->config('user') ); # DB user + + my $already_exists = Koha::Patrons->search( + { + userid => $self->userid, + ( + $self->in_storage + ? ( borrowernumber => { '!=' => $self->borrowernumber } ) + : () + ), + } + )->count; + return $already_exists ? 0 : 1; +} + +=head3 generate_userid + +my $patron = Koha::Patron->new( $params ); +$patron->generate_userid + +Generate a userid using the $surname and the $firstname (if there is a value in $firstname). + +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). + +=cut + +sub generate_userid { + my ($self) = @_; + my $offset = 0; + my $firstname = $self->firstname // q{}; + my $surname = $self->surname // q{}; + #The script will "do" the following code and increment the $offset until the generated userid is unique + do { + $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g; + $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g; + my $userid = lc(($firstname)? "$firstname.$surname" : $surname); + $userid = unac_string('utf-8',$userid); + $userid .= $offset unless $offset == 0; + $self->userid( $userid ); + $offset++; + } while (! $self->has_valid_userid ); + + return $self; + +} + +=head2 Internal methods + +=head3 _type =cut @@ -824,10 +1300,11 @@ sub _type { return 'Borrower'; } -=head1 AUTHOR +=head1 AUTHORS Kyle M Hall Alex Sassmannshausen +Martin Renvoize =cut