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