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