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