Bug 28293: (bug 20443 follow-up) Fix wrong key in Patrons::Import->generate_patron_at...
[koha.git] / C4 / Members.pm
1 package C4::Members;
2
3 # Copyright 2000-2003 Katipo Communications
4 # Copyright 2010 BibLibre
5 # Parts Copyright 2010 Catalyst IT
6 #
7 # This file is part of Koha.
8 #
9 # Koha is free software; you can redistribute it and/or modify it
10 # under the terms of the GNU General Public License as published by
11 # the Free Software Foundation; either version 3 of the License, or
12 # (at your option) any later version.
13 #
14 # Koha is distributed in the hope that it will be useful, but
15 # WITHOUT ANY WARRANTY; without even the implied warranty of
16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 # GNU General Public License for more details.
18 #
19 # You should have received a copy of the GNU General Public License
20 # along with Koha; if not, see <http://www.gnu.org/licenses>.
21
22
23 use Modern::Perl;
24 use C4::Context;
25 use String::Random qw( random_string );
26 use Scalar::Util qw( looks_like_number );
27 use Date::Calc qw/Today check_date Date_to_Days/;
28 use List::MoreUtils qw( uniq );
29 use JSON qw(to_json);
30 use C4::Log; # logaction
31 use C4::Overdues;
32 use C4::Reserves;
33 use C4::Accounts;
34 use C4::Biblio;
35 use C4::Letters;
36 use C4::NewsChannels; #get slip news
37 use DateTime;
38 use Koha::Database;
39 use Koha::DateUtils;
40 use Koha::AuthUtils qw(hash_password);
41 use Koha::Database;
42 use Koha::Holds;
43 use Koha::List::Patron;
44 use Koha::Patrons;
45 use Koha::Patron::Categories;
46
47 our (@ISA,@EXPORT,@EXPORT_OK,$debug);
48
49 BEGIN {
50     $debug = $ENV{DEBUG} || 0;
51     require Exporter;
52     @ISA = qw(Exporter);
53     #Get data
54     push @EXPORT, qw(
55
56         &GetAllIssues
57
58         &GetBorrowersToExpunge
59
60         &IssueSlip
61     );
62
63     #Check data
64     push @EXPORT, qw(
65         &checkuserpassword
66         &checkcardnumber
67     );
68 }
69
70 =head1 NAME
71
72 C4::Members - Perl Module containing convenience functions for member handling
73
74 =head1 SYNOPSIS
75
76 use C4::Members;
77
78 =head1 DESCRIPTION
79
80 This module contains routines for adding, modifying and deleting members/patrons/borrowers
81
82 =head1 FUNCTIONS
83
84 =head2 patronflags
85
86  $flags = &patronflags($patron);
87
88 This function is not exported.
89
90 The following will be set where applicable:
91  $flags->{CHARGES}->{amount}        Amount of debt
92  $flags->{CHARGES}->{noissues}      Set if debt amount >$5.00 (or syspref noissuescharge)
93  $flags->{CHARGES}->{message}       Message -- deprecated
94
95  $flags->{CREDITS}->{amount}        Amount of credit
96  $flags->{CREDITS}->{message}       Message -- deprecated
97
98  $flags->{  GNA  }                  Patron has no valid address
99  $flags->{  GNA  }->{noissues}      Set for each GNA
100  $flags->{  GNA  }->{message}       "Borrower has no valid address" -- deprecated
101
102  $flags->{ LOST  }                  Patron's card reported lost
103  $flags->{ LOST  }->{noissues}      Set for each LOST
104  $flags->{ LOST  }->{message}       Message -- deprecated
105
106  $flags->{DBARRED}                  Set if patron debarred, no access
107  $flags->{DBARRED}->{noissues}      Set for each DBARRED
108  $flags->{DBARRED}->{message}       Message -- deprecated
109
110  $flags->{ NOTES }
111  $flags->{ NOTES }->{message}       The note itself.  NOT deprecated
112
113  $flags->{ ODUES }                  Set if patron has overdue books.
114  $flags->{ ODUES }->{message}       "Yes"  -- deprecated
115  $flags->{ ODUES }->{itemlist}      ref-to-array: list of overdue books
116  $flags->{ ODUES }->{itemlisttext}  Text list of overdue items -- deprecated
117
118  $flags->{WAITING}                  Set if any of patron's reserves are available
119  $flags->{WAITING}->{message}       Message -- deprecated
120  $flags->{WAITING}->{itemlist}      ref-to-array: list of available items
121
122 =over
123
124 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
125 overdue items. Its elements are references-to-hash, each describing an
126 overdue item. The keys are selected fields from the issues, biblio,
127 biblioitems, and items tables of the Koha database.
128
129 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
130 the overdue items, one per line.  Deprecated.
131
132 =item C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
133 available items. Each element is a reference-to-hash whose keys are
134 fields from the reserves table of the Koha database.
135
136 =back
137
138 All the "message" fields that include language generated in this function are deprecated,
139 because such strings belong properly in the display layer.
140
141 The "message" field that comes from the DB is OK.
142
143 =cut
144
145 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
146 # FIXME rename this function.
147 # DEPRECATED Do not use this subroutine!
148 sub patronflags {
149     my %flags;
150     my ( $patroninformation) = @_;
151     my $dbh=C4::Context->dbh;
152     my $patron = Koha::Patrons->find( $patroninformation->{borrowernumber} );
153     my $account = $patron->account;
154     my $owing = $account->non_issues_charges;
155     if ( $owing > 0 ) {
156         my %flaginfo;
157         my $noissuescharge = C4::Context->preference("noissuescharge") || 5;
158         $flaginfo{'message'} = sprintf 'Patron owes %.02f', $owing;
159         $flaginfo{'amount'}  = sprintf "%.02f", $owing;
160         if ( $owing > $noissuescharge && !C4::Context->preference("AllowFineOverride") ) {
161             $flaginfo{'noissues'} = 1;
162         }
163         $flags{'CHARGES'} = \%flaginfo;
164     }
165     elsif ( ( my $balance = $account->balance ) < 0 ) {
166         my %flaginfo;
167         $flaginfo{'message'} = sprintf 'Patron has credit of %.02f', -$balance;
168         $flaginfo{'amount'}  = sprintf "%.02f", $balance;
169         $flags{'CREDITS'} = \%flaginfo;
170     }
171
172     # Check the debt of the guarntees of this patron
173     my $no_issues_charge_guarantees = C4::Context->preference("NoIssuesChargeGuarantees");
174     $no_issues_charge_guarantees = undef unless looks_like_number( $no_issues_charge_guarantees );
175     if ( defined $no_issues_charge_guarantees ) {
176         my $p = Koha::Patrons->find( $patroninformation->{borrowernumber} );
177         my @guarantees = map { $_->guarantee } $p->guarantee_relationships;
178         my $guarantees_non_issues_charges = 0;
179         foreach my $g ( @guarantees ) {
180             $guarantees_non_issues_charges += $g->account->non_issues_charges;
181         }
182
183         if ( $guarantees_non_issues_charges > $no_issues_charge_guarantees ) {
184             my %flaginfo;
185             $flaginfo{'message'} = sprintf 'patron guarantees owe %.02f', $guarantees_non_issues_charges;
186             $flaginfo{'amount'}  = $guarantees_non_issues_charges;
187             $flaginfo{'noissues'} = 1 unless C4::Context->preference("allowfineoverride");
188             $flags{'CHARGES_GUARANTEES'} = \%flaginfo;
189         }
190     }
191
192     if (   $patroninformation->{'gonenoaddress'}
193         && $patroninformation->{'gonenoaddress'} == 1 )
194     {
195         my %flaginfo;
196         $flaginfo{'message'}  = 'Borrower has no valid address.';
197         $flaginfo{'noissues'} = 1;
198         $flags{'GNA'}         = \%flaginfo;
199     }
200     if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
201         my %flaginfo;
202         $flaginfo{'message'}  = 'Borrower\'s card reported lost.';
203         $flaginfo{'noissues'} = 1;
204         $flags{'LOST'}        = \%flaginfo;
205     }
206     if ( $patroninformation->{'debarred'} && check_date( split( /-/, $patroninformation->{'debarred'} ) ) ) {
207         if ( Date_to_Days(Date::Calc::Today) < Date_to_Days( split( /-/, $patroninformation->{'debarred'} ) ) ) {
208             my %flaginfo;
209             $flaginfo{'debarredcomment'} = $patroninformation->{'debarredcomment'};
210             $flaginfo{'message'}         = $patroninformation->{'debarredcomment'};
211             $flaginfo{'noissues'}        = 1;
212             $flaginfo{'dateend'}         = $patroninformation->{'debarred'};
213             $flags{'DBARRED'}           = \%flaginfo;
214         }
215     }
216     if (   $patroninformation->{'borrowernotes'}
217         && $patroninformation->{'borrowernotes'} )
218     {
219         my %flaginfo;
220         $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
221         $flags{'NOTES'}      = \%flaginfo;
222     }
223     my ( $odues, $itemsoverdue ) = C4::Overdues::checkoverdues($patroninformation->{'borrowernumber'});
224     if ( $odues && $odues > 0 ) {
225         my %flaginfo;
226         $flaginfo{'message'}  = "Yes";
227         $flaginfo{'itemlist'} = $itemsoverdue;
228         foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
229             @$itemsoverdue )
230         {
231             $flaginfo{'itemlisttext'} .=
232               "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n";  # newline is display layer
233         }
234         $flags{'ODUES'} = \%flaginfo;
235     }
236
237     my $waiting_holds = $patron->holds->search({ found => 'W' });
238     my $nowaiting = $waiting_holds->count;
239     if ( $nowaiting > 0 ) {
240         my %flaginfo;
241         $flaginfo{'message'}  = "Reserved items available";
242         $flaginfo{'itemlist'} = $waiting_holds->unblessed;
243         $flags{'WAITING'}     = \%flaginfo;
244     }
245     return ( \%flags );
246 }
247
248 =head2 GetAllIssues
249
250   $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
251
252 Looks up what the patron with the given borrowernumber has borrowed,
253 and sorts the results.
254
255 C<$sortkey> is the name of a field on which to sort the results. This
256 should be the name of a field in the C<issues>, C<biblio>,
257 C<biblioitems>, or C<items> table in the Koha database.
258
259 C<$limit> is the maximum number of results to return.
260
261 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
262 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
263 C<items> tables of the Koha database.
264
265 =cut
266
267 #'
268 sub GetAllIssues {
269     my ( $borrowernumber, $order, $limit ) = @_;
270
271     return unless $borrowernumber;
272     $order = 'date_due desc' unless $order;
273
274     my $dbh = C4::Context->dbh;
275     my $query =
276 'SELECT issues.*, items.*, biblio.*, biblioitems.*, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp,borrowers.firstname,borrowers.surname
277   FROM issues
278   LEFT JOIN items on items.itemnumber=issues.itemnumber
279   LEFT JOIN borrowers on borrowers.borrowernumber=issues.issuer_id
280   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
281   LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
282   WHERE issues.borrowernumber=?
283   UNION ALL
284   SELECT old_issues.*, items.*, biblio.*, biblioitems.*, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp,borrowers.firstname,borrowers.surname
285   FROM old_issues
286   LEFT JOIN items on items.itemnumber=old_issues.itemnumber
287   LEFT JOIN borrowers on borrowers.borrowernumber=old_issues.issuer_id
288   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
289   LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
290   WHERE old_issues.borrowernumber=? AND old_issues.itemnumber IS NOT NULL
291   order by ' . $order;
292     if ($limit) {
293         $query .= " limit $limit";
294     }
295
296     my $sth = $dbh->prepare($query);
297     $sth->execute( $borrowernumber, $borrowernumber );
298     return $sth->fetchall_arrayref( {} );
299 }
300
301 sub checkcardnumber {
302     my ( $cardnumber, $borrowernumber ) = @_;
303
304     # If cardnumber is null, we assume they're allowed.
305     return 0 unless defined $cardnumber;
306
307     my $dbh = C4::Context->dbh;
308     my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
309     $query .= " AND borrowernumber <> ?" if ($borrowernumber);
310     my $sth = $dbh->prepare($query);
311     $sth->execute(
312         $cardnumber,
313         ( $borrowernumber ? $borrowernumber : () )
314     );
315
316     return 1 if $sth->fetchrow_hashref;
317
318     my ( $min_length, $max_length ) = get_cardnumber_length();
319     return 2
320         if length $cardnumber > $max_length
321         or length $cardnumber < $min_length;
322
323     return 0;
324 }
325
326 =head2 get_cardnumber_length
327
328     my ($min, $max) = C4::Members::get_cardnumber_length()
329
330 Returns the minimum and maximum length for patron cardnumbers as
331 determined by the CardnumberLength system preference, the
332 BorrowerMandatoryField system preference, and the width of the
333 database column.
334
335 =cut
336
337 sub get_cardnumber_length {
338     my $borrower = Koha::Database->new->schema->resultset('Borrower');
339     my $field_size = $borrower->result_source->column_info('cardnumber')->{size};
340     my ( $min, $max ) = ( 0, $field_size ); # borrowers.cardnumber is a nullable varchar(20)
341     $min = 1 if C4::Context->preference('BorrowerMandatoryField') =~ /cardnumber/;
342     if ( my $cardnumber_length = C4::Context->preference('CardnumberLength') ) {
343         # Is integer and length match
344         if ( $cardnumber_length =~ m|^\d+$| ) {
345             $min = $max = $cardnumber_length
346                 if $cardnumber_length >= $min
347                     and $cardnumber_length <= $max;
348         }
349         # Else assuming it is a range
350         elsif ( $cardnumber_length =~ m|(\d*),(\d*)| ) {
351             $min = $1 if $1 and $min < $1;
352             $max = $2 if $2 and $max > $2;
353         }
354
355     }
356     $min = $max if $min > $max;
357     return ( $min, $max );
358 }
359
360 =head2 GetBorrowersToExpunge
361
362   $borrowers = &GetBorrowersToExpunge(
363       not_borrowed_since => $not_borrowed_since,
364       expired_before       => $expired_before,
365       category_code        => \@category_code,
366       patron_list_id       => $patron_list_id,
367       branchcode           => $branchcode
368   );
369
370   This function get all borrowers based on the given criteria.
371
372 =cut
373
374 sub GetBorrowersToExpunge {
375
376     my $params = shift;
377     my $filterdate       = $params->{'not_borrowed_since'};
378     my $filterexpiry     = $params->{'expired_before'};
379     my $filterlastseen   = $params->{'last_seen'};
380     my $filtercategory   = $params->{'category_code'};
381     my $filterbranch     = $params->{'branchcode'} ||
382                         ((C4::Context->preference('IndependentBranches')
383                              && C4::Context->userenv
384                              && !C4::Context->IsSuperLibrarian()
385                              && C4::Context->userenv->{branch})
386                          ? C4::Context->userenv->{branch}
387                          : "");
388     my $filterpatronlist = $params->{'patron_list_id'};
389
390     my $dbh   = C4::Context->dbh;
391     my $query = q|
392         SELECT *
393         FROM (
394             SELECT borrowers.borrowernumber,
395                    MAX(old_issues.timestamp) AS latestissue,
396                    MAX(issues.timestamp) AS currentissue
397             FROM   borrowers
398             JOIN   categories USING (categorycode)
399             LEFT JOIN (
400                 SELECT guarantor_id
401                 FROM borrower_relationships
402                 WHERE guarantor_id IS NOT NULL
403                     AND guarantor_id <> 0
404             ) as tmp ON borrowers.borrowernumber=tmp.guarantor_id
405             LEFT JOIN old_issues USING (borrowernumber)
406             LEFT JOIN issues USING (borrowernumber)|;
407     if ( $filterpatronlist  ){
408         $query .= q| LEFT JOIN patron_list_patrons USING (borrowernumber)|;
409     }
410     $query .= q| WHERE  category_type <> 'S'
411         AND ( borrowers.flags IS NULL OR borrowers.flags = 0 )
412         AND tmp.guarantor_id IS NULL
413     |;
414     my @query_params;
415     if ( $filterbranch && $filterbranch ne "" ) {
416         $query.= " AND borrowers.branchcode = ? ";
417         push( @query_params, $filterbranch );
418     }
419     if ( $filterexpiry ) {
420         $query .= " AND dateexpiry < ? ";
421         push( @query_params, $filterexpiry );
422     }
423     if ( $filterlastseen ) {
424         $query .= ' AND lastseen < ? ';
425         push @query_params, $filterlastseen;
426     }
427     if ( $filtercategory ) {
428         if (ref($filtercategory) ne 'ARRAY' ) {
429             $filtercategory = [ $filtercategory ];
430         }
431         if ( @$filtercategory ) {
432             $query .= " AND categorycode IN (" . join(',', ('?') x @$filtercategory) . ") ";
433             push( @query_params, @$filtercategory );
434         }
435     }
436     if ( $filterpatronlist ){
437         $query.=" AND patron_list_id = ? ";
438         push( @query_params, $filterpatronlist );
439     }
440     $query .= " GROUP BY borrowers.borrowernumber";
441     $query .= q|
442         ) xxx WHERE currentissue IS NULL|;
443     if ( $filterdate ) {
444         $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
445         push @query_params,$filterdate;
446     }
447
448     if ( my $anonymous_patron = C4::Context->preference("AnonymousPatron") ) {
449         $query .= q{ AND borrowernumber != ? };
450         push( @query_params, $anonymous_patron );
451     }
452
453     warn $query if $debug;
454
455     my $sth = $dbh->prepare($query);
456     if (scalar(@query_params)>0){
457         $sth->execute(@query_params);
458     }
459     else {
460         $sth->execute;
461     }
462
463     my @results;
464     while ( my $data = $sth->fetchrow_hashref ) {
465         push @results, $data;
466     }
467     return \@results;
468 }
469
470 =head2 IssueSlip
471
472   IssueSlip($branchcode, $borrowernumber, $quickslip)
473
474   Returns letter hash ( see C4::Letters::GetPreparedLetter )
475
476   $quickslip is boolean, to indicate whether we want a quick slip
477
478   IssueSlip populates ISSUESLIP and ISSUEQSLIP, and will make the following expansions:
479
480   Both slips:
481
482       <<branches.*>>
483       <<borrowers.*>>
484
485   ISSUESLIP:
486
487       <checkedout>
488          <<biblio.*>>
489          <<items.*>>
490          <<biblioitems.*>>
491          <<issues.*>>
492       </checkedout>
493
494       <overdue>
495          <<biblio.*>>
496          <<items.*>>
497          <<biblioitems.*>>
498          <<issues.*>>
499       </overdue>
500
501       <news>
502          <<opac_news.*>>
503       </news>
504
505   ISSUEQSLIP:
506
507       <checkedout>
508          <<biblio.*>>
509          <<items.*>>
510          <<biblioitems.*>>
511          <<issues.*>>
512       </checkedout>
513
514   NOTE: Fields from tables issues, items, biblio and biblioitems are available
515
516 =cut
517
518 sub IssueSlip {
519     my ($branch, $borrowernumber, $quickslip) = @_;
520
521     # FIXME Check callers before removing this statement
522     #return unless $borrowernumber;
523
524     my $patron = Koha::Patrons->find( $borrowernumber );
525     return unless $patron;
526
527     my $pending_checkouts = $patron->pending_checkouts; # Should be $patron->checkouts->pending?
528
529     my ($letter_code, %repeat, %loops);
530     if ( $quickslip ) {
531         my $today_start = dt_from_string->set( hour => 0, minute => 0, second => 0 );
532         my $today_end = dt_from_string->set( hour => 23, minute => 59, second => 0 );
533         $today_start = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_start );
534         $today_end = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_end );
535         $letter_code = 'ISSUEQSLIP';
536
537         # issue date or lastreneweddate is today
538         my $todays_checkouts = $pending_checkouts->search(
539             {
540                 -or => {
541                     issuedate => {
542                         '>=' => $today_start,
543                         '<=' => $today_end,
544                     },
545                     lastreneweddate =>
546                       { '>=' => $today_start, '<=' => $today_end, }
547                 }
548             }
549         );
550         my @checkouts;
551         while ( my $c = $todays_checkouts->next ) {
552             my $all = $c->unblessed_all_relateds;
553             push @checkouts, {
554                 biblio      => $all,
555                 items       => $all,
556                 biblioitems => $all,
557                 issues      => $all,
558             };
559         }
560
561         %repeat =  (
562             checkedout => \@checkouts, # Historical syntax
563         );
564         %loops = (
565             issues => [ map { $_->{issues}{itemnumber} } @checkouts ], # TT syntax
566         );
567     }
568     else {
569         my $today = Koha::Database->new->schema->storage->datetime_parser->format_datetime( dt_from_string );
570         # Checkouts due in the future
571         my $checkouts = $pending_checkouts->search({ date_due => { '>' => $today } });
572         my @checkouts; my @overdues;
573         while ( my $c = $checkouts->next ) {
574             my $all = $c->unblessed_all_relateds;
575             push @checkouts, {
576                 biblio      => $all,
577                 items       => $all,
578                 biblioitems => $all,
579                 issues      => $all,
580             };
581         }
582
583         # Checkouts due in the past are overdues
584         my $overdues = $pending_checkouts->search({ date_due => { '<=' => $today } });
585         while ( my $o = $overdues->next ) {
586             my $all = $o->unblessed_all_relateds;
587             push @overdues, {
588                 biblio      => $all,
589                 items       => $all,
590                 biblioitems => $all,
591                 issues      => $all,
592             };
593         }
594         my $news = GetNewsToDisplay( "slip", $branch );
595         my @news = map {
596             $_->{'timestamp'} = $_->{'newdate'};
597             { opac_news => $_ }
598         } @$news;
599         $letter_code = 'ISSUESLIP';
600         %repeat      = (
601             checkedout => \@checkouts,
602             overdue    => \@overdues,
603             news       => \@news,
604         );
605         %loops = (
606             issues => [ map { $_->{issues}{itemnumber} } @checkouts ],
607             overdues   => [ map { $_->{issues}{itemnumber} } @overdues ],
608             opac_news => [ map { $_->{opac_news}{idnew} } @news ],
609         );
610     }
611
612     return  C4::Letters::GetPreparedLetter (
613         module => 'circulation',
614         letter_code => $letter_code,
615         branchcode => $branch,
616         lang => $patron->lang,
617         tables => {
618             'branches'    => $branch,
619             'borrowers'   => $borrowernumber,
620         },
621         repeat => \%repeat,
622         loops => \%loops,
623     );
624 }
625
626 =head2 DeleteExpiredOpacRegistrations
627
628     Delete accounts that haven't been upgraded from the 'temporary' category
629     Returns the number of removed patrons
630
631 =cut
632
633 sub DeleteExpiredOpacRegistrations {
634
635     my $delay = C4::Context->preference('PatronSelfRegistrationExpireTemporaryAccountsDelay');
636     my $category_code = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
637
638     return 0 if not $category_code or not defined $delay or $delay eq q||;
639     my $date_enrolled = dt_from_string();
640     $date_enrolled->subtract( days => $delay );
641
642     my $registrations_to_del = Koha::Patrons->search({
643         dateenrolled => {'<=' => $date_enrolled->ymd},
644         categorycode => $category_code,
645     });
646
647     my $cnt=0;
648     while ( my $registration = $registrations_to_del->next() ) {
649         next if $registration->checkouts->count || $registration->account->balance;
650         $registration->delete;
651         $cnt++;
652     }
653     return $cnt;
654 }
655
656 =head2 DeleteUnverifiedOpacRegistrations
657
658     Delete all unverified self registrations in borrower_modifications,
659     older than the specified number of days.
660
661 =cut
662
663 sub DeleteUnverifiedOpacRegistrations {
664     my ( $days ) = @_;
665     my $dbh = C4::Context->dbh;
666     my $sql=qq|
667 DELETE FROM borrower_modifications
668 WHERE borrowernumber = 0 AND DATEDIFF( NOW(), timestamp ) > ?|;
669     my $cnt=$dbh->do($sql, undef, ($days) );
670     return $cnt eq '0E0'? 0: $cnt;
671 }
672
673 END { }    # module clean-up code here (global destructor)
674
675 1;
676
677 __END__
678
679 =head1 AUTHOR
680
681 Koha Team
682
683 =cut