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     if ( my $anonymous_patron = C4::Context->preference("AnonymousPatron") ) {
 441         $query .= q{ AND borrowernumber != ? };
 442         push( @query_params, $anonymous_patron );
 443     }
 444
 445     warn $query if $debug;
 446
 447     my $sth = $dbh->prepare($query);
 448     if (scalar(@query_params)>0){
 449         $sth->execute(@query_params);
 450     }
 451     else {
 452         $sth->execute;
 453     }
 454
 455     my @results;
 456     while ( my $data = $sth->fetchrow_hashref ) {
 457         push @results, $data;
 458     }
 459     return \@results;
 460 }
 461
 462 =head2 IssueSlip
 463
 464   IssueSlip($branchcode, $borrowernumber, $quickslip)
 465
 466   Returns letter hash ( see C4::Letters::GetPreparedLetter )
 467
 468   $quickslip is boolean, to indicate whether we want a quick slip
 469
 470   IssueSlip populates ISSUESLIP and ISSUEQSLIP, and will make the following expansions:
 471
 472   Both slips:
 473
 474       <<branches.*>>
 475       <<borrowers.*>>
 476
 477   ISSUESLIP:
 478
 479       <checkedout>
 480          <<biblio.*>>
 481          <<items.*>>
 482          <<biblioitems.*>>
 483          <<issues.*>>
 484       </checkedout>
 485
 486       <overdue>
 487          <<biblio.*>>
 488          <<items.*>>
 489          <<biblioitems.*>>
 490          <<issues.*>>
 491       </overdue>
 492
 493       <news>
 494          <<opac_news.*>>
 495       </news>
 496
 497   ISSUEQSLIP:
 498
 499       <checkedout>
 500          <<biblio.*>>
 501          <<items.*>>
 502          <<biblioitems.*>>
 503          <<issues.*>>
 504       </checkedout>
 505
 506   NOTE: Fields from tables issues, items, biblio and biblioitems are available
 507
 508 =cut
 509
 510 sub IssueSlip {
 511     my ($branch, $borrowernumber, $quickslip) = @_;
 512
 513     # FIXME Check callers before removing this statement
 514     #return unless $borrowernumber;
 515
 516     my $patron = Koha::Patrons->find( $borrowernumber );
 517     return unless $patron;
 518
 519     my $pending_checkouts = $patron->pending_checkouts; # Should be $patron->checkouts->pending?
 520
 521     my ($letter_code, %repeat, %loops);
 522     if ( $quickslip ) {
 523         my $today_start = dt_from_string->set( hour => 0, minute => 0, second => 0 );
 524         my $today_end = dt_from_string->set( hour => 23, minute => 59, second => 0 );
 525         $today_start = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_start );
 526         $today_end = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_end );
 527         $letter_code = 'ISSUEQSLIP';
 528
 529         # issue date or lastreneweddate is today
 530         my $todays_checkouts = $pending_checkouts->search(
 531             {
 532                 -or => {
 533                     issuedate => {
 534                         '>=' => $today_start,
 535                         '<=' => $today_end,
 536                     },
 537                     lastreneweddate =>
 538                       { '>=' => $today_start, '<=' => $today_end, }
 539                 }
 540             }
 541         );
 542         my @checkouts;
 543         while ( my $c = $todays_checkouts->next ) {
 544             my $all = $c->unblessed_all_relateds;
 545             push @checkouts, {
 546                 biblio      => $all,
 547                 items       => $all,
 548                 biblioitems => $all,
 549                 issues      => $all,
 550             };
 551         }
 552
 553         %repeat =  (
 554             checkedout => \@checkouts, # Historical syntax
 555         );
 556         %loops = (
 557             issues => [ map { $_->{issues}{itemnumber} } @checkouts ], # TT syntax
 558         );
 559     }
 560     else {
 561         my $today = Koha::Database->new->schema->storage->datetime_parser->format_datetime( dt_from_string );
 562         # Checkouts due in the future
 563         my $checkouts = $pending_checkouts->search({ date_due => { '>' => $today } });
 564         my @checkouts; my @overdues;
 565         while ( my $c = $checkouts->next ) {
 566             my $all = $c->unblessed_all_relateds;
 567             push @checkouts, {
 568                 biblio      => $all,
 569                 items       => $all,
 570                 biblioitems => $all,
 571                 issues      => $all,
 572             };
 573         }
 574
 575         # Checkouts due in the past are overdues
 576         my $overdues = $pending_checkouts->search({ date_due => { '<=' => $today } });
 577         while ( my $o = $overdues->next ) {
 578             my $all = $o->unblessed_all_relateds;
 579             push @overdues, {
 580                 biblio      => $all,
 581                 items       => $all,
 582                 biblioitems => $all,
 583                 issues      => $all,
 584             };
 585         }
 586         my $news = GetNewsToDisplay( "slip", $branch );
 587         my @news = map {
 588             $_->{'timestamp'} = $_->{'newdate'};
 589             { opac_news => $_ }
 590         } @$news;
 591         $letter_code = 'ISSUESLIP';
 592         %repeat      = (
 593             checkedout => \@checkouts,
 594             overdue    => \@overdues,
 595             news       => \@news,
 596         );
 597         %loops = (
 598             issues => [ map { $_->{issues}{itemnumber} } @checkouts ],
 599             overdues   => [ map { $_->{issues}{itemnumber} } @overdues ],
 600             opac_news => [ map { $_->{opac_news}{idnew} } @news ],
 601         );
 602     }
 603
 604     return  C4::Letters::GetPreparedLetter (
 605         module => 'circulation',
 606         letter_code => $letter_code,
 607         branchcode => $branch,
 608         lang => $patron->lang,
 609         tables => {
 610             'branches'    => $branch,
 611             'borrowers'   => $borrowernumber,
 612         },
 613         repeat => \%repeat,
 614         loops => \%loops,
 615     );
 616 }
 617
 618 =head2 DeleteExpiredOpacRegistrations
 619
 620     Delete accounts that haven't been upgraded from the 'temporary' category
 621     Returns the number of removed patrons
 622
 623 =cut
 624
 625 sub DeleteExpiredOpacRegistrations {
 626
 627     my $delay = C4::Context->preference('PatronSelfRegistrationExpireTemporaryAccountsDelay');
 628     my $category_code = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
 629
 630     return 0 if not $category_code or not defined $delay or $delay eq q||;
 631     my $date_enrolled = dt_from_string();
 632     $date_enrolled->subtract( days => $delay );
 633
 634     my $registrations_to_del = Koha::Patrons->search({
 635         dateenrolled => {'<=' => $date_enrolled->ymd},
 636         categorycode => $category_code,
 637     });
 638
 639     my $cnt=0;
 640     while ( my $registration = $registrations_to_del->next() ) {
 641         next if $registration->checkouts->count || $registration->account->balance;
 642         $registration->delete;
 643         $cnt++;
 644     }
 645     return $cnt;
 646 }
 647
 648 =head2 DeleteUnverifiedOpacRegistrations
 649
 650     Delete all unverified self registrations in borrower_modifications,
 651     older than the specified number of days.
 652
 653 =cut
 654
 655 sub DeleteUnverifiedOpacRegistrations {
 656     my ( $days ) = @_;
 657     my $dbh = C4::Context->dbh;
 658     my $sql=qq|
 659 DELETE FROM borrower_modifications
 660 WHERE borrowernumber = 0 AND DATEDIFF( NOW(), timestamp ) > ?|;
 661     my $cnt=$dbh->do($sql, undef, ($days) );
 662     return $cnt eq '0E0'? 0: $cnt;
 663 }
 664
 665 END { }    # module clean-up code here (global destructor)
 666
 667 1;
 668
 669 __END__
 670
 671 =head1 AUTHOR
 672
 673 Koha Team
 674
 675 =cut