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