C4/Members.pm

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