C4/Members.pm

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