use Modern::Perl;
use Carp;
+use List::MoreUtils qw( uniq );
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 base qw(Koha::Object);
$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
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)
+ return Koha::Library->_new_from_dbic($self->_result->branchcode);
}
=head3 guarantees
};
# 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;
return;
}
-=head2 is_expired
+=head3 is_expired
my $is_expired = $patron->is_expired;
return 0;
}
-=head2 is_going_to_expire
+=head3 is_going_to_expire
my $is_going_to_expire = $patron->is_going_to_expire;
return 0;
}
-=head2 update_password
+=head3 update_password
my $updated = $patron->update_password( $userid, $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;
}
}
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;
return dt_from_string( $expiry_date )->truncate( to => 'day' );
}
-=head2 has_overdues
+=head3 has_overdues
my $has_overdues = $patron->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 });
$self->lastseen( dt_from_string() )->store;
}
-=head2 move_to_deleted
+=head3 move_to_deleted
my $is_moved = $patron->move_to_deleted;
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);
}
return $enrolment_fee || 0;
}
+=head3 checkouts
+
+my $checkouts = $patron->checkouts
+
+=cut
+
+sub checkouts {
+ my ($self) = @_;
+ my $checkouts = $self->_result->issues;
+ 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
sub get_overdues {
my ($self) = @_;
my $dtf = Koha::Database->new->schema->storage->datetime_parser;
- my $issues = Koha::Issues->search(
+ return $self->checkouts->search(
{
- 'me.borrowernumber' => $self->borrowernumber,
'me.date_due' => { '<' => $dtf->format_datetime(dt_from_string) },
},
{
prefetch => { item => { biblio => 'biblioitems' } },
}
);
- return $issues;
}
=head3 get_age
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;
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 type
=cut
projects / srvgit / blobdiff