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