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