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;
 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.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
 277   FROM issues
 278   LEFT JOIN items on items.itemnumber=issues.itemnumber
 279   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
 280   LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
 281   WHERE borrowernumber=?
 282   UNION ALL
 283   SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
 284   FROM old_issues
 285   LEFT JOIN items on items.itemnumber=old_issues.itemnumber
 286   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
 287   LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
 288   WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL
 289   order by ' . $order;
 290     if ($limit) {
 291         $query .= " limit $limit";
 292     }
 293
 294     my $sth = $dbh->prepare($query);
 295     $sth->execute( $borrowernumber, $borrowernumber );
 296     return $sth->fetchall_arrayref( {} );
 297 }
 298
 299 sub checkcardnumber {
 300     my ( $cardnumber, $borrowernumber ) = @_;
 301
 302     # If cardnumber is null, we assume they're allowed.
 303     return 0 unless defined $cardnumber;
 304
 305     my $dbh = C4::Context->dbh;
 306     my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
 307     $query .= " AND borrowernumber <> ?" if ($borrowernumber);
 308     my $sth = $dbh->prepare($query);
 309     $sth->execute(
 310         $cardnumber,
 311         ( $borrowernumber ? $borrowernumber : () )
 312     );
 313
 314     return 1 if $sth->fetchrow_hashref;
 315
 316     my ( $min_length, $max_length ) = get_cardnumber_length();
 317     return 2
 318         if length $cardnumber > $max_length
 319         or length $cardnumber < $min_length;
 320
 321     return 0;
 322 }
 323
 324 =head2 get_cardnumber_length
 325
 326     my ($min, $max) = C4::Members::get_cardnumber_length()
 327
 328 Returns the minimum and maximum length for patron cardnumbers as
 329 determined by the CardnumberLength system preference, the
 330 BorrowerMandatoryField system preference, and the width of the
 331 database column.
 332
 333 =cut
 334
 335 sub get_cardnumber_length {
 336     my $borrower = Koha::Database->new->schema->resultset('Borrower');
 337     my $field_size = $borrower->result_source->column_info('cardnumber')->{size};
 338     my ( $min, $max ) = ( 0, $field_size ); # borrowers.cardnumber is a nullable varchar(20)
 339     $min = 1 if C4::Context->preference('BorrowerMandatoryField') =~ /cardnumber/;
 340     if ( my $cardnumber_length = C4::Context->preference('CardnumberLength') ) {
 341         # Is integer and length match
 342         if ( $cardnumber_length =~ m|^\d+$| ) {
 343             $min = $max = $cardnumber_length
 344                 if $cardnumber_length >= $min
 345                     and $cardnumber_length <= $max;
 346         }
 347         # Else assuming it is a range
 348         elsif ( $cardnumber_length =~ m|(\d*),(\d*)| ) {
 349             $min = $1 if $1 and $min < $1;
 350             $max = $2 if $2 and $max > $2;
 351         }
 352
 353     }
 354     $min = $max if $min > $max;
 355     return ( $min, $max );
 356 }
 357
 358 =head2 GetBorrowersToExpunge
 359
 360   $borrowers = &GetBorrowersToExpunge(
 361       not_borrowed_since => $not_borrowed_since,
 362       expired_before       => $expired_before,
 363       category_code        => $category_code,
 364       patron_list_id       => $patron_list_id,
 365       branchcode           => $branchcode
 366   );
 367
 368   This function get all borrowers based on the given criteria.
 369
 370 =cut
 371
 372 sub GetBorrowersToExpunge {
 373
 374     my $params = shift;
 375     my $filterdate       = $params->{'not_borrowed_since'};
 376     my $filterexpiry     = $params->{'expired_before'};
 377     my $filterlastseen   = $params->{'last_seen'};
 378     my $filtercategory   = $params->{'category_code'};
 379     my $filterbranch     = $params->{'branchcode'} ||
 380                         ((C4::Context->preference('IndependentBranches')
 381                              && C4::Context->userenv
 382                              && !C4::Context->IsSuperLibrarian()
 383                              && C4::Context->userenv->{branch})
 384                          ? C4::Context->userenv->{branch}
 385                          : "");
 386     my $filterpatronlist = $params->{'patron_list_id'};
 387
 388     my $dbh   = C4::Context->dbh;
 389     my $query = q|
 390         SELECT *
 391         FROM (
 392             SELECT borrowers.borrowernumber,
 393                    MAX(old_issues.timestamp) AS latestissue,
 394                    MAX(issues.timestamp) AS currentissue
 395             FROM   borrowers
 396             JOIN   categories USING (categorycode)
 397             LEFT JOIN (
 398                 SELECT guarantor_id
 399                 FROM borrower_relationships
 400                 WHERE guarantor_id IS NOT NULL
 401                     AND guarantor_id <> 0
 402             ) as tmp ON borrowers.borrowernumber=tmp.guarantor_id
 403             LEFT JOIN old_issues USING (borrowernumber)
 404             LEFT JOIN issues USING (borrowernumber)|;
 405     if ( $filterpatronlist  ){
 406         $query .= q| LEFT JOIN patron_list_patrons USING (borrowernumber)|;
 407     }
 408     $query .= q| WHERE  category_type <> 'S'
 409         AND tmp.guarantor_id IS NULL
 410     |;
 411     my @query_params;
 412     if ( $filterbranch && $filterbranch ne "" ) {
 413         $query.= " AND borrowers.branchcode = ? ";
 414         push( @query_params, $filterbranch );
 415     }
 416     if ( $filterexpiry ) {
 417         $query .= " AND dateexpiry < ? ";
 418         push( @query_params, $filterexpiry );
 419     }
 420     if ( $filterlastseen ) {
 421         $query .= ' AND lastseen < ? ';
 422         push @query_params, $filterlastseen;
 423     }
 424     if ( $filtercategory ) {
 425         $query .= " AND categorycode = ? ";
 426         push( @query_params, $filtercategory );
 427     }
 428     if ( $filterpatronlist ){
 429         $query.=" AND patron_list_id = ? ";
 430         push( @query_params, $filterpatronlist );
 431     }
 432     $query .= " GROUP BY borrowers.borrowernumber";
 433     $query .= q|
 434         ) xxx WHERE currentissue IS NULL|;
 435     if ( $filterdate ) {
 436         $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
 437         push @query_params,$filterdate;
 438     }
 439
 440     warn $query if $debug;
 441
 442     my $sth = $dbh->prepare($query);
 443     if (scalar(@query_params)>0){
 444         $sth->execute(@query_params);
 445     }
 446     else {
 447         $sth->execute;
 448     }
 449
 450     my @results;
 451     while ( my $data = $sth->fetchrow_hashref ) {
 452         push @results, $data;
 453     }
 454     return \@results;
 455 }
 456
 457 =head2 IssueSlip
 458
 459   IssueSlip($branchcode, $borrowernumber, $quickslip)
 460
 461   Returns letter hash ( see C4::Letters::GetPreparedLetter )
 462
 463   $quickslip is boolean, to indicate whether we want a quick slip
 464
 465   IssueSlip populates ISSUESLIP and ISSUEQSLIP, and will make the following expansions:
 466
 467   Both slips:
 468
 469       <<branches.*>>
 470       <<borrowers.*>>
 471
 472   ISSUESLIP:
 473
 474       <checkedout>
 475          <<biblio.*>>
 476          <<items.*>>
 477          <<biblioitems.*>>
 478          <<issues.*>>
 479       </checkedout>
 480
 481       <overdue>
 482          <<biblio.*>>
 483          <<items.*>>
 484          <<biblioitems.*>>
 485          <<issues.*>>
 486       </overdue>
 487
 488       <news>
 489          <<opac_news.*>>
 490       </news>
 491
 492   ISSUEQSLIP:
 493
 494       <checkedout>
 495          <<biblio.*>>
 496          <<items.*>>
 497          <<biblioitems.*>>
 498          <<issues.*>>
 499       </checkedout>
 500
 501   NOTE: Fields from tables issues, items, biblio and biblioitems are available
 502
 503 =cut
 504
 505 sub IssueSlip {
 506     my ($branch, $borrowernumber, $quickslip) = @_;
 507
 508     # FIXME Check callers before removing this statement
 509     #return unless $borrowernumber;
 510
 511     my $patron = Koha::Patrons->find( $borrowernumber );
 512     return unless $patron;
 513
 514     my $pending_checkouts = $patron->pending_checkouts; # Should be $patron->checkouts->pending?
 515
 516     my ($letter_code, %repeat, %loops);
 517     if ( $quickslip ) {
 518         my $today_start = dt_from_string->set( hour => 0, minute => 0, second => 0 );
 519         my $today_end = dt_from_string->set( hour => 23, minute => 59, second => 0 );
 520         $today_start = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_start );
 521         $today_end = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_end );
 522         $letter_code = 'ISSUEQSLIP';
 523
 524         # issue date or lastreneweddate is today
 525         my $todays_checkouts = $pending_checkouts->search(
 526             {
 527                 -or => {
 528                     issuedate => {
 529                         '>=' => $today_start,
 530                         '<=' => $today_end,
 531                     },
 532                     lastreneweddate =>
 533                       { '>=' => $today_start, '<=' => $today_end, }
 534                 }
 535             }
 536         );
 537         my @checkouts;
 538         while ( my $c = $todays_checkouts->next ) {
 539             my $all = $c->unblessed_all_relateds;
 540             push @checkouts, {
 541                 biblio      => $all,
 542                 items       => $all,
 543                 biblioitems => $all,
 544                 issues      => $all,
 545             };
 546         }
 547
 548         %repeat =  (
 549             checkedout => \@checkouts, # Historical syntax
 550         );
 551         %loops = (
 552             issues => [ map { $_->{issues}{itemnumber} } @checkouts ], # TT syntax
 553         );
 554     }
 555     else {
 556         my $today = Koha::Database->new->schema->storage->datetime_parser->format_datetime( dt_from_string );
 557         # Checkouts due in the future
 558         my $checkouts = $pending_checkouts->search({ date_due => { '>' => $today } });
 559         my @checkouts; my @overdues;
 560         while ( my $c = $checkouts->next ) {
 561             my $all = $c->unblessed_all_relateds;
 562             push @checkouts, {
 563                 biblio      => $all,
 564                 items       => $all,
 565                 biblioitems => $all,
 566                 issues      => $all,
 567             };
 568         }
 569
 570         # Checkouts due in the past are overdues
 571         my $overdues = $pending_checkouts->search({ date_due => { '<=' => $today } });
 572         while ( my $o = $overdues->next ) {
 573             my $all = $o->unblessed_all_relateds;
 574             push @overdues, {
 575                 biblio      => $all,
 576                 items       => $all,
 577                 biblioitems => $all,
 578                 issues      => $all,
 579             };
 580         }
 581         my $news = GetNewsToDisplay( "slip", $branch );
 582         my @news = map {
 583             $_->{'timestamp'} = $_->{'newdate'};
 584             { opac_news => $_ }
 585         } @$news;
 586         $letter_code = 'ISSUESLIP';
 587         %repeat      = (
 588             checkedout => \@checkouts,
 589             overdue    => \@overdues,
 590             news       => \@news,
 591         );
 592         %loops = (
 593             issues => [ map { $_->{issues}{itemnumber} } @checkouts ],
 594             overdues   => [ map { $_->{issues}{itemnumber} } @overdues ],
 595             opac_news => [ map { $_->{opac_news}{idnew} } @news ],
 596         );
 597     }
 598
 599     return  C4::Letters::GetPreparedLetter (
 600         module => 'circulation',
 601         letter_code => $letter_code,
 602         branchcode => $branch,
 603         lang => $patron->lang,
 604         tables => {
 605             'branches'    => $branch,
 606             'borrowers'   => $borrowernumber,
 607         },
 608         repeat => \%repeat,
 609         loops => \%loops,
 610     );
 611 }
 612
 613 =head2 DeleteExpiredOpacRegistrations
 614
 615     Delete accounts that haven't been upgraded from the 'temporary' category
 616     Returns the number of removed patrons
 617
 618 =cut
 619
 620 sub DeleteExpiredOpacRegistrations {
 621
 622     my $delay = C4::Context->preference('PatronSelfRegistrationExpireTemporaryAccountsDelay');
 623     my $category_code = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
 624
 625     return 0 if not $category_code or not defined $delay or $delay eq q||;
 626     my $date_enrolled = dt_from_string();
 627     $date_enrolled->subtract( days => $delay );
 628
 629     my $registrations_to_del = Koha::Patrons->search({
 630         dateenrolled => {'<=' => $date_enrolled->ymd},
 631         categorycode => $category_code,
 632     });
 633
 634     my $cnt=0;
 635     while ( my $registration = $registrations_to_del->next() ) {
 636         next if $registration->checkouts->count || $registration->account->balance;
 637         $registration->delete;
 638         $cnt++;
 639     }
 640     return $cnt;
 641 }
 642
 643 =head2 DeleteUnverifiedOpacRegistrations
 644
 645     Delete all unverified self registrations in borrower_modifications,
 646     older than the specified number of days.
 647
 648 =cut
 649
 650 sub DeleteUnverifiedOpacRegistrations {
 651     my ( $days ) = @_;
 652     my $dbh = C4::Context->dbh;
 653     my $sql=qq|
 654 DELETE FROM borrower_modifications
 655 WHERE borrowernumber = 0 AND DATEDIFF( NOW(), timestamp ) > ?|;
 656     my $cnt=$dbh->do($sql, undef, ($days) );
 657     return $cnt eq '0E0'? 0: $cnt;
 658 }
 659
 660 END { }    # module clean-up code here (global destructor)
 661
 662 1;
 663
 664 __END__
 665
 666 =head1 AUTHOR
 667
 668 Koha Team
 669
 670 =cut