koha-dev.rot13.org Git - srvgit/blob - 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=?,email=?,
 308   address2=?,relationship=?,othernames=?,phonepro=?,categorycode=?,
 309   city=?,phone=?,borrowernotes=?,B_phone=?,surname=?,initials=?,
 310   B_address=?,ethnicity=?,gonenoaddress=?,lost=?,debarred=?,opacnote=?,
 311   branchcode=?,zipcode=?,B_zipcode=?,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{'email'},
 322         $data{'address2'},      $data{'relationship'},
 323         $data{'othernames'},    $data{'phonepro'},
 324         $data{'categorycode'},  $data{'city'},
 325         $data{'phone'},
 326         $data{'borrowernotes'}, $data{'b_phone'},
 327         $data{'surname'},       $data{'initials'},
 328         $data{'b_address'},     $data{'ethnicity'},
 329         $data{'gna'},           $data{'lost'},
 330         $data{'debarred'},      $data{'opacnotes'},
 331         $data{'branchcode'},    $data{'zipcode'},
 332         $data{'b_zipcode'},     $data{'sort1'},
 333         $data{'sort2'},         $data{'borrowerid'}
 334     );
 335     $sth->finish;
 336 # ok if its an adult (type) it may have borrowers that depend on it as a guarantor
 337 # so when we update information for an adult we should check for guarantees and update the relevant part
 338 # of their records, ie addresses and phone numbers
 339     if ( $data{'categorycode'} eq 'A' || $data{'categorycode'} eq 'W' ) {
 340
 341         # is adult check guarantees;
 342         updateguarantees(%data);
 343     }
 344 }
 345
 346 sub newmember {
 347     my (%data) = @_;
 348     my $dbh = C4::Context->dbh;
 349     $data{'userid'} = '' unless $data{'password'};
 350     $data{'password'} = md5_base64( $data{'password'} ) if $data{'password'};
 351     $data{'dateofbirth'} = format_date_in_iso( $data{'dateofbirth'} );
 352     $data{'dateenrolled'} = format_date_in_iso( $data{'dateenrolled'} );
 353     $data{expiry} = format_date_in_iso( $data{expiry} );
 354     my $query =
 355         "insert into borrowers set cardnumber="
 356       . $dbh->quote( $data{'cardnumber'} )
 357       . ",surname="
 358       . $dbh->quote( $data{'surname'} )
 359       . ",firstname="
 360       . $dbh->quote( $data{'firstname'} )
 361       . ",title="
 362       . $dbh->quote( $data{'title'} )
 363       . ",othernames="
 364       . $dbh->quote( $data{'othernames'} )
 365       . ",initials="
 366       . $dbh->quote( $data{'initials'} )
 367       . ",streetnumber="
 368       . $dbh->quote( $data{'streetnumber'} )
 369       . ",streettype="
 370       . $dbh->quote( $data{'streettype'} )
 371       . ",address="
 372       . $dbh->quote( $data{'address'} )
 373       . ",address2="
 374       . $dbh->quote( $data{'address2'} )
 375       . ",zipcode="
 376       . $dbh->quote( $data{'zipcode'} )
 377       . ",city="
 378       . $dbh->quote( $data{'city'} )
 379       . ",phone="
 380       . $dbh->quote( $data{'phone'} )
 381       . ",email="
 382       . $dbh->quote( $data{'email'} )
 383       . ",mobile="
 384       . $dbh->quote( $data{'mobile'} )
 385       . ",phonepro="
 386       . $dbh->quote( $data{'phonepro'} )
 387       . ",opacnote="
 388       . $dbh->quote( $data{'opacnote'} )
 389       . ",guarantorid="
 390       . $dbh->quote( $data{'guarantorid'} )
 391       . ",dateofbirth="
 392       . $dbh->quote( $data{'dateofbirth'} )
 393       . ",branchcode="
 394       . $dbh->quote( $data{'branchcode'} )
 395       . ",categorycode="
 396       . $dbh->quote( $data{'categorycode'} )
 397       . ",dateenrolled="
 398       . $dbh->quote( $data{'dateenrolled'} )
 399       . ",contactname="
 400       . $dbh->quote( $data{'contactname'} )
 401       . ",borrowernotes="
 402       . $dbh->quote( $data{'borrowernotes'} )
 403       . ",dateexpiry="
 404       . $dbh->quote( $data{'dateexpiry'} )
 405       . ",contactnote="
 406       . $dbh->quote( $data{'contactnote'} )
 407       . ",b_address="
 408       . $dbh->quote( $data{'b_address'} )
 409       . ",b_zipcode="
 410       . $dbh->quote( $data{'b_zipcode'} )
 411       . ",b_city="
 412       . $dbh->quote( $data{'b_city'} )
 413       . ",b_phone="
 414       . $dbh->quote( $data{'b_phone'} )
 415       . ",b_email="
 416       . $dbh->quote( $data{'b_email'}, )
 417       . ",password="
 418       . $dbh->quote( $data{'password'} )
 419       . ",userid="
 420       . $dbh->quote( $data{'userid'} )
 421       . ",sort1="
 422       . $dbh->quote( $data{'sort1'} )
 423       . ",sort2="
 424       . $dbh->quote( $data{'sort2'} )
 425       . ",contacttitle="
 426       . $dbh->quote( $data{'contacttitle'} )
 427       . ",emailpro="
 428       . $dbh->quote( $data{'emailpro'} )
 429       . ",contactfirstname="
 430       . $dbh->quote( $data{'contactfirstname'} ) . ",sex="
 431       . $dbh->quote( $data{'sex'} ) . ",fax="
 432       . $dbh->quote( $data{'fax'} )
 433       . ",flags="
 434       . $dbh->quote( $data{'flags'} )
 435       . ",relationship="
 436       . $dbh->quote( $data{'relationship'} );
 437     my $sth = $dbh->prepare($query);
 438     $sth->execute;
 439     $sth->finish;
 440     $data{'borrowerid'} = $dbh->{'mysql_insertid'};
 441     return $data{'borrowerid'};
 442 }
 443
 444 sub changepassword {
 445     my ( $uid, $member, $digest ) = @_;
 446     my $dbh = C4::Context->dbh;
 447
 448 #Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
 449 #Then we need to tell the user and have them create a new one.
 450     my $sth =
 451       $dbh->prepare(
 452         "select * from borrowers where userid=? and borrowernumber != ?");
 453     $sth->execute( $uid, $member );
 454     if ( ( $uid ne '' ) && ( $sth->fetchrow ) ) {
 455         return 0;
 456     }
 457     else {
 458
 459         #Everything is good so we can update the information.
 460         $sth =
 461           $dbh->prepare(
 462             "update borrowers set userid=?, password=? where borrowernumber=?");
 463         $sth->execute( $uid, $digest, $member );
 464         return 1;
 465     }
 466 }
 467
 468 sub getmemberfromuserid {
 469     my ($userid) = @_;
 470     my $dbh      = C4::Context->dbh;
 471     my $sth      = $dbh->prepare("select * from borrowers where userid=?");
 472     $sth->execute($userid);
 473     return $sth->fetchrow_hashref;
 474 }
 475
 476 sub updateguarantees {
 477     my (%data) = @_;
 478     my $dbh = C4::Context->dbh;
 479     my ( $count, $guarantees ) = findguarantees( $data{'borrowernumber'} );
 480     for ( my $i = 0 ; $i < $count ; $i++ ) {
 481
 482         # FIXME
 483         # It looks like the $i is only being returned to handle walking through
 484         # the array, which is probably better done as a foreach loop.
 485         #
 486         my $guaquery =
 487 "update borrowers set streetaddress='$data{'address'}',faxnumber='$data{'faxnumber'}',
 488                 streetcity='$data{'streetcity'}',phoneday='$data{'phoneday'}',city='$data{'city'}',area='$data{'area'}',phone='$data{'phone'}'
 489                 ,streetaddress='$data{'address'}'
 490                 where borrowernumber='$guarantees->[$i]->{'borrowernumber'}'";
 491         my $sth3 = $dbh->prepare($guaquery);
 492         $sth3->execute;
 493         $sth3->finish;
 494     }
 495 }
 496 ################################################################################
 497
 498 =item fixup_cardnumber
 499
 500 Warning: The caller is responsible for locking the members table in write
 501 mode, to avoid database corruption.
 502
 503 =cut
 504
 505 use vars qw( @weightings );
 506 my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
 507
 508 sub fixup_cardnumber ($) {
 509     my ($cardnumber) = @_;
 510     my $autonumber_members = C4::Context->boolean_preference('autoMemberNum');
 511     $autonumber_members = 0 unless defined $autonumber_members;
 512
 513     # Find out whether member numbers should be generated
 514     # automatically. Should be either "1" or something else.
 515     # Defaults to "0", which is interpreted as "no".
 516
 517     #     if ($cardnumber !~ /\S/ && $autonumber_members) {
 518     if ($autonumber_members) {
 519         my $dbh = C4::Context->dbh;
 520         if ( C4::Context->preference('checkdigit') eq 'katipo' ) {
 521
 522             # if checkdigit is selected, calculate katipo-style cardnumber.
 523             # otherwise, just use the max()
 524             # purpose: generate checksum'd member numbers.
 525             # We'll assume we just got the max value of digits 2-8 of member #'s
 526             # from the database and our job is to increment that by one,
 527             # determine the 1st and 9th digits and return the full string.
 528             my $sth =
 529               $dbh->prepare(
 530                 "select max(substring(borrowers.cardnumber,2,7)) from borrowers"
 531               );
 532             $sth->execute;
 533
 534             my $data = $sth->fetchrow_hashref;
 535             $cardnumber = $data->{'max(substring(borrowers.cardnumber,2,7))'};
 536             $sth->finish;
 537             if ( !$cardnumber ) {    # If DB has no values,
 538                 $cardnumber = 1000000;    # start at 1000000
 539             }
 540             else {
 541                 $cardnumber += 1;
 542             }
 543
 544             my $sum = 0;
 545             for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
 546
 547                 # read weightings, left to right, 1 char at a time
 548                 my $temp1 = $weightings[$i];
 549
 550                 # sequence left to right, 1 char at a time
 551                 my $temp2 = substr( $cardnumber, $i, 1 );
 552
 553                 # mult each char 1-7 by its corresponding weighting
 554                 $sum += $temp1 * $temp2;
 555             }
 556
 557             my $rem = ( $sum % 11 );
 558             $rem = 'X' if $rem == 10;
 559
 560             $cardnumber = "V$cardnumber$rem";
 561         }
 562         else {
 563
 564      # MODIFIED BY JF: mysql4.1 allows casting as an integer, which is probably
 565      # better. I'll leave the original in in case it needs to be changed for you
 566             my $sth =
 567               $dbh->prepare(
 568                 "select max(cast(cardnumber as signed)) from borrowers");
 569
 570       #my $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers");
 571
 572             $sth->execute;
 573
 574             my ($result) = $sth->fetchrow;
 575             $sth->finish;
 576             $cardnumber = $result + 1;
 577         }
 578     }
 579     return $cardnumber;
 580 }
 581
 582 sub findguarantees {
 583     my ($bornum) = @_;
 584     my $dbh      = C4::Context->dbh;
 585     my $sth      = $dbh->prepare(
 586         "select cardnumber,borrowernumber from borrowers where
 587   guarantorid=?"
 588     );
 589     $sth->execute($bornum);
 590     my @dat;
 591     my $i = 0;
 592     while ( my $data = $sth->fetchrow_hashref ) {
 593         $dat[$i] = $data;
 594         $i++;
 595     }
 596     $sth->finish;
 597     return ( $i, \@dat );
 598 }
 599
 600 =item findguarantor
 601
 602   $guarantor = &findguarantor($borrower_no);
 603   $guarantor_cardno = $guarantor->{"cardnumber"};
 604   $guarantor_surname = $guarantor->{"surname"};
 605   ...
 606
 607 C<&findguarantor> takes a borrower number (presumably that of a child
 608 patron), finds the guarantor for C<$borrower_no> (the child's parent),
 609 and returns the record for the guarantor.
 610
 611 C<&findguarantor> returns a reference-to-hash. Its keys are the fields
 612 from the C<borrowers> database table;
 613
 614 =cut
 615
 616 #'
 617 sub findguarantor {
 618     my ($bornum) = @_;
 619     my $dbh = C4::Context->dbh;
 620     my $sth = $dbh->prepare("Select * from borrowers where borrowernumber=?");
 621     $sth->execute($bornum);
 622     my $data = $sth->fetchrow_hashref;
 623     $sth->finish;
 624     return ($data);
 625 }
 626
 627 =item GuarantornameSearch
 628
 629   ($count, $borrowers) = &GuarantornameSearch($env, $searchstring, $type);
 630
 631 Looks up guarantor  by name.
 632
 633 C<$env> is ignored.
 634
 635 BUGFIX 499: C<$type> is now used to determine type of search.
 636 if $type is "simple", search is performed on the first letter of the
 637 surname only.
 638
 639 C<$searchstring> is a space-separated list of search terms. Each term
 640 must match the beginning a borrower's surname, first name, or other
 641 name.
 642
 643 C<&GuarantornameSearch> returns a two-element list. C<$borrowers> is a
 644 reference-to-array; each element is a reference-to-hash, whose keys
 645 are the fields of the C<borrowers> table in the Koha database.
 646 C<$count> is the number of elements in C<$borrowers>.
 647
 648 return all info from guarantor =>only category_type A
 649
 650 =cut
 651
 652 #'
 653 #used by member enquiries from the intranet
 654 #called by guarantor_search.pl
 655 sub GuarantornameSearch {
 656     my ( $env, $searchstring, $orderby, $type ) = @_;
 657     my $dbh   = C4::Context->dbh;
 658     my $query = "";
 659     my $count;
 660     my @data;
 661     my @bind = ();
 662
 663     if ( $type eq "simple" )    # simple search for one letter only
 664     {
 665         $query =
 666 "Select * from borrowers,categories  where borrowers.categorycode=categories.categorycode and category_type='A'  and  surname like ? order by $orderby";
 667         @bind = ("$searchstring%");
 668     }
 669     else    # advanced search looking in surname, firstname and othernames
 670     {
 671         @data  = split( ' ', $searchstring );
 672         $count = @data;
 673         $query = "Select * from borrowers,categories
 674                 where ((surname like ? or surname like ?
 675                 or firstname  like ? or firstname like ?
 676                 or othernames like ? or othernames like ?) and borrowers.categorycode=categories.categorycode and category_type='A'
 677                 ";
 678         @bind = (
 679             "$data[0]%", "% $data[0]%", "$data[0]%", "% $data[0]%",
 680             "$data[0]%", "% $data[0]%"
 681         );
 682         for ( my $i = 1 ; $i < $count ; $i++ ) {
 683             $query = $query . " and (" . " surname like ? or surname like ?
 684                         or firstname  like ? or firstname like ?
 685                         or othernames like ? or othernames like ?)";
 686             push( @bind,
 687                 "$data[$i]%",   "% $data[$i]%", "$data[$i]%",
 688                 "% $data[$i]%", "$data[$i]%",   "% $data[$i]%" );
 689
 690             # FIXME - .= <<EOT;
 691         }
 692         $query = $query . ") or cardnumber like ?
 693                 order by $orderby";
 694         push( @bind, $searchstring );
 695
 696         # FIXME - .= <<EOT;
 697     }
 698
 699     my $sth = $dbh->prepare($query);
 700     $sth->execute(@bind);
 701     my @results;
 702     my $cnt = $sth->rows;
 703     while ( my $data = $sth->fetchrow_hashref ) {
 704         push( @results, $data );
 705     }
 706
 707     #  $sth->execute;
 708     $sth->finish;
 709     return ( $cnt, \@results );
 710 }
 711
 712 =item NewBorrowerNumber
 713
 714   $num = &NewBorrowerNumber();
 715
 716 Allocates a new, unused borrower number, and returns it.
 717
 718 =cut
 719
 720 #'
 721 # FIXME - This is identical to C4::Circulation::Borrower::NewBorrowerNumber.
 722 # Pick one and stick with it. Preferably use the other one. This function
 723 # doesn't belong in C4::Search.
 724 sub NewBorrowerNumber {
 725     my $dbh = C4::Context->dbh;
 726     my $sth = $dbh->prepare("Select max(borrowernumber) from borrowers");
 727     $sth->execute;
 728     my $data = $sth->fetchrow_hashref;
 729     $sth->finish;
 730     $data->{'max(borrowernumber)'}++;
 731     return ( $data->{'max(borrowernumber)'} );
 732 }
 733
 734 =head2 borrissues
 735
 736   ($count, $issues) = &borrissues($borrowernumber);
 737
 738 Looks up what the patron with the given borrowernumber has borrowed.
 739
 740 C<&borrissues> returns a two-element array. C<$issues> is a
 741 reference-to-array, where each element is a reference-to-hash; the
 742 keys are the fields from the C<issues>, C<biblio>, and C<items> tables
 743 in the Koha database. C<$count> is the number of elements in
 744 C<$issues>.
 745
 746 =cut
 747
 748 #'
 749 sub borrissues {
 750     my ($bornum) = @_;
 751     my $dbh      = C4::Context->dbh;
 752     my $sth      = $dbh->prepare(
 753         "Select * from issues,biblio,items where borrowernumber=?
 754    and items.itemnumber=issues.itemnumber
 755         and items.biblionumber=biblio.biblionumber
 756         and issues.returndate is NULL order by date_due"
 757     );
 758     $sth->execute($bornum);
 759     my @result;
 760     while ( my $data = $sth->fetchrow_hashref ) {
 761         push @result, $data;
 762     }
 763     $sth->finish;
 764     return ( scalar(@result), \@result );
 765 }
 766
 767 =head2 allissues
 768
 769   ($count, $issues) = &allissues($borrowernumber, $sortkey, $limit);
 770
 771 Looks up what the patron with the given borrowernumber has borrowed,
 772 and sorts the results.
 773
 774 C<$sortkey> is the name of a field on which to sort the results. This
 775 should be the name of a field in the C<issues>, C<biblio>,
 776 C<biblioitems>, or C<items> table in the Koha database.
 777
 778 C<$limit> is the maximum number of results to return.
 779
 780 C<&allissues> returns a two-element array. C<$issues> is a
 781 reference-to-array, where each element is a reference-to-hash; the
 782 keys are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
 783 C<items> tables of the Koha database. C<$count> is the number of
 784 elements in C<$issues>
 785
 786 =cut
 787
 788 #'
 789 sub allissues {
 790     my ( $bornum, $order, $limit ) = @_;
 791
 792     #FIXME: sanity-check order and limit
 793     my $dbh   = C4::Context->dbh;
 794     my $query = "Select * from issues,biblio,items,biblioitems
 795   where borrowernumber=? and
 796   items.biblioitemnumber=biblioitems.biblioitemnumber and
 797   items.itemnumber=issues.itemnumber and
 798   items.biblionumber=biblio.biblionumber order by $order";
 799     if ( $limit != 0 ) {
 800         $query .= " limit $limit";
 801     }
 802
 803     #print $query;
 804     my $sth = $dbh->prepare($query);
 805     $sth->execute($bornum);
 806     my @result;
 807     my $i = 0;
 808     while ( my $data = $sth->fetchrow_hashref ) {
 809         $result[$i] = $data;
 810         $i++;
 811     }
 812     $sth->finish;
 813     return ( $i, \@result );
 814 }
 815
 816 =head2 getboracctrecord
 817
 818   ($count, $acctlines, $total) = &getboracctrecord($env, $borrowernumber);
 819
 820 Looks up accounting data for the patron with the given borrowernumber.
 821
 822 C<$env> is ignored.
 823
 824 (FIXME - I'm not at all sure what this is about.)
 825
 826 C<&getboracctrecord> returns a three-element array. C<$acctlines> is a
 827 reference-to-array, where each element is a reference-to-hash; the
 828 keys are the fields of the C<accountlines> table in the Koha database.
 829 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
 830 total amount outstanding for all of the account lines.
 831
 832 =cut
 833
 834 #'
 835 sub getboracctrecord {
 836     my ( $env, $params ) = @_;
 837     my $dbh = C4::Context->dbh;
 838     my @acctlines;
 839     my $numlines = 0;
 840     my $sth      = $dbh->prepare(
 841         "Select * from accountlines where
 842 borrowernumber=? order by date desc,timestamp desc"
 843     );
 844
 845     #   print $query;
 846     $sth->execute( $params->{'borrowernumber'} );
 847     my $total = 0;
 848     while ( my $data = $sth->fetchrow_hashref ) {
 849
 850         #FIXME before reinstating: insecure?
 851         #      if ($data->{'itemnumber'} ne ''){
 852         #        $query="Select * from items,biblio where items.itemnumber=
 853         #       '$data->{'itemnumber'}' and biblio.biblionumber=items.biblionumber";
 854         #       my $sth2=$dbh->prepare($query);
 855         #       $sth2->execute;
 856         #       my $data2=$sth2->fetchrow_hashref;
 857         #       $sth2->finish;
 858         #       $data=$data2;
 859         #     }
 860         $acctlines[$numlines] = $data;
 861         $numlines++;
 862         $total += $data->{'amountoutstanding'};
 863     }
 864     $sth->finish;
 865     return ( $numlines, \@acctlines, $total );
 866 }
 867
 868 =head2 checkuniquemember (OUEST-PROVENCE)
 869
 870   $result = &checkuniquemember($collectivity,$surname,$categorycode,$firstname,$dateofbirth);
 871
 872 Checks that a member exists or not in the database.
 873
 874 C<&result> is 1 (=exist) or 0 (=does not exist)
 875 C<&collectivity> is 1 (= we add a collectivity) or 0 (= we add a physical member)
 876 C<&surname> is the surname
 877 C<&categorycode> is from categorycode table
 878 C<&firstname> is the firstname (only if collectivity=0)
 879 C<&dateofbirth> is the date of birth (only if collectivity=0)
 880
 881 =cut
 882
 883 sub checkuniquemember {
 884     my ( $collectivity, $surname, $firstname, $dateofbirth ) = @_;
 885     my $dbh = C4::Context->dbh;
 886     my $request;
 887     if ($collectivity) {
 888
 889 #                               $request="select count(*) from borrowers where surname=? and categorycode=?";
 890         $request =
 891           "select borrowernumber,categorycode from borrowers where surname=? ";
 892     }
 893     else {
 894
 895 #                               $request="select count(*) from borrowers where surname=? and categorycode=? and firstname=? and dateofbirth=?";
 896         $request =
 897 "select borrowernumber,categorycode from borrowers where surname=?  and firstname=? and dateofbirth=?";
 898     }
 899     my $sth = $dbh->prepare($request);
 900     if ($collectivity) {
 901         $sth->execute( uc($surname) );
 902     }
 903     else {
 904         $sth->execute( uc($surname), ucfirst($firstname), $dateofbirth );
 905     }
 906     my @data = $sth->fetchrow;
 907     if ( $data[0] ) {
 908         $sth->finish;
 909         return $data[0], $data[1];
 910
 911         #
 912     }
 913     else {
 914         $sth->finish;
 915         return 0;
 916     }
 917 }
 918
 919 =head2 getzipnamecity (OUEST-PROVENCE)
 920
 921 take all info from table city for the fields city and  zip
 922 check for the name and the zip code of the city selected
 923
 924 =cut
 925
 926 sub getzipnamecity {
 927     my ($cityid) = @_;
 928     my $dbh      = C4::Context->dbh;
 929     my $sth      =
 930       $dbh->prepare(
 931         "select city_name,city_zipcode from cities where cityid=? ");
 932     $sth->execute($cityid);
 933     my @data = $sth->fetchrow;
 934     return $data[0], $data[1];
 935 }
 936
 937 =head2 updatechildguarantor (OUEST-PROVENCE)
 938
 939 check for title,firstname,surname,adress,zip code and city  from guarantor to
 940 guarantorchild
 941
 942 =cut
 943
 944 #'
 945
 946 sub getguarantordata {
 947     my ($borrowerid) = @_;
 948     my $dbh          = C4::Context->dbh;
 949     my $sth          =
 950       $dbh->prepare(
 951 "Select title,firstname,surname,streetnumber,address,streettype,address2,zipcode,city,phone,phonepro,mobile,email,emailpro  from borrowers where borrowernumber =? "
 952       );
 953     $sth->execute($borrowerid);
 954     my $guarantor_data = $sth->fetchrow_hashref;
 955     $sth->finish;
 956     return $guarantor_data;
 957 }
 958
 959 =head2 getdcity (OUEST-PROVENCE)
 960 recover cityid  with city_name condition
 961 =cut
 962
 963 sub getidcity {
 964     my ($city_name) = @_;
 965     my $dbh = C4::Context->dbh;
 966     my $sth = $dbh->prepare("select cityid from cities where city_name=? ");
 967     $sth->execute($city_name);
 968     my $data = $sth->fetchrow;
 969     return $data;
 970 }
 971
 972 =head2 getcategorytype (OUEST-PROVENCE)
 973
 974 check for the category_type with categorycode
 975 and return the category_type
 976
 977 =cut
 978
 979 sub getcategorytype {
 980     my ($categorycode) = @_;
 981     my $dbh            = C4::Context->dbh;
 982     my $sth            =
 983       $dbh->prepare(
 984 "Select category_type,description from categories where categorycode=?  "
 985       );
 986     $sth->execute($categorycode);
 987     my ( $category_type, $description ) = $sth->fetchrow;
 988     return $category_type, $description;
 989 }
 990
 991 sub calcexpirydate {
 992     my ( $categorycode, $dateenrolled ) = @_;
 993     my $dbh = C4::Context->dbh;
 994     my $sth =
 995       $dbh->prepare(
 996         "select enrolmentperiod from categories where categorycode=?");
 997     $sth->execute($categorycode);
 998     my ($enrolmentperiod) = $sth->fetchrow;
 999     $enrolmentperiod = 12 unless ($enrolmentperiod);
1000     return format_date_in_iso(
1001         &DateCalc( $dateenrolled, "$enrolmentperiod months" ) );
1002 }
1003
1004 =head2 checkuserpassword (OUEST-PROVENCE)
1005
1006 check for the password and login are not used
1007 return the number of record
1008 0=> NOT USED 1=> USED
1009
1010 =cut
1011
1012 sub checkuserpassword {
1013     my ( $borrowerid, $userid, $password ) = @_;
1014     $password = md5_base64($password);
1015     my $dbh = C4::Context->dbh;
1016     my $sth =
1017       $dbh->prepare(
1018 "Select count(*) from borrowers where borrowernumber !=? and userid =? and password=? "
1019       );
1020     $sth->execute( $borrowerid, $userid, $password );
1021     my $number_rows = $sth->fetchrow;
1022     return $number_rows;
1023
1024 }
1025
1026 =head2 borrowercategories
1027
1028   ($codes_arrayref, $labels_hashref) = &borrowercategories();
1029
1030 Looks up the different types of borrowers in the database. Returns two
1031 elements: a reference-to-array, which lists the borrower category
1032 codes, and a reference-to-hash, which maps the borrower category codes
1033 to category descriptions.
1034
1035 =cut
1036
1037 #'
1038 sub borrowercategories {
1039     my ( $category_type, $action ) = @_;
1040     my $dbh = C4::Context->dbh;
1041     my $request;
1042     $request =
1043 "Select categorycode,description from categories where category_type=? order by categorycode";
1044     my $sth = $dbh->prepare($request);
1045     $sth->execute($category_type);
1046     my %labels;
1047     my @codes;
1048
1049     while ( my $data = $sth->fetchrow_hashref ) {
1050         push @codes, $data->{'categorycode'};
1051         $labels{ $data->{'categorycode'} } = $data->{'description'};
1052     }
1053     $sth->finish;
1054     return ( \@codes, \%labels );
1055 }
1056
1057 =head2 getborrowercategory
1058
1059   $description = &getborrowercategory($categorycode);
1060
1061 Given the borrower's category code, the function returns the corresponding
1062 description for a comprehensive information display.
1063
1064 =cut
1065
1066 sub getborrowercategory {
1067     my ($catcode) = @_;
1068     my $dbh       = C4::Context->dbh;
1069     my $sth       =
1070       $dbh->prepare(
1071         "SELECT description FROM categories WHERE categorycode = ?");
1072     $sth->execute($catcode);
1073     my $description = $sth->fetchrow();
1074     $sth->finish();
1075     return $description;
1076 }    # sub getborrowercategory
1077
1078 =head2 ethnicitycategories
1079
1080   ($codes_arrayref, $labels_hashref) = &ethnicitycategories();
1081
1082 Looks up the different ethnic types in the database. Returns two
1083 elements: a reference-to-array, which lists the ethnicity codes, and a
1084 reference-to-hash, which maps the ethnicity codes to ethnicity
1085 descriptions.
1086
1087 =cut
1088
1089 #'
1090
1091 sub ethnicitycategories {
1092     my $dbh = C4::Context->dbh;
1093     my $sth = $dbh->prepare("Select code,name from ethnicity order by name");
1094     $sth->execute;
1095     my %labels;
1096     my @codes;
1097     while ( my $data = $sth->fetchrow_hashref ) {
1098         push @codes, $data->{'code'};
1099         $labels{ $data->{'code'} } = $data->{'name'};
1100     }
1101     $sth->finish;
1102     return ( \@codes, \%labels );
1103 }
1104
1105 =head2 fixEthnicity
1106
1107   $ethn_name = &fixEthnicity($ethn_code);
1108
1109 Takes an ethnicity code (e.g., "european" or "pi") and returns the
1110 corresponding descriptive name from the C<ethnicity> table in the
1111 Koha database ("European" or "Pacific Islander").
1112
1113 =cut
1114
1115 #'
1116
1117 sub fixEthnicity($) {
1118
1119     my $ethnicity = shift;
1120     my $dbh       = C4::Context->dbh;
1121     my $sth       = $dbh->prepare("Select name from ethnicity where code = ?");
1122     $sth->execute($ethnicity);
1123     my $data = $sth->fetchrow_hashref;
1124     $sth->finish;
1125     return $data->{'name'};
1126 }    # sub fixEthnicity
1127
1128 =head2 get_institutions
1129
1130   $insitutions = get_institutions();
1131
1132 Just returns a list of all the borrowers of type I, borrownumber and name
1133
1134 =cut
1135
1136 #'
1137
1138 sub get_institutions {
1139     my $dbh = C4::Context->dbh();
1140     my $sth =
1141       $dbh->prepare(
1142 "SELECT borrowernumber,surname FROM borrowers WHERE categorycode=? ORDER BY surname"
1143       );
1144     $sth->execute('I');
1145     my %orgs;
1146     while ( my $data = $sth->fetchrow_hashref() ) {
1147         $orgs{ $data->{'borrowernumber'} } = $data;
1148     }
1149     $sth->finish();
1150     return ( \%orgs );
1151
1152 }    # sub get_institutions
1153
1154 =head2 add_member_orgs
1155
1156   add_member_orgs($borrowernumber,$borrowernumbers);
1157
1158 Takes a borrowernumber and a list of other borrowernumbers and inserts them into the borrowers_to_borrowers table
1159
1160 =cut
1161
1162 #'
1163 sub add_member_orgs {
1164     my ( $borrowernumber, $otherborrowers ) = @_;
1165     my $dbh   = C4::Context->dbh();
1166     my $query =
1167       "INSERT INTO borrowers_to_borrowers (borrower1,borrower2) VALUES (?,?)";
1168     my $sth = $dbh->prepare($query);
1169     foreach my $bornum (@$otherborrowers) {
1170         $sth->execute( $borrowernumber, $bornum );
1171     }
1172     $sth->finish();
1173
1174 }    # sub add_member_orgs
1175 1;