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 GetHideLostItemsPreference
1307
1308   $hidelostitemspref = &GetHideLostItemsPreference($borrowernumber);
1309
1310 Returns the HideLostItems preference for the patron category of the supplied borrowernumber
1311 C<&$hidelostitemspref>return value of function, 0 or 1
1312
1313 =cut
1314
1315 sub GetHideLostItemsPreference {
1316     my ($borrowernumber) = @_;
1317     my $dbh = C4::Context->dbh;
1318     my $query = "SELECT hidelostitems FROM borrowers,categories WHERE borrowers.categorycode = categories.categorycode AND borrowernumber = ?";
1319     my $sth = $dbh->prepare($query);
1320     $sth->execute($borrowernumber);
1321     my $hidelostitems = $sth->fetchrow;
1322     return $hidelostitems;
1323 }
1324
1325 =head2 GetBorrowersToExpunge
1326
1327   $borrowers = &GetBorrowersToExpunge(
1328       not_borrowed_since => $not_borrowed_since,
1329       expired_before       => $expired_before,
1330       category_code        => $category_code,
1331       patron_list_id       => $patron_list_id,
1332       branchcode           => $branchcode
1333   );
1334
1335   This function get all borrowers based on the given criteria.
1336
1337 =cut
1338
1339 sub GetBorrowersToExpunge {
1340
1341     my $params = shift;
1342     my $filterdate       = $params->{'not_borrowed_since'};
1343     my $filterexpiry     = $params->{'expired_before'};
1344     my $filterlastseen   = $params->{'last_seen'};
1345     my $filtercategory   = $params->{'category_code'};
1346     my $filterbranch     = $params->{'branchcode'} ||
1347                         ((C4::Context->preference('IndependentBranches')
1348                              && C4::Context->userenv
1349                              && !C4::Context->IsSuperLibrarian()
1350                              && C4::Context->userenv->{branch})
1351                          ? C4::Context->userenv->{branch}
1352                          : "");
1353     my $filterpatronlist = $params->{'patron_list_id'};
1354
1355     my $dbh   = C4::Context->dbh;
1356     my $query = q|
1357         SELECT borrowers.borrowernumber,
1358                MAX(old_issues.timestamp) AS latestissue,
1359                MAX(issues.timestamp) AS currentissue
1360         FROM   borrowers
1361         JOIN   categories USING (categorycode)
1362         LEFT JOIN (
1363             SELECT guarantorid
1364             FROM borrowers
1365             WHERE guarantorid IS NOT NULL
1366                 AND guarantorid <> 0
1367         ) as tmp ON borrowers.borrowernumber=tmp.guarantorid
1368         LEFT JOIN old_issues USING (borrowernumber)
1369         LEFT JOIN issues USING (borrowernumber)|;
1370     if ( $filterpatronlist  ){
1371         $query .= q| LEFT JOIN patron_list_patrons USING (borrowernumber)|;
1372     }
1373     $query .= q| WHERE  category_type <> 'S'
1374         AND tmp.guarantorid IS NULL
1375    |;
1376     my @query_params;
1377     if ( $filterbranch && $filterbranch ne "" ) {
1378         $query.= " AND borrowers.branchcode = ? ";
1379         push( @query_params, $filterbranch );
1380     }
1381     if ( $filterexpiry ) {
1382         $query .= " AND dateexpiry < ? ";
1383         push( @query_params, $filterexpiry );
1384     }
1385     if ( $filterlastseen ) {
1386         $query .= ' AND lastseen < ? ';
1387         push @query_params, $filterlastseen;
1388     }
1389     if ( $filtercategory ) {
1390         $query .= " AND categorycode = ? ";
1391         push( @query_params, $filtercategory );
1392     }
1393     if ( $filterpatronlist ){
1394         $query.=" AND patron_list_id = ? ";
1395         push( @query_params, $filterpatronlist );
1396     }
1397     $query.=" GROUP BY borrowers.borrowernumber HAVING currentissue IS NULL ";
1398     if ( $filterdate ) {
1399         $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
1400         push @query_params,$filterdate;
1401     }
1402     warn $query if $debug;
1403
1404     my $sth = $dbh->prepare($query);
1405     if (scalar(@query_params)>0){
1406         $sth->execute(@query_params);
1407     }
1408     else {
1409         $sth->execute;
1410     }
1411
1412     my @results;
1413     while ( my $data = $sth->fetchrow_hashref ) {
1414         push @results, $data;
1415     }
1416     return \@results;
1417 }
1418
1419 =head2 GetBorrowersWhoHaveNeverBorrowed
1420
1421   $results = &GetBorrowersWhoHaveNeverBorrowed
1422
1423 This function get all borrowers who have never borrowed.
1424
1425 I<$result> is a ref to an array which all elements are a hasref.
1426
1427 =cut
1428
1429 sub GetBorrowersWhoHaveNeverBorrowed {
1430     my $filterbranch = shift ||
1431                         ((C4::Context->preference('IndependentBranches')
1432                              && C4::Context->userenv
1433                              && !C4::Context->IsSuperLibrarian()
1434                              && C4::Context->userenv->{branch})
1435                          ? C4::Context->userenv->{branch}
1436                          : "");
1437     my $dbh   = C4::Context->dbh;
1438     my $query = "
1439         SELECT borrowers.borrowernumber,max(timestamp) as latestissue
1440         FROM   borrowers
1441           LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
1442         WHERE issues.borrowernumber IS NULL
1443    ";
1444     my @query_params;
1445     if ($filterbranch && $filterbranch ne ""){
1446         $query.=" AND borrowers.branchcode= ?";
1447         push @query_params,$filterbranch;
1448     }
1449     warn $query if $debug;
1450
1451     my $sth = $dbh->prepare($query);
1452     if (scalar(@query_params)>0){
1453         $sth->execute(@query_params);
1454     }
1455     else {
1456         $sth->execute;
1457     }
1458
1459     my @results;
1460     while ( my $data = $sth->fetchrow_hashref ) {
1461         push @results, $data;
1462     }
1463     return \@results;
1464 }
1465
1466 =head2 GetBorrowersWithIssuesHistoryOlderThan
1467
1468   $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
1469
1470 this function get all borrowers who has an issue history older than I<$date> given on input arg.
1471
1472 I<$result> is a ref to an array which all elements are a hashref.
1473 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
1474
1475 =cut
1476
1477 sub GetBorrowersWithIssuesHistoryOlderThan {
1478     my $dbh  = C4::Context->dbh;
1479     my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
1480     my $filterbranch = shift ||
1481                         ((C4::Context->preference('IndependentBranches')
1482                              && C4::Context->userenv
1483                              && !C4::Context->IsSuperLibrarian()
1484                              && C4::Context->userenv->{branch})
1485                          ? C4::Context->userenv->{branch}
1486                          : "");
1487     my $query = "
1488        SELECT count(borrowernumber) as n,borrowernumber
1489        FROM old_issues
1490        WHERE returndate < ?
1491          AND borrowernumber IS NOT NULL
1492     ";
1493     my @query_params;
1494     push @query_params, $date;
1495     if ($filterbranch){
1496         $query.="   AND branchcode = ?";
1497         push @query_params, $filterbranch;
1498     }
1499     $query.=" GROUP BY borrowernumber ";
1500     warn $query if $debug;
1501     my $sth = $dbh->prepare($query);
1502     $sth->execute(@query_params);
1503     my @results;
1504
1505     while ( my $data = $sth->fetchrow_hashref ) {
1506         push @results, $data;
1507     }
1508     return \@results;
1509 }
1510
1511 =head2 IssueSlip
1512
1513   IssueSlip($branchcode, $borrowernumber, $quickslip)
1514
1515   Returns letter hash ( see C4::Letters::GetPreparedLetter )
1516
1517   $quickslip is boolean, to indicate whether we want a quick slip
1518
1519   IssueSlip populates ISSUESLIP and ISSUEQSLIP, and will make the following expansions:
1520
1521   Both slips:
1522
1523       <<branches.*>>
1524       <<borrowers.*>>
1525
1526   ISSUESLIP:
1527
1528       <checkedout>
1529          <<biblio.*>>
1530          <<items.*>>
1531          <<biblioitems.*>>
1532          <<issues.*>>
1533       </checkedout>
1534
1535       <overdue>
1536          <<biblio.*>>
1537          <<items.*>>
1538          <<biblioitems.*>>
1539          <<issues.*>>
1540       </overdue>
1541
1542       <news>
1543          <<opac_news.*>>
1544       </news>
1545
1546   ISSUEQSLIP:
1547
1548       <checkedout>
1549          <<biblio.*>>
1550          <<items.*>>
1551          <<biblioitems.*>>
1552          <<issues.*>>
1553       </checkedout>
1554
1555   NOTE: Not all table fields are available, pleasee see GetPendingIssues for a list of available fields.
1556
1557 =cut
1558
1559 sub IssueSlip {
1560     my ($branch, $borrowernumber, $quickslip) = @_;
1561
1562     # FIXME Check callers before removing this statement
1563     #return unless $borrowernumber;
1564
1565     my @issues = @{ GetPendingIssues($borrowernumber) };
1566
1567     for my $issue (@issues) {
1568         $issue->{date_due} = $issue->{date_due_sql};
1569         if ($quickslip) {
1570             my $today = output_pref({ dt => dt_from_string, dateformat => 'iso', dateonly => 1 });
1571             if ( substr( $issue->{issuedate}, 0, 10 ) eq $today
1572                 or substr( $issue->{lastreneweddate}, 0, 10 ) eq $today ) {
1573                   $issue->{now} = 1;
1574             };
1575         }
1576     }
1577
1578     # Sort on timestamp then on issuedate (useful for tests and could be if modified in a batch
1579     @issues = sort {
1580         my $s = $b->{timestamp} <=> $a->{timestamp};
1581         $s == 0 ?
1582              $b->{issuedate} <=> $a->{issuedate} : $s;
1583     } @issues;
1584
1585     my ($letter_code, %repeat);
1586     if ( $quickslip ) {
1587         $letter_code = 'ISSUEQSLIP';
1588         %repeat =  (
1589             'checkedout' => [ map {
1590                 'biblio'       => $_,
1591                 'items'        => $_,
1592                 'biblioitems'  => $_,
1593                 'issues'       => $_,
1594             }, grep { $_->{'now'} } @issues ],
1595         );
1596     }
1597     else {
1598         $letter_code = 'ISSUESLIP';
1599         %repeat =  (
1600             'checkedout' => [ map {
1601                 'biblio'       => $_,
1602                 'items'        => $_,
1603                 'biblioitems'  => $_,
1604                 'issues'       => $_,
1605             }, grep { !$_->{'overdue'} } @issues ],
1606
1607             'overdue' => [ map {
1608                 'biblio'       => $_,
1609                 'items'        => $_,
1610                 'biblioitems'  => $_,
1611                 'issues'       => $_,
1612             }, grep { $_->{'overdue'} } @issues ],
1613
1614             'news' => [ map {
1615                 $_->{'timestamp'} = $_->{'newdate'};
1616                 { opac_news => $_ }
1617             } @{ GetNewsToDisplay("slip",$branch) } ],
1618         );
1619     }
1620
1621     return  C4::Letters::GetPreparedLetter (
1622         module => 'circulation',
1623         letter_code => $letter_code,
1624         branchcode => $branch,
1625         tables => {
1626             'branches'    => $branch,
1627             'borrowers'   => $borrowernumber,
1628         },
1629         repeat => \%repeat,
1630     );
1631 }
1632
1633 =head2 GetBorrowersWithEmail
1634
1635     ([$borrnum,$userid], ...) = GetBorrowersWithEmail('me@example.com');
1636
1637 This gets a list of users and their basic details from their email address.
1638 As it's possible for multiple user to have the same email address, it provides
1639 you with all of them. If there is no userid for the user, there will be an
1640 C<undef> there. An empty list will be returned if there are no matches.
1641
1642 =cut
1643
1644 sub GetBorrowersWithEmail {
1645     my $email = shift;
1646
1647     my $dbh = C4::Context->dbh;
1648
1649     my $query = "SELECT borrowernumber, userid FROM borrowers WHERE email=?";
1650     my $sth=$dbh->prepare($query);
1651     $sth->execute($email);
1652     my @result = ();
1653     while (my $ref = $sth->fetch) {
1654         push @result, $ref;
1655     }
1656     die "Failure searching for borrowers by email address: $sth->errstr" if $sth->err;
1657     return @result;
1658 }
1659
1660 =head2 AddMember_Opac
1661
1662 =cut
1663
1664 sub AddMember_Opac {
1665     my ( %borrower ) = @_;
1666
1667     $borrower{'categorycode'} //= C4::Context->preference('PatronSelfRegistrationDefaultCategory');
1668     if (not defined $borrower{'password'}){
1669         my $sr = new String::Random;
1670         $sr->{'A'} = [ 'A'..'Z', 'a'..'z' ];
1671         my $password = $sr->randpattern("AAAAAAAAAA");
1672         $borrower{'password'} = $password;
1673     }
1674
1675     $borrower{'cardnumber'} = fixup_cardnumber( $borrower{'cardnumber'} );
1676
1677     my $borrowernumber = AddMember(%borrower);
1678
1679     return ( $borrowernumber, $borrower{'password'} );
1680 }
1681
1682 =head2 AddEnrolmentFeeIfNeeded
1683
1684     AddEnrolmentFeeIfNeeded( $borrower->{categorycode}, $borrower->{borrowernumber} );
1685
1686 Add enrolment fee for a patron if needed.
1687
1688 =cut
1689
1690 sub AddEnrolmentFeeIfNeeded {
1691     my ( $categorycode, $borrowernumber ) = @_;
1692     # check for enrollment fee & add it if needed
1693     my $dbh = C4::Context->dbh;
1694     my $sth = $dbh->prepare(q{
1695         SELECT enrolmentfee
1696         FROM categories
1697         WHERE categorycode=?
1698     });
1699     $sth->execute( $categorycode );
1700     if ( $sth->err ) {
1701         warn sprintf('Database returned the following error: %s', $sth->errstr);
1702         return;
1703     }
1704     my ($enrolmentfee) = $sth->fetchrow;
1705     if ($enrolmentfee && $enrolmentfee > 0) {
1706         # insert fee in patron debts
1707         C4::Accounts::manualinvoice( $borrowernumber, '', '', 'A', $enrolmentfee );
1708     }
1709 }
1710
1711 =head2 DeleteExpiredOpacRegistrations
1712
1713     Delete accounts that haven't been upgraded from the 'temporary' category
1714     Returns the number of removed patrons
1715
1716 =cut
1717
1718 sub DeleteExpiredOpacRegistrations {
1719
1720     my $delay = C4::Context->preference('PatronSelfRegistrationExpireTemporaryAccountsDelay');
1721     my $category_code = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
1722
1723     return 0 if not $category_code or not defined $delay or $delay eq q||;
1724
1725     my $query = qq|
1726 SELECT borrowernumber
1727 FROM borrowers
1728 WHERE categorycode = ? AND DATEDIFF( NOW(), dateenrolled ) > ? |;
1729
1730     my $dbh = C4::Context->dbh;
1731     my $sth = $dbh->prepare($query);
1732     $sth->execute( $category_code, $delay );
1733     my $cnt=0;
1734     while ( my ($borrowernumber) = $sth->fetchrow_array() ) {
1735         Koha::Patrons->find($borrowernumber)->delete;
1736         $cnt++;
1737     }
1738     return $cnt;
1739 }
1740
1741 =head2 DeleteUnverifiedOpacRegistrations
1742
1743     Delete all unverified self registrations in borrower_modifications,
1744     older than the specified number of days.
1745
1746 =cut
1747
1748 sub DeleteUnverifiedOpacRegistrations {
1749     my ( $days ) = @_;
1750     my $dbh = C4::Context->dbh;
1751     my $sql=qq|
1752 DELETE FROM borrower_modifications
1753 WHERE borrowernumber = 0 AND DATEDIFF( NOW(), timestamp ) > ?|;
1754     my $cnt=$dbh->do($sql, undef, ($days) );
1755     return $cnt eq '0E0'? 0: $cnt;
1756 }
1757
1758 sub GetOverduesForPatron {
1759     my ( $borrowernumber ) = @_;
1760
1761     my $sql = "
1762         SELECT *
1763         FROM issues, items, biblio, biblioitems
1764         WHERE items.itemnumber=issues.itemnumber
1765           AND biblio.biblionumber   = items.biblionumber
1766           AND biblio.biblionumber   = biblioitems.biblionumber
1767           AND issues.borrowernumber = ?
1768           AND date_due < NOW()
1769     ";
1770
1771     my $sth = C4::Context->dbh->prepare( $sql );
1772     $sth->execute( $borrowernumber );
1773
1774     return $sth->fetchall_arrayref({});
1775 }
1776
1777 END { }    # module clean-up code here (global destructor)
1778
1779 1;
1780
1781 __END__
1782
1783 =head1 AUTHOR
1784
1785 Koha Team
1786
1787 =cut