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