C4/Members.pm

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