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