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