C4/Members.pm

   1 # -*- tab-width: 8 -*-
   2
   3 package C4::Members;
   4
   5 # Copyright 2000-2003 Katipo Communications
   6 #
   7 # This file is part of Koha.
   8 #
   9 # Koha is free software; you can redistribute it and/or modify it under the
  10 # terms of the GNU General Public License as published by the Free Software
  11 # Foundation; either version 2 of the License, or (at your option) any later
  12 # version.
  13 #
  14 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  15 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  16 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU General Public License along with
  19 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  20 # Suite 330, Boston, MA  02111-1307 USA
  21
  22 # $Id$
  23
  24 use strict;
  25 require Exporter;
  26 use C4::Context;
  27 use Date::Manip;
  28 use C4::Date;
  29 use Digest::MD5 qw(md5_base64);
  30
  31 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
  32
  33 $VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); };
  34
  35 =head1 NAME
  36
  37 C4::Members - Perl Module containing convenience functions for member handling
  38
  39 =head1 SYNOPSIS
  40
  41 use C4::Members;
  42
  43 =head1 DESCRIPTION
  44
  45 This module contains routines for adding, modifying and deleting members/patrons/borrowers
  46
  47 =head1 FUNCTIONS
  48
  49 =over 2
  50
  51 =cut
  52
  53 #'
  54
  55 @ISA    = qw(Exporter);
  56 @EXPORT = qw();
  57
  58 @EXPORT = qw(
  59   &BornameSearch &getmember &borrdata &borrdata2 &fixup_cardnumber &findguarantees &findguarantor &GuarantornameSearch &NewBorrowerNumber &modmember &newmember &changepassword &borrissues &allissues
  60   &checkuniquemember &getzipnamecity &getidcity &getguarantordata &getcategorytype
  61   &calcexpirydate &checkuserpassword
  62   &getboracctrecord
  63   &borrowercategories &getborrowercategory
  64   &fixEthnicity
  65   &ethnicitycategories get_institutions add_member_orgs
  66 );
  67
  68 =item BornameSearch
  69
  70   ($count, $borrowers) = &BornameSearch($env, $searchstring, $type);
  71
  72 Looks up patrons (borrowers) by name.
  73
  74 C<$env> is ignored.
  75
  76 BUGFIX 499: C<$type> is now used to determine type of search.
  77 if $type is "simple", search is performed on the first letter of the
  78 surname only.
  79
  80 C<$searchstring> is a space-separated list of search terms. Each term
  81 must match the beginning a borrower's surname, first name, or other
  82 name.
  83
  84 C<&BornameSearch> returns a two-element list. C<$borrowers> is a
  85 reference-to-array; each element is a reference-to-hash, whose keys
  86 are the fields of the C<borrowers> table in the Koha database.
  87 C<$count> is the number of elements in C<$borrowers>.
  88
  89 =cut
  90
  91 #'
  92 #used by member enquiries from the intranet
  93 #called by member.pl
  94 sub BornameSearch {
  95     my ( $env, $searchstring, $orderby, $type ) = @_;
  96     my $dbh   = C4::Context->dbh;
  97     my $query = "";
  98     my $count;
  99     my @data;
 100     my @bind = ();
 101
 102     if ( $type eq "simple" )    # simple search for one letter only
 103     {
 104         $query =
 105           "Select * from borrowers where surname like ? order by $orderby";
 106         @bind = ("$searchstring%");
 107     }
 108     else    # advanced search looking in surname, firstname and othernames
 109     {
 110         @data  = split( ' ', $searchstring );
 111         $count = @data;
 112         $query = "Select * from borrowers
 113                 where ((surname like ? or surname like ?
 114                 or firstname  like ? or firstname like ?
 115                 or othernames like ? or othernames like ?)
 116                 ";
 117         @bind = (
 118             "$data[0]%", "% $data[0]%", "$data[0]%", "% $data[0]%",
 119             "$data[0]%", "% $data[0]%"
 120         );
 121         for ( my $i = 1 ; $i < $count ; $i++ ) {
 122             $query = $query . " and (" . " surname like ? or surname like ?
 123                         or firstname  like ? or firstname like ?
 124                         or othernames like ? or othernames like ?)";
 125             push( @bind,
 126                 "$data[$i]%",   "% $data[$i]%", "$data[$i]%",
 127                 "% $data[$i]%", "$data[$i]%",   "% $data[$i]%" );
 128
 129             # FIXME - .= <<EOT;
 130         }
 131         $query = $query . ") or cardnumber like ?
 132                 order by $orderby";
 133         push( @bind, $searchstring );
 134
 135         # FIXME - .= <<EOT;
 136     }
 137
 138     my $sth = $dbh->prepare($query);
 139
 140     #   warn "Q $orderby : $query";
 141     $sth->execute(@bind);
 142     my @results;
 143     my $cnt = $sth->rows;
 144     while ( my $data = $sth->fetchrow_hashref ) {
 145         push( @results, $data );
 146     }
 147
 148     #  $sth->execute;
 149     $sth->finish;
 150     return ( $cnt, \@results );
 151 }
 152
 153 =item getmember
 154
 155   $borrower = &getmember($cardnumber, $borrowernumber);
 156
 157 Looks up information about a patron (borrower) by either card number
 158 or borrower number. If $borrowernumber is specified, C<&borrdata>
 159 searches by borrower number; otherwise, it searches by card number.
 160
 161 C<&getmember> returns a reference-to-hash whose keys are the fields of
 162 the C<borrowers> table in the Koha database.
 163
 164 =cut
 165
 166 #'
 167 sub getmember {
 168     my ( $cardnumber, $bornum ) = @_;
 169     $cardnumber = uc $cardnumber;
 170     my $dbh = C4::Context->dbh;
 171     my $sth;
 172     if ( $bornum eq '' ) {
 173         $sth = $dbh->prepare("Select * from borrowers where cardnumber=?");
 174         $sth->execute($cardnumber);
 175     }
 176     else {
 177         $sth = $dbh->prepare("Select * from borrowers where borrowernumber=?");
 178         $sth->execute($bornum);
 179     }
 180     my $data = $sth->fetchrow_hashref;
 181     $sth->finish;
 182     if ($data) {
 183         return ($data);
 184     }
 185     else {    # try with firstname
 186         if ($cardnumber) {
 187             my $sth =
 188               $dbh->prepare("select * from borrowers where firstname=?");
 189             $sth->execute($cardnumber);
 190             my $data = $sth->fetchrow_hashref;
 191             $sth->finish;
 192             return ($data);
 193         }
 194     }
 195     return undef;
 196 }
 197
 198 =item borrdata
 199
 200   $borrower = &borrdata($cardnumber, $borrowernumber);
 201
 202 Looks up information about a patron (borrower) by either card number
 203 or borrower number. If $borrowernumber is specified, C<&borrdata>
 204 searches by borrower number; otherwise, it searches by card number.
 205
 206 C<&borrdata> returns a reference-to-hash whose keys are the fields of
 207 the C<borrowers> table in the Koha database.
 208
 209 =cut
 210
 211 #'
 212 sub borrdata {
 213     my ( $cardnumber, $bornum ) = @_;
 214     $cardnumber = uc $cardnumber;
 215     my $dbh = C4::Context->dbh;
 216     my $sth;
 217     if ( $bornum eq '' ) {
 218         $sth =
 219           $dbh->prepare(
 220 "Select borrowers.*,categories.category_type from borrowers left join categories on borrowers.categorycode=categories.categorycode where cardnumber=?"
 221           );
 222         $sth->execute($cardnumber);
 223     }
 224     else {
 225         $sth =
 226           $dbh->prepare(
 227 "Select borrowers.*,categories.category_type from borrowers left join categories on borrowers.categorycode=categories.categorycode where borrowernumber=?"
 228           );
 229         $sth->execute($bornum);
 230     }
 231     my $data = $sth->fetchrow_hashref;
 232     warn "DATA" . $data->{category_type};
 233     $sth->finish;
 234     if ($data) {
 235         return ($data);
 236     }
 237     else {    # try with firstname
 238         if ($cardnumber) {
 239             my $sth =
 240               $dbh->prepare(
 241 "Select borrowers.*,categories.category_type from borrowers left join categories on borrowers.categorycode=categories.categorycode  where firstname=?"
 242               );
 243             $sth->execute($cardnumber);
 244             my $data = $sth->fetchrow_hashref;
 245             $sth->finish;
 246             return ($data);
 247         }
 248     }
 249     return undef;
 250 }
 251
 252 =item borrdata2
 253
 254   ($borrowed, $due, $fine) = &borrdata2($env, $borrowernumber);
 255
 256 Returns aggregate data about items borrowed by the patron with the
 257 given borrowernumber.
 258
 259 C<$env> is ignored.
 260
 261 C<&borrdata2> returns a three-element array. C<$borrowed> is the
 262 number of books the patron currently has borrowed. C<$due> is the
 263 number of overdue items the patron currently has borrowed. C<$fine> is
 264 the total fine currently due by the borrower.
 265
 266 =cut
 267
 268 #'
 269 sub borrdata2 {
 270     my ( $env, $bornum ) = @_;
 271     my $dbh   = C4::Context->dbh;
 272     my $query = "Select count(*) from issues where borrowernumber='$bornum' and
 273     returndate is NULL";
 274
 275     # print $query;
 276     my $sth = $dbh->prepare($query);
 277     $sth->execute;
 278     my $data = $sth->fetchrow_hashref;
 279     $sth->finish;
 280     $sth = $dbh->prepare(
 281         "Select count(*) from issues where
 282     borrowernumber='$bornum' and date_due < now() and returndate is NULL"
 283     );
 284     $sth->execute;
 285     my $data2 = $sth->fetchrow_hashref;
 286     $sth->finish;
 287     $sth = $dbh->prepare(
 288         "Select sum(amountoutstanding) from accountlines where
 289     borrowernumber='$bornum'"
 290     );
 291     $sth->execute;
 292     my $data3 = $sth->fetchrow_hashref;
 293     $sth->finish;
 294
 295     return ( $data2->{'count(*)'}, $data->{'count(*)'},
 296         $data3->{'sum(amountoutstanding)'} );
 297 }
 298
 299 sub modmember {
 300     my (%data) = @_;
 301     my $dbh = C4::Context->dbh;
 302     $data{'dateofbirth'} = format_date_in_iso( $data{'dateofbirth'} );
 303     $data{'expiry'}      = format_date_in_iso( $data{'expiry'} );
 304
 305     my $query = "UPDATE borrowers SET
 306   title=?,dateexpiry=?,cardnumber=?,sex=?,ethnotes=?,address=?,fax=?,
 307   firstname=?,contactnote=?,dateofbirth=?,contactname=?,emailaddress=?,
 308   streetcity=?,altrelationship=?,othernames=?,phoneday=?,categorycode=?,
 309   city=?,area=?,phone=?,borrowernotes=?,altphone=?,surname=?,initials=?,
 310   physstreet=?,ethnicity=?,gonenoaddress=?,lost=?,debarred=?,textmessaging=?,
 311   branchcode=?,zipcode=?,homezipcode=?,sort1=?,sort2=?
 312   WHERE borrowernumber=?";
 313
 314     my $sth = $dbh->prepare($query);
 315     $sth->execute(
 316         $data{'title'},         $data{'expiry'},
 317         $data{'cardnumber'},    $data{'sex'},
 318         $data{'ehtnotes'},      $data{'address'},
 319         $data{'fax'},           $data{'firstname'},
 320         $data{'contactnote'},   $data{'dateofbirth'},
 321         $data{'contactname'},   $data{'emailaddress'},
 322         $data{'streetcity'},    $data{'altrelationship'},
 323         $data{'othernames'},    $data{'phoneday'},
 324         $data{'categorycode'},  $data{'city'},
 325         $data{'area'},          $data{'phone'},
 326         $data{'borrowernotes'}, $data{'altphone'},
 327         $data{'surname'},       $data{'initials'},
 328         $data{'physstreet'},    $data{'ethnicity'},
 329         $data{'gna'},           $data{'lost'},
 330         $data{'debarred'},      $data{'textmessaging'},
 331         $data{'branchcode'},    $data{'zipcode'},
 332         $data{'homezipcode'},   $data{'sort1'},
 333         $data{'sort2'},         $data{'borrowernumber'}
 334     );
 335     $sth->finish;
 336
 337 # ok if its an adult (type) it may have borrowers that depend on it as a guarantor
 338 # so when we update information for an adult we should check for guarantees and update the relevant part
 339 # of their records, ie addresses and phone numbers
 340     if ( $data{'categorycode'} eq 'A' || $data{'categorycode'} eq 'W' ) {
 341
 342         # is adult check guarantees;
 343         updateguarantees(%data);
 344     }
 345 }
 346
 347 sub newmember {
 348     my (%data) = @_;
 349     my $dbh = C4::Context->dbh;
 350     $data{'userid'} = '' unless $data{'password'};
 351     $data{'password'} = md5_base64( $data{'password'} ) if $data{'password'};
 352     $data{'dateofbirth'} = format_date_in_iso( $data{'dateofbirth'} );
 353     $data{'dateenrolled'} = format_date_in_iso( $data{'dateenrolled'} );
 354     $data{expiry} = format_date_in_iso( $data{expiry} );
 355     my $query =
 356         "insert into borrowers set cardnumber="
 357       . $dbh->quote( $data{'cardnumber'} )
 358       . ",surname="
 359       . $dbh->quote( $data{'surname'} )
 360       . ",firstname="
 361       . $dbh->quote( $data{'firstname'} )
 362       . ",title="
 363       . $dbh->quote( $data{'title'} )
 364       . ",othernames="
 365       . $dbh->quote( $data{'othernames'} )
 366       . ",initials="
 367       . $dbh->quote( $data{'initials'} )
 368       . ",streetnumber="
 369       . $dbh->quote( $data{'streetnumber'} )
 370       . ",streettype="
 371       . $dbh->quote( $data{'streettype'} )
 372       . ",address="
 373       . $dbh->quote( $data{'address'} )
 374       . ",address2="
 375       . $dbh->quote( $data{'address2'} )
 376       . ",zipcode="
 377       . $dbh->quote( $data{'zipcode'} )
 378       . ",city="
 379       . $dbh->quote( $data{'city'} )
 380       . ",phone="
 381       . $dbh->quote( $data{'phone'} )
 382       . ",email="
 383       . $dbh->quote( $data{'email'} )
 384       . ",mobile="
 385       . $dbh->quote( $data{'mobile'} )
 386       . ",phonepro="
 387       . $dbh->quote( $data{'phonepro'} )
 388       . ",opacnote="
 389       . $dbh->quote( $data{'opacnote'} )
 390       . ",guarantorid="
 391       . $dbh->quote( $data{'guarantorid'} )
 392       . ",dateofbirth="
 393       . $dbh->quote( $data{'dateofbirth'} )
 394       . ",branchcode="
 395       . $dbh->quote( $data{'branchcode'} )
 396       . ",categorycode="
 397       . $dbh->quote( $data{'categorycode'} )
 398       . ",dateenrolled="
 399       . $dbh->quote( $data{'dateenrolled'} )
 400       . ",contactname="
 401       . $dbh->quote( $data{'contactname'} )
 402       . ",borrowernotes="
 403       . $dbh->quote( $data{'borrowernotes'} )
 404       . ",dateexpiry="
 405       . $dbh->quote( $data{'dateexpiry'} )
 406       . ",contactnote="
 407       . $dbh->quote( $data{'contactnote'} )
 408       . ",b_address="
 409       . $dbh->quote( $data{'b_address'} )
 410       . ",b_zipcode="
 411       . $dbh->quote( $data{'b_zipcode'} )
 412       . ",b_city="
 413       . $dbh->quote( $data{'b_city'} )
 414       . ",b_phone="
 415       . $dbh->quote( $data{'b_phone'} )
 416       . ",b_email="
 417       . $dbh->quote( $data{'b_email'}, )
 418       . ",password="
 419       . $dbh->quote( $data{'password'} )
 420       . ",userid="
 421       . $dbh->quote( $data{'userid'} )
 422       . ",sort1="
 423       . $dbh->quote( $data{'sort1'} )
 424       . ",sort2="
 425       . $dbh->quote( $data{'sort2'} )
 426       . ",contacttitle="
 427       . $dbh->quote( $data{'contacttitle'} )
 428       . ",emailpro="
 429       . $dbh->quote( $data{'emailpro'} )
 430       . ",contactfirstname="
 431       . $dbh->quote( $data{'contactfirstname'} ) . ",sex="
 432       . $dbh->quote( $data{'sex'} ) . ",fax="
 433       . $dbh->quote( $data{'fax'} )
 434       . ",flags="
 435       . $dbh->quote( $data{'flags'} )
 436       . ",relationship="
 437       . $dbh->quote( $data{'relationship'} );
 438     my $sth = $dbh->prepare($query);
 439     $sth->execute;
 440     $sth->finish;
 441     $data{'borrowerid'} = $dbh->{'mysql_insertid'};
 442     return $data{'borrowerid'};
 443 }
 444
 445 sub changepassword {
 446     my ( $uid, $member, $digest ) = @_;
 447     my $dbh = C4::Context->dbh;
 448
 449 #Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
 450 #Then we need to tell the user and have them create a new one.
 451     my $sth =
 452       $dbh->prepare(
 453         "select * from borrowers where userid=? and borrowernumber != ?");
 454     $sth->execute( $uid, $member );
 455     if ( ( $uid ne '' ) && ( $sth->fetchrow ) ) {
 456         return 0;
 457     }
 458     else {
 459
 460         #Everything is good so we can update the information.
 461         $sth =
 462           $dbh->prepare(
 463             "update borrowers set userid=?, password=? where borrowernumber=?");
 464         $sth->execute( $uid, $digest, $member );
 465         return 1;
 466     }
 467 }
 468
 469 sub getmemberfromuserid {
 470     my ($userid) = @_;
 471     my $dbh      = C4::Context->dbh;
 472     my $sth      = $dbh->prepare("select * from borrowers where userid=?");
 473     $sth->execute($userid);
 474     return $sth->fetchrow_hashref;
 475 }
 476
 477 sub updateguarantees {
 478     my (%data) = @_;
 479     my $dbh = C4::Context->dbh;
 480     my ( $count, $guarantees ) = findguarantees( $data{'borrowernumber'} );
 481     for ( my $i = 0 ; $i < $count ; $i++ ) {
 482
 483         # FIXME
 484         # It looks like the $i is only being returned to handle walking through
 485         # the array, which is probably better done as a foreach loop.
 486         #
 487         my $guaquery =
 488 "update borrowers set streetaddress='$data{'address'}',faxnumber='$data{'faxnumber'}',
 489                 streetcity='$data{'streetcity'}',phoneday='$data{'phoneday'}',city='$data{'city'}',area='$data{'area'}',phone='$data{'phone'}'
 490                 ,streetaddress='$data{'address'}'
 491                 where borrowernumber='$guarantees->[$i]->{'borrowernumber'}'";
 492         my $sth3 = $dbh->prepare($guaquery);
 493         $sth3->execute;
 494         $sth3->finish;
 495     }
 496 }
 497 ################################################################################
 498
 499 =item fixup_cardnumber
 500
 501 Warning: The caller is responsible for locking the members table in write
 502 mode, to avoid database corruption.
 503
 504 =cut
 505
 506 use vars qw( @weightings );
 507 my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
 508
 509 sub fixup_cardnumber ($) {
 510     my ($cardnumber) = @_;
 511     my $autonumber_members = C4::Context->boolean_preference('autoMemberNum');
 512     $autonumber_members = 0 unless defined $autonumber_members;
 513
 514     # Find out whether member numbers should be generated
 515     # automatically. Should be either "1" or something else.
 516     # Defaults to "0", which is interpreted as "no".
 517
 518     #     if ($cardnumber !~ /\S/ && $autonumber_members) {
 519     if ($autonumber_members) {
 520         my $dbh = C4::Context->dbh;
 521         if ( C4::Context->preference('checkdigit') eq 'katipo' ) {
 522
 523             # if checkdigit is selected, calculate katipo-style cardnumber.
 524             # otherwise, just use the max()
 525             # purpose: generate checksum'd member numbers.
 526             # We'll assume we just got the max value of digits 2-8 of member #'s
 527             # from the database and our job is to increment that by one,
 528             # determine the 1st and 9th digits and return the full string.
 529             my $sth =
 530               $dbh->prepare(
 531                 "select max(substring(borrowers.cardnumber,2,7)) from borrowers"
 532               );
 533             $sth->execute;
 534
 535             my $data = $sth->fetchrow_hashref;
 536             $cardnumber = $data->{'max(substring(borrowers.cardnumber,2,7))'};
 537             $sth->finish;
 538             if ( !$cardnumber ) {    # If DB has no values,
 539                 $cardnumber = 1000000;    # start at 1000000
 540             }
 541             else {
 542                 $cardnumber += 1;
 543             }
 544
 545             my $sum = 0;
 546             for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
 547
 548                 # read weightings, left to right, 1 char at a time
 549                 my $temp1 = $weightings[$i];
 550
 551                 # sequence left to right, 1 char at a time
 552                 my $temp2 = substr( $cardnumber, $i, 1 );
 553
 554                 # mult each char 1-7 by its corresponding weighting
 555                 $sum += $temp1 * $temp2;
 556             }
 557
 558             my $rem = ( $sum % 11 );
 559             $rem = 'X' if $rem == 10;
 560
 561             $cardnumber = "V$cardnumber$rem";
 562         }
 563         else {
 564
 565      # MODIFIED BY JF: mysql4.1 allows casting as an integer, which is probably
 566      # better. I'll leave the original in in case it needs to be changed for you
 567             my $sth =
 568               $dbh->prepare(
 569                 "select max(cast(cardnumber as signed)) from borrowers");
 570
 571       #my $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers");
 572
 573             $sth->execute;
 574
 575             my ($result) = $sth->fetchrow;
 576             $sth->finish;
 577             $cardnumber = $result + 1;
 578         }
 579     }
 580     return $cardnumber;
 581 }
 582
 583 sub findguarantees {
 584     my ($bornum) = @_;
 585     my $dbh      = C4::Context->dbh;
 586     my $sth      = $dbh->prepare(
 587         "select cardnumber,borrowernumber from borrowers where
 588   guarantorid=?"
 589     );
 590     $sth->execute($bornum);
 591     my @dat;
 592     my $i = 0;
 593     while ( my $data = $sth->fetchrow_hashref ) {
 594         $dat[$i] = $data;
 595         $i++;
 596     }
 597     $sth->finish;
 598     return ( $i, \@dat );
 599 }
 600
 601 =item findguarantor
 602
 603   $guarantor = &findguarantor($borrower_no);
 604   $guarantor_cardno = $guarantor->{"cardnumber"};
 605   $guarantor_surname = $guarantor->{"surname"};
 606   ...
 607
 608 C<&findguarantor> takes a borrower number (presumably that of a child
 609 patron), finds the guarantor for C<$borrower_no> (the child's parent),
 610 and returns the record for the guarantor.
 611
 612 C<&findguarantor> returns a reference-to-hash. Its keys are the fields
 613 from the C<borrowers> database table;
 614
 615 =cut
 616
 617 #'
 618 sub findguarantor {
 619     my ($bornum) = @_;
 620     my $dbh = C4::Context->dbh;
 621     my $sth = $dbh->prepare("Select * from borrowers where borrowernumber=?");
 622     $sth->execute($bornum);
 623     my $data = $sth->fetchrow_hashref;
 624     $sth->finish;
 625     return ($data);
 626 }
 627
 628 =item GuarantornameSearch
 629
 630   ($count, $borrowers) = &GuarantornameSearch($env, $searchstring, $type);
 631
 632 Looks up guarantor  by name.
 633
 634 C<$env> is ignored.
 635
 636 BUGFIX 499: C<$type> is now used to determine type of search.
 637 if $type is "simple", search is performed on the first letter of the
 638 surname only.
 639
 640 C<$searchstring> is a space-separated list of search terms. Each term
 641 must match the beginning a borrower's surname, first name, or other
 642 name.
 643
 644 C<&GuarantornameSearch> returns a two-element list. C<$borrowers> is a
 645 reference-to-array; each element is a reference-to-hash, whose keys
 646 are the fields of the C<borrowers> table in the Koha database.
 647 C<$count> is the number of elements in C<$borrowers>.
 648
 649 return all info from guarantor =>only category_type A
 650
 651 =cut
 652
 653 #'
 654 #used by member enquiries from the intranet
 655 #called by guarantor_search.pl
 656 sub GuarantornameSearch {
 657     my ( $env, $searchstring, $orderby, $type ) = @_;
 658     my $dbh   = C4::Context->dbh;
 659     my $query = "";
 660     my $count;
 661     my @data;
 662     my @bind = ();
 663
 664     if ( $type eq "simple" )    # simple search for one letter only
 665     {
 666         $query =
 667 "Select * from borrowers,categories  where borrowers.categorycode=categories.categorycode and category_type='A'  and  surname like ? order by $orderby";
 668         @bind = ("$searchstring%");
 669     }
 670     else    # advanced search looking in surname, firstname and othernames
 671     {
 672         @data  = split( ' ', $searchstring );
 673         $count = @data;
 674         $query = "Select * from borrowers,categories
 675                 where ((surname like ? or surname like ?
 676                 or firstname  like ? or firstname like ?
 677                 or othernames like ? or othernames like ?) and borrowers.categorycode=categories.categorycode and category_type='A'
 678                 ";
 679         @bind = (
 680             "$data[0]%", "% $data[0]%", "$data[0]%", "% $data[0]%",
 681             "$data[0]%", "% $data[0]%"
 682         );
 683         for ( my $i = 1 ; $i < $count ; $i++ ) {
 684             $query = $query . " and (" . " surname like ? or surname like ?
 685                         or firstname  like ? or firstname like ?
 686                         or othernames like ? or othernames like ?)";
 687             push( @bind,
 688                 "$data[$i]%",   "% $data[$i]%", "$data[$i]%",
 689                 "% $data[$i]%", "$data[$i]%",   "% $data[$i]%" );
 690
 691             # FIXME - .= <<EOT;
 692         }
 693         $query = $query . ") or cardnumber like ?
 694                 order by $orderby";
 695         push( @bind, $searchstring );
 696
 697         # FIXME - .= <<EOT;
 698     }
 699
 700     my $sth = $dbh->prepare($query);
 701     $sth->execute(@bind);
 702     my @results;
 703     my $cnt = $sth->rows;
 704     while ( my $data = $sth->fetchrow_hashref ) {
 705         push( @results, $data );
 706     }
 707
 708     #  $sth->execute;
 709     $sth->finish;
 710     return ( $cnt, \@results );
 711 }
 712
 713 =item NewBorrowerNumber
 714
 715   $num = &NewBorrowerNumber();
 716
 717 Allocates a new, unused borrower number, and returns it.
 718
 719 =cut
 720
 721 #'
 722 # FIXME - This is identical to C4::Circulation::Borrower::NewBorrowerNumber.
 723 # Pick one and stick with it. Preferably use the other one. This function
 724 # doesn't belong in C4::Search.
 725 sub NewBorrowerNumber {
 726     my $dbh = C4::Context->dbh;
 727     my $sth = $dbh->prepare("Select max(borrowernumber) from borrowers");
 728     $sth->execute;
 729     my $data = $sth->fetchrow_hashref;
 730     $sth->finish;
 731     $data->{'max(borrowernumber)'}++;
 732     return ( $data->{'max(borrowernumber)'} );
 733 }
 734
 735 =head2 borrissues
 736
 737   ($count, $issues) = &borrissues($borrowernumber);
 738
 739 Looks up what the patron with the given borrowernumber has borrowed.
 740
 741 C<&borrissues> returns a two-element array. C<$issues> is a
 742 reference-to-array, where each element is a reference-to-hash; the
 743 keys are the fields from the C<issues>, C<biblio>, and C<items> tables
 744 in the Koha database. C<$count> is the number of elements in
 745 C<$issues>.
 746
 747 =cut
 748
 749 #'
 750 sub borrissues {
 751     my ($bornum) = @_;
 752     my $dbh      = C4::Context->dbh;
 753     my $sth      = $dbh->prepare(
 754         "Select * from issues,biblio,items where borrowernumber=?
 755    and items.itemnumber=issues.itemnumber
 756         and items.biblionumber=biblio.biblionumber
 757         and issues.returndate is NULL order by date_due"
 758     );
 759     $sth->execute($bornum);
 760     my @result;
 761     while ( my $data = $sth->fetchrow_hashref ) {
 762         push @result, $data;
 763     }
 764     $sth->finish;
 765     return ( scalar(@result), \@result );
 766 }
 767
 768 =head2 allissues
 769
 770   ($count, $issues) = &allissues($borrowernumber, $sortkey, $limit);
 771
 772 Looks up what the patron with the given borrowernumber has borrowed,
 773 and sorts the results.
 774
 775 C<$sortkey> is the name of a field on which to sort the results. This
 776 should be the name of a field in the C<issues>, C<biblio>,
 777 C<biblioitems>, or C<items> table in the Koha database.
 778
 779 C<$limit> is the maximum number of results to return.
 780
 781 C<&allissues> returns a two-element array. C<$issues> is a
 782 reference-to-array, where each element is a reference-to-hash; the
 783 keys are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
 784 C<items> tables of the Koha database. C<$count> is the number of
 785 elements in C<$issues>
 786
 787 =cut
 788
 789 #'
 790 sub allissues {
 791     my ( $bornum, $order, $limit ) = @_;
 792
 793     #FIXME: sanity-check order and limit
 794     my $dbh   = C4::Context->dbh;
 795     my $query = "Select * from issues,biblio,items,biblioitems
 796   where borrowernumber=? and
 797   items.biblioitemnumber=biblioitems.biblioitemnumber and
 798   items.itemnumber=issues.itemnumber and
 799   items.biblionumber=biblio.biblionumber order by $order";
 800     if ( $limit != 0 ) {
 801         $query .= " limit $limit";
 802     }
 803
 804     #print $query;
 805     my $sth = $dbh->prepare($query);
 806     $sth->execute($bornum);
 807     my @result;
 808     my $i = 0;
 809     while ( my $data = $sth->fetchrow_hashref ) {
 810         $result[$i] = $data;
 811         $i++;
 812     }
 813     $sth->finish;
 814     return ( $i, \@result );
 815 }
 816
 817 =head2 getboracctrecord
 818
 819   ($count, $acctlines, $total) = &getboracctrecord($env, $borrowernumber);
 820
 821 Looks up accounting data for the patron with the given borrowernumber.
 822
 823 C<$env> is ignored.
 824
 825 (FIXME - I'm not at all sure what this is about.)
 826
 827 C<&getboracctrecord> returns a three-element array. C<$acctlines> is a
 828 reference-to-array, where each element is a reference-to-hash; the
 829 keys are the fields of the C<accountlines> table in the Koha database.
 830 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
 831 total amount outstanding for all of the account lines.
 832
 833 =cut
 834
 835 #'
 836 sub getboracctrecord {
 837     my ( $env, $params ) = @_;
 838     my $dbh = C4::Context->dbh;
 839     my @acctlines;
 840     my $numlines = 0;
 841     my $sth      = $dbh->prepare(
 842         "Select * from accountlines where
 843 borrowernumber=? order by date desc,timestamp desc"
 844     );
 845
 846     #   print $query;
 847     $sth->execute( $params->{'borrowernumber'} );
 848     my $total = 0;
 849     while ( my $data = $sth->fetchrow_hashref ) {
 850
 851         #FIXME before reinstating: insecure?
 852         #      if ($data->{'itemnumber'} ne ''){
 853         #        $query="Select * from items,biblio where items.itemnumber=
 854         #       '$data->{'itemnumber'}' and biblio.biblionumber=items.biblionumber";
 855         #       my $sth2=$dbh->prepare($query);
 856         #       $sth2->execute;
 857         #       my $data2=$sth2->fetchrow_hashref;
 858         #       $sth2->finish;
 859         #       $data=$data2;
 860         #     }
 861         $acctlines[$numlines] = $data;
 862         $numlines++;
 863         $total += $data->{'amountoutstanding'};
 864     }
 865     $sth->finish;
 866     return ( $numlines, \@acctlines, $total );
 867 }
 868
 869 =head2 checkuniquemember (OUEST-PROVENCE)
 870
 871   $result = &checkuniquemember($collectivity,$surname,$categorycode,$firstname,$dateofbirth);
 872
 873 Checks that a member exists or not in the database.
 874
 875 C<&result> is 1 (=exist) or 0 (=does not exist)
 876 C<&collectivity> is 1 (= we add a collectivity) or 0 (= we add a physical member)
 877 C<&surname> is the surname
 878 C<&categorycode> is from categorycode table
 879 C<&firstname> is the firstname (only if collectivity=0)
 880 C<&dateofbirth> is the date of birth (only if collectivity=0)
 881
 882 =cut
 883
 884 sub checkuniquemember {
 885     my ( $collectivity, $surname, $firstname, $dateofbirth ) = @_;
 886     my $dbh = C4::Context->dbh;
 887     my $request;
 888     if ($collectivity) {
 889
 890 #                               $request="select count(*) from borrowers where surname=? and categorycode=?";
 891         $request =
 892           "select borrowernumber,categorycode from borrowers where surname=? ";
 893     }
 894     else {
 895
 896 #                               $request="select count(*) from borrowers where surname=? and categorycode=? and firstname=? and dateofbirth=?";
 897         $request =
 898 "select borrowernumber,categorycode from borrowers where surname=?  and firstname=? and dateofbirth=?";
 899     }
 900     my $sth = $dbh->prepare($request);
 901     if ($collectivity) {
 902         $sth->execute( uc($surname) );
 903     }
 904     else {
 905         $sth->execute( uc($surname), ucfirst($firstname), $dateofbirth );
 906     }
 907     my @data = $sth->fetchrow;
 908     if ( $data[0] ) {
 909         $sth->finish;
 910         return $data[0], $data[1];
 911
 912         #
 913     }
 914     else {
 915         $sth->finish;
 916         return 0;
 917     }
 918 }
 919
 920 =head2 getzipnamecity (OUEST-PROVENCE)
 921
 922 take all info from table city for the fields city and  zip
 923 check for the name and the zip code of the city selected
 924
 925 =cut
 926
 927 sub getzipnamecity {
 928     my ($cityid) = @_;
 929     my $dbh      = C4::Context->dbh;
 930     my $sth      =
 931       $dbh->prepare(
 932         "select city_name,city_zipcode from cities where cityid=? ");
 933     $sth->execute($cityid);
 934     my @data = $sth->fetchrow;
 935     return $data[0], $data[1];
 936 }
 937
 938 =head2 updatechildguarantor (OUEST-PROVENCE)
 939
 940 check for title,firstname,surname,adress,zip code and city  from guarantor to
 941 guarantorchild
 942
 943 =cut
 944
 945 #'
 946
 947 sub getguarantordata {
 948     my ($borrowerid) = @_;
 949     my $dbh          = C4::Context->dbh;
 950     my $sth          =
 951       $dbh->prepare(
 952 "Select title,firstname,surname,streetnumber,address,streettype,address2,zipcode,city,phone,phonepro,mobile,email,emailpro  from borrowers where borrowernumber =? "
 953       );
 954     $sth->execute($borrowerid);
 955     my $guarantor_data = $sth->fetchrow_hashref;
 956     $sth->finish;
 957     return $guarantor_data;
 958 }
 959
 960 =head2 getdcity (OUEST-PROVENCE)
 961 recover cityid  with city_name condition
 962 =cut
 963
 964 sub getidcity {
 965     my ($city_name) = @_;
 966     my $dbh = C4::Context->dbh;
 967     my $sth = $dbh->prepare("select cityid from cities where city_name=? ");
 968     $sth->execute($city_name);
 969     my $data = $sth->fetchrow;
 970     return $data;
 971 }
 972
 973 =head2 getcategorytype (OUEST-PROVENCE)
 974
 975 check for the category_type with categorycode
 976 and return the category_type
 977
 978 =cut
 979
 980 sub getcategorytype {
 981     my ($categorycode) = @_;
 982     my $dbh            = C4::Context->dbh;
 983     my $sth            =
 984       $dbh->prepare(
 985 "Select category_type,description from categories where categorycode=?  "
 986       );
 987     $sth->execute($categorycode);
 988     my ( $category_type, $description ) = $sth->fetchrow;
 989     return $category_type, $description;
 990 }
 991
 992 sub calcexpirydate {
 993     my ( $categorycode, $dateenrolled ) = @_;
 994     my $dbh = C4::Context->dbh;
 995     my $sth =
 996       $dbh->prepare(
 997         "select enrolmentperiod from categories where categorycode=?");
 998     $sth->execute($categorycode);
 999     my ($enrolmentperiod) = $sth->fetchrow;
1000     $enrolmentperiod = 12 unless ($enrolmentperiod);
1001     return format_date_in_iso(
1002         &DateCalc( $dateenrolled, "$enrolmentperiod months" ) );
1003 }
1004
1005 =head2 checkuserpassword (OUEST-PROVENCE)
1006
1007 check for the password and login are not used
1008 return the number of record
1009 0=> NOT USED 1=> USED
1010
1011 =cut
1012
1013 sub checkuserpassword {
1014     my ( $borrowerid, $userid, $password ) = @_;
1015     $password = md5_base64($password);
1016     my $dbh = C4::Context->dbh;
1017     my $sth =
1018       $dbh->prepare(
1019 "Select count(*) from borrowers where borrowernumber !=? and userid =? and password=? "
1020       );
1021     $sth->execute( $borrowerid, $userid, $password );
1022     my $number_rows = $sth->fetchrow;
1023     return $number_rows;
1024
1025 }
1026
1027 =head2 borrowercategories
1028
1029   ($codes_arrayref, $labels_hashref) = &borrowercategories();
1030
1031 Looks up the different types of borrowers in the database. Returns two
1032 elements: a reference-to-array, which lists the borrower category
1033 codes, and a reference-to-hash, which maps the borrower category codes
1034 to category descriptions.
1035
1036 =cut
1037
1038 #'
1039 sub borrowercategories {
1040     my ( $category_type, $action ) = @_;
1041     my $dbh = C4::Context->dbh;
1042     my $request;
1043     $request =
1044 "Select categorycode,description from categories where category_type=? order by categorycode";
1045     my $sth = $dbh->prepare($request);
1046     $sth->execute($category_type);
1047     my %labels;
1048     my @codes;
1049
1050     while ( my $data = $sth->fetchrow_hashref ) {
1051         push @codes, $data->{'categorycode'};
1052         $labels{ $data->{'categorycode'} } = $data->{'description'};
1053     }
1054     $sth->finish;
1055     return ( \@codes, \%labels );
1056 }
1057
1058 =head2 getborrowercategory
1059
1060   $description = &getborrowercategory($categorycode);
1061
1062 Given the borrower's category code, the function returns the corresponding
1063 description for a comprehensive information display.
1064
1065 =cut
1066
1067 sub getborrowercategory {
1068     my ($catcode) = @_;
1069     my $dbh       = C4::Context->dbh;
1070     my $sth       =
1071       $dbh->prepare(
1072         "SELECT description FROM categories WHERE categorycode = ?");
1073     $sth->execute($catcode);
1074     my $description = $sth->fetchrow();
1075     $sth->finish();
1076     return $description;
1077 }    # sub getborrowercategory
1078
1079 =head2 ethnicitycategories
1080
1081   ($codes_arrayref, $labels_hashref) = &ethnicitycategories();
1082
1083 Looks up the different ethnic types in the database. Returns two
1084 elements: a reference-to-array, which lists the ethnicity codes, and a
1085 reference-to-hash, which maps the ethnicity codes to ethnicity
1086 descriptions.
1087
1088 =cut
1089
1090 #'
1091
1092 sub ethnicitycategories {
1093     my $dbh = C4::Context->dbh;
1094     my $sth = $dbh->prepare("Select code,name from ethnicity order by name");
1095     $sth->execute;
1096     my %labels;
1097     my @codes;
1098     while ( my $data = $sth->fetchrow_hashref ) {
1099         push @codes, $data->{'code'};
1100         $labels{ $data->{'code'} } = $data->{'name'};
1101     }
1102     $sth->finish;
1103     return ( \@codes, \%labels );
1104 }
1105
1106 =head2 fixEthnicity
1107
1108   $ethn_name = &fixEthnicity($ethn_code);
1109
1110 Takes an ethnicity code (e.g., "european" or "pi") and returns the
1111 corresponding descriptive name from the C<ethnicity> table in the
1112 Koha database ("European" or "Pacific Islander").
1113
1114 =cut
1115
1116 #'
1117
1118 sub fixEthnicity($) {
1119
1120     my $ethnicity = shift;
1121     my $dbh       = C4::Context->dbh;
1122     my $sth       = $dbh->prepare("Select name from ethnicity where code = ?");
1123     $sth->execute($ethnicity);
1124     my $data = $sth->fetchrow_hashref;
1125     $sth->finish;
1126     return $data->{'name'};
1127 }    # sub fixEthnicity
1128
1129 =head2 get_institutions
1130
1131   $insitutions = get_institutions();
1132
1133 Just returns a list of all the borrowers of type I, borrownumber and name
1134
1135 =cut
1136
1137 #'
1138
1139 sub get_institutions {
1140     my $dbh = C4::Context->dbh();
1141     my $sth =
1142       $dbh->prepare(
1143 "SELECT borrowernumber,surname FROM borrowers WHERE categorycode=? ORDER BY surname"
1144       );
1145     $sth->execute('I');
1146     my %orgs;
1147     while ( my $data = $sth->fetchrow_hashref() ) {
1148         $orgs{ $data->{'borrowernumber'} } = $data;
1149     }
1150     $sth->finish();
1151     return ( \%orgs );
1152
1153 }    # sub get_institutions
1154
1155 =head2 add_member_orgs
1156
1157   add_member_orgs($borrowernumber,$borrowernumbers);
1158
1159 Takes a borrowernumber and a list of other borrowernumbers and inserts them into the borrowers_to_borrowers table
1160
1161 =cut
1162
1163 #'
1164 sub add_member_orgs {
1165     my ( $borrowernumber, $otherborrowers ) = @_;
1166     my $dbh   = C4::Context->dbh();
1167     my $query =
1168       "INSERT INTO borrowers_to_borrowers (borrower1,borrower2) VALUES (?,?)";
1169     my $sth = $dbh->prepare($query);
1170     foreach my $bornum (@$otherborrowers) {
1171         $sth->execute( $borrowernumber, $bornum );
1172     }
1173     $sth->finish();
1174
1175 }    # sub add_member_orgs
1176 1;