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