C4/Members.pm

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