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
  24 use Koha::Database;
  25 use Koha::DateUtils qw( dt_from_string );
  26
  27 use Koha::ArticleRequests;
  28 use Koha::Patron;
  29 use Koha::Exceptions::Patron;
  30 use Koha::Patron::Categories;
  31
  32 use base qw(Koha::Objects);
  33
  34 =head1 NAME
  35
  36 Koha::Patron - Koha Patron Object class
  37
  38 =head1 API
  39
  40 =head2 Class Methods
  41
  42 =cut
  43
  44 =head3 search_limited
  45
  46 my $patrons = Koha::Patrons->search_limit( $params, $attributes );
  47
  48 Returns all the patrons the logged in user is allowed to see
  49
  50 =cut
  51
  52 sub search_limited {
  53     my ( $self, $params, $attributes ) = @_;
  54
  55     my $userenv = C4::Context->userenv;
  56     my @restricted_branchcodes;
  57     if ( $userenv and $userenv->{number} ) {
  58         my $logged_in_user = Koha::Patrons->find( $userenv->{number} );
  59         @restricted_branchcodes = $logged_in_user->libraries_where_can_see_patrons;
  60     }
  61     $params->{'me.branchcode'} = { -in => \@restricted_branchcodes } if @restricted_branchcodes;
  62     return $self->search( $params, $attributes );
  63 }
  64
  65 =head3 search_housebound_choosers
  66
  67 Returns all Patrons which are Housebound choosers.
  68
  69 =cut
  70
  71 sub search_housebound_choosers {
  72     my ( $self ) = @_;
  73     my $cho = $self->_resultset
  74         ->search_related('housebound_role', {
  75             housebound_chooser => 1,
  76         })->search_related('borrowernumber');
  77     return Koha::Patrons->_new_from_dbic($cho);
  78 }
  79
  80 =head3 search_housebound_deliverers
  81
  82 Returns all Patrons which are Housebound deliverers.
  83
  84 =cut
  85
  86 sub search_housebound_deliverers {
  87     my ( $self ) = @_;
  88     my $del = $self->_resultset
  89         ->search_related('housebound_role', {
  90             housebound_deliverer => 1,
  91         })->search_related('borrowernumber');
  92     return Koha::Patrons->_new_from_dbic($del);
  93 }
  94
  95 =head3 search_upcoming_membership_expires
  96
  97 my $patrons = Koha::Patrons->search_upcoming_membership_expires();
  98
  99 The 'before' and 'after' represent the number of days before/after the date
 100 that is set by the preference MembershipExpiryDaysNotice.
 101 If the pref is 14, before 2 and after 3 then you will get all expires
 102 from 12 to 17 days.
 103
 104 =cut
 105
 106 sub search_upcoming_membership_expires {
 107     my ( $self, $params ) = @_;
 108     my $before = $params->{before} || 0;
 109     my $after  = $params->{after} || 0;
 110     delete $params->{before};
 111     delete $params->{after};
 112
 113     my $days = C4::Context->preference("MembershipExpiryDaysNotice") || 0;
 114     my $date_before = dt_from_string->add( days => $days - $before );
 115     my $date_after = dt_from_string->add( days => $days + $after );
 116     my $dtf = Koha::Database->new->schema->storage->datetime_parser;
 117
 118     $params->{dateexpiry} = {
 119         ">=" => $dtf->format_date( $date_before ),
 120         "<=" => $dtf->format_date( $date_after ),
 121     };
 122     return $self->SUPER::search(
 123         $params, { join => ['branchcode', 'categorycode'] }
 124     );
 125 }
 126
 127 =head3 search_patrons_to_anonymise
 128
 129     my $patrons = Koha::Patrons->search_patrons_to_anonymise( { before => $older_than_date, [ library => $library ] } );
 130
 131 This method returns all patrons who has an issue history older than a given date.
 132
 133 =cut
 134
 135 sub search_patrons_to_anonymise {
 136     my ( $class, $params ) = @_;
 137     my $older_than_date = $params->{before};
 138     my $library         = $params->{library};
 139     $older_than_date = $older_than_date ? dt_from_string($older_than_date) : dt_from_string;
 140     $library ||=
 141       ( C4::Context->preference('IndependentBranches') && C4::Context->userenv && !C4::Context->IsSuperLibrarian() && C4::Context->userenv->{branch} )
 142       ? C4::Context->userenv->{branch}
 143       : undef;
 144     my $anonymous_patron = C4::Context->preference('AnonymousPatron') || undef;
 145
 146     my $dtf = Koha::Database->new->schema->storage->datetime_parser;
 147     my $rs = $class->_resultset->search(
 148         {   returndate                  => { '<'   =>  $dtf->format_datetime($older_than_date), },
 149             'old_issues.borrowernumber' => { 'not' => undef },
 150             privacy                     => { '<>'  => 0 },                  # Keep forever
 151             ( $library ? ( 'old_issues.branchcode' => $library ) : () ),
 152             ( $anonymous_patron ? ( 'old_issues.borrowernumber' => { '!=' => $anonymous_patron } ) : () ),
 153         },
 154         {   join     => ["old_issues"],
 155             distinct => 1,
 156         }
 157     );
 158     return Koha::Patrons->_new_from_dbic($rs);
 159 }
 160
 161 =head3 delete
 162
 163     Koha::Patrons->search({ some filters here })->delete({ move => 1 });
 164
 165     Delete passed set of patron objects.
 166     Wrapper for Koha::Patron->delete. (We do not want to bypass Koha::Patron
 167     and let DBIx do the job without further housekeeping.)
 168     Includes a move to deletedborrowers if move flag set.
 169
 170     Just like DBIx, the delete will only succeed when all entries could be
 171     deleted. Returns true or throws an exception.
 172
 173 =cut
 174
 175 sub delete {
 176     my ( $self, $params ) = @_;
 177     my $patrons_deleted;
 178     $self->_resultset->result_source->schema->txn_do( sub {
 179         my ( $set, $params ) = @_;
 180         my $count = $set->count;
 181         while ( my $patron = $set->next ) {
 182
 183             next unless $patron->in_storage;
 184
 185             $patron->move_to_deleted if $params->{move};
 186             $patron->delete;
 187
 188             $patrons_deleted++;
 189         }
 190     }, $self, $params );
 191     return $patrons_deleted;
 192 }
 193
 194 =head3 filter_by_expiration_date
 195
 196     Koha::Patrons->filter_by_expiration_date{{ days => $x });
 197
 198     Returns set of Koha patron objects expired $x days.
 199
 200 =cut
 201
 202 sub filter_by_expiration_date {
 203     my ( $class, $params ) = @_;
 204
 205     return $class->filter_by_last_update(
 206         {
 207             timestamp_column_name => 'dateexpiry',
 208             days                  => $params->{days} || 0,
 209             days_inclusive        => 1,
 210         }
 211     );
 212 }
 213
 214 =head3 search_unsubscribed
 215
 216     Koha::Patrons->search_unsubscribed;
 217
 218     Returns a set of Koha patron objects for patrons that recently
 219     unsubscribed and are not locked (candidates for locking).
 220     Depends on UnsubscribeReflectionDelay.
 221
 222 =cut
 223
 224 sub search_unsubscribed {
 225     my ( $class ) = @_;
 226
 227     my $delay = C4::Context->preference('UnsubscribeReflectionDelay');
 228     if( !defined($delay) || $delay eq q{} ) {
 229         # return empty set
 230         return $class->search({ borrowernumber => undef });
 231     }
 232     my $parser = Koha::Database->new->schema->storage->datetime_parser;
 233     my $dt = dt_from_string()->subtract( days => $delay );
 234     my $str = $parser->format_datetime($dt);
 235     my $fails = C4::Context->preference('FailedLoginAttempts') || 0;
 236     my $cond = [ undef, 0, 1..$fails-1 ]; # NULL, 0, 1..fails-1 (if fails>0)
 237     return $class->search(
 238         {
 239             'patron_consents.refused_on' => { '<=' => $str },
 240             'patron_consents.type' => 'GDPR_PROCESSING',
 241             'login_attempts' => $cond,
 242         },
 243         { join => 'patron_consents' },
 244     );
 245 }
 246
 247 =head3 search_anonymize_candidates
 248
 249     Koha::Patrons->search_anonymize_candidates({ locked => 1 });
 250
 251     Returns a set of Koha patron objects for patrons whose account is expired
 252     and locked (if parameter set). These are candidates for anonymizing.
 253     Depends on PatronAnonymizeDelay.
 254
 255 =cut
 256
 257 sub search_anonymize_candidates {
 258     my ( $class, $params ) = @_;
 259
 260     my $delay = C4::Context->preference('PatronAnonymizeDelay');
 261     if( !defined($delay) || $delay eq q{} ) {
 262         # return empty set
 263         return $class->search({ borrowernumber => undef });
 264     }
 265     my $cond = {};
 266     my $parser = Koha::Database->new->schema->storage->datetime_parser;
 267     my $dt = dt_from_string()->subtract( days => $delay );
 268     my $str = $parser->format_datetime($dt);
 269     $cond->{dateexpiry} = { '<=' => $str };
 270     $cond->{anonymized} = 0; # not yet done
 271     if( $params->{locked} ) {
 272         my $fails = C4::Context->preference('FailedLoginAttempts') || 0;
 273         $cond->{login_attempts} = [ -and => { '!=' => undef }, { -not_in => [0, 1..$fails-1 ] } ]; # -not_in does not like undef
 274     }
 275     return $class->search( $cond );
 276 }
 277
 278 =head3 search_anonymized
 279
 280     Koha::Patrons->search_anonymized;
 281
 282     Returns a set of Koha patron objects for patron accounts that have been
 283     anonymized before and could be removed.
 284     Depends on PatronRemovalDelay.
 285
 286 =cut
 287
 288 sub search_anonymized {
 289     my ( $class ) = @_;
 290
 291     my $delay = C4::Context->preference('PatronRemovalDelay');
 292     if( !defined($delay) || $delay eq q{} ) {
 293         # return empty set
 294         return $class->search({ borrowernumber => undef });
 295     }
 296     my $cond = {};
 297     my $parser = Koha::Database->new->schema->storage->datetime_parser;
 298     my $dt = dt_from_string()->subtract( days => $delay );
 299     my $str = $parser->format_datetime($dt);
 300     $cond->{dateexpiry} = { '<=' => $str };
 301     $cond->{anonymized} = 1;
 302     return $class->search( $cond );
 303 }
 304
 305 =head3 lock
 306
 307     Koha::Patrons->search({ some filters })->lock({ expire => 1, remove => 1 })
 308
 309     Lock the passed set of patron objects. Optionally expire and remove holds.
 310     Wrapper around Koha::Patron->lock.
 311
 312 =cut
 313
 314 sub lock {
 315     my ( $self, $params ) = @_;
 316     my $count = $self->count;
 317     while( my $patron = $self->next ) {
 318         $patron->lock($params);
 319     }
 320 }
 321
 322 =head3 anonymize
 323
 324     Koha::Patrons->search({ some filters })->anonymize();
 325
 326     Anonymize passed set of patron objects.
 327     Wrapper around Koha::Patron->anonymize.
 328
 329 =cut
 330
 331 sub anonymize {
 332     my ( $self ) = @_;
 333     my $count = $self->count;
 334     while( my $patron = $self->next ) {
 335         $patron->anonymize;
 336     }
 337 }
 338
 339 =head3 search_patrons_to_update_category
 340
 341     my $patrons = Koha::Patrons->search_patrons_to_update_category( {
 342                       from          => $from_category,
 343                       fine_max      => $fine_max,
 344                       fine_min      => $fin_min,
 345                       too_young     => $too_young,
 346                       too_old      => $too_old,
 347                   });
 348
 349 This method returns all patron who should be updated from one category to another meeting criteria:
 350
 351 from          - borrower categorycode
 352 fine_min      - with fines totaling at least this amount
 353 fine_max      - with fines above this amount
 354 too_young     - if passed, select patrons who are under the age limit for the current category
 355 too_old       - if passed, select patrons who are over the age limit for the current category
 356
 357 =cut
 358
 359 sub search_patrons_to_update_category {
 360     my ( $self, $params ) = @_;
 361     my %query;
 362     my $search_params;
 363
 364     my $cat_from = Koha::Patron::Categories->find($params->{from});
 365     $search_params->{categorycode}=$params->{from};
 366     if ($params->{too_young} || $params->{too_old}){
 367         my $dtf = Koha::Database->new->schema->storage->datetime_parser;
 368         if( $cat_from->dateofbirthrequired && $params->{too_young} ) {
 369             my $date_after = dt_from_string()->subtract( years => $cat_from->dateofbirthrequired);
 370             $search_params->{dateofbirth}{'>'} = $dtf->format_datetime( $date_after );
 371         }
 372         if( $cat_from->upperagelimit && $params->{too_old} ) {
 373             my $date_before = dt_from_string()->subtract( years => $cat_from->upperagelimit);
 374             $search_params->{dateofbirth}{'<'} = $dtf->format_datetime( $date_before );
 375         }
 376     }
 377     if ($params->{fine_min} || $params->{fine_max}) {
 378         $query{join} = ["accountlines"];
 379         $query{columns} = ["borrowernumber"];
 380         $query{group_by} = ["borrowernumber"];
 381         $query{having} = \['COALESCE(sum(accountlines.amountoutstanding),0) <= ?',$params->{fine_max}] if defined $params->{fine_max};
 382         $query{having} = \['COALESCE(sum(accountlines.amountoutstanding),0) >= ?',$params->{fine_min}] if defined $params->{fine_min};
 383     }
 384     return $self->search($search_params,\%query);
 385 }
 386
 387 =head3 update_category_to
 388
 389     Koha::Patrons->search->update_category_to( {
 390             category   => $to_category,
 391         });
 392
 393 Update supplied patrons from current category to another and take care of guarantor info.
 394 To make sure all the conditions are met, the caller has the responsibility to
 395 call search_patrons_to_update to filter the Koha::Patrons set
 396
 397 =cut
 398
 399 sub update_category_to {
 400     my ( $self, $params ) = @_;
 401     my $counter = 0;
 402     while( my $patron = $self->next ) {
 403         $patron->discard_changes;
 404         $counter++;
 405         $patron->categorycode($params->{category})->store();
 406     }
 407     return $counter;
 408 }
 409
 410 =head3 filter_by_attribute_type
 411
 412 my $patrons = Koha::Patrons->filter_by_attribute_type($attribute_type_code);
 413
 414 Return a Koha::Patrons set with patrons having the attribute defined.
 415
 416 =cut
 417
 418 sub filter_by_attribute_type {
 419     my ( $self, $attribute_type ) = @_;
 420     my $rs = Koha::Patron::Attributes->search( { code => $attribute_type } )
 421       ->_resultset()->search_related('borrowernumber');
 422     return Koha::Patrons->_new_from_dbic($rs);
 423 }
 424
 425 =head3 filter_by_attribute_value
 426
 427 my $patrons = Koha::Patrons->filter_by_attribute_value($attribute_value);
 428
 429 Return a Koha::Patrons set with patrong having the attribute value passed in parameter.
 430
 431 =cut
 432
 433 sub filter_by_attribute_value {
 434     my ( $self, $attribute_value ) = @_;
 435     my $rs = Koha::Patron::Attributes->search(
 436         {
 437             'borrower_attribute_types.staff_searchable' => 1,
 438             attribute => { like => "%$attribute_value%" }
 439         },
 440         { join => 'borrower_attribute_types' }
 441     )->_resultset()->search_related('borrowernumber');
 442     return Koha::Patrons->_new_from_dbic($rs);
 443 }
 444
 445 =head3 filter_by_amount_owed
 446
 447     Koha::Patrons->filter_by_amount_owed(
 448         {
 449             less_than  => '2.00',
 450             more_than  => '0.50',
 451             debit_type => $debit_type_code,
 452             library    => $branchcode
 453         }
 454     );
 455
 456 Returns patrons filtered by how much money they owe, between passed limits.
 457
 458 Optionally limit to debts of a particular debit_type or/and owed to a particular library.
 459
 460 =head4 arguments hashref
 461
 462 =over 4
 463
 464 =item less_than (optional)  - filter out patrons who owe less than Amount
 465
 466 =item more_than (optional)  - filter out patrons who owe more than Amount
 467
 468 =item debit_type (optional) - filter the amount owed by debit type
 469
 470 =item library (optional)    - filter the amount owed to a particular branch
 471
 472 =back
 473
 474 =cut
 475
 476 sub filter_by_amount_owed {
 477     my ( $self, $options ) = @_;
 478
 479     return $self
 480       unless (
 481         defined($options)
 482         && (   defined( $options->{less_than} )
 483             || defined( $options->{more_than} ) )
 484       );
 485
 486     my $where = {};
 487     my $group_by =
 488       [ map { 'me.' . $_ } $self->_resultset->result_source->columns ];
 489
 490     my $attrs = {
 491         join     => 'accountlines',
 492         group_by => $group_by,
 493         '+select' =>
 494           { sum => 'accountlines.amountoutstanding', '-as' => 'outstanding' },
 495         '+as' => 'outstanding'
 496     };
 497
 498     $where->{'accountlines.debit_type_code'} = $options->{debit_type}
 499       if defined( $options->{debit_type} );
 500
 501     $where->{'accountlines.branchcode'} = $options->{library}
 502       if defined( $options->{library} );
 503
 504     $attrs->{'having'} = [
 505         { 'outstanding' => { '<' => $options->{less_than} } },
 506         { 'outstanding' => undef }
 507       ]
 508       if ( defined( $options->{less_than} )
 509         && !defined( $options->{more_than} ) );
 510
 511     $attrs->{'having'} = { 'outstanding' => { '>' => $options->{more_than} } }
 512       if (!defined( $options->{less_than} )
 513         && defined( $options->{more_than} ) );
 514
 515     $attrs->{'having'}->{'-and'} = [
 516         { 'outstanding' => { '>' => $options->{more_than} } },
 517         { 'outstanding' => { '<' => $options->{less_than} } }
 518       ]
 519       if ( defined( $options->{less_than} )
 520         && defined( $options->{more_than} ) );
 521
 522     return $self->search( $where, $attrs );
 523 }
 524
 525 =head3 filter_by_have_permission
 526
 527     my $patrons = Koha::Patrons->search->filter_by_have_permission('suggestions.suggestions_manage');
 528
 529     my $patrons = Koha::Patrons->search->filter_by_have_permission('suggestions');
 530
 531 Filter patrons who have a given subpermission or the whole permission.
 532
 533 =cut
 534
 535 sub filter_by_have_permission {
 536     my ($self, $subpermission) = @_;
 537
 538     my ($p, $sp) = split '\.', $subpermission;
 539
 540     my $perm = Koha::Database->new()->schema()->resultset('Userflag')->find({flag => $p});
 541
 542     Koha::Exceptions::ObjectNotFound->throw( sprintf( "Permission %s not found", $p ) )
 543       unless $perm;
 544
 545     my $bit = $perm->bit;
 546
 547     return $self->search(
 548         {
 549             -and => [
 550                 -or => [
 551                     \"me.flags & (1 << $bit)",
 552                     { 'me.flags' => 1 },
 553                     (
 554                         $sp
 555                         ? {
 556                             -and => [
 557                                 { 'user_permissions.module_bit' => $bit },
 558                                 { 'user_permissions.code'       => $sp }
 559                             ]
 560                           }
 561                         : ()
 562                     )
 563                 ]
 564             ]
 565         },
 566         { prefetch => 'user_permissions' }
 567     );
 568 }
 569
 570 =head3 _type
 571
 572 =cut
 573
 574 sub _type {
 575     return 'Borrower';
 576 }
 577
 578 =head3 object_class
 579
 580 =cut
 581
 582 sub object_class {
 583     return 'Koha::Patron';
 584 }
 585
 586 =head1 AUTHOR
 587
 588 Kyle M Hall <kyle@bywatersolutions.com>
 589
 590 =cut
 591
 592 1;