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