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 C4::Date;
  28 use Digest::MD5 qw(md5_base64);
  29 use Date::Calc qw/Today/;
  30 use C4::Biblio;
  31 use C4::Stats;
  32 use C4::Reserves2;
  33 use C4::Koha;
  34 use C4::Accounts2;
  35 use C4::Circulation::Circ2;
  36 use Date::Manip;
  37 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
  38
  39 $VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); };
  40
  41 =head1 NAME
  42
  43 C4::Members - Perl Module containing convenience functions for member handling
  44
  45 =head1 SYNOPSIS
  46
  47 use C4::Members;
  48
  49 =head1 DESCRIPTION
  50
  51 This module contains routines for adding, modifying and deleting members/patrons/borrowers
  52
  53 =head1 FUNCTIONS
  54
  55 =over 2
  56
  57 =cut
  58
  59 #'
  60
  61 @ISA    = qw(Exporter);
  62
  63 @EXPORT = qw(
  64
  65 &allissues
  66 &add_member_orgs
  67 &borrdata
  68 &borrdata2
  69 &borrdata3
  70 &BornameSearch
  71 &borrissues
  72 &borrowercard_active
  73 &borrowercategories
  74 &change_user_pass
  75 &checkuniquemember
  76 &calcexpirydate
  77 &checkuserpassword
  78
  79 &ethnicitycategories
  80 &fixEthnicity
  81 &fixup_cardnumber
  82 &findguarantees
  83 &findguarantor
  84 &fixupneu_cardnumber
  85
  86 &getmember
  87 &getMemberPhoto
  88 &get_institutions
  89 &getzipnamecity
  90 &getidcity
  91 &getguarantordata
  92 &getcategorytype
  93 &getboracctrecord
  94 &getborrowercategory
  95 &getborrowercategoryinfo
  96 &get_age
  97 &getpatroninformation
  98 &GetBorrowersFromSurname
  99 &GetBranchCodeFromBorrowers
 100 &GetFlagsAndBranchFromBorrower
 101 &GuarantornameSearch
 102 &NewBorrowerNumber
 103 &modmember
 104 &newmember
 105 &expand_sex_into_predicate
 106         );
 107
 108
 109
 110 =head2 borrowercategories
 111
 112   ($codes_arrayref, $labels_hashref) = &borrowercategories();
 113
 114 Looks up the different types of borrowers in the database. Returns two
 115 elements: a reference-to-array, which lists the borrower category
 116 codes, and a reference-to-hash, which maps the borrower category codes
 117 to category descriptions.
 118
 119 =cut
 120 #'
 121
 122 sub borrowercategories {
 123     my $dbh = C4::Context->dbh;
 124     my $sth=$dbh->prepare("Select categorycode,description from categories order by description");
 125     $sth->execute;
 126     my %labels;
 127     my @codes;
 128     while (my $data=$sth->fetchrow_hashref){
 129       push @codes,$data->{'categorycode'};
 130       $labels{$data->{'categorycode'}}=$data->{'description'};
 131     }
 132     $sth->finish;
 133     return(\@codes,\%labels);
 134 }
 135
 136 =item BornameSearch
 137
 138   ($count, $borrowers) = &BornameSearch($env, $searchstring, $type);
 139
 140 Looks up patrons (borrowers) by name.
 141
 142 C<$env> is ignored.
 143
 144 BUGFIX 499: C<$type> is now used to determine type of search.
 145 if $type is "simple", search is performed on the first letter of the
 146 surname only.
 147
 148 C<$searchstring> is a space-separated list of search terms. Each term
 149 must match the beginning a borrower's surname, first name, or other
 150 name.
 151
 152 C<&BornameSearch> returns a two-element list. C<$borrowers> is a
 153 reference-to-array; each element is a reference-to-hash, whose keys
 154 are the fields of the C<borrowers> table in the Koha database.
 155 C<$count> is the number of elements in C<$borrowers>.
 156
 157 =cut
 158 #'
 159 #used by member enquiries from the intranet
 160 #called by member.pl
 161 sub BornameSearch  {
 162         my ($env,$searchstring,$orderby,$type)=@_;
 163         my $dbh = C4::Context->dbh;
 164         my $query = ""; my $count;
 165         my @data;
 166         my @bind=();
 167
 168         if($type eq "simple")   # simple search for one letter only
 169         {
 170                 $query="Select * from borrowers where surname like '$searchstring%' order by $orderby";
 171 #               @bind=("$searchstring%");
 172         }
 173         else    # advanced search looking in surname, firstname and othernames
 174         {
 175 ### Try to determine whether numeric like cardnumber
 176         if ($searchstring+1>1) {
 177         $query="Select * from borrowers where  cardnumber  like '$searchstring%' ";
 178
 179         }else{
 180
 181         my @words=split / /,$searchstring;
 182         foreach my $word(@words){
 183         $word="+".$word;
 184
 185         }
 186         $searchstring=join " ",@words;
 187
 188                 $query="Select * from borrowers where  MATCH(surname,firstname,othernames) AGAINST('$searchstring'  in boolean mode)";
 189
 190         }
 191                 $query=$query." order by $orderby";
 192         }
 193
 194         my $sth=$dbh->prepare($query);
 195 #       warn "Q $orderby : $query";
 196         $sth->execute();
 197         my @results;
 198         my $cnt=$sth->rows;
 199         while (my $data=$sth->fetchrow_hashref){
 200         push(@results,$data);
 201         }
 202         #  $sth->execute;
 203         $sth->finish;
 204         return ($cnt,\@results);
 205 }
 206 =head2 getpatroninformation
 207
 208   ($borrower, $flags) = &getpatroninformation($env, $borrowernumber, $cardnumber);
 209 Looks up a patron and returns information about him or her. If
 210 C<$borrowernumber> is true (nonzero), C<&getpatroninformation> looks
 211 up the borrower by number; otherwise, it looks up the borrower by card
 212 number.
 213 C<$env> is effectively ignored, but should be a reference-to-hash.
 214 C<$borrower> is a reference-to-hash whose keys are the fields of the
 215 borrowers table in the Koha database. In addition,
 216 C<$borrower-E<gt>{flags}> is a hash giving more detailed information
 217 about the patron. Its keys act as flags :
 218
 219         if $borrower->{flags}->{LOST} {
 220                 # Patron's card was reported lost
 221         }
 222
 223 Each flag has a C<message> key, giving a human-readable explanation of
 224 the flag. If the state of a flag means that the patron should not be
 225 allowed to borrow any more books, then it will have a C<noissues> key
 226 with a true value.
 227
 228 The possible flags are:
 229
 230 =head3 CHARGES
 231
 232 =over 4
 233
 234 Shows the patron's credit or debt, if any.
 235
 236 =back
 237
 238 =head3 GNA
 239
 240 =over 4
 241
 242 (Gone, no address.) Set if the patron has left without giving a
 243 forwarding address.
 244
 245 =back
 246
 247 =head3 LOST
 248
 249 =over 4
 250
 251 Set if the patron's card has been reported as lost.
 252
 253 =back
 254
 255 =head3 DBARRED
 256
 257 =over 4
 258
 259 Set if the patron has been debarred.
 260
 261 =back
 262
 263 =head3 NOTES
 264
 265 =over 4
 266
 267 Any additional notes about the patron.
 268
 269 =back
 270
 271 =head3 ODUES
 272
 273 =over 4
 274
 275 Set if the patron has overdue items. This flag has several keys:
 276
 277 C<$flags-E<gt>{ODUES}{itemlist}> is a reference-to-array listing the
 278 overdue items. Its elements are references-to-hash, each describing an
 279 overdue item. The keys are selected fields from the issues, biblio,
 280 biblioitems, and items tables of the Koha database.
 281
 282 C<$flags-E<gt>{ODUES}{itemlist}> is a string giving a text listing of
 283 the overdue items, one per line.
 284
 285 =back
 286
 287 =head3 WAITING
 288
 289 =over 4
 290
 291 Set if any items that the patron has reserved are available.
 292
 293 C<$flags-E<gt>{WAITING}{itemlist}> is a reference-to-array listing the
 294 available items. Each element is a reference-to-hash whose keys are
 295 fields from the reserves table of the Koha database.
 296
 297 =back
 298
 299 =back
 300
 301 =cut
 302
 303 sub getpatroninformation {
 304 # returns
 305         my ($env, $borrowernumber,$cardnumber) = @_;
 306         my $dbh = C4::Context->dbh;
 307         my $query;
 308         my $sth;
 309         if ($borrowernumber) {
 310                 $sth = $dbh->prepare("select * from borrowers where borrowernumber=?");
 311                 $sth->execute($borrowernumber);
 312         } elsif ($cardnumber) {
 313                 $sth = $dbh->prepare("select * from borrowers where cardnumber=?");
 314                 $sth->execute($cardnumber);
 315         } else {
 316                 $env->{'apierror'} = "invalid borrower information passed to getpatroninformation subroutine";
 317                 return();
 318         }
 319         my $borrower = $sth->fetchrow_hashref;
 320         my $amount = C4::Accounts2::checkaccount($env, $borrowernumber, $dbh);
 321         $borrower->{'amountoutstanding'} = $amount;
 322         my $flags = C4::Circulation::Circ2::patronflags($env, $borrower, $dbh);
 323         my $accessflagshash;
 324
 325         $sth=$dbh->prepare("select bit,flag from userflags");
 326         $sth->execute;
 327         while (my ($bit, $flag) = $sth->fetchrow) {
 328                 if ($borrower->{'flags'} & 2**$bit) {
 329                 $accessflagshash->{$flag}=1;
 330                 }
 331         }
 332         $sth->finish;
 333         $borrower->{'flags'}=$flags;
 334         $borrower->{'authflags'} = $accessflagshash;
 335         return ($borrower); #, $flags, $accessflagshash);
 336 }
 337
 338 =item getmember
 339
 340   $borrower = &getmember($cardnumber, $borrowernumber);
 341
 342 Looks up information about a patron (borrower) by either card number
 343 or borrower number. If $borrowernumber is specified, C<&borrdata>
 344 searches by borrower number; otherwise, it searches by card number.
 345
 346 C<&getmember> returns a reference-to-hash whose keys are the fields of
 347 the C<borrowers> table in the Koha database.
 348
 349 =cut
 350
 351 =head3 GetFlagsAndBranchFromBorrower
 352
 353 =over 4
 354
 355 ($flags, $homebranch) = GetFlagsAndBranchFromBorrower($loggedinuser);
 356
 357 this function read on the database to get flags and homebranch for a user
 358 given on input arg.
 359
 360 return :
 361 it returns the $flags & the homebranch in scalar context.
 362
 363 =back
 364
 365 =cut
 366
 367
 368
 369 =item borrissues
 370
 371   ($count, $issues) = &borrissues($borrowernumber);
 372
 373 Looks up what the patron with the given borrowernumber has borrowed.
 374
 375 C<&borrissues> returns a two-element array. C<$issues> is a
 376 reference-to-array, where each element is a reference-to-hash; the
 377 keys are the fields from the C<issues>, C<biblio>, and C<items> tables
 378 in the Koha database. C<$count> is the number of elements in
 379 C<$issues>.
 380
 381 =cut
 382 #'
 383 sub borrissues {
 384   my ($bornum)=@_;
 385   my $dbh = C4::Context->dbh;
 386   my $sth=$dbh->prepare("Select * from issues,biblio,items where borrowernumber=?
 387    and items.itemnumber=issues.itemnumber
 388         and items.biblionumber=biblio.biblionumber
 389         and issues.returndate is NULL order by date_due");
 390     $sth->execute($bornum);
 391   my @result;
 392   while (my $data = $sth->fetchrow_hashref) {
 393     push @result, $data;
 394   }
 395   $sth->finish;
 396   return(scalar(@result), \@result);
 397 }
 398
 399 =item allissues
 400
 401   ($count, $issues) = &allissues($borrowernumber, $sortkey, $limit);
 402
 403 Looks up what the patron with the given borrowernumber has borrowed,
 404 and sorts the results.
 405
 406 C<$sortkey> is the name of a field on which to sort the results. This
 407 should be the name of a field in the C<issues>, C<biblio>,
 408 C<biblioitems>, or C<items> table in the Koha database.
 409
 410 C<$limit> is the maximum number of results to return.
 411
 412 C<&allissues> returns a two-element array. C<$issues> is a
 413 reference-to-array, where each element is a reference-to-hash; the
 414 keys are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
 415 C<items> tables of the Koha database. C<$count> is the number of
 416 elements in C<$issues>
 417
 418 =cut
 419 #'
 420 sub allissues {
 421   my ($bornum,$order,$limit)=@_;
 422   #FIXME: sanity-check order and limit
 423   my $dbh = C4::Context->dbh;
 424   my $query="Select * from issues,biblio,items
 425   where borrowernumber=? and
 426   items.itemnumber=issues.itemnumber and
 427   items.biblionumber=biblio.biblionumber order by $order";
 428   if ($limit !=0){
 429     $query.=" limit $limit";
 430   }
 431   #print $query;
 432   my $sth=$dbh->prepare($query);
 433   $sth->execute($bornum);
 434   my @result;
 435   my $i=0;
 436   while (my $data=$sth->fetchrow_hashref){
 437     $result[$i]=$data;;
 438     $i++;
 439   }
 440   $sth->finish;
 441   return($i,\@result);
 442 }
 443
 444
 445 sub borrdata3 {
 446 ## NEU specific. used in Reserve section issues
 447   my ($env,$bornum)=@_;
 448   my $dbh = C4::Context->dbh;
 449   my $query="Select count(*) from  reserveissue as r where r.borrowernumber='$bornum'
 450      and rettime is null";
 451     # print $query;
 452   my $sth=$dbh->prepare($query);
 453   $sth->execute;
 454   my $data=$sth->fetchrow_hashref;
 455   $sth->finish;
 456   $sth=$dbh->prepare("Select count(*),timediff(now(),  duetime  ) as elapsed, hour(timediff(now(),  duetime  )) as hours, MINUTE(timediff(now(),  duetime  )) as min from
 457     reserveissue as r where  r.borrowernumber='$bornum' and rettime is null and duetime< now() group by r.borrowernumber");
 458   $sth->execute;
 459
 460   my $data2=$sth->fetchrow_hashref;
 461 my $resfine;
 462 my $rescharge=C4::Context->preference('resmaterialcharge');
 463         if (!$rescharge){
 464         $rescharge=1;
 465         }
 466         if ($data2->{'elapsed'}>0){
 467          $resfine=($data2->{'hours'}+$data2->{'min'}/60)*$rescharge;
 468         $resfine=sprintf  ("%.1f",$resfine);
 469         }
 470   $sth->finish;
 471   $sth=$dbh->prepare("Select sum(amountoutstanding) from accountlines where
 472     borrowernumber='$bornum'");
 473   $sth->execute;
 474   my $data3=$sth->fetchrow_hashref;
 475   $sth->finish;
 476
 477
 478 return($data2->{'count(*)'},$data->{'count(*)'},$data3->{'sum(amountoutstanding)'},$resfine);
 479 }
 480 =item getboracctrecord
 481
 482   ($count, $acctlines, $total) = &getboracctrecord($env, $borrowernumber);
 483
 484 Looks up accounting data for the patron with the given borrowernumber.
 485
 486 C<$env> is ignored.
 487
 488
 489 C<&getboracctrecord> returns a three-element array. C<$acctlines> is a
 490 reference-to-array, where each element is a reference-to-hash; the
 491 keys are the fields of the C<accountlines> table in the Koha database.
 492 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
 493 total amount outstanding for all of the account lines.
 494
 495 =cut
 496 #'
 497 sub getboracctrecord {
 498    my ($env,$params) = @_;
 499    my $dbh = C4::Context->dbh;
 500    my @acctlines;
 501    my $numlines=0;
 502    my $sth=$dbh->prepare("Select * from accountlines where
 503 borrowernumber=? order by date desc,timestamp desc");
 504 #   print $query;
 505    $sth->execute($params->{'borrowernumber'});
 506    my $total=0;
 507    while (my $data=$sth->fetchrow_hashref){
 508       $acctlines[$numlines] = $data;
 509       $numlines++;
 510       $total += $data->{'amountoutstanding'};
 511    }
 512    $sth->finish;
 513    return ($numlines,\@acctlines,$total);
 514 }
 515
 516 sub getborrowercategory{
 517         my ($catcode) = @_;
 518         my $dbh = C4::Context->dbh;
 519         my $sth = $dbh->prepare("SELECT description FROM categories WHERE categorycode = ?");
 520         $sth->execute($catcode);
 521         my $description = $sth->fetchrow();
 522         $sth->finish();
 523         return $description;
 524 } # sub getborrowercategory
 525
 526 sub getborrowercategoryinfo{
 527         my ($catcode) = @_;
 528         my $dbh = C4::Context->dbh;
 529         my $sth = $dbh->prepare("SELECT * FROM categories WHERE categorycode = ?");
 530         $sth->execute($catcode);
 531         my $category = $sth->fetchrow_hashref;
 532         $sth->finish();
 533         return $category;
 534 } # sub getborrowercategoryinfo
 535
 536
 537 sub GetFlagsAndBranchFromBorrower {
 538     my $loggedinuser = @_;
 539     my $dbh = C4::Context->dbh;
 540     my $query = "
 541        SELECT flags, branchcode
 542        FROM   borrowers
 543        WHERE  borrowernumber = ?
 544     ";
 545     my $sth = $dbh->prepare($query);
 546     $sth->execute($loggedinuser);
 547
 548     return $sth->fetchrow;
 549 }
 550
 551
 552 sub getmember {
 553     my ( $cardnumber, $bornum ) = @_;
 554     $cardnumber = uc $cardnumber;
 555     my $dbh = C4::Context->dbh;
 556     my $sth;
 557     if ( $bornum eq '' ) {
 558         $sth = $dbh->prepare("Select * from borrowers where cardnumber=?");
 559         $sth->execute($cardnumber);
 560     } else {
 561         $sth = $dbh->prepare("Select * from borrowers where borrowernumber=?");
 562         $sth->execute($bornum);
 563     }
 564     my $data = $sth->fetchrow_hashref;
 565     $sth->finish;
 566     if ($data) {
 567         return ($data);
 568     }
 569     else {    # try with firstname
 570         if ($cardnumber) {
 571             my $sth =
 572               $dbh->prepare("select * from borrowers where firstname=?");
 573             $sth->execute($cardnumber);
 574             my $data = $sth->fetchrow_hashref;
 575             $sth->finish;
 576             return ($data);
 577         }
 578     }
 579     return undef;
 580 }
 581
 582 =item borrdata
 583
 584   $borrower = &borrdata($cardnumber, $borrowernumber);
 585
 586 Looks up information about a patron (borrower) by either card number
 587 or borrower number. If $borrowernumber is specified, C<&borrdata>
 588 searches by borrower number; otherwise, it searches by card number.
 589
 590 C<&borrdata> returns a reference-to-hash whose keys are the fields of
 591 the C<borrowers> table in the Koha database.
 592
 593 =cut
 594
 595 #'
 596 sub borrdata {
 597     my ( $cardnumber, $bornum ) = @_;
 598     $cardnumber = uc $cardnumber;
 599     my $dbh = C4::Context->dbh;
 600     my $sth;
 601     if ( $bornum eq '' ) {
 602         $sth =
 603           $dbh->prepare(
 604 "Select borrowers.*,categories.category_type from borrowers left join categories on borrowers.categorycode=categories.categorycode where cardnumber=?"
 605           );
 606         $sth->execute($cardnumber);
 607     }
 608     else {
 609         $sth =
 610           $dbh->prepare(
 611 "Select borrowers.*,categories.category_type from borrowers left join categories on borrowers.categorycode=categories.categorycode where borrowernumber=?"
 612           );
 613         $sth->execute($bornum);
 614     }
 615     my $data = $sth->fetchrow_hashref;
 616 #     warn "DATA" . $data->{category_type};
 617     $sth->finish;
 618     if ($data) {
 619         return ($data);
 620     }
 621     else {    # try with firstname
 622         if ($cardnumber) {
 623             my $sth =
 624               $dbh->prepare(
 625 "Select borrowers.*,categories.category_type from borrowers left join categories on borrowers.categorycode=categories.categorycode  where firstname=?"
 626               );
 627             $sth->execute($cardnumber);
 628             my $data = $sth->fetchrow_hashref;
 629             $sth->finish;
 630             return ($data);
 631         }
 632     }
 633     return undef;
 634 }
 635
 636 =item borrdata2
 637
 638   ($borrowed, $due, $fine) = &borrdata2($env, $borrowernumber);
 639
 640 Returns aggregate data about items borrowed by the patron with the
 641 given borrowernumber.
 642
 643 C<$env> is ignored.
 644
 645 C<&borrdata2> returns a three-element array. C<$borrowed> is the
 646 number of books the patron currently has borrowed. C<$due> is the
 647 number of overdue items the patron currently has borrowed. C<$fine> is
 648 the total fine currently due by the borrower.
 649
 650 =cut
 651
 652 #'
 653 sub borrdata2 {
 654     my ( $env, $bornum ) = @_;
 655     my $dbh   = C4::Context->dbh;
 656     my $query = "Select count(*) from issues where borrowernumber='$bornum' and
 657     returndate is NULL";
 658
 659     # print $query;
 660     my $sth = $dbh->prepare($query);
 661     $sth->execute;
 662     my $data = $sth->fetchrow_hashref;
 663     $sth->finish;
 664     $sth = $dbh->prepare(
 665         "Select count(*) from issues where
 666     borrowernumber='$bornum' and date_due < now() and returndate is NULL"
 667     );
 668     $sth->execute;
 669     my $data2 = $sth->fetchrow_hashref;
 670     $sth->finish;
 671     $sth = $dbh->prepare(
 672         "Select sum(amountoutstanding) from accountlines where
 673     borrowernumber='$bornum'"
 674     );
 675     $sth->execute;
 676     my $data3 = $sth->fetchrow_hashref;
 677     $sth->finish;
 678
 679     return ( $data2->{'count(*)'}, $data->{'count(*)'},
 680         $data3->{'sum(amountoutstanding)'} );
 681 }
 682
 683 sub modmember {
 684         my (%data) = @_;
 685         my $dbh = C4::Context->dbh;
 686         $data{'dateofbirth'}=format_date_in_iso($data{'dateofbirth'});
 687
 688
 689         $data{'joining'}=format_date_in_iso($data{'joining'});
 690
 691         if ($data{'expiry'} eq '') {
 692
 693                 my $sth = $dbh->prepare("select enrolmentperiod from categories where categorycode=?");
 694                 $sth->execute($data{'categorycode'});
 695                 my ($enrolmentperiod) = $sth->fetchrow;
 696                 $enrolmentperiod = 12 unless ($enrolmentperiod);
 697                 $data{'expiry'} = &DateCalc($data{'joining'},"$enrolmentperiod years");
 698         }
 699         $data{'expiry'}=format_date_in_iso($data{'expiry'});
 700         my $query= "UPDATE borrowers SET
 701                                         cardnumber              = '$data{'cardnumber'}'         ,
 702                                         surname                 = '$data{'surname'}'            ,
 703                                         firstname               = '$data{'firstname'}'          ,
 704                                         title                   = '$data{'title'}'                      ,
 705                                         initials                = '$data{'initials'}'           ,
 706                                         dateofbirth             = '$data{'dateofbirth'}'        ,
 707                                         sex                             = '$data{'sex'}'                        ,
 708                                         streetaddress   = '$data{'streetaddress'}'      ,
 709                                         streetcity              = '$data{'streetcity'}'         ,
 710                                         zipcode                 = '$data{'zipcode'}'            ,
 711                                         phoneday                = '$data{'phoneday'}'           ,
 712                                         physstreet              = '$data{'physstreet'}'         ,
 713                                         city                    = '$data{'city'}'                       ,
 714                                         homezipcode             = '$data{'homezipcode'}'        ,
 715                                         phone                   = '$data{'phone'}'                      ,
 716                                         emailaddress    = '$data{'emailaddress'}'       ,
 717                                         faxnumber               = '$data{'faxnumber'}'          ,
 718                                         textmessaging   = '$data{'textmessaging'}'      ,
 719                                         categorycode    = '$data{'categorycode'}'       ,
 720                                         branchcode              = '$data{'branchcode'}'         ,
 721                                         borrowernotes   = '$data{'borrowernotes'}'      ,
 722                                         ethnicity               = '$data{'ethnicity'}'          ,
 723                                         ethnotes                = '$data{'ethnotes'}'           ,
 724                                         expiry                  = '$data{'expiry'}'                     ,
 725                                         dateenrolled    = '$data{'joining'}'            ,
 726                                         sort1                   = '$data{'sort1'}'                      ,
 727                                         sort2                   = '$data{'sort2'}'                      ,
 728                                         debarred                = '$data{'debarred'}'           ,
 729                                         lost                    = '$data{'lost'}'                       ,
 730                                         gonenoaddress   = '$data{'gna'}'
 731                         WHERE borrowernumber = $data{'borrowernumber'}";
 732         my $sth = $dbh->prepare($query);
 733         $sth->execute;
 734         $sth->finish;
 735         # ok if its an adult (type) it may have borrowers that depend on it as a guarantor
 736         # so when we update information for an adult we should check for guarantees and update the relevant part
 737         # of their records, ie addresses and phone numbers
 738         if ($data{'categorycode'} eq 'A' || $data{'categorycode'} eq 'W'){
 739                 # is adult check guarantees;
 740                 updateguarantees(%data);
 741         }
 742 }
 743
 744 sub newmember {
 745         my (%data) = @_;
 746         my $dbh = C4::Context->dbh;
 747         $data{'dateofbirth'}=format_date_in_iso($data{'dateofbirth'});
 748         $data{'joining'} = &ParseDate("today") unless $data{'joining'};
 749         $data{'joining'}=format_date_in_iso($data{'joining'});
 750         # if expirydate is not set, calculate it from borrower category subscription duration
 751         unless ($data{'expiry'}) {
 752                 my $sth = $dbh->prepare("select enrolmentperiod from categories where categorycode=?");
 753                 $sth->execute($data{'categorycode'});
 754                 my ($enrolmentperiod) = $sth->fetchrow;
 755                 $enrolmentperiod = 12 unless ($enrolmentperiod);
 756                 $data{'expiry'} = &DateCalc($data{'joining'},"$enrolmentperiod years");
 757         }
 758         $data{'expiry'}=format_date_in_iso($data{'expiry'});
 759         my $query= "INSERT INTO borrowers (
 760                                                         cardnumber,
 761                                                         surname,
 762                                                         firstname,
 763                                                         title,
 764                                                         initials,
 765                                                         dateofbirth,
 766                                                         sex,
 767                                                         streetaddress,
 768                                                         streetcity,
 769                                                         zipcode,
 770                                                         phoneday,
 771                                                         physstreet,
 772                                                         city,
 773                                                         homezipcode,
 774                                                         phone,
 775                                                         emailaddress,
 776                                                         faxnumber,
 777                                                         textmessaging,
 778                                                         categorycode,
 779                                                         branchcode,
 780                                                         borrowernotes,
 781                                                         ethnicity,
 782                                                         ethnotes,
 783                                                         expiry,
 784                                                         dateenrolled,
 785                                                         sort1,
 786                                                         sort2
 787                                                                 )
 788                                 VALUES (
 789                                                         '$data{'cardnumber'}',
 790                                                         '$data{'surname'}',
 791                                                         '$data{'firstname'}',
 792                                                         '$data{'title'}',
 793                                                         '$data{'initials'}',
 794                                                         '$data{'dateofbirth'}',
 795                                                         '$data{'sex'}',
 796
 797                                                         '$data{'streetaddress'}',
 798                                                         '$data{'streetcity'}',
 799                                                         '$data{'zipcode'}',
 800                                                         '$data{'phoneday'}',
 801
 802                                                         '$data{'physstreet'}',
 803                                                         '$data{'city'}',
 804                                                         '$data{'homezipcode'}',
 805                                                         '$data{'phone'}',
 806
 807                                                         '$data{'emailaddress'}',
 808                                                         '$data{'faxnumber'}',
 809                                                         '$data{'textmessaging'}',
 810
 811                                                         '$data{'categorycode'}',
 812                                                         '$data{'branchcode'}',
 813                                                         '$data{'borrowernotes'}',
 814                                                         '$data{'ethnicity'}',
 815                                                         '$data{'ethnotes'}',
 816                                                         '$data{'expiry'}',
 817                                                         '$data{'joining'}',
 818                                                         '$data{'sort1'}',
 819                                                         '$data{'sort2'}'
 820                                                         )";
 821         my $sth=$dbh->prepare($query);
 822         $sth->execute;
 823         $sth->finish;
 824         $data{'bornum'} =$dbh->{'mysql_insertid'};
 825         return $data{'bornum'};
 826 }
 827
 828 sub calcexpirydate {
 829     my ( $categorycode, $dateenrolled ) = @_;
 830     my $dbh = C4::Context->dbh;
 831     my $sth =
 832       $dbh->prepare(
 833         "select enrolmentperiod from categories where categorycode=?");
 834     $sth->execute($categorycode);
 835     my ($enrolmentperiod) = $sth->fetchrow;
 836     $enrolmentperiod = 12 unless ($enrolmentperiod);
 837     return format_date_in_iso(
 838         &DateCalc( $dateenrolled, "$enrolmentperiod months" ) );
 839 }
 840
 841 =head2 checkuserpassword (OUEST-PROVENCE)
 842
 843 check for the password and login are not used
 844 return the number of record
 845 0=> NOT USED 1=> USED
 846
 847 =cut
 848
 849 sub checkuserpassword {
 850     my ( $borrowernumber, $userid, $password ) = @_;
 851     $password = md5_base64($password);
 852     my $dbh = C4::Context->dbh;
 853     my $sth =
 854       $dbh->prepare(
 855 "Select count(*) from borrowers where borrowernumber !=? and userid =? and password=? "
 856       );
 857     $sth->execute( $borrowernumber, $userid, $password );
 858     my $number_rows = $sth->fetchrow;
 859     return $number_rows;
 860
 861 }
 862 sub getmemberfromuserid {
 863     my ($userid) = @_;
 864     my $dbh      = C4::Context->dbh;
 865     my $sth      = $dbh->prepare("select * from borrowers where userid=?");
 866     $sth->execute($userid);
 867     return $sth->fetchrow_hashref;
 868 }
 869 sub updateguarantees {
 870     my (%data) = @_;
 871     my $dbh = C4::Context->dbh;
 872     my ( $count, $guarantees ) = findguarantees( $data{'borrowernumber'} );
 873     for ( my $i = 0 ; $i < $count ; $i++ ) {
 874
 875         # FIXME
 876         # It looks like the $i is only being returned to handle walking through
 877         # the array, which is probably better done as a foreach loop.
 878         #
 879         my $guaquery =
 880 "update borrowers set streetaddress='$data{'address'}',faxnumber='$data{'faxnumber'}',
 881                 streetcity='$data{'streetcity'}',phoneday='$data{'phoneday'}',city='$data{'city'}',area='$data{'area'}',phone='$data{'phone'}'
 882                 ,streetaddress='$data{'address'}'
 883                 where borrowernumber='$guarantees->[$i]->{'borrowernumber'}'";
 884         my $sth3 = $dbh->prepare($guaquery);
 885         $sth3->execute;
 886         $sth3->finish;
 887     }
 888 }
 889 ################################################################################
 890
 891 =item fixup_cardnumber
 892
 893 Warning: The caller is responsible for locking the members table in write
 894 mode, to avoid database corruption.
 895
 896 =cut
 897
 898 use vars qw( @weightings );
 899 my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
 900
 901 sub fixup_cardnumber ($) {
 902     my ($cardnumber) = @_;
 903     my $autonumber_members = C4::Context->boolean_preference('autoMemberNum');
 904     $autonumber_members = 0 unless defined $autonumber_members;
 905 my $rem;
 906     # Find out whether member numbers should be generated
 907     # automatically. Should be either "1" or something else.
 908     # Defaults to "0", which is interpreted as "no".
 909
 910     #     if ($cardnumber !~ /\S/ && $autonumber_members) {
 911     if ($autonumber_members) {
 912         my $dbh = C4::Context->dbh;
 913         if ( C4::Context->preference('checkdigit') eq 'katipo' ) {
 914
 915             # if checkdigit is selected, calculate katipo-style cardnumber.
 916             # otherwise, just use the max()
 917             # purpose: generate checksum'd member numbers.
 918             # We'll assume we just got the max value of digits 2-8 of member #'s
 919             # from the database and our job is to increment that by one,
 920             # determine the 1st and 9th digits and return the full string.
 921             my $sth =
 922               $dbh->prepare(
 923                 "select max(substring(borrowers.cardnumber,2,7)) from borrowers"
 924               );
 925             $sth->execute;
 926
 927             my $data = $sth->fetchrow_hashref;
 928             $cardnumber = $data->{'max(substring(borrowers.cardnumber,2,7))'};
 929             $sth->finish;
 930
 931                 if ( !$cardnumber ) {    # If DB has no values,
 932                 $cardnumber = 1000000;    # start at 1000000
 933                 } else {
 934                 $cardnumber += 1;
 935                 }
 936
 937             my $sum = 0;
 938                     for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
 939
 940                 # read weightings, left to right, 1 char at a time
 941                 my $temp1 = $weightings[$i];
 942
 943                 # sequence left to right, 1 char at a time
 944                 my $temp2 = substr( $cardnumber, $i, 1 );
 945
 946                 # mult each char 1-7 by its corresponding weighting
 947                 $sum += $temp1 * $temp2;
 948                     }
 949
 950              $rem = ( $sum % 11 );
 951             $rem = 'X' if $rem == 10;
 952
 953             $cardnumber = "V$cardnumber$rem";
 954         }
 955         else {
 956
 957      # MODIFIED BY JF: mysql4.1 allows casting as an integer, which is probably
 958      # better. I'll leave the original in in case it needs to be changed for you
 959             my $sth =
 960               $dbh->prepare(
 961                 "select max(cast(cardnumber as signed)) from borrowers");
 962
 963       #my $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers");
 964
 965             $sth->execute;
 966
 967         $cardnumber="V$cardnumber$rem";
 968     }
 969     return $cardnumber;
 970 }
 971 }
 972 sub fixupneu_cardnumber{
 973     my($cardnumber,$categorycode) = @_;
 974     my $autonumber_members = C4::Context->boolean_preference('autoMemberNum');
 975     $autonumber_members = 0 unless defined $autonumber_members;
 976     # Find out whether member numbers should be generated
 977     # automatically. Should be either "1" or something else.
 978     # Defaults to "0", which is interpreted as "no".
 979 my $dbh = C4::Context->dbh;
 980 my $sth;
 981     if (! $cardnumber  && $autonumber_members && $categorycode) {
 982         if ($categorycode eq "A" || $categorycode eq "W" ){
 983          $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers where borrowers.cardnumber like '5%' ");
 984         }elsif ($categorycode eq "L"){
 985          $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers where borrowers.cardnumber like '10%' ");
 986         }elsif ($categorycode eq "F" || $categorycode eq "E")   {
 987          $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers where borrowers.cardnumber like '30%' ");
 988         }elsif ($categorycode eq "N"){
 989          $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers where borrowers.cardnumber like '40%' ");
 990         }elsif ($categorycode eq "C"){
 991          $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers where borrowers.cardnumber like '80%' ");
 992
 993         }else{
 994          $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers where borrowers.cardnumber like '6%' ");
 995         }
 996         $sth->execute;
 997
 998         my $data=$sth->fetchrow_hashref;
 999         $cardnumber=$data->{'max(borrowers.cardnumber)'};
1000         $sth->finish;
1001
1002         # purpose: generate checksum'd member numbers.
1003         # We'll assume we just got the max value of digits 2-8 of member #'s
1004         # from the database and our job is to increment that by one,
1005         # determine the 1st and 9th digits and return the full string.
1006
1007         if (! $cardnumber) {                    # If DB has no values,
1008          if ($categorycode eq "A" || $categorycode eq "W" ){   $cardnumber = 5000000;}
1009          elsif ($categorycode eq "L"){   $cardnumber = 1000000;}
1010          elsif ($categorycode  eq "F"){   $cardnumber = 3000000;}
1011         elsif ($categorycode  eq "C"){   $cardnumber = 8000000;}
1012         else{$cardnumber = 6000000;}
1013         # start at 1000000 or 3000000 or 5000000
1014         } else {
1015             $cardnumber += 1;
1016         }
1017
1018
1019     }
1020     return $cardnumber;
1021 }
1022
1023 =item GuarantornameSearch
1024
1025   ($count, $borrowers) = &GuarantornameSearch($env, $searchstring, $type);
1026
1027 Looks up guarantor  by name.
1028
1029 C<$env> is ignored.
1030
1031 BUGFIX 499: C<$type> is now used to determine type of search.
1032 if $type is "simple", search is performed on the first letter of the
1033 surname only.
1034
1035 C<$searchstring> is a space-separated list of search terms. Each term
1036 must match the beginning a borrower's surname, first name, or other
1037 name.
1038
1039 C<&GuarantornameSearch> returns a two-element list. C<$borrowers> is a
1040 reference-to-array; each element is a reference-to-hash, whose keys
1041 are the fields of the C<borrowers> table in the Koha database.
1042 C<$count> is the number of elements in C<$borrowers>.
1043
1044 return all info from guarantor =>only category_type A
1045
1046 =cut
1047
1048 #'
1049 #used by member enquiries from the intranet
1050 #called by guarantor_search.pl
1051 sub GuarantornameSearch {
1052     my ( $env, $searchstring, $orderby, $type ) = @_;
1053     my $dbh   = C4::Context->dbh;
1054     my $query = "";
1055     my $count;
1056     my @data;
1057     my @bind = ();
1058
1059     if ( $type eq "simple" )    # simple search for one letter only
1060     {
1061         $query =
1062 "Select * from borrowers,categories  where borrowers.categorycode=categories.categorycode and category_type='A'  and  surname like ? order by $orderby";
1063         @bind = ("$searchstring%");
1064     }
1065     else    # advanced search looking in surname, firstname and othernames
1066     {
1067         @data  = split( ' ', $searchstring );
1068         $count = @data;
1069         $query = "Select * from borrowers,categories
1070                 where ((surname like ? or surname like ?
1071                 or firstname  like ? or firstname like ?
1072                 or othernames like ? or othernames like ?) and borrowers.categorycode=categories.categorycode and category_type='A'
1073                 ";
1074         @bind = (
1075             "$data[0]%", "% $data[0]%", "$data[0]%", "% $data[0]%",
1076             "$data[0]%", "% $data[0]%"
1077         );
1078         for ( my $i = 1 ; $i < $count ; $i++ ) {
1079             $query = $query . " and (" . " surname like ? or surname like ?
1080                         or firstname  like ? or firstname like ?
1081                         or othernames like ? or othernames like ?)";
1082             push( @bind,
1083                 "$data[$i]%",   "% $data[$i]%", "$data[$i]%",
1084                 "% $data[$i]%", "$data[$i]%",   "% $data[$i]%" );
1085
1086             # FIXME - .= <<EOT;
1087         }
1088         $query = $query . ") or cardnumber like ?
1089                 order by $orderby";
1090         push( @bind, $searchstring );
1091
1092         # FIXME - .= <<EOT;
1093     }
1094
1095     my $sth = $dbh->prepare($query);
1096     $sth->execute(@bind);
1097     my @results;
1098     my $cnt = $sth->rows;
1099     while ( my $data = $sth->fetchrow_hashref ) {
1100         push( @results, $data );
1101     }
1102
1103     #  $sth->execute;
1104     $sth->finish;
1105     return ( $cnt, \@results );
1106 }
1107
1108
1109 =item findguarantees
1110
1111   ($num_children, $children_arrayref) = &findguarantees($parent_borrno);
1112   $child0_cardno = $children_arrayref->[0]{"cardnumber"};
1113   $child0_borrno = $children_arrayref->[0]{"borrowernumber"};
1114
1115 C<&findguarantees> takes a borrower number (e.g., that of a patron
1116 with children) and looks up the borrowers who are guaranteed by that
1117 borrower (i.e., the patron's children).
1118
1119 C<&findguarantees> returns two values: an integer giving the number of
1120 borrowers guaranteed by C<$parent_borrno>, and a reference to an array
1121 of references to hash, which gives the actual results.
1122
1123 =cut
1124 #'
1125 sub findguarantees{
1126   my ($bornum)=@_;
1127   my $dbh = C4::Context->dbh;
1128   my $sth=$dbh->prepare("select cardnumber,borrowernumber, firstname, surname from borrowers where guarantor=?");
1129   $sth->execute($bornum);
1130
1131   my @dat;
1132   while (my $data = $sth->fetchrow_hashref)
1133   {
1134     push @dat, $data;
1135   }
1136   $sth->finish;
1137   return (scalar(@dat), \@dat);
1138 }
1139
1140 =item findguarantor
1141
1142   $guarantor = &findguarantor($borrower_no);
1143   $guarantor_cardno = $guarantor->{"cardnumber"};
1144   $guarantor_surname = $guarantor->{"surname"};
1145   ...
1146
1147 C<&findguarantor> takes a borrower number (presumably that of a child
1148 patron), finds the guarantor for C<$borrower_no> (the child's parent),
1149 and returns the record for the guarantor.
1150
1151 C<&findguarantor> returns a reference-to-hash. Its keys are the fields
1152 from the C<borrowers> database table;
1153
1154 =cut
1155 #'
1156 sub findguarantor{
1157   my ($bornum)=@_;
1158   my $dbh = C4::Context->dbh;
1159   my $sth=$dbh->prepare("select guarantor from borrowers where borrowernumber=?");
1160   $sth->execute($bornum);
1161   my $data=$sth->fetchrow_hashref;
1162   $sth->finish;
1163   $sth=$dbh->prepare("Select * from borrowers where borrowernumber=?");
1164   $sth->execute($data->{'guarantor'});
1165   $data=$sth->fetchrow_hashref;
1166   $sth->finish;
1167   return($data);
1168 }
1169
1170 sub borrowercard_active {
1171         my ($bornum) = @_;
1172         my $dbh = C4::Context->dbh;
1173         my $sth = $dbh->prepare("SELECT expiry FROM borrowers WHERE (borrowernumber = ?) AND (NOW() <= expiry)");
1174         $sth->execute($bornum);
1175         if (my $data=$sth->fetchrow_hashref){
1176         return ('1');
1177         }else{
1178         return ('0');
1179         }
1180 }
1181
1182 # Search the member photo, in case that photo doesn´t exists, return a default photo.for NEU
1183 sub getMemberPhoto {
1184         my $cardnumber = shift @_;
1185  my $htdocs = C4::Context->config('opacdir');
1186 my $dirname = $htdocs."/htdocs/uploaded-files/users-photo/";
1187 #       my $dirname = "$ENV{'DOCUMENT_ROOT'}/uploaded-files/users-photo";
1188         opendir(DIR, $dirname) or die "Can't open directory $dirname: $!";
1189         while (defined(my $file = readdir(DIR))) {
1190            if ($file =~ /^$cardnumber\..+/){
1191                    return "/uploaded-files/users-photo/$file";
1192            }
1193         }
1194         closedir(DIR);
1195         return "http://cc.neu.edu.tr/stdpictures/".$cardnumber.".jpg";
1196 }
1197
1198 sub change_user_pass {
1199         my ($uid,$member,$digest) = @_;
1200         my $dbh = C4::Context->dbh;
1201         #Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
1202         #Then we need to tell the user and have them create a new one.
1203         my $sth=$dbh->prepare("select * from borrowers where userid=? and borrowernumber <> ?");
1204         $sth->execute($uid,$member);
1205         if ( ($uid ne '') && ($sth->fetchrow) ) {
1206
1207                 return 0;
1208     } else {
1209                 #Everything is good so we can update the information.
1210                 $sth=$dbh->prepare("update borrowers set userid=?, password=? where borrowernumber=?");
1211                 $sth->execute($uid, $digest, $member);
1212                 return 1;
1213         }
1214 =head2 checkuniquemember (OUEST-PROVENCE)
1215
1216   $result = &checkuniquemember($collectivity,$surname,$categorycode,$firstname,$dateofbirth);
1217
1218 Checks that a member exists or not in the database.
1219
1220 C<&result> is 1 (=exist) or 0 (=does not exist)
1221 C<&collectivity> is 1 (= we add a collectivity) or 0 (= we add a physical member)
1222 C<&surname> is the surname
1223 C<&categorycode> is from categorycode table
1224 C<&firstname> is the firstname (only if collectivity=0)
1225 C<&dateofbirth> is the date of birth (only if collectivity=0)
1226
1227 =cut
1228
1229 sub checkuniquemember {
1230     my ( $collectivity, $surname, $firstname, $dateofbirth ) = @_;
1231     my $dbh = C4::Context->dbh;
1232     my $request;
1233     if ($collectivity) {
1234
1235 #                               $request="select count(*) from borrowers where surname=? and categorycode=?";
1236         $request =
1237           "select borrowernumber,categorycode from borrowers where surname=? ";
1238     }
1239     else {
1240
1241 #                               $request="select count(*) from borrowers where surname=? and categorycode=? and firstname=? and dateofbirth=?";
1242         $request =
1243 "select borrowernumber,categorycode from borrowers where surname=?  and firstname=? and dateofbirth=?";
1244     }
1245     my $sth = $dbh->prepare($request);
1246     if ($collectivity) {
1247         $sth->execute( uc($surname) );
1248     }
1249     else {
1250         $sth->execute( uc($surname), ucfirst($firstname), $dateofbirth );
1251     }
1252     my @data = $sth->fetchrow;
1253     if ( $data[0] ) {
1254         $sth->finish;
1255         return $data[0], $data[1];
1256
1257         #
1258     }
1259     else {
1260         $sth->finish;
1261         return 0;
1262     }
1263 }
1264 =head2 getzipnamecity (OUEST-PROVENCE)
1265
1266 take all info from table city for the fields city and  zip
1267 check for the name and the zip code of the city selected
1268
1269 =cut
1270
1271 sub getzipnamecity {
1272     my ($cityid) = @_;
1273     my $dbh      = C4::Context->dbh;
1274     my $sth      =
1275       $dbh->prepare(
1276         "select city_name,city_zipcode from cities where cityid=? ");
1277     $sth->execute($cityid);
1278     my @data = $sth->fetchrow;
1279     return $data[0], $data[1];
1280 }
1281
1282 =head2 updatechildguarantor (OUEST-PROVENCE)
1283
1284 check for title,firstname,surname,adress,zip code and city  from guarantor to
1285 guarantorchild
1286
1287 =cut
1288
1289 #'
1290
1291 sub getguarantordata {
1292     my ($borrowerid) = @_;
1293     my $dbh          = C4::Context->dbh;
1294     my $sth          =
1295       $dbh->prepare(
1296 "Select title,firstname,surname,streetnumber,address,streettype,address2,zipcode,city,phone,phonepro,mobile,email,emailpro,fax  from borrowers where borrowernumber =? "
1297       );
1298     $sth->execute($borrowerid);
1299     my $guarantor_data = $sth->fetchrow_hashref;
1300     $sth->finish;
1301     return $guarantor_data;
1302 }
1303
1304 =head2 getdcity (OUEST-PROVENCE)
1305 recover cityid  with city_name condition
1306 =cut
1307
1308 sub getidcity {
1309     my ($city_name) = @_;
1310     my $dbh = C4::Context->dbh;
1311     my $sth = $dbh->prepare("select cityid from cities where city_name=? ");
1312     $sth->execute($city_name);
1313     my $data = $sth->fetchrow;
1314     return $data;
1315 }
1316
1317 =head2 getcategorytype (OUEST-PROVENCE)
1318
1319 check for the category_type with categorycode
1320 and return the category_type
1321
1322 =cut
1323
1324 sub getcategorytype {
1325     my ($categorycode) = @_;
1326     my $dbh            = C4::Context->dbh;
1327     my $sth            =
1328       $dbh->prepare(
1329 "Select category_type,description from categories where categorycode=?  "
1330       );
1331     $sth->execute($categorycode);
1332     my ( $category_type, $description ) = $sth->fetchrow;
1333     return $category_type, $description;
1334 }
1335 }
1336
1337
1338
1339
1340
1341
1342 # # A better approach might be to set borrowernumber autoincrement and
1343 #
1344  sub NewBorrowerNumber {
1345    my $dbh = C4::Context->dbh;
1346    my $sth=$dbh->prepare("Select max(borrowernumber) from borrowers");
1347    $sth->execute;
1348    my $data=$sth->fetchrow_hashref;
1349    $sth->finish;
1350    $data->{'max(borrowernumber)'}++;
1351    return($data->{'max(borrowernumber)'});
1352  }
1353
1354 =head2 ethnicitycategories
1355
1356   ($codes_arrayref, $labels_hashref) = &ethnicitycategories();
1357
1358 Looks up the different ethnic types in the database. Returns two
1359 elements: a reference-to-array, which lists the ethnicity codes, and a
1360 reference-to-hash, which maps the ethnicity codes to ethnicity
1361 descriptions.
1362
1363 =cut
1364
1365 #'
1366
1367 sub ethnicitycategories {
1368     my $dbh = C4::Context->dbh;
1369     my $sth = $dbh->prepare("Select code,name from ethnicity order by name");
1370     $sth->execute;
1371     my %labels;
1372     my @codes;
1373     while ( my $data = $sth->fetchrow_hashref ) {
1374         push @codes, $data->{'code'};
1375         $labels{ $data->{'code'} } = $data->{'name'};
1376     }
1377     $sth->finish;
1378     return ( \@codes, \%labels );
1379 }
1380
1381 =head2 fixEthnicity
1382
1383   $ethn_name = &fixEthnicity($ethn_code);
1384
1385 Takes an ethnicity code (e.g., "european" or "pi") and returns the
1386 corresponding descriptive name from the C<ethnicity> table in the
1387 Koha database ("European" or "Pacific Islander").
1388
1389 =cut
1390
1391 #'
1392
1393 sub fixEthnicity($) {
1394
1395     my $ethnicity = shift;
1396     my $dbh       = C4::Context->dbh;
1397     my $sth       = $dbh->prepare("Select name from ethnicity where code = ?");
1398     $sth->execute($ethnicity);
1399     my $data = $sth->fetchrow_hashref;
1400     $sth->finish;
1401     return $data->{'name'};
1402 }    # sub fixEthnicity
1403
1404
1405
1406 =head2 get_age
1407
1408   $dateofbirth,$date = &get_age($date);
1409
1410 this function return the borrowers age with the value of dateofbirth
1411
1412 =cut
1413 #'
1414 sub get_age {
1415     my ($date, $date_ref) = @_;
1416
1417     if (not defined $date_ref) {
1418         $date_ref = sprintf('%04d-%02d-%02d', Today());
1419     }
1420
1421     my ($year1, $month1, $day1) = split /-/, $date;
1422     my ($year2, $month2, $day2) = split /-/, $date_ref;
1423
1424     my $age = $year2 - $year1;
1425     if ($month1.$day1 > $month2.$day2) {
1426         $age--;
1427     }
1428
1429     return $age;
1430 }# sub get_age
1431
1432
1433
1434 =head2 get_institutions
1435   $insitutions = get_institutions();
1436
1437 Just returns a list of all the borrowers of type I, borrownumber and name
1438 =cut
1439
1440 #'
1441 sub get_institutions {
1442     my $dbh = C4::Context->dbh();
1443     my $sth =
1444       $dbh->prepare(
1445 "SELECT borrowernumber,surname FROM borrowers WHERE categorycode=? ORDER BY surname"
1446       );
1447     $sth->execute('I');
1448     my %orgs;
1449     while ( my $data = $sth->fetchrow_hashref() ) {
1450         $orgs{ $data->{'borrowernumber'} } = $data;
1451     }
1452     $sth->finish();
1453     return ( \%orgs );
1454
1455 }    # sub get_institutions
1456
1457 =head2 add_member_orgs
1458
1459   add_member_orgs($borrowernumber,$borrowernumbers);
1460
1461 Takes a borrowernumber and a list of other borrowernumbers and inserts them into the borrowers_to_borrowers table
1462
1463 =cut
1464
1465 #'
1466 sub add_member_orgs {
1467     my ( $borrowernumber, $otherborrowers ) = @_;
1468     my $dbh   = C4::Context->dbh();
1469     my $query =
1470       "INSERT INTO borrowers_to_borrowers (borrower1,borrower2) VALUES (?,?)";
1471     my $sth = $dbh->prepare($query);
1472     foreach my $bornum (@$otherborrowers) {
1473         $sth->execute( $borrowernumber, $bornum );
1474     }
1475     $sth->finish();
1476
1477 }    # sub add_member_orgs
1478
1479 =head2 GetBorrowersFromSurname
1480
1481 =over 4
1482
1483 \@resutlts = GetBorrowersFromSurname($surname)
1484 this function get the list of borrower names like $surname.
1485 return :
1486 the table of results in @results
1487
1488 =back
1489
1490 =cut
1491 sub GetBorrowersFromSurname  {
1492     my ($searchstring)=@_;
1493     my $dbh = C4::Context->dbh;
1494     $searchstring=~ s/\'/\\\'/g;
1495     my @data=split(' ',$searchstring);
1496     my $count=@data;
1497     my $query = qq|
1498         SELECT   surname,firstname
1499         FROM     borrowers
1500         WHERE    (surname like ?)
1501         ORDER BY surname
1502     |;
1503     my $sth=$dbh->prepare($query);
1504     $sth->execute("$data[0]%");
1505     my @results;
1506     my $count = 0;
1507     while (my $data=$sth->fetchrow_hashref){
1508          push(@results,$data);
1509          $count++;
1510     }
1511      $sth->finish;
1512      return ($count,\@results);
1513 }
1514
1515 =head2 expand_sex_into_predicate
1516
1517   $data{&expand_sex_into_predicate($data{sex})} = 1;
1518
1519 Converts a single 'M' or 'F' into 'sex_M_p' or 'sex_F_p'
1520 respectively.
1521
1522 In some languages, 'M' and 'F' are not appropriate. However,
1523 with HTML::Template, there is no way to localize 'M' or 'F'
1524 unless these are converted into variables that TMPL_IF can
1525 understand. This function provides this conversion.
1526
1527 =cut
1528
1529 sub expand_sex_into_predicate ($) {
1530    my($sex) = @_;
1531    return "sex_${sex}_p";
1532 } # expand_sex_into_predicate
1533 1;