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