C4/Members.pm

   1 package C4::Members;
   2
   3 # Copyright 2000-2003 Katipo Communications
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it under the
   8 # terms of the GNU General Public License as published by the Free Software
   9 # Foundation; either version 2 of the License, or (at your option) any later
  10 # version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along with
  17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  18 # Suite 330, Boston, MA  02111-1307 USA
  19
  20
  21 use strict;
  22 use C4::Context;
  23 use C4::Dates qw(format_date_in_iso);
  24 use Digest::MD5 qw(md5_base64);
  25 use Date::Calc qw/Today Add_Delta_YM/;
  26 use C4::Log; # logaction
  27 use C4::Overdues;
  28 use C4::Reserves;
  29 use C4::Accounts;
  30 use C4::Biblio;
  31
  32 our ($VERSION,@ISA,@EXPORT,@EXPORT_OK,$debug);
  33
  34 BEGIN {
  35         $VERSION = 3.02;
  36         $debug = $ENV{DEBUG} || 0;
  37         require Exporter;
  38         @ISA = qw(Exporter);
  39         #Get data
  40         push @EXPORT, qw(
  41                 &SearchMember
  42                 &GetMemberDetails
  43                 &GetMember
  44
  45                 &GetGuarantees
  46
  47                 &GetMemberIssuesAndFines
  48                 &GetPendingIssues
  49                 &GetAllIssues
  50
  51                 &get_institutions
  52                 &getzipnamecity
  53                 &getidcity
  54
  55                 &GetAge
  56                 &GetCities
  57                 &GetRoadTypes
  58                 &GetRoadTypeDetails
  59                 &GetSortDetails
  60                 &GetTitles
  61
  62     &GetPatronImage
  63     &PutPatronImage
  64     &RmPatronImage
  65
  66                 &GetMemberAccountRecords
  67                 &GetBorNotifyAcctRecord
  68
  69                 &GetborCatFromCatType
  70                 &GetBorrowercategory
  71     &GetBorrowercategoryList
  72
  73                 &GetBorrowersWhoHaveNotBorrowedSince
  74                 &GetBorrowersWhoHaveNeverBorrowed
  75                 &GetBorrowersWithIssuesHistoryOlderThan
  76
  77                 &GetExpiryDate
  78         );
  79
  80         #Modify data
  81         push @EXPORT, qw(
  82                 &ModMember
  83                 &changepassword
  84         );
  85
  86         #Delete data
  87         push @EXPORT, qw(
  88                 &DelMember
  89         );
  90
  91         #Insert data
  92         push @EXPORT, qw(
  93                 &AddMember
  94                 &add_member_orgs
  95                 &MoveMemberToDeleted
  96                 &ExtendMemberSubscriptionTo
  97         );
  98
  99         #Check data
 100     push @EXPORT, qw(
 101         &checkuniquemember
 102         &checkuserpassword
 103         &Check_Userid
 104         &Generate_Userid
 105         &fixEthnicity
 106         &ethnicitycategories
 107         &fixup_cardnumber
 108         &checkcardnumber
 109     );
 110 }
 111
 112 =head1 NAME
 113
 114 C4::Members - Perl Module containing convenience functions for member handling
 115
 116 =head1 SYNOPSIS
 117
 118 use C4::Members;
 119
 120 =head1 DESCRIPTION
 121
 122 This module contains routines for adding, modifying and deleting members/patrons/borrowers
 123
 124 =head1 FUNCTIONS
 125
 126 =over 2
 127
 128 =item SearchMember
 129
 130   ($count, $borrowers) = &SearchMember($searchstring, $type,$category_type,$filter,$showallbranches);
 131
 132 =back
 133
 134 Looks up patrons (borrowers) by name.
 135
 136 BUGFIX 499: C<$type> is now used to determine type of search.
 137 if $type is "simple", search is performed on the first letter of the
 138 surname only.
 139
 140 $category_type is used to get a specified type of user.
 141 (mainly adults when creating a child.)
 142
 143 C<$searchstring> is a space-separated list of search terms. Each term
 144 must match the beginning a borrower's surname, first name, or other
 145 name.
 146
 147 C<$filter> is assumed to be a list of elements to filter results on
 148
 149 C<$showallbranches> is used in IndependantBranches Context to display all branches results.
 150
 151 C<&SearchMember> returns a two-element list. C<$borrowers> is a
 152 reference-to-array; each element is a reference-to-hash, whose keys
 153 are the fields of the C<borrowers> table in the Koha database.
 154 C<$count> is the number of elements in C<$borrowers>.
 155
 156 =cut
 157
 158 #'
 159 #used by member enquiries from the intranet
 160 #called by member.pl and circ/circulation.pl
 161 sub SearchMember {
 162     my ($searchstring, $orderby, $type,$category_type,$filter,$showallbranches ) = @_;
 163     my $dbh   = C4::Context->dbh;
 164     my $query = "";
 165     my $count;
 166     my @data;
 167     my @bind = ();
 168
 169     # this is used by circulation everytime a new borrowers cardnumber is scanned
 170     # so we can check an exact match first, if that works return, otherwise do the rest
 171     $query = "SELECT * FROM borrowers
 172         LEFT JOIN categories ON borrowers.categorycode=categories.categorycode
 173         ";
 174     my $sth = $dbh->prepare("$query WHERE cardnumber = ?");
 175     $sth->execute($searchstring);
 176     my $data = $sth->fetchall_arrayref({});
 177     if (@$data){
 178         return ( scalar(@$data), $data );
 179     }
 180     $sth->finish;
 181
 182     if ( $type eq "simple" )    # simple search for one letter only
 183     {
 184         $query .= ($category_type ? " AND category_type = ".$dbh->quote($category_type) : "");
 185         $query .= " WHERE (surname LIKE ? OR cardnumber like ?) ";
 186         if (C4::Context->preference("IndependantBranches") && !$showallbranches){
 187           if (C4::Context->userenv && C4::Context->userenv->{flags} % 2 !=1 && C4::Context->userenv->{'branch'}){
 188             $query.=" AND borrowers.branchcode =".$dbh->quote(C4::Context->userenv->{'branch'}) unless (C4::Context->userenv->{'branch'} eq "insecure");
 189           }
 190         }
 191         $query.=" ORDER BY $orderby";
 192         @bind = ("$searchstring%","$searchstring");
 193     }
 194     else    # advanced search looking in surname, firstname and othernames
 195     {
 196         @data  = split( ' ', $searchstring );
 197         $count = @data;
 198         $query .= " WHERE ";
 199         if (C4::Context->preference("IndependantBranches") && !$showallbranches){
 200           if (C4::Context->userenv && C4::Context->userenv->{flags} % 2 !=1 && C4::Context->userenv->{'branch'}){
 201             $query.=" borrowers.branchcode =".$dbh->quote(C4::Context->userenv->{'branch'})." AND " unless (C4::Context->userenv->{'branch'} eq "insecure");
 202           }
 203         }
 204         $query.="((surname LIKE ? OR surname LIKE ?
 205                 OR firstname  LIKE ? OR firstname LIKE ?
 206                 OR othernames LIKE ? OR othernames LIKE ?)
 207         " .
 208         ($category_type?" AND category_type = ".$dbh->quote($category_type):"");
 209         @bind = (
 210             "$data[0]%", "% $data[0]%", "$data[0]%", "% $data[0]%",
 211             "$data[0]%", "% $data[0]%"
 212         );
 213         for ( my $i = 1 ; $i < $count ; $i++ ) {
 214             $query = $query . " AND (" . " surname LIKE ? OR surname LIKE ?
 215                 OR firstname  LIKE ? OR firstname LIKE ?
 216                 OR othernames LIKE ? OR othernames LIKE ?)";
 217             push( @bind,
 218                 "$data[$i]%",   "% $data[$i]%", "$data[$i]%",
 219                 "% $data[$i]%", "$data[$i]%",   "% $data[$i]%" );
 220
 221             # FIXME - .= <<EOT;
 222         }
 223         $query = $query . ") OR cardnumber LIKE ? ";
 224         push( @bind, $searchstring );
 225         if (C4::Context->preference('ExtendedPatronAttributes')) {
 226             $query .= "OR borrowernumber IN (
 227 SELECT borrowernumber
 228 FROM borrower_attributes
 229 JOIN borrower_attribute_types USING (code)
 230 WHERE staff_searchable = 1
 231 AND attribute like ?
 232 )";
 233             push (@bind, $searchstring);
 234         }
 235         $query .= "order by $orderby";
 236
 237         # FIXME - .= <<EOT;
 238     }
 239
 240     $sth = $dbh->prepare($query);
 241
 242     $debug and print STDERR "Q $orderby : $query\n";
 243     $sth->execute(@bind);
 244     my @results;
 245     $data = $sth->fetchall_arrayref({});
 246
 247     $sth->finish;
 248     return ( scalar(@$data), $data );
 249 }
 250
 251 =head2 GetMemberDetails
 252
 253 ($borrower) = &GetMemberDetails($borrowernumber, $cardnumber);
 254
 255 Looks up a patron and returns information about him or her. If
 256 C<$borrowernumber> is true (nonzero), C<&GetMemberDetails> looks
 257 up the borrower by number; otherwise, it looks up the borrower by card
 258 number.
 259
 260 C<$borrower> is a reference-to-hash whose keys are the fields of the
 261 borrowers table in the Koha database. In addition,
 262 C<$borrower-E<gt>{flags}> is a hash giving more detailed information
 263 about the patron. Its keys act as flags :
 264
 265     if $borrower->{flags}->{LOST} {
 266         # Patron's card was reported lost
 267     }
 268
 269 Each flag has a C<message> key, giving a human-readable explanation of
 270 the flag. If the state of a flag means that the patron should not be
 271 allowed to borrow any more books, then it will have a C<noissues> key
 272 with a true value.
 273
 274 The possible flags are:
 275
 276 =head3 CHARGES
 277
 278 =over 4
 279
 280 =item Shows the patron's credit or debt, if any.
 281
 282 =back
 283
 284 =head3 GNA
 285
 286 =over 4
 287
 288 =item (Gone, no address.) Set if the patron has left without giving a
 289 forwarding address.
 290
 291 =back
 292
 293 =head3 LOST
 294
 295 =over 4
 296
 297 =item Set if the patron's card has been reported as lost.
 298
 299 =back
 300
 301 =head3 DBARRED
 302
 303 =over 4
 304
 305 =item Set if the patron has been debarred.
 306
 307 =back
 308
 309 =head3 NOTES
 310
 311 =over 4
 312
 313 =item Any additional notes about the patron.
 314
 315 =back
 316
 317 =head3 ODUES
 318
 319 =over 4
 320
 321 =item Set if the patron has overdue items. This flag has several keys:
 322
 323 C<$flags-E<gt>{ODUES}{itemlist}> is a reference-to-array listing the
 324 overdue items. Its elements are references-to-hash, each describing an
 325 overdue item. The keys are selected fields from the issues, biblio,
 326 biblioitems, and items tables of the Koha database.
 327
 328 C<$flags-E<gt>{ODUES}{itemlist}> is a string giving a text listing of
 329 the overdue items, one per line.
 330
 331 =back
 332
 333 =head3 WAITING
 334
 335 =over 4
 336
 337 =item Set if any items that the patron has reserved are available.
 338
 339 C<$flags-E<gt>{WAITING}{itemlist}> is a reference-to-array listing the
 340 available items. Each element is a reference-to-hash whose keys are
 341 fields from the reserves table of the Koha database.
 342
 343 =back
 344
 345 C<$borrower-E<gt>{authflags}> is a hash giving more detailed information
 346 about the top-level permissions flags set for the borrower.  For example,
 347 if a user has the "editcatalogue" permission,
 348 C<$borrower-E<gt>{authflags}-E<gt>{editcatalogue}> will exist and have
 349 the value "1".
 350
 351 =cut
 352
 353 sub GetMemberDetails {
 354     my ( $borrowernumber, $cardnumber ) = @_;
 355     my $dbh = C4::Context->dbh;
 356     my $query;
 357     my $sth;
 358     if ($borrowernumber) {
 359         $sth = $dbh->prepare("select borrowers.*,category_type,categories.description from borrowers left join categories on borrowers.categorycode=categories.categorycode where  borrowernumber=?");
 360         $sth->execute($borrowernumber);
 361     }
 362     elsif ($cardnumber) {
 363         $sth = $dbh->prepare("select borrowers.*,category_type,categories.description from borrowers left join categories on borrowers.categorycode=categories.categorycode where cardnumber=?");
 364         $sth->execute($cardnumber);
 365     }
 366     else {
 367         return undef;
 368     }
 369     my $borrower = $sth->fetchrow_hashref;
 370     my ($amount) = GetMemberAccountRecords( $borrowernumber);
 371     $borrower->{'amountoutstanding'} = $amount;
 372     # FIXME - patronflags calls GetMemberAccountRecords... just have patronflags return $amount
 373     my $flags = patronflags( $borrower);
 374     my $accessflagshash;
 375
 376     $sth = $dbh->prepare("select bit,flag from userflags");
 377     $sth->execute;
 378     while ( my ( $bit, $flag ) = $sth->fetchrow ) {
 379         if ( $borrower->{'flags'} && $borrower->{'flags'} & 2**$bit ) {
 380             $accessflagshash->{$flag} = 1;
 381         }
 382     }
 383     $sth->finish;
 384     $borrower->{'flags'}     = $flags;
 385     $borrower->{'authflags'} = $accessflagshash;
 386
 387     # find out how long the membership lasts
 388     $sth =
 389       $dbh->prepare(
 390         "select enrolmentperiod from categories where categorycode = ?");
 391     $sth->execute( $borrower->{'categorycode'} );
 392     my $enrolment = $sth->fetchrow;
 393     $borrower->{'enrolmentperiod'} = $enrolment;
 394     return ($borrower);    #, $flags, $accessflagshash);
 395 }
 396
 397 =head2 patronflags
 398
 399  Not exported
 400
 401  NOTE!: If you change this function, be sure to update the POD for
 402  &GetMemberDetails.
 403
 404  $flags = &patronflags($patron);
 405
 406  $flags->{CHARGES}
 407         {message}    Message showing patron's credit or debt
 408        {noissues}    Set if patron owes >$5.00
 409          {GNA}            Set if patron gone w/o address
 410         {message}    "Borrower has no valid address"
 411         {noissues}    Set.
 412         {LOST}        Set if patron's card reported lost
 413         {message}    Message to this effect
 414         {noissues}    Set.
 415         {DBARRED}        Set is patron is debarred
 416         {message}    Message to this effect
 417         {noissues}    Set.
 418          {NOTES}        Set if patron has notes
 419         {message}    Notes about patron
 420          {ODUES}        Set if patron has overdue books
 421         {message}    "Yes"
 422         {itemlist}    ref-to-array: list of overdue books
 423         {itemlisttext}    Text list of overdue items
 424          {WAITING}        Set if there are items available that the
 425                 patron reserved
 426         {message}    Message to this effect
 427         {itemlist}    ref-to-array: list of available items
 428
 429 =cut
 430 # FIXME rename this function.
 431 sub patronflags {
 432     my %flags;
 433     my ( $patroninformation) = @_;
 434     my $dbh=C4::Context->dbh;
 435     my ($amount) = GetMemberAccountRecords( $patroninformation->{'borrowernumber'});
 436     if ( $amount > 0 ) {
 437         my %flaginfo;
 438         my $noissuescharge = C4::Context->preference("noissuescharge");
 439         $flaginfo{'message'} = sprintf "Patron owes \$%.02f", $amount;
 440         $flaginfo{'amount'} = sprintf "%.02f",$amount;
 441         if ( $amount > $noissuescharge ) {
 442             $flaginfo{'noissues'} = 1;
 443         }
 444         $flags{'CHARGES'} = \%flaginfo;
 445     }
 446     elsif ( $amount < 0 ) {
 447         my %flaginfo;
 448         $flaginfo{'message'} = sprintf "Patron has credit of \$%.02f", -$amount;
 449         $flags{'CREDITS'} = \%flaginfo;
 450     }
 451     if (   $patroninformation->{'gonenoaddress'}
 452         && $patroninformation->{'gonenoaddress'} == 1 )
 453     {
 454         my %flaginfo;
 455         $flaginfo{'message'}  = 'Borrower has no valid address.';
 456         $flaginfo{'noissues'} = 1;
 457         $flags{'GNA'}         = \%flaginfo;
 458     }
 459     if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
 460         my %flaginfo;
 461         $flaginfo{'message'}  = 'Borrower\'s card reported lost.';
 462         $flaginfo{'noissues'} = 1;
 463         $flags{'LOST'}        = \%flaginfo;
 464     }
 465     if (   $patroninformation->{'debarred'}
 466         && $patroninformation->{'debarred'} == 1 )
 467     {
 468         my %flaginfo;
 469         $flaginfo{'message'}  = 'Borrower is Debarred.';
 470         $flaginfo{'noissues'} = 1;
 471         $flags{'DBARRED'}     = \%flaginfo;
 472     }
 473     if (   $patroninformation->{'borrowernotes'}
 474         && $patroninformation->{'borrowernotes'} )
 475     {
 476         my %flaginfo;
 477         $flaginfo{'message'} = "$patroninformation->{'borrowernotes'}";
 478         $flags{'NOTES'}      = \%flaginfo;
 479     }
 480     my ( $odues, $itemsoverdue ) =
 481       checkoverdues( $patroninformation->{'borrowernumber'}, $dbh );
 482     if ( $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";
 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, $type);
 509
 510 Looks up information about a patron (borrower) by either card number
 511 ,firstname, or borrower number, depending on $type value.
 512 If C<$type> == 'cardnumber', C<&GetBorrower>
 513 searches by cardnumber then by firstname if not found in cardnumber;
 514 otherwise, it searches by borrowernumber.
 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 =cut
 520
 521 #'
 522 sub GetMember {
 523     my ( $information, $type ) = @_;
 524     my $dbh = C4::Context->dbh;
 525     my $sth;
 526     my $select = "
 527 SELECT borrowers.*, categories.category_type, categories.description
 528 FROM borrowers
 529 LEFT JOIN categories on borrowers.categorycode=categories.categorycode
 530 ";
 531     if (defined($type) and ( $type eq 'cardnumber' || $type eq 'firstname'|| $type eq 'userid'|| $type eq 'borrowernumber' ) ){
 532         $information = uc $information;
 533         $sth = $dbh->prepare("$select WHERE $type=?");
 534     } else {
 535         $sth = $dbh->prepare("$select WHERE borrowernumber=?");
 536     }
 537     $sth->execute($information);
 538     my $data = $sth->fetchrow_hashref;
 539     ($data) and return ($data);
 540
 541     if (defined($type) and ($type eq 'cardnumber' || $type eq 'firstname')) {    # otherwise, try with firstname
 542         $sth = $dbh->prepare("$select WHERE firstname like ?");
 543         $sth->execute($information);
 544         $data = $sth->fetchrow_hashref;
 545         ($data) and return ($data);
 546     }
 547     return undef;
 548 }
 549
 550 =head2 GetMemberIssuesAndFines
 551
 552   ($overdue_count, $issue_count, $total_fines) = &GetMemberIssuesAndFines($borrowernumber);
 553
 554 Returns aggregate data about items borrowed by the patron with the
 555 given borrowernumber.
 556
 557 C<&GetMemberIssuesAndFines> returns a three-element array.  C<$overdue_count> is the
 558 number of overdue items the patron currently has borrowed. C<$issue_count> is the
 559 number of books the patron currently has borrowed.  C<$total_fines> is
 560 the total fine currently due by the borrower.
 561
 562 =cut
 563
 564 #'
 565 sub GetMemberIssuesAndFines {
 566     my ( $borrowernumber ) = @_;
 567     my $dbh   = C4::Context->dbh;
 568     my $query = "SELECT COUNT(*) FROM issues WHERE borrowernumber = ?";
 569
 570     $debug and warn $query."\n";
 571     my $sth = $dbh->prepare($query);
 572     $sth->execute($borrowernumber);
 573     my $issue_count = $sth->fetchrow_arrayref->[0];
 574     $sth->finish;
 575
 576     $sth = $dbh->prepare(
 577         "SELECT COUNT(*) FROM issues
 578          WHERE borrowernumber = ?
 579          AND date_due < now()"
 580     );
 581     $sth->execute($borrowernumber);
 582     my $overdue_count = $sth->fetchrow_arrayref->[0];
 583     $sth->finish;
 584
 585     $sth = $dbh->prepare("SELECT SUM(amountoutstanding) FROM accountlines WHERE borrowernumber = ?");
 586     $sth->execute($borrowernumber);
 587     my $total_fines = $sth->fetchrow_arrayref->[0];
 588     $sth->finish;
 589
 590     return ($overdue_count, $issue_count, $total_fines);
 591 }
 592
 593 sub columns(;$) {
 594     return @{C4::Context->dbh->selectcol_arrayref("SHOW columns from borrowers")};
 595 }
 596
 597 =head2
 598
 599 =head2 ModMember
 600
 601 =over 4
 602
 603 my $success = ModMember(borrowernumber => $borrowernumber, [ field => value ]... );
 604
 605 Modify borrower's data.  All date fields should ALREADY be in ISO format.
 606
 607 return :
 608 true on success, or false on failure
 609
 610 =back
 611
 612 =cut
 613
 614 sub ModMember {
 615     my (%data) = @_;
 616     my $dbh = C4::Context->dbh;
 617     my $iso_re = C4::Dates->new()->regexp('iso');
 618     foreach (qw(dateofbirth dateexpiry dateenrolled)) {
 619         if (my $tempdate = $data{$_}) {                                 # assignment, not comparison
 620             ($tempdate =~ /$iso_re/) and next;                          # Congatulations, you sent a valid ISO date.
 621             warn "ModMember given $_ not in ISO format ($tempdate)";
 622             my $tempdate2 = format_date_in_iso($tempdate);
 623             if (!$tempdate2 or $tempdate2 eq '0000-00-00') {
 624                 warn "ModMember cannot convert '$tempdate' (from syspref to ISO)";
 625                 next;
 626             }
 627             $data{$_} = $tempdate2;
 628         }
 629     }
 630     if (!$data{'dateofbirth'}){
 631         delete $data{'dateofbirth'};
 632     }
 633     my @columns = &columns;
 634     my %hashborrowerfields = (map {$_=>1} @columns);
 635     my $query = "UPDATE borrowers SET \n";
 636     my $sth;
 637     my @parameters;
 638
 639     # test to know if you must update or not the borrower password
 640     if (exists $data{password}) {
 641         if ($data{password} eq '****' or $data{password} eq '') {
 642             delete $data{password};
 643         } else {
 644             $data{password} = md5_base64($data{password});
 645         }
 646     }
 647     my @badkeys;
 648     foreach (keys %data) {
 649         next if ($_ eq 'borrowernumber' or $_ eq 'flags');
 650         if ($hashborrowerfields{$_}){
 651             $query .= " $_=?, ";
 652             push @parameters,$data{$_};
 653         } else {
 654             push @badkeys, $_;
 655             delete $data{$_};
 656         }
 657     }
 658     (@badkeys) and warn scalar(@badkeys) . " Illegal key(s) passed to ModMember: " . join(',',@badkeys);
 659     $query =~ s/, $//;
 660     $query .= " WHERE borrowernumber=?";
 661     push @parameters, $data{'borrowernumber'};
 662     $debug and print STDERR "$query (executed w/ arg: $data{'borrowernumber'})";
 663     $sth = $dbh->prepare($query);
 664     my $execute_success = $sth->execute(@parameters);
 665     $sth->finish;
 666
 667 # ok if its an adult (type) it may have borrowers that depend on it as a guarantor
 668 # so when we update information for an adult we should check for guarantees and update the relevant part
 669 # of their records, ie addresses and phone numbers
 670     my $borrowercategory= GetBorrowercategory( $data{'category_type'} );
 671     if ( exists  $borrowercategory->{'category_type'} && $borrowercategory->{'category_type'} eq ('A' || 'S') ) {
 672         # is adult check guarantees;
 673         UpdateGuarantees(%data);
 674     }
 675     logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "$query (executed w/ arg: $data{'borrowernumber'})")
 676         if C4::Context->preference("BorrowersLog");
 677
 678     return $execute_success;
 679 }
 680
 681
 682 =head2
 683
 684 =head2 AddMember
 685
 686   $borrowernumber = &AddMember(%borrower);
 687
 688 insert new borrower into table
 689 Returns the borrowernumber
 690
 691 =cut
 692
 693 #'
 694 sub AddMember {
 695     my (%data) = @_;
 696     my $dbh = C4::Context->dbh;
 697     $data{'userid'} = '' unless $data{'password'};
 698     $data{'password'} = md5_base64( $data{'password'} ) if $data{'password'};
 699
 700     # WE SHOULD NEVER PASS THIS SUBROUTINE ANYTHING OTHER THAN ISO DATES
 701     # IF YOU UNCOMMENT THESE LINES YOU BETTER HAVE A DARN COMPELLING REASON
 702 #    $data{'dateofbirth'}  = format_date_in_iso( $data{'dateofbirth'} );
 703 #    $data{'dateenrolled'} = format_date_in_iso( $data{'dateenrolled'});
 704 #    $data{'dateexpiry'}   = format_date_in_iso( $data{'dateexpiry'}  );
 705     # This query should be rewritten to use "?" at execute.
 706     if (!$data{'dateofbirth'}){
 707         undef ($data{'dateofbirth'});
 708     }
 709     my $query =
 710         "insert into borrowers set cardnumber=" . $dbh->quote( $data{'cardnumber'} )
 711       . ",surname="     . $dbh->quote( $data{'surname'} )
 712       . ",firstname="   . $dbh->quote( $data{'firstname'} )
 713       . ",title="       . $dbh->quote( $data{'title'} )
 714       . ",othernames="  . $dbh->quote( $data{'othernames'} )
 715       . ",initials="    . $dbh->quote( $data{'initials'} )
 716       . ",streetnumber=". $dbh->quote( $data{'streetnumber'} )
 717       . ",streettype="  . $dbh->quote( $data{'streettype'} )
 718       . ",address="     . $dbh->quote( $data{'address'} )
 719       . ",address2="    . $dbh->quote( $data{'address2'} )
 720       . ",zipcode="     . $dbh->quote( $data{'zipcode'} )
 721       . ",city="        . $dbh->quote( $data{'city'} )
 722       . ",phone="       . $dbh->quote( $data{'phone'} )
 723       . ",email="       . $dbh->quote( $data{'email'} )
 724       . ",mobile="      . $dbh->quote( $data{'mobile'} )
 725       . ",phonepro="    . $dbh->quote( $data{'phonepro'} )
 726       . ",opacnote="    . $dbh->quote( $data{'opacnote'} )
 727       . ",guarantorid=" . $dbh->quote( $data{'guarantorid'} )
 728       . ",dateofbirth=" . $dbh->quote( $data{'dateofbirth'} )
 729       . ",branchcode="  . $dbh->quote( $data{'branchcode'} )
 730       . ",categorycode=" . $dbh->quote( $data{'categorycode'} )
 731       . ",dateenrolled=" . $dbh->quote( $data{'dateenrolled'} )
 732       . ",contactname=" . $dbh->quote( $data{'contactname'} )
 733       . ",borrowernotes=" . $dbh->quote( $data{'borrowernotes'} )
 734       . ",dateexpiry="  . $dbh->quote( $data{'dateexpiry'} )
 735       . ",contactnote=" . $dbh->quote( $data{'contactnote'} )
 736       . ",B_address="   . $dbh->quote( $data{'B_address'} )
 737       . ",B_zipcode="   . $dbh->quote( $data{'B_zipcode'} )
 738       . ",B_city="      . $dbh->quote( $data{'B_city'} )
 739       . ",B_phone="     . $dbh->quote( $data{'B_phone'} )
 740       . ",B_email="     . $dbh->quote( $data{'B_email'} )
 741       . ",password="    . $dbh->quote( $data{'password'} )
 742       . ",userid="      . $dbh->quote( $data{'userid'} )
 743       . ",sort1="       . $dbh->quote( $data{'sort1'} )
 744       . ",sort2="       . $dbh->quote( $data{'sort2'} )
 745       . ",contacttitle=" . $dbh->quote( $data{'contacttitle'} )
 746       . ",emailpro="    . $dbh->quote( $data{'emailpro'} )
 747       . ",contactfirstname=" . $dbh->quote( $data{'contactfirstname'} )
 748       . ",sex="         . $dbh->quote( $data{'sex'} )
 749       . ",fax="         . $dbh->quote( $data{'fax'} )
 750       . ",relationship=" . $dbh->quote( $data{'relationship'} )
 751       . ",B_streetnumber=" . $dbh->quote( $data{'B_streetnumber'} )
 752       . ",B_streettype=" . $dbh->quote( $data{'B_streettype'} )
 753       . ",gonenoaddress=" . $dbh->quote( $data{'gonenoaddress'} )
 754       . ",lost="        . $dbh->quote( $data{'lost'} )
 755       . ",debarred="    . $dbh->quote( $data{'debarred'} )
 756       . ",ethnicity="   . $dbh->quote( $data{'ethnicity'} )
 757       . ",ethnotes="    . $dbh->quote( $data{'ethnotes'} )
 758       . ",altcontactsurname="   . $dbh->quote( $data{'altcontactsurname'} )
 759       . ",altcontactfirstname="     . $dbh->quote( $data{'altcontactfirstname'} )
 760       . ",altcontactaddress1="  . $dbh->quote( $data{'altcontactaddress1'} )
 761       . ",altcontactaddress2="  . $dbh->quote( $data{'altcontactaddress2'} )
 762       . ",altcontactaddress3="  . $dbh->quote( $data{'altcontactaddress3'} )
 763       . ",altcontactzipcode="   . $dbh->quote( $data{'altcontactzipcode'} )
 764       . ",altcontactphone="     . $dbh->quote( $data{'altcontactphone'} ) ;
 765     $debug and print STDERR "AddMember SQL: ($query)\n";
 766     my $sth = $dbh->prepare($query);
 767     #   print "Executing SQL: $query\n";
 768     $sth->execute();
 769     $sth->finish;
 770     $data{'borrowernumber'} = $dbh->{'mysql_insertid'};     # unneeded w/ autoincrement ?
 771     # mysql_insertid is probably bad.  not necessarily accurate and mysql-specific at best.
 772
 773     logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
 774
 775     # check for enrollment fee & add it if needed
 776     $sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
 777     $sth->execute($data{'categorycode'});
 778     my ($enrolmentfee) = $sth->fetchrow;
 779     if ($enrolmentfee && $enrolmentfee > 0) {
 780         # insert fee in patron debts
 781         manualinvoice($data{'borrowernumber'}, '', '', 'A', $enrolmentfee);
 782     }
 783     return $data{'borrowernumber'};
 784 }
 785
 786 sub Check_Userid {
 787     my ($uid,$member) = @_;
 788     my $dbh = C4::Context->dbh;
 789     # Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
 790     # Then we need to tell the user and have them create a new one.
 791     my $sth =
 792       $dbh->prepare(
 793         "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
 794     $sth->execute( $uid, $member );
 795     if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
 796         return 0;
 797     }
 798     else {
 799         return 1;
 800     }
 801 }
 802
 803 sub Generate_Userid {
 804   my ($borrowernumber, $firstname, $surname) = @_;
 805   my $newuid;
 806   my $offset = 0;
 807   do {
 808     $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
 809     $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
 810     $newuid = lc("$firstname.$surname");
 811     $newuid .= $offset unless $offset == 0;
 812     $offset++;
 813
 814    } while (!Check_Userid($newuid,$borrowernumber));
 815
 816    return $newuid;
 817 }
 818
 819 sub changepassword {
 820     my ( $uid, $member, $digest ) = @_;
 821     my $dbh = C4::Context->dbh;
 822
 823 #Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
 824 #Then we need to tell the user and have them create a new one.
 825     my $resultcode;
 826     my $sth =
 827       $dbh->prepare(
 828         "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
 829     $sth->execute( $uid, $member );
 830     if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
 831         $resultcode=0;
 832     }
 833     else {
 834         #Everything is good so we can update the information.
 835         $sth =
 836           $dbh->prepare(
 837             "update borrowers set userid=?, password=? where borrowernumber=?");
 838         $sth->execute( $uid, $digest, $member );
 839         $resultcode=1;
 840     }
 841
 842     logaction("MEMBERS", "CHANGE PASS", $member, "") if C4::Context->preference("BorrowersLog");
 843     return $resultcode;
 844 }
 845
 846
 847
 848 =head2 fixup_cardnumber
 849
 850 Warning: The caller is responsible for locking the members table in write
 851 mode, to avoid database corruption.
 852
 853 =cut
 854
 855 use vars qw( @weightings );
 856 my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
 857
 858 sub fixup_cardnumber ($) {
 859     my ($cardnumber) = @_;
 860     my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;
 861
 862     # Find out whether member numbers should be generated
 863     # automatically. Should be either "1" or something else.
 864     # Defaults to "0", which is interpreted as "no".
 865
 866     #     if ($cardnumber !~ /\S/ && $autonumber_members) {
 867     ($autonumber_members) or return $cardnumber;
 868     my $checkdigit = C4::Context->preference('checkdigit');
 869     my $dbh = C4::Context->dbh;
 870     if ( $checkdigit and $checkdigit eq 'katipo' ) {
 871
 872         # if checkdigit is selected, calculate katipo-style cardnumber.
 873         # otherwise, just use the max()
 874         # purpose: generate checksum'd member numbers.
 875         # We'll assume we just got the max value of digits 2-8 of member #'s
 876         # from the database and our job is to increment that by one,
 877         # determine the 1st and 9th digits and return the full string.
 878         my $sth = $dbh->prepare(
 879             "select max(substring(borrowers.cardnumber,2,7)) as new_num from borrowers"
 880         );
 881         $sth->execute;
 882         my $data = $sth->fetchrow_hashref;
 883         $cardnumber = $data->{new_num};
 884         if ( !$cardnumber ) {    # If DB has no values,
 885             $cardnumber = 1000000;    # start at 1000000
 886         } else {
 887             $cardnumber += 1;
 888         }
 889
 890         my $sum = 0;
 891         for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
 892             # read weightings, left to right, 1 char at a time
 893             my $temp1 = $weightings[$i];
 894
 895             # sequence left to right, 1 char at a time
 896             my $temp2 = substr( $cardnumber, $i, 1 );
 897
 898             # mult each char 1-7 by its corresponding weighting
 899             $sum += $temp1 * $temp2;
 900         }
 901
 902         my $rem = ( $sum % 11 );
 903         $rem = 'X' if $rem == 10;
 904
 905         return "V$cardnumber$rem";
 906      } else {
 907
 908      # MODIFIED BY JF: mysql4.1 allows casting as an integer, which is probably
 909      # better. I'll leave the original in in case it needs to be changed for you
 910      # my $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers");
 911         my $sth = $dbh->prepare(
 912             "select max(cast(cardnumber as signed)) from borrowers"
 913         );
 914         $sth->execute;
 915         my ($result) = $sth->fetchrow;
 916         return $result + 1;
 917     }
 918     return $cardnumber;     # just here as a fallback/reminder
 919 }
 920
 921 =head2 GetGuarantees
 922
 923   ($num_children, $children_arrayref) = &GetGuarantees($parent_borrno);
 924   $child0_cardno = $children_arrayref->[0]{"cardnumber"};
 925   $child0_borrno = $children_arrayref->[0]{"borrowernumber"};
 926
 927 C<&GetGuarantees> takes a borrower number (e.g., that of a patron
 928 with children) and looks up the borrowers who are guaranteed by that
 929 borrower (i.e., the patron's children).
 930
 931 C<&GetGuarantees> returns two values: an integer giving the number of
 932 borrowers guaranteed by C<$parent_borrno>, and a reference to an array
 933 of references to hash, which gives the actual results.
 934
 935 =cut
 936
 937 #'
 938 sub GetGuarantees {
 939     my ($borrowernumber) = @_;
 940     my $dbh              = C4::Context->dbh;
 941     my $sth              =
 942       $dbh->prepare(
 943 "select cardnumber,borrowernumber, firstname, surname from borrowers where guarantorid=?"
 944       );
 945     $sth->execute($borrowernumber);
 946
 947     my @dat;
 948     my $data = $sth->fetchall_arrayref({});
 949     $sth->finish;
 950     return ( scalar(@$data), $data );
 951 }
 952
 953 =head2 UpdateGuarantees
 954
 955   &UpdateGuarantees($parent_borrno);
 956
 957
 958 C<&UpdateGuarantees> borrower data for an adult and updates all the guarantees
 959 with the modified information
 960
 961 =cut
 962
 963 #'
 964 sub UpdateGuarantees {
 965     my (%data) = @_;
 966     my $dbh = C4::Context->dbh;
 967     my ( $count, $guarantees ) = GetGuarantees( $data{'borrowernumber'} );
 968     for ( my $i = 0 ; $i < $count ; $i++ ) {
 969
 970         # FIXME
 971         # It looks like the $i is only being returned to handle walking through
 972         # the array, which is probably better done as a foreach loop.
 973         #
 974         my $guaquery = qq|UPDATE borrowers
 975               SET address='$data{'address'}',fax='$data{'fax'}',
 976                   B_city='$data{'B_city'}',mobile='$data{'mobile'}',city='$data{'city'}',phone='$data{'phone'}'
 977               WHERE borrowernumber='$guarantees->[$i]->{'borrowernumber'}'
 978         |;
 979         my $sth3 = $dbh->prepare($guaquery);
 980         $sth3->execute;
 981         $sth3->finish;
 982     }
 983 }
 984 =head2 GetPendingIssues
 985
 986   my $issues = &GetPendingIssues($borrowernumber);
 987
 988 Looks up what the patron with the given borrowernumber has borrowed.
 989
 990 C<&GetPendingIssues> returns a
 991 reference-to-array where each element is a reference-to-hash; the
 992 keys are the fields from the C<issues>, C<biblio>, and C<items> tables.
 993 The keys include C<biblioitems> fields except marc and marcxml.
 994
 995 =cut
 996
 997 #'
 998 sub GetPendingIssues {
 999     my ($borrowernumber) = @_;
1000     # must avoid biblioitems.* to prevent large marc and marcxml fields from killing performance
1001     # FIXME: namespace collision: each table has "timestamp" fields.  Which one is "timestamp" ?
1002     # FIXME: circ/ciculation.pl tries to sort by timestamp!
1003     # FIXME: C4::Print::printslip tries to sort by timestamp!
1004     # FIXME: namespace collision: other collisions possible.
1005     # FIXME: most of this data isn't really being used by callers.
1006     my $sth = C4::Context->dbh->prepare(
1007    "SELECT issues.*,
1008             items.*,
1009            biblio.*,
1010            biblioitems.volume,
1011            biblioitems.number,
1012            biblioitems.itemtype,
1013            biblioitems.isbn,
1014            biblioitems.issn,
1015            biblioitems.publicationyear,
1016            biblioitems.publishercode,
1017            biblioitems.volumedate,
1018            biblioitems.volumedesc,
1019            biblioitems.lccn,
1020            biblioitems.url,
1021            issues.timestamp AS timestamp,
1022            issues.renewals  AS renewals,
1023             items.renewals  AS totalrenewals
1024     FROM   issues
1025     LEFT JOIN items       ON items.itemnumber       =      issues.itemnumber
1026     LEFT JOIN biblio      ON items.biblionumber     =      biblio.biblionumber
1027     LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
1028     WHERE
1029       borrowernumber=?
1030     ORDER BY issues.issuedate"
1031     );
1032     $sth->execute($borrowernumber);
1033     my $data = $sth->fetchall_arrayref({});
1034     my $today = C4::Dates->new->output('iso');
1035     foreach (@$data) {
1036         $_->{date_due} or next;
1037         ($_->{date_due} lt $today) and $_->{overdue} = 1;
1038     }
1039     return $data;
1040 }
1041
1042 =head2 GetAllIssues
1043
1044   ($count, $issues) = &GetAllIssues($borrowernumber, $sortkey, $limit);
1045
1046 Looks up what the patron with the given borrowernumber has borrowed,
1047 and sorts the results.
1048
1049 C<$sortkey> is the name of a field on which to sort the results. This
1050 should be the name of a field in the C<issues>, C<biblio>,
1051 C<biblioitems>, or C<items> table in the Koha database.
1052
1053 C<$limit> is the maximum number of results to return.
1054
1055 C<&GetAllIssues> returns a two-element array. C<$issues> is a
1056 reference-to-array, where each element is a reference-to-hash; the
1057 keys are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
1058 C<items> tables of the Koha database. C<$count> is the number of
1059 elements in C<$issues>
1060
1061 =cut
1062
1063 #'
1064 sub GetAllIssues {
1065     my ( $borrowernumber, $order, $limit ) = @_;
1066
1067     #FIXME: sanity-check order and limit
1068     my $dbh   = C4::Context->dbh;
1069     my $count = 0;
1070     my $query =
1071   "SELECT *,issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1072   FROM issues
1073   LEFT JOIN items on items.itemnumber=issues.itemnumber
1074   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1075   LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1076   WHERE borrowernumber=?
1077   UNION ALL
1078   SELECT *,old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1079   FROM old_issues
1080   LEFT JOIN items on items.itemnumber=old_issues.itemnumber
1081   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1082   LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1083   WHERE borrowernumber=?
1084   order by $order";
1085     if ( $limit != 0 ) {
1086         $query .= " limit $limit";
1087     }
1088
1089     #print $query;
1090     my $sth = $dbh->prepare($query);
1091     $sth->execute($borrowernumber, $borrowernumber);
1092     my @result;
1093     my $i = 0;
1094     while ( my $data = $sth->fetchrow_hashref ) {
1095         $result[$i] = $data;
1096         $i++;
1097         $count++;
1098     }
1099
1100     # get all issued items for borrowernumber from oldissues table
1101     # large chunk of older issues data put into table oldissues
1102     # to speed up db calls for issuing items
1103     if ( C4::Context->preference("ReadingHistory") ) {
1104         # FIXME oldissues (not to be confused with old_issues) is
1105         # apparently specific to HLT.  Not sure if the ReadingHistory
1106         # syspref is still required, as old_issues by design
1107         # is no longer checked with each loan.
1108         my $query2 = "SELECT * FROM oldissues
1109                       LEFT JOIN items ON items.itemnumber=oldissues.itemnumber
1110                       LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1111                       LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1112                       WHERE borrowernumber=?
1113                       ORDER BY $order";
1114         if ( $limit != 0 ) {
1115             $limit = $limit - $count;
1116             $query2 .= " limit $limit";
1117         }
1118
1119         my $sth2 = $dbh->prepare($query2);
1120         $sth2->execute($borrowernumber);
1121
1122         while ( my $data2 = $sth2->fetchrow_hashref ) {
1123             $result[$i] = $data2;
1124             $i++;
1125         }
1126         $sth2->finish;
1127     }
1128     $sth->finish;
1129
1130     return ( $i, \@result );
1131 }
1132
1133
1134 =head2 GetMemberAccountRecords
1135
1136   ($total, $acctlines, $count) = &GetMemberAccountRecords($borrowernumber);
1137
1138 Looks up accounting data for the patron with the given borrowernumber.
1139
1140 C<&GetMemberAccountRecords> returns a three-element array. C<$acctlines> is a
1141 reference-to-array, where each element is a reference-to-hash; the
1142 keys are the fields of the C<accountlines> table in the Koha database.
1143 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1144 total amount outstanding for all of the account lines.
1145
1146 =cut
1147
1148 #'
1149 sub GetMemberAccountRecords {
1150     my ($borrowernumber,$date) = @_;
1151     my $dbh = C4::Context->dbh;
1152     my @acctlines;
1153     my $numlines = 0;
1154     my $strsth      = qq(
1155                         SELECT *
1156                         FROM accountlines
1157                         WHERE borrowernumber=?);
1158     my @bind = ($borrowernumber);
1159     if ($date && $date ne ''){
1160             $strsth.=" AND date < ? ";
1161             push(@bind,$date);
1162     }
1163     $strsth.=" ORDER BY date desc,timestamp DESC";
1164     my $sth= $dbh->prepare( $strsth );
1165     $sth->execute( @bind );
1166     my $total = 0;
1167     while ( my $data = $sth->fetchrow_hashref ) {
1168                 my $biblio = GetBiblioFromItemNumber($data->{itemnumber}) if $data->{itemnumber};
1169                 $data->{biblionumber} = $biblio->{biblionumber};
1170                 $data->{title} = $biblio->{title};
1171         $acctlines[$numlines] = $data;
1172         $numlines++;
1173         $total += int(100 * $data->{'amountoutstanding'}); # convert float to integer to avoid round-off errors
1174     }
1175     $total /= 100;
1176     $sth->finish;
1177     return ( $total, \@acctlines,$numlines);
1178 }
1179
1180 =head2 GetBorNotifyAcctRecord
1181
1182   ($count, $acctlines, $total) = &GetBorNotifyAcctRecord($params,$notifyid);
1183
1184 Looks up accounting data for the patron with the given borrowernumber per file number.
1185
1186 (FIXME - I'm not at all sure what this is about.)
1187
1188 C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a
1189 reference-to-array, where each element is a reference-to-hash; the
1190 keys are the fields of the C<accountlines> table in the Koha database.
1191 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1192 total amount outstanding for all of the account lines.
1193
1194 =cut
1195
1196 sub GetBorNotifyAcctRecord {
1197     my ( $borrowernumber, $notifyid ) = @_;
1198     my $dbh = C4::Context->dbh;
1199     my @acctlines;
1200     my $numlines = 0;
1201     my $sth = $dbh->prepare(
1202             "SELECT *
1203                 FROM accountlines
1204                 WHERE borrowernumber=?
1205                     AND notify_id=?
1206                     AND amountoutstanding != '0'
1207                 ORDER BY notify_id,accounttype
1208                 ");
1209 #                    AND (accounttype='FU' OR accounttype='N' OR accounttype='M'OR accounttype='A'OR accounttype='F'OR accounttype='L' OR accounttype='IP' OR accounttype='CH' OR accounttype='RE' OR accounttype='RL')
1210
1211     $sth->execute( $borrowernumber, $notifyid );
1212     my $total = 0;
1213     while ( my $data = $sth->fetchrow_hashref ) {
1214         $acctlines[$numlines] = $data;
1215         $numlines++;
1216         $total += int(100 * $data->{'amountoutstanding'});
1217     }
1218     $total /= 100;
1219     $sth->finish;
1220     return ( $total, \@acctlines, $numlines );
1221 }
1222
1223 =head2 checkuniquemember (OUEST-PROVENCE)
1224
1225   ($result,$categorycode)  = &checkuniquemember($collectivity,$surname,$firstname,$dateofbirth);
1226
1227 Checks that a member exists or not in the database.
1228
1229 C<&result> is nonzero (=exist) or 0 (=does not exist)
1230 C<&categorycode> is from categorycode table
1231 C<&collectivity> is 1 (= we add a collectivity) or 0 (= we add a physical member)
1232 C<&surname> is the surname
1233 C<&firstname> is the firstname (only if collectivity=0)
1234 C<&dateofbirth> is the date of birth in ISO format (only if collectivity=0)
1235
1236 =cut
1237
1238 # FIXME: This function is not legitimate.  Multiple patrons might have the same first/last name and birthdate.
1239 # This is especially true since first name is not even a required field.
1240
1241 sub checkuniquemember {
1242     my ( $collectivity, $surname, $firstname, $dateofbirth ) = @_;
1243     my $dbh = C4::Context->dbh;
1244     my $request = ($collectivity) ?
1245         "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? " :
1246             ($dateofbirth) ?
1247             "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=?  and dateofbirth=?" :
1248             "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=?";
1249     my $sth = $dbh->prepare($request);
1250     if ($collectivity) {
1251         $sth->execute( uc($surname) );
1252     } elsif($dateofbirth){
1253         $sth->execute( uc($surname), ucfirst($firstname), $dateofbirth );
1254     }else{
1255         $sth->execute( uc($surname), ucfirst($firstname));
1256     }
1257     my @data = $sth->fetchrow;
1258     $sth->finish;
1259     ( $data[0] ) and return $data[0], $data[1];
1260     return 0;
1261 }
1262
1263 sub checkcardnumber {
1264     my ($cardnumber,$borrowernumber) = @_;
1265     my $dbh = C4::Context->dbh;
1266     my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
1267     $query .= " AND borrowernumber <> ?" if ($borrowernumber);
1268   my $sth = $dbh->prepare($query);
1269   if ($borrowernumber) {
1270    $sth->execute($cardnumber,$borrowernumber);
1271   } else {
1272      $sth->execute($cardnumber);
1273   }
1274     if (my $data= $sth->fetchrow_hashref()){
1275         return 1;
1276     }
1277     else {
1278         return 0;
1279     }
1280     $sth->finish();
1281 }
1282
1283
1284 =head2 getzipnamecity (OUEST-PROVENCE)
1285
1286 take all info from table city for the fields city and  zip
1287 check for the name and the zip code of the city selected
1288
1289 =cut
1290
1291 sub getzipnamecity {
1292     my ($cityid) = @_;
1293     my $dbh      = C4::Context->dbh;
1294     my $sth      =
1295       $dbh->prepare(
1296         "select city_name,city_zipcode from cities where cityid=? ");
1297     $sth->execute($cityid);
1298     my @data = $sth->fetchrow;
1299     return $data[0], $data[1];
1300 }
1301
1302
1303 =head2 getdcity (OUEST-PROVENCE)
1304
1305 recover cityid  with city_name condition
1306
1307 =cut
1308
1309 sub getidcity {
1310     my ($city_name) = @_;
1311     my $dbh = C4::Context->dbh;
1312     my $sth = $dbh->prepare("select cityid from cities where city_name=? ");
1313     $sth->execute($city_name);
1314     my $data = $sth->fetchrow;
1315     return $data;
1316 }
1317
1318
1319 =head2 GetExpiryDate
1320
1321   $expirydate = GetExpiryDate($categorycode, $dateenrolled);
1322
1323 Calculate expiry date given a categorycode and starting date.  Date argument must be in ISO format.
1324 Return date is also in ISO format.
1325
1326 =cut
1327
1328 sub GetExpiryDate {
1329     my ( $categorycode, $dateenrolled ) = @_;
1330     my $enrolmentperiod = 12;   # reasonable default
1331     if ($categorycode) {
1332         my $dbh = C4::Context->dbh;
1333         my $sth = $dbh->prepare("select enrolmentperiod from categories where categorycode=?");
1334         $sth->execute($categorycode);
1335         $enrolmentperiod = $sth->fetchrow;
1336     }
1337     # die "GetExpiryDate: for enrollmentperiod $enrolmentperiod (category '$categorycode') starting $dateenrolled.\n";
1338     my @date = split /-/,$dateenrolled;
1339     return sprintf("%04d-%02d-%02d", Add_Delta_YM(@date,0,$enrolmentperiod));
1340 }
1341
1342 =head2 checkuserpassword (OUEST-PROVENCE)
1343
1344 check for the password and login are not used
1345 return the number of record
1346 0=> NOT USED 1=> USED
1347
1348 =cut
1349
1350 sub checkuserpassword {
1351     my ( $borrowernumber, $userid, $password ) = @_;
1352     $password = md5_base64($password);
1353     my $dbh = C4::Context->dbh;
1354     my $sth =
1355       $dbh->prepare(
1356 "Select count(*) from borrowers where borrowernumber !=? and userid =? and password=? "
1357       );
1358     $sth->execute( $borrowernumber, $userid, $password );
1359     my $number_rows = $sth->fetchrow;
1360     return $number_rows;
1361
1362 }
1363
1364 =head2 GetborCatFromCatType
1365
1366   ($codes_arrayref, $labels_hashref) = &GetborCatFromCatType();
1367
1368 Looks up the different types of borrowers in the database. Returns two
1369 elements: a reference-to-array, which lists the borrower category
1370 codes, and a reference-to-hash, which maps the borrower category codes
1371 to category descriptions.
1372
1373 =cut
1374
1375 #'
1376 sub GetborCatFromCatType {
1377     my ( $category_type, $action ) = @_;
1378         # FIXME - This API  seems both limited and dangerous.
1379     my $dbh     = C4::Context->dbh;
1380     my $request = qq|   SELECT categorycode,description
1381             FROM categories
1382             $action
1383             ORDER BY categorycode|;
1384     my $sth = $dbh->prepare($request);
1385         if ($action) {
1386         $sth->execute($category_type);
1387     }
1388     else {
1389         $sth->execute();
1390     }
1391
1392     my %labels;
1393     my @codes;
1394
1395     while ( my $data = $sth->fetchrow_hashref ) {
1396         push @codes, $data->{'categorycode'};
1397         $labels{ $data->{'categorycode'} } = $data->{'description'};
1398     }
1399     $sth->finish;
1400     return ( \@codes, \%labels );
1401 }
1402
1403 =head2 GetBorrowercategory
1404
1405   $hashref = &GetBorrowercategory($categorycode);
1406
1407 Given the borrower's category code, the function returns the corresponding
1408 data hashref for a comprehensive information display.
1409
1410   $arrayref_hashref = &GetBorrowercategory;
1411 If no category code provided, the function returns all the categories.
1412
1413 =cut
1414
1415 sub GetBorrowercategory {
1416     my ($catcode) = @_;
1417     my $dbh       = C4::Context->dbh;
1418     if ($catcode){
1419         my $sth       =
1420         $dbh->prepare(
1421     "SELECT description,dateofbirthrequired,upperagelimit,category_type
1422     FROM categories
1423     WHERE categorycode = ?"
1424         );
1425         $sth->execute($catcode);
1426         my $data =
1427         $sth->fetchrow_hashref;
1428         $sth->finish();
1429         return $data;
1430     }
1431     return;
1432 }    # sub getborrowercategory
1433
1434 =head2 GetBorrowercategoryList
1435
1436   $arrayref_hashref = &GetBorrowercategoryList;
1437 If no category code provided, the function returns all the categories.
1438
1439 =cut
1440
1441 sub GetBorrowercategoryList {
1442     my $dbh       = C4::Context->dbh;
1443     my $sth       =
1444     $dbh->prepare(
1445     "SELECT *
1446     FROM categories
1447     ORDER BY description"
1448         );
1449     $sth->execute;
1450     my $data =
1451     $sth->fetchall_arrayref({});
1452     $sth->finish();
1453     return $data;
1454 }    # sub getborrowercategory
1455
1456 =head2 ethnicitycategories
1457
1458   ($codes_arrayref, $labels_hashref) = &ethnicitycategories();
1459
1460 Looks up the different ethnic types in the database. Returns two
1461 elements: a reference-to-array, which lists the ethnicity codes, and a
1462 reference-to-hash, which maps the ethnicity codes to ethnicity
1463 descriptions.
1464
1465 =cut
1466
1467 #'
1468
1469 sub ethnicitycategories {
1470     my $dbh = C4::Context->dbh;
1471     my $sth = $dbh->prepare("Select code,name from ethnicity order by name");
1472     $sth->execute;
1473     my %labels;
1474     my @codes;
1475     while ( my $data = $sth->fetchrow_hashref ) {
1476         push @codes, $data->{'code'};
1477         $labels{ $data->{'code'} } = $data->{'name'};
1478     }
1479     $sth->finish;
1480     return ( \@codes, \%labels );
1481 }
1482
1483 =head2 fixEthnicity
1484
1485   $ethn_name = &fixEthnicity($ethn_code);
1486
1487 Takes an ethnicity code (e.g., "european" or "pi") and returns the
1488 corresponding descriptive name from the C<ethnicity> table in the
1489 Koha database ("European" or "Pacific Islander").
1490
1491 =cut
1492
1493 #'
1494
1495 sub fixEthnicity {
1496     my $ethnicity = shift;
1497     return unless $ethnicity;
1498     my $dbh       = C4::Context->dbh;
1499     my $sth       = $dbh->prepare("Select name from ethnicity where code = ?");
1500     $sth->execute($ethnicity);
1501     my $data = $sth->fetchrow_hashref;
1502     $sth->finish;
1503     return $data->{'name'};
1504 }    # sub fixEthnicity
1505
1506 =head2 GetAge
1507
1508   $dateofbirth,$date = &GetAge($date);
1509
1510 this function return the borrowers age with the value of dateofbirth
1511
1512 =cut
1513
1514 #'
1515 sub GetAge{
1516     my ( $date, $date_ref ) = @_;
1517
1518     if ( not defined $date_ref ) {
1519         $date_ref = sprintf( '%04d-%02d-%02d', Today() );
1520     }
1521
1522     my ( $year1, $month1, $day1 ) = split /-/, $date;
1523     my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
1524
1525     my $age = $year2 - $year1;
1526     if ( $month1 . $day1 > $month2 . $day2 ) {
1527         $age--;
1528     }
1529
1530     return $age;
1531 }    # sub get_age
1532
1533 =head2 get_institutions
1534   $insitutions = get_institutions();
1535
1536 Just returns a list of all the borrowers of type I, borrownumber and name
1537
1538 =cut
1539
1540 #'
1541 sub get_institutions {
1542     my $dbh = C4::Context->dbh();
1543     my $sth =
1544       $dbh->prepare(
1545 "SELECT borrowernumber,surname FROM borrowers WHERE categorycode=? ORDER BY surname"
1546       );
1547     $sth->execute('I');
1548     my %orgs;
1549     while ( my $data = $sth->fetchrow_hashref() ) {
1550         $orgs{ $data->{'borrowernumber'} } = $data;
1551     }
1552     $sth->finish();
1553     return ( \%orgs );
1554
1555 }    # sub get_institutions
1556
1557 =head2 add_member_orgs
1558
1559   add_member_orgs($borrowernumber,$borrowernumbers);
1560
1561 Takes a borrowernumber and a list of other borrowernumbers and inserts them into the borrowers_to_borrowers table
1562
1563 =cut
1564
1565 #'
1566 sub add_member_orgs {
1567     my ( $borrowernumber, $otherborrowers ) = @_;
1568     my $dbh   = C4::Context->dbh();
1569     my $query =
1570       "INSERT INTO borrowers_to_borrowers (borrower1,borrower2) VALUES (?,?)";
1571     my $sth = $dbh->prepare($query);
1572     foreach my $otherborrowernumber (@$otherborrowers) {
1573         $sth->execute( $borrowernumber, $otherborrowernumber );
1574     }
1575     $sth->finish();
1576
1577 }    # sub add_member_orgs
1578
1579 =head2 GetCities (OUEST-PROVENCE)
1580
1581   ($id_cityarrayref, $city_hashref) = &GetCities();
1582
1583 Looks up the different city and zip in the database. Returns two
1584 elements: a reference-to-array, which lists the zip city
1585 codes, and a reference-to-hash, which maps the name of the city.
1586 WHERE =>OUEST PROVENCE OR EXTERIEUR
1587
1588 =cut
1589
1590 sub GetCities {
1591
1592     #my ($type_city) = @_;
1593     my $dbh   = C4::Context->dbh;
1594     my $query = qq|SELECT cityid,city_zipcode,city_name
1595         FROM cities
1596         ORDER BY city_name|;
1597     my $sth = $dbh->prepare($query);
1598
1599     #$sth->execute($type_city);
1600     $sth->execute();
1601     my %city;
1602     my @id;
1603     #    insert empty value to create a empty choice in cgi popup
1604     push @id, " ";
1605     $city{""} = "";
1606     while ( my $data = $sth->fetchrow_hashref ) {
1607         push @id, $data->{'city_zipcode'}."|".$data->{'city_name'};
1608         $city{ $data->{'city_zipcode'}."|".$data->{'city_name'} } = $data->{'city_name'};
1609     }
1610
1611 #test to know if the table contain some records if no the function return nothing
1612     my $id = @id;
1613     $sth->finish;
1614     if ( $id == 1 ) {
1615         # all we have is the one blank row
1616         return ();
1617     }
1618     else {
1619         unshift( @id, "" );
1620         return ( \@id, \%city );
1621     }
1622 }
1623
1624 =head2 GetSortDetails (OUEST-PROVENCE)
1625
1626   ($lib) = &GetSortDetails($category,$sortvalue);
1627
1628 Returns the authorized value  details
1629 C<&$lib>return value of authorized value details
1630 C<&$sortvalue>this is the value of authorized value
1631 C<&$category>this is the value of authorized value category
1632
1633 =cut
1634
1635 sub GetSortDetails {
1636     my ( $category, $sortvalue ) = @_;
1637     my $dbh   = C4::Context->dbh;
1638     my $query = qq|SELECT lib
1639         FROM authorised_values
1640         WHERE category=?
1641         AND authorised_value=? |;
1642     my $sth = $dbh->prepare($query);
1643     $sth->execute( $category, $sortvalue );
1644     my $lib = $sth->fetchrow;
1645     return ($lib) if ($lib);
1646     return ($sortvalue) unless ($lib);
1647 }
1648
1649 =head2 MoveMemberToDeleted
1650
1651   $result = &MoveMemberToDeleted($borrowernumber);
1652
1653 Copy the record from borrowers to deletedborrowers table.
1654
1655 =cut
1656
1657 # FIXME: should do it in one SQL statement w/ subquery
1658 # Otherwise, we should return the @data on success
1659
1660 sub MoveMemberToDeleted {
1661     my ($member) = shift or return;
1662     my $dbh = C4::Context->dbh;
1663     my $query = qq|SELECT *
1664           FROM borrowers
1665           WHERE borrowernumber=?|;
1666     my $sth = $dbh->prepare($query);
1667     $sth->execute($member);
1668     my @data = $sth->fetchrow_array;
1669     (@data) or return;  # if we got a bad borrowernumber, there's nothing to insert
1670     $sth =
1671       $dbh->prepare( "INSERT INTO deletedborrowers VALUES ("
1672           . ( "?," x ( scalar(@data) - 1 ) )
1673           . "?)" );
1674     $sth->execute(@data);
1675 }
1676
1677 =head2 DelMember
1678
1679 DelMember($borrowernumber);
1680
1681 This function remove directly a borrower whitout writing it on deleteborrower.
1682 + Deletes reserves for the borrower
1683
1684 =cut
1685
1686 sub DelMember {
1687     my $dbh            = C4::Context->dbh;
1688     my $borrowernumber = shift;
1689     #warn "in delmember with $borrowernumber";
1690     return unless $borrowernumber;    # borrowernumber is mandatory.
1691
1692     my $query = qq|DELETE
1693           FROM  reserves
1694           WHERE borrowernumber=?|;
1695     my $sth = $dbh->prepare($query);
1696     $sth->execute($borrowernumber);
1697     $sth->finish;
1698     $query = "
1699        DELETE
1700        FROM borrowers
1701        WHERE borrowernumber = ?
1702    ";
1703     $sth = $dbh->prepare($query);
1704     $sth->execute($borrowernumber);
1705     $sth->finish;
1706     logaction("MEMBERS", "DELETE", $borrowernumber, "") if C4::Context->preference("BorrowersLog");
1707     return $sth->rows;
1708 }
1709
1710 =head2 ExtendMemberSubscriptionTo (OUEST-PROVENCE)
1711
1712     $date = ExtendMemberSubscriptionTo($borrowerid, $date);
1713
1714 Extending the subscription to a given date or to the expiry date calculated on ISO date.
1715 Returns ISO date.
1716
1717 =cut
1718
1719 sub ExtendMemberSubscriptionTo {
1720     my ( $borrowerid,$date) = @_;
1721     my $dbh = C4::Context->dbh;
1722     my $borrower = GetMember($borrowerid,'borrowernumber');
1723     unless ($date){
1724       $date=POSIX::strftime("%Y-%m-%d",localtime());
1725       my $borrower = GetMember($borrowerid,'borrowernumber');
1726       $date = GetExpiryDate( $borrower->{'categorycode'}, $date );
1727     }
1728     my $sth = $dbh->do(<<EOF);
1729 UPDATE borrowers
1730 SET  dateexpiry='$date'
1731 WHERE borrowernumber='$borrowerid'
1732 EOF
1733     # add enrolmentfee if needed
1734     $sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
1735     $sth->execute($borrower->{'categorycode'});
1736     my ($enrolmentfee) = $sth->fetchrow;
1737     if ($enrolmentfee && $enrolmentfee > 0) {
1738         # insert fee in patron debts
1739         manualinvoice($borrower->{'borrowernumber'}, '', '', 'A', $enrolmentfee);
1740     }
1741     return $date if ($sth);
1742     return 0;
1743 }
1744
1745 =head2 GetRoadTypes (OUEST-PROVENCE)
1746
1747   ($idroadtypearrayref, $roadttype_hashref) = &GetRoadTypes();
1748
1749 Looks up the different road type . Returns two
1750 elements: a reference-to-array, which lists the id_roadtype
1751 codes, and a reference-to-hash, which maps the road type of the road .
1752
1753 =cut
1754
1755 sub GetRoadTypes {
1756     my $dbh   = C4::Context->dbh;
1757     my $query = qq|
1758 SELECT roadtypeid,road_type
1759 FROM roadtype
1760 ORDER BY road_type|;
1761     my $sth = $dbh->prepare($query);
1762     $sth->execute();
1763     my %roadtype;
1764     my @id;
1765
1766     #    insert empty value to create a empty choice in cgi popup
1767
1768     while ( my $data = $sth->fetchrow_hashref ) {
1769
1770         push @id, $data->{'roadtypeid'};
1771         $roadtype{ $data->{'roadtypeid'} } = $data->{'road_type'};
1772     }
1773
1774 #test to know if the table contain some records if no the function return nothing
1775     my $id = @id;
1776     $sth->finish;
1777     if ( $id eq 0 ) {
1778         return ();
1779     }
1780     else {
1781         unshift( @id, "" );
1782         return ( \@id, \%roadtype );
1783     }
1784 }
1785
1786
1787
1788 =head2 GetTitles (OUEST-PROVENCE)
1789
1790   ($borrowertitle)= &GetTitles();
1791
1792 Looks up the different title . Returns array  with all borrowers title
1793
1794 =cut
1795
1796 sub GetTitles {
1797     my @borrowerTitle = split /,|\|/,C4::Context->preference('BorrowersTitles');
1798     unshift( @borrowerTitle, "" );
1799     my $count=@borrowerTitle;
1800     if ($count == 1){
1801         return ();
1802     }
1803     else {
1804         return ( \@borrowerTitle);
1805     }
1806 }
1807
1808 =head2 GetPatronImage
1809
1810     my ($imagedata, $dberror) = GetPatronImage($cardnumber);
1811
1812 Returns the mimetype and binary image data of the image for the patron with the supplied cardnumber.
1813
1814 =cut
1815
1816 sub GetPatronImage {
1817     my ($cardnumber) = @_;
1818     warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1819     my $dbh = C4::Context->dbh;
1820     my $query = 'SELECT mimetype, imagefile FROM patronimage WHERE cardnumber = ?';
1821     my $sth = $dbh->prepare($query);
1822     $sth->execute($cardnumber);
1823     my $imagedata = $sth->fetchrow_hashref;
1824     warn "Database error!" if $sth->errstr;
1825     return $imagedata, $sth->errstr;
1826 }
1827
1828 =head2 PutPatronImage
1829
1830     PutPatronImage($cardnumber, $mimetype, $imgfile);
1831
1832 Stores patron binary image data and mimetype in database.
1833 NOTE: This function is good for updating images as well as inserting new images in the database.
1834
1835 =cut
1836
1837 sub PutPatronImage {
1838     my ($cardnumber, $mimetype, $imgfile) = @_;
1839     warn "Parameters passed in: Cardnumber=$cardnumber, Mimetype=$mimetype, " . ($imgfile ? "Imagefile" : "No Imagefile") if $debug;
1840     my $dbh = C4::Context->dbh;
1841     my $query = "INSERT INTO patronimage (cardnumber, mimetype, imagefile) VALUES (?,?,?) ON DUPLICATE KEY UPDATE imagefile = ?;";
1842     my $sth = $dbh->prepare($query);
1843     $sth->execute($cardnumber,$mimetype,$imgfile,$imgfile);
1844     warn "Error returned inserting $cardnumber.$mimetype." if $sth->errstr;
1845     return $sth->errstr;
1846 }
1847
1848 =head2 RmPatronImage
1849
1850     my ($dberror) = RmPatronImage($cardnumber);
1851
1852 Removes the image for the patron with the supplied cardnumber.
1853
1854 =cut
1855
1856 sub RmPatronImage {
1857     my ($cardnumber) = @_;
1858     warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1859     my $dbh = C4::Context->dbh;
1860     my $query = "DELETE FROM patronimage WHERE cardnumber = ?;";
1861     my $sth = $dbh->prepare($query);
1862     $sth->execute($cardnumber);
1863     my $dberror = $sth->errstr;
1864     warn "Database error!" if $sth->errstr;
1865     return $dberror;
1866 }
1867
1868 =head2 GetRoadTypeDetails (OUEST-PROVENCE)
1869
1870   ($roadtype) = &GetRoadTypeDetails($roadtypeid);
1871
1872 Returns the description of roadtype
1873 C<&$roadtype>return description of road type
1874 C<&$roadtypeid>this is the value of roadtype s
1875
1876 =cut
1877
1878 sub GetRoadTypeDetails {
1879     my ($roadtypeid) = @_;
1880     my $dbh          = C4::Context->dbh;
1881     my $query        = qq|
1882 SELECT road_type
1883 FROM roadtype
1884 WHERE roadtypeid=?|;
1885     my $sth = $dbh->prepare($query);
1886     $sth->execute($roadtypeid);
1887     my $roadtype = $sth->fetchrow;
1888     return ($roadtype);
1889 }
1890
1891 =head2 GetBorrowersWhoHaveNotBorrowedSince
1892
1893 &GetBorrowersWhoHaveNotBorrowedSince($date)
1894
1895 this function get all borrowers who haven't borrowed since the date given on input arg.
1896
1897 =cut
1898
1899 sub GetBorrowersWhoHaveNotBorrowedSince {
1900 ### TODO : It could be dangerous to delete Borrowers who have just been entered and who have not yet borrowed any book. May be good to add a dateexpiry or dateenrolled filter.
1901
1902                 my $filterdate = shift||POSIX::strftime("%Y-%m-%d",localtime());
1903     my $filterbranch = shift ||
1904                         ((C4::Context->preference('IndependantBranches')
1905                              && C4::Context->userenv
1906                              && C4::Context->userenv->{flags} % 2 !=1
1907                              && C4::Context->userenv->{branch})
1908                          ? C4::Context->userenv->{branch}
1909                          : "");
1910     my $dbh   = C4::Context->dbh;
1911     my $query = "
1912         SELECT borrowers.borrowernumber,max(issues.timestamp) as latestissue
1913         FROM   borrowers
1914         JOIN   categories USING (categorycode)
1915         LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
1916         WHERE  category_type <> 'S'
1917    ";
1918     my @query_params;
1919     if ($filterbranch && $filterbranch ne ""){
1920         $query.=" AND borrowers.branchcode= ?";
1921         push @query_params,$filterbranch;
1922     }
1923     $query.=" GROUP BY borrowers.borrowernumber";
1924     if ($filterdate){
1925         $query.=" HAVING latestissue <? OR latestissue IS NULL";
1926         push @query_params,$filterdate;
1927     }
1928     warn $query if $debug;
1929     my $sth = $dbh->prepare($query);
1930     if (scalar(@query_params)>0){
1931         $sth->execute(@query_params);
1932     }
1933     else {
1934         $sth->execute;
1935     }
1936
1937     my @results;
1938     while ( my $data = $sth->fetchrow_hashref ) {
1939         push @results, $data;
1940     }
1941     return \@results;
1942 }
1943
1944 =head2 GetBorrowersWhoHaveNeverBorrowed
1945
1946 $results = &GetBorrowersWhoHaveNeverBorrowed
1947
1948 this function get all borrowers who have never borrowed.
1949
1950 I<$result> is a ref to an array which all elements are a hasref.
1951
1952 =cut
1953
1954 sub GetBorrowersWhoHaveNeverBorrowed {
1955     my $filterbranch = shift ||
1956                         ((C4::Context->preference('IndependantBranches')
1957                              && C4::Context->userenv
1958                              && C4::Context->userenv->{flags} % 2 !=1
1959                              && C4::Context->userenv->{branch})
1960                          ? C4::Context->userenv->{branch}
1961                          : "");
1962     my $dbh   = C4::Context->dbh;
1963     my $query = "
1964         SELECT borrowers.borrowernumber,max(timestamp) as latestissue
1965         FROM   borrowers
1966           LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
1967         WHERE issues.borrowernumber IS NULL
1968    ";
1969     my @query_params;
1970     if ($filterbranch && $filterbranch ne ""){
1971         $query.=" AND borrowers.branchcode= ?";
1972         push @query_params,$filterbranch;
1973     }
1974     warn $query if $debug;
1975
1976     my $sth = $dbh->prepare($query);
1977     if (scalar(@query_params)>0){
1978         $sth->execute(@query_params);
1979     }
1980     else {
1981         $sth->execute;
1982     }
1983
1984     my @results;
1985     while ( my $data = $sth->fetchrow_hashref ) {
1986         push @results, $data;
1987     }
1988     return \@results;
1989 }
1990
1991 =head2 GetBorrowersWithIssuesHistoryOlderThan
1992
1993 $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
1994
1995 this function get all borrowers who has an issue history older than I<$date> given on input arg.
1996
1997 I<$result> is a ref to an array which all elements are a hashref.
1998 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
1999
2000 =cut
2001
2002 sub GetBorrowersWithIssuesHistoryOlderThan {
2003     my $dbh  = C4::Context->dbh;
2004     my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
2005     my $filterbranch = shift ||
2006                         ((C4::Context->preference('IndependantBranches')
2007                              && C4::Context->userenv
2008                              && C4::Context->userenv->{flags} % 2 !=1
2009                              && C4::Context->userenv->{branch})
2010                          ? C4::Context->userenv->{branch}
2011                          : "");
2012     my $query = "
2013        SELECT count(borrowernumber) as n,borrowernumber
2014        FROM old_issues
2015        WHERE returndate < ?
2016          AND borrowernumber IS NOT NULL
2017     ";
2018     my @query_params;
2019     push @query_params, $date;
2020     if ($filterbranch){
2021         $query.="   AND branchcode = ?";
2022         push @query_params, $filterbranch;
2023     }
2024     $query.=" GROUP BY borrowernumber ";
2025     warn $query if $debug;
2026     my $sth = $dbh->prepare($query);
2027     $sth->execute(@query_params);
2028     my @results;
2029
2030     while ( my $data = $sth->fetchrow_hashref ) {
2031         push @results, $data;
2032     }
2033     return \@results;
2034 }
2035
2036 =head2 GetBorrowersNamesAndLatestIssue
2037
2038 $results = &GetBorrowersNamesAndLatestIssueList(@borrowernumbers)
2039
2040 this function get borrowers Names and surnames and Issue information.
2041
2042 I<@borrowernumbers> is an array which all elements are borrowernumbers.
2043 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2044
2045 =cut
2046
2047 sub GetBorrowersNamesAndLatestIssue {
2048     my $dbh  = C4::Context->dbh;
2049     my @borrowernumbers=@_;
2050     my $query = "
2051        SELECT surname,lastname, phone, email,max(timestamp)
2052        FROM borrowers
2053          LEFT JOIN issues ON borrowers.borrowernumber=issues.borrowernumber
2054        GROUP BY borrowernumber
2055    ";
2056     my $sth = $dbh->prepare($query);
2057     $sth->execute;
2058     my $results = $sth->fetchall_arrayref({});
2059     return $results;
2060 }
2061
2062 =head2 DebarMember
2063
2064 =over 4
2065
2066 my $success = DebarMember( $borrowernumber );
2067
2068 marks a Member as debarred, and therefore unable to checkout any more
2069 items.
2070
2071 return :
2072 true on success, false on failure
2073
2074 =back
2075
2076 =cut
2077
2078 sub DebarMember {
2079     my $borrowernumber = shift;
2080
2081     return unless defined $borrowernumber;
2082     return unless $borrowernumber =~ /^\d+$/;
2083
2084     return ModMember( borrowernumber => $borrowernumber,
2085                       debarred       => 1 );
2086
2087 }
2088
2089 END { }    # module clean-up code here (global destructor)
2090
2091 1;
2092
2093 __END__
2094
2095 =head1 AUTHOR
2096
2097 Koha Team
2098
2099 =cut