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