C4/Members.pm

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