X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=Koha%2FPatron.pm;h=fa0b53a55b2e066cf2fab75bb85fdba247ad4617;hb=cfbc53bb22e6f4a851a2a7cd6ede891012951410;hp=478a0cd90678f4a2648bf7c3ce930fb805a3aff3;hpb=d892342e6f8569a4ea51a0e550b5d9c59b92e588;p=koha.git diff --git a/Koha/Patron.pm b/Koha/Patron.pm index 478a0cd906..fa0b53a55b 100644 --- a/Koha/Patron.pm +++ b/Koha/Patron.pm @@ -21,23 +21,63 @@ package Koha::Patron; use Modern::Perl; use Carp; +use List::MoreUtils qw( uniq ); +use Module::Load::Conditional qw( can_load ); +use Text::Unaccent qw( unac_string ); use C4::Context; use C4::Log; +use Koha::Checkouts; use Koha::Database; use Koha::DateUtils; use Koha::Holds; -use Koha::Issues; -use Koha::OldIssues; +use Koha::Old::Checkouts; use Koha::Patron::Categories; use Koha::Patron::HouseboundProfile; use Koha::Patron::HouseboundRole; use Koha::Patron::Images; use Koha::Patrons; use Koha::Virtualshelves; +use Koha::Club::Enrollments; +use Koha::Account; +use Koha::Subscription::Routinglists; + +if ( ! can_load( modules => { 'Koha::NorwegianPatronDB' => undef } ) ) { + warn "Unable to load Koha::NorwegianPatronDB"; +} 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 @@ -48,6 +88,163 @@ Koha::Patron - Koha Patron Object class =cut +=head3 new + +=cut + +sub new { + my ( $class, $params ) = @_; + + return $class->SUPER::new($params); +} + +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); +} + +# trim whitespace from data which has some non-whitespace in it. +# Could be moved to Koha::Object if need to be reused +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; +} + +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; +} + +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->in_storage ) { #AddMember + + unless( $self->category->in_storage ) { + Koha::Exceptions::Object::FKConstraint->throw( + broken_fk => 'categorycode', + value => $self->categorycode, + ); + } + + $self->trim_whitespaces; + + # Generate a valid userid/login if needed + $self->userid($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); + + 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 ); + + # Create a disabled account if no password provided + $self->password( $self->password + ? Koha::AuthUtils::hash_password( $self->password ) + : '!' ); + + # 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; + + $self->borrowernumber(undef); + + $self = $self->SUPER::store; + + # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a + # cronjob will use for syncing with NL + if ( C4::Context->preference('NorwegianPatronDBEnable') + && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) + { + Koha::Database->new->schema->resultset('BorrowerSync') + ->create( + { + 'borrowernumber' => $self->borrowernumber, + 'synctype' => 'norwegianpatrondb', + 'sync' => 1, + 'syncstatus' => 'new', + 'hashed_pin' => + Koha::NorwegianPatronDB::NLEncryptPIN($self->plain_text_password), + } + ); + } + + $self->add_enrolment_fee_if_needed; + + logaction( "MEMBERS", "CREATE", $self->borrowernumber, "" ) + if C4::Context->preference("BorrowersLog"); + } + else { #ModMember + $self = $self->SUPER::store; + } + + } + ); + return $self; +} + =head3 delete $patron->delete @@ -66,8 +263,7 @@ sub delete { $self->_result->result_source->schema->txn_do( sub { # Delete Patron's holds - # FIXME Should be $patron->get_holds - $_->delete for Koha::Holds->search( { borrowernumber => $self->borrowernumber } ); + $self->holds->delete; # Delete all lists and all shares of this borrower # Consistent with the approach Koha uses on deleting individual lists @@ -124,7 +320,12 @@ sub guarantor { sub image { my ( $self ) = @_; - return Koha::Patron::Images->find( $self->borrowernumber ) + return scalar Koha::Patron::Images->find( $self->borrowernumber ); +} + +sub library { + my ( $self ) = @_; + return Koha::Library->_new_from_dbic($self->_result->branchcode); } =head3 guarantees @@ -193,6 +394,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; @@ -252,15 +501,15 @@ sub do_check_for_previous_checkout { }; # Check current issues table - my $issues = Koha::Issues->search($criteria); + my $issues = Koha::Checkouts->search($criteria); return 1 if $issues->count; # 0 || N # Check old issues table - my $old_issues = Koha::OldIssues->search($criteria); + my $old_issues = Koha::Old::Checkouts->search($criteria); return $old_issues->count; # 0 || N } -=head2 is_debarred +=head3 is_debarred my $debarment_expiration = $patron->is_debarred; @@ -279,7 +528,7 @@ sub is_debarred { return; } -=head2 is_expired +=head3 is_expired my $is_expired = $patron->is_expired; @@ -290,12 +539,32 @@ 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 1 if dt_from_string( $self->dateexpiry ) < dt_from_string; + return 0 if $self->dateexpiry =~ '^9999'; + return 1 if dt_from_string( $self->dateexpiry ) < dt_from_string->truncate( to => 'day' ); + return 0; +} + +=head3 is_going_to_expire + +my $is_going_to_expire = $patron->is_going_to_expire; + +Returns 1 if the patron is going to expired, depending on the NotifyBorrowerDeparture pref or 0 + +=cut + +sub is_going_to_expire { + my ($self) = @_; + + my $delay = C4::Context->preference('NotifyBorrowerDeparture') || 0; + + return 0 unless $delay; + return 0 unless $self->dateexpiry; + 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; } -=head2 update_password +=head3 update_password my $updated = $patron->update_password( $userid, $password ); @@ -309,7 +578,12 @@ 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 - $self->password($password)->store; + $self->update( + { + password => $password, + login_attempts => 0, + } + ); logaction( "MEMBERS", "CHANGE PASS", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog"); return 1; } @@ -335,7 +609,9 @@ sub renew_account { } my $expiry_date = $self->category->get_expiry_date($date); - $self->dateexpiry($expiry_date)->store; + $self->dateexpiry($expiry_date); + $self->date_renewed( dt_from_string() ); + $self->store(); $self->add_enrolment_fee_if_needed; @@ -343,7 +619,7 @@ sub renew_account { return dt_from_string( $expiry_date )->truncate( to => 'day' ); } -=head2 has_overdues +=head3 has_overdues my $has_overdues = $patron->has_overdues; @@ -357,7 +633,7 @@ sub has_overdues { return $self->_result->issues->search({ date_due => { '<' => $dtf->format_datetime( dt_from_string() ) } })->count; } -=head2 track_login +=head3 track_login $patron->track_login; $patron->track_login({ force => 1 }); @@ -376,7 +652,7 @@ sub track_login { $self->lastseen( dt_from_string() )->store; } -=head2 move_to_deleted +=head3 move_to_deleted my $is_moved = $patron->move_to_deleted; @@ -388,6 +664,7 @@ This can be done before deleting a patron, to make sure the data are not complet sub move_to_deleted { my ($self) = @_; my $patron_infos = $self->unblessed; + delete $patron_infos->{updated_on}; #This ensures the updated_on date in deletedborrowers will be set to the current timestamp return Koha::Database->new->schema->resultset('Deletedborrower')->create($patron_infos); } @@ -476,7 +753,450 @@ sub add_enrolment_fee_if_needed { return $enrolment_fee || 0; } -=head3 type +=head3 checkouts + +my $checkouts = $patron->checkouts + +=cut + +sub checkouts { + my ($self) = @_; + my $checkouts = $self->_result->issues; + 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 + +=cut + +sub old_checkouts { + my ($self) = @_; + my $old_checkouts = $self->_result->old_issues; + return Koha::Old::Checkouts->_new_from_dbic( $old_checkouts ); +} + +=head3 get_overdues + +my $overdue_items = $patron->get_overdues + +Return the overdue items + +=cut + +sub get_overdues { + my ($self) = @_; + my $dtf = Koha::Database->new->schema->storage->datetime_parser; + return $self->checkouts->search( + { + 'me.date_due' => { '<' => $dtf->format_datetime(dt_from_string) }, + }, + { + prefetch => { item => { biblio => 'biblioitems' } }, + } + ); +} + +=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 + +Return the age of the patron + +=cut + +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; + + my $age = $today_y - $dob_y; + if ( $dob_m . $dob_d > $today_m . $today_d ) { + $age--; + } + + return $age; +} + +=head3 account + +my $account = $patron->account + +=cut + +sub account { + my ($self) = @_; + return Koha::Account->new( { patron_id => $self->borrowernumber } ); +} + +=head3 holds + +my $holds = $patron->holds + +Return all the holds placed by this patron + +=cut + +sub holds { + my ($self) = @_; + my $holds_rs = $self->_result->reserves->search( {}, { order_by => 'reservedate' } ); + return Koha::Holds->_new_from_dbic($holds_rs); +} + +=head3 old_holds + +my $old_holds = $patron->old_holds + +Return all the historical holds for this patron + +=cut + +sub old_holds { + my ($self) = @_; + my $old_holds_rs = $self->_result->old_reserves->search( {}, { order_by => 'reservedate' } ); + return Koha::Old::Holds->_new_from_dbic($old_holds_rs); +} + +=head3 notice_email_address + + my $email = $patron->notice_email_address; + +Return the email address of patron used for notices. +Returns the empty string if no email address. + +=cut + +sub notice_email_address{ + my ( $self ) = @_; + + my $which_address = C4::Context->preference("AutoEmailPrimaryAddress"); + # if syspref is set to 'first valid' (value == OFF), look up email address + if ( $which_address eq 'OFF' ) { + return $self->first_valid_email_address; + } + + return $self->$which_address || ''; +} + +=head3 first_valid_email_address + +my $first_valid_email_address = $patron->first_valid_email_address + +Return the first valid email address for a patron. +For now, the order is defined as email, emailpro, B_email. +Returns the empty string if the borrower has no email addresses. + +=cut + +sub first_valid_email_address { + my ($self) = @_; + + return $self->email() || $self->emailpro() || $self->B_email() || q{}; +} + +=head3 get_club_enrollments + +=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; + + return wantarray ? $e->as_list : $e; +} + +=head3 get_enrollable_clubs + +=cut + +sub get_enrollable_clubs { + my ( $self, $is_enrollable_from_opac, $return_scalar ) = @_; + + my $params; + $params->{is_enrollable_from_opac} = $is_enrollable_from_opac + if $is_enrollable_from_opac; + $params->{is_email_required} = 0 unless $self->first_valid_email_address(); + + $params->{borrower} = $self; + + my $e = Koha::Clubs->get_enrollable($params); + + return $e if $return_scalar; + + return wantarray ? $e->as_list : $e; +} + +=head3 account_locked + +my $is_locked = $patron->account_locked + +Return true if the patron has reach the maximum number of login attempts (see pref FailedLoginAttempts). +Otherwise return false. +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 + and $self->login_attempts + and $self->login_attempts >= $FailedLoginAttempts )? 1 : 0; +} + +=head3 can_see_patron_infos + +my $can_see = $patron->can_see_patron_infos( $patron ); + +Return true if the patron (usually the logged in user) can see the patron's infos for a given patron + +=cut + +sub can_see_patron_infos { + my ( $self, $patron ) = @_; + return $self->can_see_patrons_from( $patron->library->branchcode ); +} + +=head3 can_see_patrons_from + +my $can_see = $patron->can_see_patrons_from( $branchcode ); + +Return true if the patron (usually the logged in user) can see the patron's infos from a given library + +=cut + +sub can_see_patrons_from { + my ( $self, $branchcode ) = @_; + my $can = 0; + if ( $self->branchcode eq $branchcode ) { + $can = 1; + } elsif ( $self->has_permission( { borrowers => 'view_borrower_infos_from_any_libraries' } ) ) { + $can = 1; + } elsif ( my $library_groups = $self->library->library_groups ) { + while ( my $library_group = $library_groups->next ) { + if ( $library_group->parent->has_child( $branchcode ) ) { + $can = 1; + last; + } + } + } + return $can; +} + +=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 ) = @_; + my $userenv = C4::Context->userenv; + + return () unless $userenv; # For tests, but userenv should be defined in tests... + + my @restricted_branchcodes; + if (C4::Context::only_my_library) { + push @restricted_branchcodes, $self->branchcode; + } + else { + unless ( + $self->has_permission( + { borrowers => 'view_borrower_infos_from_any_libraries' } + ) + ) + { + my $library_groups = $self->library->library_groups({ ft_hide_patron_info => 1 }); + if ( $library_groups->count ) + { + while ( my $library_group = $library_groups->next ) { + my $parent = $library_group->parent; + if ( $parent->has_child( $self->branchcode ) ) { + push @restricted_branchcodes, $parent->children->get_column('branchcode'); + } + } + } + + @restricted_branchcodes = ( $self->branchcode ) unless @restricted_branchcodes; + } + } + + @restricted_branchcodes = grep { defined $_ } @restricted_branchcodes; + @restricted_branchcodes = uniq(@restricted_branchcodes); + @restricted_branchcodes = sort(@restricted_branchcodes); + return @restricted_branchcodes; +} + +sub has_permission { + my ( $self, $flagsrequired ) = @_; + return unless $self->userid; + # TODO code from haspermission needs to be moved here! + 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 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 ); +my $userid = $patron->generate_userid + +Generate a userid using the $surname and the $firstname (if there is a value in $firstname). + +Return the generate 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). + +# Note: Should we set $self->userid with the generated value? +# Certainly yes, but we AddMember and ModMember will be rewritten + +=cut + +sub generate_userid { + my ($self) = @_; + my $userid; + my $offset = 0; + my $existing_userid = $self->userid; + 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; + $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 ); + + # Resetting to the previous value as the callers do not expect + # this method to modify the userid attribute + # This will be done later (move of AddMember and ModMember) + $self->userid( $existing_userid ); + + return $userid; + +} + +=head2 Internal methods + +=head3 _type =cut