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