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') || 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         $acctlines[$numlines] = $data;
1171         $numlines++;
1172         $total += int(100 * $data->{'amountoutstanding'}); # convert float to integer to avoid round-off errors
1173     }
1174     $total /= 100;
1175     $sth->finish;
1176     return ( $total, \@acctlines,$numlines);
1177 }
1178
1179 =head2 GetBorNotifyAcctRecord
1180
1181   ($count, $acctlines, $total) = &GetBorNotifyAcctRecord($params,$notifyid);
1182
1183 Looks up accounting data for the patron with the given borrowernumber per file number.
1184
1185 (FIXME - I'm not at all sure what this is about.)
1186
1187 C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a
1188 reference-to-array, where each element is a reference-to-hash; the
1189 keys are the fields of the C<accountlines> table in the Koha database.
1190 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1191 total amount outstanding for all of the account lines.
1192
1193 =cut
1194
1195 sub GetBorNotifyAcctRecord {
1196     my ( $borrowernumber, $notifyid ) = @_;
1197     my $dbh = C4::Context->dbh;
1198     my @acctlines;
1199     my $numlines = 0;
1200     my $sth = $dbh->prepare(
1201             "SELECT *
1202                 FROM accountlines
1203                 WHERE borrowernumber=?
1204                     AND notify_id=?
1205                     AND amountoutstanding != '0'
1206                 ORDER BY notify_id,accounttype
1207                 ");
1208 #                    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')
1209
1210     $sth->execute( $borrowernumber, $notifyid );
1211     my $total = 0;
1212     while ( my $data = $sth->fetchrow_hashref ) {
1213         $acctlines[$numlines] = $data;
1214         $numlines++;
1215         $total += int(100 * $data->{'amountoutstanding'});
1216     }
1217     $total /= 100;
1218     $sth->finish;
1219     return ( $total, \@acctlines, $numlines );
1220 }
1221
1222 =head2 checkuniquemember (OUEST-PROVENCE)
1223
1224   ($result,$categorycode)  = &checkuniquemember($collectivity,$surname,$firstname,$dateofbirth);
1225
1226 Checks that a member exists or not in the database.
1227
1228 C<&result> is nonzero (=exist) or 0 (=does not exist)
1229 C<&categorycode> is from categorycode table
1230 C<&collectivity> is 1 (= we add a collectivity) or 0 (= we add a physical member)
1231 C<&surname> is the surname
1232 C<&firstname> is the firstname (only if collectivity=0)
1233 C<&dateofbirth> is the date of birth in ISO format (only if collectivity=0)
1234
1235 =cut
1236
1237 # FIXME: This function is not legitimate.  Multiple patrons might have the same first/last name and birthdate.
1238 # This is especially true since first name is not even a required field.
1239
1240 sub checkuniquemember {
1241     my ( $collectivity, $surname, $firstname, $dateofbirth ) = @_;
1242     my $dbh = C4::Context->dbh;
1243     my $request = ($collectivity) ?
1244         "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? " :
1245             ($dateofbirth) ?
1246             "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=?  and dateofbirth=?" :
1247             "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=?";
1248     my $sth = $dbh->prepare($request);
1249     if ($collectivity) {
1250         $sth->execute( uc($surname) );
1251     } elsif($dateofbirth){
1252         $sth->execute( uc($surname), ucfirst($firstname), $dateofbirth );
1253     }else{
1254         $sth->execute( uc($surname), ucfirst($firstname));
1255     }
1256     my @data = $sth->fetchrow;
1257     $sth->finish;
1258     ( $data[0] ) and return $data[0], $data[1];
1259     return 0;
1260 }
1261
1262 sub checkcardnumber {
1263     my ($cardnumber,$borrowernumber) = @_;
1264     my $dbh = C4::Context->dbh;
1265     my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
1266     $query .= " AND borrowernumber <> ?" if ($borrowernumber);
1267   my $sth = $dbh->prepare($query);
1268   if ($borrowernumber) {
1269    $sth->execute($cardnumber,$borrowernumber);
1270   } else {
1271      $sth->execute($cardnumber);
1272   }
1273     if (my $data= $sth->fetchrow_hashref()){
1274         return 1;
1275     }
1276     else {
1277         return 0;
1278     }
1279     $sth->finish();
1280 }
1281
1282
1283 =head2 getzipnamecity (OUEST-PROVENCE)
1284
1285 take all info from table city for the fields city and  zip
1286 check for the name and the zip code of the city selected
1287
1288 =cut
1289
1290 sub getzipnamecity {
1291     my ($cityid) = @_;
1292     my $dbh      = C4::Context->dbh;
1293     my $sth      =
1294       $dbh->prepare(
1295         "select city_name,city_zipcode from cities where cityid=? ");
1296     $sth->execute($cityid);
1297     my @data = $sth->fetchrow;
1298     return $data[0], $data[1];
1299 }
1300
1301
1302 =head2 getdcity (OUEST-PROVENCE)
1303
1304 recover cityid  with city_name condition
1305
1306 =cut
1307
1308 sub getidcity {
1309     my ($city_name) = @_;
1310     my $dbh = C4::Context->dbh;
1311     my $sth = $dbh->prepare("select cityid from cities where city_name=? ");
1312     $sth->execute($city_name);
1313     my $data = $sth->fetchrow;
1314     return $data;
1315 }
1316
1317
1318 =head2 GetExpiryDate
1319
1320   $expirydate = GetExpiryDate($categorycode, $dateenrolled);
1321
1322 Calculate expiry date given a categorycode and starting date.  Date argument must be in ISO format.
1323 Return date is also in ISO format.
1324
1325 =cut
1326
1327 sub GetExpiryDate {
1328     my ( $categorycode, $dateenrolled ) = @_;
1329     my $enrolmentperiod = 12;   # reasonable default
1330     if ($categorycode) {
1331         my $dbh = C4::Context->dbh;
1332         my $sth = $dbh->prepare("select enrolmentperiod from categories where categorycode=?");
1333         $sth->execute($categorycode);
1334         $enrolmentperiod = $sth->fetchrow;
1335     }
1336     # die "GetExpiryDate: for enrollmentperiod $enrolmentperiod (category '$categorycode') starting $dateenrolled.\n";
1337     my @date = split /-/,$dateenrolled;
1338     return sprintf("%04d-%02d-%02d", Add_Delta_YM(@date,0,$enrolmentperiod));
1339 }
1340
1341 =head2 checkuserpassword (OUEST-PROVENCE)
1342
1343 check for the password and login are not used
1344 return the number of record
1345 0=> NOT USED 1=> USED
1346
1347 =cut
1348
1349 sub checkuserpassword {
1350     my ( $borrowernumber, $userid, $password ) = @_;
1351     $password = md5_base64($password);
1352     my $dbh = C4::Context->dbh;
1353     my $sth =
1354       $dbh->prepare(
1355 "Select count(*) from borrowers where borrowernumber !=? and userid =? and password=? "
1356       );
1357     $sth->execute( $borrowernumber, $userid, $password );
1358     my $number_rows = $sth->fetchrow;
1359     return $number_rows;
1360
1361 }
1362
1363 =head2 GetborCatFromCatType
1364
1365   ($codes_arrayref, $labels_hashref) = &GetborCatFromCatType();
1366
1367 Looks up the different types of borrowers in the database. Returns two
1368 elements: a reference-to-array, which lists the borrower category
1369 codes, and a reference-to-hash, which maps the borrower category codes
1370 to category descriptions.
1371
1372 =cut
1373
1374 #'
1375 sub GetborCatFromCatType {
1376     my ( $category_type, $action ) = @_;
1377         # FIXME - This API  seems both limited and dangerous.
1378     my $dbh     = C4::Context->dbh;
1379     my $request = qq|   SELECT categorycode,description
1380             FROM categories
1381             $action
1382             ORDER BY categorycode|;
1383     my $sth = $dbh->prepare($request);
1384         if ($action) {
1385         $sth->execute($category_type);
1386     }
1387     else {
1388         $sth->execute();
1389     }
1390
1391     my %labels;
1392     my @codes;
1393
1394     while ( my $data = $sth->fetchrow_hashref ) {
1395         push @codes, $data->{'categorycode'};
1396         $labels{ $data->{'categorycode'} } = $data->{'description'};
1397     }
1398     $sth->finish;
1399     return ( \@codes, \%labels );
1400 }
1401
1402 =head2 GetBorrowercategory
1403
1404   $hashref = &GetBorrowercategory($categorycode);
1405
1406 Given the borrower's category code, the function returns the corresponding
1407 data hashref for a comprehensive information display.
1408
1409   $arrayref_hashref = &GetBorrowercategory;
1410 If no category code provided, the function returns all the categories.
1411
1412 =cut
1413
1414 sub GetBorrowercategory {
1415     my ($catcode) = @_;
1416     my $dbh       = C4::Context->dbh;
1417     if ($catcode){
1418         my $sth       =
1419         $dbh->prepare(
1420     "SELECT description,dateofbirthrequired,upperagelimit,category_type
1421     FROM categories
1422     WHERE categorycode = ?"
1423         );
1424         $sth->execute($catcode);
1425         my $data =
1426         $sth->fetchrow_hashref;
1427         $sth->finish();
1428         return $data;
1429     }
1430     return;
1431 }    # sub getborrowercategory
1432
1433 =head2 GetBorrowercategoryList
1434
1435   $arrayref_hashref = &GetBorrowercategoryList;
1436 If no category code provided, the function returns all the categories.
1437
1438 =cut
1439
1440 sub GetBorrowercategoryList {
1441     my $dbh       = C4::Context->dbh;
1442     my $sth       =
1443     $dbh->prepare(
1444     "SELECT *
1445     FROM categories
1446     ORDER BY description"
1447         );
1448     $sth->execute;
1449     my $data =
1450     $sth->fetchall_arrayref({});
1451     $sth->finish();
1452     return $data;
1453 }    # sub getborrowercategory
1454
1455 =head2 ethnicitycategories
1456
1457   ($codes_arrayref, $labels_hashref) = &ethnicitycategories();
1458
1459 Looks up the different ethnic types in the database. Returns two
1460 elements: a reference-to-array, which lists the ethnicity codes, and a
1461 reference-to-hash, which maps the ethnicity codes to ethnicity
1462 descriptions.
1463
1464 =cut
1465
1466 #'
1467
1468 sub ethnicitycategories {
1469     my $dbh = C4::Context->dbh;
1470     my $sth = $dbh->prepare("Select code,name from ethnicity order by name");
1471     $sth->execute;
1472     my %labels;
1473     my @codes;
1474     while ( my $data = $sth->fetchrow_hashref ) {
1475         push @codes, $data->{'code'};
1476         $labels{ $data->{'code'} } = $data->{'name'};
1477     }
1478     $sth->finish;
1479     return ( \@codes, \%labels );
1480 }
1481
1482 =head2 fixEthnicity
1483
1484   $ethn_name = &fixEthnicity($ethn_code);
1485
1486 Takes an ethnicity code (e.g., "european" or "pi") and returns the
1487 corresponding descriptive name from the C<ethnicity> table in the
1488 Koha database ("European" or "Pacific Islander").
1489
1490 =cut
1491
1492 #'
1493
1494 sub fixEthnicity {
1495     my $ethnicity = shift;
1496     return unless $ethnicity;
1497     my $dbh       = C4::Context->dbh;
1498     my $sth       = $dbh->prepare("Select name from ethnicity where code = ?");
1499     $sth->execute($ethnicity);
1500     my $data = $sth->fetchrow_hashref;
1501     $sth->finish;
1502     return $data->{'name'};
1503 }    # sub fixEthnicity
1504
1505 =head2 GetAge
1506
1507   $dateofbirth,$date = &GetAge($date);
1508
1509 this function return the borrowers age with the value of dateofbirth
1510
1511 =cut
1512
1513 #'
1514 sub GetAge{
1515     my ( $date, $date_ref ) = @_;
1516
1517     if ( not defined $date_ref ) {
1518         $date_ref = sprintf( '%04d-%02d-%02d', Today() );
1519     }
1520
1521     my ( $year1, $month1, $day1 ) = split /-/, $date;
1522     my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
1523
1524     my $age = $year2 - $year1;
1525     if ( $month1 . $day1 > $month2 . $day2 ) {
1526         $age--;
1527     }
1528
1529     return $age;
1530 }    # sub get_age
1531
1532 =head2 get_institutions
1533   $insitutions = get_institutions();
1534
1535 Just returns a list of all the borrowers of type I, borrownumber and name
1536
1537 =cut
1538
1539 #'
1540 sub get_institutions {
1541     my $dbh = C4::Context->dbh();
1542     my $sth =
1543       $dbh->prepare(
1544 "SELECT borrowernumber,surname FROM borrowers WHERE categorycode=? ORDER BY surname"
1545       );
1546     $sth->execute('I');
1547     my %orgs;
1548     while ( my $data = $sth->fetchrow_hashref() ) {
1549         $orgs{ $data->{'borrowernumber'} } = $data;
1550     }
1551     $sth->finish();
1552     return ( \%orgs );
1553
1554 }    # sub get_institutions
1555
1556 =head2 add_member_orgs
1557
1558   add_member_orgs($borrowernumber,$borrowernumbers);
1559
1560 Takes a borrowernumber and a list of other borrowernumbers and inserts them into the borrowers_to_borrowers table
1561
1562 =cut
1563
1564 #'
1565 sub add_member_orgs {
1566     my ( $borrowernumber, $otherborrowers ) = @_;
1567     my $dbh   = C4::Context->dbh();
1568     my $query =
1569       "INSERT INTO borrowers_to_borrowers (borrower1,borrower2) VALUES (?,?)";
1570     my $sth = $dbh->prepare($query);
1571     foreach my $otherborrowernumber (@$otherborrowers) {
1572         $sth->execute( $borrowernumber, $otherborrowernumber );
1573     }
1574     $sth->finish();
1575
1576 }    # sub add_member_orgs
1577
1578 =head2 GetCities (OUEST-PROVENCE)
1579
1580   ($id_cityarrayref, $city_hashref) = &GetCities();
1581
1582 Looks up the different city and zip in the database. Returns two
1583 elements: a reference-to-array, which lists the zip city
1584 codes, and a reference-to-hash, which maps the name of the city.
1585 WHERE =>OUEST PROVENCE OR EXTERIEUR
1586
1587 =cut
1588
1589 sub GetCities {
1590
1591     #my ($type_city) = @_;
1592     my $dbh   = C4::Context->dbh;
1593     my $query = qq|SELECT cityid,city_zipcode,city_name
1594         FROM cities
1595         ORDER BY city_name|;
1596     my $sth = $dbh->prepare($query);
1597
1598     #$sth->execute($type_city);
1599     $sth->execute();
1600     my %city;
1601     my @id;
1602     #    insert empty value to create a empty choice in cgi popup
1603     push @id, " ";
1604     $city{""} = "";
1605     while ( my $data = $sth->fetchrow_hashref ) {
1606         push @id, $data->{'city_zipcode'}."|".$data->{'city_name'};
1607         $city{ $data->{'city_zipcode'}."|".$data->{'city_name'} } = $data->{'city_name'};
1608     }
1609
1610 #test to know if the table contain some records if no the function return nothing
1611     my $id = @id;
1612     $sth->finish;
1613     if ( $id == 1 ) {
1614         # all we have is the one blank row
1615         return ();
1616     }
1617     else {
1618         unshift( @id, "" );
1619         return ( \@id, \%city );
1620     }
1621 }
1622
1623 =head2 GetSortDetails (OUEST-PROVENCE)
1624
1625   ($lib) = &GetSortDetails($category,$sortvalue);
1626
1627 Returns the authorized value  details
1628 C<&$lib>return value of authorized value details
1629 C<&$sortvalue>this is the value of authorized value
1630 C<&$category>this is the value of authorized value category
1631
1632 =cut
1633
1634 sub GetSortDetails {
1635     my ( $category, $sortvalue ) = @_;
1636     my $dbh   = C4::Context->dbh;
1637     my $query = qq|SELECT lib
1638         FROM authorised_values
1639         WHERE category=?
1640         AND authorised_value=? |;
1641     my $sth = $dbh->prepare($query);
1642     $sth->execute( $category, $sortvalue );
1643     my $lib = $sth->fetchrow;
1644     return ($lib) if ($lib);
1645     return ($sortvalue) unless ($lib);
1646 }
1647
1648 =head2 DeleteBorrower
1649
1650   () = &DeleteBorrower($member);
1651
1652 delete all data fo borrowers and add record to deletedborrowers table
1653 C<&$member>this is the borrowernumber
1654
1655 =cut
1656
1657 sub MoveMemberToDeleted {
1658     my ($member) = @_;
1659     my $dbh = C4::Context->dbh;
1660     my $query;
1661     $query = qq|SELECT *
1662           FROM borrowers
1663           WHERE borrowernumber=?|;
1664     my $sth = $dbh->prepare($query);
1665     $sth->execute($member);
1666     my @data = $sth->fetchrow_array;
1667     $sth->finish;
1668     $sth =
1669       $dbh->prepare( "INSERT INTO deletedborrowers VALUES ("
1670           . ( "?," x ( scalar(@data) - 1 ) )
1671           . "?)" );
1672     $sth->execute(@data);
1673     $sth->finish;
1674 }
1675
1676 =head2 DelMember
1677
1678 DelMember($borrowernumber);
1679
1680 This function remove directly a borrower whitout writing it on deleteborrower.
1681 + Deletes reserves for the borrower
1682
1683 =cut
1684
1685 sub DelMember {
1686     my $dbh            = C4::Context->dbh;
1687     my $borrowernumber = shift;
1688     #warn "in delmember with $borrowernumber";
1689     return unless $borrowernumber;    # borrowernumber is mandatory.
1690
1691     my $query = qq|DELETE
1692           FROM  reserves
1693           WHERE borrowernumber=?|;
1694     my $sth = $dbh->prepare($query);
1695     $sth->execute($borrowernumber);
1696     $sth->finish;
1697     $query = "
1698        DELETE
1699        FROM borrowers
1700        WHERE borrowernumber = ?
1701    ";
1702     $sth = $dbh->prepare($query);
1703     $sth->execute($borrowernumber);
1704     $sth->finish;
1705     logaction("MEMBERS", "DELETE", $borrowernumber, "") if C4::Context->preference("BorrowersLog");
1706     return $sth->rows;
1707 }
1708
1709 =head2 ExtendMemberSubscriptionTo (OUEST-PROVENCE)
1710
1711     $date = ExtendMemberSubscriptionTo($borrowerid, $date);
1712
1713 Extending the subscription to a given date or to the expiry date calculated on ISO date.
1714 Returns ISO date.
1715
1716 =cut
1717
1718 sub ExtendMemberSubscriptionTo {
1719     my ( $borrowerid,$date) = @_;
1720     my $dbh = C4::Context->dbh;
1721     my $borrower = GetMember($borrowerid,'borrowernumber');
1722     unless ($date){
1723       $date=POSIX::strftime("%Y-%m-%d",localtime());
1724       my $borrower = GetMember($borrowerid,'borrowernumber');
1725       $date = GetExpiryDate( $borrower->{'categorycode'}, $date );
1726     }
1727     my $sth = $dbh->do(<<EOF);
1728 UPDATE borrowers
1729 SET  dateexpiry='$date'
1730 WHERE borrowernumber='$borrowerid'
1731 EOF
1732     # add enrolmentfee if needed
1733     $sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
1734     $sth->execute($borrower->{'categorycode'});
1735     my ($enrolmentfee) = $sth->fetchrow;
1736     if ($enrolmentfee && $enrolmentfee > 0) {
1737         # insert fee in patron debts
1738         manualinvoice($borrower->{'borrowernumber'}, '', '', 'A', $enrolmentfee);
1739     }
1740     return $date if ($sth);
1741     return 0;
1742 }
1743
1744 =head2 GetRoadTypes (OUEST-PROVENCE)
1745
1746   ($idroadtypearrayref, $roadttype_hashref) = &GetRoadTypes();
1747
1748 Looks up the different road type . Returns two
1749 elements: a reference-to-array, which lists the id_roadtype
1750 codes, and a reference-to-hash, which maps the road type of the road .
1751
1752 =cut
1753
1754 sub GetRoadTypes {
1755     my $dbh   = C4::Context->dbh;
1756     my $query = qq|
1757 SELECT roadtypeid,road_type
1758 FROM roadtype
1759 ORDER BY road_type|;
1760     my $sth = $dbh->prepare($query);
1761     $sth->execute();
1762     my %roadtype;
1763     my @id;
1764
1765     #    insert empty value to create a empty choice in cgi popup
1766
1767     while ( my $data = $sth->fetchrow_hashref ) {
1768
1769         push @id, $data->{'roadtypeid'};
1770         $roadtype{ $data->{'roadtypeid'} } = $data->{'road_type'};
1771     }
1772
1773 #test to know if the table contain some records if no the function return nothing
1774     my $id = @id;
1775     $sth->finish;
1776     if ( $id eq 0 ) {
1777         return ();
1778     }
1779     else {
1780         unshift( @id, "" );
1781         return ( \@id, \%roadtype );
1782     }
1783 }
1784
1785
1786
1787 =head2 GetTitles (OUEST-PROVENCE)
1788
1789   ($borrowertitle)= &GetTitles();
1790
1791 Looks up the different title . Returns array  with all borrowers title
1792
1793 =cut
1794
1795 sub GetTitles {
1796     my @borrowerTitle = split /,|\|/,C4::Context->preference('BorrowersTitles');
1797     unshift( @borrowerTitle, "" );
1798     my $count=@borrowerTitle;
1799     if ($count == 1){
1800         return ();
1801     }
1802     else {
1803         return ( \@borrowerTitle);
1804     }
1805 }
1806
1807 =head2 GetPatronImage
1808
1809     my ($imagedata, $dberror) = GetPatronImage($cardnumber);
1810
1811 Returns the mimetype and binary image data of the image for the patron with the supplied cardnumber.
1812
1813 =cut
1814
1815 sub GetPatronImage {
1816     my ($cardnumber) = @_;
1817     warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1818     my $dbh = C4::Context->dbh;
1819     my $query = 'SELECT mimetype, imagefile FROM patronimage WHERE cardnumber = ?';
1820     my $sth = $dbh->prepare($query);
1821     $sth->execute($cardnumber);
1822     my $imagedata = $sth->fetchrow_hashref;
1823     my $dberror = $sth->errstr;
1824     warn "Database error!" if $sth->errstr;
1825     $sth->finish;
1826     return $imagedata, $dberror;
1827 }
1828
1829 =head2 PutPatronImage
1830
1831     PutPatronImage($cardnumber, $mimetype, $imgfile);
1832
1833 Stores patron binary image data and mimetype in database.
1834 NOTE: This function is good for updating images as well as inserting new images in the database.
1835
1836 =cut
1837
1838 sub PutPatronImage {
1839     my ($cardnumber, $mimetype, $imgfile) = @_;
1840     warn "Parameters passed in: Cardnumber=$cardnumber, Mimetype=$mimetype, " . ($imgfile ? "Imagefile" : "No Imagefile") if $debug;
1841     my $dbh = C4::Context->dbh;
1842     my $query = "INSERT INTO patronimage (cardnumber, mimetype, imagefile) VALUES (?,?,?) ON DUPLICATE KEY UPDATE imagefile = ?;";
1843     my $sth = $dbh->prepare($query);
1844     $sth->execute($cardnumber,$mimetype,$imgfile,$imgfile);
1845     warn "Error returned inserting $cardnumber.$mimetype." if $sth->errstr;
1846     my $dberror = $sth->errstr;
1847     $sth->finish;
1848     return $dberror;
1849 }
1850
1851 =head2 RmPatronImage
1852
1853     my ($dberror) = RmPatronImage($cardnumber);
1854
1855 Removes the image for the patron with the supplied cardnumber.
1856
1857 =cut
1858
1859 sub RmPatronImage {
1860     my ($cardnumber) = @_;
1861     warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1862     my $dbh = C4::Context->dbh;
1863     my $query = "DELETE FROM patronimage WHERE cardnumber = ?;";
1864     my $sth = $dbh->prepare($query);
1865     $sth->execute($cardnumber);
1866     my $dberror = $sth->errstr;
1867     warn "Database error!" if $sth->errstr;
1868     $sth->finish;
1869     return $dberror;
1870 }
1871
1872 =head2 GetRoadTypeDetails (OUEST-PROVENCE)
1873
1874   ($roadtype) = &GetRoadTypeDetails($roadtypeid);
1875
1876 Returns the description of roadtype
1877 C<&$roadtype>return description of road type
1878 C<&$roadtypeid>this is the value of roadtype s
1879
1880 =cut
1881
1882 sub GetRoadTypeDetails {
1883     my ($roadtypeid) = @_;
1884     my $dbh          = C4::Context->dbh;
1885     my $query        = qq|
1886 SELECT road_type
1887 FROM roadtype
1888 WHERE roadtypeid=?|;
1889     my $sth = $dbh->prepare($query);
1890     $sth->execute($roadtypeid);
1891     my $roadtype = $sth->fetchrow;
1892     return ($roadtype);
1893 }
1894
1895 =head2 GetBorrowersWhoHaveNotBorrowedSince
1896
1897 &GetBorrowersWhoHaveNotBorrowedSince($date)
1898
1899 this function get all borrowers who haven't borrowed since the date given on input arg.
1900
1901 =cut
1902
1903 sub GetBorrowersWhoHaveNotBorrowedSince {
1904 ### 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.
1905
1906                 my $filterdate = shift||POSIX::strftime("%Y-%m-%d",localtime());
1907     my $filterbranch = shift ||
1908                         ((C4::Context->preference('IndependantBranches')
1909                              && C4::Context->userenv
1910                              && C4::Context->userenv->{flags}!=1
1911                              && C4::Context->userenv->{branch})
1912                          ? C4::Context->userenv->{branch}
1913                          : "");
1914     my $dbh   = C4::Context->dbh;
1915     my $query = "
1916         SELECT borrowers.borrowernumber,max(issues.timestamp) as latestissue
1917         FROM   borrowers
1918         JOIN   categories USING (categorycode)
1919         LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
1920         WHERE  category_type <> 'S'
1921    ";
1922     my @query_params;
1923     if ($filterbranch && $filterbranch ne ""){
1924         $query.=" AND borrowers.branchcode= ?";
1925         push @query_params,$filterbranch;
1926     }
1927     $query.=" GROUP BY borrowers.borrowernumber";
1928     if ($filterdate){
1929         $query.=" HAVING latestissue <? OR latestissue IS NULL";
1930         push @query_params,$filterdate;
1931     }
1932     warn $query if $debug;
1933     my $sth = $dbh->prepare($query);
1934     if (scalar(@query_params)>0){
1935         $sth->execute(@query_params);
1936     }
1937     else {
1938         $sth->execute;
1939     }
1940
1941     my @results;
1942     while ( my $data = $sth->fetchrow_hashref ) {
1943         push @results, $data;
1944     }
1945     return \@results;
1946 }
1947
1948 =head2 GetBorrowersWhoHaveNeverBorrowed
1949
1950 $results = &GetBorrowersWhoHaveNeverBorrowed
1951
1952 this function get all borrowers who have never borrowed.
1953
1954 I<$result> is a ref to an array which all elements are a hasref.
1955
1956 =cut
1957
1958 sub GetBorrowersWhoHaveNeverBorrowed {
1959     my $filterbranch = shift ||
1960                         ((C4::Context->preference('IndependantBranches')
1961                              && C4::Context->userenv
1962                              && C4::Context->userenv->{flags}!=1
1963                              && C4::Context->userenv->{branch})
1964                          ? C4::Context->userenv->{branch}
1965                          : "");
1966     my $dbh   = C4::Context->dbh;
1967     my $query = "
1968         SELECT borrowers.borrowernumber,max(timestamp) as latestissue
1969         FROM   borrowers
1970           LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
1971         WHERE issues.borrowernumber IS NULL
1972    ";
1973     my @query_params;
1974     if ($filterbranch && $filterbranch ne ""){
1975         $query.=" AND borrowers.branchcode= ?";
1976         push @query_params,$filterbranch;
1977     }
1978     warn $query if $debug;
1979
1980     my $sth = $dbh->prepare($query);
1981     if (scalar(@query_params)>0){
1982         $sth->execute(@query_params);
1983     }
1984     else {
1985         $sth->execute;
1986     }
1987
1988     my @results;
1989     while ( my $data = $sth->fetchrow_hashref ) {
1990         push @results, $data;
1991     }
1992     return \@results;
1993 }
1994
1995 =head2 GetBorrowersWithIssuesHistoryOlderThan
1996
1997 $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
1998
1999 this function get all borrowers who has an issue history older than I<$date> given on input arg.
2000
2001 I<$result> is a ref to an array which all elements are a hashref.
2002 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2003
2004 =cut
2005
2006 sub GetBorrowersWithIssuesHistoryOlderThan {
2007     my $dbh  = C4::Context->dbh;
2008     my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
2009     my $filterbranch = shift ||
2010                         ((C4::Context->preference('IndependantBranches')
2011                              && C4::Context->userenv
2012                              && C4::Context->userenv->{flags}!=1
2013                              && C4::Context->userenv->{branch})
2014                          ? C4::Context->userenv->{branch}
2015                          : "");
2016     my $query = "
2017        SELECT count(borrowernumber) as n,borrowernumber
2018        FROM old_issues
2019        WHERE returndate < ?
2020          AND borrowernumber IS NOT NULL
2021     ";
2022     my @query_params;
2023     push @query_params, $date;
2024     if ($filterbranch){
2025         $query.="   AND branchcode = ?";
2026         push @query_params, $filterbranch;
2027     }
2028     $query.=" GROUP BY borrowernumber ";
2029     warn $query if $debug;
2030     my $sth = $dbh->prepare($query);
2031     $sth->execute(@query_params);
2032     my @results;
2033
2034     while ( my $data = $sth->fetchrow_hashref ) {
2035         push @results, $data;
2036     }
2037     return \@results;
2038 }
2039
2040 =head2 GetBorrowersNamesAndLatestIssue
2041
2042 $results = &GetBorrowersNamesAndLatestIssueList(@borrowernumbers)
2043
2044 this function get borrowers Names and surnames and Issue information.
2045
2046 I<@borrowernumbers> is an array which all elements are borrowernumbers.
2047 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2048
2049 =cut
2050
2051 sub GetBorrowersNamesAndLatestIssue {
2052     my $dbh  = C4::Context->dbh;
2053     my @borrowernumbers=@_;
2054     my $query = "
2055        SELECT surname,lastname, phone, email,max(timestamp)
2056        FROM borrowers
2057          LEFT JOIN issues ON borrowers.borrowernumber=issues.borrowernumber
2058        GROUP BY borrowernumber
2059    ";
2060     my $sth = $dbh->prepare($query);
2061     $sth->execute;
2062     my $results = $sth->fetchall_arrayref({});
2063     return $results;
2064 }
2065
2066 =head2 DebarMember
2067
2068 =over 4
2069
2070 my $success = DebarMember( $borrowernumber );
2071
2072 marks a Member as debarred, and therefore unable to checkout any more
2073 items.
2074
2075 return :
2076 true on success, false on failure
2077
2078 =back
2079
2080 =cut
2081
2082 sub DebarMember {
2083     my $borrowernumber = shift;
2084
2085     return unless defined $borrowernumber;
2086     return unless $borrowernumber =~ /^\d+$/;
2087
2088     return ModMember( borrowernumber => $borrowernumber,
2089                       debarred       => 1 );
2090
2091 }
2092
2093 END { }    # module clean-up code here (global destructor)
2094
2095 1;
2096
2097 __END__
2098
2099 =head1 AUTHOR
2100
2101 Koha Team
2102
2103 =cut