C4/Members.pm

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