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 except marc and marcxml.
 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     # must avoid biblioitems.* to prevent large marc and marcxml fields from killing performance
 718     # FIXME: namespace collision: each table has "timestamp" fields.  Which one is "timestamp" ?
 719     # FIXME: circ/ciculation.pl tries to sort by timestamp!
 720     # FIXME: namespace collision: other collisions possible.
 721     # FIXME: most of this data isn't really being used by callers.
 722     my $query =
 723    "SELECT issues.*,
 724             items.*,
 725            biblio.*,
 726            biblioitems.volume,
 727            biblioitems.number,
 728            biblioitems.itemtype,
 729            biblioitems.isbn,
 730            biblioitems.issn,
 731            biblioitems.publicationyear,
 732            biblioitems.publishercode,
 733            biblioitems.volumedate,
 734            biblioitems.volumedesc,
 735            biblioitems.lccn,
 736            biblioitems.url,
 737            borrowers.firstname,
 738            borrowers.surname,
 739            borrowers.cardnumber,
 740            issues.timestamp AS timestamp,
 741            issues.renewals  AS renewals,
 742            issues.borrowernumber AS borrowernumber,
 743             items.renewals  AS totalrenewals
 744     FROM   issues
 745     LEFT JOIN items       ON items.itemnumber       =      issues.itemnumber
 746     LEFT JOIN biblio      ON items.biblionumber     =      biblio.biblionumber
 747     LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
 748     LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
 749     WHERE
 750       $bquery
 751     ORDER BY issues.issuedate"
 752     ;
 753
 754     my $sth = C4::Context->dbh->prepare($query);
 755     $sth->execute(@borrowernumbers);
 756     my $data = $sth->fetchall_arrayref({});
 757     my $today = dt_from_string;
 758     foreach (@{$data}) {
 759         if ($_->{issuedate}) {
 760             $_->{issuedate} = dt_from_string($_->{issuedate}, 'sql');
 761         }
 762         $_->{date_due_sql} = $_->{date_due};
 763         # FIXME no need to have this value
 764         $_->{date_due} or next;
 765         $_->{date_due_sql} = $_->{date_due};
 766         # FIXME no need to have this value
 767         $_->{date_due} = dt_from_string($_->{date_due}, 'sql');
 768         if ( DateTime->compare($_->{date_due}, $today) == -1 ) {
 769             $_->{overdue} = 1;
 770         }
 771     }
 772     return $data;
 773 }
 774
 775 =head2 GetAllIssues
 776
 777   $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
 778
 779 Looks up what the patron with the given borrowernumber has borrowed,
 780 and sorts the results.
 781
 782 C<$sortkey> is the name of a field on which to sort the results. This
 783 should be the name of a field in the C<issues>, C<biblio>,
 784 C<biblioitems>, or C<items> table in the Koha database.
 785
 786 C<$limit> is the maximum number of results to return.
 787
 788 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
 789 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
 790 C<items> tables of the Koha database.
 791
 792 =cut
 793
 794 #'
 795 sub GetAllIssues {
 796     my ( $borrowernumber, $order, $limit ) = @_;
 797
 798     return unless $borrowernumber;
 799     $order = 'date_due desc' unless $order;
 800
 801     my $dbh = C4::Context->dbh;
 802     my $query =
 803 'SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
 804   FROM issues
 805   LEFT JOIN items on items.itemnumber=issues.itemnumber
 806   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
 807   LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
 808   WHERE borrowernumber=?
 809   UNION ALL
 810   SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
 811   FROM old_issues
 812   LEFT JOIN items on items.itemnumber=old_issues.itemnumber
 813   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
 814   LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
 815   WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL
 816   order by ' . $order;
 817     if ($limit) {
 818         $query .= " limit $limit";
 819     }
 820
 821     my $sth = $dbh->prepare($query);
 822     $sth->execute( $borrowernumber, $borrowernumber );
 823     return $sth->fetchall_arrayref( {} );
 824 }
 825
 826
 827 =head2 GetMemberAccountRecords
 828
 829   ($total, $acctlines, $count) = &GetMemberAccountRecords($borrowernumber);
 830
 831 Looks up accounting data for the patron with the given borrowernumber.
 832
 833 C<&GetMemberAccountRecords> returns a three-element array. C<$acctlines> is a
 834 reference-to-array, where each element is a reference-to-hash; the
 835 keys are the fields of the C<accountlines> table in the Koha database.
 836 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
 837 total amount outstanding for all of the account lines.
 838
 839 =cut
 840
 841 sub GetMemberAccountRecords {
 842     my ($borrowernumber) = @_;
 843     my $dbh = C4::Context->dbh;
 844     my @acctlines;
 845     my $numlines = 0;
 846     my $strsth      = qq(
 847                         SELECT *
 848                         FROM accountlines
 849                         WHERE borrowernumber=?);
 850     $strsth.=" ORDER BY accountlines_id desc";
 851     my $sth= $dbh->prepare( $strsth );
 852     $sth->execute( $borrowernumber );
 853
 854     my $total = 0;
 855     while ( my $data = $sth->fetchrow_hashref ) {
 856         if ( $data->{itemnumber} ) {
 857             my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
 858             $data->{biblionumber} = $biblio->{biblionumber};
 859             $data->{title}        = $biblio->{title};
 860         }
 861         $acctlines[$numlines] = $data;
 862         $numlines++;
 863         $total += sprintf "%.0f", 1000*$data->{amountoutstanding}; # convert float to integer to avoid round-off errors
 864     }
 865     $total /= 1000;
 866     return ( $total, \@acctlines,$numlines);
 867 }
 868
 869 =head2 GetMemberAccountBalance
 870
 871   ($total_balance, $non_issue_balance, $other_charges) = &GetMemberAccountBalance($borrowernumber);
 872
 873 Calculates amount immediately owing by the patron - non-issue charges.
 874 Based on GetMemberAccountRecords.
 875 Charges exempt from non-issue are:
 876 * Res (reserves)
 877 * Rent (rental) if RentalsInNoissuesCharge syspref is set to false
 878 * Manual invoices if ManInvInNoissuesCharge syspref is set to false
 879
 880 =cut
 881
 882 sub GetMemberAccountBalance {
 883     my ($borrowernumber) = @_;
 884
 885     my $ACCOUNT_TYPE_LENGTH = 5; # this is plain ridiculous...
 886
 887     my @not_fines;
 888     push @not_fines, 'Res' unless C4::Context->preference('HoldsInNoissuesCharge');
 889     push @not_fines, 'Rent' unless C4::Context->preference('RentalsInNoissuesCharge');
 890     unless ( C4::Context->preference('ManInvInNoissuesCharge') ) {
 891         my $dbh = C4::Context->dbh;
 892         my $man_inv_types = $dbh->selectcol_arrayref(qq{SELECT authorised_value FROM authorised_values WHERE category = 'MANUAL_INV'});
 893         push @not_fines, map substr($_, 0, $ACCOUNT_TYPE_LENGTH), @$man_inv_types;
 894     }
 895     my %not_fine = map {$_ => 1} @not_fines;
 896
 897     my ($total, $acctlines) = GetMemberAccountRecords($borrowernumber);
 898     my $other_charges = 0;
 899     foreach (@$acctlines) {
 900         $other_charges += $_->{amountoutstanding} if $not_fine{ substr($_->{accounttype}, 0, $ACCOUNT_TYPE_LENGTH) };
 901     }
 902
 903     return ( $total, $total - $other_charges, $other_charges);
 904 }
 905
 906 =head2 GetBorNotifyAcctRecord
 907
 908   ($total, $acctlines, $count) = &GetBorNotifyAcctRecord($params,$notifyid);
 909
 910 Looks up accounting data for the patron with the given borrowernumber per file number.
 911
 912 C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a
 913 reference-to-array, where each element is a reference-to-hash; the
 914 keys are the fields of the C<accountlines> table in the Koha database.
 915 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
 916 total amount outstanding for all of the account lines.
 917
 918 =cut
 919
 920 sub GetBorNotifyAcctRecord {
 921     my ( $borrowernumber, $notifyid ) = @_;
 922     my $dbh = C4::Context->dbh;
 923     my @acctlines;
 924     my $numlines = 0;
 925     my $sth = $dbh->prepare(
 926             "SELECT *
 927                 FROM accountlines
 928                 WHERE borrowernumber=?
 929                     AND notify_id=?
 930                     AND amountoutstanding != '0'
 931                 ORDER BY notify_id,accounttype
 932                 ");
 933
 934     $sth->execute( $borrowernumber, $notifyid );
 935     my $total = 0;
 936     while ( my $data = $sth->fetchrow_hashref ) {
 937         if ( $data->{itemnumber} ) {
 938             my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
 939             $data->{biblionumber} = $biblio->{biblionumber};
 940             $data->{title}        = $biblio->{title};
 941         }
 942         $acctlines[$numlines] = $data;
 943         $numlines++;
 944         $total += int(100 * $data->{'amountoutstanding'});
 945     }
 946     $total /= 100;
 947     return ( $total, \@acctlines, $numlines );
 948 }
 949
 950 sub checkcardnumber {
 951     my ( $cardnumber, $borrowernumber ) = @_;
 952
 953     # If cardnumber is null, we assume they're allowed.
 954     return 0 unless defined $cardnumber;
 955
 956     my $dbh = C4::Context->dbh;
 957     my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
 958     $query .= " AND borrowernumber <> ?" if ($borrowernumber);
 959     my $sth = $dbh->prepare($query);
 960     $sth->execute(
 961         $cardnumber,
 962         ( $borrowernumber ? $borrowernumber : () )
 963     );
 964
 965     return 1 if $sth->fetchrow_hashref;
 966
 967     my ( $min_length, $max_length ) = get_cardnumber_length();
 968     return 2
 969         if length $cardnumber > $max_length
 970         or length $cardnumber < $min_length;
 971
 972     return 0;
 973 }
 974
 975 =head2 get_cardnumber_length
 976
 977     my ($min, $max) = C4::Members::get_cardnumber_length()
 978
 979 Returns the minimum and maximum length for patron cardnumbers as
 980 determined by the CardnumberLength system preference, the
 981 BorrowerMandatoryField system preference, and the width of the
 982 database column.
 983
 984 =cut
 985
 986 sub get_cardnumber_length {
 987     my ( $min, $max ) = ( 0, 16 ); # borrowers.cardnumber is a nullable varchar(16)
 988     $min = 1 if C4::Context->preference('BorrowerMandatoryField') =~ /cardnumber/;
 989     if ( my $cardnumber_length = C4::Context->preference('CardnumberLength') ) {
 990         # Is integer and length match
 991         if ( $cardnumber_length =~ m|^\d+$| ) {
 992             $min = $max = $cardnumber_length
 993                 if $cardnumber_length >= $min
 994                     and $cardnumber_length <= $max;
 995         }
 996         # Else assuming it is a range
 997         elsif ( $cardnumber_length =~ m|(\d*),(\d*)| ) {
 998             $min = $1 if $1 and $min < $1;
 999             $max = $2 if $2 and $max > $2;
1000         }
1001
1002     }
1003     my $borrower = Koha::Schema->resultset('Borrower');
1004     my $field_size = $borrower->result_source->column_info('cardnumber')->{size};
1005     $min = $field_size if $min > $field_size;
1006     return ( $min, $max );
1007 }
1008
1009 =head2 GetFirstValidEmailAddress
1010
1011   $email = GetFirstValidEmailAddress($borrowernumber);
1012
1013 Return the first valid email address for a borrower, given the borrowernumber.  For now, the order
1014 is defined as email, emailpro, B_email.  Returns the empty string if the borrower has no email
1015 addresses.
1016
1017 =cut
1018
1019 sub GetFirstValidEmailAddress {
1020     my $borrowernumber = shift;
1021     my $dbh = C4::Context->dbh;
1022     my $sth = $dbh->prepare( "SELECT email, emailpro, B_email FROM borrowers where borrowernumber = ? ");
1023     $sth->execute( $borrowernumber );
1024     my $data = $sth->fetchrow_hashref;
1025
1026     if ($data->{'email'}) {
1027        return $data->{'email'};
1028     } elsif ($data->{'emailpro'}) {
1029        return $data->{'emailpro'};
1030     } elsif ($data->{'B_email'}) {
1031        return $data->{'B_email'};
1032     } else {
1033        return '';
1034     }
1035 }
1036
1037 =head2 GetNoticeEmailAddress
1038
1039   $email = GetNoticeEmailAddress($borrowernumber);
1040
1041 Return the email address of borrower used for notices, given the borrowernumber.
1042 Returns the empty string if no email address.
1043
1044 =cut
1045
1046 sub GetNoticeEmailAddress {
1047     my $borrowernumber = shift;
1048
1049     my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
1050     # if syspref is set to 'first valid' (value == OFF), look up email address
1051     if ( $which_address eq 'OFF' ) {
1052         return GetFirstValidEmailAddress($borrowernumber);
1053     }
1054     # specified email address field
1055     my $dbh = C4::Context->dbh;
1056     my $sth = $dbh->prepare( qq{
1057         SELECT $which_address AS primaryemail
1058         FROM borrowers
1059         WHERE borrowernumber=?
1060     } );
1061     $sth->execute($borrowernumber);
1062     my $data = $sth->fetchrow_hashref;
1063     return $data->{'primaryemail'} || '';
1064 }
1065
1066 =head2 GetBorrowersToExpunge
1067
1068   $borrowers = &GetBorrowersToExpunge(
1069       not_borrowed_since => $not_borrowed_since,
1070       expired_before       => $expired_before,
1071       category_code        => $category_code,
1072       patron_list_id       => $patron_list_id,
1073       branchcode           => $branchcode
1074   );
1075
1076   This function get all borrowers based on the given criteria.
1077
1078 =cut
1079
1080 sub GetBorrowersToExpunge {
1081
1082     my $params = shift;
1083     my $filterdate       = $params->{'not_borrowed_since'};
1084     my $filterexpiry     = $params->{'expired_before'};
1085     my $filterlastseen   = $params->{'last_seen'};
1086     my $filtercategory   = $params->{'category_code'};
1087     my $filterbranch     = $params->{'branchcode'} ||
1088                         ((C4::Context->preference('IndependentBranches')
1089                              && C4::Context->userenv
1090                              && !C4::Context->IsSuperLibrarian()
1091                              && C4::Context->userenv->{branch})
1092                          ? C4::Context->userenv->{branch}
1093                          : "");
1094     my $filterpatronlist = $params->{'patron_list_id'};
1095
1096     my $dbh   = C4::Context->dbh;
1097     my $query = q|
1098         SELECT borrowers.borrowernumber,
1099                MAX(old_issues.timestamp) AS latestissue,
1100                MAX(issues.timestamp) AS currentissue
1101         FROM   borrowers
1102         JOIN   categories USING (categorycode)
1103         LEFT JOIN (
1104             SELECT guarantorid
1105             FROM borrowers
1106             WHERE guarantorid IS NOT NULL
1107                 AND guarantorid <> 0
1108         ) as tmp ON borrowers.borrowernumber=tmp.guarantorid
1109         LEFT JOIN old_issues USING (borrowernumber)
1110         LEFT JOIN issues USING (borrowernumber)|;
1111     if ( $filterpatronlist  ){
1112         $query .= q| LEFT JOIN patron_list_patrons USING (borrowernumber)|;
1113     }
1114     $query .= q| WHERE  category_type <> 'S'
1115         AND tmp.guarantorid IS NULL
1116    |;
1117     my @query_params;
1118     if ( $filterbranch && $filterbranch ne "" ) {
1119         $query.= " AND borrowers.branchcode = ? ";
1120         push( @query_params, $filterbranch );
1121     }
1122     if ( $filterexpiry ) {
1123         $query .= " AND dateexpiry < ? ";
1124         push( @query_params, $filterexpiry );
1125     }
1126     if ( $filterlastseen ) {
1127         $query .= ' AND lastseen < ? ';
1128         push @query_params, $filterlastseen;
1129     }
1130     if ( $filtercategory ) {
1131         $query .= " AND categorycode = ? ";
1132         push( @query_params, $filtercategory );
1133     }
1134     if ( $filterpatronlist ){
1135         $query.=" AND patron_list_id = ? ";
1136         push( @query_params, $filterpatronlist );
1137     }
1138     $query.=" GROUP BY borrowers.borrowernumber HAVING currentissue IS NULL ";
1139     if ( $filterdate ) {
1140         $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
1141         push @query_params,$filterdate;
1142     }
1143     warn $query if $debug;
1144
1145     my $sth = $dbh->prepare($query);
1146     if (scalar(@query_params)>0){
1147         $sth->execute(@query_params);
1148     }
1149     else {
1150         $sth->execute;
1151     }
1152
1153     my @results;
1154     while ( my $data = $sth->fetchrow_hashref ) {
1155         push @results, $data;
1156     }
1157     return \@results;
1158 }
1159
1160 =head2 GetBorrowersWhoHaveNeverBorrowed
1161
1162   $results = &GetBorrowersWhoHaveNeverBorrowed
1163
1164 This function get all borrowers who have never borrowed.
1165
1166 I<$result> is a ref to an array which all elements are a hasref.
1167
1168 =cut
1169
1170 sub GetBorrowersWhoHaveNeverBorrowed {
1171     my $filterbranch = shift ||
1172                         ((C4::Context->preference('IndependentBranches')
1173                              && C4::Context->userenv
1174                              && !C4::Context->IsSuperLibrarian()
1175                              && C4::Context->userenv->{branch})
1176                          ? C4::Context->userenv->{branch}
1177                          : "");
1178     my $dbh   = C4::Context->dbh;
1179     my $query = "
1180         SELECT borrowers.borrowernumber,max(timestamp) as latestissue
1181         FROM   borrowers
1182           LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
1183         WHERE issues.borrowernumber IS NULL
1184    ";
1185     my @query_params;
1186     if ($filterbranch && $filterbranch ne ""){
1187         $query.=" AND borrowers.branchcode= ?";
1188         push @query_params,$filterbranch;
1189     }
1190     warn $query if $debug;
1191
1192     my $sth = $dbh->prepare($query);
1193     if (scalar(@query_params)>0){
1194         $sth->execute(@query_params);
1195     }
1196     else {
1197         $sth->execute;
1198     }
1199
1200     my @results;
1201     while ( my $data = $sth->fetchrow_hashref ) {
1202         push @results, $data;
1203     }
1204     return \@results;
1205 }
1206
1207 =head2 GetBorrowersWithIssuesHistoryOlderThan
1208
1209   $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
1210
1211 this function get all borrowers who has an issue history older than I<$date> given on input arg.
1212
1213 I<$result> is a ref to an array which all elements are a hashref.
1214 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
1215
1216 =cut
1217
1218 sub GetBorrowersWithIssuesHistoryOlderThan {
1219     my $dbh  = C4::Context->dbh;
1220     my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
1221     my $filterbranch = shift ||
1222                         ((C4::Context->preference('IndependentBranches')
1223                              && C4::Context->userenv
1224                              && !C4::Context->IsSuperLibrarian()
1225                              && C4::Context->userenv->{branch})
1226                          ? C4::Context->userenv->{branch}
1227                          : "");
1228     my $query = "
1229        SELECT count(borrowernumber) as n,borrowernumber
1230        FROM old_issues
1231        WHERE returndate < ?
1232          AND borrowernumber IS NOT NULL
1233     ";
1234     my @query_params;
1235     push @query_params, $date;
1236     if ($filterbranch){
1237         $query.="   AND branchcode = ?";
1238         push @query_params, $filterbranch;
1239     }
1240     $query.=" GROUP BY borrowernumber ";
1241     warn $query if $debug;
1242     my $sth = $dbh->prepare($query);
1243     $sth->execute(@query_params);
1244     my @results;
1245
1246     while ( my $data = $sth->fetchrow_hashref ) {
1247         push @results, $data;
1248     }
1249     return \@results;
1250 }
1251
1252 =head2 IssueSlip
1253
1254   IssueSlip($branchcode, $borrowernumber, $quickslip)
1255
1256   Returns letter hash ( see C4::Letters::GetPreparedLetter )
1257
1258   $quickslip is boolean, to indicate whether we want a quick slip
1259
1260   IssueSlip populates ISSUESLIP and ISSUEQSLIP, and will make the following expansions:
1261
1262   Both slips:
1263
1264       <<branches.*>>
1265       <<borrowers.*>>
1266
1267   ISSUESLIP:
1268
1269       <checkedout>
1270          <<biblio.*>>
1271          <<items.*>>
1272          <<biblioitems.*>>
1273          <<issues.*>>
1274       </checkedout>
1275
1276       <overdue>
1277          <<biblio.*>>
1278          <<items.*>>
1279          <<biblioitems.*>>
1280          <<issues.*>>
1281       </overdue>
1282
1283       <news>
1284          <<opac_news.*>>
1285       </news>
1286
1287   ISSUEQSLIP:
1288
1289       <checkedout>
1290          <<biblio.*>>
1291          <<items.*>>
1292          <<biblioitems.*>>
1293          <<issues.*>>
1294       </checkedout>
1295
1296   NOTE: Not all table fields are available, pleasee see GetPendingIssues for a list of available fields.
1297
1298 =cut
1299
1300 sub IssueSlip {
1301     my ($branch, $borrowernumber, $quickslip) = @_;
1302
1303     # FIXME Check callers before removing this statement
1304     #return unless $borrowernumber;
1305
1306     my @issues = @{ GetPendingIssues($borrowernumber) };
1307
1308     for my $issue (@issues) {
1309         $issue->{date_due} = $issue->{date_due_sql};
1310         if ($quickslip) {
1311             my $today = output_pref({ dt => dt_from_string, dateformat => 'iso', dateonly => 1 });
1312             if ( substr( $issue->{issuedate}, 0, 10 ) eq $today
1313                 or substr( $issue->{lastreneweddate}, 0, 10 ) eq $today ) {
1314                   $issue->{now} = 1;
1315             };
1316         }
1317     }
1318
1319     # Sort on timestamp then on issuedate (useful for tests and could be if modified in a batch
1320     @issues = sort {
1321         my $s = $b->{timestamp} <=> $a->{timestamp};
1322         $s == 0 ?
1323              $b->{issuedate} <=> $a->{issuedate} : $s;
1324     } @issues;
1325
1326     my ($letter_code, %repeat);
1327     if ( $quickslip ) {
1328         $letter_code = 'ISSUEQSLIP';
1329         %repeat =  (
1330             'checkedout' => [ map {
1331                 'biblio'       => $_,
1332                 'items'        => $_,
1333                 'biblioitems'  => $_,
1334                 'issues'       => $_,
1335             }, grep { $_->{'now'} } @issues ],
1336         );
1337     }
1338     else {
1339         $letter_code = 'ISSUESLIP';
1340         %repeat =  (
1341             'checkedout' => [ map {
1342                 'biblio'       => $_,
1343                 'items'        => $_,
1344                 'biblioitems'  => $_,
1345                 'issues'       => $_,
1346             }, grep { !$_->{'overdue'} } @issues ],
1347
1348             'overdue' => [ map {
1349                 'biblio'       => $_,
1350                 'items'        => $_,
1351                 'biblioitems'  => $_,
1352                 'issues'       => $_,
1353             }, grep { $_->{'overdue'} } @issues ],
1354
1355             'news' => [ map {
1356                 $_->{'timestamp'} = $_->{'newdate'};
1357                 { opac_news => $_ }
1358             } @{ GetNewsToDisplay("slip",$branch) } ],
1359         );
1360     }
1361
1362     return  C4::Letters::GetPreparedLetter (
1363         module => 'circulation',
1364         letter_code => $letter_code,
1365         branchcode => $branch,
1366         tables => {
1367             'branches'    => $branch,
1368             'borrowers'   => $borrowernumber,
1369         },
1370         repeat => \%repeat,
1371     );
1372 }
1373
1374 =head2 GetBorrowersWithEmail
1375
1376     ([$borrnum,$userid], ...) = GetBorrowersWithEmail('me@example.com');
1377
1378 This gets a list of users and their basic details from their email address.
1379 As it's possible for multiple user to have the same email address, it provides
1380 you with all of them. If there is no userid for the user, there will be an
1381 C<undef> there. An empty list will be returned if there are no matches.
1382
1383 =cut
1384
1385 sub GetBorrowersWithEmail {
1386     my $email = shift;
1387
1388     my $dbh = C4::Context->dbh;
1389
1390     my $query = "SELECT borrowernumber, userid FROM borrowers WHERE email=?";
1391     my $sth=$dbh->prepare($query);
1392     $sth->execute($email);
1393     my @result = ();
1394     while (my $ref = $sth->fetch) {
1395         push @result, $ref;
1396     }
1397     die "Failure searching for borrowers by email address: $sth->errstr" if $sth->err;
1398     return @result;
1399 }
1400
1401 =head2 AddMember_Opac
1402
1403 =cut
1404
1405 sub AddMember_Opac {
1406     my ( %borrower ) = @_;
1407
1408     $borrower{'categorycode'} //= C4::Context->preference('PatronSelfRegistrationDefaultCategory');
1409     if (not defined $borrower{'password'}){
1410         my $sr = new String::Random;
1411         $sr->{'A'} = [ 'A'..'Z', 'a'..'z' ];
1412         my $password = $sr->randpattern("AAAAAAAAAA");
1413         $borrower{'password'} = $password;
1414     }
1415
1416     $borrower{'cardnumber'} = fixup_cardnumber( $borrower{'cardnumber'} );
1417
1418     my $borrowernumber = AddMember(%borrower);
1419
1420     return ( $borrowernumber, $borrower{'password'} );
1421 }
1422
1423 =head2 DeleteExpiredOpacRegistrations
1424
1425     Delete accounts that haven't been upgraded from the 'temporary' category
1426     Returns the number of removed patrons
1427
1428 =cut
1429
1430 sub DeleteExpiredOpacRegistrations {
1431
1432     my $delay = C4::Context->preference('PatronSelfRegistrationExpireTemporaryAccountsDelay');
1433     my $category_code = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
1434
1435     return 0 if not $category_code or not defined $delay or $delay eq q||;
1436
1437     my $query = qq|
1438 SELECT borrowernumber
1439 FROM borrowers
1440 WHERE categorycode = ? AND DATEDIFF( NOW(), dateenrolled ) > ? |;
1441
1442     my $dbh = C4::Context->dbh;
1443     my $sth = $dbh->prepare($query);
1444     $sth->execute( $category_code, $delay );
1445     my $cnt=0;
1446     while ( my ($borrowernumber) = $sth->fetchrow_array() ) {
1447         Koha::Patrons->find($borrowernumber)->delete;
1448         $cnt++;
1449     }
1450     return $cnt;
1451 }
1452
1453 =head2 DeleteUnverifiedOpacRegistrations
1454
1455     Delete all unverified self registrations in borrower_modifications,
1456     older than the specified number of days.
1457
1458 =cut
1459
1460 sub DeleteUnverifiedOpacRegistrations {
1461     my ( $days ) = @_;
1462     my $dbh = C4::Context->dbh;
1463     my $sql=qq|
1464 DELETE FROM borrower_modifications
1465 WHERE borrowernumber = 0 AND DATEDIFF( NOW(), timestamp ) > ?|;
1466     my $cnt=$dbh->do($sql, undef, ($days) );
1467     return $cnt eq '0E0'? 0: $cnt;
1468 }
1469
1470 sub GetOverduesForPatron {
1471     my ( $borrowernumber ) = @_;
1472
1473     my $sql = "
1474         SELECT *
1475         FROM issues, items, biblio, biblioitems
1476         WHERE items.itemnumber=issues.itemnumber
1477           AND biblio.biblionumber   = items.biblionumber
1478           AND biblio.biblionumber   = biblioitems.biblionumber
1479           AND issues.borrowernumber = ?
1480           AND date_due < NOW()
1481     ";
1482
1483     my $sth = C4::Context->dbh->prepare( $sql );
1484     $sth->execute( $borrowernumber );
1485
1486     return $sth->fetchall_arrayref({});
1487 }
1488
1489 END { }    # module clean-up code here (global destructor)
1490
1491 1;
1492
1493 __END__
1494
1495 =head1 AUTHOR
1496
1497 Koha Team
1498
1499 =cut