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