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