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   ($count, $acctlines, $total) = &GetBorNotifyAcctRecord($params,$notifyid);
1208
1209 Looks up accounting data for the patron with the given borrowernumber per file number.
1210
1211 (FIXME - I'm not at all sure what this is about.)
1212
1213 C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a
1214 reference-to-array, where each element is a reference-to-hash; the
1215 keys are the fields of the C<accountlines> table in the Koha database.
1216 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1217 total amount outstanding for all of the account lines.
1218
1219 =cut
1220
1221 sub GetBorNotifyAcctRecord {
1222     my ( $borrowernumber, $notifyid ) = @_;
1223     my $dbh = C4::Context->dbh;
1224     my @acctlines;
1225     my $numlines = 0;
1226     my $sth = $dbh->prepare(
1227             "SELECT *
1228                 FROM accountlines
1229                 WHERE borrowernumber=?
1230                     AND notify_id=?
1231                     AND amountoutstanding != '0'
1232                 ORDER BY notify_id,accounttype
1233                 ");
1234 #                    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')
1235
1236     $sth->execute( $borrowernumber, $notifyid );
1237     my $total = 0;
1238     while ( my $data = $sth->fetchrow_hashref ) {
1239         $acctlines[$numlines] = $data;
1240         $numlines++;
1241         $total += int(100 * $data->{'amountoutstanding'});
1242     }
1243     $total /= 100;
1244     return ( $total, \@acctlines, $numlines );
1245 }
1246
1247 =head2 checkuniquemember (OUEST-PROVENCE)
1248
1249   ($result,$categorycode)  = &checkuniquemember($collectivity,$surname,$firstname,$dateofbirth);
1250
1251 Checks that a member exists or not in the database.
1252
1253 C<&result> is nonzero (=exist) or 0 (=does not exist)
1254 C<&categorycode> is from categorycode table
1255 C<&collectivity> is 1 (= we add a collectivity) or 0 (= we add a physical member)
1256 C<&surname> is the surname
1257 C<&firstname> is the firstname (only if collectivity=0)
1258 C<&dateofbirth> is the date of birth in ISO format (only if collectivity=0)
1259
1260 =cut
1261
1262 # FIXME: This function is not legitimate.  Multiple patrons might have the same first/last name and birthdate.
1263 # This is especially true since first name is not even a required field.
1264
1265 sub checkuniquemember {
1266     my ( $collectivity, $surname, $firstname, $dateofbirth ) = @_;
1267     my $dbh = C4::Context->dbh;
1268     my $request = ($collectivity) ?
1269         "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? " :
1270             ($dateofbirth) ?
1271             "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=?  and dateofbirth=?" :
1272             "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=?";
1273     my $sth = $dbh->prepare($request);
1274     if ($collectivity) {
1275         $sth->execute( uc($surname) );
1276     } elsif($dateofbirth){
1277         $sth->execute( uc($surname), ucfirst($firstname), $dateofbirth );
1278     }else{
1279         $sth->execute( uc($surname), ucfirst($firstname));
1280     }
1281     my @data = $sth->fetchrow;
1282     ( $data[0] ) and return $data[0], $data[1];
1283     return 0;
1284 }
1285
1286 sub checkcardnumber {
1287     my ($cardnumber,$borrowernumber) = @_;
1288     # If cardnumber is null, we assume they're allowed.
1289     return 0 if !defined($cardnumber);
1290     my $dbh = C4::Context->dbh;
1291     my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
1292     $query .= " AND borrowernumber <> ?" if ($borrowernumber);
1293   my $sth = $dbh->prepare($query);
1294   if ($borrowernumber) {
1295    $sth->execute($cardnumber,$borrowernumber);
1296   } else {
1297      $sth->execute($cardnumber);
1298   }
1299     if (my $data= $sth->fetchrow_hashref()){
1300         return 1;
1301     }
1302     else {
1303         return 0;
1304     }
1305 }
1306
1307
1308 =head2 getzipnamecity (OUEST-PROVENCE)
1309
1310 take all info from table city for the fields city and  zip
1311 check for the name and the zip code of the city selected
1312
1313 =cut
1314
1315 sub getzipnamecity {
1316     my ($cityid) = @_;
1317     my $dbh      = C4::Context->dbh;
1318     my $sth      =
1319       $dbh->prepare(
1320         "select city_name,city_state,city_zipcode,city_country from cities where cityid=? ");
1321     $sth->execute($cityid);
1322     my @data = $sth->fetchrow;
1323     return $data[0], $data[1], $data[2], $data[3];
1324 }
1325
1326
1327 =head2 getdcity (OUEST-PROVENCE)
1328
1329 recover cityid  with city_name condition
1330
1331 =cut
1332
1333 sub getidcity {
1334     my ($city_name) = @_;
1335     my $dbh = C4::Context->dbh;
1336     my $sth = $dbh->prepare("select cityid from cities where city_name=? ");
1337     $sth->execute($city_name);
1338     my $data = $sth->fetchrow;
1339     return $data;
1340 }
1341
1342 =head2 GetFirstValidEmailAddress
1343
1344   $email = GetFirstValidEmailAddress($borrowernumber);
1345
1346 Return the first valid email address for a borrower, given the borrowernumber.  For now, the order
1347 is defined as email, emailpro, B_email.  Returns the empty string if the borrower has no email
1348 addresses.
1349
1350 =cut
1351
1352 sub GetFirstValidEmailAddress {
1353     my $borrowernumber = shift;
1354     my $dbh = C4::Context->dbh;
1355     my $sth = $dbh->prepare( "SELECT email, emailpro, B_email FROM borrowers where borrowernumber = ? ");
1356     $sth->execute( $borrowernumber );
1357     my $data = $sth->fetchrow_hashref;
1358
1359     if ($data->{'email'}) {
1360        return $data->{'email'};
1361     } elsif ($data->{'emailpro'}) {
1362        return $data->{'emailpro'};
1363     } elsif ($data->{'B_email'}) {
1364        return $data->{'B_email'};
1365     } else {
1366        return '';
1367     }
1368 }
1369
1370 =head2 GetExpiryDate
1371
1372   $expirydate = GetExpiryDate($categorycode, $dateenrolled);
1373
1374 Calculate expiry date given a categorycode and starting date.  Date argument must be in ISO format.
1375 Return date is also in ISO format.
1376
1377 =cut
1378
1379 sub GetExpiryDate {
1380     my ( $categorycode, $dateenrolled ) = @_;
1381     my $enrolments;
1382     if ($categorycode) {
1383         my $dbh = C4::Context->dbh;
1384         my $sth = $dbh->prepare("SELECT enrolmentperiod,enrolmentperioddate FROM categories WHERE categorycode=?");
1385         $sth->execute($categorycode);
1386         $enrolments = $sth->fetchrow_hashref;
1387     }
1388     # die "GetExpiryDate: for enrollmentperiod $enrolmentperiod (category '$categorycode') starting $dateenrolled.\n";
1389     my @date = split (/-/,$dateenrolled);
1390     if($enrolments->{enrolmentperiod}){
1391         return sprintf("%04d-%02d-%02d", Add_Delta_YM(@date,0,$enrolments->{enrolmentperiod}));
1392     }else{
1393         return $enrolments->{enrolmentperioddate};
1394     }
1395 }
1396
1397 =head2 checkuserpassword (OUEST-PROVENCE)
1398
1399 check for the password and login are not used
1400 return the number of record
1401 0=> NOT USED 1=> USED
1402
1403 =cut
1404
1405 sub checkuserpassword {
1406     my ( $borrowernumber, $userid, $password ) = @_;
1407     $password = md5_base64($password);
1408     my $dbh = C4::Context->dbh;
1409     my $sth =
1410       $dbh->prepare(
1411 "Select count(*) from borrowers where borrowernumber !=? and userid =? and password=? "
1412       );
1413     $sth->execute( $borrowernumber, $userid, $password );
1414     my $number_rows = $sth->fetchrow;
1415     return $number_rows;
1416
1417 }
1418
1419 =head2 GetborCatFromCatType
1420
1421   ($codes_arrayref, $labels_hashref) = &GetborCatFromCatType();
1422
1423 Looks up the different types of borrowers in the database. Returns two
1424 elements: a reference-to-array, which lists the borrower category
1425 codes, and a reference-to-hash, which maps the borrower category codes
1426 to category descriptions.
1427
1428 =cut
1429
1430 #'
1431 sub GetborCatFromCatType {
1432     my ( $category_type, $action ) = @_;
1433         # FIXME - This API  seems both limited and dangerous.
1434     my $dbh     = C4::Context->dbh;
1435     my $request = qq|   SELECT categorycode,description
1436             FROM categories
1437             $action
1438             ORDER BY categorycode|;
1439     my $sth = $dbh->prepare($request);
1440         if ($action) {
1441         $sth->execute($category_type);
1442     }
1443     else {
1444         $sth->execute();
1445     }
1446
1447     my %labels;
1448     my @codes;
1449
1450     while ( my $data = $sth->fetchrow_hashref ) {
1451         push @codes, $data->{'categorycode'};
1452         $labels{ $data->{'categorycode'} } = $data->{'description'};
1453     }
1454     return ( \@codes, \%labels );
1455 }
1456
1457 =head2 GetBorrowercategory
1458
1459   $hashref = &GetBorrowercategory($categorycode);
1460
1461 Given the borrower's category code, the function returns the corresponding
1462 data hashref for a comprehensive information display.
1463
1464   $arrayref_hashref = &GetBorrowercategory;
1465
1466 If no category code provided, the function returns all the categories.
1467
1468 =cut
1469
1470 sub GetBorrowercategory {
1471     my ($catcode) = @_;
1472     my $dbh       = C4::Context->dbh;
1473     if ($catcode){
1474         my $sth       =
1475         $dbh->prepare(
1476     "SELECT description,dateofbirthrequired,upperagelimit,category_type
1477     FROM categories
1478     WHERE categorycode = ?"
1479         );
1480         $sth->execute($catcode);
1481         my $data =
1482         $sth->fetchrow_hashref;
1483         return $data;
1484     }
1485     return;
1486 }    # sub getborrowercategory
1487
1488 =head2 GetBorrowercategoryList
1489
1490   $arrayref_hashref = &GetBorrowercategoryList;
1491 If no category code provided, the function returns all the categories.
1492
1493 =cut
1494
1495 sub GetBorrowercategoryList {
1496     my $dbh       = C4::Context->dbh;
1497     my $sth       =
1498     $dbh->prepare(
1499     "SELECT *
1500     FROM categories
1501     ORDER BY description"
1502         );
1503     $sth->execute;
1504     my $data =
1505     $sth->fetchall_arrayref({});
1506     return $data;
1507 }    # sub getborrowercategory
1508
1509 =head2 ethnicitycategories
1510
1511   ($codes_arrayref, $labels_hashref) = &ethnicitycategories();
1512
1513 Looks up the different ethnic types in the database. Returns two
1514 elements: a reference-to-array, which lists the ethnicity codes, and a
1515 reference-to-hash, which maps the ethnicity codes to ethnicity
1516 descriptions.
1517
1518 =cut
1519
1520 #'
1521
1522 sub ethnicitycategories {
1523     my $dbh = C4::Context->dbh;
1524     my $sth = $dbh->prepare("Select code,name from ethnicity order by name");
1525     $sth->execute;
1526     my %labels;
1527     my @codes;
1528     while ( my $data = $sth->fetchrow_hashref ) {
1529         push @codes, $data->{'code'};
1530         $labels{ $data->{'code'} } = $data->{'name'};
1531     }
1532     return ( \@codes, \%labels );
1533 }
1534
1535 =head2 fixEthnicity
1536
1537   $ethn_name = &fixEthnicity($ethn_code);
1538
1539 Takes an ethnicity code (e.g., "european" or "pi") and returns the
1540 corresponding descriptive name from the C<ethnicity> table in the
1541 Koha database ("European" or "Pacific Islander").
1542
1543 =cut
1544
1545 #'
1546
1547 sub fixEthnicity {
1548     my $ethnicity = shift;
1549     return unless $ethnicity;
1550     my $dbh       = C4::Context->dbh;
1551     my $sth       = $dbh->prepare("Select name from ethnicity where code = ?");
1552     $sth->execute($ethnicity);
1553     my $data = $sth->fetchrow_hashref;
1554     return $data->{'name'};
1555 }    # sub fixEthnicity
1556
1557 =head2 GetAge
1558
1559   $dateofbirth,$date = &GetAge($date);
1560
1561 this function return the borrowers age with the value of dateofbirth
1562
1563 =cut
1564
1565 #'
1566 sub GetAge{
1567     my ( $date, $date_ref ) = @_;
1568
1569     if ( not defined $date_ref ) {
1570         $date_ref = sprintf( '%04d-%02d-%02d', Today() );
1571     }
1572
1573     my ( $year1, $month1, $day1 ) = split /-/, $date;
1574     my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
1575
1576     my $age = $year2 - $year1;
1577     if ( $month1 . $day1 > $month2 . $day2 ) {
1578         $age--;
1579     }
1580
1581     return $age;
1582 }    # sub get_age
1583
1584 =head2 get_institutions
1585
1586   $insitutions = get_institutions();
1587
1588 Just returns a list of all the borrowers of type I, borrownumber and name
1589
1590 =cut
1591
1592 #'
1593 sub get_institutions {
1594     my $dbh = C4::Context->dbh();
1595     my $sth =
1596       $dbh->prepare(
1597 "SELECT borrowernumber,surname FROM borrowers WHERE categorycode=? ORDER BY surname"
1598       );
1599     $sth->execute('I');
1600     my %orgs;
1601     while ( my $data = $sth->fetchrow_hashref() ) {
1602         $orgs{ $data->{'borrowernumber'} } = $data;
1603     }
1604     return ( \%orgs );
1605
1606 }    # sub get_institutions
1607
1608 =head2 add_member_orgs
1609
1610   add_member_orgs($borrowernumber,$borrowernumbers);
1611
1612 Takes a borrowernumber and a list of other borrowernumbers and inserts them into the borrowers_to_borrowers table
1613
1614 =cut
1615
1616 #'
1617 sub add_member_orgs {
1618     my ( $borrowernumber, $otherborrowers ) = @_;
1619     my $dbh   = C4::Context->dbh();
1620     my $query =
1621       "INSERT INTO borrowers_to_borrowers (borrower1,borrower2) VALUES (?,?)";
1622     my $sth = $dbh->prepare($query);
1623     foreach my $otherborrowernumber (@$otherborrowers) {
1624         $sth->execute( $borrowernumber, $otherborrowernumber );
1625     }
1626
1627 }    # sub add_member_orgs
1628
1629 =head2 GetCities
1630
1631   $cityarrayref = GetCities();
1632
1633   Returns an array_ref of the entries in the cities table
1634   If there are entries in the table an empty row is returned
1635   This is currently only used to populate a popup in memberentry
1636
1637 =cut
1638
1639 sub GetCities {
1640
1641     my $dbh   = C4::Context->dbh;
1642     my $city_arr = $dbh->selectall_arrayref(
1643         q|SELECT cityid,city_zipcode,city_name,city_state,city_country FROM cities ORDER BY city_name|,
1644         { Slice => {} });
1645     if ( @{$city_arr} ) {
1646         unshift @{$city_arr}, {
1647             city_zipcode => q{},
1648             city_name    => q{},
1649             cityid       => q{},
1650             city_state   => q{},
1651             city_country => q{},
1652         };
1653     }
1654
1655     return  $city_arr;
1656 }
1657
1658 =head2 GetSortDetails (OUEST-PROVENCE)
1659
1660   ($lib) = &GetSortDetails($category,$sortvalue);
1661
1662 Returns the authorized value  details
1663 C<&$lib>return value of authorized value details
1664 C<&$sortvalue>this is the value of authorized value
1665 C<&$category>this is the value of authorized value category
1666
1667 =cut
1668
1669 sub GetSortDetails {
1670     my ( $category, $sortvalue ) = @_;
1671     my $dbh   = C4::Context->dbh;
1672     my $query = qq|SELECT lib
1673         FROM authorised_values
1674         WHERE category=?
1675         AND authorised_value=? |;
1676     my $sth = $dbh->prepare($query);
1677     $sth->execute( $category, $sortvalue );
1678     my $lib = $sth->fetchrow;
1679     return ($lib) if ($lib);
1680     return ($sortvalue) unless ($lib);
1681 }
1682
1683 =head2 MoveMemberToDeleted
1684
1685   $result = &MoveMemberToDeleted($borrowernumber);
1686
1687 Copy the record from borrowers to deletedborrowers table.
1688
1689 =cut
1690
1691 # FIXME: should do it in one SQL statement w/ subquery
1692 # Otherwise, we should return the @data on success
1693
1694 sub MoveMemberToDeleted {
1695     my ($member) = shift or return;
1696     my $dbh = C4::Context->dbh;
1697     my $query = qq|SELECT *
1698           FROM borrowers
1699           WHERE borrowernumber=?|;
1700     my $sth = $dbh->prepare($query);
1701     $sth->execute($member);
1702     my @data = $sth->fetchrow_array;
1703     (@data) or return;  # if we got a bad borrowernumber, there's nothing to insert
1704     $sth =
1705       $dbh->prepare( "INSERT INTO deletedborrowers VALUES ("
1706           . ( "?," x ( scalar(@data) - 1 ) )
1707           . "?)" );
1708     $sth->execute(@data);
1709 }
1710
1711 =head2 DelMember
1712
1713     DelMember($borrowernumber);
1714
1715 This function remove directly a borrower whitout writing it on deleteborrower.
1716 + Deletes reserves for the borrower
1717
1718 =cut
1719
1720 sub DelMember {
1721     my $dbh            = C4::Context->dbh;
1722     my $borrowernumber = shift;
1723     #warn "in delmember with $borrowernumber";
1724     return unless $borrowernumber;    # borrowernumber is mandatory.
1725
1726     my $query = qq|DELETE
1727           FROM  reserves
1728           WHERE borrowernumber=?|;
1729     my $sth = $dbh->prepare($query);
1730     $sth->execute($borrowernumber);
1731     $query = "
1732        DELETE
1733        FROM borrowers
1734        WHERE borrowernumber = ?
1735    ";
1736     $sth = $dbh->prepare($query);
1737     $sth->execute($borrowernumber);
1738     logaction("MEMBERS", "DELETE", $borrowernumber, "") if C4::Context->preference("BorrowersLog");
1739     return $sth->rows;
1740 }
1741
1742 =head2 ExtendMemberSubscriptionTo (OUEST-PROVENCE)
1743
1744     $date = ExtendMemberSubscriptionTo($borrowerid, $date);
1745
1746 Extending the subscription to a given date or to the expiry date calculated on ISO date.
1747 Returns ISO date.
1748
1749 =cut
1750
1751 sub ExtendMemberSubscriptionTo {
1752     my ( $borrowerid,$date) = @_;
1753     my $dbh = C4::Context->dbh;
1754     my $borrower = GetMember('borrowernumber'=>$borrowerid);
1755     unless ($date){
1756       $date=POSIX::strftime("%Y-%m-%d",localtime());
1757       $date = GetExpiryDate( $borrower->{'categorycode'}, $date );
1758     }
1759     my $sth = $dbh->do(<<EOF);
1760 UPDATE borrowers
1761 SET  dateexpiry='$date'
1762 WHERE borrowernumber='$borrowerid'
1763 EOF
1764     # add enrolmentfee if needed
1765     $sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
1766     $sth->execute($borrower->{'categorycode'});
1767     my ($enrolmentfee) = $sth->fetchrow;
1768     if ($enrolmentfee && $enrolmentfee > 0) {
1769         # insert fee in patron debts
1770         manualinvoice($borrower->{'borrowernumber'}, '', '', 'A', $enrolmentfee);
1771     }
1772      logaction("MEMBERS", "RENEW", $borrower->{'borrowernumber'}, "Membership renewed")if C4::Context->preference("BorrowersLog");
1773     return $date if ($sth);
1774     return 0;
1775 }
1776
1777 =head2 GetRoadTypes (OUEST-PROVENCE)
1778
1779   ($idroadtypearrayref, $roadttype_hashref) = &GetRoadTypes();
1780
1781 Looks up the different road type . Returns two
1782 elements: a reference-to-array, which lists the id_roadtype
1783 codes, and a reference-to-hash, which maps the road type of the road .
1784
1785 =cut
1786
1787 sub GetRoadTypes {
1788     my $dbh   = C4::Context->dbh;
1789     my $query = qq|
1790 SELECT roadtypeid,road_type
1791 FROM roadtype
1792 ORDER BY road_type|;
1793     my $sth = $dbh->prepare($query);
1794     $sth->execute();
1795     my %roadtype;
1796     my @id;
1797
1798     #    insert empty value to create a empty choice in cgi popup
1799
1800     while ( my $data = $sth->fetchrow_hashref ) {
1801
1802         push @id, $data->{'roadtypeid'};
1803         $roadtype{ $data->{'roadtypeid'} } = $data->{'road_type'};
1804     }
1805
1806 #test to know if the table contain some records if no the function return nothing
1807     my $id = @id;
1808     if ( $id eq 0 ) {
1809         return ();
1810     }
1811     else {
1812         unshift( @id, "" );
1813         return ( \@id, \%roadtype );
1814     }
1815 }
1816
1817
1818
1819 =head2 GetTitles (OUEST-PROVENCE)
1820
1821   ($borrowertitle)= &GetTitles();
1822
1823 Looks up the different title . Returns array  with all borrowers title
1824
1825 =cut
1826
1827 sub GetTitles {
1828     my @borrowerTitle = split (/,|\|/,C4::Context->preference('BorrowersTitles'));
1829     unshift( @borrowerTitle, "" );
1830     my $count=@borrowerTitle;
1831     if ($count == 1){
1832         return ();
1833     }
1834     else {
1835         return ( \@borrowerTitle);
1836     }
1837 }
1838
1839 =head2 GetPatronImage
1840
1841     my ($imagedata, $dberror) = GetPatronImage($cardnumber);
1842
1843 Returns the mimetype and binary image data of the image for the patron with the supplied cardnumber.
1844
1845 =cut
1846
1847 sub GetPatronImage {
1848     my ($cardnumber) = @_;
1849     warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1850     my $dbh = C4::Context->dbh;
1851     my $query = 'SELECT mimetype, imagefile FROM patronimage WHERE cardnumber = ?';
1852     my $sth = $dbh->prepare($query);
1853     $sth->execute($cardnumber);
1854     my $imagedata = $sth->fetchrow_hashref;
1855     warn "Database error!" if $sth->errstr;
1856     return $imagedata, $sth->errstr;
1857 }
1858
1859 =head2 PutPatronImage
1860
1861     PutPatronImage($cardnumber, $mimetype, $imgfile);
1862
1863 Stores patron binary image data and mimetype in database.
1864 NOTE: This function is good for updating images as well as inserting new images in the database.
1865
1866 =cut
1867
1868 sub PutPatronImage {
1869     my ($cardnumber, $mimetype, $imgfile) = @_;
1870     warn "Parameters passed in: Cardnumber=$cardnumber, Mimetype=$mimetype, " . ($imgfile ? "Imagefile" : "No Imagefile") if $debug;
1871     my $dbh = C4::Context->dbh;
1872     my $query = "INSERT INTO patronimage (cardnumber, mimetype, imagefile) VALUES (?,?,?) ON DUPLICATE KEY UPDATE imagefile = ?;";
1873     my $sth = $dbh->prepare($query);
1874     $sth->execute($cardnumber,$mimetype,$imgfile,$imgfile);
1875     warn "Error returned inserting $cardnumber.$mimetype." if $sth->errstr;
1876     return $sth->errstr;
1877 }
1878
1879 =head2 RmPatronImage
1880
1881     my ($dberror) = RmPatronImage($cardnumber);
1882
1883 Removes the image for the patron with the supplied cardnumber.
1884
1885 =cut
1886
1887 sub RmPatronImage {
1888     my ($cardnumber) = @_;
1889     warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1890     my $dbh = C4::Context->dbh;
1891     my $query = "DELETE FROM patronimage WHERE cardnumber = ?;";
1892     my $sth = $dbh->prepare($query);
1893     $sth->execute($cardnumber);
1894     my $dberror = $sth->errstr;
1895     warn "Database error!" if $sth->errstr;
1896     return $dberror;
1897 }
1898
1899 =head2 GetHideLostItemsPreference
1900
1901   $hidelostitemspref = &GetHideLostItemsPreference($borrowernumber);
1902
1903 Returns the HideLostItems preference for the patron category of the supplied borrowernumber
1904 C<&$hidelostitemspref>return value of function, 0 or 1
1905
1906 =cut
1907
1908 sub GetHideLostItemsPreference {
1909     my ($borrowernumber) = @_;
1910     my $dbh = C4::Context->dbh;
1911     my $query = "SELECT hidelostitems FROM borrowers,categories WHERE borrowers.categorycode = categories.categorycode AND borrowernumber = ?";
1912     my $sth = $dbh->prepare($query);
1913     $sth->execute($borrowernumber);
1914     my $hidelostitems = $sth->fetchrow;
1915     return $hidelostitems;
1916 }
1917
1918 =head2 GetRoadTypeDetails (OUEST-PROVENCE)
1919
1920   ($roadtype) = &GetRoadTypeDetails($roadtypeid);
1921
1922 Returns the description of roadtype
1923 C<&$roadtype>return description of road type
1924 C<&$roadtypeid>this is the value of roadtype s
1925
1926 =cut
1927
1928 sub GetRoadTypeDetails {
1929     my ($roadtypeid) = @_;
1930     my $dbh          = C4::Context->dbh;
1931     my $query        = qq|
1932 SELECT road_type
1933 FROM roadtype
1934 WHERE roadtypeid=?|;
1935     my $sth = $dbh->prepare($query);
1936     $sth->execute($roadtypeid);
1937     my $roadtype = $sth->fetchrow;
1938     return ($roadtype);
1939 }
1940
1941 =head2 GetBorrowersWhoHaveNotBorrowedSince
1942
1943   &GetBorrowersWhoHaveNotBorrowedSince($date)
1944
1945 this function get all borrowers who haven't borrowed since the date given on input arg.
1946
1947 =cut
1948
1949 sub GetBorrowersWhoHaveNotBorrowedSince {
1950     my $filterdate = shift||POSIX::strftime("%Y-%m-%d",localtime());
1951     my $filterexpiry = shift;
1952     my $filterbranch = shift ||
1953                         ((C4::Context->preference('IndependantBranches')
1954                              && C4::Context->userenv
1955                              && C4::Context->userenv->{flags} % 2 !=1
1956                              && C4::Context->userenv->{branch})
1957                          ? C4::Context->userenv->{branch}
1958                          : "");
1959     my $dbh   = C4::Context->dbh;
1960     my $query = "
1961         SELECT borrowers.borrowernumber,
1962                max(old_issues.timestamp) as latestissue,
1963                max(issues.timestamp) as currentissue
1964         FROM   borrowers
1965         JOIN   categories USING (categorycode)
1966         LEFT JOIN old_issues USING (borrowernumber)
1967         LEFT JOIN issues USING (borrowernumber)
1968         WHERE  category_type <> 'S'
1969         AND borrowernumber NOT IN (SELECT guarantorid FROM borrowers WHERE guarantorid IS NOT NULL AND guarantorid <> 0)
1970    ";
1971     my @query_params;
1972     if ($filterbranch && $filterbranch ne ""){
1973         $query.=" AND borrowers.branchcode= ?";
1974         push @query_params,$filterbranch;
1975     }
1976     if($filterexpiry){
1977         $query .= " AND dateexpiry < ? ";
1978         push @query_params,$filterdate;
1979     }
1980     $query.=" GROUP BY borrowers.borrowernumber";
1981     if ($filterdate){
1982         $query.=" HAVING (latestissue < ? OR latestissue IS NULL)
1983                   AND currentissue IS NULL";
1984         push @query_params,$filterdate;
1985     }
1986     warn $query if $debug;
1987     my $sth = $dbh->prepare($query);
1988     if (scalar(@query_params)>0){
1989         $sth->execute(@query_params);
1990     }
1991     else {
1992         $sth->execute;
1993     }
1994
1995     my @results;
1996     while ( my $data = $sth->fetchrow_hashref ) {
1997         push @results, $data;
1998     }
1999     return \@results;
2000 }
2001
2002 =head2 GetBorrowersWhoHaveNeverBorrowed
2003
2004   $results = &GetBorrowersWhoHaveNeverBorrowed
2005
2006 This function get all borrowers who have never borrowed.
2007
2008 I<$result> is a ref to an array which all elements are a hasref.
2009
2010 =cut
2011
2012 sub GetBorrowersWhoHaveNeverBorrowed {
2013     my $filterbranch = shift ||
2014                         ((C4::Context->preference('IndependantBranches')
2015                              && C4::Context->userenv
2016                              && C4::Context->userenv->{flags} % 2 !=1
2017                              && C4::Context->userenv->{branch})
2018                          ? C4::Context->userenv->{branch}
2019                          : "");
2020     my $dbh   = C4::Context->dbh;
2021     my $query = "
2022         SELECT borrowers.borrowernumber,max(timestamp) as latestissue
2023         FROM   borrowers
2024           LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
2025         WHERE issues.borrowernumber IS NULL
2026    ";
2027     my @query_params;
2028     if ($filterbranch && $filterbranch ne ""){
2029         $query.=" AND borrowers.branchcode= ?";
2030         push @query_params,$filterbranch;
2031     }
2032     warn $query if $debug;
2033
2034     my $sth = $dbh->prepare($query);
2035     if (scalar(@query_params)>0){
2036         $sth->execute(@query_params);
2037     }
2038     else {
2039         $sth->execute;
2040     }
2041
2042     my @results;
2043     while ( my $data = $sth->fetchrow_hashref ) {
2044         push @results, $data;
2045     }
2046     return \@results;
2047 }
2048
2049 =head2 GetBorrowersWithIssuesHistoryOlderThan
2050
2051   $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
2052
2053 this function get all borrowers who has an issue history older than I<$date> given on input arg.
2054
2055 I<$result> is a ref to an array which all elements are a hashref.
2056 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2057
2058 =cut
2059
2060 sub GetBorrowersWithIssuesHistoryOlderThan {
2061     my $dbh  = C4::Context->dbh;
2062     my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
2063     my $filterbranch = shift ||
2064                         ((C4::Context->preference('IndependantBranches')
2065                              && C4::Context->userenv
2066                              && C4::Context->userenv->{flags} % 2 !=1
2067                              && C4::Context->userenv->{branch})
2068                          ? C4::Context->userenv->{branch}
2069                          : "");
2070     my $query = "
2071        SELECT count(borrowernumber) as n,borrowernumber
2072        FROM old_issues
2073        WHERE returndate < ?
2074          AND borrowernumber IS NOT NULL
2075     ";
2076     my @query_params;
2077     push @query_params, $date;
2078     if ($filterbranch){
2079         $query.="   AND branchcode = ?";
2080         push @query_params, $filterbranch;
2081     }
2082     $query.=" GROUP BY borrowernumber ";
2083     warn $query if $debug;
2084     my $sth = $dbh->prepare($query);
2085     $sth->execute(@query_params);
2086     my @results;
2087
2088     while ( my $data = $sth->fetchrow_hashref ) {
2089         push @results, $data;
2090     }
2091     return \@results;
2092 }
2093
2094 =head2 GetBorrowersNamesAndLatestIssue
2095
2096   $results = &GetBorrowersNamesAndLatestIssueList(@borrowernumbers)
2097
2098 this function get borrowers Names and surnames and Issue information.
2099
2100 I<@borrowernumbers> is an array which all elements are borrowernumbers.
2101 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2102
2103 =cut
2104
2105 sub GetBorrowersNamesAndLatestIssue {
2106     my $dbh  = C4::Context->dbh;
2107     my @borrowernumbers=@_;
2108     my $query = "
2109        SELECT surname,lastname, phone, email,max(timestamp)
2110        FROM borrowers
2111          LEFT JOIN issues ON borrowers.borrowernumber=issues.borrowernumber
2112        GROUP BY borrowernumber
2113    ";
2114     my $sth = $dbh->prepare($query);
2115     $sth->execute;
2116     my $results = $sth->fetchall_arrayref({});
2117     return $results;
2118 }
2119
2120 =head2 DebarMember
2121
2122   my $success = DebarMember( $borrowernumber );
2123
2124 marks a Member as debarred, and therefore unable to checkout any more
2125 items.
2126
2127 return :
2128 true on success, false on failure
2129
2130 =cut
2131
2132 sub DebarMember {
2133     my $borrowernumber = shift;
2134
2135     return unless defined $borrowernumber;
2136     return unless $borrowernumber =~ /^\d+$/;
2137
2138     return ModMember( borrowernumber => $borrowernumber,
2139                       debarred       => 1 );
2140
2141 }
2142
2143 =head2 ModPrivacy
2144
2145 =over 4
2146
2147 my $success = ModPrivacy( $borrowernumber, $privacy );
2148
2149 Update the privacy of a patron.
2150
2151 return :
2152 true on success, false on failure
2153
2154 =back
2155
2156 =cut
2157
2158 sub ModPrivacy {
2159     my $borrowernumber = shift;
2160     my $privacy = shift;
2161     return unless defined $borrowernumber;
2162     return unless $borrowernumber =~ /^\d+$/;
2163
2164     return ModMember( borrowernumber => $borrowernumber,
2165                       privacy        => $privacy );
2166 }
2167
2168 =head2 AddMessage
2169
2170   AddMessage( $borrowernumber, $message_type, $message, $branchcode );
2171
2172 Adds a message to the messages table for the given borrower.
2173
2174 Returns:
2175   True on success
2176   False on failure
2177
2178 =cut
2179
2180 sub AddMessage {
2181     my ( $borrowernumber, $message_type, $message, $branchcode ) = @_;
2182
2183     my $dbh  = C4::Context->dbh;
2184
2185     if ( ! ( $borrowernumber && $message_type && $message && $branchcode ) ) {
2186       return;
2187     }
2188
2189     my $query = "INSERT INTO messages ( borrowernumber, branchcode, message_type, message ) VALUES ( ?, ?, ?, ? )";
2190     my $sth = $dbh->prepare($query);
2191     $sth->execute( $borrowernumber, $branchcode, $message_type, $message );
2192
2193     return 1;
2194 }
2195
2196 =head2 GetMessages
2197
2198   GetMessages( $borrowernumber, $type );
2199
2200 $type is message type, B for borrower, or L for Librarian.
2201 Empty type returns all messages of any type.
2202
2203 Returns all messages for the given borrowernumber
2204
2205 =cut
2206
2207 sub GetMessages {
2208     my ( $borrowernumber, $type, $branchcode ) = @_;
2209
2210     if ( ! $type ) {
2211       $type = '%';
2212     }
2213
2214     my $dbh  = C4::Context->dbh;
2215
2216     my $query = "SELECT
2217                   branches.branchname,
2218                   messages.*,
2219                   message_date,
2220                   messages.branchcode LIKE '$branchcode' AS can_delete
2221                   FROM messages, branches
2222                   WHERE borrowernumber = ?
2223                   AND message_type LIKE ?
2224                   AND messages.branchcode = branches.branchcode
2225                   ORDER BY message_date DESC";
2226     my $sth = $dbh->prepare($query);
2227     $sth->execute( $borrowernumber, $type ) ;
2228     my @results;
2229
2230     while ( my $data = $sth->fetchrow_hashref ) {
2231         my $d = C4::Dates->new( $data->{message_date}, 'iso' );
2232         $data->{message_date_formatted} = $d->output;
2233         push @results, $data;
2234     }
2235     return \@results;
2236
2237 }
2238
2239 =head2 GetMessages
2240
2241   GetMessagesCount( $borrowernumber, $type );
2242
2243 $type is message type, B for borrower, or L for Librarian.
2244 Empty type returns all messages of any type.
2245
2246 Returns the number of messages for the given borrowernumber
2247
2248 =cut
2249
2250 sub GetMessagesCount {
2251     my ( $borrowernumber, $type, $branchcode ) = @_;
2252
2253     if ( ! $type ) {
2254       $type = '%';
2255     }
2256
2257     my $dbh  = C4::Context->dbh;
2258
2259     my $query = "SELECT COUNT(*) as MsgCount FROM messages WHERE borrowernumber = ? AND message_type LIKE ?";
2260     my $sth = $dbh->prepare($query);
2261     $sth->execute( $borrowernumber, $type ) ;
2262     my @results;
2263
2264     my $data = $sth->fetchrow_hashref;
2265     my $count = $data->{'MsgCount'};
2266
2267     return $count;
2268 }
2269
2270
2271
2272 =head2 DeleteMessage
2273
2274   DeleteMessage( $message_id );
2275
2276 =cut
2277
2278 sub DeleteMessage {
2279     my ( $message_id ) = @_;
2280
2281     my $dbh = C4::Context->dbh;
2282
2283     my $query = "DELETE FROM messages WHERE message_id = ?";
2284     my $sth = $dbh->prepare($query);
2285     $sth->execute( $message_id );
2286
2287 }
2288
2289 END { }    # module clean-up code here (global destructor)
2290
2291 1;
2292
2293 __END__
2294
2295 =head1 AUTHOR
2296
2297 Koha Team
2298
2299 =cut