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     my @columns = $schema->source('Borrower')->columns;
 634     my $new_member = { map { join(' ',@columns) =~ /$_/ ? ( $_ => $data{$_} )  : () } keys(%data) } ;
 635     $new_member->{checkprevcheckout} ||= 'inherit';
 636     delete $new_member->{borrowernumber};
 637
 638     my $rs = $schema->resultset('Borrower');
 639     $data{borrowernumber} = $rs->create($new_member)->id;
 640
 641     # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
 642     # cronjob will use for syncing with NL
 643     if ( exists $data{'borrowernumber'} && C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
 644         Koha::Database->new->schema->resultset('BorrowerSync')->create({
 645             'borrowernumber' => $data{'borrowernumber'},
 646             'synctype'       => 'norwegianpatrondb',
 647             'sync'           => 1,
 648             'syncstatus'     => 'new',
 649             'hashed_pin'     => Koha::NorwegianPatronDB::NLEncryptPIN( $plain_text_password ),
 650         });
 651     }
 652
 653     # mysql_insertid is probably bad.  not necessarily accurate and mysql-specific at best.
 654     logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
 655
 656     AddEnrolmentFeeIfNeeded( $data{categorycode}, $data{borrowernumber} );
 657
 658     return $data{borrowernumber};
 659 }
 660
 661 =head2 Check_Userid
 662
 663     my $uniqueness = Check_Userid($userid,$borrowernumber);
 664
 665     $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 != '').
 666
 667     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.
 668
 669     return :
 670         0 for not unique (i.e. this $userid already exists)
 671         1 for unique (i.e. this $userid does not exist, or this $userid/$borrowernumber combination already exists)
 672
 673 =cut
 674
 675 sub Check_Userid {
 676     my ( $uid, $borrowernumber ) = @_;
 677
 678     return 0 unless ($uid); # userid is a unique column, we should assume NULL is not unique
 679
 680     return 0 if ( $uid eq C4::Context->config('user') );
 681
 682     my $rs = Koha::Database->new()->schema()->resultset('Borrower');
 683
 684     my $params;
 685     $params->{userid} = $uid;
 686     $params->{borrowernumber} = { '!=' => $borrowernumber } if ($borrowernumber);
 687
 688     my $count = $rs->count( $params );
 689
 690     return $count ? 0 : 1;
 691 }
 692
 693 =head2 Generate_Userid
 694
 695     my $newuid = Generate_Userid($borrowernumber, $firstname, $surname);
 696
 697     Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
 698
 699     $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.
 700
 701     return :
 702         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).
 703
 704 =cut
 705
 706 sub Generate_Userid {
 707   my ($borrowernumber, $firstname, $surname) = @_;
 708   my $newuid;
 709   my $offset = 0;
 710   #The script will "do" the following code and increment the $offset until Check_Userid = 1 (i.e. until $newuid comes back as unique)
 711   do {
 712     $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
 713     $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
 714     $newuid = lc(($firstname)? "$firstname.$surname" : $surname);
 715     $newuid = unac_string('utf-8',$newuid);
 716     $newuid .= $offset unless $offset == 0;
 717     $offset++;
 718
 719    } while (!Check_Userid($newuid,$borrowernumber));
 720
 721    return $newuid;
 722 }
 723
 724 =head2 fixup_cardnumber
 725
 726 Warning: The caller is responsible for locking the members table in write
 727 mode, to avoid database corruption.
 728
 729 =cut
 730
 731 use vars qw( @weightings );
 732 my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
 733
 734 sub fixup_cardnumber {
 735     my ($cardnumber) = @_;
 736     my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;
 737
 738     # Find out whether member numbers should be generated
 739     # automatically. Should be either "1" or something else.
 740     # Defaults to "0", which is interpreted as "no".
 741
 742     #     if ($cardnumber !~ /\S/ && $autonumber_members) {
 743     ($autonumber_members) or return $cardnumber;
 744     my $checkdigit = C4::Context->preference('checkdigit');
 745     my $dbh = C4::Context->dbh;
 746     if ( $checkdigit and $checkdigit eq 'katipo' ) {
 747
 748         # if checkdigit is selected, calculate katipo-style cardnumber.
 749         # otherwise, just use the max()
 750         # purpose: generate checksum'd member numbers.
 751         # We'll assume we just got the max value of digits 2-8 of member #'s
 752         # from the database and our job is to increment that by one,
 753         # determine the 1st and 9th digits and return the full string.
 754         my $sth = $dbh->prepare(
 755             "select max(substring(borrowers.cardnumber,2,7)) as new_num from borrowers"
 756         );
 757         $sth->execute;
 758         my $data = $sth->fetchrow_hashref;
 759         $cardnumber = $data->{new_num};
 760         if ( !$cardnumber ) {    # If DB has no values,
 761             $cardnumber = 1000000;    # start at 1000000
 762         } else {
 763             $cardnumber += 1;
 764         }
 765
 766         my $sum = 0;
 767         for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
 768             # read weightings, left to right, 1 char at a time
 769             my $temp1 = $weightings[$i];
 770
 771             # sequence left to right, 1 char at a time
 772             my $temp2 = substr( $cardnumber, $i, 1 );
 773
 774             # mult each char 1-7 by its corresponding weighting
 775             $sum += $temp1 * $temp2;
 776         }
 777
 778         my $rem = ( $sum % 11 );
 779         $rem = 'X' if $rem == 10;
 780
 781         return "V$cardnumber$rem";
 782      } else {
 783
 784         my $sth = $dbh->prepare(
 785             'SELECT MAX( CAST( cardnumber AS SIGNED ) ) FROM borrowers WHERE cardnumber REGEXP "^-?[0-9]+$"'
 786         );
 787         $sth->execute;
 788         my ($result) = $sth->fetchrow;
 789         return $result + 1;
 790     }
 791     return $cardnumber;     # just here as a fallback/reminder
 792 }
 793
 794 =head2 GetPendingIssues
 795
 796   my $issues = &GetPendingIssues(@borrowernumber);
 797
 798 Looks up what the patron with the given borrowernumber has borrowed.
 799
 800 C<&GetPendingIssues> returns a
 801 reference-to-array where each element is a reference-to-hash; the
 802 keys are the fields from the C<issues>, C<biblio>, and C<items> tables.
 803 The keys include C<biblioitems> fields except marc and marcxml.
 804
 805 =cut
 806
 807 sub GetPendingIssues {
 808     my @borrowernumbers = @_;
 809
 810     unless (@borrowernumbers ) { # return a ref_to_array
 811         return \@borrowernumbers; # to not cause surprise to caller
 812     }
 813
 814     # Borrowers part of the query
 815     my $bquery = '';
 816     for (my $i = 0; $i < @borrowernumbers; $i++) {
 817         $bquery .= ' issues.borrowernumber = ?';
 818         if ($i < $#borrowernumbers ) {
 819             $bquery .= ' OR';
 820         }
 821     }
 822
 823     # must avoid biblioitems.* to prevent large marc and marcxml fields from killing performance
 824     # FIXME: namespace collision: each table has "timestamp" fields.  Which one is "timestamp" ?
 825     # FIXME: circ/ciculation.pl tries to sort by timestamp!
 826     # FIXME: namespace collision: other collisions possible.
 827     # FIXME: most of this data isn't really being used by callers.
 828     my $query =
 829    "SELECT issues.*,
 830             items.*,
 831            biblio.*,
 832            biblioitems.volume,
 833            biblioitems.number,
 834            biblioitems.itemtype,
 835            biblioitems.isbn,
 836            biblioitems.issn,
 837            biblioitems.publicationyear,
 838            biblioitems.publishercode,
 839            biblioitems.volumedate,
 840            biblioitems.volumedesc,
 841            biblioitems.lccn,
 842            biblioitems.url,
 843            borrowers.firstname,
 844            borrowers.surname,
 845            borrowers.cardnumber,
 846            issues.timestamp AS timestamp,
 847            issues.renewals  AS renewals,
 848            issues.borrowernumber AS borrowernumber,
 849             items.renewals  AS totalrenewals
 850     FROM   issues
 851     LEFT JOIN items       ON items.itemnumber       =      issues.itemnumber
 852     LEFT JOIN biblio      ON items.biblionumber     =      biblio.biblionumber
 853     LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
 854     LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
 855     WHERE
 856       $bquery
 857     ORDER BY issues.issuedate"
 858     ;
 859
 860     my $sth = C4::Context->dbh->prepare($query);
 861     $sth->execute(@borrowernumbers);
 862     my $data = $sth->fetchall_arrayref({});
 863     my $today = dt_from_string;
 864     foreach (@{$data}) {
 865         if ($_->{issuedate}) {
 866             $_->{issuedate} = dt_from_string($_->{issuedate}, 'sql');
 867         }
 868         $_->{date_due_sql} = $_->{date_due};
 869         # FIXME no need to have this value
 870         $_->{date_due} or next;
 871         $_->{date_due_sql} = $_->{date_due};
 872         # FIXME no need to have this value
 873         $_->{date_due} = dt_from_string($_->{date_due}, 'sql');
 874         if ( DateTime->compare($_->{date_due}, $today) == -1 ) {
 875             $_->{overdue} = 1;
 876         }
 877     }
 878     return $data;
 879 }
 880
 881 =head2 GetAllIssues
 882
 883   $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
 884
 885 Looks up what the patron with the given borrowernumber has borrowed,
 886 and sorts the results.
 887
 888 C<$sortkey> is the name of a field on which to sort the results. This
 889 should be the name of a field in the C<issues>, C<biblio>,
 890 C<biblioitems>, or C<items> table in the Koha database.
 891
 892 C<$limit> is the maximum number of results to return.
 893
 894 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
 895 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
 896 C<items> tables of the Koha database.
 897
 898 =cut
 899
 900 #'
 901 sub GetAllIssues {
 902     my ( $borrowernumber, $order, $limit ) = @_;
 903
 904     return unless $borrowernumber;
 905     $order = 'date_due desc' unless $order;
 906
 907     my $dbh = C4::Context->dbh;
 908     my $query =
 909 'SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
 910   FROM issues
 911   LEFT JOIN items on items.itemnumber=issues.itemnumber
 912   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
 913   LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
 914   WHERE borrowernumber=?
 915   UNION ALL
 916   SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
 917   FROM old_issues
 918   LEFT JOIN items on items.itemnumber=old_issues.itemnumber
 919   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
 920   LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
 921   WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL
 922   order by ' . $order;
 923     if ($limit) {
 924         $query .= " limit $limit";
 925     }
 926
 927     my $sth = $dbh->prepare($query);
 928     $sth->execute( $borrowernumber, $borrowernumber );
 929     return $sth->fetchall_arrayref( {} );
 930 }
 931
 932
 933 =head2 GetMemberAccountRecords
 934
 935   ($total, $acctlines, $count) = &GetMemberAccountRecords($borrowernumber);
 936
 937 Looks up accounting data for the patron with the given borrowernumber.
 938
 939 C<&GetMemberAccountRecords> returns a three-element array. C<$acctlines> is a
 940 reference-to-array, where each element is a reference-to-hash; the
 941 keys are the fields of the C<accountlines> table in the Koha database.
 942 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
 943 total amount outstanding for all of the account lines.
 944
 945 =cut
 946
 947 sub GetMemberAccountRecords {
 948     my ($borrowernumber) = @_;
 949     my $dbh = C4::Context->dbh;
 950     my @acctlines;
 951     my $numlines = 0;
 952     my $strsth      = qq(
 953                         SELECT *
 954                         FROM accountlines
 955                         WHERE borrowernumber=?);
 956     $strsth.=" ORDER BY accountlines_id desc";
 957     my $sth= $dbh->prepare( $strsth );
 958     $sth->execute( $borrowernumber );
 959
 960     my $total = 0;
 961     while ( my $data = $sth->fetchrow_hashref ) {
 962         if ( $data->{itemnumber} ) {
 963             my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
 964             $data->{biblionumber} = $biblio->{biblionumber};
 965             $data->{title}        = $biblio->{title};
 966         }
 967         $acctlines[$numlines] = $data;
 968         $numlines++;
 969         $total += sprintf "%.0f", 1000*$data->{amountoutstanding}; # convert float to integer to avoid round-off errors
 970     }
 971     $total /= 1000;
 972     return ( $total, \@acctlines,$numlines);
 973 }
 974
 975 =head2 GetMemberAccountBalance
 976
 977   ($total_balance, $non_issue_balance, $other_charges) = &GetMemberAccountBalance($borrowernumber);
 978
 979 Calculates amount immediately owing by the patron - non-issue charges.
 980 Based on GetMemberAccountRecords.
 981 Charges exempt from non-issue are:
 982 * Res (reserves)
 983 * Rent (rental) if RentalsInNoissuesCharge syspref is set to false
 984 * Manual invoices if ManInvInNoissuesCharge syspref is set to false
 985
 986 =cut
 987
 988 sub GetMemberAccountBalance {
 989     my ($borrowernumber) = @_;
 990
 991     my $ACCOUNT_TYPE_LENGTH = 5; # this is plain ridiculous...
 992
 993     my @not_fines;
 994     push @not_fines, 'Res' unless C4::Context->preference('HoldsInNoissuesCharge');
 995     push @not_fines, 'Rent' unless C4::Context->preference('RentalsInNoissuesCharge');
 996     unless ( C4::Context->preference('ManInvInNoissuesCharge') ) {
 997         my $dbh = C4::Context->dbh;
 998         my $man_inv_types = $dbh->selectcol_arrayref(qq{SELECT authorised_value FROM authorised_values WHERE category = 'MANUAL_INV'});
 999         push @not_fines, map substr($_, 0, $ACCOUNT_TYPE_LENGTH), @$man_inv_types;
1000     }
1001     my %not_fine = map {$_ => 1} @not_fines;
1002
1003     my ($total, $acctlines) = GetMemberAccountRecords($borrowernumber);
1004     my $other_charges = 0;
1005     foreach (@$acctlines) {
1006         $other_charges += $_->{amountoutstanding} if $not_fine{ substr($_->{accounttype}, 0, $ACCOUNT_TYPE_LENGTH) };
1007     }
1008
1009     return ( $total, $total - $other_charges, $other_charges);
1010 }
1011
1012 =head2 GetBorNotifyAcctRecord
1013
1014   ($total, $acctlines, $count) = &GetBorNotifyAcctRecord($params,$notifyid);
1015
1016 Looks up accounting data for the patron with the given borrowernumber per file number.
1017
1018 C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a
1019 reference-to-array, where each element is a reference-to-hash; the
1020 keys are the fields of the C<accountlines> table in the Koha database.
1021 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1022 total amount outstanding for all of the account lines.
1023
1024 =cut
1025
1026 sub GetBorNotifyAcctRecord {
1027     my ( $borrowernumber, $notifyid ) = @_;
1028     my $dbh = C4::Context->dbh;
1029     my @acctlines;
1030     my $numlines = 0;
1031     my $sth = $dbh->prepare(
1032             "SELECT *
1033                 FROM accountlines
1034                 WHERE borrowernumber=?
1035                     AND notify_id=?
1036                     AND amountoutstanding != '0'
1037                 ORDER BY notify_id,accounttype
1038                 ");
1039
1040     $sth->execute( $borrowernumber, $notifyid );
1041     my $total = 0;
1042     while ( my $data = $sth->fetchrow_hashref ) {
1043         if ( $data->{itemnumber} ) {
1044             my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
1045             $data->{biblionumber} = $biblio->{biblionumber};
1046             $data->{title}        = $biblio->{title};
1047         }
1048         $acctlines[$numlines] = $data;
1049         $numlines++;
1050         $total += int(100 * $data->{'amountoutstanding'});
1051     }
1052     $total /= 100;
1053     return ( $total, \@acctlines, $numlines );
1054 }
1055
1056 sub checkcardnumber {
1057     my ( $cardnumber, $borrowernumber ) = @_;
1058
1059     # If cardnumber is null, we assume they're allowed.
1060     return 0 unless defined $cardnumber;
1061
1062     my $dbh = C4::Context->dbh;
1063     my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
1064     $query .= " AND borrowernumber <> ?" if ($borrowernumber);
1065     my $sth = $dbh->prepare($query);
1066     $sth->execute(
1067         $cardnumber,
1068         ( $borrowernumber ? $borrowernumber : () )
1069     );
1070
1071     return 1 if $sth->fetchrow_hashref;
1072
1073     my ( $min_length, $max_length ) = get_cardnumber_length();
1074     return 2
1075         if length $cardnumber > $max_length
1076         or length $cardnumber < $min_length;
1077
1078     return 0;
1079 }
1080
1081 =head2 get_cardnumber_length
1082
1083     my ($min, $max) = C4::Members::get_cardnumber_length()
1084
1085 Returns the minimum and maximum length for patron cardnumbers as
1086 determined by the CardnumberLength system preference, the
1087 BorrowerMandatoryField system preference, and the width of the
1088 database column.
1089
1090 =cut
1091
1092 sub get_cardnumber_length {
1093     my ( $min, $max ) = ( 0, 16 ); # borrowers.cardnumber is a nullable varchar(16)
1094     $min = 1 if C4::Context->preference('BorrowerMandatoryField') =~ /cardnumber/;
1095     if ( my $cardnumber_length = C4::Context->preference('CardnumberLength') ) {
1096         # Is integer and length match
1097         if ( $cardnumber_length =~ m|^\d+$| ) {
1098             $min = $max = $cardnumber_length
1099                 if $cardnumber_length >= $min
1100                     and $cardnumber_length <= $max;
1101         }
1102         # Else assuming it is a range
1103         elsif ( $cardnumber_length =~ m|(\d*),(\d*)| ) {
1104             $min = $1 if $1 and $min < $1;
1105             $max = $2 if $2 and $max > $2;
1106         }
1107
1108     }
1109     return ( $min, $max );
1110 }
1111
1112 =head2 GetFirstValidEmailAddress
1113
1114   $email = GetFirstValidEmailAddress($borrowernumber);
1115
1116 Return the first valid email address for a borrower, given the borrowernumber.  For now, the order
1117 is defined as email, emailpro, B_email.  Returns the empty string if the borrower has no email
1118 addresses.
1119
1120 =cut
1121
1122 sub GetFirstValidEmailAddress {
1123     my $borrowernumber = shift;
1124     my $dbh = C4::Context->dbh;
1125     my $sth = $dbh->prepare( "SELECT email, emailpro, B_email FROM borrowers where borrowernumber = ? ");
1126     $sth->execute( $borrowernumber );
1127     my $data = $sth->fetchrow_hashref;
1128
1129     if ($data->{'email'}) {
1130        return $data->{'email'};
1131     } elsif ($data->{'emailpro'}) {
1132        return $data->{'emailpro'};
1133     } elsif ($data->{'B_email'}) {
1134        return $data->{'B_email'};
1135     } else {
1136        return '';
1137     }
1138 }
1139
1140 =head2 GetNoticeEmailAddress
1141
1142   $email = GetNoticeEmailAddress($borrowernumber);
1143
1144 Return the email address of borrower used for notices, given the borrowernumber.
1145 Returns the empty string if no email address.
1146
1147 =cut
1148
1149 sub GetNoticeEmailAddress {
1150     my $borrowernumber = shift;
1151
1152     my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
1153     # if syspref is set to 'first valid' (value == OFF), look up email address
1154     if ( $which_address eq 'OFF' ) {
1155         return GetFirstValidEmailAddress($borrowernumber);
1156     }
1157     # specified email address field
1158     my $dbh = C4::Context->dbh;
1159     my $sth = $dbh->prepare( qq{
1160         SELECT $which_address AS primaryemail
1161         FROM borrowers
1162         WHERE borrowernumber=?
1163     } );
1164     $sth->execute($borrowernumber);
1165     my $data = $sth->fetchrow_hashref;
1166     return $data->{'primaryemail'} || '';
1167 }
1168
1169 =head2 GetUpcomingMembershipExpires
1170
1171     my $expires = GetUpcomingMembershipExpires({
1172         branch => $branch, before => $before, after => $after,
1173     });
1174
1175     $branch is an optional branch code.
1176     $before/$after is an optional number of days before/after the date that
1177     is set by the preference MembershipExpiryDaysNotice.
1178     If the pref would be 14, before 2 and after 3, you will get all expires
1179     from 12 to 17 days.
1180
1181 =cut
1182
1183 sub GetUpcomingMembershipExpires {
1184     my ( $params ) = @_;
1185     my $before = $params->{before} || 0;
1186     my $after  = $params->{after} || 0;
1187     my $branch = $params->{branch};
1188
1189     my $dbh = C4::Context->dbh;
1190     my $days = C4::Context->preference("MembershipExpiryDaysNotice") || 0;
1191     my $date1 = dt_from_string->add( days => $days - $before );
1192     my $date2 = dt_from_string->add( days => $days + $after );
1193     $date1= output_pref({ dt => $date1, dateformat => 'iso', dateonly => 1 });
1194     $date2= output_pref({ dt => $date2, dateformat => 'iso', dateonly => 1 });
1195
1196     my $query = q|
1197         SELECT borrowers.*, categories.description,
1198         branches.branchname, branches.branchemail FROM borrowers
1199         LEFT JOIN branches USING (branchcode)
1200         LEFT JOIN categories USING (categorycode)
1201     |;
1202     if( $branch ) {
1203         $query.= 'WHERE branchcode=? AND dateexpiry BETWEEN ? AND ?';
1204     } else {
1205         $query.= 'WHERE dateexpiry BETWEEN ? AND ?';
1206     }
1207
1208     my $sth = $dbh->prepare( $query );
1209     my @pars = $branch? ( $branch ): ();
1210     push @pars, $date1, $date2;
1211     $sth->execute( @pars );
1212     my $results = $sth->fetchall_arrayref( {} );
1213     return $results;
1214 }
1215
1216 =head2 GetBorrowerCategorycode
1217
1218     $categorycode = &GetBorrowerCategoryCode( $borrowernumber );
1219
1220 Given the borrowernumber, the function returns the corresponding categorycode
1221
1222 =cut
1223
1224 sub GetBorrowerCategorycode {
1225     my ( $borrowernumber ) = @_;
1226     my $dbh = C4::Context->dbh;
1227     my $sth = $dbh->prepare( qq{
1228         SELECT categorycode
1229         FROM borrowers
1230         WHERE borrowernumber = ?
1231     } );
1232     $sth->execute( $borrowernumber );
1233     return $sth->fetchrow;
1234 }
1235
1236 =head2 GetAge
1237
1238   $dateofbirth,$date = &GetAge($date);
1239
1240 this function return the borrowers age with the value of dateofbirth
1241
1242 =cut
1243
1244 #'
1245 sub GetAge{
1246     my ( $date, $date_ref ) = @_;
1247
1248     if ( not defined $date_ref ) {
1249         $date_ref = sprintf( '%04d-%02d-%02d', Today() );
1250     }
1251
1252     my ( $year1, $month1, $day1 ) = split /-/, $date;
1253     my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
1254
1255     my $age = $year2 - $year1;
1256     if ( $month1 . $day1 > $month2 . $day2 ) {
1257         $age--;
1258     }
1259
1260     return $age;
1261 }    # sub get_age
1262
1263 =head2 SetAge
1264
1265   $borrower = C4::Members::SetAge($borrower, $datetimeduration);
1266   $borrower = C4::Members::SetAge($borrower, '0015-12-10');
1267   $borrower = C4::Members::SetAge($borrower, $datetimeduration, $datetime_reference);
1268
1269   eval { $borrower = C4::Members::SetAge($borrower, '015-1-10'); };
1270   if ($@) {print $@;} #Catch a bad ISO Date or kill your script!
1271
1272 This function sets the borrower's dateofbirth to match the given age.
1273 Optionally relative to the given $datetime_reference.
1274
1275 @PARAM1 koha.borrowers-object
1276 @PARAM2 DateTime::Duration-object as the desired age
1277         OR a ISO 8601 Date. (To make the API more pleasant)
1278 @PARAM3 DateTime-object as the relative date, defaults to now().
1279 RETURNS The given borrower reference @PARAM1.
1280 DIES    If there was an error with the ISO Date handling.
1281
1282 =cut
1283
1284 #'
1285 sub SetAge{
1286     my ( $borrower, $datetimeduration, $datetime_ref ) = @_;
1287     $datetime_ref = DateTime->now() unless $datetime_ref;
1288
1289     if ($datetimeduration && ref $datetimeduration ne 'DateTime::Duration') {
1290         if ($datetimeduration =~ /^(\d{4})-(\d{2})-(\d{2})/) {
1291             $datetimeduration = DateTime::Duration->new(years => $1, months => $2, days => $3);
1292         }
1293         else {
1294             die "C4::Members::SetAge($borrower, $datetimeduration), datetimeduration not a valid ISO 8601 Date!\n";
1295         }
1296     }
1297
1298     my $new_datetime_ref = $datetime_ref->clone();
1299     $new_datetime_ref->subtract_duration( $datetimeduration );
1300
1301     $borrower->{dateofbirth} = $new_datetime_ref->ymd();
1302
1303     return $borrower;
1304 }    # sub SetAge
1305
1306 =head2 HandleDelBorrower
1307
1308      HandleDelBorrower($borrower);
1309
1310 When a member is deleted, you should call me first.
1311 This routine deletes/moves lists and entries for the deleted member/borrower.
1312 Lists owned by the borrower are deleted, but entries from the borrower to
1313 other lists are kept.
1314
1315 =cut
1316
1317 sub HandleDelBorrower {
1318     my ($borrower)= @_;
1319     my $query;
1320     my $dbh = C4::Context->dbh;
1321
1322     #Delete all lists and all shares of this borrower
1323     #Consistent with the approach Koha uses on deleting individual lists
1324     #Note that entries in virtualshelfcontents added by this borrower to
1325     #lists of others will be handled by a table constraint: the borrower
1326     #is set to NULL in those entries.
1327     $query="DELETE FROM virtualshelves WHERE owner=?";
1328     $dbh->do($query,undef,($borrower));
1329
1330     #NOTE:
1331     #We could handle the above deletes via a constraint too.
1332     #But a new BZ report 11889 has been opened to discuss another approach.
1333     #Instead of deleting we could also disown lists (based on a pref).
1334     #In that way we could save shared and public lists.
1335     #The current table constraints support that idea now.
1336     #This pref should then govern the results of other routines/methods such as
1337     #Koha::Virtualshelf->new->delete too.
1338 }
1339
1340 =head2 GetHideLostItemsPreference
1341
1342   $hidelostitemspref = &GetHideLostItemsPreference($borrowernumber);
1343
1344 Returns the HideLostItems preference for the patron category of the supplied borrowernumber
1345 C<&$hidelostitemspref>return value of function, 0 or 1
1346
1347 =cut
1348
1349 sub GetHideLostItemsPreference {
1350     my ($borrowernumber) = @_;
1351     my $dbh = C4::Context->dbh;
1352     my $query = "SELECT hidelostitems FROM borrowers,categories WHERE borrowers.categorycode = categories.categorycode AND borrowernumber = ?";
1353     my $sth = $dbh->prepare($query);
1354     $sth->execute($borrowernumber);
1355     my $hidelostitems = $sth->fetchrow;
1356     return $hidelostitems;
1357 }
1358
1359 =head2 GetBorrowersToExpunge
1360
1361   $borrowers = &GetBorrowersToExpunge(
1362       not_borrowed_since => $not_borrowed_since,
1363       expired_before       => $expired_before,
1364       category_code        => $category_code,
1365       patron_list_id       => $patron_list_id,
1366       branchcode           => $branchcode
1367   );
1368
1369   This function get all borrowers based on the given criteria.
1370
1371 =cut
1372
1373 sub GetBorrowersToExpunge {
1374
1375     my $params = shift;
1376     my $filterdate       = $params->{'not_borrowed_since'};
1377     my $filterexpiry     = $params->{'expired_before'};
1378     my $filterlastseen   = $params->{'last_seen'};
1379     my $filtercategory   = $params->{'category_code'};
1380     my $filterbranch     = $params->{'branchcode'} ||
1381                         ((C4::Context->preference('IndependentBranches')
1382                              && C4::Context->userenv
1383                              && !C4::Context->IsSuperLibrarian()
1384                              && C4::Context->userenv->{branch})
1385                          ? C4::Context->userenv->{branch}
1386                          : "");
1387     my $filterpatronlist = $params->{'patron_list_id'};
1388
1389     my $dbh   = C4::Context->dbh;
1390     my $query = q|
1391         SELECT borrowers.borrowernumber,
1392                MAX(old_issues.timestamp) AS latestissue,
1393                MAX(issues.timestamp) AS currentissue
1394         FROM   borrowers
1395         JOIN   categories USING (categorycode)
1396         LEFT JOIN (
1397             SELECT guarantorid
1398             FROM borrowers
1399             WHERE guarantorid IS NOT NULL
1400                 AND guarantorid <> 0
1401         ) as tmp ON borrowers.borrowernumber=tmp.guarantorid
1402         LEFT JOIN old_issues USING (borrowernumber)
1403         LEFT JOIN issues USING (borrowernumber)|;
1404     if ( $filterpatronlist  ){
1405         $query .= q| LEFT JOIN patron_list_patrons USING (borrowernumber)|;
1406     }
1407     $query .= q| WHERE  category_type <> 'S'
1408         AND tmp.guarantorid IS NULL
1409    |;
1410     my @query_params;
1411     if ( $filterbranch && $filterbranch ne "" ) {
1412         $query.= " AND borrowers.branchcode = ? ";
1413         push( @query_params, $filterbranch );
1414     }
1415     if ( $filterexpiry ) {
1416         $query .= " AND dateexpiry < ? ";
1417         push( @query_params, $filterexpiry );
1418     }
1419     if ( $filterlastseen ) {
1420         $query .= ' AND lastseen < ? ';
1421         push @query_params, $filterlastseen;
1422     }
1423     if ( $filtercategory ) {
1424         $query .= " AND categorycode = ? ";
1425         push( @query_params, $filtercategory );
1426     }
1427     if ( $filterpatronlist ){
1428         $query.=" AND patron_list_id = ? ";
1429         push( @query_params, $filterpatronlist );
1430     }
1431     $query.=" GROUP BY borrowers.borrowernumber HAVING currentissue IS NULL ";
1432     if ( $filterdate ) {
1433         $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
1434         push @query_params,$filterdate;
1435     }
1436     warn $query if $debug;
1437
1438     my $sth = $dbh->prepare($query);
1439     if (scalar(@query_params)>0){
1440         $sth->execute(@query_params);
1441     }
1442     else {
1443         $sth->execute;
1444     }
1445
1446     my @results;
1447     while ( my $data = $sth->fetchrow_hashref ) {
1448         push @results, $data;
1449     }
1450     return \@results;
1451 }
1452
1453 =head2 GetBorrowersWhoHaveNeverBorrowed
1454
1455   $results = &GetBorrowersWhoHaveNeverBorrowed
1456
1457 This function get all borrowers who have never borrowed.
1458
1459 I<$result> is a ref to an array which all elements are a hasref.
1460
1461 =cut
1462
1463 sub GetBorrowersWhoHaveNeverBorrowed {
1464     my $filterbranch = shift ||
1465                         ((C4::Context->preference('IndependentBranches')
1466                              && C4::Context->userenv
1467                              && !C4::Context->IsSuperLibrarian()
1468                              && C4::Context->userenv->{branch})
1469                          ? C4::Context->userenv->{branch}
1470                          : "");
1471     my $dbh   = C4::Context->dbh;
1472     my $query = "
1473         SELECT borrowers.borrowernumber,max(timestamp) as latestissue
1474         FROM   borrowers
1475           LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
1476         WHERE issues.borrowernumber IS NULL
1477    ";
1478     my @query_params;
1479     if ($filterbranch && $filterbranch ne ""){
1480         $query.=" AND borrowers.branchcode= ?";
1481         push @query_params,$filterbranch;
1482     }
1483     warn $query if $debug;
1484
1485     my $sth = $dbh->prepare($query);
1486     if (scalar(@query_params)>0){
1487         $sth->execute(@query_params);
1488     }
1489     else {
1490         $sth->execute;
1491     }
1492
1493     my @results;
1494     while ( my $data = $sth->fetchrow_hashref ) {
1495         push @results, $data;
1496     }
1497     return \@results;
1498 }
1499
1500 =head2 GetBorrowersWithIssuesHistoryOlderThan
1501
1502   $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
1503
1504 this function get all borrowers who has an issue history older than I<$date> given on input arg.
1505
1506 I<$result> is a ref to an array which all elements are a hashref.
1507 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
1508
1509 =cut
1510
1511 sub GetBorrowersWithIssuesHistoryOlderThan {
1512     my $dbh  = C4::Context->dbh;
1513     my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
1514     my $filterbranch = shift ||
1515                         ((C4::Context->preference('IndependentBranches')
1516                              && C4::Context->userenv
1517                              && !C4::Context->IsSuperLibrarian()
1518                              && C4::Context->userenv->{branch})
1519                          ? C4::Context->userenv->{branch}
1520                          : "");
1521     my $query = "
1522        SELECT count(borrowernumber) as n,borrowernumber
1523        FROM old_issues
1524        WHERE returndate < ?
1525          AND borrowernumber IS NOT NULL
1526     ";
1527     my @query_params;
1528     push @query_params, $date;
1529     if ($filterbranch){
1530         $query.="   AND branchcode = ?";
1531         push @query_params, $filterbranch;
1532     }
1533     $query.=" GROUP BY borrowernumber ";
1534     warn $query if $debug;
1535     my $sth = $dbh->prepare($query);
1536     $sth->execute(@query_params);
1537     my @results;
1538
1539     while ( my $data = $sth->fetchrow_hashref ) {
1540         push @results, $data;
1541     }
1542     return \@results;
1543 }
1544
1545 =head2 IssueSlip
1546
1547   IssueSlip($branchcode, $borrowernumber, $quickslip)
1548
1549   Returns letter hash ( see C4::Letters::GetPreparedLetter )
1550
1551   $quickslip is boolean, to indicate whether we want a quick slip
1552
1553   IssueSlip populates ISSUESLIP and ISSUEQSLIP, and will make the following expansions:
1554
1555   Both slips:
1556
1557       <<branches.*>>
1558       <<borrowers.*>>
1559
1560   ISSUESLIP:
1561
1562       <checkedout>
1563          <<biblio.*>>
1564          <<items.*>>
1565          <<biblioitems.*>>
1566          <<issues.*>>
1567       </checkedout>
1568
1569       <overdue>
1570          <<biblio.*>>
1571          <<items.*>>
1572          <<biblioitems.*>>
1573          <<issues.*>>
1574       </overdue>
1575
1576       <news>
1577          <<opac_news.*>>
1578       </news>
1579
1580   ISSUEQSLIP:
1581
1582       <checkedout>
1583          <<biblio.*>>
1584          <<items.*>>
1585          <<biblioitems.*>>
1586          <<issues.*>>
1587       </checkedout>
1588
1589   NOTE: Not all table fields are available, pleasee see GetPendingIssues for a list of available fields.
1590
1591 =cut
1592
1593 sub IssueSlip {
1594     my ($branch, $borrowernumber, $quickslip) = @_;
1595
1596     # FIXME Check callers before removing this statement
1597     #return unless $borrowernumber;
1598
1599     my @issues = @{ GetPendingIssues($borrowernumber) };
1600
1601     for my $issue (@issues) {
1602         $issue->{date_due} = $issue->{date_due_sql};
1603         if ($quickslip) {
1604             my $today = output_pref({ dt => dt_from_string, dateformat => 'iso', dateonly => 1 });
1605             if ( substr( $issue->{issuedate}, 0, 10 ) eq $today
1606                 or substr( $issue->{lastreneweddate}, 0, 10 ) eq $today ) {
1607                   $issue->{now} = 1;
1608             };
1609         }
1610     }
1611
1612     # Sort on timestamp then on issuedate (useful for tests and could be if modified in a batch
1613     @issues = sort {
1614         my $s = $b->{timestamp} <=> $a->{timestamp};
1615         $s == 0 ?
1616              $b->{issuedate} <=> $a->{issuedate} : $s;
1617     } @issues;
1618
1619     my ($letter_code, %repeat);
1620     if ( $quickslip ) {
1621         $letter_code = 'ISSUEQSLIP';
1622         %repeat =  (
1623             'checkedout' => [ map {
1624                 'biblio'       => $_,
1625                 'items'        => $_,
1626                 'biblioitems'  => $_,
1627                 'issues'       => $_,
1628             }, grep { $_->{'now'} } @issues ],
1629         );
1630     }
1631     else {
1632         $letter_code = 'ISSUESLIP';
1633         %repeat =  (
1634             'checkedout' => [ map {
1635                 'biblio'       => $_,
1636                 'items'        => $_,
1637                 'biblioitems'  => $_,
1638                 'issues'       => $_,
1639             }, grep { !$_->{'overdue'} } @issues ],
1640
1641             'overdue' => [ map {
1642                 'biblio'       => $_,
1643                 'items'        => $_,
1644                 'biblioitems'  => $_,
1645                 'issues'       => $_,
1646             }, grep { $_->{'overdue'} } @issues ],
1647
1648             'news' => [ map {
1649                 $_->{'timestamp'} = $_->{'newdate'};
1650                 { opac_news => $_ }
1651             } @{ GetNewsToDisplay("slip",$branch) } ],
1652         );
1653     }
1654
1655     return  C4::Letters::GetPreparedLetter (
1656         module => 'circulation',
1657         letter_code => $letter_code,
1658         branchcode => $branch,
1659         tables => {
1660             'branches'    => $branch,
1661             'borrowers'   => $borrowernumber,
1662         },
1663         repeat => \%repeat,
1664     );
1665 }
1666
1667 =head2 GetBorrowersWithEmail
1668
1669     ([$borrnum,$userid], ...) = GetBorrowersWithEmail('me@example.com');
1670
1671 This gets a list of users and their basic details from their email address.
1672 As it's possible for multiple user to have the same email address, it provides
1673 you with all of them. If there is no userid for the user, there will be an
1674 C<undef> there. An empty list will be returned if there are no matches.
1675
1676 =cut
1677
1678 sub GetBorrowersWithEmail {
1679     my $email = shift;
1680
1681     my $dbh = C4::Context->dbh;
1682
1683     my $query = "SELECT borrowernumber, userid FROM borrowers WHERE email=?";
1684     my $sth=$dbh->prepare($query);
1685     $sth->execute($email);
1686     my @result = ();
1687     while (my $ref = $sth->fetch) {
1688         push @result, $ref;
1689     }
1690     die "Failure searching for borrowers by email address: $sth->errstr" if $sth->err;
1691     return @result;
1692 }
1693
1694 =head2 AddMember_Opac
1695
1696 =cut
1697
1698 sub AddMember_Opac {
1699     my ( %borrower ) = @_;
1700
1701     $borrower{'categorycode'} //= C4::Context->preference('PatronSelfRegistrationDefaultCategory');
1702     if (not defined $borrower{'password'}){
1703         my $sr = new String::Random;
1704         $sr->{'A'} = [ 'A'..'Z', 'a'..'z' ];
1705         my $password = $sr->randpattern("AAAAAAAAAA");
1706         $borrower{'password'} = $password;
1707     }
1708
1709     $borrower{'cardnumber'} = fixup_cardnumber( $borrower{'cardnumber'} );
1710
1711     my $borrowernumber = AddMember(%borrower);
1712
1713     return ( $borrowernumber, $borrower{'password'} );
1714 }
1715
1716 =head2 AddEnrolmentFeeIfNeeded
1717
1718     AddEnrolmentFeeIfNeeded( $borrower->{categorycode}, $borrower->{borrowernumber} );
1719
1720 Add enrolment fee for a patron if needed.
1721
1722 =cut
1723
1724 sub AddEnrolmentFeeIfNeeded {
1725     my ( $categorycode, $borrowernumber ) = @_;
1726     # check for enrollment fee & add it if needed
1727     my $dbh = C4::Context->dbh;
1728     my $sth = $dbh->prepare(q{
1729         SELECT enrolmentfee
1730         FROM categories
1731         WHERE categorycode=?
1732     });
1733     $sth->execute( $categorycode );
1734     if ( $sth->err ) {
1735         warn sprintf('Database returned the following error: %s', $sth->errstr);
1736         return;
1737     }
1738     my ($enrolmentfee) = $sth->fetchrow;
1739     if ($enrolmentfee && $enrolmentfee > 0) {
1740         # insert fee in patron debts
1741         C4::Accounts::manualinvoice( $borrowernumber, '', '', 'A', $enrolmentfee );
1742     }
1743 }
1744
1745 =head2 DeleteExpiredOpacRegistrations
1746
1747     Delete accounts that haven't been upgraded from the 'temporary' category
1748     Returns the number of removed patrons
1749
1750 =cut
1751
1752 sub DeleteExpiredOpacRegistrations {
1753
1754     my $delay = C4::Context->preference('PatronSelfRegistrationExpireTemporaryAccountsDelay');
1755     my $category_code = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
1756
1757     return 0 if not $category_code or not defined $delay or $delay eq q||;
1758
1759     my $query = qq|
1760 SELECT borrowernumber
1761 FROM borrowers
1762 WHERE categorycode = ? AND DATEDIFF( NOW(), dateenrolled ) > ? |;
1763
1764     my $dbh = C4::Context->dbh;
1765     my $sth = $dbh->prepare($query);
1766     $sth->execute( $category_code, $delay );
1767     my $cnt=0;
1768     while ( my ($borrowernumber) = $sth->fetchrow_array() ) {
1769         Koha::Patrons->find($borrowernumber)->delete;
1770         $cnt++;
1771     }
1772     return $cnt;
1773 }
1774
1775 =head2 DeleteUnverifiedOpacRegistrations
1776
1777     Delete all unverified self registrations in borrower_modifications,
1778     older than the specified number of days.
1779
1780 =cut
1781
1782 sub DeleteUnverifiedOpacRegistrations {
1783     my ( $days ) = @_;
1784     my $dbh = C4::Context->dbh;
1785     my $sql=qq|
1786 DELETE FROM borrower_modifications
1787 WHERE borrowernumber = 0 AND DATEDIFF( NOW(), timestamp ) > ?|;
1788     my $cnt=$dbh->do($sql, undef, ($days) );
1789     return $cnt eq '0E0'? 0: $cnt;
1790 }
1791
1792 sub GetOverduesForPatron {
1793     my ( $borrowernumber ) = @_;
1794
1795     my $sql = "
1796         SELECT *
1797         FROM issues, items, biblio, biblioitems
1798         WHERE items.itemnumber=issues.itemnumber
1799           AND biblio.biblionumber   = items.biblionumber
1800           AND biblio.biblionumber   = biblioitems.biblionumber
1801           AND issues.borrowernumber = ?
1802           AND date_due < NOW()
1803     ";
1804
1805     my $sth = C4::Context->dbh->prepare( $sql );
1806     $sth->execute( $borrowernumber );
1807
1808     return $sth->fetchall_arrayref({});
1809 }
1810
1811 END { }    # module clean-up code here (global destructor)
1812
1813 1;
1814
1815 __END__
1816
1817 =head1 AUTHOR
1818
1819 Koha Team
1820
1821 =cut