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