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