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