C4/Members.pm

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