C4/Members.pm

   1 package C4::Members;
   2
   3 # Copyright 2000-2003 Katipo Communications
   4 # Copyright 2010 BibLibre
   5 # Parts Copyright 2010 Catalyst IT
   6 #
   7 # This file is part of Koha.
   8 #
   9 # Koha is free software; you can redistribute it and/or modify it under the
  10 # terms of the GNU General Public License as published by the Free Software
  11 # Foundation; either version 2 of the License, or (at your option) any later
  12 # version.
  13 #
  14 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  15 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  16 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU General Public License along
  19 # with Koha; if not, write to the Free Software Foundation, Inc.,
  20 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  21
  22
  23 use strict;
  24 #use warnings; FIXME - Bug 2505
  25 use C4::Context;
  26 use C4::Dates qw(format_date_in_iso);
  27 use Digest::MD5 qw(md5_base64);
  28 use Date::Calc qw/Today Add_Delta_YM/;
  29 use C4::Log; # logaction
  30 use C4::Overdues;
  31 use C4::Reserves;
  32 use C4::Accounts;
  33 use C4::Biblio;
  34 use C4::SQLHelper qw(InsertInTable UpdateInTable SearchInTable);
  35 use C4::Members::Attributes qw(SearchIdMatchingAttribute);
  36
  37 our ($VERSION,@ISA,@EXPORT,@EXPORT_OK,$debug);
  38
  39 BEGIN {
  40         $VERSION = 3.02;
  41         $debug = $ENV{DEBUG} || 0;
  42         require Exporter;
  43         @ISA = qw(Exporter);
  44         #Get data
  45         push @EXPORT, qw(
  46                 &Search
  47                 &SearchMember
  48                 &GetMemberDetails
  49         &GetMemberRelatives
  50                 &GetMember
  51
  52                 &GetGuarantees
  53
  54                 &GetMemberIssuesAndFines
  55                 &GetPendingIssues
  56                 &GetAllIssues
  57
  58                 &get_institutions
  59                 &getzipnamecity
  60                 &getidcity
  61
  62                 &GetFirstValidEmailAddress
  63
  64                 &GetAge
  65                 &GetCities
  66                 &GetRoadTypes
  67                 &GetRoadTypeDetails
  68                 &GetSortDetails
  69                 &GetTitles
  70
  71     &GetPatronImage
  72     &PutPatronImage
  73     &RmPatronImage
  74
  75                 &GetHideLostItemsPreference
  76
  77                 &IsMemberBlocked
  78                 &GetMemberAccountRecords
  79                 &GetBorNotifyAcctRecord
  80
  81                 &GetborCatFromCatType
  82                 &GetBorrowercategory
  83     &GetBorrowercategoryList
  84
  85                 &GetBorrowersWhoHaveNotBorrowedSince
  86                 &GetBorrowersWhoHaveNeverBorrowed
  87                 &GetBorrowersWithIssuesHistoryOlderThan
  88
  89                 &GetExpiryDate
  90
  91                 &AddMessage
  92                 &DeleteMessage
  93                 &GetMessages
  94                 &GetMessagesCount
  95         );
  96
  97         #Modify data
  98         push @EXPORT, qw(
  99                 &ModMember
 100                 &changepassword
 101          &ModPrivacy
 102         );
 103
 104         #Delete data
 105         push @EXPORT, qw(
 106                 &DelMember
 107         );
 108
 109         #Insert data
 110         push @EXPORT, qw(
 111                 &AddMember
 112                 &add_member_orgs
 113                 &MoveMemberToDeleted
 114                 &ExtendMemberSubscriptionTo
 115         );
 116
 117         #Check data
 118     push @EXPORT, qw(
 119         &checkuniquemember
 120         &checkuserpassword
 121         &Check_Userid
 122         &Generate_Userid
 123         &fixEthnicity
 124         &ethnicitycategories
 125         &fixup_cardnumber
 126         &checkcardnumber
 127     );
 128 }
 129
 130 =head1 NAME
 131
 132 C4::Members - Perl Module containing convenience functions for member handling
 133
 134 =head1 SYNOPSIS
 135
 136 use C4::Members;
 137
 138 =head1 DESCRIPTION
 139
 140 This module contains routines for adding, modifying and deleting members/patrons/borrowers
 141
 142 =head1 FUNCTIONS
 143
 144 =head2 SearchMember
 145
 146   ($count, $borrowers) = &SearchMember($searchstring, $type,
 147                      $category_type, $filter, $showallbranches);
 148
 149 Looks up patrons (borrowers) by name.
 150
 151 BUGFIX 499: C<$type> is now used to determine type of search.
 152 if $type is "simple", search is performed on the first letter of the
 153 surname only.
 154
 155 $category_type is used to get a specified type of user.
 156 (mainly adults when creating a child.)
 157
 158 C<$searchstring> is a space-separated list of search terms. Each term
 159 must match the beginning a borrower's surname, first name, or other
 160 name.
 161
 162 C<$filter> is assumed to be a list of elements to filter results on
 163
 164 C<$showallbranches> is used in IndependantBranches Context to display all branches results.
 165
 166 C<&SearchMember> returns a two-element list. C<$borrowers> is a
 167 reference-to-array; each element is a reference-to-hash, whose keys
 168 are the fields of the C<borrowers> table in the Koha database.
 169 C<$count> is the number of elements in C<$borrowers>.
 170
 171 =cut
 172
 173 #'
 174 #used by member enquiries from the intranet
 175 sub SearchMember {
 176     my ($searchstring, $orderby, $type,$category_type,$filter,$showallbranches ) = @_;
 177     my $dbh   = C4::Context->dbh;
 178     my $query = "";
 179     my $count;
 180     my @data;
 181     my @bind = ();
 182
 183     # this is used by circulation everytime a new borrowers cardnumber is scanned
 184     # so we can check an exact match first, if that works return, otherwise do the rest
 185     $query = "SELECT * FROM borrowers
 186         LEFT JOIN categories ON borrowers.categorycode=categories.categorycode
 187         ";
 188     my $sth = $dbh->prepare("$query WHERE cardnumber = ?");
 189     $sth->execute($searchstring);
 190     my $data = $sth->fetchall_arrayref({});
 191     if (@$data){
 192         return ( scalar(@$data), $data );
 193     }
 194
 195     if ( $type eq "simple" )    # simple search for one letter only
 196     {
 197         $query .= ($category_type ? " AND category_type = ".$dbh->quote($category_type) : "");
 198         $query .= " WHERE (surname LIKE ? OR cardnumber like ?) ";
 199         if (C4::Context->preference("IndependantBranches") && !$showallbranches){
 200           if (C4::Context->userenv && C4::Context->userenv->{flags} % 2 !=1 && C4::Context->userenv->{'branch'}){
 201             $query.=" AND borrowers.branchcode =".$dbh->quote(C4::Context->userenv->{'branch'}) unless (C4::Context->userenv->{'branch'} eq "insecure");
 202           }
 203         }
 204         $query.=" ORDER BY $orderby";
 205         @bind = ("$searchstring%","$searchstring");
 206     }
 207     else    # advanced search looking in surname, firstname and othernames
 208     {
 209         @data  = split( ' ', $searchstring );
 210         $count = @data;
 211         $query .= " WHERE ";
 212         if (C4::Context->preference("IndependantBranches") && !$showallbranches){
 213           if (C4::Context->userenv && C4::Context->userenv->{flags} % 2 !=1 && C4::Context->userenv->{'branch'}){
 214             $query.=" borrowers.branchcode =".$dbh->quote(C4::Context->userenv->{'branch'})." AND " unless (C4::Context->userenv->{'branch'} eq "insecure");
 215           }
 216         }
 217         $query.="((surname LIKE ? OR (surname LIKE ? AND surname REGEXP ?)
 218                 OR firstname  LIKE ? OR (firstname LIKE ? AND firstname REGEXP ?)
 219                 OR othernames LIKE ? OR (othernames LIKE ? AND othernames REGEXP ?))
 220         " .
 221         ($category_type?" AND category_type = ".$dbh->quote($category_type):"");
 222         my $regex = '[[:punct:][:space:]]'.$data[0];
 223         @bind = (
 224             "$data[0]%", "%$data[0]%", $regex,
 225             "$data[0]%", "%$data[0]%", $regex,
 226             "$data[0]%", "%$data[0]%", $regex
 227         );
 228         for ( my $i = 1 ; $i < $count ; $i++ ) {
 229             $query = $query . " AND (" . " surname LIKE ? OR (surname LIKE ? AND surname REGEXP ?)
 230                 OR firstname  LIKE ? OR (firstname LIKE ? AND firstname REGEXP ?)
 231                 OR othernames LIKE ? OR (othernames LIKE ? AND othernames REGEXP ?))";
 232             $regex = '[[:punct:][:space:]]'.$data[$i];
 233             push( @bind,
 234               "$data[$i]%", "%$data[$i]%", $regex,
 235               "$data[$i]%", "%$data[$i]%", $regex,
 236               "$data[$i]%", "%$data[$i]%", $regex
 237             );
 238
 239
 240             # FIXME - .= <<EOT;
 241         }
 242         $query = $query . ") OR cardnumber LIKE ? ";
 243         push( @bind, $searchstring );
 244         $query .= "order by $orderby";
 245
 246         # FIXME - .= <<EOT;
 247     }
 248
 249     $sth = $dbh->prepare($query);
 250
 251     $debug and print STDERR "Q $orderby : $query\n";
 252     $sth->execute(@bind);
 253     my @results;
 254     $data = $sth->fetchall_arrayref({});
 255
 256     return ( scalar(@$data), $data );
 257 }
 258
 259 =head2 Search
 260
 261   $borrowers_result_array_ref = &Search($filter,$orderby, $limit,
 262                        $columns_out, $search_on_fields,$searchtype);
 263
 264 Looks up patrons (borrowers) on filter.
 265
 266 BUGFIX 499: C<$type> is now used to determine type of search.
 267 if $type is "simple", search is performed on the first letter of the
 268 surname only.
 269
 270 $category_type is used to get a specified type of user.
 271 (mainly adults when creating a child.)
 272
 273 C<$filter> can be
 274    - a space-separated list of search terms. Implicit AND is done on them
 275    - a hash ref containing fieldnames associated with queried value
 276    - an array ref combining the two previous elements Implicit OR is done between each array element
 277
 278
 279 C<$orderby> is an arrayref of hashref. Contains the name of the field and 0 or 1 depending if order is ascending or descending
 280
 281 C<$limit> is there to allow limiting number of results returned
 282
 283 C<&columns_out> is an array ref to the fieldnames you want to see in the result list
 284
 285 C<&search_on_fields> is an array ref to the fieldnames you want to limit search on when you are using string search
 286
 287 C<&searchtype> is a string telling the type of search you want todo : start_with, exact or contains are allowed
 288
 289 =cut
 290
 291 sub Search {
 292     my ( $filter, $orderby, $limit, $columns_out, $search_on_fields, $searchtype ) = @_;
 293     my @filters;
 294     my %filtersmatching_record;
 295     my @finalfilter;
 296     if ( ref($filter) eq "ARRAY" ) {
 297         push @filters, @$filter;
 298     } else {
 299         push @filters, $filter;
 300     }
 301     if ( C4::Context->preference('ExtendedPatronAttributes') ) {
 302         my $matching_records = C4::Members::Attributes::SearchIdMatchingAttribute($filter);
 303         if(scalar(@$matching_records)>0) {
 304                         foreach my $matching_record (@$matching_records) {
 305                                 $filtersmatching_record{$$matching_record[0]}=1;
 306                         }
 307                         foreach my $k (keys(%filtersmatching_record)) {
 308                                 push @filters, {"borrowernumber"=>$k};
 309                         }
 310                 }
 311     }
 312     $searchtype ||= "start_with";
 313         push @finalfilter, \@filters;
 314         my $data = SearchInTable( "borrowers", \@finalfilter, $orderby, $limit, $columns_out, $search_on_fields, $searchtype );
 315     return ($data);
 316 }
 317
 318 =head2 GetMemberDetails
 319
 320 ($borrower) = &GetMemberDetails($borrowernumber, $cardnumber);
 321
 322 Looks up a patron and returns information about him or her. If
 323 C<$borrowernumber> is true (nonzero), C<&GetMemberDetails> looks
 324 up the borrower by number; otherwise, it looks up the borrower by card
 325 number.
 326
 327 C<$borrower> is a reference-to-hash whose keys are the fields of the
 328 borrowers table in the Koha database. In addition,
 329 C<$borrower-E<gt>{flags}> is a hash giving more detailed information
 330 about the patron. Its keys act as flags :
 331
 332     if $borrower->{flags}->{LOST} {
 333         # Patron's card was reported lost
 334     }
 335
 336 If the state of a flag means that the patron should not be
 337 allowed to borrow any more books, then it will have a C<noissues> key
 338 with a true value.
 339
 340 See patronflags for more details.
 341
 342 C<$borrower-E<gt>{authflags}> is a hash giving more detailed information
 343 about the top-level permissions flags set for the borrower.  For example,
 344 if a user has the "editcatalogue" permission,
 345 C<$borrower-E<gt>{authflags}-E<gt>{editcatalogue}> will exist and have
 346 the value "1".
 347
 348 =cut
 349
 350 sub GetMemberDetails {
 351     my ( $borrowernumber, $cardnumber ) = @_;
 352     my $dbh = C4::Context->dbh;
 353     my $query;
 354     my $sth;
 355     if ($borrowernumber) {
 356         $sth = $dbh->prepare("SELECT borrowers.*,category_type,categories.description,reservefee FROM borrowers LEFT JOIN categories ON borrowers.categorycode=categories.categorycode WHERE  borrowernumber=?");
 357         $sth->execute($borrowernumber);
 358     }
 359     elsif ($cardnumber) {
 360         $sth = $dbh->prepare("SELECT borrowers.*,category_type,categories.description,reservefee FROM borrowers LEFT JOIN categories ON borrowers.categorycode=categories.categorycode WHERE cardnumber=?");
 361         $sth->execute($cardnumber);
 362     }
 363     else {
 364         return undef;
 365     }
 366     my $borrower = $sth->fetchrow_hashref;
 367     my ($amount) = GetMemberAccountRecords( $borrowernumber);
 368     $borrower->{'amountoutstanding'} = $amount;
 369     # FIXME - patronflags calls GetMemberAccountRecords... just have patronflags return $amount
 370     my $flags = patronflags( $borrower);
 371     my $accessflagshash;
 372
 373     $sth = $dbh->prepare("select bit,flag from userflags");
 374     $sth->execute;
 375     while ( my ( $bit, $flag ) = $sth->fetchrow ) {
 376         if ( $borrower->{'flags'} && $borrower->{'flags'} & 2**$bit ) {
 377             $accessflagshash->{$flag} = 1;
 378         }
 379     }
 380     $borrower->{'flags'}     = $flags;
 381     $borrower->{'authflags'} = $accessflagshash;
 382
 383     # find out how long the membership lasts
 384     $sth =
 385       $dbh->prepare(
 386         "select enrolmentperiod from categories where categorycode = ?");
 387     $sth->execute( $borrower->{'categorycode'} );
 388     my $enrolment = $sth->fetchrow;
 389     $borrower->{'enrolmentperiod'} = $enrolment;
 390
 391     return ($borrower);    #, $flags, $accessflagshash);
 392 }
 393
 394 =head2 patronflags
 395
 396  $flags = &patronflags($patron);
 397
 398 This function is not exported.
 399
 400 The following will be set where applicable:
 401  $flags->{CHARGES}->{amount}        Amount of debt
 402  $flags->{CHARGES}->{noissues}      Set if debt amount >$5.00 (or syspref noissuescharge)
 403  $flags->{CHARGES}->{message}       Message -- deprecated
 404
 405  $flags->{CREDITS}->{amount}        Amount of credit
 406  $flags->{CREDITS}->{message}       Message -- deprecated
 407
 408  $flags->{  GNA  }                  Patron has no valid address
 409  $flags->{  GNA  }->{noissues}      Set for each GNA
 410  $flags->{  GNA  }->{message}       "Borrower has no valid address" -- deprecated
 411
 412  $flags->{ LOST  }                  Patron's card reported lost
 413  $flags->{ LOST  }->{noissues}      Set for each LOST
 414  $flags->{ LOST  }->{message}       Message -- deprecated
 415
 416  $flags->{DBARRED}                  Set if patron debarred, no access
 417  $flags->{DBARRED}->{noissues}      Set for each DBARRED
 418  $flags->{DBARRED}->{message}       Message -- deprecated
 419
 420  $flags->{ NOTES }
 421  $flags->{ NOTES }->{message}       The note itself.  NOT deprecated
 422
 423  $flags->{ ODUES }                  Set if patron has overdue books.
 424  $flags->{ ODUES }->{message}       "Yes"  -- deprecated
 425  $flags->{ ODUES }->{itemlist}      ref-to-array: list of overdue books
 426  $flags->{ ODUES }->{itemlisttext}  Text list of overdue items -- deprecated
 427
 428  $flags->{WAITING}                  Set if any of patron's reserves are available
 429  $flags->{WAITING}->{message}       Message -- deprecated
 430  $flags->{WAITING}->{itemlist}      ref-to-array: list of available items
 431
 432 =over
 433
 434 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
 435 overdue items. Its elements are references-to-hash, each describing an
 436 overdue item. The keys are selected fields from the issues, biblio,
 437 biblioitems, and items tables of the Koha database.
 438
 439 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
 440 the overdue items, one per line.  Deprecated.
 441
 442 =item C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
 443 available items. Each element is a reference-to-hash whose keys are
 444 fields from the reserves table of the Koha database.
 445
 446 =back
 447
 448 All the "message" fields that include language generated in this function are deprecated,
 449 because such strings belong properly in the display layer.
 450
 451 The "message" field that comes from the DB is OK.
 452
 453 =cut
 454
 455 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
 456 # FIXME rename this function.
 457 sub patronflags {
 458     my %flags;
 459     my ( $patroninformation) = @_;
 460     my $dbh=C4::Context->dbh;
 461     my ($amount) = GetMemberAccountRecords( $patroninformation->{'borrowernumber'});
 462     if ( $amount > 0 ) {
 463         my %flaginfo;
 464         my $noissuescharge = C4::Context->preference("noissuescharge") || 5;
 465         $flaginfo{'message'} = sprintf "Patron owes \$%.02f", $amount;
 466         $flaginfo{'amount'}  = sprintf "%.02f", $amount;
 467         if ( $amount > $noissuescharge && !C4::Context->preference("AllowFineOverride") ) {
 468             $flaginfo{'noissues'} = 1;
 469         }
 470         $flags{'CHARGES'} = \%flaginfo;
 471     }
 472     elsif ( $amount < 0 ) {
 473         my %flaginfo;
 474         $flaginfo{'message'} = sprintf "Patron has credit of \$%.02f", -$amount;
 475         $flaginfo{'amount'}  = sprintf "%.02f", $amount;
 476         $flags{'CREDITS'} = \%flaginfo;
 477     }
 478     if (   $patroninformation->{'gonenoaddress'}
 479         && $patroninformation->{'gonenoaddress'} == 1 )
 480     {
 481         my %flaginfo;
 482         $flaginfo{'message'}  = 'Borrower has no valid address.';
 483         $flaginfo{'noissues'} = 1;
 484         $flags{'GNA'}         = \%flaginfo;
 485     }
 486     if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
 487         my %flaginfo;
 488         $flaginfo{'message'}  = 'Borrower\'s card reported lost.';
 489         $flaginfo{'noissues'} = 1;
 490         $flags{'LOST'}        = \%flaginfo;
 491     }
 492     if (   $patroninformation->{'debarred'}
 493         && $patroninformation->{'debarred'} == 1 )
 494     {
 495         my %flaginfo;
 496         $flaginfo{'message'}  = 'Borrower is Debarred.';
 497         $flaginfo{'noissues'} = 1;
 498         $flags{'DBARRED'}     = \%flaginfo;
 499     }
 500     if (   $patroninformation->{'borrowernotes'}
 501         && $patroninformation->{'borrowernotes'} )
 502     {
 503         my %flaginfo;
 504         $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
 505         $flags{'NOTES'}      = \%flaginfo;
 506     }
 507     my ( $odues, $itemsoverdue ) = checkoverdues($patroninformation->{'borrowernumber'});
 508     if ( $odues && $odues > 0 ) {
 509         my %flaginfo;
 510         $flaginfo{'message'}  = "Yes";
 511         $flaginfo{'itemlist'} = $itemsoverdue;
 512         foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
 513             @$itemsoverdue )
 514         {
 515             $flaginfo{'itemlisttext'} .=
 516               "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n";  # newline is display layer
 517         }
 518         $flags{'ODUES'} = \%flaginfo;
 519     }
 520     my @itemswaiting = C4::Reserves::GetReservesFromBorrowernumber( $patroninformation->{'borrowernumber'},'W' );
 521     my $nowaiting = scalar @itemswaiting;
 522     if ( $nowaiting > 0 ) {
 523         my %flaginfo;
 524         $flaginfo{'message'}  = "Reserved items available";
 525         $flaginfo{'itemlist'} = \@itemswaiting;
 526         $flags{'WAITING'}     = \%flaginfo;
 527     }
 528     return ( \%flags );
 529 }
 530
 531
 532 =head2 GetMember
 533
 534   $borrower = &GetMember(%information);
 535
 536 Retrieve the first patron record meeting on criteria listed in the
 537 C<%information> hash, which should contain one or more
 538 pairs of borrowers column names and values, e.g.,
 539
 540    $borrower = GetMember(borrowernumber => id);
 541
 542 C<&GetBorrower> returns a reference-to-hash whose keys are the fields of
 543 the C<borrowers> table in the Koha database.
 544
 545 FIXME: GetMember() is used throughout the code as a lookup
 546 on a unique key such as the borrowernumber, but this meaning is not
 547 enforced in the routine itself.
 548
 549 =cut
 550
 551 #'
 552 sub GetMember {
 553     my ( %information ) = @_;
 554     if (exists $information{borrowernumber} && !defined $information{borrowernumber}) {
 555         #passing mysql's kohaadmin?? Makes no sense as a query
 556         return;
 557     }
 558     my $dbh = C4::Context->dbh;
 559     my $select =
 560     q{SELECT borrowers.*, categories.category_type, categories.description
 561     FROM borrowers
 562     LEFT JOIN categories on borrowers.categorycode=categories.categorycode WHERE };
 563     my $more_p = 0;
 564     my @values = ();
 565     for (keys %information ) {
 566         if ($more_p) {
 567             $select .= ' AND ';
 568         }
 569         else {
 570             $more_p++;
 571         }
 572
 573         if (defined $information{$_}) {
 574             $select .= "$_ = ?";
 575             push @values, $information{$_};
 576         }
 577         else {
 578             $select .= "$_ IS NULL";
 579         }
 580     }
 581     $debug && warn $select, " ",values %information;
 582     my $sth = $dbh->prepare("$select");
 583     $sth->execute(map{$information{$_}} keys %information);
 584     my $data = $sth->fetchall_arrayref({});
 585     #FIXME interface to this routine now allows generation of a result set
 586     #so whole array should be returned but bowhere in the current code expects this
 587     if (@{$data} ) {
 588         return $data->[0];
 589     }
 590
 591     return;
 592 }
 593
 594 =head2 GetMemberRelatives
 595
 596  @borrowernumbers = GetMemberRelatives($borrowernumber);
 597
 598  C<GetMemberRelatives> returns a borrowersnumber's list of guarantor/guarantees of the member given in parameter
 599
 600 =cut
 601 sub GetMemberRelatives {
 602     my $borrowernumber = shift;
 603     my $dbh = C4::Context->dbh;
 604     my @glist;
 605
 606     # Getting guarantor
 607     my $query = "SELECT guarantorid FROM borrowers WHERE borrowernumber=?";
 608     my $sth = $dbh->prepare($query);
 609     $sth->execute($borrowernumber);
 610     my $data = $sth->fetchrow_arrayref();
 611     push @glist, $data->[0] if $data->[0];
 612     my $guarantor = $data->[0] if $data->[0];
 613
 614     # Getting guarantees
 615     $query = "SELECT borrowernumber FROM borrowers WHERE guarantorid=?";
 616     $sth = $dbh->prepare($query);
 617     $sth->execute($borrowernumber);
 618     while ($data = $sth->fetchrow_arrayref()) {
 619        push @glist, $data->[0];
 620     }
 621
 622     # Getting sibling guarantees
 623     if ($guarantor) {
 624         $query = "SELECT borrowernumber FROM borrowers WHERE guarantorid=?";
 625         $sth = $dbh->prepare($query);
 626         $sth->execute($guarantor);
 627         while ($data = $sth->fetchrow_arrayref()) {
 628            push @glist, $data->[0] if ($data->[0] != $borrowernumber);
 629         }
 630     }
 631
 632     return @glist;
 633 }
 634
 635 =head2 IsMemberBlocked
 636
 637   my ($block_status, $count) = IsMemberBlocked( $borrowernumber );
 638
 639 Returns whether a patron has overdue items that may result
 640 in a block or whether the patron has active fine days
 641 that would block circulation privileges.
 642
 643 C<$block_status> can have the following values:
 644
 645 1 if the patron has outstanding fine days, in which case C<$count> is the number of them
 646
 647 -1 if the patron has overdue items, in which case C<$count> is the number of them
 648
 649 0 if the patron has no overdue items or outstanding fine days, in which case C<$count> is 0
 650
 651 Outstanding fine days are checked before current overdue items
 652 are.
 653
 654 FIXME: this needs to be split into two functions; a potential block
 655 based on the number of current overdue items could be orthogonal
 656 to a block based on whether the patron has any fine days accrued.
 657
 658 =cut
 659
 660 sub IsMemberBlocked {
 661     my $borrowernumber = shift;
 662     my $dbh            = C4::Context->dbh;
 663
 664     # does patron have current fine days?
 665         my $strsth=qq{
 666             SELECT
 667             ADDDATE(returndate, finedays * DATEDIFF(returndate,date_due) ) AS blockingdate,
 668             DATEDIFF(ADDDATE(returndate, finedays * DATEDIFF(returndate,date_due)),NOW()) AS blockedcount
 669             FROM old_issues
 670         };
 671     if(C4::Context->preference("item-level_itypes")){
 672         $strsth.=
 673                 qq{ LEFT JOIN items ON (items.itemnumber=old_issues.itemnumber)
 674             LEFT JOIN issuingrules ON (issuingrules.itemtype=items.itype)}
 675     }else{
 676         $strsth .=
 677                 qq{ LEFT JOIN items ON (items.itemnumber=old_issues.itemnumber)
 678             LEFT JOIN biblioitems ON (biblioitems.biblioitemnumber=items.biblioitemnumber)
 679             LEFT JOIN issuingrules ON (issuingrules.itemtype=biblioitems.itemtype) };
 680     }
 681         $strsth.=
 682         qq{ WHERE finedays IS NOT NULL
 683             AND  date_due < returndate
 684             AND borrowernumber = ?
 685             ORDER BY blockingdate DESC, blockedcount DESC
 686             LIMIT 1};
 687         my $sth=$dbh->prepare($strsth);
 688     $sth->execute($borrowernumber);
 689     my $row = $sth->fetchrow_hashref;
 690     my $blockeddate  = $row->{'blockeddate'};
 691     my $blockedcount = $row->{'blockedcount'};
 692
 693     return (1, $blockedcount) if $blockedcount > 0;
 694
 695     # if he have late issues
 696     $sth = $dbh->prepare(
 697         "SELECT COUNT(*) as latedocs
 698          FROM issues
 699          WHERE borrowernumber = ?
 700          AND date_due < curdate()"
 701     );
 702     $sth->execute($borrowernumber);
 703     my $latedocs = $sth->fetchrow_hashref->{'latedocs'};
 704
 705     return (-1, $latedocs) if $latedocs > 0;
 706
 707     return (0, 0);
 708 }
 709
 710 =head2 GetMemberIssuesAndFines
 711
 712   ($overdue_count, $issue_count, $total_fines) = &GetMemberIssuesAndFines($borrowernumber);
 713
 714 Returns aggregate data about items borrowed by the patron with the
 715 given borrowernumber.
 716
 717 C<&GetMemberIssuesAndFines> returns a three-element array.  C<$overdue_count> is the
 718 number of overdue items the patron currently has borrowed. C<$issue_count> is the
 719 number of books the patron currently has borrowed.  C<$total_fines> is
 720 the total fine currently due by the borrower.
 721
 722 =cut
 723
 724 #'
 725 sub GetMemberIssuesAndFines {
 726     my ( $borrowernumber ) = @_;
 727     my $dbh   = C4::Context->dbh;
 728     my $query = "SELECT COUNT(*) FROM issues WHERE borrowernumber = ?";
 729
 730     $debug and warn $query."\n";
 731     my $sth = $dbh->prepare($query);
 732     $sth->execute($borrowernumber);
 733     my $issue_count = $sth->fetchrow_arrayref->[0];
 734
 735     $sth = $dbh->prepare(
 736         "SELECT COUNT(*) FROM issues
 737          WHERE borrowernumber = ?
 738          AND date_due < curdate()"
 739     );
 740     $sth->execute($borrowernumber);
 741     my $overdue_count = $sth->fetchrow_arrayref->[0];
 742
 743     $sth = $dbh->prepare("SELECT SUM(amountoutstanding) FROM accountlines WHERE borrowernumber = ?");
 744     $sth->execute($borrowernumber);
 745     my $total_fines = $sth->fetchrow_arrayref->[0];
 746
 747     return ($overdue_count, $issue_count, $total_fines);
 748 }
 749
 750 sub columns(;$) {
 751     return @{C4::Context->dbh->selectcol_arrayref("SHOW columns from borrowers")};
 752 }
 753
 754 =head2 ModMember
 755
 756   my $success = ModMember(borrowernumber => $borrowernumber,
 757                                             [ field => value ]... );
 758
 759 Modify borrower's data.  All date fields should ALREADY be in ISO format.
 760
 761 return :
 762 true on success, or false on failure
 763
 764 =cut
 765
 766 sub ModMember {
 767     my (%data) = @_;
 768     # test to know if you must update or not the borrower password
 769     if (exists $data{password}) {
 770         if ($data{password} eq '****' or $data{password} eq '') {
 771             delete $data{password};
 772         } else {
 773             $data{password} = md5_base64($data{password});
 774         }
 775     }
 776         my $execute_success=UpdateInTable("borrowers",\%data);
 777     if ($execute_success) { # only proceed if the update was a success
 778         # ok if its an adult (type) it may have borrowers that depend on it as a guarantor
 779         # so when we update information for an adult we should check for guarantees and update the relevant part
 780         # of their records, ie addresses and phone numbers
 781         my $borrowercategory= GetBorrowercategory( $data{'category_type'} );
 782         if ( exists  $borrowercategory->{'category_type'} && $borrowercategory->{'category_type'} eq ('A' || 'S') ) {
 783             # is adult check guarantees;
 784             UpdateGuarantees(%data);
 785         }
 786         logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "UPDATE (executed w/ arg: $data{'borrowernumber'})") if C4::Context->preference("BorrowersLog");
 787     }
 788     return $execute_success;
 789 }
 790
 791
 792 =head2 AddMember
 793
 794   $borrowernumber = &AddMember(%borrower);
 795
 796 insert new borrower into table
 797 Returns the borrowernumber upon success
 798
 799 Returns as undef upon any db error without further processing
 800
 801 =cut
 802
 803 #'
 804 sub AddMember {
 805     my (%data) = @_;
 806     my $dbh = C4::Context->dbh;
 807         # generate a proper login if none provided
 808         $data{'userid'} = Generate_Userid($data{'borrowernumber'}, $data{'firstname'}, $data{'surname'}) if $data{'userid'} eq '';
 809         # create a disabled account if no password provided
 810         $data{'password'} = ($data{'password'})? md5_base64($data{'password'}) : '!';
 811         $data{'borrowernumber'}=InsertInTable("borrowers",\%data);
 812     # mysql_insertid is probably bad.  not necessarily accurate and mysql-specific at best.
 813     logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
 814
 815     # check for enrollment fee & add it if needed
 816     my $sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
 817     $sth->execute($data{'categorycode'});
 818     my ($enrolmentfee) = $sth->fetchrow;
 819     if ($sth->err) {
 820         warn sprintf('Database returned the following error: %s', $sth->errstr);
 821         return;
 822     }
 823     if ($enrolmentfee && $enrolmentfee > 0) {
 824         # insert fee in patron debts
 825         manualinvoice($data{'borrowernumber'}, '', '', 'A', $enrolmentfee);
 826     }
 827
 828     return $data{'borrowernumber'};
 829 }
 830
 831
 832 sub Check_Userid {
 833     my ($uid,$member) = @_;
 834     my $dbh = C4::Context->dbh;
 835     # Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
 836     # Then we need to tell the user and have them create a new one.
 837     my $sth =
 838       $dbh->prepare(
 839         "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
 840     $sth->execute( $uid, $member );
 841     if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
 842         return 0;
 843     }
 844     else {
 845         return 1;
 846     }
 847 }
 848
 849 sub Generate_Userid {
 850   my ($borrowernumber, $firstname, $surname) = @_;
 851   my $newuid;
 852   my $offset = 0;
 853   do {
 854     $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
 855     $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
 856     $newuid = lc(($firstname)? "$firstname.$surname" : $surname);
 857     $newuid .= $offset unless $offset == 0;
 858     $offset++;
 859
 860    } while (!Check_Userid($newuid,$borrowernumber));
 861
 862    return $newuid;
 863 }
 864
 865 sub changepassword {
 866     my ( $uid, $member, $digest ) = @_;
 867     my $dbh = C4::Context->dbh;
 868
 869 #Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
 870 #Then we need to tell the user and have them create a new one.
 871     my $resultcode;
 872     my $sth =
 873       $dbh->prepare(
 874         "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
 875     $sth->execute( $uid, $member );
 876     if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
 877         $resultcode=0;
 878     }
 879     else {
 880         #Everything is good so we can update the information.
 881         $sth =
 882           $dbh->prepare(
 883             "update borrowers set userid=?, password=? where borrowernumber=?");
 884         $sth->execute( $uid, $digest, $member );
 885         $resultcode=1;
 886     }
 887
 888     logaction("MEMBERS", "CHANGE PASS", $member, "") if C4::Context->preference("BorrowersLog");
 889     return $resultcode;
 890 }
 891
 892
 893
 894 =head2 fixup_cardnumber
 895
 896 Warning: The caller is responsible for locking the members table in write
 897 mode, to avoid database corruption.
 898
 899 =cut
 900
 901 use vars qw( @weightings );
 902 my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
 903
 904 sub fixup_cardnumber ($) {
 905     my ($cardnumber) = @_;
 906     my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;
 907
 908     # Find out whether member numbers should be generated
 909     # automatically. Should be either "1" or something else.
 910     # Defaults to "0", which is interpreted as "no".
 911
 912     #     if ($cardnumber !~ /\S/ && $autonumber_members) {
 913     ($autonumber_members) or return $cardnumber;
 914     my $checkdigit = C4::Context->preference('checkdigit');
 915     my $dbh = C4::Context->dbh;
 916     if ( $checkdigit and $checkdigit eq 'katipo' ) {
 917
 918         # if checkdigit is selected, calculate katipo-style cardnumber.
 919         # otherwise, just use the max()
 920         # purpose: generate checksum'd member numbers.
 921         # We'll assume we just got the max value of digits 2-8 of member #'s
 922         # from the database and our job is to increment that by one,
 923         # determine the 1st and 9th digits and return the full string.
 924         my $sth = $dbh->prepare(
 925             "select max(substring(borrowers.cardnumber,2,7)) as new_num from borrowers"
 926         );
 927         $sth->execute;
 928         my $data = $sth->fetchrow_hashref;
 929         $cardnumber = $data->{new_num};
 930         if ( !$cardnumber ) {    # If DB has no values,
 931             $cardnumber = 1000000;    # start at 1000000
 932         } else {
 933             $cardnumber += 1;
 934         }
 935
 936         my $sum = 0;
 937         for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
 938             # read weightings, left to right, 1 char at a time
 939             my $temp1 = $weightings[$i];
 940
 941             # sequence left to right, 1 char at a time
 942             my $temp2 = substr( $cardnumber, $i, 1 );
 943
 944             # mult each char 1-7 by its corresponding weighting
 945             $sum += $temp1 * $temp2;
 946         }
 947
 948         my $rem = ( $sum % 11 );
 949         $rem = 'X' if $rem == 10;
 950
 951         return "V$cardnumber$rem";
 952      } else {
 953
 954      # MODIFIED BY JF: mysql4.1 allows casting as an integer, which is probably
 955      # better. I'll leave the original in in case it needs to be changed for you
 956      # my $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers");
 957         my $sth = $dbh->prepare(
 958             "select max(cast(cardnumber as signed)) from borrowers"
 959         );
 960         $sth->execute;
 961         my ($result) = $sth->fetchrow;
 962         return $result + 1;
 963     }
 964     return $cardnumber;     # just here as a fallback/reminder
 965 }
 966
 967 =head2 GetGuarantees
 968
 969   ($num_children, $children_arrayref) = &GetGuarantees($parent_borrno);
 970   $child0_cardno = $children_arrayref->[0]{"cardnumber"};
 971   $child0_borrno = $children_arrayref->[0]{"borrowernumber"};
 972
 973 C<&GetGuarantees> takes a borrower number (e.g., that of a patron
 974 with children) and looks up the borrowers who are guaranteed by that
 975 borrower (i.e., the patron's children).
 976
 977 C<&GetGuarantees> returns two values: an integer giving the number of
 978 borrowers guaranteed by C<$parent_borrno>, and a reference to an array
 979 of references to hash, which gives the actual results.
 980
 981 =cut
 982
 983 #'
 984 sub GetGuarantees {
 985     my ($borrowernumber) = @_;
 986     my $dbh              = C4::Context->dbh;
 987     my $sth              =
 988       $dbh->prepare(
 989 "select cardnumber,borrowernumber, firstname, surname from borrowers where guarantorid=?"
 990       );
 991     $sth->execute($borrowernumber);
 992
 993     my @dat;
 994     my $data = $sth->fetchall_arrayref({});
 995     return ( scalar(@$data), $data );
 996 }
 997
 998 =head2 UpdateGuarantees
 999
1000   &UpdateGuarantees($parent_borrno);
1001
1002
1003 C<&UpdateGuarantees> borrower data for an adult and updates all the guarantees
1004 with the modified information
1005
1006 =cut
1007
1008 #'
1009 sub UpdateGuarantees {
1010     my %data = shift;
1011     my $dbh = C4::Context->dbh;
1012     my ( $count, $guarantees ) = GetGuarantees( $data{'borrowernumber'} );
1013     foreach my $guarantee (@$guarantees){
1014         my $guaquery = qq|UPDATE borrowers
1015               SET address=?,fax=?,B_city=?,mobile=?,city=?,phone=?
1016               WHERE borrowernumber=?
1017         |;
1018         my $sth = $dbh->prepare($guaquery);
1019         $sth->execute($data{'address'},$data{'fax'},$data{'B_city'},$data{'mobile'},$data{'city'},$data{'phone'},$guarantee->{'borrowernumber'});
1020     }
1021 }
1022 =head2 GetPendingIssues
1023
1024   my $issues = &GetPendingIssues(@borrowernumber);
1025
1026 Looks up what the patron with the given borrowernumber has borrowed.
1027
1028 C<&GetPendingIssues> returns a
1029 reference-to-array where each element is a reference-to-hash; the
1030 keys are the fields from the C<issues>, C<biblio>, and C<items> tables.
1031 The keys include C<biblioitems> fields except marc and marcxml.
1032
1033 =cut
1034
1035 #'
1036 sub GetPendingIssues {
1037     my @borrowernumbers = @_;
1038
1039     unless (@borrowernumbers ) { # return a ref_to_array
1040         return \@borrowernumbers; # to not cause surprise to caller
1041     }
1042
1043     # Borrowers part of the query
1044     my $bquery = '';
1045     for (my $i = 0; $i < @borrowernumbers; $i++) {
1046         $bquery .= ' issues.borrowernumber = ?';
1047         if ($i < $#borrowernumbers ) {
1048             $bquery .= ' OR';
1049         }
1050     }
1051
1052     # must avoid biblioitems.* to prevent large marc and marcxml fields from killing performance
1053     # FIXME: namespace collision: each table has "timestamp" fields.  Which one is "timestamp" ?
1054     # FIXME: circ/ciculation.pl tries to sort by timestamp!
1055     # FIXME: C4::Print::printslip tries to sort by timestamp!
1056     # FIXME: namespace collision: other collisions possible.
1057     # FIXME: most of this data isn't really being used by callers.
1058     my $query =
1059    "SELECT issues.*,
1060             items.*,
1061            biblio.*,
1062            biblioitems.volume,
1063            biblioitems.number,
1064            biblioitems.itemtype,
1065            biblioitems.isbn,
1066            biblioitems.issn,
1067            biblioitems.publicationyear,
1068            biblioitems.publishercode,
1069            biblioitems.volumedate,
1070            biblioitems.volumedesc,
1071            biblioitems.lccn,
1072            biblioitems.url,
1073            borrowers.firstname,
1074            borrowers.surname,
1075            borrowers.cardnumber,
1076            issues.timestamp AS timestamp,
1077            issues.renewals  AS renewals,
1078            issues.borrowernumber AS borrowernumber,
1079             items.renewals  AS totalrenewals
1080     FROM   issues
1081     LEFT JOIN items       ON items.itemnumber       =      issues.itemnumber
1082     LEFT JOIN biblio      ON items.biblionumber     =      biblio.biblionumber
1083     LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
1084     LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
1085     WHERE
1086       $bquery
1087     ORDER BY issues.issuedate"
1088     ;
1089
1090     my $sth = C4::Context->dbh->prepare($query);
1091     $sth->execute(@borrowernumbers);
1092     my $data = $sth->fetchall_arrayref({});
1093     my $today = C4::Dates->new->output('iso');
1094     foreach (@{$data}) {
1095         if ($_->{date_due}  and $_->{date_due} lt $today) {
1096             $_->{overdue} = 1;
1097         }
1098     }
1099     return $data;
1100 }
1101
1102 =head2 GetAllIssues
1103
1104   $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
1105
1106 Looks up what the patron with the given borrowernumber has borrowed,
1107 and sorts the results.
1108
1109 C<$sortkey> is the name of a field on which to sort the results. This
1110 should be the name of a field in the C<issues>, C<biblio>,
1111 C<biblioitems>, or C<items> table in the Koha database.
1112
1113 C<$limit> is the maximum number of results to return.
1114
1115 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
1116 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
1117 C<items> tables of the Koha database.
1118
1119 =cut
1120
1121 #'
1122 sub GetAllIssues {
1123     my ( $borrowernumber, $order, $limit ) = @_;
1124
1125     #FIXME: sanity-check order and limit
1126     my $dbh   = C4::Context->dbh;
1127     my $query =
1128   "SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1129   FROM issues
1130   LEFT JOIN items on items.itemnumber=issues.itemnumber
1131   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1132   LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1133   WHERE borrowernumber=?
1134   UNION ALL
1135   SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1136   FROM old_issues
1137   LEFT JOIN items on items.itemnumber=old_issues.itemnumber
1138   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1139   LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1140   WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL
1141   order by $order";
1142     if ( $limit != 0 ) {
1143         $query .= " limit $limit";
1144     }
1145
1146     my $sth = $dbh->prepare($query);
1147     $sth->execute($borrowernumber, $borrowernumber);
1148     my @result;
1149     my $i = 0;
1150     while ( my $data = $sth->fetchrow_hashref ) {
1151         push @result, $data;
1152     }
1153
1154     return \@result;
1155 }
1156
1157
1158 =head2 GetMemberAccountRecords
1159
1160   ($total, $acctlines, $count) = &GetMemberAccountRecords($borrowernumber);
1161
1162 Looks up accounting data for the patron with the given borrowernumber.
1163
1164 C<&GetMemberAccountRecords> returns a three-element array. C<$acctlines> is a
1165 reference-to-array, where each element is a reference-to-hash; the
1166 keys are the fields of the C<accountlines> table in the Koha database.
1167 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1168 total amount outstanding for all of the account lines.
1169
1170 =cut
1171
1172 #'
1173 sub GetMemberAccountRecords {
1174     my ($borrowernumber,$date) = @_;
1175     my $dbh = C4::Context->dbh;
1176     my @acctlines;
1177     my $numlines = 0;
1178     my $strsth      = qq(
1179                         SELECT *
1180                         FROM accountlines
1181                         WHERE borrowernumber=?);
1182     my @bind = ($borrowernumber);
1183     if ($date && $date ne ''){
1184             $strsth.=" AND date < ? ";
1185             push(@bind,$date);
1186     }
1187     $strsth.=" ORDER BY date desc,timestamp DESC";
1188     my $sth= $dbh->prepare( $strsth );
1189     $sth->execute( @bind );
1190     my $total = 0;
1191     while ( my $data = $sth->fetchrow_hashref ) {
1192         if ( $data->{itemnumber} ) {
1193             my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
1194             $data->{biblionumber} = $biblio->{biblionumber};
1195             $data->{title}        = $biblio->{title};
1196         }
1197         $acctlines[$numlines] = $data;
1198         $numlines++;
1199         $total += int(1000 * $data->{'amountoutstanding'}); # convert float to integer to avoid round-off errors
1200     }
1201     $total /= 1000;
1202     return ( $total, \@acctlines,$numlines);
1203 }
1204
1205 =head2 GetBorNotifyAcctRecord
1206
1207   ($total, $acctlines, $count) = &GetBorNotifyAcctRecord($params,$notifyid);
1208
1209 Looks up accounting data for the patron with the given borrowernumber per file number.
1210
1211 C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a
1212 reference-to-array, where each element is a reference-to-hash; the
1213 keys are the fields of the C<accountlines> table in the Koha database.
1214 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1215 total amount outstanding for all of the account lines.
1216
1217 =cut
1218
1219 sub GetBorNotifyAcctRecord {
1220     my ( $borrowernumber, $notifyid ) = @_;
1221     my $dbh = C4::Context->dbh;
1222     my @acctlines;
1223     my $numlines = 0;
1224     my $sth = $dbh->prepare(
1225             "SELECT *
1226                 FROM accountlines
1227                 WHERE borrowernumber=?
1228                     AND notify_id=?
1229                     AND amountoutstanding != '0'
1230                 ORDER BY notify_id,accounttype
1231                 ");
1232
1233     $sth->execute( $borrowernumber, $notifyid );
1234     my $total = 0;
1235     while ( my $data = $sth->fetchrow_hashref ) {
1236         $acctlines[$numlines] = $data;
1237         $numlines++;
1238         $total += int(100 * $data->{'amountoutstanding'});
1239     }
1240     $total /= 100;
1241     return ( $total, \@acctlines, $numlines );
1242 }
1243
1244 =head2 checkuniquemember (OUEST-PROVENCE)
1245
1246   ($result,$categorycode)  = &checkuniquemember($collectivity,$surname,$firstname,$dateofbirth);
1247
1248 Checks that a member exists or not in the database.
1249
1250 C<&result> is nonzero (=exist) or 0 (=does not exist)
1251 C<&categorycode> is from categorycode table
1252 C<&collectivity> is 1 (= we add a collectivity) or 0 (= we add a physical member)
1253 C<&surname> is the surname
1254 C<&firstname> is the firstname (only if collectivity=0)
1255 C<&dateofbirth> is the date of birth in ISO format (only if collectivity=0)
1256
1257 =cut
1258
1259 # FIXME: This function is not legitimate.  Multiple patrons might have the same first/last name and birthdate.
1260 # This is especially true since first name is not even a required field.
1261
1262 sub checkuniquemember {
1263     my ( $collectivity, $surname, $firstname, $dateofbirth ) = @_;
1264     my $dbh = C4::Context->dbh;
1265     my $request = ($collectivity) ?
1266         "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? " :
1267             ($dateofbirth) ?
1268             "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=?  and dateofbirth=?" :
1269             "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=?";
1270     my $sth = $dbh->prepare($request);
1271     if ($collectivity) {
1272         $sth->execute( uc($surname) );
1273     } elsif($dateofbirth){
1274         $sth->execute( uc($surname), ucfirst($firstname), $dateofbirth );
1275     }else{
1276         $sth->execute( uc($surname), ucfirst($firstname));
1277     }
1278     my @data = $sth->fetchrow;
1279     ( $data[0] ) and return $data[0], $data[1];
1280     return 0;
1281 }
1282
1283 sub checkcardnumber {
1284     my ($cardnumber,$borrowernumber) = @_;
1285     # If cardnumber is null, we assume they're allowed.
1286     return 0 if !defined($cardnumber);
1287     my $dbh = C4::Context->dbh;
1288     my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
1289     $query .= " AND borrowernumber <> ?" if ($borrowernumber);
1290   my $sth = $dbh->prepare($query);
1291   if ($borrowernumber) {
1292    $sth->execute($cardnumber,$borrowernumber);
1293   } else {
1294      $sth->execute($cardnumber);
1295   }
1296     if (my $data= $sth->fetchrow_hashref()){
1297         return 1;
1298     }
1299     else {
1300         return 0;
1301     }
1302 }
1303
1304
1305 =head2 getzipnamecity (OUEST-PROVENCE)
1306
1307 take all info from table city for the fields city and  zip
1308 check for the name and the zip code of the city selected
1309
1310 =cut
1311
1312 sub getzipnamecity {
1313     my ($cityid) = @_;
1314     my $dbh      = C4::Context->dbh;
1315     my $sth      =
1316       $dbh->prepare(
1317         "select city_name,city_state,city_zipcode,city_country from cities where cityid=? ");
1318     $sth->execute($cityid);
1319     my @data = $sth->fetchrow;
1320     return $data[0], $data[1], $data[2], $data[3];
1321 }
1322
1323
1324 =head2 getdcity (OUEST-PROVENCE)
1325
1326 recover cityid  with city_name condition
1327
1328 =cut
1329
1330 sub getidcity {
1331     my ($city_name) = @_;
1332     my $dbh = C4::Context->dbh;
1333     my $sth = $dbh->prepare("select cityid from cities where city_name=? ");
1334     $sth->execute($city_name);
1335     my $data = $sth->fetchrow;
1336     return $data;
1337 }
1338
1339 =head2 GetFirstValidEmailAddress
1340
1341   $email = GetFirstValidEmailAddress($borrowernumber);
1342
1343 Return the first valid email address for a borrower, given the borrowernumber.  For now, the order
1344 is defined as email, emailpro, B_email.  Returns the empty string if the borrower has no email
1345 addresses.
1346
1347 =cut
1348
1349 sub GetFirstValidEmailAddress {
1350     my $borrowernumber = shift;
1351     my $dbh = C4::Context->dbh;
1352     my $sth = $dbh->prepare( "SELECT email, emailpro, B_email FROM borrowers where borrowernumber = ? ");
1353     $sth->execute( $borrowernumber );
1354     my $data = $sth->fetchrow_hashref;
1355
1356     if ($data->{'email'}) {
1357        return $data->{'email'};
1358     } elsif ($data->{'emailpro'}) {
1359        return $data->{'emailpro'};
1360     } elsif ($data->{'B_email'}) {
1361        return $data->{'B_email'};
1362     } else {
1363        return '';
1364     }
1365 }
1366
1367 =head2 GetExpiryDate
1368
1369   $expirydate = GetExpiryDate($categorycode, $dateenrolled);
1370
1371 Calculate expiry date given a categorycode and starting date.  Date argument must be in ISO format.
1372 Return date is also in ISO format.
1373
1374 =cut
1375
1376 sub GetExpiryDate {
1377     my ( $categorycode, $dateenrolled ) = @_;
1378     my $enrolments;
1379     if ($categorycode) {
1380         my $dbh = C4::Context->dbh;
1381         my $sth = $dbh->prepare("SELECT enrolmentperiod,enrolmentperioddate FROM categories WHERE categorycode=?");
1382         $sth->execute($categorycode);
1383         $enrolments = $sth->fetchrow_hashref;
1384     }
1385     # die "GetExpiryDate: for enrollmentperiod $enrolmentperiod (category '$categorycode') starting $dateenrolled.\n";
1386     my @date = split (/-/,$dateenrolled);
1387     if($enrolments->{enrolmentperiod}){
1388         return sprintf("%04d-%02d-%02d", Add_Delta_YM(@date,0,$enrolments->{enrolmentperiod}));
1389     }else{
1390         return $enrolments->{enrolmentperioddate};
1391     }
1392 }
1393
1394 =head2 checkuserpassword (OUEST-PROVENCE)
1395
1396 check for the password and login are not used
1397 return the number of record
1398 0=> NOT USED 1=> USED
1399
1400 =cut
1401
1402 sub checkuserpassword {
1403     my ( $borrowernumber, $userid, $password ) = @_;
1404     $password = md5_base64($password);
1405     my $dbh = C4::Context->dbh;
1406     my $sth =
1407       $dbh->prepare(
1408 "Select count(*) from borrowers where borrowernumber !=? and userid =? and password=? "
1409       );
1410     $sth->execute( $borrowernumber, $userid, $password );
1411     my $number_rows = $sth->fetchrow;
1412     return $number_rows;
1413
1414 }
1415
1416 =head2 GetborCatFromCatType
1417
1418   ($codes_arrayref, $labels_hashref) = &GetborCatFromCatType();
1419
1420 Looks up the different types of borrowers in the database. Returns two
1421 elements: a reference-to-array, which lists the borrower category
1422 codes, and a reference-to-hash, which maps the borrower category codes
1423 to category descriptions.
1424
1425 =cut
1426
1427 #'
1428 sub GetborCatFromCatType {
1429     my ( $category_type, $action ) = @_;
1430         # FIXME - This API  seems both limited and dangerous.
1431     my $dbh     = C4::Context->dbh;
1432     my $request = qq|   SELECT categorycode,description
1433             FROM categories
1434             $action
1435             ORDER BY categorycode|;
1436     my $sth = $dbh->prepare($request);
1437         if ($action) {
1438         $sth->execute($category_type);
1439     }
1440     else {
1441         $sth->execute();
1442     }
1443
1444     my %labels;
1445     my @codes;
1446
1447     while ( my $data = $sth->fetchrow_hashref ) {
1448         push @codes, $data->{'categorycode'};
1449         $labels{ $data->{'categorycode'} } = $data->{'description'};
1450     }
1451     return ( \@codes, \%labels );
1452 }
1453
1454 =head2 GetBorrowercategory
1455
1456   $hashref = &GetBorrowercategory($categorycode);
1457
1458 Given the borrower's category code, the function returns the corresponding
1459 data hashref for a comprehensive information display.
1460
1461   $arrayref_hashref = &GetBorrowercategory;
1462
1463 If no category code provided, the function returns all the categories.
1464
1465 =cut
1466
1467 sub GetBorrowercategory {
1468     my ($catcode) = @_;
1469     my $dbh       = C4::Context->dbh;
1470     if ($catcode){
1471         my $sth       =
1472         $dbh->prepare(
1473     "SELECT description,dateofbirthrequired,upperagelimit,category_type
1474     FROM categories
1475     WHERE categorycode = ?"
1476         );
1477         $sth->execute($catcode);
1478         my $data =
1479         $sth->fetchrow_hashref;
1480         return $data;
1481     }
1482     return;
1483 }    # sub getborrowercategory
1484
1485 =head2 GetBorrowercategoryList
1486
1487   $arrayref_hashref = &GetBorrowercategoryList;
1488 If no category code provided, the function returns all the categories.
1489
1490 =cut
1491
1492 sub GetBorrowercategoryList {
1493     my $dbh       = C4::Context->dbh;
1494     my $sth       =
1495     $dbh->prepare(
1496     "SELECT *
1497     FROM categories
1498     ORDER BY description"
1499         );
1500     $sth->execute;
1501     my $data =
1502     $sth->fetchall_arrayref({});
1503     return $data;
1504 }    # sub getborrowercategory
1505
1506 =head2 ethnicitycategories
1507
1508   ($codes_arrayref, $labels_hashref) = &ethnicitycategories();
1509
1510 Looks up the different ethnic types in the database. Returns two
1511 elements: a reference-to-array, which lists the ethnicity codes, and a
1512 reference-to-hash, which maps the ethnicity codes to ethnicity
1513 descriptions.
1514
1515 =cut
1516
1517 #'
1518
1519 sub ethnicitycategories {
1520     my $dbh = C4::Context->dbh;
1521     my $sth = $dbh->prepare("Select code,name from ethnicity order by name");
1522     $sth->execute;
1523     my %labels;
1524     my @codes;
1525     while ( my $data = $sth->fetchrow_hashref ) {
1526         push @codes, $data->{'code'};
1527         $labels{ $data->{'code'} } = $data->{'name'};
1528     }
1529     return ( \@codes, \%labels );
1530 }
1531
1532 =head2 fixEthnicity
1533
1534   $ethn_name = &fixEthnicity($ethn_code);
1535
1536 Takes an ethnicity code (e.g., "european" or "pi") and returns the
1537 corresponding descriptive name from the C<ethnicity> table in the
1538 Koha database ("European" or "Pacific Islander").
1539
1540 =cut
1541
1542 #'
1543
1544 sub fixEthnicity {
1545     my $ethnicity = shift;
1546     return unless $ethnicity;
1547     my $dbh       = C4::Context->dbh;
1548     my $sth       = $dbh->prepare("Select name from ethnicity where code = ?");
1549     $sth->execute($ethnicity);
1550     my $data = $sth->fetchrow_hashref;
1551     return $data->{'name'};
1552 }    # sub fixEthnicity
1553
1554 =head2 GetAge
1555
1556   $dateofbirth,$date = &GetAge($date);
1557
1558 this function return the borrowers age with the value of dateofbirth
1559
1560 =cut
1561
1562 #'
1563 sub GetAge{
1564     my ( $date, $date_ref ) = @_;
1565
1566     if ( not defined $date_ref ) {
1567         $date_ref = sprintf( '%04d-%02d-%02d', Today() );
1568     }
1569
1570     my ( $year1, $month1, $day1 ) = split /-/, $date;
1571     my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
1572
1573     my $age = $year2 - $year1;
1574     if ( $month1 . $day1 > $month2 . $day2 ) {
1575         $age--;
1576     }
1577
1578     return $age;
1579 }    # sub get_age
1580
1581 =head2 get_institutions
1582
1583   $insitutions = get_institutions();
1584
1585 Just returns a list of all the borrowers of type I, borrownumber and name
1586
1587 =cut
1588
1589 #'
1590 sub get_institutions {
1591     my $dbh = C4::Context->dbh();
1592     my $sth =
1593       $dbh->prepare(
1594 "SELECT borrowernumber,surname FROM borrowers WHERE categorycode=? ORDER BY surname"
1595       );
1596     $sth->execute('I');
1597     my %orgs;
1598     while ( my $data = $sth->fetchrow_hashref() ) {
1599         $orgs{ $data->{'borrowernumber'} } = $data;
1600     }
1601     return ( \%orgs );
1602
1603 }    # sub get_institutions
1604
1605 =head2 add_member_orgs
1606
1607   add_member_orgs($borrowernumber,$borrowernumbers);
1608
1609 Takes a borrowernumber and a list of other borrowernumbers and inserts them into the borrowers_to_borrowers table
1610
1611 =cut
1612
1613 #'
1614 sub add_member_orgs {
1615     my ( $borrowernumber, $otherborrowers ) = @_;
1616     my $dbh   = C4::Context->dbh();
1617     my $query =
1618       "INSERT INTO borrowers_to_borrowers (borrower1,borrower2) VALUES (?,?)";
1619     my $sth = $dbh->prepare($query);
1620     foreach my $otherborrowernumber (@$otherborrowers) {
1621         $sth->execute( $borrowernumber, $otherborrowernumber );
1622     }
1623
1624 }    # sub add_member_orgs
1625
1626 =head2 GetCities
1627
1628   $cityarrayref = GetCities();
1629
1630   Returns an array_ref of the entries in the cities table
1631   If there are entries in the table an empty row is returned
1632   This is currently only used to populate a popup in memberentry
1633
1634 =cut
1635
1636 sub GetCities {
1637
1638     my $dbh   = C4::Context->dbh;
1639     my $city_arr = $dbh->selectall_arrayref(
1640         q|SELECT cityid,city_zipcode,city_name,city_state,city_country FROM cities ORDER BY city_name|,
1641         { Slice => {} });
1642     if ( @{$city_arr} ) {
1643         unshift @{$city_arr}, {
1644             city_zipcode => q{},
1645             city_name    => q{},
1646             cityid       => q{},
1647             city_state   => q{},
1648             city_country => q{},
1649         };
1650     }
1651
1652     return  $city_arr;
1653 }
1654
1655 =head2 GetSortDetails (OUEST-PROVENCE)
1656
1657   ($lib) = &GetSortDetails($category,$sortvalue);
1658
1659 Returns the authorized value  details
1660 C<&$lib>return value of authorized value details
1661 C<&$sortvalue>this is the value of authorized value
1662 C<&$category>this is the value of authorized value category
1663
1664 =cut
1665
1666 sub GetSortDetails {
1667     my ( $category, $sortvalue ) = @_;
1668     my $dbh   = C4::Context->dbh;
1669     my $query = qq|SELECT lib
1670         FROM authorised_values
1671         WHERE category=?
1672         AND authorised_value=? |;
1673     my $sth = $dbh->prepare($query);
1674     $sth->execute( $category, $sortvalue );
1675     my $lib = $sth->fetchrow;
1676     return ($lib) if ($lib);
1677     return ($sortvalue) unless ($lib);
1678 }
1679
1680 =head2 MoveMemberToDeleted
1681
1682   $result = &MoveMemberToDeleted($borrowernumber);
1683
1684 Copy the record from borrowers to deletedborrowers table.
1685
1686 =cut
1687
1688 # FIXME: should do it in one SQL statement w/ subquery
1689 # Otherwise, we should return the @data on success
1690
1691 sub MoveMemberToDeleted {
1692     my ($member) = shift or return;
1693     my $dbh = C4::Context->dbh;
1694     my $query = qq|SELECT *
1695           FROM borrowers
1696           WHERE borrowernumber=?|;
1697     my $sth = $dbh->prepare($query);
1698     $sth->execute($member);
1699     my @data = $sth->fetchrow_array;
1700     (@data) or return;  # if we got a bad borrowernumber, there's nothing to insert
1701     $sth =
1702       $dbh->prepare( "INSERT INTO deletedborrowers VALUES ("
1703           . ( "?," x ( scalar(@data) - 1 ) )
1704           . "?)" );
1705     $sth->execute(@data);
1706 }
1707
1708 =head2 DelMember
1709
1710     DelMember($borrowernumber);
1711
1712 This function remove directly a borrower whitout writing it on deleteborrower.
1713 + Deletes reserves for the borrower
1714
1715 =cut
1716
1717 sub DelMember {
1718     my $dbh            = C4::Context->dbh;
1719     my $borrowernumber = shift;
1720     #warn "in delmember with $borrowernumber";
1721     return unless $borrowernumber;    # borrowernumber is mandatory.
1722
1723     my $query = qq|DELETE
1724           FROM  reserves
1725           WHERE borrowernumber=?|;
1726     my $sth = $dbh->prepare($query);
1727     $sth->execute($borrowernumber);
1728     $query = "
1729        DELETE
1730        FROM borrowers
1731        WHERE borrowernumber = ?
1732    ";
1733     $sth = $dbh->prepare($query);
1734     $sth->execute($borrowernumber);
1735     logaction("MEMBERS", "DELETE", $borrowernumber, "") if C4::Context->preference("BorrowersLog");
1736     return $sth->rows;
1737 }
1738
1739 =head2 ExtendMemberSubscriptionTo (OUEST-PROVENCE)
1740
1741     $date = ExtendMemberSubscriptionTo($borrowerid, $date);
1742
1743 Extending the subscription to a given date or to the expiry date calculated on ISO date.
1744 Returns ISO date.
1745
1746 =cut
1747
1748 sub ExtendMemberSubscriptionTo {
1749     my ( $borrowerid,$date) = @_;
1750     my $dbh = C4::Context->dbh;
1751     my $borrower = GetMember('borrowernumber'=>$borrowerid);
1752     unless ($date){
1753       $date=POSIX::strftime("%Y-%m-%d",localtime());
1754       $date = GetExpiryDate( $borrower->{'categorycode'}, $date );
1755     }
1756     my $sth = $dbh->do(<<EOF);
1757 UPDATE borrowers
1758 SET  dateexpiry='$date'
1759 WHERE borrowernumber='$borrowerid'
1760 EOF
1761     # add enrolmentfee if needed
1762     $sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
1763     $sth->execute($borrower->{'categorycode'});
1764     my ($enrolmentfee) = $sth->fetchrow;
1765     if ($enrolmentfee && $enrolmentfee > 0) {
1766         # insert fee in patron debts
1767         manualinvoice($borrower->{'borrowernumber'}, '', '', 'A', $enrolmentfee);
1768     }
1769      logaction("MEMBERS", "RENEW", $borrower->{'borrowernumber'}, "Membership renewed")if C4::Context->preference("BorrowersLog");
1770     return $date if ($sth);
1771     return 0;
1772 }
1773
1774 =head2 GetRoadTypes (OUEST-PROVENCE)
1775
1776   ($idroadtypearrayref, $roadttype_hashref) = &GetRoadTypes();
1777
1778 Looks up the different road type . Returns two
1779 elements: a reference-to-array, which lists the id_roadtype
1780 codes, and a reference-to-hash, which maps the road type of the road .
1781
1782 =cut
1783
1784 sub GetRoadTypes {
1785     my $dbh   = C4::Context->dbh;
1786     my $query = qq|
1787 SELECT roadtypeid,road_type
1788 FROM roadtype
1789 ORDER BY road_type|;
1790     my $sth = $dbh->prepare($query);
1791     $sth->execute();
1792     my %roadtype;
1793     my @id;
1794
1795     #    insert empty value to create a empty choice in cgi popup
1796
1797     while ( my $data = $sth->fetchrow_hashref ) {
1798
1799         push @id, $data->{'roadtypeid'};
1800         $roadtype{ $data->{'roadtypeid'} } = $data->{'road_type'};
1801     }
1802
1803 #test to know if the table contain some records if no the function return nothing
1804     my $id = @id;
1805     if ( $id eq 0 ) {
1806         return ();
1807     }
1808     else {
1809         unshift( @id, "" );
1810         return ( \@id, \%roadtype );
1811     }
1812 }
1813
1814
1815
1816 =head2 GetTitles (OUEST-PROVENCE)
1817
1818   ($borrowertitle)= &GetTitles();
1819
1820 Looks up the different title . Returns array  with all borrowers title
1821
1822 =cut
1823
1824 sub GetTitles {
1825     my @borrowerTitle = split (/,|\|/,C4::Context->preference('BorrowersTitles'));
1826     unshift( @borrowerTitle, "" );
1827     my $count=@borrowerTitle;
1828     if ($count == 1){
1829         return ();
1830     }
1831     else {
1832         return ( \@borrowerTitle);
1833     }
1834 }
1835
1836 =head2 GetPatronImage
1837
1838     my ($imagedata, $dberror) = GetPatronImage($cardnumber);
1839
1840 Returns the mimetype and binary image data of the image for the patron with the supplied cardnumber.
1841
1842 =cut
1843
1844 sub GetPatronImage {
1845     my ($cardnumber) = @_;
1846     warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1847     my $dbh = C4::Context->dbh;
1848     my $query = 'SELECT mimetype, imagefile FROM patronimage WHERE cardnumber = ?';
1849     my $sth = $dbh->prepare($query);
1850     $sth->execute($cardnumber);
1851     my $imagedata = $sth->fetchrow_hashref;
1852     warn "Database error!" if $sth->errstr;
1853     return $imagedata, $sth->errstr;
1854 }
1855
1856 =head2 PutPatronImage
1857
1858     PutPatronImage($cardnumber, $mimetype, $imgfile);
1859
1860 Stores patron binary image data and mimetype in database.
1861 NOTE: This function is good for updating images as well as inserting new images in the database.
1862
1863 =cut
1864
1865 sub PutPatronImage {
1866     my ($cardnumber, $mimetype, $imgfile) = @_;
1867     warn "Parameters passed in: Cardnumber=$cardnumber, Mimetype=$mimetype, " . ($imgfile ? "Imagefile" : "No Imagefile") if $debug;
1868     my $dbh = C4::Context->dbh;
1869     my $query = "INSERT INTO patronimage (cardnumber, mimetype, imagefile) VALUES (?,?,?) ON DUPLICATE KEY UPDATE imagefile = ?;";
1870     my $sth = $dbh->prepare($query);
1871     $sth->execute($cardnumber,$mimetype,$imgfile,$imgfile);
1872     warn "Error returned inserting $cardnumber.$mimetype." if $sth->errstr;
1873     return $sth->errstr;
1874 }
1875
1876 =head2 RmPatronImage
1877
1878     my ($dberror) = RmPatronImage($cardnumber);
1879
1880 Removes the image for the patron with the supplied cardnumber.
1881
1882 =cut
1883
1884 sub RmPatronImage {
1885     my ($cardnumber) = @_;
1886     warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1887     my $dbh = C4::Context->dbh;
1888     my $query = "DELETE FROM patronimage WHERE cardnumber = ?;";
1889     my $sth = $dbh->prepare($query);
1890     $sth->execute($cardnumber);
1891     my $dberror = $sth->errstr;
1892     warn "Database error!" if $sth->errstr;
1893     return $dberror;
1894 }
1895
1896 =head2 GetHideLostItemsPreference
1897
1898   $hidelostitemspref = &GetHideLostItemsPreference($borrowernumber);
1899
1900 Returns the HideLostItems preference for the patron category of the supplied borrowernumber
1901 C<&$hidelostitemspref>return value of function, 0 or 1
1902
1903 =cut
1904
1905 sub GetHideLostItemsPreference {
1906     my ($borrowernumber) = @_;
1907     my $dbh = C4::Context->dbh;
1908     my $query = "SELECT hidelostitems FROM borrowers,categories WHERE borrowers.categorycode = categories.categorycode AND borrowernumber = ?";
1909     my $sth = $dbh->prepare($query);
1910     $sth->execute($borrowernumber);
1911     my $hidelostitems = $sth->fetchrow;
1912     return $hidelostitems;
1913 }
1914
1915 =head2 GetRoadTypeDetails (OUEST-PROVENCE)
1916
1917   ($roadtype) = &GetRoadTypeDetails($roadtypeid);
1918
1919 Returns the description of roadtype
1920 C<&$roadtype>return description of road type
1921 C<&$roadtypeid>this is the value of roadtype s
1922
1923 =cut
1924
1925 sub GetRoadTypeDetails {
1926     my ($roadtypeid) = @_;
1927     my $dbh          = C4::Context->dbh;
1928     my $query        = qq|
1929 SELECT road_type
1930 FROM roadtype
1931 WHERE roadtypeid=?|;
1932     my $sth = $dbh->prepare($query);
1933     $sth->execute($roadtypeid);
1934     my $roadtype = $sth->fetchrow;
1935     return ($roadtype);
1936 }
1937
1938 =head2 GetBorrowersWhoHaveNotBorrowedSince
1939
1940   &GetBorrowersWhoHaveNotBorrowedSince($date)
1941
1942 this function get all borrowers who haven't borrowed since the date given on input arg.
1943
1944 =cut
1945
1946 sub GetBorrowersWhoHaveNotBorrowedSince {
1947     my $filterdate = shift||POSIX::strftime("%Y-%m-%d",localtime());
1948     my $filterexpiry = shift;
1949     my $filterbranch = shift ||
1950                         ((C4::Context->preference('IndependantBranches')
1951                              && C4::Context->userenv
1952                              && C4::Context->userenv->{flags} % 2 !=1
1953                              && C4::Context->userenv->{branch})
1954                          ? C4::Context->userenv->{branch}
1955                          : "");
1956     my $dbh   = C4::Context->dbh;
1957     my $query = "
1958         SELECT borrowers.borrowernumber,
1959                max(old_issues.timestamp) as latestissue,
1960                max(issues.timestamp) as currentissue
1961         FROM   borrowers
1962         JOIN   categories USING (categorycode)
1963         LEFT JOIN old_issues USING (borrowernumber)
1964         LEFT JOIN issues USING (borrowernumber)
1965         WHERE  category_type <> 'S'
1966         AND borrowernumber NOT IN (SELECT guarantorid FROM borrowers WHERE guarantorid IS NOT NULL AND guarantorid <> 0)
1967    ";
1968     my @query_params;
1969     if ($filterbranch && $filterbranch ne ""){
1970         $query.=" AND borrowers.branchcode= ?";
1971         push @query_params,$filterbranch;
1972     }
1973     if($filterexpiry){
1974         $query .= " AND dateexpiry < ? ";
1975         push @query_params,$filterdate;
1976     }
1977     $query.=" GROUP BY borrowers.borrowernumber";
1978     if ($filterdate){
1979         $query.=" HAVING (latestissue < ? OR latestissue IS NULL)
1980                   AND currentissue IS NULL";
1981         push @query_params,$filterdate;
1982     }
1983     warn $query if $debug;
1984     my $sth = $dbh->prepare($query);
1985     if (scalar(@query_params)>0){
1986         $sth->execute(@query_params);
1987     }
1988     else {
1989         $sth->execute;
1990     }
1991
1992     my @results;
1993     while ( my $data = $sth->fetchrow_hashref ) {
1994         push @results, $data;
1995     }
1996     return \@results;
1997 }
1998
1999 =head2 GetBorrowersWhoHaveNeverBorrowed
2000
2001   $results = &GetBorrowersWhoHaveNeverBorrowed
2002
2003 This function get all borrowers who have never borrowed.
2004
2005 I<$result> is a ref to an array which all elements are a hasref.
2006
2007 =cut
2008
2009 sub GetBorrowersWhoHaveNeverBorrowed {
2010     my $filterbranch = shift ||
2011                         ((C4::Context->preference('IndependantBranches')
2012                              && C4::Context->userenv
2013                              && C4::Context->userenv->{flags} % 2 !=1
2014                              && C4::Context->userenv->{branch})
2015                          ? C4::Context->userenv->{branch}
2016                          : "");
2017     my $dbh   = C4::Context->dbh;
2018     my $query = "
2019         SELECT borrowers.borrowernumber,max(timestamp) as latestissue
2020         FROM   borrowers
2021           LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
2022         WHERE issues.borrowernumber IS NULL
2023    ";
2024     my @query_params;
2025     if ($filterbranch && $filterbranch ne ""){
2026         $query.=" AND borrowers.branchcode= ?";
2027         push @query_params,$filterbranch;
2028     }
2029     warn $query if $debug;
2030
2031     my $sth = $dbh->prepare($query);
2032     if (scalar(@query_params)>0){
2033         $sth->execute(@query_params);
2034     }
2035     else {
2036         $sth->execute;
2037     }
2038
2039     my @results;
2040     while ( my $data = $sth->fetchrow_hashref ) {
2041         push @results, $data;
2042     }
2043     return \@results;
2044 }
2045
2046 =head2 GetBorrowersWithIssuesHistoryOlderThan
2047
2048   $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
2049
2050 this function get all borrowers who has an issue history older than I<$date> given on input arg.
2051
2052 I<$result> is a ref to an array which all elements are a hashref.
2053 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2054
2055 =cut
2056
2057 sub GetBorrowersWithIssuesHistoryOlderThan {
2058     my $dbh  = C4::Context->dbh;
2059     my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
2060     my $filterbranch = shift ||
2061                         ((C4::Context->preference('IndependantBranches')
2062                              && C4::Context->userenv
2063                              && C4::Context->userenv->{flags} % 2 !=1
2064                              && C4::Context->userenv->{branch})
2065                          ? C4::Context->userenv->{branch}
2066                          : "");
2067     my $query = "
2068        SELECT count(borrowernumber) as n,borrowernumber
2069        FROM old_issues
2070        WHERE returndate < ?
2071          AND borrowernumber IS NOT NULL
2072     ";
2073     my @query_params;
2074     push @query_params, $date;
2075     if ($filterbranch){
2076         $query.="   AND branchcode = ?";
2077         push @query_params, $filterbranch;
2078     }
2079     $query.=" GROUP BY borrowernumber ";
2080     warn $query if $debug;
2081     my $sth = $dbh->prepare($query);
2082     $sth->execute(@query_params);
2083     my @results;
2084
2085     while ( my $data = $sth->fetchrow_hashref ) {
2086         push @results, $data;
2087     }
2088     return \@results;
2089 }
2090
2091 =head2 GetBorrowersNamesAndLatestIssue
2092
2093   $results = &GetBorrowersNamesAndLatestIssueList(@borrowernumbers)
2094
2095 this function get borrowers Names and surnames and Issue information.
2096
2097 I<@borrowernumbers> is an array which all elements are borrowernumbers.
2098 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2099
2100 =cut
2101
2102 sub GetBorrowersNamesAndLatestIssue {
2103     my $dbh  = C4::Context->dbh;
2104     my @borrowernumbers=@_;
2105     my $query = "
2106        SELECT surname,lastname, phone, email,max(timestamp)
2107        FROM borrowers
2108          LEFT JOIN issues ON borrowers.borrowernumber=issues.borrowernumber
2109        GROUP BY borrowernumber
2110    ";
2111     my $sth = $dbh->prepare($query);
2112     $sth->execute;
2113     my $results = $sth->fetchall_arrayref({});
2114     return $results;
2115 }
2116
2117 =head2 DebarMember
2118
2119   my $success = DebarMember( $borrowernumber );
2120
2121 marks a Member as debarred, and therefore unable to checkout any more
2122 items.
2123
2124 return :
2125 true on success, false on failure
2126
2127 =cut
2128
2129 sub DebarMember {
2130     my $borrowernumber = shift;
2131
2132     return unless defined $borrowernumber;
2133     return unless $borrowernumber =~ /^\d+$/;
2134
2135     return ModMember( borrowernumber => $borrowernumber,
2136                       debarred       => 1 );
2137
2138 }
2139
2140 =head2 ModPrivacy
2141
2142 =over 4
2143
2144 my $success = ModPrivacy( $borrowernumber, $privacy );
2145
2146 Update the privacy of a patron.
2147
2148 return :
2149 true on success, false on failure
2150
2151 =back
2152
2153 =cut
2154
2155 sub ModPrivacy {
2156     my $borrowernumber = shift;
2157     my $privacy = shift;
2158     return unless defined $borrowernumber;
2159     return unless $borrowernumber =~ /^\d+$/;
2160
2161     return ModMember( borrowernumber => $borrowernumber,
2162                       privacy        => $privacy );
2163 }
2164
2165 =head2 AddMessage
2166
2167   AddMessage( $borrowernumber, $message_type, $message, $branchcode );
2168
2169 Adds a message to the messages table for the given borrower.
2170
2171 Returns:
2172   True on success
2173   False on failure
2174
2175 =cut
2176
2177 sub AddMessage {
2178     my ( $borrowernumber, $message_type, $message, $branchcode ) = @_;
2179
2180     my $dbh  = C4::Context->dbh;
2181
2182     if ( ! ( $borrowernumber && $message_type && $message && $branchcode ) ) {
2183       return;
2184     }
2185
2186     my $query = "INSERT INTO messages ( borrowernumber, branchcode, message_type, message ) VALUES ( ?, ?, ?, ? )";
2187     my $sth = $dbh->prepare($query);
2188     $sth->execute( $borrowernumber, $branchcode, $message_type, $message );
2189
2190     return 1;
2191 }
2192
2193 =head2 GetMessages
2194
2195   GetMessages( $borrowernumber, $type );
2196
2197 $type is message type, B for borrower, or L for Librarian.
2198 Empty type returns all messages of any type.
2199
2200 Returns all messages for the given borrowernumber
2201
2202 =cut
2203
2204 sub GetMessages {
2205     my ( $borrowernumber, $type, $branchcode ) = @_;
2206
2207     if ( ! $type ) {
2208       $type = '%';
2209     }
2210
2211     my $dbh  = C4::Context->dbh;
2212
2213     my $query = "SELECT
2214                   branches.branchname,
2215                   messages.*,
2216                   message_date,
2217                   messages.branchcode LIKE '$branchcode' AS can_delete
2218                   FROM messages, branches
2219                   WHERE borrowernumber = ?
2220                   AND message_type LIKE ?
2221                   AND messages.branchcode = branches.branchcode
2222                   ORDER BY message_date DESC";
2223     my $sth = $dbh->prepare($query);
2224     $sth->execute( $borrowernumber, $type ) ;
2225     my @results;
2226
2227     while ( my $data = $sth->fetchrow_hashref ) {
2228         my $d = C4::Dates->new( $data->{message_date}, 'iso' );
2229         $data->{message_date_formatted} = $d->output;
2230         push @results, $data;
2231     }
2232     return \@results;
2233
2234 }
2235
2236 =head2 GetMessages
2237
2238   GetMessagesCount( $borrowernumber, $type );
2239
2240 $type is message type, B for borrower, or L for Librarian.
2241 Empty type returns all messages of any type.
2242
2243 Returns the number of messages for the given borrowernumber
2244
2245 =cut
2246
2247 sub GetMessagesCount {
2248     my ( $borrowernumber, $type, $branchcode ) = @_;
2249
2250     if ( ! $type ) {
2251       $type = '%';
2252     }
2253
2254     my $dbh  = C4::Context->dbh;
2255
2256     my $query = "SELECT COUNT(*) as MsgCount FROM messages WHERE borrowernumber = ? AND message_type LIKE ?";
2257     my $sth = $dbh->prepare($query);
2258     $sth->execute( $borrowernumber, $type ) ;
2259     my @results;
2260
2261     my $data = $sth->fetchrow_hashref;
2262     my $count = $data->{'MsgCount'};
2263
2264     return $count;
2265 }
2266
2267
2268
2269 =head2 DeleteMessage
2270
2271   DeleteMessage( $message_id );
2272
2273 =cut
2274
2275 sub DeleteMessage {
2276     my ( $message_id ) = @_;
2277
2278     my $dbh = C4::Context->dbh;
2279
2280     my $query = "DELETE FROM messages WHERE message_id = ?";
2281     my $sth = $dbh->prepare($query);
2282     $sth->execute( $message_id );
2283
2284 }
2285
2286 END { }    # module clean-up code here (global destructor)
2287
2288 1;
2289
2290 __END__
2291
2292 =head1 AUTHOR
2293
2294 Koha Team
2295
2296 =cut