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