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     foreach (keys %data)
 588     {push @parameters,"$_ = ".$dbh->quote($data{$_}) if ($_ ne "borrowernumber" and $hashborrowerfields{$_} and $data{$_})} ;
 589
 590     # test to know if u must update or not the borrower password
 591     if ( $data{'password'} eq '****' ) {
 592
 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
 601         ( $data{'password'} = md5_base64( $data{'password'} ) )
 602           if ( $data{'password'} ne '' );
 603         $query = "UPDATE borrowers SET ".join (",",@parameters)." WHERE borrowernumber=$data{'borrowernumber'}";
 604 #         warn "$query";
 605         $sth = $dbh->prepare($query);
 606         $sth->execute;
 607     }
 608     $sth->finish;
 609
 610 # ok if its an adult (type) it may have borrowers that depend on it as a guarantor
 611 # so when we update information for an adult we should check for guarantees and update the relevant part
 612 # of their records, ie addresses and phone numbers
 613     my $borrowercategory= GetBorrowercategory( $data{'category_type'} );
 614     if ( $borrowercategory->{'category_type'} eq 'A' ) {
 615         # is adult check guarantees;
 616         UpdateGuarantees(%data);
 617
 618     }
 619     &logaction(C4::Context->userenv->{'number'},"MEMBERS","MODIFY",$data{'borrowernumber'},"")
 620         if C4::Context->preference("BorrowersLog");
 621 }
 622
 623
 624 =head2
 625
 626 =item AddMember
 627
 628   $borrowernumber = &AddMember(%borrower);
 629
 630 insert new borrower into table
 631 Returns the borrowernumber
 632
 633 =cut
 634
 635 #'
 636 sub AddMember {
 637     my (%data) = @_;
 638     my $dbh = C4::Context->dbh;
 639     $data{'userid'} = '' unless $data{'password'};
 640     $data{'password'} = md5_base64( $data{'password'} ) if $data{'password'};
 641     $data{'dateofbirth'} = format_date_in_iso( $data{'dateofbirth'} );
 642     $data{'dateenrolled'} = format_date_in_iso( $data{'dateenrolled'} );
 643     $data{'dateexpiry'}   = format_date_in_iso( $data{'dateexpiry'} );
 644     my $query =
 645         "insert into borrowers set cardnumber="
 646       . $dbh->quote( $data{'cardnumber'} )
 647       . ",surname="
 648       . $dbh->quote( $data{'surname'} )
 649       . ",firstname="
 650       . $dbh->quote( $data{'firstname'} )
 651       . ",title="
 652       . $dbh->quote( $data{'title'} )
 653       . ",othernames="
 654       . $dbh->quote( $data{'othernames'} )
 655       . ",initials="
 656       . $dbh->quote( $data{'initials'} )
 657       . ",streetnumber="
 658       . $dbh->quote( $data{'streetnumber'} )
 659       . ",streettype="
 660       . $dbh->quote( $data{'streettype'} )
 661       . ",address="
 662       . $dbh->quote( $data{'address'} )
 663       . ",address2="
 664       . $dbh->quote( $data{'address2'} )
 665       . ",zipcode="
 666       . $dbh->quote( $data{'zipcode'} )
 667       . ",city="
 668       . $dbh->quote( $data{'city'} )
 669       . ",phone="
 670       . $dbh->quote( $data{'phone'} )
 671       . ",email="
 672       . $dbh->quote( $data{'email'} )
 673       . ",mobile="
 674       . $dbh->quote( $data{'mobile'} )
 675       . ",phonepro="
 676       . $dbh->quote( $data{'phonepro'} )
 677       . ",opacnote="
 678       . $dbh->quote( $data{'opacnote'} )
 679       . ",guarantorid="
 680       . $dbh->quote( $data{'guarantorid'} )
 681       . ",dateofbirth="
 682       . $dbh->quote( $data{'dateofbirth'} )
 683       . ",branchcode="
 684       . $dbh->quote( $data{'branchcode'} )
 685       . ",categorycode="
 686       . $dbh->quote( $data{'categorycode'} )
 687       . ",dateenrolled="
 688       . $dbh->quote( $data{'dateenrolled'} )
 689       . ",contactname="
 690       . $dbh->quote( $data{'contactname'} )
 691       . ",borrowernotes="
 692       . $dbh->quote( $data{'borrowernotes'} )
 693       . ",dateexpiry="
 694       . $dbh->quote( $data{'dateexpiry'} )
 695       . ",contactnote="
 696       . $dbh->quote( $data{'contactnote'} )
 697       . ",B_address="
 698       . $dbh->quote( $data{'B_address'} )
 699       . ",B_zipcode="
 700       . $dbh->quote( $data{'B_zipcode'} )
 701       . ",B_city="
 702       . $dbh->quote( $data{'B_city'} )
 703       . ",B_phone="
 704       . $dbh->quote( $data{'B_phone'} )
 705       . ",B_email="
 706       . $dbh->quote( $data{'B_email'}, )
 707       . ",password="
 708       . $dbh->quote( $data{'password'} )
 709       . ",userid="
 710       . $dbh->quote( $data{'userid'} )
 711       . ",sort1="
 712       . $dbh->quote( $data{'sort1'} )
 713       . ",sort2="
 714       . $dbh->quote( $data{'sort2'} )
 715       . ",contacttitle="
 716       . $dbh->quote( $data{'contacttitle'} )
 717       . ",emailpro="
 718       . $dbh->quote( $data{'emailpro'} )
 719       . ",contactfirstname="
 720       . $dbh->quote( $data{'contactfirstname'} ) . ",sex="
 721       . $dbh->quote( $data{'sex'} ) . ",fax="
 722       . $dbh->quote( $data{'fax'} )
 723       . ",relationship="
 724       . $dbh->quote( $data{'relationship'} )
 725       . ",B_streetnumber="
 726       . $dbh->quote( $data{'B_streetnumber'} )
 727       . ",B_streettype="
 728       . $dbh->quote( $data{'B_streettype'} )
 729       . ",gonenoaddress="
 730       . $dbh->quote( $data{'gonenoaddress'} )
 731       . ",lost="
 732       . $dbh->quote( $data{'lost'} )
 733       . ",debarred="
 734       . $dbh->quote( $data{'debarred'} )
 735       . ",ethnicity="
 736       . $dbh->quote( $data{'ethnicity'} )
 737       . ",ethnotes="
 738       . $dbh->quote( $data{'ethnotes'} );
 739
 740     my $sth = $dbh->prepare($query);
 741     $sth->execute;
 742     $sth->finish;
 743     $data{'borrowernumber'} = $dbh->{'mysql_insertid'};
 744
 745     &logaction(C4::Context->userenv->{'number'},"MEMBERS","CREATE",$data{'borrowernumber'},"")
 746         if C4::Context->preference("BorrowersLog");
 747
 748     return $data{'borrowernumber'};
 749 }
 750
 751 sub changepassword {
 752     my ( $uid, $member, $digest ) = @_;
 753     my $dbh = C4::Context->dbh;
 754
 755 #Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
 756 #Then we need to tell the user and have them create a new one.
 757     my $sth =
 758       $dbh->prepare(
 759         "select * from borrowers where userid=? and borrowernumber != ?");
 760     $sth->execute( $uid, $member );
 761     if ( ( $uid ne '' ) && ( $sth->fetchrow ) ) {
 762         return 0;
 763     }
 764     else {
 765         #Everything is good so we can update the information.
 766         $sth =
 767           $dbh->prepare(
 768             "update borrowers set userid=?, password=? where borrowernumber=?");
 769         $sth->execute( $uid, $digest, $member );
 770         return 1;
 771     }
 772
 773     &logaction(C4::Context->userenv->{'number'},"MEMBERS","CHANGE PASS",$member,"")
 774         if C4::Context->preference("BorrowersLog");
 775 }
 776
 777
 778
 779 =item fixup_cardnumber
 780
 781 Warning: The caller is responsible for locking the members table in write
 782 mode, to avoid database corruption.
 783
 784 =cut
 785
 786 use vars qw( @weightings );
 787 my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
 788
 789 sub fixup_cardnumber ($) {
 790     my ($cardnumber) = @_;
 791     my $autonumber_members = C4::Context->boolean_preference('autoMemberNum');
 792     $autonumber_members = 0 unless defined $autonumber_members;
 793
 794     # Find out whether member numbers should be generated
 795     # automatically. Should be either "1" or something else.
 796     # Defaults to "0", which is interpreted as "no".
 797
 798     #     if ($cardnumber !~ /\S/ && $autonumber_members) {
 799     if ($autonumber_members) {
 800         my $dbh = C4::Context->dbh;
 801         if ( C4::Context->preference('checkdigit') eq 'katipo' ) {
 802
 803             # if checkdigit is selected, calculate katipo-style cardnumber.
 804             # otherwise, just use the max()
 805             # purpose: generate checksum'd member numbers.
 806             # We'll assume we just got the max value of digits 2-8 of member #'s
 807             # from the database and our job is to increment that by one,
 808             # determine the 1st and 9th digits and return the full string.
 809             my $sth =
 810               $dbh->prepare(
 811                 "select max(substring(borrowers.cardnumber,2,7)) from borrowers"
 812               );
 813             $sth->execute;
 814
 815             my $data = $sth->fetchrow_hashref;
 816             $cardnumber = $data->{'max(substring(borrowers.cardnumber,2,7))'};
 817             $sth->finish;
 818             if ( !$cardnumber ) {    # If DB has no values,
 819                 $cardnumber = 1000000;    # start at 1000000
 820             }
 821             else {
 822                 $cardnumber += 1;
 823             }
 824
 825             my $sum = 0;
 826             for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
 827
 828                 # read weightings, left to right, 1 char at a time
 829                 my $temp1 = $weightings[$i];
 830
 831                 # sequence left to right, 1 char at a time
 832                 my $temp2 = substr( $cardnumber, $i, 1 );
 833
 834                 # mult each char 1-7 by its corresponding weighting
 835                 $sum += $temp1 * $temp2;
 836             }
 837
 838             my $rem = ( $sum % 11 );
 839             $rem = 'X' if $rem == 10;
 840
 841             $cardnumber = "V$cardnumber$rem";
 842         }
 843         else {
 844
 845      # MODIFIED BY JF: mysql4.1 allows casting as an integer, which is probably
 846      # better. I'll leave the original in in case it needs to be changed for you
 847             my $sth =
 848               $dbh->prepare(
 849                 "select max(cast(cardnumber as signed)) from borrowers");
 850
 851       #my $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers");
 852
 853             $sth->execute;
 854
 855             my ($result) = $sth->fetchrow;
 856             $sth->finish;
 857             $cardnumber = $result + 1;
 858         }
 859     }
 860     return $cardnumber;
 861 }
 862
 863 =head2 GetGuarantees
 864
 865   ($num_children, $children_arrayref) = &GetGuarantees($parent_borrno);
 866   $child0_cardno = $children_arrayref->[0]{"cardnumber"};
 867   $child0_borrno = $children_arrayref->[0]{"borrowernumber"};
 868
 869 C<&GetGuarantees> takes a borrower number (e.g., that of a patron
 870 with children) and looks up the borrowers who are guaranteed by that
 871 borrower (i.e., the patron's children).
 872
 873 C<&GetGuarantees> returns two values: an integer giving the number of
 874 borrowers guaranteed by C<$parent_borrno>, and a reference to an array
 875 of references to hash, which gives the actual results.
 876
 877 =cut
 878
 879 #'
 880 sub GetGuarantees {
 881     my ($borrowernumber) = @_;
 882     my $dbh              = C4::Context->dbh;
 883     my $sth              =
 884       $dbh->prepare(
 885 "select cardnumber,borrowernumber, firstname, surname from borrowers where guarantorid=?"
 886       );
 887     $sth->execute($borrowernumber);
 888
 889     my @dat;
 890     my $data = $sth->fetchall_arrayref({});
 891     $sth->finish;
 892     return ( scalar(@$data), $data );
 893 }
 894
 895 =head2 UpdateGuarantees
 896
 897   &UpdateGuarantees($parent_borrno);
 898
 899
 900 C<&UpdateGuarantees> borrower data for an adulte and updates all the guarantees
 901 with the modified information
 902
 903 =cut
 904
 905 #'
 906 sub UpdateGuarantees {
 907     my (%data) = @_;
 908     my $dbh = C4::Context->dbh;
 909     my ( $count, $guarantees ) = GetGuarantees( $data{'borrowernumber'} );
 910     for ( my $i = 0 ; $i < $count ; $i++ ) {
 911
 912         # FIXME
 913         # It looks like the $i is only being returned to handle walking through
 914         # the array, which is probably better done as a foreach loop.
 915         #
 916         my $guaquery = qq|UPDATE borrowers
 917                           SET address='$data{'address'}',fax='$data{'fax'}',
 918                               B_city='$data{'B_city'}',mobile='$data{'mobile'}',city='$data{'city'}',phone='$data{'phone'}'
 919                           WHERE borrowernumber='$guarantees->[$i]->{'borrowernumber'}'
 920                 |;
 921         my $sth3 = $dbh->prepare($guaquery);
 922         $sth3->execute;
 923         $sth3->finish;
 924     }
 925 }
 926 =head2 GetPendingIssues
 927
 928   ($count, $issues) = &GetPendingIssues($borrowernumber);
 929
 930 Looks up what the patron with the given borrowernumber has borrowed.
 931
 932 C<&GetPendingIssues> returns a two-element array. C<$issues> is a
 933 reference-to-array, where each element is a reference-to-hash; the
 934 keys are the fields from the C<issues>, C<biblio>, and C<items> tables
 935 in the Koha database. C<$count> is the number of elements in
 936 C<$issues>.
 937
 938 =cut
 939
 940 #'
 941 sub GetPendingIssues {
 942     my ($borrowernumber) = @_;
 943     my $dbh              = C4::Context->dbh;
 944
 945     my $sth              = $dbh->prepare(
 946    "SELECT * FROM issues
 947       LEFT JOIN items ON issues.itemnumber=items.itemnumber
 948       LEFT JOIN biblio ON     items.biblionumber=biblio.biblionumber
 949       LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
 950     WHERE
 951       borrowernumber=?
 952       AND returndate IS NULL
 953     ORDER BY issues.date_due"
 954     );
 955     $sth->execute($borrowernumber);
 956     my $data = $sth->fetchall_arrayref({});
 957     my $today = POSIX::strftime("%Y%m%d", localtime);
 958     foreach( @$data ) {
 959         my $datedue = $_->{'date_due'};
 960         $datedue =~ s/-//g;
 961         if ( $datedue < $today ) {
 962             $_->{'overdue'} = 1;
 963         }
 964     }
 965     $sth->finish;
 966     return ( scalar(@$data), $data );
 967 }
 968
 969 =head2 GetAllIssues
 970
 971   ($count, $issues) = &GetAllIssues($borrowernumber, $sortkey, $limit);
 972
 973 Looks up what the patron with the given borrowernumber has borrowed,
 974 and sorts the results.
 975
 976 C<$sortkey> is the name of a field on which to sort the results. This
 977 should be the name of a field in the C<issues>, C<biblio>,
 978 C<biblioitems>, or C<items> table in the Koha database.
 979
 980 C<$limit> is the maximum number of results to return.
 981
 982 C<&GetAllIssues> returns a two-element array. C<$issues> is a
 983 reference-to-array, where each element is a reference-to-hash; the
 984 keys are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
 985 C<items> tables of the Koha database. C<$count> is the number of
 986 elements in C<$issues>
 987
 988 =cut
 989
 990 #'
 991 sub GetAllIssues {
 992     my ( $borrowernumber, $order, $limit ) = @_;
 993
 994     #FIXME: sanity-check order and limit
 995     my $dbh   = C4::Context->dbh;
 996     my $count = 0;
 997     my $query =
 998 "Select *,items.timestamp AS itemstimestamp from issues,biblio,items,biblioitems
 999   where borrowernumber=? and
1000   items.biblioitemnumber=biblioitems.biblioitemnumber and
1001   items.itemnumber=issues.itemnumber and
1002   items.biblionumber=biblio.biblionumber order by $order";
1003     if ( $limit != 0 ) {
1004         $query .= " limit $limit";
1005     }
1006
1007     #print $query;
1008     my $sth = $dbh->prepare($query);
1009     $sth->execute($borrowernumber);
1010     my @result;
1011     my $i = 0;
1012     while ( my $data = $sth->fetchrow_hashref ) {
1013         $result[$i] = $data;
1014         $i++;
1015         $count++;
1016     }
1017
1018     # get all issued items for borrowernumber from oldissues table
1019     # large chunk of older issues data put into table oldissues
1020     # to speed up db calls for issuing items
1021     if ( C4::Context->preference("ReadingHistory") ) {
1022         my $query2 = "SELECT * FROM oldissues,biblio,items,biblioitems
1023                       WHERE borrowernumber=?
1024                       AND items.biblioitemnumber=biblioitems.biblioitemnumber
1025                       AND items.itemnumber=oldissues.itemnumber
1026                       AND items.biblionumber=biblio.biblionumber
1027                       ORDER BY $order";
1028         if ( $limit != 0 ) {
1029             $limit = $limit - $count;
1030             $query2 .= " limit $limit";
1031         }
1032
1033         my $sth2 = $dbh->prepare($query2);
1034         $sth2->execute($borrowernumber);
1035
1036         while ( my $data2 = $sth2->fetchrow_hashref ) {
1037             $result[$i] = $data2;
1038             $i++;
1039         }
1040         $sth2->finish;
1041     }
1042     $sth->finish;
1043
1044     return ( $i, \@result );
1045 }
1046
1047
1048 =head2 GetMemberAccountRecords
1049
1050   ($total, $acctlines, $count) = &GetMemberAccountRecords($borrowernumber);
1051
1052 Looks up accounting data for the patron with the given borrowernumber.
1053
1054 C<&GetMemberAccountRecords> returns a three-element array. C<$acctlines> is a
1055 reference-to-array, where each element is a reference-to-hash; the
1056 keys are the fields of the C<accountlines> table in the Koha database.
1057 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1058 total amount outstanding for all of the account lines.
1059
1060 =cut
1061
1062 #'
1063 sub GetMemberAccountRecords {
1064     my ($borrowernumber,$date) = @_;
1065     my $dbh = C4::Context->dbh;
1066     my @acctlines;
1067     my $numlines = 0;
1068     my $strsth      = qq(
1069 SELECT *
1070 FROM accountlines
1071 WHERE borrowernumber=?);
1072     my @bind = ($borrowernumber);
1073     if ($date && $date ne ''){
1074     $strsth.="
1075 AND date < ? ";
1076     push(@bind,$date);
1077     }
1078     $strsth.="
1079 ORDER BY date desc,timestamp DESC";
1080     my $sth= $dbh->prepare( $strsth );
1081     $sth->execute( @bind );
1082     my $total = 0;
1083     while ( my $data = $sth->fetchrow_hashref ) {
1084         $acctlines[$numlines] = $data;
1085         $numlines++;
1086         $total += $data->{'amountoutstanding'};
1087     }
1088     $sth->finish;
1089     return ( $total, \@acctlines,$numlines);
1090 }
1091
1092 =head2 GetBorNotifyAcctRecord
1093
1094   ($count, $acctlines, $total) = &GetBorNotifyAcctRecord($params,$notifyid);
1095
1096 Looks up accounting data for the patron with the given borrowernumber per file number.
1097
1098 (FIXME - I'm not at all sure what this is about.)
1099
1100 C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a
1101 reference-to-array, where each element is a reference-to-hash; the
1102 keys are the fields of the C<accountlines> table in the Koha database.
1103 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1104 total amount outstanding for all of the account lines.
1105
1106 =cut
1107
1108 sub GetBorNotifyAcctRecord {
1109     my ( $borrowernumber, $notifyid ) = @_;
1110     my $dbh = C4::Context->dbh;
1111     my @acctlines;
1112     my $numlines = 0;
1113     my $query    = qq|  SELECT *
1114                         FROM accountlines
1115                         WHERE borrowernumber=?
1116                         AND notify_id=?
1117                         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')
1118                         AND amountoutstanding != '0'
1119                         ORDER BY notify_id,accounttype
1120                 |;
1121     my $sth = $dbh->prepare($query);
1122
1123     $sth->execute( $borrowernumber, $notifyid );
1124     my $total = 0;
1125     while ( my $data = $sth->fetchrow_hashref ) {
1126         $acctlines[$numlines] = $data;
1127         $numlines++;
1128         $total += $data->{'amountoutstanding'};
1129     }
1130     $sth->finish;
1131     return ( $total, \@acctlines, $numlines );
1132 }
1133
1134 =head2 checkuniquemember (OUEST-PROVENCE)
1135
1136   $result = &checkuniquemember($collectivity,$surname,$categorycode,$firstname,$dateofbirth);
1137
1138 Checks that a member exists or not in the database.
1139
1140 C<&result> is 1 (=exist) or 0 (=does not exist)
1141 C<&collectivity> is 1 (= we add a collectivity) or 0 (= we add a physical member)
1142 C<&surname> is the surname
1143 C<&categorycode> is from categorycode table
1144 C<&firstname> is the firstname (only if collectivity=0)
1145 C<&dateofbirth> is the date of birth (only if collectivity=0)
1146
1147 =cut
1148
1149 sub checkuniquemember {
1150     my ( $collectivity, $surname, $firstname, $dateofbirth ) = @_;
1151     my $dbh = C4::Context->dbh;
1152     my $request;
1153     if ($collectivity) {
1154
1155 #                               $request="select count(*) from borrowers where surname=? and categorycode=?";
1156         $request =
1157           "select borrowernumber,categorycode from borrowers where surname=? ";
1158     }
1159     else {
1160
1161 #                               $request="select count(*) from borrowers where surname=? and categorycode=? and firstname=? and dateofbirth=?";
1162         $request =
1163 "select borrowernumber,categorycode from borrowers where surname=?  and firstname=? and dateofbirth=?";
1164     }
1165     my $sth = $dbh->prepare($request);
1166     if ($collectivity) {
1167         $sth->execute( uc($surname) );
1168     }
1169     else {
1170         $sth->execute( uc($surname), ucfirst($firstname), $dateofbirth );
1171     }
1172     my @data = $sth->fetchrow;
1173     if ( $data[0] ) {
1174         $sth->finish;
1175         return $data[0], $data[1];
1176
1177         #
1178     }
1179     else {
1180         $sth->finish;
1181         return 0;
1182     }
1183 }
1184
1185 sub checkcardnumber {
1186         my ($cardnumber) = @_;
1187         my $dbh = C4::Context->dbh;
1188         my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
1189         my $sth = $dbh->prepare($query);
1190         $sth->execute($cardnumber);
1191         if (my $data= $sth->fetchrow_hashref()){
1192                 return 1;
1193         }
1194         else {
1195                 return 0;
1196         }
1197         $sth->finish();
1198 }
1199
1200
1201 =head2 getzipnamecity (OUEST-PROVENCE)
1202
1203 take all info from table city for the fields city and  zip
1204 check for the name and the zip code of the city selected
1205
1206 =cut
1207
1208 sub getzipnamecity {
1209     my ($cityid) = @_;
1210     my $dbh      = C4::Context->dbh;
1211     my $sth      =
1212       $dbh->prepare(
1213         "select city_name,city_zipcode from cities where cityid=? ");
1214     $sth->execute($cityid);
1215     my @data = $sth->fetchrow;
1216     return $data[0], $data[1];
1217 }
1218
1219
1220 =head2 getdcity (OUEST-PROVENCE)
1221
1222 recover cityid  with city_name condition
1223
1224 =cut
1225
1226 sub getidcity {
1227     my ($city_name) = @_;
1228     my $dbh = C4::Context->dbh;
1229     my $sth = $dbh->prepare("select cityid from cities where city_name=? ");
1230     $sth->execute($city_name);
1231     my $data = $sth->fetchrow;
1232     return $data;
1233 }
1234
1235
1236 =head2 GetExpiryDate
1237
1238   $expirydate = GetExpiryDate($categorycode, $dateenrolled);
1239 process expiry date given a date and a categorycode
1240
1241 =cut
1242 sub GetExpiryDate {
1243     my ( $categorycode, $dateenrolled ) = @_;
1244     my $dbh = C4::Context->dbh;
1245     my $sth =
1246       $dbh->prepare(
1247         "select enrolmentperiod from categories where categorycode=?");
1248     $sth->execute($categorycode);
1249     my ($enrolmentperiod) = $sth->fetchrow;
1250     $enrolmentperiod = 12 unless ($enrolmentperiod);
1251     my @date=split /-/,format_date_in_iso($dateenrolled);
1252     @date=Add_Delta_YM($date[0],$date[1],$date[2],0,$enrolmentperiod);
1253     return sprintf("%04d-%02d-%02d",$date[0],$date[1],$date[2]);
1254 }
1255
1256 =head2 checkuserpassword (OUEST-PROVENCE)
1257
1258 check for the password and login are not used
1259 return the number of record
1260 0=> NOT USED 1=> USED
1261
1262 =cut
1263
1264 sub checkuserpassword {
1265     my ( $borrowernumber, $userid, $password ) = @_;
1266     $password = md5_base64($password);
1267     my $dbh = C4::Context->dbh;
1268     my $sth =
1269       $dbh->prepare(
1270 "Select count(*) from borrowers where borrowernumber !=? and userid =? and password=? "
1271       );
1272     $sth->execute( $borrowernumber, $userid, $password );
1273     my $number_rows = $sth->fetchrow;
1274     return $number_rows;
1275
1276 }
1277
1278 =head2 GetborCatFromCatType
1279
1280   ($codes_arrayref, $labels_hashref) = &GetborCatFromCatType();
1281
1282 Looks up the different types of borrowers in the database. Returns two
1283 elements: a reference-to-array, which lists the borrower category
1284 codes, and a reference-to-hash, which maps the borrower category codes
1285 to category descriptions.
1286
1287 =cut
1288
1289 #'
1290 sub GetborCatFromCatType {
1291     my ( $category_type, $action ) = @_;
1292     my $dbh     = C4::Context->dbh;
1293     my $request = qq|   SELECT categorycode,description
1294                         FROM categories
1295                         $action
1296                         ORDER BY categorycode|;
1297     my $sth = $dbh->prepare($request);
1298     if ($action) {
1299         $sth->execute($category_type);
1300     }
1301     else {
1302         $sth->execute();
1303     }
1304
1305     my %labels;
1306     my @codes;
1307
1308     while ( my $data = $sth->fetchrow_hashref ) {
1309         push @codes, $data->{'categorycode'};
1310         $labels{ $data->{'categorycode'} } = $data->{'description'};
1311     }
1312     $sth->finish;
1313     return ( \@codes, \%labels );
1314 }
1315
1316 =head2 GetBorrowercategory
1317
1318   $hashref = &GetBorrowercategory($categorycode);
1319
1320 Given the borrower's category code, the function returns the corresponding
1321 data hashref for a comprehensive information display.
1322
1323 =cut
1324
1325 sub GetBorrowercategory {
1326     my ($catcode) = @_;
1327     my $dbh       = C4::Context->dbh;
1328     my $sth       =
1329       $dbh->prepare(
1330 "SELECT description,dateofbirthrequired,upperagelimit,category_type
1331  FROM categories
1332  WHERE categorycode = ?"
1333       );
1334     $sth->execute($catcode);
1335     my $data =
1336       $sth->fetchrow_hashref;
1337     $sth->finish();
1338     return $data;
1339 }    # sub getborrowercategory
1340
1341 =head2 ethnicitycategories
1342
1343   ($codes_arrayref, $labels_hashref) = &ethnicitycategories();
1344
1345 Looks up the different ethnic types in the database. Returns two
1346 elements: a reference-to-array, which lists the ethnicity codes, and a
1347 reference-to-hash, which maps the ethnicity codes to ethnicity
1348 descriptions.
1349
1350 =cut
1351
1352 #'
1353
1354 sub ethnicitycategories {
1355     my $dbh = C4::Context->dbh;
1356     my $sth = $dbh->prepare("Select code,name from ethnicity order by name");
1357     $sth->execute;
1358     my %labels;
1359     my @codes;
1360     while ( my $data = $sth->fetchrow_hashref ) {
1361         push @codes, $data->{'code'};
1362         $labels{ $data->{'code'} } = $data->{'name'};
1363     }
1364     $sth->finish;
1365     return ( \@codes, \%labels );
1366 }
1367
1368 =head2 fixEthnicity
1369
1370   $ethn_name = &fixEthnicity($ethn_code);
1371
1372 Takes an ethnicity code (e.g., "european" or "pi") and returns the
1373 corresponding descriptive name from the C<ethnicity> table in the
1374 Koha database ("European" or "Pacific Islander").
1375
1376 =cut
1377
1378 #'
1379
1380 sub fixEthnicity {
1381     my $ethnicity = shift;
1382     return unless $ethnicity;
1383     my $dbh       = C4::Context->dbh;
1384     my $sth       = $dbh->prepare("Select name from ethnicity where code = ?");
1385     $sth->execute($ethnicity);
1386     my $data = $sth->fetchrow_hashref;
1387     $sth->finish;
1388     return $data->{'name'};
1389 }    # sub fixEthnicity
1390
1391 =head2 GetAge
1392
1393   $dateofbirth,$date = &GetAge($date);
1394
1395 this function return the borrowers age with the value of dateofbirth
1396
1397 =cut
1398
1399 #'
1400 sub GetAge{
1401     my ( $date, $date_ref ) = @_;
1402
1403     if ( not defined $date_ref ) {
1404         $date_ref = sprintf( '%04d-%02d-%02d', Today() );
1405     }
1406
1407     my ( $year1, $month1, $day1 ) = split /-/, $date;
1408     my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
1409
1410     my $age = $year2 - $year1;
1411     if ( $month1 . $day1 > $month2 . $day2 ) {
1412         $age--;
1413     }
1414
1415     return $age;
1416 }    # sub get_age
1417
1418 =head2 get_institutions
1419   $insitutions = get_institutions();
1420
1421 Just returns a list of all the borrowers of type I, borrownumber and name
1422
1423 =cut
1424
1425 #'
1426 sub get_institutions {
1427     my $dbh = C4::Context->dbh();
1428     my $sth =
1429       $dbh->prepare(
1430 "SELECT borrowernumber,surname FROM borrowers WHERE categorycode=? ORDER BY surname"
1431       );
1432     $sth->execute('I');
1433     my %orgs;
1434     while ( my $data = $sth->fetchrow_hashref() ) {
1435         $orgs{ $data->{'borrowernumber'} } = $data;
1436     }
1437     $sth->finish();
1438     return ( \%orgs );
1439
1440 }    # sub get_institutions
1441
1442 =head2 add_member_orgs
1443
1444   add_member_orgs($borrowernumber,$borrowernumbers);
1445
1446 Takes a borrowernumber and a list of other borrowernumbers and inserts them into the borrowers_to_borrowers table
1447
1448 =cut
1449
1450 #'
1451 sub add_member_orgs {
1452     my ( $borrowernumber, $otherborrowers ) = @_;
1453     my $dbh   = C4::Context->dbh();
1454     my $query =
1455       "INSERT INTO borrowers_to_borrowers (borrower1,borrower2) VALUES (?,?)";
1456     my $sth = $dbh->prepare($query);
1457     foreach my $otherborrowernumber (@$otherborrowers) {
1458         $sth->execute( $borrowernumber, $otherborrowernumber );
1459     }
1460     $sth->finish();
1461
1462 }    # sub add_member_orgs
1463
1464 =head2 GetCities (OUEST-PROVENCE)
1465
1466   ($id_cityarrayref, $city_hashref) = &GetCities();
1467
1468 Looks up the different city and zip in the database. Returns two
1469 elements: a reference-to-array, which lists the zip city
1470 codes, and a reference-to-hash, which maps the name of the city.
1471 WHERE =>OUEST PROVENCE OR EXTERIEUR
1472
1473 =cut
1474
1475 sub GetCities {
1476
1477     #my ($type_city) = @_;
1478     my $dbh   = C4::Context->dbh;
1479     my $query = qq|SELECT cityid,city_name
1480                 FROM cities
1481                 ORDER BY city_name|;
1482     my $sth = $dbh->prepare($query);
1483
1484     #$sth->execute($type_city);
1485     $sth->execute();
1486     my %city;
1487     my @id;
1488
1489     #    insert empty value to create a empty choice in cgi popup
1490
1491     while ( my $data = $sth->fetchrow_hashref ) {
1492
1493         push @id, $data->{'cityid'};
1494         $city{ $data->{'cityid'} } = $data->{'city_name'};
1495     }
1496
1497 #test to know if the table contain some records if no the function return nothing
1498     my $id = @id;
1499     $sth->finish;
1500     if ( $id eq 0 ) {
1501         return ();
1502     }
1503     else {
1504         unshift( @id, "" );
1505         return ( \@id, \%city );
1506     }
1507 }
1508
1509 =head2 GetSortDetails (OUEST-PROVENCE)
1510
1511   ($lib) = &GetSortDetails($category,$sortvalue);
1512
1513 Returns the authorized value  details
1514 C<&$lib>return value of authorized value details
1515 C<&$sortvalue>this is the value of authorized value
1516 C<&$category>this is the value of authorized value category
1517
1518 =cut
1519
1520 sub GetSortDetails {
1521     my ( $category, $sortvalue ) = @_;
1522     my $dbh   = C4::Context->dbh;
1523     my $query = qq|SELECT lib
1524                 FROM authorised_values
1525                 WHERE category=?
1526                 AND authorised_value=? |;
1527     my $sth = $dbh->prepare($query);
1528     $sth->execute( $category, $sortvalue );
1529     my $lib = $sth->fetchrow;
1530     return ($lib);
1531 }
1532
1533 =head2 DeleteBorrower
1534
1535   () = &DeleteBorrower($member);
1536
1537 delete all data fo borrowers and add record to deletedborrowers table
1538 C<&$member>this is the borrowernumber
1539
1540 =cut
1541
1542 sub MoveMemberToDeleted {
1543     my ($member) = @_;
1544     my $dbh = C4::Context->dbh;
1545     my $query;
1546     $query = qq|SELECT *
1547                   FROM borrowers
1548                   WHERE borrowernumber=?|;
1549     my $sth = $dbh->prepare($query);
1550     $sth->execute($member);
1551     my @data = $sth->fetchrow_array;
1552     $sth->finish;
1553     $sth =
1554       $dbh->prepare( "INSERT INTO deletedborrowers VALUES ("
1555           . ( "?," x ( scalar(@data) - 1 ) )
1556           . "?)" );
1557     $sth->execute(@data);
1558     $sth->finish;
1559 }
1560
1561 =head2 DelMember
1562
1563 DelMember($borrowernumber);
1564
1565 This function remove directly a borrower whitout writing it on deleteborrower.
1566 + Deletes reserves for the borrower
1567
1568 =cut
1569
1570 sub DelMember {
1571     my $dbh            = C4::Context->dbh;
1572     my $borrowernumber = shift;
1573         warn "in delmember with $borrowernumber";
1574     return unless $borrowernumber;    # borrowernumber is mandatory.
1575
1576     my $query = qq|DELETE
1577                   FROM  reserves
1578                   WHERE borrowernumber=?|;
1579     my $sth = $dbh->prepare($query);
1580     $sth->execute($borrowernumber);
1581     $sth->finish;
1582     $query = "
1583        DELETE
1584        FROM borrowers
1585        WHERE borrowernumber = ?
1586    ";
1587     $sth = $dbh->prepare($query);
1588     $sth->execute($borrowernumber);
1589     $sth->finish;
1590     &logaction(C4::Context->userenv->{'number'},"MEMBERS","DELETE",$borrowernumber,"")
1591         if C4::Context->preference("BorrowersLog");
1592     return $sth->rows;
1593 }
1594
1595 =head2 ExtendMemberSubscriptionTo (OUEST-PROVENCE)
1596
1597 $date= ExtendMemberSubscriptionTo($borrowerid, $date);
1598 Extending the subscription to a given date or to the expiry date calculated on local date.
1599 returns date
1600 =cut
1601
1602 sub ExtendMemberSubscriptionTo {
1603     my ( $borrowerid,$date) = @_;
1604     my $dbh = C4::Context->dbh;
1605     unless ($date){
1606       $date=POSIX::strftime("%Y-%m-%d",localtime(time));
1607       my $borrower = GetMember($borrowerid,'borrowernumber');
1608       $date = GetExpiryDate( $borrower->{'categorycode'}, $date );
1609     }
1610     my $sth = $dbh->do(<<EOF);
1611 UPDATE borrowers
1612 SET  dateexpiry='$date'
1613 WHERE borrowernumber='$borrowerid'
1614 EOF
1615     return $date if ($sth);
1616     return 0;
1617 }
1618
1619 =head2 GetRoadTypes (OUEST-PROVENCE)
1620
1621   ($idroadtypearrayref, $roadttype_hashref) = &GetRoadTypes();
1622
1623 Looks up the different road type . Returns two
1624 elements: a reference-to-array, which lists the id_roadtype
1625 codes, and a reference-to-hash, which maps the road type of the road .
1626
1627
1628 =cut
1629
1630 sub GetRoadTypes {
1631     my $dbh   = C4::Context->dbh;
1632     my $query = qq|
1633 SELECT roadtypeid,road_type
1634 FROM roadtype
1635 ORDER BY road_type|;
1636     my $sth = $dbh->prepare($query);
1637     $sth->execute();
1638     my %roadtype;
1639     my @id;
1640
1641     #    insert empty value to create a empty choice in cgi popup
1642
1643     while ( my $data = $sth->fetchrow_hashref ) {
1644
1645         push @id, $data->{'roadtypeid'};
1646         $roadtype{ $data->{'roadtypeid'} } = $data->{'road_type'};
1647     }
1648
1649 #test to know if the table contain some records if no the function return nothing
1650     my $id = @id;
1651     $sth->finish;
1652     if ( $id eq 0 ) {
1653         return ();
1654     }
1655     else {
1656         unshift( @id, "" );
1657         return ( \@id, \%roadtype );
1658     }
1659 }
1660
1661
1662
1663 =head2 GetTitles (OUEST-PROVENCE)
1664
1665   ($borrowertitle)= &GetTitles();
1666
1667 Looks up the different title . Returns array  with all borrowers title
1668
1669 =cut
1670
1671 sub GetTitles {
1672     my @borrowerTitle = split /,|\|/,C4::Context->preference('BorrowersTitles');
1673     unshift( @borrowerTitle, "" );
1674     return ( \@borrowerTitle);
1675     }
1676
1677
1678
1679 =head2 GetRoadTypeDetails (OUEST-PROVENCE)
1680
1681   ($roadtype) = &GetRoadTypeDetails($roadtypeid);
1682
1683 Returns the description of roadtype
1684 C<&$roadtype>return description of road type
1685 C<&$roadtypeid>this is the value of roadtype s
1686
1687 =cut
1688
1689 sub GetRoadTypeDetails {
1690     my ($roadtypeid) = @_;
1691     my $dbh          = C4::Context->dbh;
1692     my $query        = qq|
1693 SELECT road_type
1694 FROM roadtype
1695 WHERE roadtypeid=?|;
1696     my $sth = $dbh->prepare($query);
1697     $sth->execute($roadtypeid);
1698     my $roadtype = $sth->fetchrow;
1699     return ($roadtype);
1700 }
1701
1702 =head2 GetBorrowersWhoHaveNotBorrowedSince
1703
1704 &GetBorrowersWhoHaveNotBorrowedSince($date)
1705
1706 this function get all borrowers who haven't borrowed since the date given on input arg.
1707
1708 =cut
1709
1710 sub GetBorrowersWhoHaveNotBorrowedSince {
1711     my $date = shift;
1712     return unless $date;    # date is mandatory.
1713     my $dbh   = C4::Context->dbh;
1714     my $query = "
1715         SELECT borrowers.borrowernumber,max(timestamp)
1716         FROM   borrowers
1717           LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
1718         WHERE issues.borrowernumber IS NOT NULL
1719         GROUP BY borrowers.borrowernumber
1720    ";
1721     my $sth = $dbh->prepare($query);
1722     $sth->execute;
1723     my @results;
1724
1725     while ( my $data = $sth->fetchrow_hashref ) {
1726         push @results, $data;
1727     }
1728     return \@results;
1729 }
1730
1731 =head2 GetBorrowersWhoHaveNeverBorrowed
1732
1733 $results = &GetBorrowersWhoHaveNeverBorrowed
1734
1735 this function get all borrowers who have never borrowed.
1736
1737 I<$result> is a ref to an array which all elements are a hasref.
1738
1739 =cut
1740
1741 sub GetBorrowersWhoHaveNeverBorrowed {
1742     my $dbh   = C4::Context->dbh;
1743     my $query = "
1744         SELECT borrowers.borrowernumber,max(timestamp)
1745         FROM   borrowers
1746           LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
1747         WHERE issues.borrowernumber IS NULL
1748    ";
1749     my $sth = $dbh->prepare($query);
1750     $sth->execute;
1751     my @results;
1752     while ( my $data = $sth->fetchrow_hashref ) {
1753         push @results, $data;
1754     }
1755     return \@results;
1756 }
1757
1758 =head2 GetBorrowersWithIssuesHistoryOlderThan
1759
1760 $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
1761
1762 this function get all borrowers who has an issue history older than I<$date> given on input arg.
1763
1764 I<$result> is a ref to an array which all elements are a hashref.
1765 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
1766
1767 =cut
1768
1769 sub GetBorrowersWithIssuesHistoryOlderThan {
1770     my $dbh  = C4::Context->dbh;
1771     my $date = shift;
1772     return unless $date;    # date is mandatory.
1773     my $query = "
1774        SELECT count(borrowernumber) as n,borrowernumber
1775        FROM issues
1776        WHERE returndate < ?
1777          AND borrowernumber IS NOT NULL
1778        GROUP BY borrowernumber
1779    ";
1780     my $sth = $dbh->prepare($query);
1781     $sth->execute($date);
1782     my @results;
1783
1784     while ( my $data = $sth->fetchrow_hashref ) {
1785         push @results, $data;
1786     }
1787     return \@results;
1788 }
1789
1790 END { }    # module clean-up code here (global destructor)
1791
1792 1;
1793
1794 __END__
1795
1796 =back
1797
1798 =head1 AUTHOR
1799
1800 Koha Team
1801
1802 =cut