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     my ( $min_length, $max_length ) = get_cardnumber_length();
1345     return 2
1346         if length $cardnumber > $max_length
1347         or length $cardnumber < $min_length;
1348
1349     return 0;
1350 }
1351
1352 =head2 get_cardnumber_length
1353
1354     my ($min, $max) = C4::Members::get_cardnumber_length()
1355
1356 Returns the minimum and maximum length for patron cardnumbers as
1357 determined by the CardnumberLength system preference, the
1358 BorrowerMandatoryField system preference, and the width of the
1359 database column.
1360
1361 =cut
1362
1363 sub get_cardnumber_length {
1364     my ( $min, $max ) = ( 0, 16 ); # borrowers.cardnumber is a nullable varchar(16)
1365     $min = 1 if C4::Context->preference('BorrowerMandatoryField') =~ /cardnumber/;
1366     if ( my $cardnumber_length = C4::Context->preference('CardnumberLength') ) {
1367         # Is integer and length match
1368         if ( $cardnumber_length =~ m|^\d+$| ) {
1369             $min = $max = $cardnumber_length
1370                 if $cardnumber_length >= $min
1371                     and $cardnumber_length <= $max;
1372         }
1373         # Else assuming it is a range
1374         elsif ( $cardnumber_length =~ m|(\d*),(\d*)| ) {
1375             $min = $1 if $1 and $min < $1;
1376             $max = $2 if $2 and $max > $2;
1377         }
1378
1379     }
1380     return ( $min, $max );
1381 }
1382
1383 =head2 getzipnamecity (OUEST-PROVENCE)
1384
1385 take all info from table city for the fields city and  zip
1386 check for the name and the zip code of the city selected
1387
1388 =cut
1389
1390 sub getzipnamecity {
1391     my ($cityid) = @_;
1392     my $dbh      = C4::Context->dbh;
1393     my $sth      =
1394       $dbh->prepare(
1395         "select city_name,city_state,city_zipcode,city_country from cities where cityid=? ");
1396     $sth->execute($cityid);
1397     my @data = $sth->fetchrow;
1398     return $data[0], $data[1], $data[2], $data[3];
1399 }
1400
1401
1402 =head2 getdcity (OUEST-PROVENCE)
1403
1404 recover cityid  with city_name condition
1405
1406 =cut
1407
1408 sub getidcity {
1409     my ($city_name) = @_;
1410     my $dbh = C4::Context->dbh;
1411     my $sth = $dbh->prepare("select cityid from cities where city_name=? ");
1412     $sth->execute($city_name);
1413     my $data = $sth->fetchrow;
1414     return $data;
1415 }
1416
1417 =head2 GetFirstValidEmailAddress
1418
1419   $email = GetFirstValidEmailAddress($borrowernumber);
1420
1421 Return the first valid email address for a borrower, given the borrowernumber.  For now, the order
1422 is defined as email, emailpro, B_email.  Returns the empty string if the borrower has no email
1423 addresses.
1424
1425 =cut
1426
1427 sub GetFirstValidEmailAddress {
1428     my $borrowernumber = shift;
1429     my $dbh = C4::Context->dbh;
1430     my $sth = $dbh->prepare( "SELECT email, emailpro, B_email FROM borrowers where borrowernumber = ? ");
1431     $sth->execute( $borrowernumber );
1432     my $data = $sth->fetchrow_hashref;
1433
1434     if ($data->{'email'}) {
1435        return $data->{'email'};
1436     } elsif ($data->{'emailpro'}) {
1437        return $data->{'emailpro'};
1438     } elsif ($data->{'B_email'}) {
1439        return $data->{'B_email'};
1440     } else {
1441        return '';
1442     }
1443 }
1444
1445 =head2 GetNoticeEmailAddress
1446
1447   $email = GetNoticeEmailAddress($borrowernumber);
1448
1449 Return the email address of borrower used for notices, given the borrowernumber.
1450 Returns the empty string if no email address.
1451
1452 =cut
1453
1454 sub GetNoticeEmailAddress {
1455     my $borrowernumber = shift;
1456
1457     my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
1458     # if syspref is set to 'first valid' (value == OFF), look up email address
1459     if ( $which_address eq 'OFF' ) {
1460         return GetFirstValidEmailAddress($borrowernumber);
1461     }
1462     # specified email address field
1463     my $dbh = C4::Context->dbh;
1464     my $sth = $dbh->prepare( qq{
1465         SELECT $which_address AS primaryemail
1466         FROM borrowers
1467         WHERE borrowernumber=?
1468     } );
1469     $sth->execute($borrowernumber);
1470     my $data = $sth->fetchrow_hashref;
1471     return $data->{'primaryemail'} || '';
1472 }
1473
1474 =head2 GetExpiryDate
1475
1476   $expirydate = GetExpiryDate($categorycode, $dateenrolled);
1477
1478 Calculate expiry date given a categorycode and starting date.  Date argument must be in ISO format.
1479 Return date is also in ISO format.
1480
1481 =cut
1482
1483 sub GetExpiryDate {
1484     my ( $categorycode, $dateenrolled ) = @_;
1485     my $enrolments;
1486     if ($categorycode) {
1487         my $dbh = C4::Context->dbh;
1488         my $sth = $dbh->prepare("SELECT enrolmentperiod,enrolmentperioddate FROM categories WHERE categorycode=?");
1489         $sth->execute($categorycode);
1490         $enrolments = $sth->fetchrow_hashref;
1491     }
1492     # die "GetExpiryDate: for enrollmentperiod $enrolmentperiod (category '$categorycode') starting $dateenrolled.\n";
1493     my @date = split (/-/,$dateenrolled);
1494     if($enrolments->{enrolmentperiod}){
1495         return sprintf("%04d-%02d-%02d", Add_Delta_YM(@date,0,$enrolments->{enrolmentperiod}));
1496     }else{
1497         return $enrolments->{enrolmentperioddate};
1498     }
1499 }
1500
1501 =head2 GetborCatFromCatType
1502
1503   ($codes_arrayref, $labels_hashref) = &GetborCatFromCatType();
1504
1505 Looks up the different types of borrowers in the database. Returns two
1506 elements: a reference-to-array, which lists the borrower category
1507 codes, and a reference-to-hash, which maps the borrower category codes
1508 to category descriptions.
1509
1510 =cut
1511
1512 #'
1513 sub GetborCatFromCatType {
1514     my ( $category_type, $action, $no_branch_limit ) = @_;
1515
1516     my $branch_limit = $no_branch_limit
1517         ? 0
1518         : C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1519
1520     # FIXME - This API  seems both limited and dangerous.
1521     my $dbh     = C4::Context->dbh;
1522
1523     my $request = qq{
1524         SELECT categories.categorycode, categories.description
1525         FROM categories
1526     };
1527     $request .= qq{
1528         LEFT JOIN categories_branches ON categories.categorycode = categories_branches.categorycode
1529     } if $branch_limit;
1530     if($action) {
1531         $request .= " $action ";
1532         $request .= " AND (branchcode = ? OR branchcode IS NULL) GROUP BY description" if $branch_limit;
1533     } else {
1534         $request .= " WHERE branchcode = ? OR branchcode IS NULL GROUP BY description" if $branch_limit;
1535     }
1536     $request .= " ORDER BY categorycode";
1537
1538     my $sth = $dbh->prepare($request);
1539     $sth->execute(
1540         $action ? $category_type : (),
1541         $branch_limit ? $branch_limit : ()
1542     );
1543
1544     my %labels;
1545     my @codes;
1546
1547     while ( my $data = $sth->fetchrow_hashref ) {
1548         push @codes, $data->{'categorycode'};
1549         $labels{ $data->{'categorycode'} } = $data->{'description'};
1550     }
1551     $sth->finish;
1552     return ( \@codes, \%labels );
1553 }
1554
1555 =head2 GetBorrowercategory
1556
1557   $hashref = &GetBorrowercategory($categorycode);
1558
1559 Given the borrower's category code, the function returns the corresponding
1560 data hashref for a comprehensive information display.
1561
1562 =cut
1563
1564 sub GetBorrowercategory {
1565     my ($catcode) = @_;
1566     my $dbh       = C4::Context->dbh;
1567     if ($catcode){
1568         my $sth       =
1569         $dbh->prepare(
1570     "SELECT description,dateofbirthrequired,upperagelimit,category_type
1571     FROM categories
1572     WHERE categorycode = ?"
1573         );
1574         $sth->execute($catcode);
1575         my $data =
1576         $sth->fetchrow_hashref;
1577         return $data;
1578     }
1579     return;
1580 }    # sub getborrowercategory
1581
1582
1583 =head2 GetBorrowerCategorycode
1584
1585     $categorycode = &GetBorrowerCategoryCode( $borrowernumber );
1586
1587 Given the borrowernumber, the function returns the corresponding categorycode
1588 =cut
1589
1590 sub GetBorrowerCategorycode {
1591     my ( $borrowernumber ) = @_;
1592     my $dbh = C4::Context->dbh;
1593     my $sth = $dbh->prepare( qq{
1594         SELECT categorycode
1595         FROM borrowers
1596         WHERE borrowernumber = ?
1597     } );
1598     $sth->execute( $borrowernumber );
1599     return $sth->fetchrow;
1600 }
1601
1602 =head2 GetBorrowercategoryList
1603
1604   $arrayref_hashref = &GetBorrowercategoryList;
1605 If no category code provided, the function returns all the categories.
1606
1607 =cut
1608
1609 sub GetBorrowercategoryList {
1610     my $no_branch_limit = @_ ? shift : 0;
1611     my $branch_limit = $no_branch_limit
1612         ? 0
1613         : C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1614     my $dbh       = C4::Context->dbh;
1615     my $query = "SELECT categories.* FROM categories";
1616     $query .= qq{
1617         LEFT JOIN categories_branches ON categories.categorycode = categories_branches.categorycode
1618         WHERE branchcode = ? OR branchcode IS NULL GROUP BY description
1619     } if $branch_limit;
1620     $query .= " ORDER BY description";
1621     my $sth = $dbh->prepare( $query );
1622     $sth->execute( $branch_limit ? $branch_limit : () );
1623     my $data = $sth->fetchall_arrayref( {} );
1624     $sth->finish;
1625     return $data;
1626 }    # sub getborrowercategory
1627
1628 =head2 ethnicitycategories
1629
1630   ($codes_arrayref, $labels_hashref) = &ethnicitycategories();
1631
1632 Looks up the different ethnic types in the database. Returns two
1633 elements: a reference-to-array, which lists the ethnicity codes, and a
1634 reference-to-hash, which maps the ethnicity codes to ethnicity
1635 descriptions.
1636
1637 =cut
1638
1639 #'
1640
1641 sub ethnicitycategories {
1642     my $dbh = C4::Context->dbh;
1643     my $sth = $dbh->prepare("Select code,name from ethnicity order by name");
1644     $sth->execute;
1645     my %labels;
1646     my @codes;
1647     while ( my $data = $sth->fetchrow_hashref ) {
1648         push @codes, $data->{'code'};
1649         $labels{ $data->{'code'} } = $data->{'name'};
1650     }
1651     return ( \@codes, \%labels );
1652 }
1653
1654 =head2 fixEthnicity
1655
1656   $ethn_name = &fixEthnicity($ethn_code);
1657
1658 Takes an ethnicity code (e.g., "european" or "pi") and returns the
1659 corresponding descriptive name from the C<ethnicity> table in the
1660 Koha database ("European" or "Pacific Islander").
1661
1662 =cut
1663
1664 #'
1665
1666 sub fixEthnicity {
1667     my $ethnicity = shift;
1668     return unless $ethnicity;
1669     my $dbh       = C4::Context->dbh;
1670     my $sth       = $dbh->prepare("Select name from ethnicity where code = ?");
1671     $sth->execute($ethnicity);
1672     my $data = $sth->fetchrow_hashref;
1673     return $data->{'name'};
1674 }    # sub fixEthnicity
1675
1676 =head2 GetAge
1677
1678   $dateofbirth,$date = &GetAge($date);
1679
1680 this function return the borrowers age with the value of dateofbirth
1681
1682 =cut
1683
1684 #'
1685 sub GetAge{
1686     my ( $date, $date_ref ) = @_;
1687
1688     if ( not defined $date_ref ) {
1689         $date_ref = sprintf( '%04d-%02d-%02d', Today() );
1690     }
1691
1692     my ( $year1, $month1, $day1 ) = split /-/, $date;
1693     my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
1694
1695     my $age = $year2 - $year1;
1696     if ( $month1 . $day1 > $month2 . $day2 ) {
1697         $age--;
1698     }
1699
1700     return $age;
1701 }    # sub get_age
1702
1703 =head2 GetCities
1704
1705   $cityarrayref = GetCities();
1706
1707   Returns an array_ref of the entries in the cities table
1708   If there are entries in the table an empty row is returned
1709   This is currently only used to populate a popup in memberentry
1710
1711 =cut
1712
1713 sub GetCities {
1714
1715     my $dbh   = C4::Context->dbh;
1716     my $city_arr = $dbh->selectall_arrayref(
1717         q|SELECT cityid,city_zipcode,city_name,city_state,city_country FROM cities ORDER BY city_name|,
1718         { Slice => {} });
1719     if ( @{$city_arr} ) {
1720         unshift @{$city_arr}, {
1721             city_zipcode => q{},
1722             city_name    => q{},
1723             cityid       => q{},
1724             city_state   => q{},
1725             city_country => q{},
1726         };
1727     }
1728
1729     return  $city_arr;
1730 }
1731
1732 =head2 GetSortDetails (OUEST-PROVENCE)
1733
1734   ($lib) = &GetSortDetails($category,$sortvalue);
1735
1736 Returns the authorized value  details
1737 C<&$lib>return value of authorized value details
1738 C<&$sortvalue>this is the value of authorized value
1739 C<&$category>this is the value of authorized value category
1740
1741 =cut
1742
1743 sub GetSortDetails {
1744     my ( $category, $sortvalue ) = @_;
1745     my $dbh   = C4::Context->dbh;
1746     my $query = qq|SELECT lib
1747         FROM authorised_values
1748         WHERE category=?
1749         AND authorised_value=? |;
1750     my $sth = $dbh->prepare($query);
1751     $sth->execute( $category, $sortvalue );
1752     my $lib = $sth->fetchrow;
1753     return ($lib) if ($lib);
1754     return ($sortvalue) unless ($lib);
1755 }
1756
1757 =head2 MoveMemberToDeleted
1758
1759   $result = &MoveMemberToDeleted($borrowernumber);
1760
1761 Copy the record from borrowers to deletedborrowers table.
1762
1763 =cut
1764
1765 # FIXME: should do it in one SQL statement w/ subquery
1766 # Otherwise, we should return the @data on success
1767
1768 sub MoveMemberToDeleted {
1769     my ($member) = shift or return;
1770     my $dbh = C4::Context->dbh;
1771     my $query = qq|SELECT *
1772           FROM borrowers
1773           WHERE borrowernumber=?|;
1774     my $sth = $dbh->prepare($query);
1775     $sth->execute($member);
1776     my @data = $sth->fetchrow_array;
1777     (@data) or return;  # if we got a bad borrowernumber, there's nothing to insert
1778     $sth =
1779       $dbh->prepare( "INSERT INTO deletedborrowers VALUES ("
1780           . ( "?," x ( scalar(@data) - 1 ) )
1781           . "?)" );
1782     $sth->execute(@data);
1783 }
1784
1785 =head2 DelMember
1786
1787     DelMember($borrowernumber);
1788
1789 This function remove directly a borrower whitout writing it on deleteborrower.
1790 + Deletes reserves for the borrower
1791
1792 =cut
1793
1794 sub DelMember {
1795     my $dbh            = C4::Context->dbh;
1796     my $borrowernumber = shift;
1797     #warn "in delmember with $borrowernumber";
1798     return unless $borrowernumber;    # borrowernumber is mandatory.
1799
1800     my $query = qq|DELETE
1801           FROM  reserves
1802           WHERE borrowernumber=?|;
1803     my $sth = $dbh->prepare($query);
1804     $sth->execute($borrowernumber);
1805     $query = "
1806        DELETE
1807        FROM borrowers
1808        WHERE borrowernumber = ?
1809    ";
1810     $sth = $dbh->prepare($query);
1811     $sth->execute($borrowernumber);
1812     logaction("MEMBERS", "DELETE", $borrowernumber, "") if C4::Context->preference("BorrowersLog");
1813     return $sth->rows;
1814 }
1815
1816 =head2 ExtendMemberSubscriptionTo (OUEST-PROVENCE)
1817
1818     $date = ExtendMemberSubscriptionTo($borrowerid, $date);
1819
1820 Extending the subscription to a given date or to the expiry date calculated on ISO date.
1821 Returns ISO date.
1822
1823 =cut
1824
1825 sub ExtendMemberSubscriptionTo {
1826     my ( $borrowerid,$date) = @_;
1827     my $dbh = C4::Context->dbh;
1828     my $borrower = GetMember('borrowernumber'=>$borrowerid);
1829     unless ($date){
1830       $date = (C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry') ?
1831                                         C4::Dates->new($borrower->{'dateexpiry'}, 'iso')->output("iso") :
1832                                         C4::Dates->new()->output("iso");
1833       $date = GetExpiryDate( $borrower->{'categorycode'}, $date );
1834     }
1835     my $sth = $dbh->do(<<EOF);
1836 UPDATE borrowers
1837 SET  dateexpiry='$date'
1838 WHERE borrowernumber='$borrowerid'
1839 EOF
1840
1841     AddEnrolmentFeeIfNeeded( $borrower->{categorycode}, $borrower->{borrowernumber} );
1842
1843     logaction("MEMBERS", "RENEW", $borrower->{'borrowernumber'}, "Membership renewed")if C4::Context->preference("BorrowersLog");
1844     return $date if ($sth);
1845     return 0;
1846 }
1847
1848 =head2 GetTitles (OUEST-PROVENCE)
1849
1850   ($borrowertitle)= &GetTitles();
1851
1852 Looks up the different title . Returns array  with all borrowers title
1853
1854 =cut
1855
1856 sub GetTitles {
1857     my @borrowerTitle = split (/,|\|/,C4::Context->preference('BorrowersTitles'));
1858     unshift( @borrowerTitle, "" );
1859     my $count=@borrowerTitle;
1860     if ($count == 1){
1861         return ();
1862     }
1863     else {
1864         return ( \@borrowerTitle);
1865     }
1866 }
1867
1868 =head2 GetPatronImage
1869
1870     my ($imagedata, $dberror) = GetPatronImage($borrowernumber);
1871
1872 Returns the mimetype and binary image data of the image for the patron with the supplied borrowernumber.
1873
1874 =cut
1875
1876 sub GetPatronImage {
1877     my ($borrowernumber) = @_;
1878     warn "Borrowernumber passed to GetPatronImage is $borrowernumber" if $debug;
1879     my $dbh = C4::Context->dbh;
1880     my $query = 'SELECT mimetype, imagefile FROM patronimage WHERE borrowernumber = ?';
1881     my $sth = $dbh->prepare($query);
1882     $sth->execute($borrowernumber);
1883     my $imagedata = $sth->fetchrow_hashref;
1884     warn "Database error!" if $sth->errstr;
1885     return $imagedata, $sth->errstr;
1886 }
1887
1888 =head2 PutPatronImage
1889
1890     PutPatronImage($cardnumber, $mimetype, $imgfile);
1891
1892 Stores patron binary image data and mimetype in database.
1893 NOTE: This function is good for updating images as well as inserting new images in the database.
1894
1895 =cut
1896
1897 sub PutPatronImage {
1898     my ($cardnumber, $mimetype, $imgfile) = @_;
1899     warn "Parameters passed in: Cardnumber=$cardnumber, Mimetype=$mimetype, " . ($imgfile ? "Imagefile" : "No Imagefile") if $debug;
1900     my $dbh = C4::Context->dbh;
1901     my $query = "INSERT INTO patronimage (borrowernumber, mimetype, imagefile) VALUES ( ( SELECT borrowernumber from borrowers WHERE cardnumber = ? ),?,?) ON DUPLICATE KEY UPDATE imagefile = ?;";
1902     my $sth = $dbh->prepare($query);
1903     $sth->execute($cardnumber,$mimetype,$imgfile,$imgfile);
1904     warn "Error returned inserting $cardnumber.$mimetype." if $sth->errstr;
1905     return $sth->errstr;
1906 }
1907
1908 =head2 RmPatronImage
1909
1910     my ($dberror) = RmPatronImage($borrowernumber);
1911
1912 Removes the image for the patron with the supplied borrowernumber.
1913
1914 =cut
1915
1916 sub RmPatronImage {
1917     my ($borrowernumber) = @_;
1918     warn "Borrowernumber passed to GetPatronImage is $borrowernumber" if $debug;
1919     my $dbh = C4::Context->dbh;
1920     my $query = "DELETE FROM patronimage WHERE borrowernumber = ?;";
1921     my $sth = $dbh->prepare($query);
1922     $sth->execute($borrowernumber);
1923     my $dberror = $sth->errstr;
1924     warn "Database error!" if $sth->errstr;
1925     return $dberror;
1926 }
1927
1928 =head2 GetHideLostItemsPreference
1929
1930   $hidelostitemspref = &GetHideLostItemsPreference($borrowernumber);
1931
1932 Returns the HideLostItems preference for the patron category of the supplied borrowernumber
1933 C<&$hidelostitemspref>return value of function, 0 or 1
1934
1935 =cut
1936
1937 sub GetHideLostItemsPreference {
1938     my ($borrowernumber) = @_;
1939     my $dbh = C4::Context->dbh;
1940     my $query = "SELECT hidelostitems FROM borrowers,categories WHERE borrowers.categorycode = categories.categorycode AND borrowernumber = ?";
1941     my $sth = $dbh->prepare($query);
1942     $sth->execute($borrowernumber);
1943     my $hidelostitems = $sth->fetchrow;
1944     return $hidelostitems;
1945 }
1946
1947 =head2 GetBorrowersToExpunge
1948
1949   $borrowers = &GetBorrowersToExpunge(
1950       not_borrowered_since => $not_borrowered_since,
1951       expired_before       => $expired_before,
1952       category_code        => $category_code,
1953       branchcode           => $branchcode
1954   );
1955
1956   This function get all borrowers based on the given criteria.
1957
1958 =cut
1959
1960 sub GetBorrowersToExpunge {
1961     my $params = shift;
1962
1963     my $filterdate     = $params->{'not_borrowered_since'};
1964     my $filterexpiry   = $params->{'expired_before'};
1965     my $filtercategory = $params->{'category_code'};
1966     my $filterbranch   = $params->{'branchcode'} ||
1967                         ((C4::Context->preference('IndependentBranches')
1968                              && C4::Context->userenv
1969                              && !C4::Context->IsSuperLibrarian()
1970                              && C4::Context->userenv->{branch})
1971                          ? C4::Context->userenv->{branch}
1972                          : "");
1973
1974     my $dbh   = C4::Context->dbh;
1975     my $query = "
1976         SELECT borrowers.borrowernumber,
1977                MAX(old_issues.timestamp) AS latestissue,
1978                MAX(issues.timestamp) AS currentissue
1979         FROM   borrowers
1980         JOIN   categories USING (categorycode)
1981         LEFT JOIN old_issues USING (borrowernumber)
1982         LEFT JOIN issues USING (borrowernumber)
1983         WHERE  category_type <> 'S'
1984         AND borrowernumber NOT IN (SELECT guarantorid FROM borrowers WHERE guarantorid IS NOT NULL AND guarantorid <> 0)
1985    ";
1986     my @query_params;
1987     if ( $filterbranch && $filterbranch ne "" ) {
1988         $query.= " AND borrowers.branchcode = ? ";
1989         push( @query_params, $filterbranch );
1990     }
1991     if ( $filterexpiry ) {
1992         $query .= " AND dateexpiry < ? ";
1993         push( @query_params, $filterexpiry );
1994     }
1995     if ( $filtercategory ) {
1996         $query .= " AND categorycode = ? ";
1997         push( @query_params, $filtercategory );
1998     }
1999     $query.=" GROUP BY borrowers.borrowernumber HAVING currentissue IS NULL ";
2000     if ( $filterdate ) {
2001         $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
2002         push @query_params,$filterdate;
2003     }
2004     warn $query if $debug;
2005
2006     my $sth = $dbh->prepare($query);
2007     if (scalar(@query_params)>0){
2008         $sth->execute(@query_params);
2009     }
2010     else {
2011         $sth->execute;
2012     }
2013
2014     my @results;
2015     while ( my $data = $sth->fetchrow_hashref ) {
2016         push @results, $data;
2017     }
2018     return \@results;
2019 }
2020
2021 =head2 GetBorrowersWhoHaveNeverBorrowed
2022
2023   $results = &GetBorrowersWhoHaveNeverBorrowed
2024
2025 This function get all borrowers who have never borrowed.
2026
2027 I<$result> is a ref to an array which all elements are a hasref.
2028
2029 =cut
2030
2031 sub GetBorrowersWhoHaveNeverBorrowed {
2032     my $filterbranch = shift ||
2033                         ((C4::Context->preference('IndependentBranches')
2034                              && C4::Context->userenv
2035                              && !C4::Context->IsSuperLibrarian()
2036                              && C4::Context->userenv->{branch})
2037                          ? C4::Context->userenv->{branch}
2038                          : "");
2039     my $dbh   = C4::Context->dbh;
2040     my $query = "
2041         SELECT borrowers.borrowernumber,max(timestamp) as latestissue
2042         FROM   borrowers
2043           LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
2044         WHERE issues.borrowernumber IS NULL
2045    ";
2046     my @query_params;
2047     if ($filterbranch && $filterbranch ne ""){
2048         $query.=" AND borrowers.branchcode= ?";
2049         push @query_params,$filterbranch;
2050     }
2051     warn $query if $debug;
2052
2053     my $sth = $dbh->prepare($query);
2054     if (scalar(@query_params)>0){
2055         $sth->execute(@query_params);
2056     }
2057     else {
2058         $sth->execute;
2059     }
2060
2061     my @results;
2062     while ( my $data = $sth->fetchrow_hashref ) {
2063         push @results, $data;
2064     }
2065     return \@results;
2066 }
2067
2068 =head2 GetBorrowersWithIssuesHistoryOlderThan
2069
2070   $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
2071
2072 this function get all borrowers who has an issue history older than I<$date> given on input arg.
2073
2074 I<$result> is a ref to an array which all elements are a hashref.
2075 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2076
2077 =cut
2078
2079 sub GetBorrowersWithIssuesHistoryOlderThan {
2080     my $dbh  = C4::Context->dbh;
2081     my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
2082     my $filterbranch = shift ||
2083                         ((C4::Context->preference('IndependentBranches')
2084                              && C4::Context->userenv
2085                              && !C4::Context->IsSuperLibrarian()
2086                              && C4::Context->userenv->{branch})
2087                          ? C4::Context->userenv->{branch}
2088                          : "");
2089     my $query = "
2090        SELECT count(borrowernumber) as n,borrowernumber
2091        FROM old_issues
2092        WHERE returndate < ?
2093          AND borrowernumber IS NOT NULL
2094     ";
2095     my @query_params;
2096     push @query_params, $date;
2097     if ($filterbranch){
2098         $query.="   AND branchcode = ?";
2099         push @query_params, $filterbranch;
2100     }
2101     $query.=" GROUP BY borrowernumber ";
2102     warn $query if $debug;
2103     my $sth = $dbh->prepare($query);
2104     $sth->execute(@query_params);
2105     my @results;
2106
2107     while ( my $data = $sth->fetchrow_hashref ) {
2108         push @results, $data;
2109     }
2110     return \@results;
2111 }
2112
2113 =head2 GetBorrowersNamesAndLatestIssue
2114
2115   $results = &GetBorrowersNamesAndLatestIssueList(@borrowernumbers)
2116
2117 this function get borrowers Names and surnames and Issue information.
2118
2119 I<@borrowernumbers> is an array which all elements are borrowernumbers.
2120 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2121
2122 =cut
2123
2124 sub GetBorrowersNamesAndLatestIssue {
2125     my $dbh  = C4::Context->dbh;
2126     my @borrowernumbers=@_;
2127     my $query = "
2128        SELECT surname,lastname, phone, email,max(timestamp)
2129        FROM borrowers
2130          LEFT JOIN issues ON borrowers.borrowernumber=issues.borrowernumber
2131        GROUP BY borrowernumber
2132    ";
2133     my $sth = $dbh->prepare($query);
2134     $sth->execute;
2135     my $results = $sth->fetchall_arrayref({});
2136     return $results;
2137 }
2138
2139 =head2 ModPrivacy
2140
2141 =over 4
2142
2143 my $success = ModPrivacy( $borrowernumber, $privacy );
2144
2145 Update the privacy of a patron.
2146
2147 return :
2148 true on success, false on failure
2149
2150 =back
2151
2152 =cut
2153
2154 sub ModPrivacy {
2155     my $borrowernumber = shift;
2156     my $privacy = shift;
2157     return unless defined $borrowernumber;
2158     return unless $borrowernumber =~ /^\d+$/;
2159
2160     return ModMember( borrowernumber => $borrowernumber,
2161                       privacy        => $privacy );
2162 }
2163
2164 =head2 AddMessage
2165
2166   AddMessage( $borrowernumber, $message_type, $message, $branchcode );
2167
2168 Adds a message to the messages table for the given borrower.
2169
2170 Returns:
2171   True on success
2172   False on failure
2173
2174 =cut
2175
2176 sub AddMessage {
2177     my ( $borrowernumber, $message_type, $message, $branchcode ) = @_;
2178
2179     my $dbh  = C4::Context->dbh;
2180
2181     if ( ! ( $borrowernumber && $message_type && $message && $branchcode ) ) {
2182       return;
2183     }
2184
2185     my $query = "INSERT INTO messages ( borrowernumber, branchcode, message_type, message ) VALUES ( ?, ?, ?, ? )";
2186     my $sth = $dbh->prepare($query);
2187     $sth->execute( $borrowernumber, $branchcode, $message_type, $message );
2188     logaction("MEMBERS", "ADDCIRCMESSAGE", $borrowernumber, $message) if C4::Context->preference("BorrowersLog");
2189     return 1;
2190 }
2191
2192 =head2 GetMessages
2193
2194   GetMessages( $borrowernumber, $type );
2195
2196 $type is message type, B for borrower, or L for Librarian.
2197 Empty type returns all messages of any type.
2198
2199 Returns all messages for the given borrowernumber
2200
2201 =cut
2202
2203 sub GetMessages {
2204     my ( $borrowernumber, $type, $branchcode ) = @_;
2205
2206     if ( ! $type ) {
2207       $type = '%';
2208     }
2209
2210     my $dbh  = C4::Context->dbh;
2211
2212     my $query = "SELECT
2213                   branches.branchname,
2214                   messages.*,
2215                   message_date,
2216                   messages.branchcode LIKE '$branchcode' AS can_delete
2217                   FROM messages, branches
2218                   WHERE borrowernumber = ?
2219                   AND message_type LIKE ?
2220                   AND messages.branchcode = branches.branchcode
2221                   ORDER BY message_date DESC";
2222     my $sth = $dbh->prepare($query);
2223     $sth->execute( $borrowernumber, $type ) ;
2224     my @results;
2225
2226     while ( my $data = $sth->fetchrow_hashref ) {
2227         my $d = C4::Dates->new( $data->{message_date}, 'iso' );
2228         $data->{message_date_formatted} = $d->output;
2229         push @results, $data;
2230     }
2231     return \@results;
2232
2233 }
2234
2235 =head2 GetMessages
2236
2237   GetMessagesCount( $borrowernumber, $type );
2238
2239 $type is message type, B for borrower, or L for Librarian.
2240 Empty type returns all messages of any type.
2241
2242 Returns the number of messages for the given borrowernumber
2243
2244 =cut
2245
2246 sub GetMessagesCount {
2247     my ( $borrowernumber, $type, $branchcode ) = @_;
2248
2249     if ( ! $type ) {
2250       $type = '%';
2251     }
2252
2253     my $dbh  = C4::Context->dbh;
2254
2255     my $query = "SELECT COUNT(*) as MsgCount FROM messages WHERE borrowernumber = ? AND message_type LIKE ?";
2256     my $sth = $dbh->prepare($query);
2257     $sth->execute( $borrowernumber, $type ) ;
2258     my @results;
2259
2260     my $data = $sth->fetchrow_hashref;
2261     my $count = $data->{'MsgCount'};
2262
2263     return $count;
2264 }
2265
2266
2267
2268 =head2 DeleteMessage
2269
2270   DeleteMessage( $message_id );
2271
2272 =cut
2273
2274 sub DeleteMessage {
2275     my ( $message_id ) = @_;
2276
2277     my $dbh = C4::Context->dbh;
2278     my $query = "SELECT * FROM messages WHERE message_id = ?";
2279     my $sth = $dbh->prepare($query);
2280     $sth->execute( $message_id );
2281     my $message = $sth->fetchrow_hashref();
2282
2283     $query = "DELETE FROM messages WHERE message_id = ?";
2284     $sth = $dbh->prepare($query);
2285     $sth->execute( $message_id );
2286     logaction("MEMBERS", "DELCIRCMESSAGE", $message->{'borrowernumber'}, $message->{'message'}) if C4::Context->preference("BorrowersLog");
2287 }
2288
2289 =head2 IssueSlip
2290
2291   IssueSlip($branchcode, $borrowernumber, $quickslip)
2292
2293   Returns letter hash ( see C4::Letters::GetPreparedLetter )
2294
2295   $quickslip is boolean, to indicate whether we want a quick slip
2296
2297 =cut
2298
2299 sub IssueSlip {
2300     my ($branch, $borrowernumber, $quickslip) = @_;
2301
2302 #   return unless ( C4::Context->boolean_preference('printcirculationslips') );
2303
2304     my $now       = POSIX::strftime("%Y-%m-%d", localtime);
2305
2306     my $issueslist = GetPendingIssues($borrowernumber);
2307     foreach my $it (@$issueslist){
2308         if ((substr $it->{'issuedate'}, 0, 10) eq $now || (substr $it->{'lastreneweddate'}, 0, 10) eq $now) {
2309             $it->{'now'} = 1;
2310         }
2311         elsif ((substr $it->{'date_due'}, 0, 10) le $now) {
2312             $it->{'overdue'} = 1;
2313         }
2314         my $dt = dt_from_string( $it->{'date_due'} );
2315         $it->{'date_due'} = output_pref( $dt );;
2316     }
2317     my @issues = sort { $b->{'timestamp'} <=> $a->{'timestamp'} } @$issueslist;
2318
2319     my ($letter_code, %repeat);
2320     if ( $quickslip ) {
2321         $letter_code = 'ISSUEQSLIP';
2322         %repeat =  (
2323             'checkedout' => [ map {
2324                 'biblio' => $_,
2325                 'items'  => $_,
2326                 'issues' => $_,
2327             }, grep { $_->{'now'} } @issues ],
2328         );
2329     }
2330     else {
2331         $letter_code = 'ISSUESLIP';
2332         %repeat =  (
2333             'checkedout' => [ map {
2334                 'biblio' => $_,
2335                 'items'  => $_,
2336                 'issues' => $_,
2337             }, grep { !$_->{'overdue'} } @issues ],
2338
2339             'overdue' => [ map {
2340                 'biblio' => $_,
2341                 'items'  => $_,
2342                 'issues' => $_,
2343             }, grep { $_->{'overdue'} } @issues ],
2344
2345             'news' => [ map {
2346                 $_->{'timestamp'} = $_->{'newdate'};
2347                 { opac_news => $_ }
2348             } @{ GetNewsToDisplay("slip",$branch) } ],
2349         );
2350     }
2351
2352     return  C4::Letters::GetPreparedLetter (
2353         module => 'circulation',
2354         letter_code => $letter_code,
2355         branchcode => $branch,
2356         tables => {
2357             'branches'    => $branch,
2358             'borrowers'   => $borrowernumber,
2359         },
2360         repeat => \%repeat,
2361     );
2362 }
2363
2364 =head2 GetBorrowersWithEmail
2365
2366     ([$borrnum,$userid], ...) = GetBorrowersWithEmail('me@example.com');
2367
2368 This gets a list of users and their basic details from their email address.
2369 As it's possible for multiple user to have the same email address, it provides
2370 you with all of them. If there is no userid for the user, there will be an
2371 C<undef> there. An empty list will be returned if there are no matches.
2372
2373 =cut
2374
2375 sub GetBorrowersWithEmail {
2376     my $email = shift;
2377
2378     my $dbh = C4::Context->dbh;
2379
2380     my $query = "SELECT borrowernumber, userid FROM borrowers WHERE email=?";
2381     my $sth=$dbh->prepare($query);
2382     $sth->execute($email);
2383     my @result = ();
2384     while (my $ref = $sth->fetch) {
2385         push @result, $ref;
2386     }
2387     die "Failure searching for borrowers by email address: $sth->errstr" if $sth->err;
2388     return @result;
2389 }
2390
2391 sub AddMember_Opac {
2392     my ( %borrower ) = @_;
2393
2394     $borrower{'categorycode'} = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
2395
2396     my $sr = new String::Random;
2397     $sr->{'A'} = [ 'A'..'Z', 'a'..'z' ];
2398     my $password = $sr->randpattern("AAAAAAAAAA");
2399     $borrower{'password'} = $password;
2400
2401     $borrower{'cardnumber'} = fixup_cardnumber();
2402
2403     my $borrowernumber = AddMember(%borrower);
2404
2405     return ( $borrowernumber, $password );
2406 }
2407
2408 =head2 AddEnrolmentFeeIfNeeded
2409
2410     AddEnrolmentFeeIfNeeded( $borrower->{categorycode}, $borrower->{borrowernumber} );
2411
2412 Add enrolment fee for a patron if needed.
2413
2414 =cut
2415
2416 sub AddEnrolmentFeeIfNeeded {
2417     my ( $categorycode, $borrowernumber ) = @_;
2418     # check for enrollment fee & add it if needed
2419     my $dbh = C4::Context->dbh;
2420     my $sth = $dbh->prepare(q{
2421         SELECT enrolmentfee
2422         FROM categories
2423         WHERE categorycode=?
2424     });
2425     $sth->execute( $categorycode );
2426     if ( $sth->err ) {
2427         warn sprintf('Database returned the following error: %s', $sth->errstr);
2428         return;
2429     }
2430     my ($enrolmentfee) = $sth->fetchrow;
2431     if ($enrolmentfee && $enrolmentfee > 0) {
2432         # insert fee in patron debts
2433         C4::Accounts::manualinvoice( $borrowernumber, '', '', 'A', $enrolmentfee );
2434     }
2435 }
2436
2437 sub HasOverdues {
2438     my ( $borrowernumber ) = @_;
2439
2440     my $sql = "SELECT COUNT(*) FROM issues WHERE date_due < NOW() AND borrowernumber = ?";
2441     my $sth = C4::Context->dbh->prepare( $sql );
2442     $sth->execute( $borrowernumber );
2443     my ( $count ) = $sth->fetchrow_array();
2444
2445     return $count;
2446 }
2447
2448 END { }    # module clean-up code here (global destructor)
2449
2450 1;
2451
2452 __END__
2453
2454 =head1 AUTHOR
2455
2456 Koha Team
2457
2458 =cut