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