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