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