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