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