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