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}!=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}!=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');
 861     $autonumber_members = 0 unless defined $autonumber_members;
 862
 863     # Find out whether member numbers should be generated
 864     # automatically. Should be either "1" or something else.
 865     # Defaults to "0", which is interpreted as "no".
 866
 867     #     if ($cardnumber !~ /\S/ && $autonumber_members) {
 868     if ($autonumber_members) {
 869         my $dbh = C4::Context->dbh;
 870         if ( C4::Context->preference('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 =
 879               $dbh->prepare(
 880                 "select max(substring(borrowers.cardnumber,2,7)) from borrowers"
 881               );
 882             $sth->execute;
 883
 884             my $data = $sth->fetchrow_hashref;
 885             $cardnumber = $data->{'max(substring(borrowers.cardnumber,2,7))'};
 886             $sth->finish;
 887             if ( !$cardnumber ) {    # If DB has no values,
 888                 $cardnumber = 1000000;    # start at 1000000
 889             }
 890             else {
 891                 $cardnumber += 1;
 892             }
 893
 894             my $sum = 0;
 895             for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
 896
 897                 # read weightings, left to right, 1 char at a time
 898                 my $temp1 = $weightings[$i];
 899
 900                 # sequence left to right, 1 char at a time
 901                 my $temp2 = substr( $cardnumber, $i, 1 );
 902
 903                 # mult each char 1-7 by its corresponding weighting
 904                 $sum += $temp1 * $temp2;
 905             }
 906
 907             my $rem = ( $sum % 11 );
 908             $rem = 'X' if $rem == 10;
 909
 910             $cardnumber = "V$cardnumber$rem";
 911         }
 912         else {
 913
 914      # MODIFIED BY JF: mysql4.1 allows casting as an integer, which is probably
 915      # better. I'll leave the original in in case it needs to be changed for you
 916             my $sth =
 917               $dbh->prepare(
 918                 "select max(cast(cardnumber as signed)) from borrowers");
 919
 920       #my $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers");
 921
 922             $sth->execute;
 923
 924             my ($result) = $sth->fetchrow;
 925             $sth->finish;
 926             $cardnumber = $result + 1;
 927         }
 928     }
 929     return $cardnumber;
 930 }
 931
 932 =head2 GetGuarantees
 933
 934   ($num_children, $children_arrayref) = &GetGuarantees($parent_borrno);
 935   $child0_cardno = $children_arrayref->[0]{"cardnumber"};
 936   $child0_borrno = $children_arrayref->[0]{"borrowernumber"};
 937
 938 C<&GetGuarantees> takes a borrower number (e.g., that of a patron
 939 with children) and looks up the borrowers who are guaranteed by that
 940 borrower (i.e., the patron's children).
 941
 942 C<&GetGuarantees> returns two values: an integer giving the number of
 943 borrowers guaranteed by C<$parent_borrno>, and a reference to an array
 944 of references to hash, which gives the actual results.
 945
 946 =cut
 947
 948 #'
 949 sub GetGuarantees {
 950     my ($borrowernumber) = @_;
 951     my $dbh              = C4::Context->dbh;
 952     my $sth              =
 953       $dbh->prepare(
 954 "select cardnumber,borrowernumber, firstname, surname from borrowers where guarantorid=?"
 955       );
 956     $sth->execute($borrowernumber);
 957
 958     my @dat;
 959     my $data = $sth->fetchall_arrayref({});
 960     $sth->finish;
 961     return ( scalar(@$data), $data );
 962 }
 963
 964 =head2 UpdateGuarantees
 965
 966   &UpdateGuarantees($parent_borrno);
 967
 968
 969 C<&UpdateGuarantees> borrower data for an adulte and updates all the guarantees
 970 with the modified information
 971
 972 =cut
 973
 974 #'
 975 sub UpdateGuarantees {
 976     my (%data) = @_;
 977     my $dbh = C4::Context->dbh;
 978     my ( $count, $guarantees ) = GetGuarantees( $data{'borrowernumber'} );
 979     for ( my $i = 0 ; $i < $count ; $i++ ) {
 980
 981         # FIXME
 982         # It looks like the $i is only being returned to handle walking through
 983         # the array, which is probably better done as a foreach loop.
 984         #
 985         my $guaquery = qq|UPDATE borrowers
 986               SET address='$data{'address'}',fax='$data{'fax'}',
 987                   B_city='$data{'B_city'}',mobile='$data{'mobile'}',city='$data{'city'}',phone='$data{'phone'}'
 988               WHERE borrowernumber='$guarantees->[$i]->{'borrowernumber'}'
 989         |;
 990         my $sth3 = $dbh->prepare($guaquery);
 991         $sth3->execute;
 992         $sth3->finish;
 993     }
 994 }
 995 =head2 GetPendingIssues
 996
 997   my $issues = &GetPendingIssues($borrowernumber);
 998
 999 Looks up what the patron with the given borrowernumber has borrowed.
1000
1001 C<&GetPendingIssues> returns a
1002 reference-to-array where each element is a reference-to-hash; the
1003 keys are the fields from the C<issues>, C<biblio>, and C<items> tables.
1004 The keys include C<biblioitems> fields except marc and marcxml.
1005
1006 =cut
1007
1008 #'
1009 sub GetPendingIssues {
1010     my ($borrowernumber) = @_;
1011     # must avoid biblioitems.* to prevent large marc and marcxml fields from killing performance
1012     # FIXME: namespace collision: each table has "timestamp" fields.  Which one is "timestamp" ?
1013     # FIXME: circ/ciculation.pl tries to sort by timestamp!
1014     # FIXME: C4::Print::printslip tries to sort by timestamp!
1015     # FIXME: namespace collision: other collisions possible.
1016     # FIXME: most of this data isn't really being used by callers.
1017     my $sth = C4::Context->dbh->prepare(
1018    "SELECT issues.*,
1019             items.*,
1020            biblio.*,
1021            biblioitems.volume,
1022            biblioitems.number,
1023            biblioitems.itemtype,
1024            biblioitems.isbn,
1025            biblioitems.issn,
1026            biblioitems.publicationyear,
1027            biblioitems.publishercode,
1028            biblioitems.volumedate,
1029            biblioitems.volumedesc,
1030            biblioitems.lccn,
1031            biblioitems.url,
1032            issues.timestamp AS timestamp,
1033            issues.renewals  AS renewals,
1034             items.renewals  AS totalrenewals
1035     FROM   issues
1036     LEFT JOIN items       ON items.itemnumber       =      issues.itemnumber
1037     LEFT JOIN biblio      ON items.biblionumber     =      biblio.biblionumber
1038     LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
1039     WHERE
1040       borrowernumber=?
1041     ORDER BY issues.issuedate"
1042     );
1043     $sth->execute($borrowernumber);
1044     my $data = $sth->fetchall_arrayref({});
1045     my $today = C4::Dates->new->output('iso');
1046     foreach (@$data) {
1047         $_->{date_due} or next;
1048         ($_->{date_due} < $today) and $_->{overdue} = 1;
1049     }
1050     return $data;
1051 }
1052
1053 =head2 GetAllIssues
1054
1055   ($count, $issues) = &GetAllIssues($borrowernumber, $sortkey, $limit);
1056
1057 Looks up what the patron with the given borrowernumber has borrowed,
1058 and sorts the results.
1059
1060 C<$sortkey> is the name of a field on which to sort the results. This
1061 should be the name of a field in the C<issues>, C<biblio>,
1062 C<biblioitems>, or C<items> table in the Koha database.
1063
1064 C<$limit> is the maximum number of results to return.
1065
1066 C<&GetAllIssues> returns a two-element array. C<$issues> is a
1067 reference-to-array, where each element is a reference-to-hash; the
1068 keys are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
1069 C<items> tables of the Koha database. C<$count> is the number of
1070 elements in C<$issues>
1071
1072 =cut
1073
1074 #'
1075 sub GetAllIssues {
1076     my ( $borrowernumber, $order, $limit ) = @_;
1077
1078     #FIXME: sanity-check order and limit
1079     my $dbh   = C4::Context->dbh;
1080     my $count = 0;
1081     my $query =
1082   "SELECT *,issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1083   FROM issues
1084   LEFT JOIN items on items.itemnumber=issues.itemnumber
1085   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1086   LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1087   WHERE borrowernumber=?
1088   UNION ALL
1089   SELECT *,old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1090   FROM old_issues
1091   LEFT JOIN items on items.itemnumber=old_issues.itemnumber
1092   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1093   LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1094   WHERE borrowernumber=?
1095   order by $order";
1096     if ( $limit != 0 ) {
1097         $query .= " limit $limit";
1098     }
1099
1100     #print $query;
1101     my $sth = $dbh->prepare($query);
1102     $sth->execute($borrowernumber, $borrowernumber);
1103     my @result;
1104     my $i = 0;
1105     while ( my $data = $sth->fetchrow_hashref ) {
1106         $result[$i] = $data;
1107         $i++;
1108         $count++;
1109     }
1110
1111     # get all issued items for borrowernumber from oldissues table
1112     # large chunk of older issues data put into table oldissues
1113     # to speed up db calls for issuing items
1114     if ( C4::Context->preference("ReadingHistory") ) {
1115         # FIXME oldissues (not to be confused with old_issues) is
1116         # apparently specific to HLT.  Not sure if the ReadingHistory
1117         # syspref is still required, as old_issues by design
1118         # is no longer checked with each loan.
1119         my $query2 = "SELECT * FROM oldissues
1120                       LEFT JOIN items ON items.itemnumber=oldissues.itemnumber
1121                       LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1122                       LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1123                       WHERE borrowernumber=?
1124                       ORDER BY $order";
1125         if ( $limit != 0 ) {
1126             $limit = $limit - $count;
1127             $query2 .= " limit $limit";
1128         }
1129
1130         my $sth2 = $dbh->prepare($query2);
1131         $sth2->execute($borrowernumber);
1132
1133         while ( my $data2 = $sth2->fetchrow_hashref ) {
1134             $result[$i] = $data2;
1135             $i++;
1136         }
1137         $sth2->finish;
1138     }
1139     $sth->finish;
1140
1141     return ( $i, \@result );
1142 }
1143
1144
1145 =head2 GetMemberAccountRecords
1146
1147   ($total, $acctlines, $count) = &GetMemberAccountRecords($borrowernumber);
1148
1149 Looks up accounting data for the patron with the given borrowernumber.
1150
1151 C<&GetMemberAccountRecords> returns a three-element array. C<$acctlines> is a
1152 reference-to-array, where each element is a reference-to-hash; the
1153 keys are the fields of the C<accountlines> table in the Koha database.
1154 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1155 total amount outstanding for all of the account lines.
1156
1157 =cut
1158
1159 #'
1160 sub GetMemberAccountRecords {
1161     my ($borrowernumber,$date) = @_;
1162     my $dbh = C4::Context->dbh;
1163     my @acctlines;
1164     my $numlines = 0;
1165     my $strsth      = qq(
1166                         SELECT *
1167                         FROM accountlines
1168                         WHERE borrowernumber=?);
1169     my @bind = ($borrowernumber);
1170     if ($date && $date ne ''){
1171             $strsth.=" AND date < ? ";
1172             push(@bind,$date);
1173     }
1174     $strsth.=" ORDER BY date desc,timestamp DESC";
1175     my $sth= $dbh->prepare( $strsth );
1176     $sth->execute( @bind );
1177     my $total = 0;
1178     while ( my $data = $sth->fetchrow_hashref ) {
1179                 my $biblio = GetBiblioFromItemNumber($data->{itemnumber}) if $data->{itemnumber};
1180                 $data->{biblionumber} = $biblio->{biblionumber};
1181         $acctlines[$numlines] = $data;
1182         $numlines++;
1183         $total += $data->{'amountoutstanding'};
1184     }
1185     $sth->finish;
1186     return ( $total, \@acctlines,$numlines);
1187 }
1188
1189 =head2 GetBorNotifyAcctRecord
1190
1191   ($count, $acctlines, $total) = &GetBorNotifyAcctRecord($params,$notifyid);
1192
1193 Looks up accounting data for the patron with the given borrowernumber per file number.
1194
1195 (FIXME - I'm not at all sure what this is about.)
1196
1197 C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a
1198 reference-to-array, where each element is a reference-to-hash; the
1199 keys are the fields of the C<accountlines> table in the Koha database.
1200 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1201 total amount outstanding for all of the account lines.
1202
1203 =cut
1204
1205 sub GetBorNotifyAcctRecord {
1206     my ( $borrowernumber, $notifyid ) = @_;
1207     my $dbh = C4::Context->dbh;
1208     my @acctlines;
1209     my $numlines = 0;
1210     my $sth = $dbh->prepare(
1211             "SELECT *
1212                 FROM accountlines
1213                 WHERE borrowernumber=?
1214                     AND notify_id=?
1215                     AND amountoutstanding != '0'
1216                 ORDER BY notify_id,accounttype
1217                 ");
1218 #                    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')
1219
1220     $sth->execute( $borrowernumber, $notifyid );
1221     my $total = 0;
1222     while ( my $data = $sth->fetchrow_hashref ) {
1223         $acctlines[$numlines] = $data;
1224         $numlines++;
1225         $total += $data->{'amountoutstanding'};
1226     }
1227     $sth->finish;
1228     return ( $total, \@acctlines, $numlines );
1229 }
1230
1231 =head2 checkuniquemember (OUEST-PROVENCE)
1232
1233   ($result,$categorycode)  = &checkuniquemember($collectivity,$surname,$firstname,$dateofbirth);
1234
1235 Checks that a member exists or not in the database.
1236
1237 C<&result> is nonzero (=exist) or 0 (=does not exist)
1238 C<&categorycode> is from categorycode table
1239 C<&collectivity> is 1 (= we add a collectivity) or 0 (= we add a physical member)
1240 C<&surname> is the surname
1241 C<&firstname> is the firstname (only if collectivity=0)
1242 C<&dateofbirth> is the date of birth in ISO format (only if collectivity=0)
1243
1244 =cut
1245
1246 # FIXME: This function is not legitimate.  Multiple patrons might have the same first/last name and birthdate.
1247 # This is especially true since first name is not even a required field.
1248
1249 sub checkuniquemember {
1250     my ( $collectivity, $surname, $firstname, $dateofbirth ) = @_;
1251     my $dbh = C4::Context->dbh;
1252     my $request = ($collectivity) ?
1253         "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? " :
1254         "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=?";
1255     my $sth = $dbh->prepare($request);
1256     if ($collectivity) {
1257         $sth->execute( uc($surname) );
1258     } else {
1259         if($dateofbirth){
1260             $request .= " and dateofbirth=?";
1261             $sth->execute( uc($surname), ucfirst($firstname), $dateofbirth );
1262         }else{
1263             $sth->execute( uc($surname), ucfirst($firstname));
1264         }
1265     }
1266     my @data = $sth->fetchrow;
1267     $sth->finish;
1268     ( $data[0] ) and return $data[0], $data[1];
1269     return 0;
1270 }
1271
1272 sub checkcardnumber {
1273     my ($cardnumber,$borrowernumber) = @_;
1274     my $dbh = C4::Context->dbh;
1275     my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
1276     $query .= " AND borrowernumber <> ?" if ($borrowernumber);
1277   my $sth = $dbh->prepare($query);
1278   if ($borrowernumber) {
1279    $sth->execute($cardnumber,$borrowernumber);
1280   } else {
1281      $sth->execute($cardnumber);
1282   }
1283     if (my $data= $sth->fetchrow_hashref()){
1284         return 1;
1285     }
1286     else {
1287         return 0;
1288     }
1289     $sth->finish();
1290 }
1291
1292
1293 =head2 getzipnamecity (OUEST-PROVENCE)
1294
1295 take all info from table city for the fields city and  zip
1296 check for the name and the zip code of the city selected
1297
1298 =cut
1299
1300 sub getzipnamecity {
1301     my ($cityid) = @_;
1302     my $dbh      = C4::Context->dbh;
1303     my $sth      =
1304       $dbh->prepare(
1305         "select city_name,city_zipcode from cities where cityid=? ");
1306     $sth->execute($cityid);
1307     my @data = $sth->fetchrow;
1308     return $data[0], $data[1];
1309 }
1310
1311
1312 =head2 getdcity (OUEST-PROVENCE)
1313
1314 recover cityid  with city_name condition
1315
1316 =cut
1317
1318 sub getidcity {
1319     my ($city_name) = @_;
1320     my $dbh = C4::Context->dbh;
1321     my $sth = $dbh->prepare("select cityid from cities where city_name=? ");
1322     $sth->execute($city_name);
1323     my $data = $sth->fetchrow;
1324     return $data;
1325 }
1326
1327
1328 =head2 GetExpiryDate
1329
1330   $expirydate = GetExpiryDate($categorycode, $dateenrolled);
1331
1332 Calculate expiry date given a categorycode and starting date.  Date argument must be in ISO format.
1333 Return date is also in ISO format.
1334
1335 =cut
1336
1337 sub GetExpiryDate {
1338     my ( $categorycode, $dateenrolled ) = @_;
1339     my $enrolmentperiod = 12;   # reasonable default
1340     if ($categorycode) {
1341         my $dbh = C4::Context->dbh;
1342         my $sth = $dbh->prepare("select enrolmentperiod from categories where categorycode=?");
1343         $sth->execute($categorycode);
1344         $enrolmentperiod = $sth->fetchrow;
1345     }
1346     # die "GetExpiryDate: for enrollmentperiod $enrolmentperiod (category '$categorycode') starting $dateenrolled.\n";
1347     my @date = split /-/,$dateenrolled;
1348     return sprintf("%04d-%02d-%02d", Add_Delta_YM(@date,0,$enrolmentperiod));
1349 }
1350
1351 =head2 checkuserpassword (OUEST-PROVENCE)
1352
1353 check for the password and login are not used
1354 return the number of record
1355 0=> NOT USED 1=> USED
1356
1357 =cut
1358
1359 sub checkuserpassword {
1360     my ( $borrowernumber, $userid, $password ) = @_;
1361     $password = md5_base64($password);
1362     my $dbh = C4::Context->dbh;
1363     my $sth =
1364       $dbh->prepare(
1365 "Select count(*) from borrowers where borrowernumber !=? and userid =? and password=? "
1366       );
1367     $sth->execute( $borrowernumber, $userid, $password );
1368     my $number_rows = $sth->fetchrow;
1369     return $number_rows;
1370
1371 }
1372
1373 =head2 GetborCatFromCatType
1374
1375   ($codes_arrayref, $labels_hashref) = &GetborCatFromCatType();
1376
1377 Looks up the different types of borrowers in the database. Returns two
1378 elements: a reference-to-array, which lists the borrower category
1379 codes, and a reference-to-hash, which maps the borrower category codes
1380 to category descriptions.
1381
1382 =cut
1383
1384 #'
1385 sub GetborCatFromCatType {
1386     my ( $category_type, $action ) = @_;
1387         # FIXME - This API  seems both limited and dangerous.
1388     my $dbh     = C4::Context->dbh;
1389     my $request = qq|   SELECT categorycode,description
1390             FROM categories
1391             $action
1392             ORDER BY categorycode|;
1393     my $sth = $dbh->prepare($request);
1394         if ($action) {
1395         $sth->execute($category_type);
1396     }
1397     else {
1398         $sth->execute();
1399     }
1400
1401     my %labels;
1402     my @codes;
1403
1404     while ( my $data = $sth->fetchrow_hashref ) {
1405         push @codes, $data->{'categorycode'};
1406         $labels{ $data->{'categorycode'} } = $data->{'description'};
1407     }
1408     $sth->finish;
1409     return ( \@codes, \%labels );
1410 }
1411
1412 =head2 GetBorrowercategory
1413
1414   $hashref = &GetBorrowercategory($categorycode);
1415
1416 Given the borrower's category code, the function returns the corresponding
1417 data hashref for a comprehensive information display.
1418
1419   $arrayref_hashref = &GetBorrowercategory;
1420 If no category code provided, the function returns all the categories.
1421
1422 =cut
1423
1424 sub GetBorrowercategory {
1425     my ($catcode) = @_;
1426     my $dbh       = C4::Context->dbh;
1427     if ($catcode){
1428         my $sth       =
1429         $dbh->prepare(
1430     "SELECT description,dateofbirthrequired,upperagelimit,category_type
1431     FROM categories
1432     WHERE categorycode = ?"
1433         );
1434         $sth->execute($catcode);
1435         my $data =
1436         $sth->fetchrow_hashref;
1437         $sth->finish();
1438         return $data;
1439     }
1440     return;
1441 }    # sub getborrowercategory
1442
1443 =head2 GetBorrowercategoryList
1444
1445   $arrayref_hashref = &GetBorrowercategoryList;
1446 If no category code provided, the function returns all the categories.
1447
1448 =cut
1449
1450 sub GetBorrowercategoryList {
1451     my $dbh       = C4::Context->dbh;
1452     my $sth       =
1453     $dbh->prepare(
1454     "SELECT *
1455     FROM categories
1456     ORDER BY description"
1457         );
1458     $sth->execute;
1459     my $data =
1460     $sth->fetchall_arrayref({});
1461     $sth->finish();
1462     return $data;
1463 }    # sub getborrowercategory
1464
1465 =head2 ethnicitycategories
1466
1467   ($codes_arrayref, $labels_hashref) = &ethnicitycategories();
1468
1469 Looks up the different ethnic types in the database. Returns two
1470 elements: a reference-to-array, which lists the ethnicity codes, and a
1471 reference-to-hash, which maps the ethnicity codes to ethnicity
1472 descriptions.
1473
1474 =cut
1475
1476 #'
1477
1478 sub ethnicitycategories {
1479     my $dbh = C4::Context->dbh;
1480     my $sth = $dbh->prepare("Select code,name from ethnicity order by name");
1481     $sth->execute;
1482     my %labels;
1483     my @codes;
1484     while ( my $data = $sth->fetchrow_hashref ) {
1485         push @codes, $data->{'code'};
1486         $labels{ $data->{'code'} } = $data->{'name'};
1487     }
1488     $sth->finish;
1489     return ( \@codes, \%labels );
1490 }
1491
1492 =head2 fixEthnicity
1493
1494   $ethn_name = &fixEthnicity($ethn_code);
1495
1496 Takes an ethnicity code (e.g., "european" or "pi") and returns the
1497 corresponding descriptive name from the C<ethnicity> table in the
1498 Koha database ("European" or "Pacific Islander").
1499
1500 =cut
1501
1502 #'
1503
1504 sub fixEthnicity {
1505     my $ethnicity = shift;
1506     return unless $ethnicity;
1507     my $dbh       = C4::Context->dbh;
1508     my $sth       = $dbh->prepare("Select name from ethnicity where code = ?");
1509     $sth->execute($ethnicity);
1510     my $data = $sth->fetchrow_hashref;
1511     $sth->finish;
1512     return $data->{'name'};
1513 }    # sub fixEthnicity
1514
1515 =head2 GetAge
1516
1517   $dateofbirth,$date = &GetAge($date);
1518
1519 this function return the borrowers age with the value of dateofbirth
1520
1521 =cut
1522
1523 #'
1524 sub GetAge{
1525     my ( $date, $date_ref ) = @_;
1526
1527     if ( not defined $date_ref ) {
1528         $date_ref = sprintf( '%04d-%02d-%02d', Today() );
1529     }
1530
1531     my ( $year1, $month1, $day1 ) = split /-/, $date;
1532     my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
1533
1534     my $age = $year2 - $year1;
1535     if ( $month1 . $day1 > $month2 . $day2 ) {
1536         $age--;
1537     }
1538
1539     return $age;
1540 }    # sub get_age
1541
1542 =head2 get_institutions
1543   $insitutions = get_institutions();
1544
1545 Just returns a list of all the borrowers of type I, borrownumber and name
1546
1547 =cut
1548
1549 #'
1550 sub get_institutions {
1551     my $dbh = C4::Context->dbh();
1552     my $sth =
1553       $dbh->prepare(
1554 "SELECT borrowernumber,surname FROM borrowers WHERE categorycode=? ORDER BY surname"
1555       );
1556     $sth->execute('I');
1557     my %orgs;
1558     while ( my $data = $sth->fetchrow_hashref() ) {
1559         $orgs{ $data->{'borrowernumber'} } = $data;
1560     }
1561     $sth->finish();
1562     return ( \%orgs );
1563
1564 }    # sub get_institutions
1565
1566 =head2 add_member_orgs
1567
1568   add_member_orgs($borrowernumber,$borrowernumbers);
1569
1570 Takes a borrowernumber and a list of other borrowernumbers and inserts them into the borrowers_to_borrowers table
1571
1572 =cut
1573
1574 #'
1575 sub add_member_orgs {
1576     my ( $borrowernumber, $otherborrowers ) = @_;
1577     my $dbh   = C4::Context->dbh();
1578     my $query =
1579       "INSERT INTO borrowers_to_borrowers (borrower1,borrower2) VALUES (?,?)";
1580     my $sth = $dbh->prepare($query);
1581     foreach my $otherborrowernumber (@$otherborrowers) {
1582         $sth->execute( $borrowernumber, $otherborrowernumber );
1583     }
1584     $sth->finish();
1585
1586 }    # sub add_member_orgs
1587
1588 =head2 GetCities (OUEST-PROVENCE)
1589
1590   ($id_cityarrayref, $city_hashref) = &GetCities();
1591
1592 Looks up the different city and zip in the database. Returns two
1593 elements: a reference-to-array, which lists the zip city
1594 codes, and a reference-to-hash, which maps the name of the city.
1595 WHERE =>OUEST PROVENCE OR EXTERIEUR
1596
1597 =cut
1598
1599 sub GetCities {
1600
1601     #my ($type_city) = @_;
1602     my $dbh   = C4::Context->dbh;
1603     my $query = qq|SELECT cityid,city_zipcode,city_name
1604         FROM cities
1605         ORDER BY city_name|;
1606     my $sth = $dbh->prepare($query);
1607
1608     #$sth->execute($type_city);
1609     $sth->execute();
1610     my %city;
1611     my @id;
1612     #    insert empty value to create a empty choice in cgi popup
1613     push @id, " ";
1614     $city{""} = "";
1615     while ( my $data = $sth->fetchrow_hashref ) {
1616         push @id, $data->{'city_zipcode'}."|".$data->{'city_name'};
1617         $city{ $data->{'city_zipcode'}."|".$data->{'city_name'} } = $data->{'city_name'};
1618     }
1619
1620 #test to know if the table contain some records if no the function return nothing
1621     my $id = @id;
1622     $sth->finish;
1623     if ( $id == 1 ) {
1624         # all we have is the one blank row
1625         return ();
1626     }
1627     else {
1628         unshift( @id, "" );
1629         return ( \@id, \%city );
1630     }
1631 }
1632
1633 =head2 GetSortDetails (OUEST-PROVENCE)
1634
1635   ($lib) = &GetSortDetails($category,$sortvalue);
1636
1637 Returns the authorized value  details
1638 C<&$lib>return value of authorized value details
1639 C<&$sortvalue>this is the value of authorized value
1640 C<&$category>this is the value of authorized value category
1641
1642 =cut
1643
1644 sub GetSortDetails {
1645     my ( $category, $sortvalue ) = @_;
1646     my $dbh   = C4::Context->dbh;
1647     my $query = qq|SELECT lib
1648         FROM authorised_values
1649         WHERE category=?
1650         AND authorised_value=? |;
1651     my $sth = $dbh->prepare($query);
1652     $sth->execute( $category, $sortvalue );
1653     my $lib = $sth->fetchrow;
1654     return ($lib) if ($lib);
1655     return ($sortvalue) unless ($lib);
1656 }
1657
1658 =head2 DeleteBorrower
1659
1660   () = &DeleteBorrower($member);
1661
1662 delete all data fo borrowers and add record to deletedborrowers table
1663 C<&$member>this is the borrowernumber
1664
1665 =cut
1666
1667 sub MoveMemberToDeleted {
1668     my ($member) = @_;
1669     my $dbh = C4::Context->dbh;
1670     my $query;
1671     $query = qq|SELECT *
1672           FROM borrowers
1673           WHERE borrowernumber=?|;
1674     my $sth = $dbh->prepare($query);
1675     $sth->execute($member);
1676     my @data = $sth->fetchrow_array;
1677     $sth->finish;
1678     $sth =
1679       $dbh->prepare( "INSERT INTO deletedborrowers VALUES ("
1680           . ( "?," x ( scalar(@data) - 1 ) )
1681           . "?)" );
1682     $sth->execute(@data);
1683     $sth->finish;
1684 }
1685
1686 =head2 DelMember
1687
1688 DelMember($borrowernumber);
1689
1690 This function remove directly a borrower whitout writing it on deleteborrower.
1691 + Deletes reserves for the borrower
1692
1693 =cut
1694
1695 sub DelMember {
1696     my $dbh            = C4::Context->dbh;
1697     my $borrowernumber = shift;
1698     #warn "in delmember with $borrowernumber";
1699     return unless $borrowernumber;    # borrowernumber is mandatory.
1700
1701     my $query = qq|DELETE
1702           FROM  reserves
1703           WHERE borrowernumber=?|;
1704     my $sth = $dbh->prepare($query);
1705     $sth->execute($borrowernumber);
1706     $sth->finish;
1707     $query = "
1708        DELETE
1709        FROM borrowers
1710        WHERE borrowernumber = ?
1711    ";
1712     $sth = $dbh->prepare($query);
1713     $sth->execute($borrowernumber);
1714     $sth->finish;
1715     logaction("MEMBERS", "DELETE", $borrowernumber, "") if C4::Context->preference("BorrowersLog");
1716     return $sth->rows;
1717 }
1718
1719 =head2 ExtendMemberSubscriptionTo (OUEST-PROVENCE)
1720
1721     $date = ExtendMemberSubscriptionTo($borrowerid, $date);
1722
1723 Extending the subscription to a given date or to the expiry date calculated on ISO date.
1724 Returns ISO date.
1725
1726 =cut
1727
1728 sub ExtendMemberSubscriptionTo {
1729     my ( $borrowerid,$date) = @_;
1730     my $dbh = C4::Context->dbh;
1731     my $borrower = GetMember($borrowerid,'borrowernumber');
1732     unless ($date){
1733       $date=POSIX::strftime("%Y-%m-%d",localtime());
1734       my $borrower = GetMember($borrowerid,'borrowernumber');
1735       $date = GetExpiryDate( $borrower->{'categorycode'}, $date );
1736     }
1737     my $sth = $dbh->do(<<EOF);
1738 UPDATE borrowers
1739 SET  dateexpiry='$date'
1740 WHERE borrowernumber='$borrowerid'
1741 EOF
1742     # add enrolmentfee if needed
1743     $sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
1744     $sth->execute($borrower->{'categorycode'});
1745     my ($enrolmentfee) = $sth->fetchrow;
1746     if ($enrolmentfee) {
1747         # insert fee in patron debts
1748         manualinvoice($borrower->{'borrowernumber'}, '', '', 'A', $enrolmentfee);
1749     }
1750     return $date if ($sth);
1751     return 0;
1752 }
1753
1754 =head2 GetRoadTypes (OUEST-PROVENCE)
1755
1756   ($idroadtypearrayref, $roadttype_hashref) = &GetRoadTypes();
1757
1758 Looks up the different road type . Returns two
1759 elements: a reference-to-array, which lists the id_roadtype
1760 codes, and a reference-to-hash, which maps the road type of the road .
1761
1762 =cut
1763
1764 sub GetRoadTypes {
1765     my $dbh   = C4::Context->dbh;
1766     my $query = qq|
1767 SELECT roadtypeid,road_type
1768 FROM roadtype
1769 ORDER BY road_type|;
1770     my $sth = $dbh->prepare($query);
1771     $sth->execute();
1772     my %roadtype;
1773     my @id;
1774
1775     #    insert empty value to create a empty choice in cgi popup
1776
1777     while ( my $data = $sth->fetchrow_hashref ) {
1778
1779         push @id, $data->{'roadtypeid'};
1780         $roadtype{ $data->{'roadtypeid'} } = $data->{'road_type'};
1781     }
1782
1783 #test to know if the table contain some records if no the function return nothing
1784     my $id = @id;
1785     $sth->finish;
1786     if ( $id eq 0 ) {
1787         return ();
1788     }
1789     else {
1790         unshift( @id, "" );
1791         return ( \@id, \%roadtype );
1792     }
1793 }
1794
1795
1796
1797 =head2 GetTitles (OUEST-PROVENCE)
1798
1799   ($borrowertitle)= &GetTitles();
1800
1801 Looks up the different title . Returns array  with all borrowers title
1802
1803 =cut
1804
1805 sub GetTitles {
1806     my @borrowerTitle = split /,|\|/,C4::Context->preference('BorrowersTitles');
1807     unshift( @borrowerTitle, "" );
1808     my $count=@borrowerTitle;
1809     if ($count == 1){
1810         return ();
1811     }
1812     else {
1813         return ( \@borrowerTitle);
1814     }
1815 }
1816
1817 =head2 GetPatronImage
1818
1819     my ($imagedata, $dberror) = GetPatronImage($cardnumber);
1820
1821 Returns the mimetype and binary image data of the image for the patron with the supplied cardnumber.
1822
1823 =cut
1824
1825 sub GetPatronImage {
1826     my ($cardnumber) = @_;
1827     warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1828     my $dbh = C4::Context->dbh;
1829     my $query = 'SELECT mimetype, imagefile FROM patronimage WHERE cardnumber = ?';
1830     my $sth = $dbh->prepare($query);
1831     $sth->execute($cardnumber);
1832     my $imagedata = $sth->fetchrow_hashref;
1833     my $dberror = $sth->errstr;
1834     warn "Database error!" if $sth->errstr;
1835     $sth->finish;
1836     return $imagedata, $dberror;
1837 }
1838
1839 =head2 PutPatronImage
1840
1841     PutPatronImage($cardnumber, $mimetype, $imgfile);
1842
1843 Stores patron binary image data and mimetype in database.
1844 NOTE: This function is good for updating images as well as inserting new images in the database.
1845
1846 =cut
1847
1848 sub PutPatronImage {
1849     my ($cardnumber, $mimetype, $imgfile) = @_;
1850     warn "Parameters passed in: Cardnumber=$cardnumber, Mimetype=$mimetype, " . ($imgfile ? "Imagefile" : "No Imagefile") if $debug;
1851     my $dbh = C4::Context->dbh;
1852     my $query = "INSERT INTO patronimage (cardnumber, mimetype, imagefile) VALUES (?,?,?) ON DUPLICATE KEY UPDATE imagefile = ?;";
1853     my $sth = $dbh->prepare($query);
1854     $sth->execute($cardnumber,$mimetype,$imgfile,$imgfile);
1855     warn "Error returned inserting $cardnumber.$mimetype." if $sth->errstr;
1856     my $dberror = $sth->errstr;
1857     $sth->finish;
1858     return $dberror;
1859 }
1860
1861 =head2 RmPatronImage
1862
1863     my ($dberror) = RmPatronImage($cardnumber);
1864
1865 Removes the image for the patron with the supplied cardnumber.
1866
1867 =cut
1868
1869 sub RmPatronImage {
1870     my ($cardnumber) = @_;
1871     warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1872     my $dbh = C4::Context->dbh;
1873     my $query = "DELETE FROM patronimage WHERE cardnumber = ?;";
1874     my $sth = $dbh->prepare($query);
1875     $sth->execute($cardnumber);
1876     my $dberror = $sth->errstr;
1877     warn "Database error!" if $sth->errstr;
1878     $sth->finish;
1879     return $dberror;
1880 }
1881
1882 =head2 GetRoadTypeDetails (OUEST-PROVENCE)
1883
1884   ($roadtype) = &GetRoadTypeDetails($roadtypeid);
1885
1886 Returns the description of roadtype
1887 C<&$roadtype>return description of road type
1888 C<&$roadtypeid>this is the value of roadtype s
1889
1890 =cut
1891
1892 sub GetRoadTypeDetails {
1893     my ($roadtypeid) = @_;
1894     my $dbh          = C4::Context->dbh;
1895     my $query        = qq|
1896 SELECT road_type
1897 FROM roadtype
1898 WHERE roadtypeid=?|;
1899     my $sth = $dbh->prepare($query);
1900     $sth->execute($roadtypeid);
1901     my $roadtype = $sth->fetchrow;
1902     return ($roadtype);
1903 }
1904
1905 =head2 GetBorrowersWhoHaveNotBorrowedSince
1906
1907 &GetBorrowersWhoHaveNotBorrowedSince($date)
1908
1909 this function get all borrowers who haven't borrowed since the date given on input arg.
1910
1911 =cut
1912
1913 sub GetBorrowersWhoHaveNotBorrowedSince {
1914 ### 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.
1915
1916                 my $filterdate = shift||POSIX::strftime("%Y-%m-%d",localtime());
1917     my $filterbranch = shift ||
1918                         ((C4::Context->preference('IndependantBranches')
1919                              && C4::Context->userenv
1920                              && C4::Context->userenv->{flags}!=1
1921                              && C4::Context->userenv->{branch})
1922                          ? C4::Context->userenv->{branch}
1923                          : "");
1924     my $dbh   = C4::Context->dbh;
1925     my $query = "
1926         SELECT borrowers.borrowernumber,max(issues.timestamp) as latestissue
1927         FROM   borrowers
1928         JOIN   categories USING (categorycode)
1929         LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
1930         WHERE  category_type <> 'S'
1931    ";
1932     my @query_params;
1933     if ($filterbranch && $filterbranch ne ""){
1934         $query.=" AND borrowers.branchcode= ?";
1935         push @query_params,$filterbranch;
1936     }
1937     $query.=" GROUP BY borrowers.borrowernumber";
1938     if ($filterdate){
1939         $query.=" HAVING latestissue <? OR latestissue IS NULL";
1940         push @query_params,$filterdate;
1941     }
1942     warn $query if $debug;
1943     my $sth = $dbh->prepare($query);
1944     if (scalar(@query_params)>0){
1945         $sth->execute(@query_params);
1946     }
1947     else {
1948         $sth->execute;
1949     }
1950
1951     my @results;
1952     while ( my $data = $sth->fetchrow_hashref ) {
1953         push @results, $data;
1954     }
1955     return \@results;
1956 }
1957
1958 =head2 GetBorrowersWhoHaveNeverBorrowed
1959
1960 $results = &GetBorrowersWhoHaveNeverBorrowed
1961
1962 this function get all borrowers who have never borrowed.
1963
1964 I<$result> is a ref to an array which all elements are a hasref.
1965
1966 =cut
1967
1968 sub GetBorrowersWhoHaveNeverBorrowed {
1969     my $filterbranch = shift ||
1970                         ((C4::Context->preference('IndependantBranches')
1971                              && C4::Context->userenv
1972                              && C4::Context->userenv->{flags}!=1
1973                              && C4::Context->userenv->{branch})
1974                          ? C4::Context->userenv->{branch}
1975                          : "");
1976     my $dbh   = C4::Context->dbh;
1977     my $query = "
1978         SELECT borrowers.borrowernumber,max(timestamp) as latestissue
1979         FROM   borrowers
1980           LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
1981         WHERE issues.borrowernumber IS NULL
1982    ";
1983     my @query_params;
1984     if ($filterbranch && $filterbranch ne ""){
1985         $query.=" AND borrowers.branchcode= ?";
1986         push @query_params,$filterbranch;
1987     }
1988     warn $query if $debug;
1989
1990     my $sth = $dbh->prepare($query);
1991     if (scalar(@query_params)>0){
1992         $sth->execute(@query_params);
1993     }
1994     else {
1995         $sth->execute;
1996     }
1997
1998     my @results;
1999     while ( my $data = $sth->fetchrow_hashref ) {
2000         push @results, $data;
2001     }
2002     return \@results;
2003 }
2004
2005 =head2 GetBorrowersWithIssuesHistoryOlderThan
2006
2007 $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
2008
2009 this function get all borrowers who has an issue history older than I<$date> given on input arg.
2010
2011 I<$result> is a ref to an array which all elements are a hashref.
2012 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2013
2014 =cut
2015
2016 sub GetBorrowersWithIssuesHistoryOlderThan {
2017     my $dbh  = C4::Context->dbh;
2018     my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
2019     my $filterbranch = shift ||
2020                         ((C4::Context->preference('IndependantBranches')
2021                              && C4::Context->userenv
2022                              && C4::Context->userenv->{flags}!=1
2023                              && C4::Context->userenv->{branch})
2024                          ? C4::Context->userenv->{branch}
2025                          : "");
2026     my $query = "
2027        SELECT count(borrowernumber) as n,borrowernumber
2028        FROM old_issues
2029        WHERE returndate < ?
2030          AND borrowernumber IS NOT NULL
2031     ";
2032     my @query_params;
2033     push @query_params, $date;
2034     if ($filterbranch){
2035         $query.="   AND branchcode = ?";
2036         push @query_params, $filterbranch;
2037     }
2038     $query.=" GROUP BY borrowernumber ";
2039     warn $query if $debug;
2040     my $sth = $dbh->prepare($query);
2041     $sth->execute(@query_params);
2042     my @results;
2043
2044     while ( my $data = $sth->fetchrow_hashref ) {
2045         push @results, $data;
2046     }
2047     return \@results;
2048 }
2049
2050 =head2 GetBorrowersNamesAndLatestIssue
2051
2052 $results = &GetBorrowersNamesAndLatestIssueList(@borrowernumbers)
2053
2054 this function get borrowers Names and surnames and Issue information.
2055
2056 I<@borrowernumbers> is an array which all elements are borrowernumbers.
2057 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2058
2059 =cut
2060
2061 sub GetBorrowersNamesAndLatestIssue {
2062     my $dbh  = C4::Context->dbh;
2063     my @borrowernumbers=@_;
2064     my $query = "
2065        SELECT surname,lastname, phone, email,max(timestamp)
2066        FROM borrowers
2067          LEFT JOIN issues ON borrowers.borrowernumber=issues.borrowernumber
2068        GROUP BY borrowernumber
2069    ";
2070     my $sth = $dbh->prepare($query);
2071     $sth->execute;
2072     my $results = $sth->fetchall_arrayref({});
2073     return $results;
2074 }
2075
2076 =head2 DebarMember
2077
2078 =over 4
2079
2080 my $success = DebarMember( $borrowernumber );
2081
2082 marks a Member as debarred, and therefore unable to checkout any more
2083 items.
2084
2085 return :
2086 true on success, false on failure
2087
2088 =back
2089
2090 =cut
2091
2092 sub DebarMember {
2093     my $borrowernumber = shift;
2094
2095     return unless defined $borrowernumber;
2096     return unless $borrowernumber =~ /^\d+$/;
2097
2098     return ModMember( borrowernumber => $borrowernumber,
2099                       debarred       => 1 );
2100
2101 }
2102
2103 END { }    # module clean-up code here (global destructor)
2104
2105 1;
2106
2107 __END__
2108
2109 =head1 AUTHOR
2110
2111 Koha Team
2112
2113 =cut