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