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