C4/Members.pm

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