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 guarantor
 129
 130 Returns a Koha::Patron object for this borrower's guarantor
 131
 132 =cut
 133
 134 sub guarantor {
 135     my ( $self ) = @_;
 136
 137     return Koha::Patrons->find( $self->guarantorid() );
 138 }
 139
 140 =head3 search_patrons_to_anonymise
 141
 142     my $patrons = Koha::Patrons->search_patrons_to_anonymise( { before => $older_than_date, [ library => $library ] } );
 143
 144 This method returns all patrons who has an issue history older than a given date.
 145
 146 =cut
 147
 148 sub search_patrons_to_anonymise {
 149     my ( $class, $params ) = @_;
 150     my $older_than_date = $params->{before};
 151     my $library         = $params->{library};
 152     $older_than_date = $older_than_date ? dt_from_string($older_than_date) : dt_from_string;
 153     $library ||=
 154       ( C4::Context->preference('IndependentBranches') && C4::Context->userenv && !C4::Context->IsSuperLibrarian() && C4::Context->userenv->{branch} )
 155       ? C4::Context->userenv->{branch}
 156       : undef;
 157
 158     my $dtf = Koha::Database->new->schema->storage->datetime_parser;
 159     my $rs = $class->_resultset->search(
 160         {   returndate                  => { '<'   =>  $dtf->format_datetime($older_than_date), },
 161             'old_issues.borrowernumber' => { 'not' => undef },
 162             privacy                     => { '<>'  => 0 },                  # Keep forever
 163             ( $library ? ( 'old_issues.branchcode' => $library ) : () ),
 164         },
 165         {   join     => ["old_issues"],
 166             distinct => 1,
 167         }
 168     );
 169     return Koha::Patrons->_new_from_dbic($rs);
 170 }
 171
 172 =head3 anonymise_issue_history
 173
 174     Koha::Patrons->search->anonymise_issue_history( { [ before => $older_than_date ] } );
 175
 176 Anonymise issue history (old_issues) for all patrons older than the given date (optional).
 177 To make sure all the conditions are met, the caller has the responsibility to
 178 call search_patrons_to_anonymise to filter the Koha::Patrons set
 179
 180 =cut
 181
 182 sub anonymise_issue_history {
 183     my ( $self, $params ) = @_;
 184
 185     my $older_than_date = $params->{before};
 186
 187     $older_than_date = dt_from_string $older_than_date if $older_than_date;
 188
 189     # The default of 0 does not work due to foreign key constraints
 190     # The anonymisation should not fail quietly if AnonymousPatron is not a valid entry
 191     # Set it to undef (NULL)
 192     my $dtf = Koha::Database->new->schema->storage->datetime_parser;
 193     my $nb_rows = 0;
 194     while ( my $patron = $self->next ) {
 195         my $old_issues_to_anonymise = $patron->old_checkouts->search(
 196         {
 197             (
 198                 $older_than_date
 199                 ? ( returndate =>
 200                       { '<' => $dtf->format_datetime($older_than_date) } )
 201                 : ()
 202             )
 203         }
 204         );
 205         my $anonymous_patron = C4::Context->preference('AnonymousPatron') || undef;
 206         $nb_rows += $old_issues_to_anonymise->update( { 'old_issues.borrowernumber' => $anonymous_patron } );
 207     }
 208     return $nb_rows;
 209 }
 210
 211 =head3 delete
 212
 213     Koha::Patrons->search({ some filters here })->delete({ move => 1 });
 214
 215     Delete passed set of patron objects.
 216     Wrapper for Koha::Patron->delete. (We do not want to bypass Koha::Patron
 217     and let DBIx do the job without further housekeeping.)
 218     Includes a move to deletedborrowers if move flag set.
 219
 220     Just like DBIx, the delete will only succeed when all entries could be
 221     deleted. Returns true or throws an exception.
 222
 223 =cut
 224
 225 sub delete {
 226     my ( $self, $params ) = @_;
 227     my $patrons_deleted;
 228     $self->_resultset->result_source->schema->txn_do( sub {
 229         my ( $set, $params ) = @_;
 230         while( my $patron = $set->next ) {
 231             $patron->move_to_deleted if $params->{move};
 232             $patron->delete == 1 || Koha::Exceptions::Patron::FailedDelete->throw;
 233             $patrons_deleted++;
 234         }
 235     }, $self, $params );
 236     return $patrons_deleted;
 237 }
 238
 239 =head3 search_unsubscribed
 240
 241     Koha::Patrons->search_unsubscribed;
 242
 243     Returns a set of Koha patron objects for patrons that recently
 244     unsubscribed and are not locked (candidates for locking).
 245     Depends on UnsubscribeReflectionDelay.
 246
 247 =cut
 248
 249 sub search_unsubscribed {
 250     my ( $class ) = @_;
 251
 252     my $delay = C4::Context->preference('UnsubscribeReflectionDelay');
 253     if( !defined($delay) || $delay eq q{} ) {
 254         # return empty set
 255         return $class->search({ borrowernumber => undef });
 256     }
 257     my $parser = Koha::Database->new->schema->storage->datetime_parser;
 258     my $dt = dt_from_string()->subtract( days => $delay );
 259     my $str = $parser->format_datetime($dt);
 260     my $fails = C4::Context->preference('FailedLoginAttempts') || 0;
 261     my $cond = [ undef, 0, 1..$fails-1 ]; # NULL, 0, 1..fails-1 (if fails>0)
 262     return $class->search(
 263         {
 264             'patron_consents.refused_on' => { '<=' => $str },
 265             'login_attempts' => $cond,
 266         },
 267         { join => 'patron_consents' },
 268     );
 269 }
 270
 271 =head3 search_anonymize_candidates
 272
 273     Koha::Patrons->search_anonymize_candidates({ locked => 1 });
 274
 275     Returns a set of Koha patron objects for patrons whose account is expired
 276     and locked (if parameter set). These are candidates for anonymizing.
 277     Depends on PatronAnonymizeDelay.
 278
 279 =cut
 280
 281 sub search_anonymize_candidates {
 282     my ( $class, $params ) = @_;
 283
 284     my $delay = C4::Context->preference('PatronAnonymizeDelay');
 285     if( !defined($delay) || $delay eq q{} ) {
 286         # return empty set
 287         return $class->search({ borrowernumber => undef });
 288     }
 289     my $cond = {};
 290     my $parser = Koha::Database->new->schema->storage->datetime_parser;
 291     my $dt = dt_from_string()->subtract( days => $delay );
 292     my $str = $parser->format_datetime($dt);
 293     $cond->{dateexpiry} = { '<=' => $str };
 294     $cond->{flgAnonymized} = [ undef, 0 ]; # not yet done
 295     if( $params->{locked} ) {
 296         my $fails = C4::Context->preference('FailedLoginAttempts');
 297         $cond->{login_attempts} = [ -and => { '!=' => undef }, { -not_in => [0, 1..$fails-1 ] } ]; # -not_in does not like undef
 298     }
 299     return $class->search( $cond );
 300 }
 301
 302 =head3 search_anonymized
 303
 304     Koha::Patrons->search_anonymized;
 305
 306     Returns a set of Koha patron objects for patron accounts that have been
 307     anonymized before and could be removed.
 308     Depends on PatronRemovalDelay.
 309
 310 =cut
 311
 312 sub search_anonymized {
 313     my ( $class ) = @_;
 314
 315     my $delay = C4::Context->preference('PatronRemovalDelay');
 316     if( !defined($delay) || $delay eq q{} ) {
 317         # return empty set
 318         return $class->search({ borrowernumber => undef });
 319     }
 320     my $cond = {};
 321     my $parser = Koha::Database->new->schema->storage->datetime_parser;
 322     my $dt = dt_from_string()->subtract( days => $delay );
 323     my $str = $parser->format_datetime($dt);
 324     $cond->{dateexpiry} = { '<=' => $str };
 325     $cond->{flgAnonymized} = 1;
 326     return $class->search( $cond );
 327 }
 328
 329 =head3 lock
 330
 331     Koha::Patrons->search({ some filters })->lock({ expire => 1, remove => 1 })
 332
 333     Lock the passed set of patron objects. Optionally expire and remove holds.
 334     Wrapper around Koha::Patron->lock.
 335
 336 =cut
 337
 338 sub lock {
 339     my ( $self, $params ) = @_;
 340     while( my $patron = $self->next ) {
 341         $patron->lock($params);
 342     }
 343 }
 344
 345 =head3 anonymize
 346
 347     Koha::Patrons->search({ some filters })->anonymize;
 348
 349     Anonymize passed set of patron objects.
 350     Wrapper around Koha::Patron->anonymize.
 351
 352 =cut
 353
 354 sub anonymize {
 355     my ( $self ) = @_;
 356     while( my $patron = $self->next ) {
 357         $patron->anonymize;
 358     }
 359 }
 360
 361 =head3 _type
 362
 363 =cut
 364
 365 sub _type {
 366     return 'Borrower';
 367 }
 368
 369 sub object_class {
 370     return 'Koha::Patron';
 371 }
 372
 373 =head1 AUTHOR
 374
 375 Kyle M Hall <kyle@bywatersolutions.com>
 376
 377 =cut
 378
 379 1;