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