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