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 C4::Log; # logaction
  30 use C4::Overdues;
  31 use C4::Reserves;
  32 use C4::Accounts;
  33 use C4::Biblio;
  34 use C4::Letters;
  35 use C4::Members::Attributes qw(SearchIdMatchingAttribute UpdateBorrowerAttribute);
  36 use C4::NewsChannels; #get slip news
  37 use DateTime;
  38 use Koha::Database;
  39 use Koha::DateUtils;
  40 use Text::Unaccent qw( unac_string );
  41 use Koha::AuthUtils qw(hash_password);
  42 use Koha::Database;
  43 use Koha::Holds;
  44 use Koha::List::Patron;
  45 use Koha::Patrons;
  46 use Koha::Patron::Categories;
  47 use Koha::Schema;
  48
  49 our (@ISA,@EXPORT,@EXPORT_OK,$debug);
  50
  51 use Module::Load::Conditional qw( can_load );
  52 if ( ! can_load( modules => { 'Koha::NorwegianPatronDB' => undef } ) ) {
  53    $debug && warn "Unable to load Koha::NorwegianPatronDB";
  54 }
  55
  56
  57 BEGIN {
  58     $debug = $ENV{DEBUG} || 0;
  59     require Exporter;
  60     @ISA = qw(Exporter);
  61     #Get data
  62     push @EXPORT, qw(
  63         &GetMemberDetails
  64         &GetMember
  65
  66         &GetMemberIssuesAndFines
  67         &GetPendingIssues
  68         &GetAllIssues
  69
  70         &GetFirstValidEmailAddress
  71         &GetNoticeEmailAddress
  72
  73         &GetMemberAccountRecords
  74         &GetBorNotifyAcctRecord
  75
  76         &GetBorrowersToExpunge
  77         &GetBorrowersWhoHaveNeverBorrowed
  78         &GetBorrowersWithIssuesHistoryOlderThan
  79
  80         &GetUpcomingMembershipExpires
  81
  82         &IssueSlip
  83         GetBorrowersWithEmail
  84
  85         GetOverduesForPatron
  86     );
  87
  88     #Modify data
  89     push @EXPORT, qw(
  90         &ModMember
  91         &changepassword
  92     );
  93
  94     #Insert data
  95     push @EXPORT, qw(
  96         &AddMember
  97         &AddMember_Opac
  98     );
  99
 100     #Check data
 101     push @EXPORT, qw(
 102         &checkuniquemember
 103         &checkuserpassword
 104         &Check_Userid
 105         &Generate_Userid
 106         &fixup_cardnumber
 107         &checkcardnumber
 108     );
 109 }
 110
 111 =head1 NAME
 112
 113 C4::Members - Perl Module containing convenience functions for member handling
 114
 115 =head1 SYNOPSIS
 116
 117 use C4::Members;
 118
 119 =head1 DESCRIPTION
 120
 121 This module contains routines for adding, modifying and deleting members/patrons/borrowers
 122
 123 =head1 FUNCTIONS
 124
 125 =head2 GetMemberDetails
 126
 127 ($borrower) = &GetMemberDetails($borrowernumber, $cardnumber);
 128
 129 Looks up a patron and returns information about him or her. If
 130 C<$borrowernumber> is true (nonzero), C<&GetMemberDetails> looks
 131 up the borrower by number; otherwise, it looks up the borrower by card
 132 number.
 133
 134 C<$borrower> is a reference-to-hash whose keys are the fields of the
 135 borrowers table in the Koha database. In addition,
 136 C<$borrower-E<gt>{flags}> is a hash giving more detailed information
 137 about the patron. Its keys act as flags :
 138
 139     if $borrower->{flags}->{LOST} {
 140         # Patron's card was reported lost
 141     }
 142
 143 If the state of a flag means that the patron should not be
 144 allowed to borrow any more books, then it will have a C<noissues> key
 145 with a true value.
 146
 147 See patronflags for more details.
 148
 149 =cut
 150
 151 sub GetMemberDetails {
 152     my ( $borrowernumber, $cardnumber ) = @_;
 153     my $dbh = C4::Context->dbh;
 154     my $query;
 155     my $sth;
 156     if ($borrowernumber) {
 157         $sth = $dbh->prepare("
 158             SELECT borrowers.*,
 159                    category_type,
 160                    categories.description,
 161                    reservefee,
 162                    enrolmentperiod
 163             FROM borrowers
 164             LEFT JOIN categories ON borrowers.categorycode=categories.categorycode
 165             WHERE borrowernumber = ?
 166         ");
 167         $sth->execute($borrowernumber);
 168     }
 169     elsif ($cardnumber) {
 170         $sth = $dbh->prepare("
 171             SELECT borrowers.*,
 172                    category_type,
 173                    categories.description,
 174                    reservefee,
 175                    enrolmentperiod
 176             FROM borrowers
 177             LEFT JOIN categories ON borrowers.categorycode = categories.categorycode
 178             WHERE cardnumber = ?
 179         ");
 180         $sth->execute($cardnumber);
 181     }
 182     else {
 183         return;
 184     }
 185     my $borrower = $sth->fetchrow_hashref;
 186     return unless $borrower;
 187     my ($amount) = GetMemberAccountRecords($borrower->{borrowernumber});
 188     $borrower->{'amountoutstanding'} = $amount;
 189     # FIXME - patronflags calls GetMemberAccountRecords... just have patronflags return $amount
 190     my $flags = patronflags( $borrower);
 191     $borrower->{'flags'}     = $flags;
 192
 193     $borrower->{'is_expired'} = 0;
 194     $borrower->{'is_expired'} = 1 if
 195       defined($borrower->{dateexpiry}) &&
 196       $borrower->{'dateexpiry'} ne '0000-00-00' &&
 197       Date_to_Days( Today() ) >
 198       Date_to_Days( split /-/, $borrower->{'dateexpiry'} );
 199
 200     return ($borrower);
 201 }
 202
 203 =head2 patronflags
 204
 205  $flags = &patronflags($patron);
 206
 207 This function is not exported.
 208
 209 The following will be set where applicable:
 210  $flags->{CHARGES}->{amount}        Amount of debt
 211  $flags->{CHARGES}->{noissues}      Set if debt amount >$5.00 (or syspref noissuescharge)
 212  $flags->{CHARGES}->{message}       Message -- deprecated
 213
 214  $flags->{CREDITS}->{amount}        Amount of credit
 215  $flags->{CREDITS}->{message}       Message -- deprecated
 216
 217  $flags->{  GNA  }                  Patron has no valid address
 218  $flags->{  GNA  }->{noissues}      Set for each GNA
 219  $flags->{  GNA  }->{message}       "Borrower has no valid address" -- deprecated
 220
 221  $flags->{ LOST  }                  Patron's card reported lost
 222  $flags->{ LOST  }->{noissues}      Set for each LOST
 223  $flags->{ LOST  }->{message}       Message -- deprecated
 224
 225  $flags->{DBARRED}                  Set if patron debarred, no access
 226  $flags->{DBARRED}->{noissues}      Set for each DBARRED
 227  $flags->{DBARRED}->{message}       Message -- deprecated
 228
 229  $flags->{ NOTES }
 230  $flags->{ NOTES }->{message}       The note itself.  NOT deprecated
 231
 232  $flags->{ ODUES }                  Set if patron has overdue books.
 233  $flags->{ ODUES }->{message}       "Yes"  -- deprecated
 234  $flags->{ ODUES }->{itemlist}      ref-to-array: list of overdue books
 235  $flags->{ ODUES }->{itemlisttext}  Text list of overdue items -- deprecated
 236
 237  $flags->{WAITING}                  Set if any of patron's reserves are available
 238  $flags->{WAITING}->{message}       Message -- deprecated
 239  $flags->{WAITING}->{itemlist}      ref-to-array: list of available items
 240
 241 =over
 242
 243 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
 244 overdue items. Its elements are references-to-hash, each describing an
 245 overdue item. The keys are selected fields from the issues, biblio,
 246 biblioitems, and items tables of the Koha database.
 247
 248 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
 249 the overdue items, one per line.  Deprecated.
 250
 251 =item C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
 252 available items. Each element is a reference-to-hash whose keys are
 253 fields from the reserves table of the Koha database.
 254
 255 =back
 256
 257 All the "message" fields that include language generated in this function are deprecated,
 258 because such strings belong properly in the display layer.
 259
 260 The "message" field that comes from the DB is OK.
 261
 262 =cut
 263
 264 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
 265 # FIXME rename this function.
 266 sub patronflags {
 267     my %flags;
 268     my ( $patroninformation) = @_;
 269     my $dbh=C4::Context->dbh;
 270     my ($balance, $owing) = GetMemberAccountBalance( $patroninformation->{'borrowernumber'});
 271     if ( $owing > 0 ) {
 272         my %flaginfo;
 273         my $noissuescharge = C4::Context->preference("noissuescharge") || 5;
 274         $flaginfo{'message'} = sprintf 'Patron owes %.02f', $owing;
 275         $flaginfo{'amount'}  = sprintf "%.02f", $owing;
 276         if ( $owing > $noissuescharge && !C4::Context->preference("AllowFineOverride") ) {
 277             $flaginfo{'noissues'} = 1;
 278         }
 279         $flags{'CHARGES'} = \%flaginfo;
 280     }
 281     elsif ( $balance < 0 ) {
 282         my %flaginfo;
 283         $flaginfo{'message'} = sprintf 'Patron has credit of %.02f', -$balance;
 284         $flaginfo{'amount'}  = sprintf "%.02f", $balance;
 285         $flags{'CREDITS'} = \%flaginfo;
 286     }
 287
 288     # Check the debt of the guarntees of this patron
 289     my $no_issues_charge_guarantees = C4::Context->preference("NoIssuesChargeGuarantees");
 290     $no_issues_charge_guarantees = undef unless looks_like_number( $no_issues_charge_guarantees );
 291     if ( defined $no_issues_charge_guarantees ) {
 292         my $p = Koha::Patrons->find( $patroninformation->{borrowernumber} );
 293         my @guarantees = $p->guarantees();
 294         my $guarantees_non_issues_charges;
 295         foreach my $g ( @guarantees ) {
 296             my ( $b, $n, $o ) = C4::Members::GetMemberAccountBalance( $g->id );
 297             $guarantees_non_issues_charges += $n;
 298         }
 299
 300         if ( $guarantees_non_issues_charges > $no_issues_charge_guarantees ) {
 301             my %flaginfo;
 302             $flaginfo{'message'} = sprintf 'patron guarantees owe %.02f', $guarantees_non_issues_charges;
 303             $flaginfo{'amount'}  = $guarantees_non_issues_charges;
 304             $flaginfo{'noissues'} = 1 unless C4::Context->preference("allowfineoverride");
 305             $flags{'CHARGES_GUARANTEES'} = \%flaginfo;
 306         }
 307     }
 308
 309     if (   $patroninformation->{'gonenoaddress'}
 310         && $patroninformation->{'gonenoaddress'} == 1 )
 311     {
 312         my %flaginfo;
 313         $flaginfo{'message'}  = 'Borrower has no valid address.';
 314         $flaginfo{'noissues'} = 1;
 315         $flags{'GNA'}         = \%flaginfo;
 316     }
 317     if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
 318         my %flaginfo;
 319         $flaginfo{'message'}  = 'Borrower\'s card reported lost.';
 320         $flaginfo{'noissues'} = 1;
 321         $flags{'LOST'}        = \%flaginfo;
 322     }
 323     if ( $patroninformation->{'debarred'} && check_date( split( /-/, $patroninformation->{'debarred'} ) ) ) {
 324         if ( Date_to_Days(Date::Calc::Today) < Date_to_Days( split( /-/, $patroninformation->{'debarred'} ) ) ) {
 325             my %flaginfo;
 326             $flaginfo{'debarredcomment'} = $patroninformation->{'debarredcomment'};
 327             $flaginfo{'message'}         = $patroninformation->{'debarredcomment'};
 328             $flaginfo{'noissues'}        = 1;
 329             $flaginfo{'dateend'}         = $patroninformation->{'debarred'};
 330             $flags{'DBARRED'}           = \%flaginfo;
 331         }
 332     }
 333     if (   $patroninformation->{'borrowernotes'}
 334         && $patroninformation->{'borrowernotes'} )
 335     {
 336         my %flaginfo;
 337         $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
 338         $flags{'NOTES'}      = \%flaginfo;
 339     }
 340     my ( $odues, $itemsoverdue ) = C4::Overdues::checkoverdues($patroninformation->{'borrowernumber'});
 341     if ( $odues && $odues > 0 ) {
 342         my %flaginfo;
 343         $flaginfo{'message'}  = "Yes";
 344         $flaginfo{'itemlist'} = $itemsoverdue;
 345         foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
 346             @$itemsoverdue )
 347         {
 348             $flaginfo{'itemlisttext'} .=
 349               "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n";  # newline is display layer
 350         }
 351         $flags{'ODUES'} = \%flaginfo;
 352     }
 353     my @itemswaiting = C4::Reserves::GetReservesFromBorrowernumber( $patroninformation->{'borrowernumber'},'W' );
 354     my $nowaiting = scalar @itemswaiting;
 355     if ( $nowaiting > 0 ) {
 356         my %flaginfo;
 357         $flaginfo{'message'}  = "Reserved items available";
 358         $flaginfo{'itemlist'} = \@itemswaiting;
 359         $flags{'WAITING'}     = \%flaginfo;
 360     }
 361     return ( \%flags );
 362 }
 363
 364
 365 =head2 GetMember
 366
 367   $borrower = &GetMember(%information);
 368
 369 Retrieve the first patron record meeting on criteria listed in the
 370 C<%information> hash, which should contain one or more
 371 pairs of borrowers column names and values, e.g.,
 372
 373    $borrower = GetMember(borrowernumber => id);
 374
 375 C<&GetBorrower> returns a reference-to-hash whose keys are the fields of
 376 the C<borrowers> table in the Koha database.
 377
 378 FIXME: GetMember() is used throughout the code as a lookup
 379 on a unique key such as the borrowernumber, but this meaning is not
 380 enforced in the routine itself.
 381
 382 =cut
 383
 384 #'
 385 sub GetMember {
 386     my ( %information ) = @_;
 387     if (exists $information{borrowernumber} && !defined $information{borrowernumber}) {
 388         #passing mysql's kohaadmin?? Makes no sense as a query
 389         return;
 390     }
 391     my $dbh = C4::Context->dbh;
 392     my $select =
 393     q{SELECT borrowers.*, categories.category_type, categories.description
 394     FROM borrowers
 395     LEFT JOIN categories on borrowers.categorycode=categories.categorycode WHERE };
 396     my $more_p = 0;
 397     my @values = ();
 398     for (keys %information ) {
 399         if ($more_p) {
 400             $select .= ' AND ';
 401         }
 402         else {
 403             $more_p++;
 404         }
 405
 406         if (defined $information{$_}) {
 407             $select .= "$_ = ?";
 408             push @values, $information{$_};
 409         }
 410         else {
 411             $select .= "$_ IS NULL";
 412         }
 413     }
 414     $debug && warn $select, " ",values %information;
 415     my $sth = $dbh->prepare("$select");
 416     $sth->execute(@values);
 417     my $data = $sth->fetchall_arrayref({});
 418     #FIXME interface to this routine now allows generation of a result set
 419     #so whole array should be returned but bowhere in the current code expects this
 420     if (@{$data} ) {
 421         return $data->[0];
 422     }
 423
 424     return;
 425 }
 426
 427 =head2 GetMemberIssuesAndFines
 428
 429   ($overdue_count, $issue_count, $total_fines) = &GetMemberIssuesAndFines($borrowernumber);
 430
 431 Returns aggregate data about items borrowed by the patron with the
 432 given borrowernumber.
 433
 434 C<&GetMemberIssuesAndFines> returns a three-element array.  C<$overdue_count> is the
 435 number of overdue items the patron currently has borrowed. C<$issue_count> is the
 436 number of books the patron currently has borrowed.  C<$total_fines> is
 437 the total fine currently due by the borrower.
 438
 439 =cut
 440
 441 #'
 442 sub GetMemberIssuesAndFines {
 443     my ( $borrowernumber ) = @_;
 444     my $dbh   = C4::Context->dbh;
 445     my $query = "SELECT COUNT(*) FROM issues WHERE borrowernumber = ?";
 446
 447     $debug and warn $query."\n";
 448     my $sth = $dbh->prepare($query);
 449     $sth->execute($borrowernumber);
 450     my $issue_count = $sth->fetchrow_arrayref->[0];
 451
 452     $sth = $dbh->prepare(
 453         "SELECT COUNT(*) FROM issues
 454          WHERE borrowernumber = ?
 455          AND date_due < now()"
 456     );
 457     $sth->execute($borrowernumber);
 458     my $overdue_count = $sth->fetchrow_arrayref->[0];
 459
 460     $sth = $dbh->prepare("SELECT SUM(amountoutstanding) FROM accountlines WHERE borrowernumber = ?");
 461     $sth->execute($borrowernumber);
 462     my $total_fines = $sth->fetchrow_arrayref->[0];
 463
 464     return ($overdue_count, $issue_count, $total_fines);
 465 }
 466
 467
 468 =head2 ModMember
 469
 470   my $success = ModMember(borrowernumber => $borrowernumber,
 471                                             [ field => value ]... );
 472
 473 Modify borrower's data.  All date fields should ALREADY be in ISO format.
 474
 475 return :
 476 true on success, or false on failure
 477
 478 =cut
 479
 480 sub ModMember {
 481     my (%data) = @_;
 482     # test to know if you must update or not the borrower password
 483     if (exists $data{password}) {
 484         if ($data{password} eq '****' or $data{password} eq '') {
 485             delete $data{password};
 486         } else {
 487             if ( C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
 488                 # Update the hashed PIN in borrower_sync.hashed_pin, before Koha hashes it
 489                 Koha::NorwegianPatronDB::NLUpdateHashedPIN( $data{'borrowernumber'}, $data{password} );
 490             }
 491             $data{password} = hash_password($data{password});
 492         }
 493     }
 494
 495     my $old_categorycode = Koha::Patrons->find( $data{borrowernumber} )->categorycode;
 496
 497     # get only the columns of a borrower
 498     my $schema = Koha::Database->new()->schema;
 499     my @columns = $schema->source('Borrower')->columns;
 500     my $new_borrower = { map { join(' ', @columns) =~ /$_/ ? ( $_ => $data{$_} ) : () } keys(%data) };
 501     delete $new_borrower->{flags};
 502
 503     $new_borrower->{dateofbirth}     ||= undef if exists $new_borrower->{dateofbirth};
 504     $new_borrower->{dateenrolled}    ||= undef if exists $new_borrower->{dateenrolled};
 505     $new_borrower->{dateexpiry}      ||= undef if exists $new_borrower->{dateexpiry};
 506     $new_borrower->{debarred}        ||= undef if exists $new_borrower->{debarred};
 507     $new_borrower->{sms_provider_id} ||= undef if exists $new_borrower->{sms_provider_id};
 508     $new_borrower->{guarantorid}     ||= undef if exists $new_borrower->{guarantorid};
 509
 510     my $patron = Koha::Patrons->find( $new_borrower->{borrowernumber} );
 511
 512     delete $new_borrower->{userid} if exists $new_borrower->{userid} and not $new_borrower->{userid};
 513
 514     my $execute_success = $patron->store if $patron->set($new_borrower);
 515
 516     if ($execute_success) { # only proceed if the update was a success
 517         # If the patron changes to a category with enrollment fee, we add a fee
 518         if ( $data{categorycode} and $data{categorycode} ne $old_categorycode ) {
 519             if ( C4::Context->preference('FeeOnChangePatronCategory') ) {
 520                 $patron->add_enrolment_fee_if_needed;
 521             }
 522         }
 523
 524         # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
 525         # cronjob will use for syncing with NL
 526         if ( C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
 527             my $borrowersync = Koha::Database->new->schema->resultset('BorrowerSync')->find({
 528                 'synctype'       => 'norwegianpatrondb',
 529                 'borrowernumber' => $data{'borrowernumber'}
 530             });
 531             # Do not set to "edited" if syncstatus is "new". We need to sync as new before
 532             # we can sync as changed. And the "new sync" will pick up all changes since
 533             # the patron was created anyway.
 534             if ( $borrowersync->syncstatus ne 'new' && $borrowersync->syncstatus ne 'delete' ) {
 535                 $borrowersync->update( { 'syncstatus' => 'edited' } );
 536             }
 537             # Set the value of 'sync'
 538             $borrowersync->update( { 'sync' => $data{'sync'} } );
 539             # Try to do the live sync
 540             Koha::NorwegianPatronDB::NLSync({ 'borrowernumber' => $data{'borrowernumber'} });
 541         }
 542
 543         logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "UPDATE (executed w/ arg: $data{'borrowernumber'})") if C4::Context->preference("BorrowersLog");
 544     }
 545     return $execute_success;
 546 }
 547
 548 =head2 AddMember
 549
 550   $borrowernumber = &AddMember(%borrower);
 551
 552 insert new borrower into table
 553
 554 (%borrower keys are database columns. Database columns could be
 555 different in different versions. Please look into database for correct
 556 column names.)
 557
 558 Returns the borrowernumber upon success
 559
 560 Returns as undef upon any db error without further processing
 561
 562 =cut
 563
 564 #'
 565 sub AddMember {
 566     my (%data) = @_;
 567     my $dbh = C4::Context->dbh;
 568     my $schema = Koha::Database->new()->schema;
 569
 570     # generate a proper login if none provided
 571     $data{'userid'} = Generate_Userid( $data{'borrowernumber'}, $data{'firstname'}, $data{'surname'} )
 572       if ( $data{'userid'} eq '' || !Check_Userid( $data{'userid'} ) );
 573
 574     # add expiration date if it isn't already there
 575     $data{dateexpiry} ||= Koha::Patron::Categories->find( $data{categorycode} )->get_expiry_date;
 576
 577     # add enrollment date if it isn't already there
 578     unless ( $data{'dateenrolled'} ) {
 579         $data{'dateenrolled'} = output_pref( { dt => dt_from_string, dateonly => 1, dateformat => 'iso' } );
 580     }
 581
 582     my $patron_category = $schema->resultset('Category')->find( $data{'categorycode'} );
 583     $data{'privacy'} =
 584         $patron_category->default_privacy() eq 'default' ? 1
 585       : $patron_category->default_privacy() eq 'never'   ? 2
 586       : $patron_category->default_privacy() eq 'forever' ? 0
 587       :                                                    undef;
 588
 589     $data{'privacy_guarantor_checkouts'} = 0 unless defined( $data{'privacy_guarantor_checkouts'} );
 590
 591     # Make a copy of the plain text password for later use
 592     my $plain_text_password = $data{'password'};
 593
 594     # create a disabled account if no password provided
 595     $data{'password'} = ($data{'password'})? hash_password($data{'password'}) : '!';
 596
 597     # we don't want invalid dates in the db (mysql has a bad habit of inserting 0000-00-00
 598     $data{'dateofbirth'}     = undef if ( not $data{'dateofbirth'} );
 599     $data{'debarred'}        = undef if ( not $data{'debarred'} );
 600     $data{'sms_provider_id'} = undef if ( not $data{'sms_provider_id'} );
 601
 602     # get only the columns of Borrower
 603     # FIXME Do we really need this check?
 604     my @columns = $schema->source('Borrower')->columns;
 605     my $new_member = { map { join(' ',@columns) =~ /$_/ ? ( $_ => $data{$_} )  : () } keys(%data) } ;
 606
 607     delete $new_member->{borrowernumber};
 608
 609     my $patron = Koha::Patron->new( $new_member )->store;
 610     $data{borrowernumber} = $patron->borrowernumber;
 611
 612     # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
 613     # cronjob will use for syncing with NL
 614     if ( exists $data{'borrowernumber'} && C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
 615         Koha::Database->new->schema->resultset('BorrowerSync')->create({
 616             'borrowernumber' => $data{'borrowernumber'},
 617             'synctype'       => 'norwegianpatrondb',
 618             'sync'           => 1,
 619             'syncstatus'     => 'new',
 620             'hashed_pin'     => Koha::NorwegianPatronDB::NLEncryptPIN( $plain_text_password ),
 621         });
 622     }
 623
 624     logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
 625
 626     $patron->add_enrolment_fee_if_needed;
 627
 628     return $data{borrowernumber};
 629 }
 630
 631 =head2 Check_Userid
 632
 633     my $uniqueness = Check_Userid($userid,$borrowernumber);
 634
 635     $borrowernumber is optional (i.e. it can contain a blank value). If $userid is passed with a blank $borrowernumber variable, the database will be checked for all instances of that userid (i.e. userid=? AND borrowernumber != '').
 636
 637     If $borrowernumber is provided, the database will be checked for every instance of that userid coupled with a different borrower(number) than the one provided.
 638
 639     return :
 640         0 for not unique (i.e. this $userid already exists)
 641         1 for unique (i.e. this $userid does not exist, or this $userid/$borrowernumber combination already exists)
 642
 643 =cut
 644
 645 sub Check_Userid {
 646     my ( $uid, $borrowernumber ) = @_;
 647
 648     return 0 unless ($uid); # userid is a unique column, we should assume NULL is not unique
 649
 650     return 0 if ( $uid eq C4::Context->config('user') );
 651
 652     my $rs = Koha::Database->new()->schema()->resultset('Borrower');
 653
 654     my $params;
 655     $params->{userid} = $uid;
 656     $params->{borrowernumber} = { '!=' => $borrowernumber } if ($borrowernumber);
 657
 658     my $count = $rs->count( $params );
 659
 660     return $count ? 0 : 1;
 661 }
 662
 663 =head2 Generate_Userid
 664
 665     my $newuid = Generate_Userid($borrowernumber, $firstname, $surname);
 666
 667     Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
 668
 669     $borrowernumber is optional (i.e. it can contain a blank value). A value is passed when generating a new userid for an existing borrower. When a new userid is created for a new borrower, a blank value is passed to this sub.
 670
 671     return :
 672         new userid ($firstname.$surname if there is a $firstname, or $surname if there is no value in $firstname) plus offset (0 if the $newuid is unique, or a higher numeric value if Check_Userid finds an existing match for the $newuid in the database).
 673
 674 =cut
 675
 676 sub Generate_Userid {
 677   my ($borrowernumber, $firstname, $surname) = @_;
 678   my $newuid;
 679   my $offset = 0;
 680   #The script will "do" the following code and increment the $offset until Check_Userid = 1 (i.e. until $newuid comes back as unique)
 681   do {
 682     $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
 683     $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
 684     $newuid = lc(($firstname)? "$firstname.$surname" : $surname);
 685     $newuid = unac_string('utf-8',$newuid);
 686     $newuid .= $offset unless $offset == 0;
 687     $offset++;
 688
 689    } while (!Check_Userid($newuid,$borrowernumber));
 690
 691    return $newuid;
 692 }
 693
 694 =head2 fixup_cardnumber
 695
 696 Warning: The caller is responsible for locking the members table in write
 697 mode, to avoid database corruption.
 698
 699 =cut
 700
 701 use vars qw( @weightings );
 702 my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
 703
 704 sub fixup_cardnumber {
 705     my ($cardnumber) = @_;
 706     my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;
 707
 708     # Find out whether member numbers should be generated
 709     # automatically. Should be either "1" or something else.
 710     # Defaults to "0", which is interpreted as "no".
 711
 712     #     if ($cardnumber !~ /\S/ && $autonumber_members) {
 713     ($autonumber_members) or return $cardnumber;
 714     my $checkdigit = C4::Context->preference('checkdigit');
 715     my $dbh = C4::Context->dbh;
 716     if ( $checkdigit and $checkdigit eq 'katipo' ) {
 717
 718         # if checkdigit is selected, calculate katipo-style cardnumber.
 719         # otherwise, just use the max()
 720         # purpose: generate checksum'd member numbers.
 721         # We'll assume we just got the max value of digits 2-8 of member #'s
 722         # from the database and our job is to increment that by one,
 723         # determine the 1st and 9th digits and return the full string.
 724         my $sth = $dbh->prepare(
 725             "select max(substring(borrowers.cardnumber,2,7)) as new_num from borrowers"
 726         );
 727         $sth->execute;
 728         my $data = $sth->fetchrow_hashref;
 729         $cardnumber = $data->{new_num};
 730         if ( !$cardnumber ) {    # If DB has no values,
 731             $cardnumber = 1000000;    # start at 1000000
 732         } else {
 733             $cardnumber += 1;
 734         }
 735
 736         my $sum = 0;
 737         for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
 738             # read weightings, left to right, 1 char at a time
 739             my $temp1 = $weightings[$i];
 740
 741             # sequence left to right, 1 char at a time
 742             my $temp2 = substr( $cardnumber, $i, 1 );
 743
 744             # mult each char 1-7 by its corresponding weighting
 745             $sum += $temp1 * $temp2;
 746         }
 747
 748         my $rem = ( $sum % 11 );
 749         $rem = 'X' if $rem == 10;
 750
 751         return "V$cardnumber$rem";
 752      } else {
 753
 754         my $sth = $dbh->prepare(
 755             'SELECT MAX( CAST( cardnumber AS SIGNED ) ) FROM borrowers WHERE cardnumber REGEXP "^-?[0-9]+$"'
 756         );
 757         $sth->execute;
 758         my ($result) = $sth->fetchrow;
 759         return $result + 1;
 760     }
 761     return $cardnumber;     # just here as a fallback/reminder
 762 }
 763
 764 =head2 GetPendingIssues
 765
 766   my $issues = &GetPendingIssues(@borrowernumber);
 767
 768 Looks up what the patron with the given borrowernumber has borrowed.
 769
 770 C<&GetPendingIssues> returns a
 771 reference-to-array where each element is a reference-to-hash; the
 772 keys are the fields from the C<issues>, C<biblio>, and C<items> tables.
 773 The keys include C<biblioitems> fields except marc and marcxml.
 774
 775 =cut
 776
 777 sub GetPendingIssues {
 778     my @borrowernumbers = @_;
 779
 780     unless (@borrowernumbers ) { # return a ref_to_array
 781         return \@borrowernumbers; # to not cause surprise to caller
 782     }
 783
 784     # Borrowers part of the query
 785     my $bquery = '';
 786     for (my $i = 0; $i < @borrowernumbers; $i++) {
 787         $bquery .= ' issues.borrowernumber = ?';
 788         if ($i < $#borrowernumbers ) {
 789             $bquery .= ' OR';
 790         }
 791     }
 792
 793     # must avoid biblioitems.* to prevent large marc and marcxml fields from killing performance
 794     # FIXME: namespace collision: each table has "timestamp" fields.  Which one is "timestamp" ?
 795     # FIXME: circ/ciculation.pl tries to sort by timestamp!
 796     # FIXME: namespace collision: other collisions possible.
 797     # FIXME: most of this data isn't really being used by callers.
 798     my $query =
 799    "SELECT issues.*,
 800             items.*,
 801            biblio.*,
 802            biblioitems.volume,
 803            biblioitems.number,
 804            biblioitems.itemtype,
 805            biblioitems.isbn,
 806            biblioitems.issn,
 807            biblioitems.publicationyear,
 808            biblioitems.publishercode,
 809            biblioitems.volumedate,
 810            biblioitems.volumedesc,
 811            biblioitems.lccn,
 812            biblioitems.url,
 813            borrowers.firstname,
 814            borrowers.surname,
 815            borrowers.cardnumber,
 816            issues.timestamp AS timestamp,
 817            issues.renewals  AS renewals,
 818            issues.borrowernumber AS borrowernumber,
 819             items.renewals  AS totalrenewals
 820     FROM   issues
 821     LEFT JOIN items       ON items.itemnumber       =      issues.itemnumber
 822     LEFT JOIN biblio      ON items.biblionumber     =      biblio.biblionumber
 823     LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
 824     LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
 825     WHERE
 826       $bquery
 827     ORDER BY issues.issuedate"
 828     ;
 829
 830     my $sth = C4::Context->dbh->prepare($query);
 831     $sth->execute(@borrowernumbers);
 832     my $data = $sth->fetchall_arrayref({});
 833     my $today = dt_from_string;
 834     foreach (@{$data}) {
 835         if ($_->{issuedate}) {
 836             $_->{issuedate} = dt_from_string($_->{issuedate}, 'sql');
 837         }
 838         $_->{date_due_sql} = $_->{date_due};
 839         # FIXME no need to have this value
 840         $_->{date_due} or next;
 841         $_->{date_due_sql} = $_->{date_due};
 842         # FIXME no need to have this value
 843         $_->{date_due} = dt_from_string($_->{date_due}, 'sql');
 844         if ( DateTime->compare($_->{date_due}, $today) == -1 ) {
 845             $_->{overdue} = 1;
 846         }
 847     }
 848     return $data;
 849 }
 850
 851 =head2 GetAllIssues
 852
 853   $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
 854
 855 Looks up what the patron with the given borrowernumber has borrowed,
 856 and sorts the results.
 857
 858 C<$sortkey> is the name of a field on which to sort the results. This
 859 should be the name of a field in the C<issues>, C<biblio>,
 860 C<biblioitems>, or C<items> table in the Koha database.
 861
 862 C<$limit> is the maximum number of results to return.
 863
 864 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
 865 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
 866 C<items> tables of the Koha database.
 867
 868 =cut
 869
 870 #'
 871 sub GetAllIssues {
 872     my ( $borrowernumber, $order, $limit ) = @_;
 873
 874     return unless $borrowernumber;
 875     $order = 'date_due desc' unless $order;
 876
 877     my $dbh = C4::Context->dbh;
 878     my $query =
 879 'SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
 880   FROM issues
 881   LEFT JOIN items on items.itemnumber=issues.itemnumber
 882   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
 883   LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
 884   WHERE borrowernumber=?
 885   UNION ALL
 886   SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
 887   FROM old_issues
 888   LEFT JOIN items on items.itemnumber=old_issues.itemnumber
 889   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
 890   LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
 891   WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL
 892   order by ' . $order;
 893     if ($limit) {
 894         $query .= " limit $limit";
 895     }
 896
 897     my $sth = $dbh->prepare($query);
 898     $sth->execute( $borrowernumber, $borrowernumber );
 899     return $sth->fetchall_arrayref( {} );
 900 }
 901
 902
 903 =head2 GetMemberAccountRecords
 904
 905   ($total, $acctlines, $count) = &GetMemberAccountRecords($borrowernumber);
 906
 907 Looks up accounting data for the patron with the given borrowernumber.
 908
 909 C<&GetMemberAccountRecords> returns a three-element array. C<$acctlines> is a
 910 reference-to-array, where each element is a reference-to-hash; the
 911 keys are the fields of the C<accountlines> table in the Koha database.
 912 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
 913 total amount outstanding for all of the account lines.
 914
 915 =cut
 916
 917 sub GetMemberAccountRecords {
 918     my ($borrowernumber) = @_;
 919     my $dbh = C4::Context->dbh;
 920     my @acctlines;
 921     my $numlines = 0;
 922     my $strsth      = qq(
 923                         SELECT *
 924                         FROM accountlines
 925                         WHERE borrowernumber=?);
 926     $strsth.=" ORDER BY accountlines_id desc";
 927     my $sth= $dbh->prepare( $strsth );
 928     $sth->execute( $borrowernumber );
 929
 930     my $total = 0;
 931     while ( my $data = $sth->fetchrow_hashref ) {
 932         if ( $data->{itemnumber} ) {
 933             my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
 934             $data->{biblionumber} = $biblio->{biblionumber};
 935             $data->{title}        = $biblio->{title};
 936         }
 937         $acctlines[$numlines] = $data;
 938         $numlines++;
 939         $total += sprintf "%.0f", 1000*$data->{amountoutstanding}; # convert float to integer to avoid round-off errors
 940     }
 941     $total /= 1000;
 942     return ( $total, \@acctlines,$numlines);
 943 }
 944
 945 =head2 GetMemberAccountBalance
 946
 947   ($total_balance, $non_issue_balance, $other_charges) = &GetMemberAccountBalance($borrowernumber);
 948
 949 Calculates amount immediately owing by the patron - non-issue charges.
 950 Based on GetMemberAccountRecords.
 951 Charges exempt from non-issue are:
 952 * Res (reserves)
 953 * Rent (rental) if RentalsInNoissuesCharge syspref is set to false
 954 * Manual invoices if ManInvInNoissuesCharge syspref is set to false
 955
 956 =cut
 957
 958 sub GetMemberAccountBalance {
 959     my ($borrowernumber) = @_;
 960
 961     my $ACCOUNT_TYPE_LENGTH = 5; # this is plain ridiculous...
 962
 963     my @not_fines;
 964     push @not_fines, 'Res' unless C4::Context->preference('HoldsInNoissuesCharge');
 965     push @not_fines, 'Rent' unless C4::Context->preference('RentalsInNoissuesCharge');
 966     unless ( C4::Context->preference('ManInvInNoissuesCharge') ) {
 967         my $dbh = C4::Context->dbh;
 968         my $man_inv_types = $dbh->selectcol_arrayref(qq{SELECT authorised_value FROM authorised_values WHERE category = 'MANUAL_INV'});
 969         push @not_fines, map substr($_, 0, $ACCOUNT_TYPE_LENGTH), @$man_inv_types;
 970     }
 971     my %not_fine = map {$_ => 1} @not_fines;
 972
 973     my ($total, $acctlines) = GetMemberAccountRecords($borrowernumber);
 974     my $other_charges = 0;
 975     foreach (@$acctlines) {
 976         $other_charges += $_->{amountoutstanding} if $not_fine{ substr($_->{accounttype}, 0, $ACCOUNT_TYPE_LENGTH) };
 977     }
 978
 979     return ( $total, $total - $other_charges, $other_charges);
 980 }
 981
 982 =head2 GetBorNotifyAcctRecord
 983
 984   ($total, $acctlines, $count) = &GetBorNotifyAcctRecord($params,$notifyid);
 985
 986 Looks up accounting data for the patron with the given borrowernumber per file number.
 987
 988 C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a
 989 reference-to-array, where each element is a reference-to-hash; the
 990 keys are the fields of the C<accountlines> table in the Koha database.
 991 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
 992 total amount outstanding for all of the account lines.
 993
 994 =cut
 995
 996 sub GetBorNotifyAcctRecord {
 997     my ( $borrowernumber, $notifyid ) = @_;
 998     my $dbh = C4::Context->dbh;
 999     my @acctlines;
1000     my $numlines = 0;
1001     my $sth = $dbh->prepare(
1002             "SELECT *
1003                 FROM accountlines
1004                 WHERE borrowernumber=?
1005                     AND notify_id=?
1006                     AND amountoutstanding != '0'
1007                 ORDER BY notify_id,accounttype
1008                 ");
1009
1010     $sth->execute( $borrowernumber, $notifyid );
1011     my $total = 0;
1012     while ( my $data = $sth->fetchrow_hashref ) {
1013         if ( $data->{itemnumber} ) {
1014             my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
1015             $data->{biblionumber} = $biblio->{biblionumber};
1016             $data->{title}        = $biblio->{title};
1017         }
1018         $acctlines[$numlines] = $data;
1019         $numlines++;
1020         $total += int(100 * $data->{'amountoutstanding'});
1021     }
1022     $total /= 100;
1023     return ( $total, \@acctlines, $numlines );
1024 }
1025
1026 sub checkcardnumber {
1027     my ( $cardnumber, $borrowernumber ) = @_;
1028
1029     # If cardnumber is null, we assume they're allowed.
1030     return 0 unless defined $cardnumber;
1031
1032     my $dbh = C4::Context->dbh;
1033     my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
1034     $query .= " AND borrowernumber <> ?" if ($borrowernumber);
1035     my $sth = $dbh->prepare($query);
1036     $sth->execute(
1037         $cardnumber,
1038         ( $borrowernumber ? $borrowernumber : () )
1039     );
1040
1041     return 1 if $sth->fetchrow_hashref;
1042
1043     my ( $min_length, $max_length ) = get_cardnumber_length();
1044     return 2
1045         if length $cardnumber > $max_length
1046         or length $cardnumber < $min_length;
1047
1048     return 0;
1049 }
1050
1051 =head2 get_cardnumber_length
1052
1053     my ($min, $max) = C4::Members::get_cardnumber_length()
1054
1055 Returns the minimum and maximum length for patron cardnumbers as
1056 determined by the CardnumberLength system preference, the
1057 BorrowerMandatoryField system preference, and the width of the
1058 database column.
1059
1060 =cut
1061
1062 sub get_cardnumber_length {
1063     my ( $min, $max ) = ( 0, 16 ); # borrowers.cardnumber is a nullable varchar(16)
1064     $min = 1 if C4::Context->preference('BorrowerMandatoryField') =~ /cardnumber/;
1065     if ( my $cardnumber_length = C4::Context->preference('CardnumberLength') ) {
1066         # Is integer and length match
1067         if ( $cardnumber_length =~ m|^\d+$| ) {
1068             $min = $max = $cardnumber_length
1069                 if $cardnumber_length >= $min
1070                     and $cardnumber_length <= $max;
1071         }
1072         # Else assuming it is a range
1073         elsif ( $cardnumber_length =~ m|(\d*),(\d*)| ) {
1074             $min = $1 if $1 and $min < $1;
1075             $max = $2 if $2 and $max > $2;
1076         }
1077
1078     }
1079     my $borrower = Koha::Schema->resultset('Borrower');
1080     my $field_size = $borrower->result_source->column_info('cardnumber')->{size};
1081     $min = $field_size if $min > $field_size;
1082     return ( $min, $max );
1083 }
1084
1085 =head2 GetFirstValidEmailAddress
1086
1087   $email = GetFirstValidEmailAddress($borrowernumber);
1088
1089 Return the first valid email address for a borrower, given the borrowernumber.  For now, the order
1090 is defined as email, emailpro, B_email.  Returns the empty string if the borrower has no email
1091 addresses.
1092
1093 =cut
1094
1095 sub GetFirstValidEmailAddress {
1096     my $borrowernumber = shift;
1097     my $dbh = C4::Context->dbh;
1098     my $sth = $dbh->prepare( "SELECT email, emailpro, B_email FROM borrowers where borrowernumber = ? ");
1099     $sth->execute( $borrowernumber );
1100     my $data = $sth->fetchrow_hashref;
1101
1102     if ($data->{'email'}) {
1103        return $data->{'email'};
1104     } elsif ($data->{'emailpro'}) {
1105        return $data->{'emailpro'};
1106     } elsif ($data->{'B_email'}) {
1107        return $data->{'B_email'};
1108     } else {
1109        return '';
1110     }
1111 }
1112
1113 =head2 GetNoticeEmailAddress
1114
1115   $email = GetNoticeEmailAddress($borrowernumber);
1116
1117 Return the email address of borrower used for notices, given the borrowernumber.
1118 Returns the empty string if no email address.
1119
1120 =cut
1121
1122 sub GetNoticeEmailAddress {
1123     my $borrowernumber = shift;
1124
1125     my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
1126     # if syspref is set to 'first valid' (value == OFF), look up email address
1127     if ( $which_address eq 'OFF' ) {
1128         return GetFirstValidEmailAddress($borrowernumber);
1129     }
1130     # specified email address field
1131     my $dbh = C4::Context->dbh;
1132     my $sth = $dbh->prepare( qq{
1133         SELECT $which_address AS primaryemail
1134         FROM borrowers
1135         WHERE borrowernumber=?
1136     } );
1137     $sth->execute($borrowernumber);
1138     my $data = $sth->fetchrow_hashref;
1139     return $data->{'primaryemail'} || '';
1140 }
1141
1142 =head2 GetUpcomingMembershipExpires
1143
1144     my $expires = GetUpcomingMembershipExpires({
1145         branch => $branch, before => $before, after => $after,
1146     });
1147
1148     $branch is an optional branch code.
1149     $before/$after is an optional number of days before/after the date that
1150     is set by the preference MembershipExpiryDaysNotice.
1151     If the pref would be 14, before 2 and after 3, you will get all expires
1152     from 12 to 17 days.
1153
1154 =cut
1155
1156 sub GetUpcomingMembershipExpires {
1157     my ( $params ) = @_;
1158     my $before = $params->{before} || 0;
1159     my $after  = $params->{after} || 0;
1160     my $branch = $params->{branch};
1161
1162     my $dbh = C4::Context->dbh;
1163     my $days = C4::Context->preference("MembershipExpiryDaysNotice") || 0;
1164     my $date1 = dt_from_string->add( days => $days - $before );
1165     my $date2 = dt_from_string->add( days => $days + $after );
1166     $date1= output_pref({ dt => $date1, dateformat => 'iso', dateonly => 1 });
1167     $date2= output_pref({ dt => $date2, dateformat => 'iso', dateonly => 1 });
1168
1169     my $query = q|
1170         SELECT borrowers.*, categories.description,
1171         branches.branchname, branches.branchemail FROM borrowers
1172         LEFT JOIN branches USING (branchcode)
1173         LEFT JOIN categories USING (categorycode)
1174     |;
1175     if( $branch ) {
1176         $query.= 'WHERE branchcode=? AND dateexpiry BETWEEN ? AND ?';
1177     } else {
1178         $query.= 'WHERE dateexpiry BETWEEN ? AND ?';
1179     }
1180
1181     my $sth = $dbh->prepare( $query );
1182     my @pars = $branch? ( $branch ): ();
1183     push @pars, $date1, $date2;
1184     $sth->execute( @pars );
1185     my $results = $sth->fetchall_arrayref( {} );
1186     return $results;
1187 }
1188
1189 =head2 GetBorrowersToExpunge
1190
1191   $borrowers = &GetBorrowersToExpunge(
1192       not_borrowed_since => $not_borrowed_since,
1193       expired_before       => $expired_before,
1194       category_code        => $category_code,
1195       patron_list_id       => $patron_list_id,
1196       branchcode           => $branchcode
1197   );
1198
1199   This function get all borrowers based on the given criteria.
1200
1201 =cut
1202
1203 sub GetBorrowersToExpunge {
1204
1205     my $params = shift;
1206     my $filterdate       = $params->{'not_borrowed_since'};
1207     my $filterexpiry     = $params->{'expired_before'};
1208     my $filterlastseen   = $params->{'last_seen'};
1209     my $filtercategory   = $params->{'category_code'};
1210     my $filterbranch     = $params->{'branchcode'} ||
1211                         ((C4::Context->preference('IndependentBranches')
1212                              && C4::Context->userenv
1213                              && !C4::Context->IsSuperLibrarian()
1214                              && C4::Context->userenv->{branch})
1215                          ? C4::Context->userenv->{branch}
1216                          : "");
1217     my $filterpatronlist = $params->{'patron_list_id'};
1218
1219     my $dbh   = C4::Context->dbh;
1220     my $query = q|
1221         SELECT borrowers.borrowernumber,
1222                MAX(old_issues.timestamp) AS latestissue,
1223                MAX(issues.timestamp) AS currentissue
1224         FROM   borrowers
1225         JOIN   categories USING (categorycode)
1226         LEFT JOIN (
1227             SELECT guarantorid
1228             FROM borrowers
1229             WHERE guarantorid IS NOT NULL
1230                 AND guarantorid <> 0
1231         ) as tmp ON borrowers.borrowernumber=tmp.guarantorid
1232         LEFT JOIN old_issues USING (borrowernumber)
1233         LEFT JOIN issues USING (borrowernumber)|;
1234     if ( $filterpatronlist  ){
1235         $query .= q| LEFT JOIN patron_list_patrons USING (borrowernumber)|;
1236     }
1237     $query .= q| WHERE  category_type <> 'S'
1238         AND tmp.guarantorid IS NULL
1239    |;
1240     my @query_params;
1241     if ( $filterbranch && $filterbranch ne "" ) {
1242         $query.= " AND borrowers.branchcode = ? ";
1243         push( @query_params, $filterbranch );
1244     }
1245     if ( $filterexpiry ) {
1246         $query .= " AND dateexpiry < ? ";
1247         push( @query_params, $filterexpiry );
1248     }
1249     if ( $filterlastseen ) {
1250         $query .= ' AND lastseen < ? ';
1251         push @query_params, $filterlastseen;
1252     }
1253     if ( $filtercategory ) {
1254         $query .= " AND categorycode = ? ";
1255         push( @query_params, $filtercategory );
1256     }
1257     if ( $filterpatronlist ){
1258         $query.=" AND patron_list_id = ? ";
1259         push( @query_params, $filterpatronlist );
1260     }
1261     $query.=" GROUP BY borrowers.borrowernumber HAVING currentissue IS NULL ";
1262     if ( $filterdate ) {
1263         $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
1264         push @query_params,$filterdate;
1265     }
1266     warn $query if $debug;
1267
1268     my $sth = $dbh->prepare($query);
1269     if (scalar(@query_params)>0){
1270         $sth->execute(@query_params);
1271     }
1272     else {
1273         $sth->execute;
1274     }
1275
1276     my @results;
1277     while ( my $data = $sth->fetchrow_hashref ) {
1278         push @results, $data;
1279     }
1280     return \@results;
1281 }
1282
1283 =head2 GetBorrowersWhoHaveNeverBorrowed
1284
1285   $results = &GetBorrowersWhoHaveNeverBorrowed
1286
1287 This function get all borrowers who have never borrowed.
1288
1289 I<$result> is a ref to an array which all elements are a hasref.
1290
1291 =cut
1292
1293 sub GetBorrowersWhoHaveNeverBorrowed {
1294     my $filterbranch = shift ||
1295                         ((C4::Context->preference('IndependentBranches')
1296                              && C4::Context->userenv
1297                              && !C4::Context->IsSuperLibrarian()
1298                              && C4::Context->userenv->{branch})
1299                          ? C4::Context->userenv->{branch}
1300                          : "");
1301     my $dbh   = C4::Context->dbh;
1302     my $query = "
1303         SELECT borrowers.borrowernumber,max(timestamp) as latestissue
1304         FROM   borrowers
1305           LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
1306         WHERE issues.borrowernumber IS NULL
1307    ";
1308     my @query_params;
1309     if ($filterbranch && $filterbranch ne ""){
1310         $query.=" AND borrowers.branchcode= ?";
1311         push @query_params,$filterbranch;
1312     }
1313     warn $query if $debug;
1314
1315     my $sth = $dbh->prepare($query);
1316     if (scalar(@query_params)>0){
1317         $sth->execute(@query_params);
1318     }
1319     else {
1320         $sth->execute;
1321     }
1322
1323     my @results;
1324     while ( my $data = $sth->fetchrow_hashref ) {
1325         push @results, $data;
1326     }
1327     return \@results;
1328 }
1329
1330 =head2 GetBorrowersWithIssuesHistoryOlderThan
1331
1332   $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
1333
1334 this function get all borrowers who has an issue history older than I<$date> given on input arg.
1335
1336 I<$result> is a ref to an array which all elements are a hashref.
1337 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
1338
1339 =cut
1340
1341 sub GetBorrowersWithIssuesHistoryOlderThan {
1342     my $dbh  = C4::Context->dbh;
1343     my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
1344     my $filterbranch = shift ||
1345                         ((C4::Context->preference('IndependentBranches')
1346                              && C4::Context->userenv
1347                              && !C4::Context->IsSuperLibrarian()
1348                              && C4::Context->userenv->{branch})
1349                          ? C4::Context->userenv->{branch}
1350                          : "");
1351     my $query = "
1352        SELECT count(borrowernumber) as n,borrowernumber
1353        FROM old_issues
1354        WHERE returndate < ?
1355          AND borrowernumber IS NOT NULL
1356     ";
1357     my @query_params;
1358     push @query_params, $date;
1359     if ($filterbranch){
1360         $query.="   AND branchcode = ?";
1361         push @query_params, $filterbranch;
1362     }
1363     $query.=" GROUP BY borrowernumber ";
1364     warn $query if $debug;
1365     my $sth = $dbh->prepare($query);
1366     $sth->execute(@query_params);
1367     my @results;
1368
1369     while ( my $data = $sth->fetchrow_hashref ) {
1370         push @results, $data;
1371     }
1372     return \@results;
1373 }
1374
1375 =head2 IssueSlip
1376
1377   IssueSlip($branchcode, $borrowernumber, $quickslip)
1378
1379   Returns letter hash ( see C4::Letters::GetPreparedLetter )
1380
1381   $quickslip is boolean, to indicate whether we want a quick slip
1382
1383   IssueSlip populates ISSUESLIP and ISSUEQSLIP, and will make the following expansions:
1384
1385   Both slips:
1386
1387       <<branches.*>>
1388       <<borrowers.*>>
1389
1390   ISSUESLIP:
1391
1392       <checkedout>
1393          <<biblio.*>>
1394          <<items.*>>
1395          <<biblioitems.*>>
1396          <<issues.*>>
1397       </checkedout>
1398
1399       <overdue>
1400          <<biblio.*>>
1401          <<items.*>>
1402          <<biblioitems.*>>
1403          <<issues.*>>
1404       </overdue>
1405
1406       <news>
1407          <<opac_news.*>>
1408       </news>
1409
1410   ISSUEQSLIP:
1411
1412       <checkedout>
1413          <<biblio.*>>
1414          <<items.*>>
1415          <<biblioitems.*>>
1416          <<issues.*>>
1417       </checkedout>
1418
1419   NOTE: Not all table fields are available, pleasee see GetPendingIssues for a list of available fields.
1420
1421 =cut
1422
1423 sub IssueSlip {
1424     my ($branch, $borrowernumber, $quickslip) = @_;
1425
1426     # FIXME Check callers before removing this statement
1427     #return unless $borrowernumber;
1428
1429     my @issues = @{ GetPendingIssues($borrowernumber) };
1430
1431     for my $issue (@issues) {
1432         $issue->{date_due} = $issue->{date_due_sql};
1433         if ($quickslip) {
1434             my $today = output_pref({ dt => dt_from_string, dateformat => 'iso', dateonly => 1 });
1435             if ( substr( $issue->{issuedate}, 0, 10 ) eq $today
1436                 or substr( $issue->{lastreneweddate}, 0, 10 ) eq $today ) {
1437                   $issue->{now} = 1;
1438             };
1439         }
1440     }
1441
1442     # Sort on timestamp then on issuedate (useful for tests and could be if modified in a batch
1443     @issues = sort {
1444         my $s = $b->{timestamp} <=> $a->{timestamp};
1445         $s == 0 ?
1446              $b->{issuedate} <=> $a->{issuedate} : $s;
1447     } @issues;
1448
1449     my ($letter_code, %repeat);
1450     if ( $quickslip ) {
1451         $letter_code = 'ISSUEQSLIP';
1452         %repeat =  (
1453             'checkedout' => [ map {
1454                 'biblio'       => $_,
1455                 'items'        => $_,
1456                 'biblioitems'  => $_,
1457                 'issues'       => $_,
1458             }, grep { $_->{'now'} } @issues ],
1459         );
1460     }
1461     else {
1462         $letter_code = 'ISSUESLIP';
1463         %repeat =  (
1464             'checkedout' => [ map {
1465                 'biblio'       => $_,
1466                 'items'        => $_,
1467                 'biblioitems'  => $_,
1468                 'issues'       => $_,
1469             }, grep { !$_->{'overdue'} } @issues ],
1470
1471             'overdue' => [ map {
1472                 'biblio'       => $_,
1473                 'items'        => $_,
1474                 'biblioitems'  => $_,
1475                 'issues'       => $_,
1476             }, grep { $_->{'overdue'} } @issues ],
1477
1478             'news' => [ map {
1479                 $_->{'timestamp'} = $_->{'newdate'};
1480                 { opac_news => $_ }
1481             } @{ GetNewsToDisplay("slip",$branch) } ],
1482         );
1483     }
1484
1485     return  C4::Letters::GetPreparedLetter (
1486         module => 'circulation',
1487         letter_code => $letter_code,
1488         branchcode => $branch,
1489         tables => {
1490             'branches'    => $branch,
1491             'borrowers'   => $borrowernumber,
1492         },
1493         repeat => \%repeat,
1494     );
1495 }
1496
1497 =head2 GetBorrowersWithEmail
1498
1499     ([$borrnum,$userid], ...) = GetBorrowersWithEmail('me@example.com');
1500
1501 This gets a list of users and their basic details from their email address.
1502 As it's possible for multiple user to have the same email address, it provides
1503 you with all of them. If there is no userid for the user, there will be an
1504 C<undef> there. An empty list will be returned if there are no matches.
1505
1506 =cut
1507
1508 sub GetBorrowersWithEmail {
1509     my $email = shift;
1510
1511     my $dbh = C4::Context->dbh;
1512
1513     my $query = "SELECT borrowernumber, userid FROM borrowers WHERE email=?";
1514     my $sth=$dbh->prepare($query);
1515     $sth->execute($email);
1516     my @result = ();
1517     while (my $ref = $sth->fetch) {
1518         push @result, $ref;
1519     }
1520     die "Failure searching for borrowers by email address: $sth->errstr" if $sth->err;
1521     return @result;
1522 }
1523
1524 =head2 AddMember_Opac
1525
1526 =cut
1527
1528 sub AddMember_Opac {
1529     my ( %borrower ) = @_;
1530
1531     $borrower{'categorycode'} //= C4::Context->preference('PatronSelfRegistrationDefaultCategory');
1532     if (not defined $borrower{'password'}){
1533         my $sr = new String::Random;
1534         $sr->{'A'} = [ 'A'..'Z', 'a'..'z' ];
1535         my $password = $sr->randpattern("AAAAAAAAAA");
1536         $borrower{'password'} = $password;
1537     }
1538
1539     $borrower{'cardnumber'} = fixup_cardnumber( $borrower{'cardnumber'} );
1540
1541     my $borrowernumber = AddMember(%borrower);
1542
1543     return ( $borrowernumber, $borrower{'password'} );
1544 }
1545
1546 =head2 DeleteExpiredOpacRegistrations
1547
1548     Delete accounts that haven't been upgraded from the 'temporary' category
1549     Returns the number of removed patrons
1550
1551 =cut
1552
1553 sub DeleteExpiredOpacRegistrations {
1554
1555     my $delay = C4::Context->preference('PatronSelfRegistrationExpireTemporaryAccountsDelay');
1556     my $category_code = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
1557
1558     return 0 if not $category_code or not defined $delay or $delay eq q||;
1559
1560     my $query = qq|
1561 SELECT borrowernumber
1562 FROM borrowers
1563 WHERE categorycode = ? AND DATEDIFF( NOW(), dateenrolled ) > ? |;
1564
1565     my $dbh = C4::Context->dbh;
1566     my $sth = $dbh->prepare($query);
1567     $sth->execute( $category_code, $delay );
1568     my $cnt=0;
1569     while ( my ($borrowernumber) = $sth->fetchrow_array() ) {
1570         Koha::Patrons->find($borrowernumber)->delete;
1571         $cnt++;
1572     }
1573     return $cnt;
1574 }
1575
1576 =head2 DeleteUnverifiedOpacRegistrations
1577
1578     Delete all unverified self registrations in borrower_modifications,
1579     older than the specified number of days.
1580
1581 =cut
1582
1583 sub DeleteUnverifiedOpacRegistrations {
1584     my ( $days ) = @_;
1585     my $dbh = C4::Context->dbh;
1586     my $sql=qq|
1587 DELETE FROM borrower_modifications
1588 WHERE borrowernumber = 0 AND DATEDIFF( NOW(), timestamp ) > ?|;
1589     my $cnt=$dbh->do($sql, undef, ($days) );
1590     return $cnt eq '0E0'? 0: $cnt;
1591 }
1592
1593 sub GetOverduesForPatron {
1594     my ( $borrowernumber ) = @_;
1595
1596     my $sql = "
1597         SELECT *
1598         FROM issues, items, biblio, biblioitems
1599         WHERE items.itemnumber=issues.itemnumber
1600           AND biblio.biblionumber   = items.biblionumber
1601           AND biblio.biblionumber   = biblioitems.biblionumber
1602           AND issues.borrowernumber = ?
1603           AND date_due < NOW()
1604     ";
1605
1606     my $sth = C4::Context->dbh->prepare( $sql );
1607     $sth->execute( $borrowernumber );
1608
1609     return $sth->fetchall_arrayref({});
1610 }
1611
1612 END { }    # module clean-up code here (global destructor)
1613
1614 1;
1615
1616 __END__
1617
1618 =head1 AUTHOR
1619
1620 Koha Team
1621
1622 =cut