koha-dev.rot13.org Git - koha_fer/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 += $data->{'amountoutstanding'};
1184     }
1185     $sth->finish;
1186     return ( $total, \@acctlines,$numlines);
1187 }
1188
1189 =head2 GetBorNotifyAcctRecord
1190
1191   ($count, $acctlines, $total) = &GetBorNotifyAcctRecord($params,$notifyid);
1192
1193 Looks up accounting data for the patron with the given borrowernumber per file number.
1194
1195 (FIXME - I'm not at all sure what this is about.)
1196
1197 C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a
1198 reference-to-array, where each element is a reference-to-hash; the
1199 keys are the fields of the C<accountlines> table in the Koha database.
1200 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1201 total amount outstanding for all of the account lines.
1202
1203 =cut
1204
1205 sub GetBorNotifyAcctRecord {
1206     my ( $borrowernumber, $notifyid ) = @_;
1207     my $dbh = C4::Context->dbh;
1208     my @acctlines;
1209     my $numlines = 0;
1210     my $sth = $dbh->prepare(
1211             "SELECT *
1212                 FROM accountlines
1213                 WHERE borrowernumber=?
1214                     AND notify_id=?
1215                     AND amountoutstanding != '0'
1216                 ORDER BY notify_id,accounttype
1217                 ");
1218 #                    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')
1219
1220     $sth->execute( $borrowernumber, $notifyid );
1221     my $total = 0;
1222     while ( my $data = $sth->fetchrow_hashref ) {
1223         $acctlines[$numlines] = $data;
1224         $numlines++;
1225         $total += $data->{'amountoutstanding'};
1226     }
1227     $sth->finish;
1228     return ( $total, \@acctlines, $numlines );
1229 }
1230
1231 =head2 checkuniquemember (OUEST-PROVENCE)
1232
1233   ($result,$categorycode)  = &checkuniquemember($collectivity,$surname,$firstname,$dateofbirth);
1234
1235 Checks that a member exists or not in the database.
1236
1237 C<&result> is nonzero (=exist) or 0 (=does not exist)
1238 C<&categorycode> is from categorycode table
1239 C<&collectivity> is 1 (= we add a collectivity) or 0 (= we add a physical member)
1240 C<&surname> is the surname
1241 C<&firstname> is the firstname (only if collectivity=0)
1242 C<&dateofbirth> is the date of birth in ISO format (only if collectivity=0)
1243
1244 =cut
1245
1246 # FIXME: This function is not legitimate.  Multiple patrons might have the same first/last name and birthdate.
1247 # This is especially true since first name is not even a required field.
1248
1249 sub checkuniquemember {
1250     my ( $collectivity, $surname, $firstname, $dateofbirth ) = @_;
1251     my $dbh = C4::Context->dbh;
1252     my $request = ($collectivity) ?
1253         "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? " :
1254             ($dateofbirth) ?
1255             "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=?  and dateofbirth=?" :
1256             "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=?";
1257     my $sth = $dbh->prepare($request);
1258     if ($collectivity) {
1259         $sth->execute( uc($surname) );
1260     } elsif($dateofbirth){
1261         $sth->execute( uc($surname), ucfirst($firstname), $dateofbirth );
1262     }else{
1263         $sth->execute( uc($surname), ucfirst($firstname));
1264     }
1265     my @data = $sth->fetchrow;
1266     $sth->finish;
1267     ( $data[0] ) and return $data[0], $data[1];
1268     return 0;
1269 }
1270
1271 sub checkcardnumber {
1272     my ($cardnumber,$borrowernumber) = @_;
1273     my $dbh = C4::Context->dbh;
1274     my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
1275     $query .= " AND borrowernumber <> ?" if ($borrowernumber);
1276   my $sth = $dbh->prepare($query);
1277   if ($borrowernumber) {
1278    $sth->execute($cardnumber,$borrowernumber);
1279   } else {
1280      $sth->execute($cardnumber);
1281   }
1282     if (my $data= $sth->fetchrow_hashref()){
1283         return 1;
1284     }
1285     else {
1286         return 0;
1287     }
1288     $sth->finish();
1289 }
1290
1291
1292 =head2 getzipnamecity (OUEST-PROVENCE)
1293
1294 take all info from table city for the fields city and  zip
1295 check for the name and the zip code of the city selected
1296
1297 =cut
1298
1299 sub getzipnamecity {
1300     my ($cityid) = @_;
1301     my $dbh      = C4::Context->dbh;
1302     my $sth      =
1303       $dbh->prepare(
1304         "select city_name,city_zipcode from cities where cityid=? ");
1305     $sth->execute($cityid);
1306     my @data = $sth->fetchrow;
1307     return $data[0], $data[1];
1308 }
1309
1310
1311 =head2 getdcity (OUEST-PROVENCE)
1312
1313 recover cityid  with city_name condition
1314
1315 =cut
1316
1317 sub getidcity {
1318     my ($city_name) = @_;
1319     my $dbh = C4::Context->dbh;
1320     my $sth = $dbh->prepare("select cityid from cities where city_name=? ");
1321     $sth->execute($city_name);
1322     my $data = $sth->fetchrow;
1323     return $data;
1324 }
1325
1326
1327 =head2 GetExpiryDate
1328
1329   $expirydate = GetExpiryDate($categorycode, $dateenrolled);
1330
1331 Calculate expiry date given a categorycode and starting date.  Date argument must be in ISO format.
1332 Return date is also in ISO format.
1333
1334 =cut
1335
1336 sub GetExpiryDate {
1337     my ( $categorycode, $dateenrolled ) = @_;
1338     my $enrolmentperiod = 12;   # reasonable default
1339     if ($categorycode) {
1340         my $dbh = C4::Context->dbh;
1341         my $sth = $dbh->prepare("select enrolmentperiod from categories where categorycode=?");
1342         $sth->execute($categorycode);
1343         $enrolmentperiod = $sth->fetchrow;
1344     }
1345     # die "GetExpiryDate: for enrollmentperiod $enrolmentperiod (category '$categorycode') starting $dateenrolled.\n";
1346     my @date = split /-/,$dateenrolled;
1347     return sprintf("%04d-%02d-%02d", Add_Delta_YM(@date,0,$enrolmentperiod));
1348 }
1349
1350 =head2 checkuserpassword (OUEST-PROVENCE)
1351
1352 check for the password and login are not used
1353 return the number of record
1354 0=> NOT USED 1=> USED
1355
1356 =cut
1357
1358 sub checkuserpassword {
1359     my ( $borrowernumber, $userid, $password ) = @_;
1360     $password = md5_base64($password);
1361     my $dbh = C4::Context->dbh;
1362     my $sth =
1363       $dbh->prepare(
1364 "Select count(*) from borrowers where borrowernumber !=? and userid =? and password=? "
1365       );
1366     $sth->execute( $borrowernumber, $userid, $password );
1367     my $number_rows = $sth->fetchrow;
1368     return $number_rows;
1369
1370 }
1371
1372 =head2 GetborCatFromCatType
1373
1374   ($codes_arrayref, $labels_hashref) = &GetborCatFromCatType();
1375
1376 Looks up the different types of borrowers in the database. Returns two
1377 elements: a reference-to-array, which lists the borrower category
1378 codes, and a reference-to-hash, which maps the borrower category codes
1379 to category descriptions.
1380
1381 =cut
1382
1383 #'
1384 sub GetborCatFromCatType {
1385     my ( $category_type, $action ) = @_;
1386         # FIXME - This API  seems both limited and dangerous.
1387     my $dbh     = C4::Context->dbh;
1388     my $request = qq|   SELECT categorycode,description
1389             FROM categories
1390             $action
1391             ORDER BY categorycode|;
1392     my $sth = $dbh->prepare($request);
1393         if ($action) {
1394         $sth->execute($category_type);
1395     }
1396     else {
1397         $sth->execute();
1398     }
1399
1400     my %labels;
1401     my @codes;
1402
1403     while ( my $data = $sth->fetchrow_hashref ) {
1404         push @codes, $data->{'categorycode'};
1405         $labels{ $data->{'categorycode'} } = $data->{'description'};
1406     }
1407     $sth->finish;
1408     return ( \@codes, \%labels );
1409 }
1410
1411 =head2 GetBorrowercategory
1412
1413   $hashref = &GetBorrowercategory($categorycode);
1414
1415 Given the borrower's category code, the function returns the corresponding
1416 data hashref for a comprehensive information display.
1417
1418   $arrayref_hashref = &GetBorrowercategory;
1419 If no category code provided, the function returns all the categories.
1420
1421 =cut
1422
1423 sub GetBorrowercategory {
1424     my ($catcode) = @_;
1425     my $dbh       = C4::Context->dbh;
1426     if ($catcode){
1427         my $sth       =
1428         $dbh->prepare(
1429     "SELECT description,dateofbirthrequired,upperagelimit,category_type
1430     FROM categories
1431     WHERE categorycode = ?"
1432         );
1433         $sth->execute($catcode);
1434         my $data =
1435         $sth->fetchrow_hashref;
1436         $sth->finish();
1437         return $data;
1438     }
1439     return;
1440 }    # sub getborrowercategory
1441
1442 =head2 GetBorrowercategoryList
1443
1444   $arrayref_hashref = &GetBorrowercategoryList;
1445 If no category code provided, the function returns all the categories.
1446
1447 =cut
1448
1449 sub GetBorrowercategoryList {
1450     my $dbh       = C4::Context->dbh;
1451     my $sth       =
1452     $dbh->prepare(
1453     "SELECT *
1454     FROM categories
1455     ORDER BY description"
1456         );
1457     $sth->execute;
1458     my $data =
1459     $sth->fetchall_arrayref({});
1460     $sth->finish();
1461     return $data;
1462 }    # sub getborrowercategory
1463
1464 =head2 ethnicitycategories
1465
1466   ($codes_arrayref, $labels_hashref) = &ethnicitycategories();
1467
1468 Looks up the different ethnic types in the database. Returns two
1469 elements: a reference-to-array, which lists the ethnicity codes, and a
1470 reference-to-hash, which maps the ethnicity codes to ethnicity
1471 descriptions.
1472
1473 =cut
1474
1475 #'
1476
1477 sub ethnicitycategories {
1478     my $dbh = C4::Context->dbh;
1479     my $sth = $dbh->prepare("Select code,name from ethnicity order by name");
1480     $sth->execute;
1481     my %labels;
1482     my @codes;
1483     while ( my $data = $sth->fetchrow_hashref ) {
1484         push @codes, $data->{'code'};
1485         $labels{ $data->{'code'} } = $data->{'name'};
1486     }
1487     $sth->finish;
1488     return ( \@codes, \%labels );
1489 }
1490
1491 =head2 fixEthnicity
1492
1493   $ethn_name = &fixEthnicity($ethn_code);
1494
1495 Takes an ethnicity code (e.g., "european" or "pi") and returns the
1496 corresponding descriptive name from the C<ethnicity> table in the
1497 Koha database ("European" or "Pacific Islander").
1498
1499 =cut
1500
1501 #'
1502
1503 sub fixEthnicity {
1504     my $ethnicity = shift;
1505     return unless $ethnicity;
1506     my $dbh       = C4::Context->dbh;
1507     my $sth       = $dbh->prepare("Select name from ethnicity where code = ?");
1508     $sth->execute($ethnicity);
1509     my $data = $sth->fetchrow_hashref;
1510     $sth->finish;
1511     return $data->{'name'};
1512 }    # sub fixEthnicity
1513
1514 =head2 GetAge
1515
1516   $dateofbirth,$date = &GetAge($date);
1517
1518 this function return the borrowers age with the value of dateofbirth
1519
1520 =cut
1521
1522 #'
1523 sub GetAge{
1524     my ( $date, $date_ref ) = @_;
1525
1526     if ( not defined $date_ref ) {
1527         $date_ref = sprintf( '%04d-%02d-%02d', Today() );
1528     }
1529
1530     my ( $year1, $month1, $day1 ) = split /-/, $date;
1531     my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
1532
1533     my $age = $year2 - $year1;
1534     if ( $month1 . $day1 > $month2 . $day2 ) {
1535         $age--;
1536     }
1537
1538     return $age;
1539 }    # sub get_age
1540
1541 =head2 get_institutions
1542   $insitutions = get_institutions();
1543
1544 Just returns a list of all the borrowers of type I, borrownumber and name
1545
1546 =cut
1547
1548 #'
1549 sub get_institutions {
1550     my $dbh = C4::Context->dbh();
1551     my $sth =
1552       $dbh->prepare(
1553 "SELECT borrowernumber,surname FROM borrowers WHERE categorycode=? ORDER BY surname"
1554       );
1555     $sth->execute('I');
1556     my %orgs;
1557     while ( my $data = $sth->fetchrow_hashref() ) {
1558         $orgs{ $data->{'borrowernumber'} } = $data;
1559     }
1560     $sth->finish();
1561     return ( \%orgs );
1562
1563 }    # sub get_institutions
1564
1565 =head2 add_member_orgs
1566
1567   add_member_orgs($borrowernumber,$borrowernumbers);
1568
1569 Takes a borrowernumber and a list of other borrowernumbers and inserts them into the borrowers_to_borrowers table
1570
1571 =cut
1572
1573 #'
1574 sub add_member_orgs {
1575     my ( $borrowernumber, $otherborrowers ) = @_;
1576     my $dbh   = C4::Context->dbh();
1577     my $query =
1578       "INSERT INTO borrowers_to_borrowers (borrower1,borrower2) VALUES (?,?)";
1579     my $sth = $dbh->prepare($query);
1580     foreach my $otherborrowernumber (@$otherborrowers) {
1581         $sth->execute( $borrowernumber, $otherborrowernumber );
1582     }
1583     $sth->finish();
1584
1585 }    # sub add_member_orgs
1586
1587 =head2 GetCities (OUEST-PROVENCE)
1588
1589   ($id_cityarrayref, $city_hashref) = &GetCities();
1590
1591 Looks up the different city and zip in the database. Returns two
1592 elements: a reference-to-array, which lists the zip city
1593 codes, and a reference-to-hash, which maps the name of the city.
1594 WHERE =>OUEST PROVENCE OR EXTERIEUR
1595
1596 =cut
1597
1598 sub GetCities {
1599
1600     #my ($type_city) = @_;
1601     my $dbh   = C4::Context->dbh;
1602     my $query = qq|SELECT cityid,city_zipcode,city_name
1603         FROM cities
1604         ORDER BY city_name|;
1605     my $sth = $dbh->prepare($query);
1606
1607     #$sth->execute($type_city);
1608     $sth->execute();
1609     my %city;
1610     my @id;
1611     #    insert empty value to create a empty choice in cgi popup
1612     push @id, " ";
1613     $city{""} = "";
1614     while ( my $data = $sth->fetchrow_hashref ) {
1615         push @id, $data->{'city_zipcode'}."|".$data->{'city_name'};
1616         $city{ $data->{'city_zipcode'}."|".$data->{'city_name'} } = $data->{'city_name'};
1617     }
1618
1619 #test to know if the table contain some records if no the function return nothing
1620     my $id = @id;
1621     $sth->finish;
1622     if ( $id == 1 ) {
1623         # all we have is the one blank row
1624         return ();
1625     }
1626     else {
1627         unshift( @id, "" );
1628         return ( \@id, \%city );
1629     }
1630 }
1631
1632 =head2 GetSortDetails (OUEST-PROVENCE)
1633
1634   ($lib) = &GetSortDetails($category,$sortvalue);
1635
1636 Returns the authorized value  details
1637 C<&$lib>return value of authorized value details
1638 C<&$sortvalue>this is the value of authorized value
1639 C<&$category>this is the value of authorized value category
1640
1641 =cut
1642
1643 sub GetSortDetails {
1644     my ( $category, $sortvalue ) = @_;
1645     my $dbh   = C4::Context->dbh;
1646     my $query = qq|SELECT lib
1647         FROM authorised_values
1648         WHERE category=?
1649         AND authorised_value=? |;
1650     my $sth = $dbh->prepare($query);
1651     $sth->execute( $category, $sortvalue );
1652     my $lib = $sth->fetchrow;
1653     return ($lib) if ($lib);
1654     return ($sortvalue) unless ($lib);
1655 }
1656
1657 =head2 DeleteBorrower
1658
1659   () = &DeleteBorrower($member);
1660
1661 delete all data fo borrowers and add record to deletedborrowers table
1662 C<&$member>this is the borrowernumber
1663
1664 =cut
1665
1666 sub MoveMemberToDeleted {
1667     my ($member) = @_;
1668     my $dbh = C4::Context->dbh;
1669     my $query;
1670     $query = qq|SELECT *
1671           FROM borrowers
1672           WHERE borrowernumber=?|;
1673     my $sth = $dbh->prepare($query);
1674     $sth->execute($member);
1675     my @data = $sth->fetchrow_array;
1676     $sth->finish;
1677     $sth =
1678       $dbh->prepare( "INSERT INTO deletedborrowers VALUES ("
1679           . ( "?," x ( scalar(@data) - 1 ) )
1680           . "?)" );
1681     $sth->execute(@data);
1682     $sth->finish;
1683 }
1684
1685 =head2 DelMember
1686
1687 DelMember($borrowernumber);
1688
1689 This function remove directly a borrower whitout writing it on deleteborrower.
1690 + Deletes reserves for the borrower
1691
1692 =cut
1693
1694 sub DelMember {
1695     my $dbh            = C4::Context->dbh;
1696     my $borrowernumber = shift;
1697     #warn "in delmember with $borrowernumber";
1698     return unless $borrowernumber;    # borrowernumber is mandatory.
1699
1700     my $query = qq|DELETE
1701           FROM  reserves
1702           WHERE borrowernumber=?|;
1703     my $sth = $dbh->prepare($query);
1704     $sth->execute($borrowernumber);
1705     $sth->finish;
1706     $query = "
1707        DELETE
1708        FROM borrowers
1709        WHERE borrowernumber = ?
1710    ";
1711     $sth = $dbh->prepare($query);
1712     $sth->execute($borrowernumber);
1713     $sth->finish;
1714     logaction("MEMBERS", "DELETE", $borrowernumber, "") if C4::Context->preference("BorrowersLog");
1715     return $sth->rows;
1716 }
1717
1718 =head2 ExtendMemberSubscriptionTo (OUEST-PROVENCE)
1719
1720     $date = ExtendMemberSubscriptionTo($borrowerid, $date);
1721
1722 Extending the subscription to a given date or to the expiry date calculated on ISO date.
1723 Returns ISO date.
1724
1725 =cut
1726
1727 sub ExtendMemberSubscriptionTo {
1728     my ( $borrowerid,$date) = @_;
1729     my $dbh = C4::Context->dbh;
1730     my $borrower = GetMember($borrowerid,'borrowernumber');
1731     unless ($date){
1732       $date=POSIX::strftime("%Y-%m-%d",localtime());
1733       my $borrower = GetMember($borrowerid,'borrowernumber');
1734       $date = GetExpiryDate( $borrower->{'categorycode'}, $date );
1735     }
1736     my $sth = $dbh->do(<<EOF);
1737 UPDATE borrowers
1738 SET  dateexpiry='$date'
1739 WHERE borrowernumber='$borrowerid'
1740 EOF
1741     # add enrolmentfee if needed
1742     $sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
1743     $sth->execute($borrower->{'categorycode'});
1744     my ($enrolmentfee) = $sth->fetchrow;
1745     if ($enrolmentfee) {
1746         # insert fee in patron debts
1747         manualinvoice($borrower->{'borrowernumber'}, '', '', 'A', $enrolmentfee);
1748     }
1749     return $date if ($sth);
1750     return 0;
1751 }
1752
1753 =head2 GetRoadTypes (OUEST-PROVENCE)
1754
1755   ($idroadtypearrayref, $roadttype_hashref) = &GetRoadTypes();
1756
1757 Looks up the different road type . Returns two
1758 elements: a reference-to-array, which lists the id_roadtype
1759 codes, and a reference-to-hash, which maps the road type of the road .
1760
1761 =cut
1762
1763 sub GetRoadTypes {
1764     my $dbh   = C4::Context->dbh;
1765     my $query = qq|
1766 SELECT roadtypeid,road_type
1767 FROM roadtype
1768 ORDER BY road_type|;
1769     my $sth = $dbh->prepare($query);
1770     $sth->execute();
1771     my %roadtype;
1772     my @id;
1773
1774     #    insert empty value to create a empty choice in cgi popup
1775
1776     while ( my $data = $sth->fetchrow_hashref ) {
1777
1778         push @id, $data->{'roadtypeid'};
1779         $roadtype{ $data->{'roadtypeid'} } = $data->{'road_type'};
1780     }
1781
1782 #test to know if the table contain some records if no the function return nothing
1783     my $id = @id;
1784     $sth->finish;
1785     if ( $id eq 0 ) {
1786         return ();
1787     }
1788     else {
1789         unshift( @id, "" );
1790         return ( \@id, \%roadtype );
1791     }
1792 }
1793
1794
1795
1796 =head2 GetTitles (OUEST-PROVENCE)
1797
1798   ($borrowertitle)= &GetTitles();
1799
1800 Looks up the different title . Returns array  with all borrowers title
1801
1802 =cut
1803
1804 sub GetTitles {
1805     my @borrowerTitle = split /,|\|/,C4::Context->preference('BorrowersTitles');
1806     unshift( @borrowerTitle, "" );
1807     my $count=@borrowerTitle;
1808     if ($count == 1){
1809         return ();
1810     }
1811     else {
1812         return ( \@borrowerTitle);
1813     }
1814 }
1815
1816 =head2 GetPatronImage
1817
1818     my ($imagedata, $dberror) = GetPatronImage($cardnumber);
1819
1820 Returns the mimetype and binary image data of the image for the patron with the supplied cardnumber.
1821
1822 =cut
1823
1824 sub GetPatronImage {
1825     my ($cardnumber) = @_;
1826     warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1827     my $dbh = C4::Context->dbh;
1828     my $query = 'SELECT mimetype, imagefile FROM patronimage WHERE cardnumber = ?';
1829     my $sth = $dbh->prepare($query);
1830     $sth->execute($cardnumber);
1831     my $imagedata = $sth->fetchrow_hashref;
1832     my $dberror = $sth->errstr;
1833     warn "Database error!" if $sth->errstr;
1834     $sth->finish;
1835     return $imagedata, $dberror;
1836 }
1837
1838 =head2 PutPatronImage
1839
1840     PutPatronImage($cardnumber, $mimetype, $imgfile);
1841
1842 Stores patron binary image data and mimetype in database.
1843 NOTE: This function is good for updating images as well as inserting new images in the database.
1844
1845 =cut
1846
1847 sub PutPatronImage {
1848     my ($cardnumber, $mimetype, $imgfile) = @_;
1849     warn "Parameters passed in: Cardnumber=$cardnumber, Mimetype=$mimetype, " . ($imgfile ? "Imagefile" : "No Imagefile") if $debug;
1850     my $dbh = C4::Context->dbh;
1851     my $query = "INSERT INTO patronimage (cardnumber, mimetype, imagefile) VALUES (?,?,?) ON DUPLICATE KEY UPDATE imagefile = ?;";
1852     my $sth = $dbh->prepare($query);
1853     $sth->execute($cardnumber,$mimetype,$imgfile,$imgfile);
1854     warn "Error returned inserting $cardnumber.$mimetype." if $sth->errstr;
1855     my $dberror = $sth->errstr;
1856     $sth->finish;
1857     return $dberror;
1858 }
1859
1860 =head2 RmPatronImage
1861
1862     my ($dberror) = RmPatronImage($cardnumber);
1863
1864 Removes the image for the patron with the supplied cardnumber.
1865
1866 =cut
1867
1868 sub RmPatronImage {
1869     my ($cardnumber) = @_;
1870     warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1871     my $dbh = C4::Context->dbh;
1872     my $query = "DELETE FROM patronimage WHERE cardnumber = ?;";
1873     my $sth = $dbh->prepare($query);
1874     $sth->execute($cardnumber);
1875     my $dberror = $sth->errstr;
1876     warn "Database error!" if $sth->errstr;
1877     $sth->finish;
1878     return $dberror;
1879 }
1880
1881 =head2 GetRoadTypeDetails (OUEST-PROVENCE)
1882
1883   ($roadtype) = &GetRoadTypeDetails($roadtypeid);
1884
1885 Returns the description of roadtype
1886 C<&$roadtype>return description of road type
1887 C<&$roadtypeid>this is the value of roadtype s
1888
1889 =cut
1890
1891 sub GetRoadTypeDetails {
1892     my ($roadtypeid) = @_;
1893     my $dbh          = C4::Context->dbh;
1894     my $query        = qq|
1895 SELECT road_type
1896 FROM roadtype
1897 WHERE roadtypeid=?|;
1898     my $sth = $dbh->prepare($query);
1899     $sth->execute($roadtypeid);
1900     my $roadtype = $sth->fetchrow;
1901     return ($roadtype);
1902 }
1903
1904 =head2 GetBorrowersWhoHaveNotBorrowedSince
1905
1906 &GetBorrowersWhoHaveNotBorrowedSince($date)
1907
1908 this function get all borrowers who haven't borrowed since the date given on input arg.
1909
1910 =cut
1911
1912 sub GetBorrowersWhoHaveNotBorrowedSince {
1913 ### 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.
1914
1915                 my $filterdate = shift||POSIX::strftime("%Y-%m-%d",localtime());
1916     my $filterbranch = shift ||
1917                         ((C4::Context->preference('IndependantBranches')
1918                              && C4::Context->userenv
1919                              && C4::Context->userenv->{flags}!=1
1920                              && C4::Context->userenv->{branch})
1921                          ? C4::Context->userenv->{branch}
1922                          : "");
1923     my $dbh   = C4::Context->dbh;
1924     my $query = "
1925         SELECT borrowers.borrowernumber,max(issues.timestamp) as latestissue
1926         FROM   borrowers
1927         JOIN   categories USING (categorycode)
1928         LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
1929         WHERE  category_type <> 'S'
1930    ";
1931     my @query_params;
1932     if ($filterbranch && $filterbranch ne ""){
1933         $query.=" AND borrowers.branchcode= ?";
1934         push @query_params,$filterbranch;
1935     }
1936     $query.=" GROUP BY borrowers.borrowernumber";
1937     if ($filterdate){
1938         $query.=" HAVING latestissue <? OR latestissue IS NULL";
1939         push @query_params,$filterdate;
1940     }
1941     warn $query if $debug;
1942     my $sth = $dbh->prepare($query);
1943     if (scalar(@query_params)>0){
1944         $sth->execute(@query_params);
1945     }
1946     else {
1947         $sth->execute;
1948     }
1949
1950     my @results;
1951     while ( my $data = $sth->fetchrow_hashref ) {
1952         push @results, $data;
1953     }
1954     return \@results;
1955 }
1956
1957 =head2 GetBorrowersWhoHaveNeverBorrowed
1958
1959 $results = &GetBorrowersWhoHaveNeverBorrowed
1960
1961 this function get all borrowers who have never borrowed.
1962
1963 I<$result> is a ref to an array which all elements are a hasref.
1964
1965 =cut
1966
1967 sub GetBorrowersWhoHaveNeverBorrowed {
1968     my $filterbranch = shift ||
1969                         ((C4::Context->preference('IndependantBranches')
1970                              && C4::Context->userenv
1971                              && C4::Context->userenv->{flags}!=1
1972                              && C4::Context->userenv->{branch})
1973                          ? C4::Context->userenv->{branch}
1974                          : "");
1975     my $dbh   = C4::Context->dbh;
1976     my $query = "
1977         SELECT borrowers.borrowernumber,max(timestamp) as latestissue
1978         FROM   borrowers
1979           LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
1980         WHERE issues.borrowernumber IS NULL
1981    ";
1982     my @query_params;
1983     if ($filterbranch && $filterbranch ne ""){
1984         $query.=" AND borrowers.branchcode= ?";
1985         push @query_params,$filterbranch;
1986     }
1987     warn $query if $debug;
1988
1989     my $sth = $dbh->prepare($query);
1990     if (scalar(@query_params)>0){
1991         $sth->execute(@query_params);
1992     }
1993     else {
1994         $sth->execute;
1995     }
1996
1997     my @results;
1998     while ( my $data = $sth->fetchrow_hashref ) {
1999         push @results, $data;
2000     }
2001     return \@results;
2002 }
2003
2004 =head2 GetBorrowersWithIssuesHistoryOlderThan
2005
2006 $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
2007
2008 this function get all borrowers who has an issue history older than I<$date> given on input arg.
2009
2010 I<$result> is a ref to an array which all elements are a hashref.
2011 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2012
2013 =cut
2014
2015 sub GetBorrowersWithIssuesHistoryOlderThan {
2016     my $dbh  = C4::Context->dbh;
2017     my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
2018     my $filterbranch = shift ||
2019                         ((C4::Context->preference('IndependantBranches')
2020                              && C4::Context->userenv
2021                              && C4::Context->userenv->{flags}!=1
2022                              && C4::Context->userenv->{branch})
2023                          ? C4::Context->userenv->{branch}
2024                          : "");
2025     my $query = "
2026        SELECT count(borrowernumber) as n,borrowernumber
2027        FROM old_issues
2028        WHERE returndate < ?
2029          AND borrowernumber IS NOT NULL
2030     ";
2031     my @query_params;
2032     push @query_params, $date;
2033     if ($filterbranch){
2034         $query.="   AND branchcode = ?";
2035         push @query_params, $filterbranch;
2036     }
2037     $query.=" GROUP BY borrowernumber ";
2038     warn $query if $debug;
2039     my $sth = $dbh->prepare($query);
2040     $sth->execute(@query_params);
2041     my @results;
2042
2043     while ( my $data = $sth->fetchrow_hashref ) {
2044         push @results, $data;
2045     }
2046     return \@results;
2047 }
2048
2049 =head2 GetBorrowersNamesAndLatestIssue
2050
2051 $results = &GetBorrowersNamesAndLatestIssueList(@borrowernumbers)
2052
2053 this function get borrowers Names and surnames and Issue information.
2054
2055 I<@borrowernumbers> is an array which all elements are borrowernumbers.
2056 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2057
2058 =cut
2059
2060 sub GetBorrowersNamesAndLatestIssue {
2061     my $dbh  = C4::Context->dbh;
2062     my @borrowernumbers=@_;
2063     my $query = "
2064        SELECT surname,lastname, phone, email,max(timestamp)
2065        FROM borrowers
2066          LEFT JOIN issues ON borrowers.borrowernumber=issues.borrowernumber
2067        GROUP BY borrowernumber
2068    ";
2069     my $sth = $dbh->prepare($query);
2070     $sth->execute;
2071     my $results = $sth->fetchall_arrayref({});
2072     return $results;
2073 }
2074
2075 =head2 DebarMember
2076
2077 =over 4
2078
2079 my $success = DebarMember( $borrowernumber );
2080
2081 marks a Member as debarred, and therefore unable to checkout any more
2082 items.
2083
2084 return :
2085 true on success, false on failure
2086
2087 =back
2088
2089 =cut
2090
2091 sub DebarMember {
2092     my $borrowernumber = shift;
2093
2094     return unless defined $borrowernumber;
2095     return unless $borrowernumber =~ /^\d+$/;
2096
2097     return ModMember( borrowernumber => $borrowernumber,
2098                       debarred       => 1 );
2099
2100 }
2101
2102 END { }    # module clean-up code here (global destructor)
2103
2104 1;
2105
2106 __END__
2107
2108 =head1 AUTHOR
2109
2110 Koha Team
2111
2112 =cut