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