Koha/Patrons.pm

   1 package Koha::Patrons;
   2
   3 # Copyright 2014 ByWater Solutions
   4 # Copyright 2016 Koha Development Team
   5 #
   6 # This file is part of Koha.
   7 #
   8 # Koha is free software; you can redistribute it and/or modify it under the
   9 # terms of the GNU General Public License as published by the Free Software
  10 # Foundation; either version 3 of the License, or (at your option) any later
  11 # version.
  12 #
  13 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  14 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  15 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License along
  18 # with Koha; if not, write to the Free Software Foundation, Inc.,
  19 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  20
  21 use Modern::Perl;
  22
  23 use Carp;
  24
  25 use Koha::Database;
  26 use Koha::DateUtils;
  27
  28 use Koha::ArticleRequests;
  29 use Koha::ArticleRequest::Status;
  30 use Koha::Patron;
  31 use Koha::Exceptions::Patron;
  32
  33 use base qw(Koha::Objects);
  34
  35 =head1 NAME
  36
  37 Koha::Patron - Koha Patron Object class
  38
  39 =head1 API
  40
  41 =head2 Class Methods
  42
  43 =cut
  44
  45 =head3 search_limited
  46
  47 my $patrons = Koha::Patrons->search_limit( $params, $attributes );
  48
  49 Returns all the patrons the logged in user is allowed to see
  50
  51 =cut
  52
  53 sub search_limited {
  54     my ( $self, $params, $attributes ) = @_;
  55
  56     my $userenv = C4::Context->userenv;
  57     my @restricted_branchcodes;
  58     if ( $userenv and $userenv->{number} ) {
  59         my $logged_in_user = Koha::Patrons->find( $userenv->{number} );
  60         @restricted_branchcodes = $logged_in_user->libraries_where_can_see_patrons;
  61     }
  62     $params->{'me.branchcode'} = { -in => \@restricted_branchcodes } if @restricted_branchcodes;
  63     return $self->search( $params, $attributes );
  64 }
  65
  66 =head3 search_housebound_choosers
  67
  68 Returns all Patrons which are Housebound choosers.
  69
  70 =cut
  71
  72 sub search_housebound_choosers {
  73     my ( $self ) = @_;
  74     my $cho = $self->_resultset
  75         ->search_related('housebound_role', {
  76             housebound_chooser => 1,
  77         })->search_related('borrowernumber');
  78     return Koha::Patrons->_new_from_dbic($cho);
  79 }
  80
  81 =head3 search_housebound_deliverers
  82
  83 Returns all Patrons which are Housebound deliverers.
  84
  85 =cut
  86
  87 sub search_housebound_deliverers {
  88     my ( $self ) = @_;
  89     my $del = $self->_resultset
  90         ->search_related('housebound_role', {
  91             housebound_deliverer => 1,
  92         })->search_related('borrowernumber');
  93     return Koha::Patrons->_new_from_dbic($del);
  94 }
  95
  96 =head3 search_upcoming_membership_expires
  97
  98 my $patrons = Koha::Patrons->search_upcoming_membership_expires();
  99
 100 The 'before' and 'after' represent the number of days before/after the date
 101 that is set by the preference MembershipExpiryDaysNotice.
 102 If the pref is 14, before 2 and after 3 then you will get all expires
 103 from 12 to 17 days.
 104
 105 =cut
 106
 107 sub search_upcoming_membership_expires {
 108     my ( $self, $params ) = @_;
 109     my $before = $params->{before} || 0;
 110     my $after  = $params->{after} || 0;
 111     delete $params->{before};
 112     delete $params->{after};
 113
 114     my $days = C4::Context->preference("MembershipExpiryDaysNotice") || 0;
 115     my $date_before = dt_from_string->add( days => $days - $before );
 116     my $date_after = dt_from_string->add( days => $days + $after );
 117     my $dtf = Koha::Database->new->schema->storage->datetime_parser;
 118
 119     $params->{dateexpiry} = {
 120         ">=" => $dtf->format_date( $date_before ),
 121         "<=" => $dtf->format_date( $date_after ),
 122     };
 123     return $self->SUPER::search(
 124         $params, { join => ['branchcode', 'categorycode'] }
 125     );
 126 }
 127
 128 =head3 search_patrons_to_anonymise
 129
 130     my $patrons = Koha::Patrons->search_patrons_to_anonymise( { before => $older_than_date, [ library => $library ] } );
 131
 132 This method returns all patrons who has an issue history older than a given date.
 133
 134 =cut
 135
 136 sub search_patrons_to_anonymise {
 137     my ( $class, $params ) = @_;
 138     my $older_than_date = $params->{before};
 139     my $library         = $params->{library};
 140     $older_than_date = $older_than_date ? dt_from_string($older_than_date) : dt_from_string;
 141     $library ||=
 142       ( C4::Context->preference('IndependentBranches') && C4::Context->userenv && !C4::Context->IsSuperLibrarian() && C4::Context->userenv->{branch} )
 143       ? C4::Context->userenv->{branch}
 144       : undef;
 145     my $anonymous_patron = C4::Context->preference('AnonymousPatron') || undef;
 146
 147     my $dtf = Koha::Database->new->schema->storage->datetime_parser;
 148     my $rs = $class->_resultset->search(
 149         {   returndate                  => { '<'   =>  $dtf->format_datetime($older_than_date), },
 150             'old_issues.borrowernumber' => { 'not' => undef },
 151             privacy                     => { '<>'  => 0 },                  # Keep forever
 152             ( $library ? ( 'old_issues.branchcode' => $library ) : () ),
 153             ( $anonymous_patron ? ( 'old_issues.borrowernumber' => { '!=' => $anonymous_patron } ) : () ),
 154         },
 155         {   join     => ["old_issues"],
 156             distinct => 1,
 157         }
 158     );
 159     return Koha::Patrons->_new_from_dbic($rs);
 160 }
 161
 162 =head3 anonymise_issue_history
 163
 164     Koha::Patrons->search->anonymise_issue_history( { [ before => $older_than_date ] } );
 165
 166 Anonymise issue history (old_issues) for all patrons older than the given date (optional).
 167 To make sure all the conditions are met, the caller has the responsibility to
 168 call search_patrons_to_anonymise to filter the Koha::Patrons set
 169
 170 =cut
 171
 172 sub anonymise_issue_history {
 173     my ( $self, $params ) = @_;
 174
 175     my $older_than_date = $params->{before};
 176
 177     $older_than_date = dt_from_string $older_than_date if $older_than_date;
 178
 179     # The default of 0 does not work due to foreign key constraints
 180     # The anonymisation should not fail quietly if AnonymousPatron is not a valid entry
 181     # Set it to undef (NULL)
 182     my $dtf = Koha::Database->new->schema->storage->datetime_parser;
 183     my $nb_rows = 0;
 184     while ( my $patron = $self->next ) {
 185         my $old_issues_to_anonymise = $patron->old_checkouts->search(
 186         {
 187             (
 188                 $older_than_date
 189                 ? ( returndate =>
 190                       { '<' => $dtf->format_datetime($older_than_date) } )
 191                 : ()
 192             )
 193         }
 194         );
 195         my $anonymous_patron = C4::Context->preference('AnonymousPatron') || undef;
 196         $nb_rows += $old_issues_to_anonymise->update( { 'old_issues.borrowernumber' => $anonymous_patron } );
 197     }
 198     return $nb_rows;
 199 }
 200
 201 =head3 delete
 202
 203     Koha::Patrons->search({ some filters here })->delete({ move => 1, verbose => 1 });
 204
 205     Delete passed set of patron objects.
 206     Wrapper for Koha::Patron->delete. (We do not want to bypass Koha::Patron
 207     and let DBIx do the job without further housekeeping.)
 208     Includes a move to deletedborrowers if move flag set.
 209
 210     Just like DBIx, the delete will only succeed when all entries could be
 211     deleted. Returns true or throws an exception.
 212
 213 =cut
 214
 215 sub delete {
 216     my ( $self, $params ) = @_;
 217     my $patrons_deleted;
 218     $self->_resultset->result_source->schema->txn_do( sub {
 219         my ( $set, $params ) = @_;
 220         my $count = $set->count;
 221         while( my $patron = $set->next ) {
 222             $patron->move_to_deleted if $params->{move};
 223             $patron->delete == 1 || Koha::Exceptions::Patron::FailedDelete->throw;
 224             $patrons_deleted++;
 225         }
 226         warn "Deleted $count patrons\n" if $params->{verbose};
 227     }, $self, $params );
 228     return $patrons_deleted;
 229 }
 230
 231 =head3 search_unsubscribed
 232
 233     Koha::Patrons->search_unsubscribed;
 234
 235     Returns a set of Koha patron objects for patrons that recently
 236     unsubscribed and are not locked (candidates for locking).
 237     Depends on UnsubscribeReflectionDelay.
 238
 239 =cut
 240
 241 sub search_unsubscribed {
 242     my ( $class ) = @_;
 243
 244     my $delay = C4::Context->preference('UnsubscribeReflectionDelay');
 245     if( !defined($delay) || $delay eq q{} ) {
 246         # return empty set
 247         return $class->search({ borrowernumber => undef });
 248     }
 249     my $parser = Koha::Database->new->schema->storage->datetime_parser;
 250     my $dt = dt_from_string()->subtract( days => $delay );
 251     my $str = $parser->format_datetime($dt);
 252     my $fails = C4::Context->preference('FailedLoginAttempts') || 0;
 253     my $cond = [ undef, 0, 1..$fails-1 ]; # NULL, 0, 1..fails-1 (if fails>0)
 254     return $class->search(
 255         {
 256             'patron_consents.refused_on' => { '<=' => $str },
 257             'login_attempts' => $cond,
 258         },
 259         { join => 'patron_consents' },
 260     );
 261 }
 262
 263 =head3 search_anonymize_candidates
 264
 265     Koha::Patrons->search_anonymize_candidates({ locked => 1 });
 266
 267     Returns a set of Koha patron objects for patrons whose account is expired
 268     and locked (if parameter set). These are candidates for anonymizing.
 269     Depends on PatronAnonymizeDelay.
 270
 271 =cut
 272
 273 sub search_anonymize_candidates {
 274     my ( $class, $params ) = @_;
 275
 276     my $delay = C4::Context->preference('PatronAnonymizeDelay');
 277     if( !defined($delay) || $delay eq q{} ) {
 278         # return empty set
 279         return $class->search({ borrowernumber => undef });
 280     }
 281     my $cond = {};
 282     my $parser = Koha::Database->new->schema->storage->datetime_parser;
 283     my $dt = dt_from_string()->subtract( days => $delay );
 284     my $str = $parser->format_datetime($dt);
 285     $cond->{dateexpiry} = { '<=' => $str };
 286     $cond->{anonymized} = 0; # not yet done
 287     if( $params->{locked} ) {
 288         my $fails = C4::Context->preference('FailedLoginAttempts');
 289         $cond->{login_attempts} = [ -and => { '!=' => undef }, { -not_in => [0, 1..$fails-1 ] } ]; # -not_in does not like undef
 290     }
 291     return $class->search( $cond );
 292 }
 293
 294 =head3 search_anonymized
 295
 296     Koha::Patrons->search_anonymized;
 297
 298     Returns a set of Koha patron objects for patron accounts that have been
 299     anonymized before and could be removed.
 300     Depends on PatronRemovalDelay.
 301
 302 =cut
 303
 304 sub search_anonymized {
 305     my ( $class ) = @_;
 306
 307     my $delay = C4::Context->preference('PatronRemovalDelay');
 308     if( !defined($delay) || $delay eq q{} ) {
 309         # return empty set
 310         return $class->search({ borrowernumber => undef });
 311     }
 312     my $cond = {};
 313     my $parser = Koha::Database->new->schema->storage->datetime_parser;
 314     my $dt = dt_from_string()->subtract( days => $delay );
 315     my $str = $parser->format_datetime($dt);
 316     $cond->{dateexpiry} = { '<=' => $str };
 317     $cond->{anonymized} = 1;
 318     return $class->search( $cond );
 319 }
 320
 321 =head3 lock
 322
 323     Koha::Patrons->search({ some filters })->lock({ expire => 1, remove => 1, verbose => 1 })
 324
 325     Lock the passed set of patron objects. Optionally expire and remove holds.
 326     Optional verbose flag is used in cron job.
 327     Wrapper around Koha::Patron->lock.
 328
 329 =cut
 330
 331 sub lock {
 332     my ( $self, $params ) = @_;
 333     my $count = $self->count;
 334     while( my $patron = $self->next ) {
 335         $patron->lock($params);
 336     }
 337     if( $params->{verbose} ) {
 338         warn "Locked $count patrons\n";
 339     }
 340 }
 341
 342 =head3 anonymize
 343
 344     Koha::Patrons->search({ some filters })->anonymize({ verbose => 1 });
 345
 346     Anonymize passed set of patron objects.
 347     Optional verbose flag is used in cron job.
 348     Wrapper around Koha::Patron->anonymize.
 349
 350 =cut
 351
 352 sub anonymize {
 353     my ( $self, $params ) = @_;
 354     my $count = $self->count;
 355     while( my $patron = $self->next ) {
 356         $patron->anonymize;
 357     }
 358     if( $params->{verbose} ) {
 359         warn "Anonymized $count patrons\n";
 360     }
 361 }
 362
 363 =head3 _type
 364
 365 =cut
 366
 367 sub _type {
 368     return 'Borrower';
 369 }
 370
 371 =head3 object_class
 372
 373 =cut
 374
 375 sub object_class {
 376     return 'Koha::Patron';
 377 }
 378
 379 =head1 AUTHOR
 380
 381 Kyle M Hall <kyle@bywatersolutions.com>
 382
 383 =cut
 384
 385 1;