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