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