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 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, verbose => 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         warn "Deleted $count patrons\n" if $params->{verbose};
 233     }, $self, $params );
 234     return $patrons_deleted;
 235 }
 236
 237 =head3 search_unsubscribed
 238
 239     Koha::Patrons->search_unsubscribed;
 240
 241     Returns a set of Koha patron objects for patrons that recently
 242     unsubscribed and are not locked (candidates for locking).
 243     Depends on UnsubscribeReflectionDelay.
 244
 245 =cut
 246
 247 sub search_unsubscribed {
 248     my ( $class ) = @_;
 249
 250     my $delay = C4::Context->preference('UnsubscribeReflectionDelay');
 251     if( !defined($delay) || $delay eq q{} ) {
 252         # return empty set
 253         return $class->search({ borrowernumber => undef });
 254     }
 255     my $parser = Koha::Database->new->schema->storage->datetime_parser;
 256     my $dt = dt_from_string()->subtract( days => $delay );
 257     my $str = $parser->format_datetime($dt);
 258     my $fails = C4::Context->preference('FailedLoginAttempts') || 0;
 259     my $cond = [ undef, 0, 1..$fails-1 ]; # NULL, 0, 1..fails-1 (if fails>0)
 260     return $class->search(
 261         {
 262             'patron_consents.refused_on' => { '<=' => $str },
 263             'login_attempts' => $cond,
 264         },
 265         { join => 'patron_consents' },
 266     );
 267 }
 268
 269 =head3 search_anonymize_candidates
 270
 271     Koha::Patrons->search_anonymize_candidates({ locked => 1 });
 272
 273     Returns a set of Koha patron objects for patrons whose account is expired
 274     and locked (if parameter set). These are candidates for anonymizing.
 275     Depends on PatronAnonymizeDelay.
 276
 277 =cut
 278
 279 sub search_anonymize_candidates {
 280     my ( $class, $params ) = @_;
 281
 282     my $delay = C4::Context->preference('PatronAnonymizeDelay');
 283     if( !defined($delay) || $delay eq q{} ) {
 284         # return empty set
 285         return $class->search({ borrowernumber => undef });
 286     }
 287     my $cond = {};
 288     my $parser = Koha::Database->new->schema->storage->datetime_parser;
 289     my $dt = dt_from_string()->subtract( days => $delay );
 290     my $str = $parser->format_datetime($dt);
 291     $cond->{dateexpiry} = { '<=' => $str };
 292     $cond->{anonymized} = 0; # not yet done
 293     if( $params->{locked} ) {
 294         my $fails = C4::Context->preference('FailedLoginAttempts');
 295         $cond->{login_attempts} = [ -and => { '!=' => undef }, { -not_in => [0, 1..$fails-1 ] } ]; # -not_in does not like undef
 296     }
 297     return $class->search( $cond );
 298 }
 299
 300 =head3 search_anonymized
 301
 302     Koha::Patrons->search_anonymized;
 303
 304     Returns a set of Koha patron objects for patron accounts that have been
 305     anonymized before and could be removed.
 306     Depends on PatronRemovalDelay.
 307
 308 =cut
 309
 310 sub search_anonymized {
 311     my ( $class ) = @_;
 312
 313     my $delay = C4::Context->preference('PatronRemovalDelay');
 314     if( !defined($delay) || $delay eq q{} ) {
 315         # return empty set
 316         return $class->search({ borrowernumber => undef });
 317     }
 318     my $cond = {};
 319     my $parser = Koha::Database->new->schema->storage->datetime_parser;
 320     my $dt = dt_from_string()->subtract( days => $delay );
 321     my $str = $parser->format_datetime($dt);
 322     $cond->{dateexpiry} = { '<=' => $str };
 323     $cond->{anonymized} = 1;
 324     return $class->search( $cond );
 325 }
 326
 327 =head3 lock
 328
 329     Koha::Patrons->search({ some filters })->lock({ expire => 1, remove => 1, verbose => 1 })
 330
 331     Lock the passed set of patron objects. Optionally expire and remove holds.
 332     Optional verbose flag is used in cron job.
 333     Wrapper around Koha::Patron->lock.
 334
 335 =cut
 336
 337 sub lock {
 338     my ( $self, $params ) = @_;
 339     my $count = $self->count;
 340     while( my $patron = $self->next ) {
 341         $patron->lock($params);
 342     }
 343     if( $params->{verbose} ) {
 344         warn "Locked $count patrons\n";
 345     }
 346 }
 347
 348 =head3 anonymize
 349
 350     Koha::Patrons->search({ some filters })->anonymize({ verbose => 1 });
 351
 352     Anonymize passed set of patron objects.
 353     Optional verbose flag is used in cron job.
 354     Wrapper around Koha::Patron->anonymize.
 355
 356 =cut
 357
 358 sub anonymize {
 359     my ( $self, $params ) = @_;
 360     my $count = $self->count;
 361     while( my $patron = $self->next ) {
 362         $patron->anonymize;
 363     }
 364     if( $params->{verbose} ) {
 365         warn "Anonymized $count patrons\n";
 366     }
 367 }
 368
 369 =head3 search_patrons_to_update_category
 370
 371     my $patrons = Koha::Patrons->search_patrons_to_update_category( {
 372                       from          => $from_category,
 373                       fine_max      => $fine_max,
 374                       fine_min      => $fin_min,
 375                       too_young     => $too_young,
 376                       too_old      => $too_old,
 377                   });
 378
 379 This method returns all patron who should be updated from one category to another meeting criteria:
 380
 381 from          - borrower categorycode
 382 fine_min      - with fines totaling at least this amount
 383 fine_max      - with fines above this amount
 384 too_young     - if passed, select patrons who are under the age limit for the current category
 385 too_old       - if passed, select patrons who are over the age limit for the current category
 386
 387 =cut
 388
 389 sub search_patrons_to_update_category {
 390     my ( $self, $params ) = @_;
 391     my %query;
 392     my $search_params;
 393
 394     my $cat_from = Koha::Patron::Categories->find($params->{from});
 395     $search_params->{categorycode}=$params->{from};
 396     if ($params->{too_young} || $params->{too_old}){
 397         my $dtf = Koha::Database->new->schema->storage->datetime_parser;
 398         if( $cat_from->dateofbirthrequired && $params->{too_young} ) {
 399             my $date_after = dt_from_string()->subtract( years => $cat_from->dateofbirthrequired);
 400             $search_params->{dateofbirth}{'>'} = $dtf->format_datetime( $date_after );
 401         }
 402         if( $cat_from->upperagelimit && $params->{too_old} ) {
 403             my $date_before = dt_from_string()->subtract( years => $cat_from->upperagelimit);
 404             $search_params->{dateofbirth}{'<'} = $dtf->format_datetime( $date_before );
 405         }
 406     }
 407     if ($params->{fine_min} || $params->{fine_max}) {
 408         $query{join} = ["accountlines"];
 409         $query{select} = ["borrowernumber", "accountlines.amountoutstanding" ];
 410         $query{group_by} = ["borrowernumber"];
 411         $query{having} = \['sum(accountlines.amountoutstanding) <= ?',$params->{fine_max}] if defined $params->{fine_max};
 412         $query{having} = \['sum(accountlines.amountoutstanding) >= ?',$params->{fine_min}] if defined $params->{fine_min};
 413     }
 414     return $self->search($search_params,\%query);
 415 }
 416
 417 =head3 update_category_to
 418
 419     Koha::Patrons->search->update_category_to( {
 420             category   => $to_category,
 421         });
 422
 423 Update supplied patrons from current category to another and take care of guarantor info.
 424 To make sure all the conditions are met, the caller has the responsibility to
 425 call search_patrons_to_update to filter the Koha::Patrons set
 426
 427 =cut
 428
 429 sub update_category_to {
 430     my ( $self, $params ) = @_;
 431     my $counter = 0;
 432     while( my $patron = $self->next ) {
 433         $counter++;
 434         $patron->categorycode($params->{category})->store();
 435     }
 436     return $counter;
 437 }
 438
 439 =head3 _type
 440
 441 =cut
 442
 443 sub _type {
 444     return 'Borrower';
 445 }
 446
 447 =head3 object_class
 448
 449 =cut
 450
 451 sub object_class {
 452     return 'Koha::Patron';
 453 }
 454
 455 =head1 AUTHOR
 456
 457 Kyle M Hall <kyle@bywatersolutions.com>
 458
 459 =cut
 460
 461 1;