C4/Members.pm

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