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
   9 # under the terms of the GNU General Public License as published by
  10 # the Free Software Foundation; either version 3 of the License, or
  11 # (at your option) any later version.
  12 #
  13 # Koha is distributed in the hope that it will be useful, but
  14 # WITHOUT ANY WARRANTY; without even the implied warranty of
  15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  16 # GNU General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU General Public License
  19 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  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 use Koha::Patron::Categories;
  33 use Date::Calc qw( Today Add_Delta_YMD );
  34
  35 use base qw(Koha::Objects);
  36
  37 =head1 NAME
  38
  39 Koha::Patron - Koha Patron Object class
  40
  41 =head1 API
  42
  43 =head2 Class Methods
  44
  45 =cut
  46
  47 =head3 search_limited
  48
  49 my $patrons = Koha::Patrons->search_limit( $params, $attributes );
  50
  51 Returns all the patrons the logged in user is allowed to see
  52
  53 =cut
  54
  55 sub search_limited {
  56     my ( $self, $params, $attributes ) = @_;
  57
  58     my $userenv = C4::Context->userenv;
  59     my @restricted_branchcodes;
  60     if ( $userenv and $userenv->{number} ) {
  61         my $logged_in_user = Koha::Patrons->find( $userenv->{number} );
  62         @restricted_branchcodes = $logged_in_user->libraries_where_can_see_patrons;
  63     }
  64     $params->{'me.branchcode'} = { -in => \@restricted_branchcodes } if @restricted_branchcodes;
  65     return $self->search( $params, $attributes );
  66 }
  67
  68 =head3 search_housebound_choosers
  69
  70 Returns all Patrons which are Housebound choosers.
  71
  72 =cut
  73
  74 sub search_housebound_choosers {
  75     my ( $self ) = @_;
  76     my $cho = $self->_resultset
  77         ->search_related('housebound_role', {
  78             housebound_chooser => 1,
  79         })->search_related('borrowernumber');
  80     return Koha::Patrons->_new_from_dbic($cho);
  81 }
  82
  83 =head3 search_housebound_deliverers
  84
  85 Returns all Patrons which are Housebound deliverers.
  86
  87 =cut
  88
  89 sub search_housebound_deliverers {
  90     my ( $self ) = @_;
  91     my $del = $self->_resultset
  92         ->search_related('housebound_role', {
  93             housebound_deliverer => 1,
  94         })->search_related('borrowernumber');
  95     return Koha::Patrons->_new_from_dbic($del);
  96 }
  97
  98 =head3 search_upcoming_membership_expires
  99
 100 my $patrons = Koha::Patrons->search_upcoming_membership_expires();
 101
 102 The 'before' and 'after' represent the number of days before/after the date
 103 that is set by the preference MembershipExpiryDaysNotice.
 104 If the pref is 14, before 2 and after 3 then you will get all expires
 105 from 12 to 17 days.
 106
 107 =cut
 108
 109 sub search_upcoming_membership_expires {
 110     my ( $self, $params ) = @_;
 111     my $before = $params->{before} || 0;
 112     my $after  = $params->{after} || 0;
 113     delete $params->{before};
 114     delete $params->{after};
 115
 116     my $days = C4::Context->preference("MembershipExpiryDaysNotice") || 0;
 117     my $date_before = dt_from_string->add( days => $days - $before );
 118     my $date_after = dt_from_string->add( days => $days + $after );
 119     my $dtf = Koha::Database->new->schema->storage->datetime_parser;
 120
 121     $params->{dateexpiry} = {
 122         ">=" => $dtf->format_date( $date_before ),
 123         "<=" => $dtf->format_date( $date_after ),
 124     };
 125     return $self->SUPER::search(
 126         $params, { join => ['branchcode', 'categorycode'] }
 127     );
 128 }
 129
 130 =head3 search_patrons_to_anonymise
 131
 132     my $patrons = Koha::Patrons->search_patrons_to_anonymise( { before => $older_than_date, [ library => $library ] } );
 133
 134 This method returns all patrons who has an issue history older than a given date.
 135
 136 =cut
 137
 138 sub search_patrons_to_anonymise {
 139     my ( $class, $params ) = @_;
 140     my $older_than_date = $params->{before};
 141     my $library         = $params->{library};
 142     $older_than_date = $older_than_date ? dt_from_string($older_than_date) : dt_from_string;
 143     $library ||=
 144       ( C4::Context->preference('IndependentBranches') && C4::Context->userenv && !C4::Context->IsSuperLibrarian() && C4::Context->userenv->{branch} )
 145       ? C4::Context->userenv->{branch}
 146       : undef;
 147     my $anonymous_patron = C4::Context->preference('AnonymousPatron') || undef;
 148
 149     my $dtf = Koha::Database->new->schema->storage->datetime_parser;
 150     my $rs = $class->_resultset->search(
 151         {   returndate                  => { '<'   =>  $dtf->format_datetime($older_than_date), },
 152             'old_issues.borrowernumber' => { 'not' => undef },
 153             privacy                     => { '<>'  => 0 },                  # Keep forever
 154             ( $library ? ( 'old_issues.branchcode' => $library ) : () ),
 155             ( $anonymous_patron ? ( 'old_issues.borrowernumber' => { '!=' => $anonymous_patron } ) : () ),
 156         },
 157         {   join     => ["old_issues"],
 158             distinct => 1,
 159         }
 160     );
 161     return Koha::Patrons->_new_from_dbic($rs);
 162 }
 163
 164 =head3 anonymise_issue_history
 165
 166     Koha::Patrons->search->anonymise_issue_history( { [ before => $older_than_date ] } );
 167
 168 Anonymise issue history (old_issues) for all patrons older than the given date (optional).
 169 To make sure all the conditions are met, the caller has the responsibility to
 170 call search_patrons_to_anonymise to filter the Koha::Patrons set
 171
 172 =cut
 173
 174 sub anonymise_issue_history {
 175     my ( $self, $params ) = @_;
 176
 177     my $older_than_date = $params->{before};
 178
 179     $older_than_date = dt_from_string $older_than_date if $older_than_date;
 180
 181     # The default of 0 does not work due to foreign key constraints
 182     # The anonymisation should not fail quietly if AnonymousPatron is not a valid entry
 183     # Set it to undef (NULL)
 184     my $dtf = Koha::Database->new->schema->storage->datetime_parser;
 185     my $nb_rows = 0;
 186     while ( my $patron = $self->next ) {
 187         my $old_issues_to_anonymise = $patron->old_checkouts->search(
 188         {
 189             (
 190                 $older_than_date
 191                 ? ( returndate =>
 192                       { '<' => $dtf->format_datetime($older_than_date) } )
 193                 : ()
 194             )
 195         }
 196         );
 197         my $anonymous_patron = C4::Context->preference('AnonymousPatron') || undef;
 198         $nb_rows += $old_issues_to_anonymise->update( { 'old_issues.borrowernumber' => $anonymous_patron } );
 199     }
 200     return $nb_rows;
 201 }
 202
 203 =head3 delete
 204
 205     Koha::Patrons->search({ some filters here })->delete({ move => 1 });
 206
 207     Delete passed set of patron objects.
 208     Wrapper for Koha::Patron->delete. (We do not want to bypass Koha::Patron
 209     and let DBIx do the job without further housekeeping.)
 210     Includes a move to deletedborrowers if move flag set.
 211
 212     Just like DBIx, the delete will only succeed when all entries could be
 213     deleted. Returns true or throws an exception.
 214
 215 =cut
 216
 217 sub delete {
 218     my ( $self, $params ) = @_;
 219     my $patrons_deleted;
 220     $self->_resultset->result_source->schema->txn_do( sub {
 221         my ( $set, $params ) = @_;
 222         my $count = $set->count;
 223         while ( my $patron = $set->next ) {
 224
 225             next unless $patron->in_storage;
 226
 227             $patron->move_to_deleted if $params->{move};
 228             $patron->delete;
 229
 230             $patrons_deleted++;
 231         }
 232     }, $self, $params );
 233     return $patrons_deleted;
 234 }
 235
 236 =head3 filter_by_expiration_date
 237
 238     Koha::Patrons->filter_by_expiration_date{{ days => $x });
 239
 240     Returns set of Koha patron objects expired $x days.
 241
 242 =cut
 243
 244 sub filter_by_expiration_date {
 245     my ( $class, $params ) = @_;
 246
 247     return $class->filter_by_last_update(
 248         {
 249             timestamp_column_name => 'dateexpiry',
 250             days                  => $params->{days} || 0,
 251             days_inclusive        => 1,
 252         }
 253     );
 254 }
 255
 256 =head3 search_unsubscribed
 257
 258     Koha::Patrons->search_unsubscribed;
 259
 260     Returns a set of Koha patron objects for patrons that recently
 261     unsubscribed and are not locked (candidates for locking).
 262     Depends on UnsubscribeReflectionDelay.
 263
 264 =cut
 265
 266 sub search_unsubscribed {
 267     my ( $class ) = @_;
 268
 269     my $delay = C4::Context->preference('UnsubscribeReflectionDelay');
 270     if( !defined($delay) || $delay eq q{} ) {
 271         # return empty set
 272         return $class->search({ borrowernumber => undef });
 273     }
 274     my $parser = Koha::Database->new->schema->storage->datetime_parser;
 275     my $dt = dt_from_string()->subtract( days => $delay );
 276     my $str = $parser->format_datetime($dt);
 277     my $fails = C4::Context->preference('FailedLoginAttempts') || 0;
 278     my $cond = [ undef, 0, 1..$fails-1 ]; # NULL, 0, 1..fails-1 (if fails>0)
 279     return $class->search(
 280         {
 281             'patron_consents.refused_on' => { '<=' => $str },
 282             'login_attempts' => $cond,
 283         },
 284         { join => 'patron_consents' },
 285     );
 286 }
 287
 288 =head3 search_anonymize_candidates
 289
 290     Koha::Patrons->search_anonymize_candidates({ locked => 1 });
 291
 292     Returns a set of Koha patron objects for patrons whose account is expired
 293     and locked (if parameter set). These are candidates for anonymizing.
 294     Depends on PatronAnonymizeDelay.
 295
 296 =cut
 297
 298 sub search_anonymize_candidates {
 299     my ( $class, $params ) = @_;
 300
 301     my $delay = C4::Context->preference('PatronAnonymizeDelay');
 302     if( !defined($delay) || $delay eq q{} ) {
 303         # return empty set
 304         return $class->search({ borrowernumber => undef });
 305     }
 306     my $cond = {};
 307     my $parser = Koha::Database->new->schema->storage->datetime_parser;
 308     my $dt = dt_from_string()->subtract( days => $delay );
 309     my $str = $parser->format_datetime($dt);
 310     $cond->{dateexpiry} = { '<=' => $str };
 311     $cond->{anonymized} = 0; # not yet done
 312     if( $params->{locked} ) {
 313         my $fails = C4::Context->preference('FailedLoginAttempts') || 0;
 314         $cond->{login_attempts} = [ -and => { '!=' => undef }, { -not_in => [0, 1..$fails-1 ] } ]; # -not_in does not like undef
 315     }
 316     return $class->search( $cond );
 317 }
 318
 319 =head3 search_anonymized
 320
 321     Koha::Patrons->search_anonymized;
 322
 323     Returns a set of Koha patron objects for patron accounts that have been
 324     anonymized before and could be removed.
 325     Depends on PatronRemovalDelay.
 326
 327 =cut
 328
 329 sub search_anonymized {
 330     my ( $class ) = @_;
 331
 332     my $delay = C4::Context->preference('PatronRemovalDelay');
 333     if( !defined($delay) || $delay eq q{} ) {
 334         # return empty set
 335         return $class->search({ borrowernumber => undef });
 336     }
 337     my $cond = {};
 338     my $parser = Koha::Database->new->schema->storage->datetime_parser;
 339     my $dt = dt_from_string()->subtract( days => $delay );
 340     my $str = $parser->format_datetime($dt);
 341     $cond->{dateexpiry} = { '<=' => $str };
 342     $cond->{anonymized} = 1;
 343     return $class->search( $cond );
 344 }
 345
 346 =head3 lock
 347
 348     Koha::Patrons->search({ some filters })->lock({ expire => 1, remove => 1 })
 349
 350     Lock the passed set of patron objects. Optionally expire and remove holds.
 351     Wrapper around Koha::Patron->lock.
 352
 353 =cut
 354
 355 sub lock {
 356     my ( $self, $params ) = @_;
 357     my $count = $self->count;
 358     while( my $patron = $self->next ) {
 359         $patron->lock($params);
 360     }
 361 }
 362
 363 =head3 anonymize
 364
 365     Koha::Patrons->search({ some filters })->anonymize();
 366
 367     Anonymize passed set of patron objects.
 368     Wrapper around Koha::Patron->anonymize.
 369
 370 =cut
 371
 372 sub anonymize {
 373     my ( $self ) = @_;
 374     my $count = $self->count;
 375     while( my $patron = $self->next ) {
 376         $patron->anonymize;
 377     }
 378 }
 379
 380 =head3 search_patrons_to_update_category
 381
 382     my $patrons = Koha::Patrons->search_patrons_to_update_category( {
 383                       from          => $from_category,
 384                       fine_max      => $fine_max,
 385                       fine_min      => $fin_min,
 386                       too_young     => $too_young,
 387                       too_old      => $too_old,
 388                   });
 389
 390 This method returns all patron who should be updated from one category to another meeting criteria:
 391
 392 from          - borrower categorycode
 393 fine_min      - with fines totaling at least this amount
 394 fine_max      - with fines above this amount
 395 too_young     - if passed, select patrons who are under the age limit for the current category
 396 too_old       - if passed, select patrons who are over the age limit for the current category
 397
 398 =cut
 399
 400 sub search_patrons_to_update_category {
 401     my ( $self, $params ) = @_;
 402     my %query;
 403     my $search_params;
 404
 405     my $cat_from = Koha::Patron::Categories->find($params->{from});
 406     $search_params->{categorycode}=$params->{from};
 407     if ($params->{too_young} || $params->{too_old}){
 408         my $dtf = Koha::Database->new->schema->storage->datetime_parser;
 409         if( $cat_from->dateofbirthrequired && $params->{too_young} ) {
 410             my $date_after = dt_from_string()->subtract( years => $cat_from->dateofbirthrequired);
 411             $search_params->{dateofbirth}{'>'} = $dtf->format_datetime( $date_after );
 412         }
 413         if( $cat_from->upperagelimit && $params->{too_old} ) {
 414             my $date_before = dt_from_string()->subtract( years => $cat_from->upperagelimit);
 415             $search_params->{dateofbirth}{'<'} = $dtf->format_datetime( $date_before );
 416         }
 417     }
 418     if ($params->{fine_min} || $params->{fine_max}) {
 419         $query{join} = ["accountlines"];
 420         $query{columns} = ["borrowernumber"];
 421         $query{group_by} = ["borrowernumber"];
 422         $query{having} = \['COALESCE(sum(accountlines.amountoutstanding),0) <= ?',$params->{fine_max}] if defined $params->{fine_max};
 423         $query{having} = \['COALESCE(sum(accountlines.amountoutstanding),0) >= ?',$params->{fine_min}] if defined $params->{fine_min};
 424     }
 425     return $self->search($search_params,\%query);
 426 }
 427
 428 =head3 update_category_to
 429
 430     Koha::Patrons->search->update_category_to( {
 431             category   => $to_category,
 432         });
 433
 434 Update supplied patrons from current category to another and take care of guarantor info.
 435 To make sure all the conditions are met, the caller has the responsibility to
 436 call search_patrons_to_update to filter the Koha::Patrons set
 437
 438 =cut
 439
 440 sub update_category_to {
 441     my ( $self, $params ) = @_;
 442     my $counter = 0;
 443     while( my $patron = $self->next ) {
 444         $counter++;
 445         $patron->categorycode($params->{category})->store();
 446     }
 447     return $counter;
 448 }
 449
 450 =head3 filter_by_attribute_type
 451
 452 my $patrons = Koha::Patrons->filter_by_attribute_type($attribute_type_code);
 453
 454 Return a Koha::Patrons set with patrons having the attribute defined.
 455
 456 =cut
 457
 458 sub filter_by_attribute_type {
 459     my ( $self, $attribute_type ) = @_;
 460     my $rs = Koha::Patron::Attributes->search( { code => $attribute_type } )
 461       ->_resultset()->search_related('borrowernumber');
 462     return Koha::Patrons->_new_from_dbic($rs);
 463 }
 464
 465 =head3 filter_by_attribute_value
 466
 467 my $patrons = Koha::Patrons->filter_by_attribute_value($attribute_value);
 468
 469 Return a Koha::Patrons set with patrong having the attribute value passed in parameter.
 470
 471 =cut
 472
 473 sub filter_by_attribute_value {
 474     my ( $self, $attribute_value ) = @_;
 475     my $rs = Koha::Patron::Attributes->search(
 476         {
 477             'borrower_attribute_types.staff_searchable' => 1,
 478             attribute => { like => "%$attribute_value%" }
 479         },
 480         { join => 'borrower_attribute_types' }
 481     )->_resultset()->search_related('borrowernumber');
 482     return Koha::Patrons->_new_from_dbic($rs);
 483 }
 484
 485
 486 =head3 _type
 487
 488 =cut
 489
 490 sub _type {
 491     return 'Borrower';
 492 }
 493
 494 =head3 object_class
 495
 496 =cut
 497
 498 sub object_class {
 499     return 'Koha::Patron';
 500 }
 501
 502 =head1 AUTHOR
 503
 504 Kyle M Hall <kyle@bywatersolutions.com>
 505
 506 =cut
 507
 508 1;