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