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             'login_attempts' => $cond,
 241         },
 242         { join => 'patron_consents' },
 243     );
 244 }
 245
 246 =head3 search_anonymize_candidates
 247
 248     Koha::Patrons->search_anonymize_candidates({ locked => 1 });
 249
 250     Returns a set of Koha patron objects for patrons whose account is expired
 251     and locked (if parameter set). These are candidates for anonymizing.
 252     Depends on PatronAnonymizeDelay.
 253
 254 =cut
 255
 256 sub search_anonymize_candidates {
 257     my ( $class, $params ) = @_;
 258
 259     my $delay = C4::Context->preference('PatronAnonymizeDelay');
 260     if( !defined($delay) || $delay eq q{} ) {
 261         # return empty set
 262         return $class->search({ borrowernumber => undef });
 263     }
 264     my $cond = {};
 265     my $parser = Koha::Database->new->schema->storage->datetime_parser;
 266     my $dt = dt_from_string()->subtract( days => $delay );
 267     my $str = $parser->format_datetime($dt);
 268     $cond->{dateexpiry} = { '<=' => $str };
 269     $cond->{anonymized} = 0; # not yet done
 270     if( $params->{locked} ) {
 271         my $fails = C4::Context->preference('FailedLoginAttempts') || 0;
 272         $cond->{login_attempts} = [ -and => { '!=' => undef }, { -not_in => [0, 1..$fails-1 ] } ]; # -not_in does not like undef
 273     }
 274     return $class->search( $cond );
 275 }
 276
 277 =head3 search_anonymized
 278
 279     Koha::Patrons->search_anonymized;
 280
 281     Returns a set of Koha patron objects for patron accounts that have been
 282     anonymized before and could be removed.
 283     Depends on PatronRemovalDelay.
 284
 285 =cut
 286
 287 sub search_anonymized {
 288     my ( $class ) = @_;
 289
 290     my $delay = C4::Context->preference('PatronRemovalDelay');
 291     if( !defined($delay) || $delay eq q{} ) {
 292         # return empty set
 293         return $class->search({ borrowernumber => undef });
 294     }
 295     my $cond = {};
 296     my $parser = Koha::Database->new->schema->storage->datetime_parser;
 297     my $dt = dt_from_string()->subtract( days => $delay );
 298     my $str = $parser->format_datetime($dt);
 299     $cond->{dateexpiry} = { '<=' => $str };
 300     $cond->{anonymized} = 1;
 301     return $class->search( $cond );
 302 }
 303
 304 =head3 lock
 305
 306     Koha::Patrons->search({ some filters })->lock({ expire => 1, remove => 1 })
 307
 308     Lock the passed set of patron objects. Optionally expire and remove holds.
 309     Wrapper around Koha::Patron->lock.
 310
 311 =cut
 312
 313 sub lock {
 314     my ( $self, $params ) = @_;
 315     my $count = $self->count;
 316     while( my $patron = $self->next ) {
 317         $patron->lock($params);
 318     }
 319 }
 320
 321 =head3 anonymize
 322
 323     Koha::Patrons->search({ some filters })->anonymize();
 324
 325     Anonymize passed set of patron objects.
 326     Wrapper around Koha::Patron->anonymize.
 327
 328 =cut
 329
 330 sub anonymize {
 331     my ( $self ) = @_;
 332     my $count = $self->count;
 333     while( my $patron = $self->next ) {
 334         $patron->anonymize;
 335     }
 336 }
 337
 338 =head3 search_patrons_to_update_category
 339
 340     my $patrons = Koha::Patrons->search_patrons_to_update_category( {
 341                       from          => $from_category,
 342                       fine_max      => $fine_max,
 343                       fine_min      => $fin_min,
 344                       too_young     => $too_young,
 345                       too_old      => $too_old,
 346                   });
 347
 348 This method returns all patron who should be updated from one category to another meeting criteria:
 349
 350 from          - borrower categorycode
 351 fine_min      - with fines totaling at least this amount
 352 fine_max      - with fines above this amount
 353 too_young     - if passed, select patrons who are under the age limit for the current category
 354 too_old       - if passed, select patrons who are over the age limit for the current category
 355
 356 =cut
 357
 358 sub search_patrons_to_update_category {
 359     my ( $self, $params ) = @_;
 360     my %query;
 361     my $search_params;
 362
 363     my $cat_from = Koha::Patron::Categories->find($params->{from});
 364     $search_params->{categorycode}=$params->{from};
 365     if ($params->{too_young} || $params->{too_old}){
 366         my $dtf = Koha::Database->new->schema->storage->datetime_parser;
 367         if( $cat_from->dateofbirthrequired && $params->{too_young} ) {
 368             my $date_after = dt_from_string()->subtract( years => $cat_from->dateofbirthrequired);
 369             $search_params->{dateofbirth}{'>'} = $dtf->format_datetime( $date_after );
 370         }
 371         if( $cat_from->upperagelimit && $params->{too_old} ) {
 372             my $date_before = dt_from_string()->subtract( years => $cat_from->upperagelimit);
 373             $search_params->{dateofbirth}{'<'} = $dtf->format_datetime( $date_before );
 374         }
 375     }
 376     if ($params->{fine_min} || $params->{fine_max}) {
 377         $query{join} = ["accountlines"];
 378         $query{columns} = ["borrowernumber"];
 379         $query{group_by} = ["borrowernumber"];
 380         $query{having} = \['COALESCE(sum(accountlines.amountoutstanding),0) <= ?',$params->{fine_max}] if defined $params->{fine_max};
 381         $query{having} = \['COALESCE(sum(accountlines.amountoutstanding),0) >= ?',$params->{fine_min}] if defined $params->{fine_min};
 382     }
 383     return $self->search($search_params,\%query);
 384 }
 385
 386 =head3 update_category_to
 387
 388     Koha::Patrons->search->update_category_to( {
 389             category   => $to_category,
 390         });
 391
 392 Update supplied patrons from current category to another and take care of guarantor info.
 393 To make sure all the conditions are met, the caller has the responsibility to
 394 call search_patrons_to_update to filter the Koha::Patrons set
 395
 396 =cut
 397
 398 sub update_category_to {
 399     my ( $self, $params ) = @_;
 400     my $counter = 0;
 401     while( my $patron = $self->next ) {
 402         $counter++;
 403         $patron->categorycode($params->{category})->store();
 404     }
 405     return $counter;
 406 }
 407
 408 =head3 filter_by_attribute_type
 409
 410 my $patrons = Koha::Patrons->filter_by_attribute_type($attribute_type_code);
 411
 412 Return a Koha::Patrons set with patrons having the attribute defined.
 413
 414 =cut
 415
 416 sub filter_by_attribute_type {
 417     my ( $self, $attribute_type ) = @_;
 418     my $rs = Koha::Patron::Attributes->search( { code => $attribute_type } )
 419       ->_resultset()->search_related('borrowernumber');
 420     return Koha::Patrons->_new_from_dbic($rs);
 421 }
 422
 423 =head3 filter_by_attribute_value
 424
 425 my $patrons = Koha::Patrons->filter_by_attribute_value($attribute_value);
 426
 427 Return a Koha::Patrons set with patrong having the attribute value passed in parameter.
 428
 429 =cut
 430
 431 sub filter_by_attribute_value {
 432     my ( $self, $attribute_value ) = @_;
 433     my $rs = Koha::Patron::Attributes->search(
 434         {
 435             'borrower_attribute_types.staff_searchable' => 1,
 436             attribute => { like => "%$attribute_value%" }
 437         },
 438         { join => 'borrower_attribute_types' }
 439     )->_resultset()->search_related('borrowernumber');
 440     return Koha::Patrons->_new_from_dbic($rs);
 441 }
 442
 443 =head3 filter_by_amount_owed
 444
 445     Koha::Patrons->filter_by_amount_owed(
 446         {
 447             less_than  => '2.00',
 448             more_than  => '0.50',
 449             debit_type => $debit_type_code,
 450             library    => $branchcode
 451         }
 452     );
 453
 454 Returns patrons filtered by how much money they owe, between passed limits.
 455
 456 Optionally limit to debts of a particular debit_type or/and owed to a particular library.
 457
 458 =head4 arguments hashref
 459
 460 =over 4
 461
 462 =item less_than (optional)  - filter out patrons who owe less than Amount
 463
 464 =item more_than (optional)  - filter out patrons who owe more than Amount
 465
 466 =item debit_type (optional) - filter the amount owed by debit type
 467
 468 =item library (optional)    - filter the amount owed to a particular branch
 469
 470 =back
 471
 472 =cut
 473
 474 sub filter_by_amount_owed {
 475     my ( $self, $options ) = @_;
 476
 477     return $self
 478       unless (
 479         defined($options)
 480         && (   defined( $options->{less_than} )
 481             || defined( $options->{more_than} ) )
 482       );
 483
 484     my $where = {};
 485     my $group_by =
 486       [ map { 'me.' . $_ } $self->_resultset->result_source->columns ];
 487
 488     my $attrs = {
 489         join     => 'accountlines',
 490         group_by => $group_by,
 491         '+select' =>
 492           { sum => 'accountlines.amountoutstanding', '-as' => 'outstanding' },
 493         '+as' => 'outstanding'
 494     };
 495
 496     $where->{'accountlines.debit_type_code'} = $options->{debit_type}
 497       if defined( $options->{debit_type} );
 498
 499     $where->{'accountlines.branchcode'} = $options->{library}
 500       if defined( $options->{library} );
 501
 502     $attrs->{'having'} = [
 503         { 'outstanding' => { '<' => $options->{less_than} } },
 504         { 'outstanding' => undef }
 505       ]
 506       if ( defined( $options->{less_than} )
 507         && !defined( $options->{more_than} ) );
 508
 509     $attrs->{'having'} = { 'outstanding' => { '>' => $options->{more_than} } }
 510       if (!defined( $options->{less_than} )
 511         && defined( $options->{more_than} ) );
 512
 513     $attrs->{'having'}->{'-and'} = [
 514         { 'outstanding' => { '>' => $options->{more_than} } },
 515         { 'outstanding' => { '<' => $options->{less_than} } }
 516       ]
 517       if ( defined( $options->{less_than} )
 518         && defined( $options->{more_than} ) );
 519
 520     return $self->search( $where, $attrs );
 521 }
 522
 523 =head3 filter_by_have_subpermission
 524
 525     my $patrons = Koha::Patrons->search->filter_by_have_subpermission('suggestions.suggestions_manage');
 526
 527 Filter patrons who have a given subpermission
 528
 529 =cut
 530
 531 sub filter_by_have_subpermission {
 532     my ($self, $subpermission) = @_;
 533
 534     my ($p, $sp) = split '\.', $subpermission;
 535
 536     my $perm = Koha::Database->new()->schema()->resultset('Userflag')->find({flag => $p});
 537
 538     Koha::Exceptions::ObjectNotFound->throw( sprintf( "Permission %s not found", $p ) )
 539       unless $perm;
 540
 541     my $bit = $perm->bit;
 542
 543     return $self->search(
 544         {
 545             -and => [
 546                 -or => [
 547                     \"me.flags & (1 << $bit)",
 548                     { 'me.flags' => 1 },
 549                     {
 550                         -and => [
 551                             { 'user_permissions.module_bit' => $bit },
 552                             { 'user_permissions.code'       => $sp }
 553                         ]
 554                     }
 555                 ]
 556             ]
 557         },
 558         { prefetch => 'user_permissions' }
 559     );
 560 }
 561
 562 =head3 _type
 563
 564 =cut
 565
 566 sub _type {
 567     return 'Borrower';
 568 }
 569
 570 =head3 object_class
 571
 572 =cut
 573
 574 sub object_class {
 575     return 'Koha::Patron';
 576 }
 577
 578 =head1 AUTHOR
 579
 580 Kyle M Hall <kyle@bywatersolutions.com>
 581
 582 =cut
 583
 584 1;