koha-dev.rot13.org Git - srvgit/blob - C4/Members.pm

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