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