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