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