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 overdue items, in which case C<$count> is the number of them
 593
 594 1 if the patron has outstanding fine days, 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 FIXME: this needs to be split into two functions; a potential block
 599 based on the number of current overdue items could be orthogonal
 600 to a block based on whether the patron has any fine days accrued.
 601
 602 =cut
 603
 604 sub IsMemberBlocked {
 605     my $borrowernumber = shift;
 606     my $dbh            = C4::Context->dbh;
 607     # if he have late issues
 608     my $sth = $dbh->prepare(
 609         "SELECT COUNT(*) as latedocs
 610          FROM issues
 611          WHERE borrowernumber = ?
 612          AND date_due < curdate()"
 613     );
 614     $sth->execute($borrowernumber);
 615     my $latedocs = $sth->fetchrow_hashref->{'latedocs'};
 616
 617     return (-1, $latedocs) if $latedocs > 0;
 618
 619         my $strsth=qq{
 620             SELECT
 621             ADDDATE(returndate, finedays * DATEDIFF(returndate,date_due) ) AS blockingdate,
 622             DATEDIFF(ADDDATE(returndate, finedays * DATEDIFF(returndate,date_due)),NOW()) AS blockedcount
 623             FROM old_issues
 624         };
 625     # or if he must wait to loan
 626     if(C4::Context->preference("item-level_itypes")){
 627         $strsth.=
 628                 qq{ LEFT JOIN items ON (items.itemnumber=old_issues.itemnumber)
 629             LEFT JOIN issuingrules ON (issuingrules.itemtype=items.itype)}
 630     }else{
 631         $strsth .=
 632                 qq{ LEFT JOIN items ON (items.itemnumber=old_issues.itemnumber)
 633             LEFT JOIN biblioitems ON (biblioitems.biblioitemnumber=items.biblioitemnumber)
 634             LEFT JOIN issuingrules ON (issuingrules.itemtype=biblioitems.itemtype) };
 635     }
 636         $strsth.=
 637         qq{ WHERE finedays IS NOT NULL
 638             AND  date_due < returndate
 639             AND borrowernumber = ?
 640             ORDER BY blockingdate DESC, blockedcount DESC
 641             LIMIT 1};
 642         $sth=$dbh->prepare($strsth);
 643     $sth->execute($borrowernumber);
 644     my $row = $sth->fetchrow_hashref;
 645     my $blockeddate  = $row->{'blockeddate'};
 646     my $blockedcount = $row->{'blockedcount'};
 647
 648     return (1, $blockedcount) if $blockedcount > 0;
 649
 650     return (0, 0);
 651 }
 652
 653 =head2 GetMemberIssuesAndFines
 654
 655   ($overdue_count, $issue_count, $total_fines) = &GetMemberIssuesAndFines($borrowernumber);
 656
 657 Returns aggregate data about items borrowed by the patron with the
 658 given borrowernumber.
 659
 660 C<&GetMemberIssuesAndFines> returns a three-element array.  C<$overdue_count> is the
 661 number of overdue items the patron currently has borrowed. C<$issue_count> is the
 662 number of books the patron currently has borrowed.  C<$total_fines> is
 663 the total fine currently due by the borrower.
 664
 665 =cut
 666
 667 #'
 668 sub GetMemberIssuesAndFines {
 669     my ( $borrowernumber ) = @_;
 670     my $dbh   = C4::Context->dbh;
 671     my $query = "SELECT COUNT(*) FROM issues WHERE borrowernumber = ?";
 672
 673     $debug and warn $query."\n";
 674     my $sth = $dbh->prepare($query);
 675     $sth->execute($borrowernumber);
 676     my $issue_count = $sth->fetchrow_arrayref->[0];
 677
 678     $sth = $dbh->prepare(
 679         "SELECT COUNT(*) FROM issues
 680          WHERE borrowernumber = ?
 681          AND date_due < curdate()"
 682     );
 683     $sth->execute($borrowernumber);
 684     my $overdue_count = $sth->fetchrow_arrayref->[0];
 685
 686     $sth = $dbh->prepare("SELECT SUM(amountoutstanding) FROM accountlines WHERE borrowernumber = ?");
 687     $sth->execute($borrowernumber);
 688     my $total_fines = $sth->fetchrow_arrayref->[0];
 689
 690     return ($overdue_count, $issue_count, $total_fines);
 691 }
 692
 693 sub columns(;$) {
 694     return @{C4::Context->dbh->selectcol_arrayref("SHOW columns from borrowers")};
 695 }
 696
 697 =head2
 698
 699 =head2 ModMember
 700
 701 =over 4
 702
 703 my $success = ModMember(borrowernumber => $borrowernumber, [ field => value ]... );
 704
 705 Modify borrower's data.  All date fields should ALREADY be in ISO format.
 706
 707 return :
 708 true on success, or false on failure
 709
 710 =back
 711
 712 =cut
 713 sub ModMember {
 714     my (%data) = @_;
 715     # test to know if you must update or not the borrower password
 716     if (exists $data{password}) {
 717         if ($data{password} eq '****' or $data{password} eq '') {
 718             delete $data{password};
 719         } else {
 720             $data{password} = md5_base64($data{password});
 721         }
 722     }
 723         my $execute_success=UpdateInTable("borrowers",\%data);
 724 # ok if its an adult (type) it may have borrowers that depend on it as a guarantor
 725 # so when we update information for an adult we should check for guarantees and update the relevant part
 726 # of their records, ie addresses and phone numbers
 727     my $borrowercategory= GetBorrowercategory( $data{'category_type'} );
 728     if ( exists  $borrowercategory->{'category_type'} && $borrowercategory->{'category_type'} eq ('A' || 'S') ) {
 729         # is adult check guarantees;
 730         UpdateGuarantees(%data);
 731     }
 732     logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "UPDATE (executed w/ arg: $data{'borrowernumber'})")
 733         if C4::Context->preference("BorrowersLog");
 734
 735     return $execute_success;
 736 }
 737
 738
 739 =head2
 740
 741 =head2 AddMember
 742
 743   $borrowernumber = &AddMember(%borrower);
 744
 745 insert new borrower into table
 746 Returns the borrowernumber
 747
 748 =cut
 749
 750 #'
 751 sub AddMember {
 752     my (%data) = @_;
 753     my $dbh = C4::Context->dbh;
 754     $data{'password'} = '!' if (not $data{'password'} and $data{'userid'});
 755     $data{'password'} = md5_base64( $data{'password'} ) if $data{'password'};
 756         $data{'borrowernumber'}=InsertInTable("borrowers",\%data);
 757     # mysql_insertid is probably bad.  not necessarily accurate and mysql-specific at best.
 758     logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
 759
 760     # check for enrollment fee & add it if needed
 761     my $sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
 762     $sth->execute($data{'categorycode'});
 763     my ($enrolmentfee) = $sth->fetchrow;
 764     if ($enrolmentfee && $enrolmentfee > 0) {
 765         # insert fee in patron debts
 766         manualinvoice($data{'borrowernumber'}, '', '', 'A', $enrolmentfee);
 767     }
 768     return $data{'borrowernumber'};
 769 }
 770
 771
 772 sub Check_Userid {
 773     my ($uid,$member) = @_;
 774     my $dbh = C4::Context->dbh;
 775     # Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
 776     # Then we need to tell the user and have them create a new one.
 777     my $sth =
 778       $dbh->prepare(
 779         "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
 780     $sth->execute( $uid, $member );
 781     if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
 782         return 0;
 783     }
 784     else {
 785         return 1;
 786     }
 787 }
 788
 789 sub Generate_Userid {
 790   my ($borrowernumber, $firstname, $surname) = @_;
 791   my $newuid;
 792   my $offset = 0;
 793   do {
 794     $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
 795     $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
 796     $newuid = lc("$firstname.$surname");
 797     $newuid .= $offset unless $offset == 0;
 798     $offset++;
 799
 800    } while (!Check_Userid($newuid,$borrowernumber));
 801
 802    return $newuid;
 803 }
 804
 805 sub changepassword {
 806     my ( $uid, $member, $digest ) = @_;
 807     my $dbh = C4::Context->dbh;
 808
 809 #Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
 810 #Then we need to tell the user and have them create a new one.
 811     my $resultcode;
 812     my $sth =
 813       $dbh->prepare(
 814         "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
 815     $sth->execute( $uid, $member );
 816     if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
 817         $resultcode=0;
 818     }
 819     else {
 820         #Everything is good so we can update the information.
 821         $sth =
 822           $dbh->prepare(
 823             "update borrowers set userid=?, password=? where borrowernumber=?");
 824         $sth->execute( $uid, $digest, $member );
 825         $resultcode=1;
 826     }
 827
 828     logaction("MEMBERS", "CHANGE PASS", $member, "") if C4::Context->preference("BorrowersLog");
 829     return $resultcode;
 830 }
 831
 832
 833
 834 =head2 fixup_cardnumber
 835
 836 Warning: The caller is responsible for locking the members table in write
 837 mode, to avoid database corruption.
 838
 839 =cut
 840
 841 use vars qw( @weightings );
 842 my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
 843
 844 sub fixup_cardnumber ($) {
 845     my ($cardnumber) = @_;
 846     my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;
 847
 848     # Find out whether member numbers should be generated
 849     # automatically. Should be either "1" or something else.
 850     # Defaults to "0", which is interpreted as "no".
 851
 852     #     if ($cardnumber !~ /\S/ && $autonumber_members) {
 853     ($autonumber_members) or return $cardnumber;
 854     my $checkdigit = C4::Context->preference('checkdigit');
 855     my $dbh = C4::Context->dbh;
 856     if ( $checkdigit and $checkdigit eq 'katipo' ) {
 857
 858         # if checkdigit is selected, calculate katipo-style cardnumber.
 859         # otherwise, just use the max()
 860         # purpose: generate checksum'd member numbers.
 861         # We'll assume we just got the max value of digits 2-8 of member #'s
 862         # from the database and our job is to increment that by one,
 863         # determine the 1st and 9th digits and return the full string.
 864         my $sth = $dbh->prepare(
 865             "select max(substring(borrowers.cardnumber,2,7)) as new_num from borrowers"
 866         );
 867         $sth->execute;
 868         my $data = $sth->fetchrow_hashref;
 869         $cardnumber = $data->{new_num};
 870         if ( !$cardnumber ) {    # If DB has no values,
 871             $cardnumber = 1000000;    # start at 1000000
 872         } else {
 873             $cardnumber += 1;
 874         }
 875
 876         my $sum = 0;
 877         for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
 878             # read weightings, left to right, 1 char at a time
 879             my $temp1 = $weightings[$i];
 880
 881             # sequence left to right, 1 char at a time
 882             my $temp2 = substr( $cardnumber, $i, 1 );
 883
 884             # mult each char 1-7 by its corresponding weighting
 885             $sum += $temp1 * $temp2;
 886         }
 887
 888         my $rem = ( $sum % 11 );
 889         $rem = 'X' if $rem == 10;
 890
 891         return "V$cardnumber$rem";
 892      } else {
 893
 894      # MODIFIED BY JF: mysql4.1 allows casting as an integer, which is probably
 895      # better. I'll leave the original in in case it needs to be changed for you
 896      # my $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers");
 897         my $sth = $dbh->prepare(
 898             "select max(cast(cardnumber as signed)) from borrowers"
 899         );
 900         $sth->execute;
 901         my ($result) = $sth->fetchrow;
 902         return $result + 1;
 903     }
 904     return $cardnumber;     # just here as a fallback/reminder
 905 }
 906
 907 =head2 GetGuarantees
 908
 909   ($num_children, $children_arrayref) = &GetGuarantees($parent_borrno);
 910   $child0_cardno = $children_arrayref->[0]{"cardnumber"};
 911   $child0_borrno = $children_arrayref->[0]{"borrowernumber"};
 912
 913 C<&GetGuarantees> takes a borrower number (e.g., that of a patron
 914 with children) and looks up the borrowers who are guaranteed by that
 915 borrower (i.e., the patron's children).
 916
 917 C<&GetGuarantees> returns two values: an integer giving the number of
 918 borrowers guaranteed by C<$parent_borrno>, and a reference to an array
 919 of references to hash, which gives the actual results.
 920
 921 =cut
 922
 923 #'
 924 sub GetGuarantees {
 925     my ($borrowernumber) = @_;
 926     my $dbh              = C4::Context->dbh;
 927     my $sth              =
 928       $dbh->prepare(
 929 "select cardnumber,borrowernumber, firstname, surname from borrowers where guarantorid=?"
 930       );
 931     $sth->execute($borrowernumber);
 932
 933     my @dat;
 934     my $data = $sth->fetchall_arrayref({});
 935     return ( scalar(@$data), $data );
 936 }
 937
 938 =head2 UpdateGuarantees
 939
 940   &UpdateGuarantees($parent_borrno);
 941
 942
 943 C<&UpdateGuarantees> borrower data for an adult and updates all the guarantees
 944 with the modified information
 945
 946 =cut
 947
 948 #'
 949 sub UpdateGuarantees {
 950     my (%data) = @_;
 951     my $dbh = C4::Context->dbh;
 952     my ( $count, $guarantees ) = GetGuarantees( $data{'borrowernumber'} );
 953     for ( my $i = 0 ; $i < $count ; $i++ ) {
 954
 955         # FIXME
 956         # It looks like the $i is only being returned to handle walking through
 957         # the array, which is probably better done as a foreach loop.
 958         #
 959         my $guaquery = qq|UPDATE borrowers
 960               SET address='$data{'address'}',fax='$data{'fax'}',
 961                   B_city='$data{'B_city'}',mobile='$data{'mobile'}',city='$data{'city'}',phone='$data{'phone'}'
 962               WHERE borrowernumber='$guarantees->[$i]->{'borrowernumber'}'
 963         |;
 964         my $sth3 = $dbh->prepare($guaquery);
 965         $sth3->execute;
 966     }
 967 }
 968 =head2 GetPendingIssues
 969
 970   my $issues = &GetPendingIssues($borrowernumber);
 971
 972 Looks up what the patron with the given borrowernumber has borrowed.
 973
 974 C<&GetPendingIssues> returns a
 975 reference-to-array where each element is a reference-to-hash; the
 976 keys are the fields from the C<issues>, C<biblio>, and C<items> tables.
 977 The keys include C<biblioitems> fields except marc and marcxml.
 978
 979 =cut
 980
 981 #'
 982 sub GetPendingIssues {
 983     my ($borrowernumber) = @_;
 984     # must avoid biblioitems.* to prevent large marc and marcxml fields from killing performance
 985     # FIXME: namespace collision: each table has "timestamp" fields.  Which one is "timestamp" ?
 986     # FIXME: circ/ciculation.pl tries to sort by timestamp!
 987     # FIXME: C4::Print::printslip tries to sort by timestamp!
 988     # FIXME: namespace collision: other collisions possible.
 989     # FIXME: most of this data isn't really being used by callers.
 990     my $sth = C4::Context->dbh->prepare(
 991    "SELECT issues.*,
 992             items.*,
 993            biblio.*,
 994            biblioitems.volume,
 995            biblioitems.number,
 996            biblioitems.itemtype,
 997            biblioitems.isbn,
 998            biblioitems.issn,
 999            biblioitems.publicationyear,
1000            biblioitems.publishercode,
1001            biblioitems.volumedate,
1002            biblioitems.volumedesc,
1003            biblioitems.lccn,
1004            biblioitems.url,
1005            issues.timestamp AS timestamp,
1006            issues.renewals  AS renewals,
1007             items.renewals  AS totalrenewals
1008     FROM   issues
1009     LEFT JOIN items       ON items.itemnumber       =      issues.itemnumber
1010     LEFT JOIN biblio      ON items.biblionumber     =      biblio.biblionumber
1011     LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
1012     WHERE
1013       borrowernumber=?
1014     ORDER BY issues.issuedate"
1015     );
1016     $sth->execute($borrowernumber);
1017     my $data = $sth->fetchall_arrayref({});
1018     my $today = C4::Dates->new->output('iso');
1019     foreach (@$data) {
1020         $_->{date_due} or next;
1021         ($_->{date_due} lt $today) and $_->{overdue} = 1;
1022     }
1023     return $data;
1024 }
1025
1026 =head2 GetAllIssues
1027
1028   $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
1029
1030 Looks up what the patron with the given borrowernumber has borrowed,
1031 and sorts the results.
1032
1033 C<$sortkey> is the name of a field on which to sort the results. This
1034 should be the name of a field in the C<issues>, C<biblio>,
1035 C<biblioitems>, or C<items> table in the Koha database.
1036
1037 C<$limit> is the maximum number of results to return.
1038
1039 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
1040 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
1041 C<items> tables of the Koha database.
1042
1043 =cut
1044
1045 #'
1046 sub GetAllIssues {
1047     my ( $borrowernumber, $order, $limit ) = @_;
1048
1049     #FIXME: sanity-check order and limit
1050     my $dbh   = C4::Context->dbh;
1051     my $query =
1052   "SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1053   FROM issues
1054   LEFT JOIN items on items.itemnumber=issues.itemnumber
1055   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1056   LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1057   WHERE borrowernumber=?
1058   UNION ALL
1059   SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1060   FROM old_issues
1061   LEFT JOIN items on items.itemnumber=old_issues.itemnumber
1062   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1063   LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1064   WHERE borrowernumber=?
1065   order by $order";
1066     if ( $limit != 0 ) {
1067         $query .= " limit $limit";
1068     }
1069
1070     my $sth = $dbh->prepare($query);
1071     $sth->execute($borrowernumber, $borrowernumber);
1072     my @result;
1073     my $i = 0;
1074     while ( my $data = $sth->fetchrow_hashref ) {
1075         push @result, $data;
1076     }
1077
1078     return \@result;
1079 }
1080
1081
1082 =head2 GetMemberAccountRecords
1083
1084   ($total, $acctlines, $count) = &GetMemberAccountRecords($borrowernumber);
1085
1086 Looks up accounting data for the patron with the given borrowernumber.
1087
1088 C<&GetMemberAccountRecords> returns a three-element array. C<$acctlines> is a
1089 reference-to-array, where each element is a reference-to-hash; the
1090 keys are the fields of the C<accountlines> table in the Koha database.
1091 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1092 total amount outstanding for all of the account lines.
1093
1094 =cut
1095
1096 #'
1097 sub GetMemberAccountRecords {
1098     my ($borrowernumber,$date) = @_;
1099     my $dbh = C4::Context->dbh;
1100     my @acctlines;
1101     my $numlines = 0;
1102     my $strsth      = qq(
1103                         SELECT *
1104                         FROM accountlines
1105                         WHERE borrowernumber=?);
1106     my @bind = ($borrowernumber);
1107     if ($date && $date ne ''){
1108             $strsth.=" AND date < ? ";
1109             push(@bind,$date);
1110     }
1111     $strsth.=" ORDER BY date desc,timestamp DESC";
1112     my $sth= $dbh->prepare( $strsth );
1113     $sth->execute( @bind );
1114     my $total = 0;
1115     while ( my $data = $sth->fetchrow_hashref ) {
1116                 my $biblio = GetBiblioFromItemNumber($data->{itemnumber}) if $data->{itemnumber};
1117                 $data->{biblionumber} = $biblio->{biblionumber};
1118                 $data->{title} = $biblio->{title};
1119         $acctlines[$numlines] = $data;
1120         $numlines++;
1121         $total += int(1000 * $data->{'amountoutstanding'}); # convert float to integer to avoid round-off errors
1122     }
1123     $total /= 1000;
1124     return ( $total, \@acctlines,$numlines);
1125 }
1126
1127 =head2 GetBorNotifyAcctRecord
1128
1129   ($count, $acctlines, $total) = &GetBorNotifyAcctRecord($params,$notifyid);
1130
1131 Looks up accounting data for the patron with the given borrowernumber per file number.
1132
1133 (FIXME - I'm not at all sure what this is about.)
1134
1135 C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a
1136 reference-to-array, where each element is a reference-to-hash; the
1137 keys are the fields of the C<accountlines> table in the Koha database.
1138 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1139 total amount outstanding for all of the account lines.
1140
1141 =cut
1142
1143 sub GetBorNotifyAcctRecord {
1144     my ( $borrowernumber, $notifyid ) = @_;
1145     my $dbh = C4::Context->dbh;
1146     my @acctlines;
1147     my $numlines = 0;
1148     my $sth = $dbh->prepare(
1149             "SELECT *
1150                 FROM accountlines
1151                 WHERE borrowernumber=?
1152                     AND notify_id=?
1153                     AND amountoutstanding != '0'
1154                 ORDER BY notify_id,accounttype
1155                 ");
1156 #                    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')
1157
1158     $sth->execute( $borrowernumber, $notifyid );
1159     my $total = 0;
1160     while ( my $data = $sth->fetchrow_hashref ) {
1161         $acctlines[$numlines] = $data;
1162         $numlines++;
1163         $total += int(100 * $data->{'amountoutstanding'});
1164     }
1165     $total /= 100;
1166     return ( $total, \@acctlines, $numlines );
1167 }
1168
1169 =head2 checkuniquemember (OUEST-PROVENCE)
1170
1171   ($result,$categorycode)  = &checkuniquemember($collectivity,$surname,$firstname,$dateofbirth);
1172
1173 Checks that a member exists or not in the database.
1174
1175 C<&result> is nonzero (=exist) or 0 (=does not exist)
1176 C<&categorycode> is from categorycode table
1177 C<&collectivity> is 1 (= we add a collectivity) or 0 (= we add a physical member)
1178 C<&surname> is the surname
1179 C<&firstname> is the firstname (only if collectivity=0)
1180 C<&dateofbirth> is the date of birth in ISO format (only if collectivity=0)
1181
1182 =cut
1183
1184 # FIXME: This function is not legitimate.  Multiple patrons might have the same first/last name and birthdate.
1185 # This is especially true since first name is not even a required field.
1186
1187 sub checkuniquemember {
1188     my ( $collectivity, $surname, $firstname, $dateofbirth ) = @_;
1189     my $dbh = C4::Context->dbh;
1190     my $request = ($collectivity) ?
1191         "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? " :
1192             ($dateofbirth) ?
1193             "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=?  and dateofbirth=?" :
1194             "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=?";
1195     my $sth = $dbh->prepare($request);
1196     if ($collectivity) {
1197         $sth->execute( uc($surname) );
1198     } elsif($dateofbirth){
1199         $sth->execute( uc($surname), ucfirst($firstname), $dateofbirth );
1200     }else{
1201         $sth->execute( uc($surname), ucfirst($firstname));
1202     }
1203     my @data = $sth->fetchrow;
1204     ( $data[0] ) and return $data[0], $data[1];
1205     return 0;
1206 }
1207
1208 sub checkcardnumber {
1209     my ($cardnumber,$borrowernumber) = @_;
1210     my $dbh = C4::Context->dbh;
1211     my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
1212     $query .= " AND borrowernumber <> ?" if ($borrowernumber);
1213   my $sth = $dbh->prepare($query);
1214   if ($borrowernumber) {
1215    $sth->execute($cardnumber,$borrowernumber);
1216   } else {
1217      $sth->execute($cardnumber);
1218   }
1219     if (my $data= $sth->fetchrow_hashref()){
1220         return 1;
1221     }
1222     else {
1223         return 0;
1224     }
1225 }
1226
1227
1228 =head2 getzipnamecity (OUEST-PROVENCE)
1229
1230 take all info from table city for the fields city and  zip
1231 check for the name and the zip code of the city selected
1232
1233 =cut
1234
1235 sub getzipnamecity {
1236     my ($cityid) = @_;
1237     my $dbh      = C4::Context->dbh;
1238     my $sth      =
1239       $dbh->prepare(
1240         "select city_name,city_zipcode from cities where cityid=? ");
1241     $sth->execute($cityid);
1242     my @data = $sth->fetchrow;
1243     return $data[0], $data[1];
1244 }
1245
1246
1247 =head2 getdcity (OUEST-PROVENCE)
1248
1249 recover cityid  with city_name condition
1250
1251 =cut
1252
1253 sub getidcity {
1254     my ($city_name) = @_;
1255     my $dbh = C4::Context->dbh;
1256     my $sth = $dbh->prepare("select cityid from cities where city_name=? ");
1257     $sth->execute($city_name);
1258     my $data = $sth->fetchrow;
1259     return $data;
1260 }
1261
1262
1263 =head2 GetExpiryDate
1264
1265   $expirydate = GetExpiryDate($categorycode, $dateenrolled);
1266
1267 Calculate expiry date given a categorycode and starting date.  Date argument must be in ISO format.
1268 Return date is also in ISO format.
1269
1270 =cut
1271
1272 sub GetExpiryDate {
1273     my ( $categorycode, $dateenrolled ) = @_;
1274     my $enrolments;
1275     if ($categorycode) {
1276         my $dbh = C4::Context->dbh;
1277         my $sth = $dbh->prepare("SELECT enrolmentperiod,enrolmentperioddate FROM categories WHERE categorycode=?");
1278         $sth->execute($categorycode);
1279         $enrolments = $sth->fetchrow_hashref;
1280     }
1281     # die "GetExpiryDate: for enrollmentperiod $enrolmentperiod (category '$categorycode') starting $dateenrolled.\n";
1282     my @date = split (/-/,$dateenrolled);
1283     if($enrolments->{enrolmentperiod}){
1284         return sprintf("%04d-%02d-%02d", Add_Delta_YM(@date,0,$enrolments->{enrolmentperiod}));
1285     }else{
1286         return $enrolments->{enrolmentperioddate};
1287     }
1288 }
1289
1290 =head2 checkuserpassword (OUEST-PROVENCE)
1291
1292 check for the password and login are not used
1293 return the number of record
1294 0=> NOT USED 1=> USED
1295
1296 =cut
1297
1298 sub checkuserpassword {
1299     my ( $borrowernumber, $userid, $password ) = @_;
1300     $password = md5_base64($password);
1301     my $dbh = C4::Context->dbh;
1302     my $sth =
1303       $dbh->prepare(
1304 "Select count(*) from borrowers where borrowernumber !=? and userid =? and password=? "
1305       );
1306     $sth->execute( $borrowernumber, $userid, $password );
1307     my $number_rows = $sth->fetchrow;
1308     return $number_rows;
1309
1310 }
1311
1312 =head2 GetborCatFromCatType
1313
1314   ($codes_arrayref, $labels_hashref) = &GetborCatFromCatType();
1315
1316 Looks up the different types of borrowers in the database. Returns two
1317 elements: a reference-to-array, which lists the borrower category
1318 codes, and a reference-to-hash, which maps the borrower category codes
1319 to category descriptions.
1320
1321 =cut
1322
1323 #'
1324 sub GetborCatFromCatType {
1325     my ( $category_type, $action ) = @_;
1326         # FIXME - This API  seems both limited and dangerous.
1327     my $dbh     = C4::Context->dbh;
1328     my $request = qq|   SELECT categorycode,description
1329             FROM categories
1330             $action
1331             ORDER BY categorycode|;
1332     my $sth = $dbh->prepare($request);
1333         if ($action) {
1334         $sth->execute($category_type);
1335     }
1336     else {
1337         $sth->execute();
1338     }
1339
1340     my %labels;
1341     my @codes;
1342
1343     while ( my $data = $sth->fetchrow_hashref ) {
1344         push @codes, $data->{'categorycode'};
1345         $labels{ $data->{'categorycode'} } = $data->{'description'};
1346     }
1347     return ( \@codes, \%labels );
1348 }
1349
1350 =head2 GetBorrowercategory
1351
1352   $hashref = &GetBorrowercategory($categorycode);
1353
1354 Given the borrower's category code, the function returns the corresponding
1355 data hashref for a comprehensive information display.
1356
1357   $arrayref_hashref = &GetBorrowercategory;
1358 If no category code provided, the function returns all the categories.
1359
1360 =cut
1361
1362 sub GetBorrowercategory {
1363     my ($catcode) = @_;
1364     my $dbh       = C4::Context->dbh;
1365     if ($catcode){
1366         my $sth       =
1367         $dbh->prepare(
1368     "SELECT description,dateofbirthrequired,upperagelimit,category_type
1369     FROM categories
1370     WHERE categorycode = ?"
1371         );
1372         $sth->execute($catcode);
1373         my $data =
1374         $sth->fetchrow_hashref;
1375         return $data;
1376     }
1377     return;
1378 }    # sub getborrowercategory
1379
1380 =head2 GetBorrowercategoryList
1381
1382   $arrayref_hashref = &GetBorrowercategoryList;
1383 If no category code provided, the function returns all the categories.
1384
1385 =cut
1386
1387 sub GetBorrowercategoryList {
1388     my $dbh       = C4::Context->dbh;
1389     my $sth       =
1390     $dbh->prepare(
1391     "SELECT *
1392     FROM categories
1393     ORDER BY description"
1394         );
1395     $sth->execute;
1396     my $data =
1397     $sth->fetchall_arrayref({});
1398     return $data;
1399 }    # sub getborrowercategory
1400
1401 =head2 ethnicitycategories
1402
1403   ($codes_arrayref, $labels_hashref) = &ethnicitycategories();
1404
1405 Looks up the different ethnic types in the database. Returns two
1406 elements: a reference-to-array, which lists the ethnicity codes, and a
1407 reference-to-hash, which maps the ethnicity codes to ethnicity
1408 descriptions.
1409
1410 =cut
1411
1412 #'
1413
1414 sub ethnicitycategories {
1415     my $dbh = C4::Context->dbh;
1416     my $sth = $dbh->prepare("Select code,name from ethnicity order by name");
1417     $sth->execute;
1418     my %labels;
1419     my @codes;
1420     while ( my $data = $sth->fetchrow_hashref ) {
1421         push @codes, $data->{'code'};
1422         $labels{ $data->{'code'} } = $data->{'name'};
1423     }
1424     return ( \@codes, \%labels );
1425 }
1426
1427 =head2 fixEthnicity
1428
1429   $ethn_name = &fixEthnicity($ethn_code);
1430
1431 Takes an ethnicity code (e.g., "european" or "pi") and returns the
1432 corresponding descriptive name from the C<ethnicity> table in the
1433 Koha database ("European" or "Pacific Islander").
1434
1435 =cut
1436
1437 #'
1438
1439 sub fixEthnicity {
1440     my $ethnicity = shift;
1441     return unless $ethnicity;
1442     my $dbh       = C4::Context->dbh;
1443     my $sth       = $dbh->prepare("Select name from ethnicity where code = ?");
1444     $sth->execute($ethnicity);
1445     my $data = $sth->fetchrow_hashref;
1446     return $data->{'name'};
1447 }    # sub fixEthnicity
1448
1449 =head2 GetAge
1450
1451   $dateofbirth,$date = &GetAge($date);
1452
1453 this function return the borrowers age with the value of dateofbirth
1454
1455 =cut
1456
1457 #'
1458 sub GetAge{
1459     my ( $date, $date_ref ) = @_;
1460
1461     if ( not defined $date_ref ) {
1462         $date_ref = sprintf( '%04d-%02d-%02d', Today() );
1463     }
1464
1465     my ( $year1, $month1, $day1 ) = split /-/, $date;
1466     my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
1467
1468     my $age = $year2 - $year1;
1469     if ( $month1 . $day1 > $month2 . $day2 ) {
1470         $age--;
1471     }
1472
1473     return $age;
1474 }    # sub get_age
1475
1476 =head2 get_institutions
1477   $insitutions = get_institutions();
1478
1479 Just returns a list of all the borrowers of type I, borrownumber and name
1480
1481 =cut
1482
1483 #'
1484 sub get_institutions {
1485     my $dbh = C4::Context->dbh();
1486     my $sth =
1487       $dbh->prepare(
1488 "SELECT borrowernumber,surname FROM borrowers WHERE categorycode=? ORDER BY surname"
1489       );
1490     $sth->execute('I');
1491     my %orgs;
1492     while ( my $data = $sth->fetchrow_hashref() ) {
1493         $orgs{ $data->{'borrowernumber'} } = $data;
1494     }
1495     return ( \%orgs );
1496
1497 }    # sub get_institutions
1498
1499 =head2 add_member_orgs
1500
1501   add_member_orgs($borrowernumber,$borrowernumbers);
1502
1503 Takes a borrowernumber and a list of other borrowernumbers and inserts them into the borrowers_to_borrowers table
1504
1505 =cut
1506
1507 #'
1508 sub add_member_orgs {
1509     my ( $borrowernumber, $otherborrowers ) = @_;
1510     my $dbh   = C4::Context->dbh();
1511     my $query =
1512       "INSERT INTO borrowers_to_borrowers (borrower1,borrower2) VALUES (?,?)";
1513     my $sth = $dbh->prepare($query);
1514     foreach my $otherborrowernumber (@$otherborrowers) {
1515         $sth->execute( $borrowernumber, $otherborrowernumber );
1516     }
1517
1518 }    # sub add_member_orgs
1519
1520 =head2 GetCities
1521
1522   $cityarrayref = GetCities();
1523
1524   Returns an array_ref of the entries in the cities table
1525   If there are entries in the table an empty row is returned
1526   This is currently only used to populate a popup in memberentry
1527
1528 =cut
1529
1530 sub GetCities {
1531
1532     my $dbh   = C4::Context->dbh;
1533     my $city_arr = $dbh->selectall_arrayref(
1534         q|SELECT cityid,city_zipcode,city_name FROM cities ORDER BY city_name|,
1535         { Slice => {} });
1536     if ( @{$city_arr} ) {
1537         unshift @{$city_arr}, {
1538             city_zipcode => q{},
1539             city_name    => q{},
1540             cityid       => q{},
1541         };
1542     }
1543
1544     return  $city_arr;
1545 }
1546
1547 =head2 GetSortDetails (OUEST-PROVENCE)
1548
1549   ($lib) = &GetSortDetails($category,$sortvalue);
1550
1551 Returns the authorized value  details
1552 C<&$lib>return value of authorized value details
1553 C<&$sortvalue>this is the value of authorized value
1554 C<&$category>this is the value of authorized value category
1555
1556 =cut
1557
1558 sub GetSortDetails {
1559     my ( $category, $sortvalue ) = @_;
1560     my $dbh   = C4::Context->dbh;
1561     my $query = qq|SELECT lib
1562         FROM authorised_values
1563         WHERE category=?
1564         AND authorised_value=? |;
1565     my $sth = $dbh->prepare($query);
1566     $sth->execute( $category, $sortvalue );
1567     my $lib = $sth->fetchrow;
1568     return ($lib) if ($lib);
1569     return ($sortvalue) unless ($lib);
1570 }
1571
1572 =head2 MoveMemberToDeleted
1573
1574   $result = &MoveMemberToDeleted($borrowernumber);
1575
1576 Copy the record from borrowers to deletedborrowers table.
1577
1578 =cut
1579
1580 # FIXME: should do it in one SQL statement w/ subquery
1581 # Otherwise, we should return the @data on success
1582
1583 sub MoveMemberToDeleted {
1584     my ($member) = shift or return;
1585     my $dbh = C4::Context->dbh;
1586     my $query = qq|SELECT *
1587           FROM borrowers
1588           WHERE borrowernumber=?|;
1589     my $sth = $dbh->prepare($query);
1590     $sth->execute($member);
1591     my @data = $sth->fetchrow_array;
1592     (@data) or return;  # if we got a bad borrowernumber, there's nothing to insert
1593     $sth =
1594       $dbh->prepare( "INSERT INTO deletedborrowers VALUES ("
1595           . ( "?," x ( scalar(@data) - 1 ) )
1596           . "?)" );
1597     $sth->execute(@data);
1598 }
1599
1600 =head2 DelMember
1601
1602 DelMember($borrowernumber);
1603
1604 This function remove directly a borrower whitout writing it on deleteborrower.
1605 + Deletes reserves for the borrower
1606
1607 =cut
1608
1609 sub DelMember {
1610     my $dbh            = C4::Context->dbh;
1611     my $borrowernumber = shift;
1612     #warn "in delmember with $borrowernumber";
1613     return unless $borrowernumber;    # borrowernumber is mandatory.
1614
1615     my $query = qq|DELETE
1616           FROM  reserves
1617           WHERE borrowernumber=?|;
1618     my $sth = $dbh->prepare($query);
1619     $sth->execute($borrowernumber);
1620     $query = "
1621        DELETE
1622        FROM borrowers
1623        WHERE borrowernumber = ?
1624    ";
1625     $sth = $dbh->prepare($query);
1626     $sth->execute($borrowernumber);
1627     logaction("MEMBERS", "DELETE", $borrowernumber, "") if C4::Context->preference("BorrowersLog");
1628     return $sth->rows;
1629 }
1630
1631 =head2 ExtendMemberSubscriptionTo (OUEST-PROVENCE)
1632
1633     $date = ExtendMemberSubscriptionTo($borrowerid, $date);
1634
1635 Extending the subscription to a given date or to the expiry date calculated on ISO date.
1636 Returns ISO date.
1637
1638 =cut
1639
1640 sub ExtendMemberSubscriptionTo {
1641     my ( $borrowerid,$date) = @_;
1642     my $dbh = C4::Context->dbh;
1643     my $borrower = GetMember('borrowernumber'=>$borrowerid);
1644     unless ($date){
1645       $date=POSIX::strftime("%Y-%m-%d",localtime());
1646       $date = GetExpiryDate( $borrower->{'categorycode'}, $date );
1647     }
1648     my $sth = $dbh->do(<<EOF);
1649 UPDATE borrowers
1650 SET  dateexpiry='$date'
1651 WHERE borrowernumber='$borrowerid'
1652 EOF
1653     # add enrolmentfee if needed
1654     $sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
1655     $sth->execute($borrower->{'categorycode'});
1656     my ($enrolmentfee) = $sth->fetchrow;
1657     if ($enrolmentfee && $enrolmentfee > 0) {
1658         # insert fee in patron debts
1659         manualinvoice($borrower->{'borrowernumber'}, '', '', 'A', $enrolmentfee);
1660     }
1661     return $date if ($sth);
1662     return 0;
1663 }
1664
1665 =head2 GetRoadTypes (OUEST-PROVENCE)
1666
1667   ($idroadtypearrayref, $roadttype_hashref) = &GetRoadTypes();
1668
1669 Looks up the different road type . Returns two
1670 elements: a reference-to-array, which lists the id_roadtype
1671 codes, and a reference-to-hash, which maps the road type of the road .
1672
1673 =cut
1674
1675 sub GetRoadTypes {
1676     my $dbh   = C4::Context->dbh;
1677     my $query = qq|
1678 SELECT roadtypeid,road_type
1679 FROM roadtype
1680 ORDER BY road_type|;
1681     my $sth = $dbh->prepare($query);
1682     $sth->execute();
1683     my %roadtype;
1684     my @id;
1685
1686     #    insert empty value to create a empty choice in cgi popup
1687
1688     while ( my $data = $sth->fetchrow_hashref ) {
1689
1690         push @id, $data->{'roadtypeid'};
1691         $roadtype{ $data->{'roadtypeid'} } = $data->{'road_type'};
1692     }
1693
1694 #test to know if the table contain some records if no the function return nothing
1695     my $id = @id;
1696     if ( $id eq 0 ) {
1697         return ();
1698     }
1699     else {
1700         unshift( @id, "" );
1701         return ( \@id, \%roadtype );
1702     }
1703 }
1704
1705
1706
1707 =head2 GetTitles (OUEST-PROVENCE)
1708
1709   ($borrowertitle)= &GetTitles();
1710
1711 Looks up the different title . Returns array  with all borrowers title
1712
1713 =cut
1714
1715 sub GetTitles {
1716     my @borrowerTitle = split (/,|\|/,C4::Context->preference('BorrowersTitles'));
1717     unshift( @borrowerTitle, "" );
1718     my $count=@borrowerTitle;
1719     if ($count == 1){
1720         return ();
1721     }
1722     else {
1723         return ( \@borrowerTitle);
1724     }
1725 }
1726
1727 =head2 GetPatronImage
1728
1729     my ($imagedata, $dberror) = GetPatronImage($cardnumber);
1730
1731 Returns the mimetype and binary image data of the image for the patron with the supplied cardnumber.
1732
1733 =cut
1734
1735 sub GetPatronImage {
1736     my ($cardnumber) = @_;
1737     warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1738     my $dbh = C4::Context->dbh;
1739     my $query = 'SELECT mimetype, imagefile FROM patronimage WHERE cardnumber = ?';
1740     my $sth = $dbh->prepare($query);
1741     $sth->execute($cardnumber);
1742     my $imagedata = $sth->fetchrow_hashref;
1743     warn "Database error!" if $sth->errstr;
1744     return $imagedata, $sth->errstr;
1745 }
1746
1747 =head2 PutPatronImage
1748
1749     PutPatronImage($cardnumber, $mimetype, $imgfile);
1750
1751 Stores patron binary image data and mimetype in database.
1752 NOTE: This function is good for updating images as well as inserting new images in the database.
1753
1754 =cut
1755
1756 sub PutPatronImage {
1757     my ($cardnumber, $mimetype, $imgfile) = @_;
1758     warn "Parameters passed in: Cardnumber=$cardnumber, Mimetype=$mimetype, " . ($imgfile ? "Imagefile" : "No Imagefile") if $debug;
1759     my $dbh = C4::Context->dbh;
1760     my $query = "INSERT INTO patronimage (cardnumber, mimetype, imagefile) VALUES (?,?,?) ON DUPLICATE KEY UPDATE imagefile = ?;";
1761     my $sth = $dbh->prepare($query);
1762     $sth->execute($cardnumber,$mimetype,$imgfile,$imgfile);
1763     warn "Error returned inserting $cardnumber.$mimetype." if $sth->errstr;
1764     return $sth->errstr;
1765 }
1766
1767 =head2 RmPatronImage
1768
1769     my ($dberror) = RmPatronImage($cardnumber);
1770
1771 Removes the image for the patron with the supplied cardnumber.
1772
1773 =cut
1774
1775 sub RmPatronImage {
1776     my ($cardnumber) = @_;
1777     warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1778     my $dbh = C4::Context->dbh;
1779     my $query = "DELETE FROM patronimage WHERE cardnumber = ?;";
1780     my $sth = $dbh->prepare($query);
1781     $sth->execute($cardnumber);
1782     my $dberror = $sth->errstr;
1783     warn "Database error!" if $sth->errstr;
1784     return $dberror;
1785 }
1786
1787 =head2 GetRoadTypeDetails (OUEST-PROVENCE)
1788
1789   ($roadtype) = &GetRoadTypeDetails($roadtypeid);
1790
1791 Returns the description of roadtype
1792 C<&$roadtype>return description of road type
1793 C<&$roadtypeid>this is the value of roadtype s
1794
1795 =cut
1796
1797 sub GetRoadTypeDetails {
1798     my ($roadtypeid) = @_;
1799     my $dbh          = C4::Context->dbh;
1800     my $query        = qq|
1801 SELECT road_type
1802 FROM roadtype
1803 WHERE roadtypeid=?|;
1804     my $sth = $dbh->prepare($query);
1805     $sth->execute($roadtypeid);
1806     my $roadtype = $sth->fetchrow;
1807     return ($roadtype);
1808 }
1809
1810 =head2 GetBorrowersWhoHaveNotBorrowedSince
1811
1812 &GetBorrowersWhoHaveNotBorrowedSince($date)
1813
1814 this function get all borrowers who haven't borrowed since the date given on input arg.
1815
1816 =cut
1817
1818 sub GetBorrowersWhoHaveNotBorrowedSince {
1819     my $filterdate = shift||POSIX::strftime("%Y-%m-%d",localtime());
1820     my $filterexpiry = shift;
1821     my $filterbranch = shift ||
1822                         ((C4::Context->preference('IndependantBranches')
1823                              && C4::Context->userenv
1824                              && C4::Context->userenv->{flags} % 2 !=1
1825                              && C4::Context->userenv->{branch})
1826                          ? C4::Context->userenv->{branch}
1827                          : "");
1828     my $dbh   = C4::Context->dbh;
1829     my $query = "
1830         SELECT borrowers.borrowernumber,
1831                max(old_issues.timestamp) as latestissue,
1832                max(issues.timestamp) as currentissue
1833         FROM   borrowers
1834         JOIN   categories USING (categorycode)
1835         LEFT JOIN old_issues USING (borrowernumber)
1836         LEFT JOIN issues USING (borrowernumber)
1837         WHERE  category_type <> 'S'
1838         AND borrowernumber NOT IN (SELECT guarantorid FROM borrowers WHERE guarantorid IS NOT NULL AND guarantorid <> 0)
1839    ";
1840     my @query_params;
1841     if ($filterbranch && $filterbranch ne ""){
1842         $query.=" AND borrowers.branchcode= ?";
1843         push @query_params,$filterbranch;
1844     }
1845     if($filterexpiry){
1846         $query .= " AND dateexpiry < ? ";
1847         push @query_params,$filterdate;
1848     }
1849     $query.=" GROUP BY borrowers.borrowernumber";
1850     if ($filterdate){
1851         $query.=" HAVING (latestissue < ? OR latestissue IS NULL)
1852                   AND currentissue IS NULL";
1853         push @query_params,$filterdate;
1854     }
1855     warn $query if $debug;
1856     my $sth = $dbh->prepare($query);
1857     if (scalar(@query_params)>0){
1858         $sth->execute(@query_params);
1859     }
1860     else {
1861         $sth->execute;
1862     }
1863
1864     my @results;
1865     while ( my $data = $sth->fetchrow_hashref ) {
1866         push @results, $data;
1867     }
1868     return \@results;
1869 }
1870
1871 =head2 GetBorrowersWhoHaveNeverBorrowed
1872
1873 $results = &GetBorrowersWhoHaveNeverBorrowed
1874
1875 this function get all borrowers who have never borrowed.
1876
1877 I<$result> is a ref to an array which all elements are a hasref.
1878
1879 =cut
1880
1881 sub GetBorrowersWhoHaveNeverBorrowed {
1882     my $filterbranch = shift ||
1883                         ((C4::Context->preference('IndependantBranches')
1884                              && C4::Context->userenv
1885                              && C4::Context->userenv->{flags} % 2 !=1
1886                              && C4::Context->userenv->{branch})
1887                          ? C4::Context->userenv->{branch}
1888                          : "");
1889     my $dbh   = C4::Context->dbh;
1890     my $query = "
1891         SELECT borrowers.borrowernumber,max(timestamp) as latestissue
1892         FROM   borrowers
1893           LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
1894         WHERE issues.borrowernumber IS NULL
1895    ";
1896     my @query_params;
1897     if ($filterbranch && $filterbranch ne ""){
1898         $query.=" AND borrowers.branchcode= ?";
1899         push @query_params,$filterbranch;
1900     }
1901     warn $query if $debug;
1902
1903     my $sth = $dbh->prepare($query);
1904     if (scalar(@query_params)>0){
1905         $sth->execute(@query_params);
1906     }
1907     else {
1908         $sth->execute;
1909     }
1910
1911     my @results;
1912     while ( my $data = $sth->fetchrow_hashref ) {
1913         push @results, $data;
1914     }
1915     return \@results;
1916 }
1917
1918 =head2 GetBorrowersWithIssuesHistoryOlderThan
1919
1920 $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
1921
1922 this function get all borrowers who has an issue history older than I<$date> given on input arg.
1923
1924 I<$result> is a ref to an array which all elements are a hashref.
1925 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
1926
1927 =cut
1928
1929 sub GetBorrowersWithIssuesHistoryOlderThan {
1930     my $dbh  = C4::Context->dbh;
1931     my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
1932     my $filterbranch = shift ||
1933                         ((C4::Context->preference('IndependantBranches')
1934                              && C4::Context->userenv
1935                              && C4::Context->userenv->{flags} % 2 !=1
1936                              && C4::Context->userenv->{branch})
1937                          ? C4::Context->userenv->{branch}
1938                          : "");
1939     my $query = "
1940        SELECT count(borrowernumber) as n,borrowernumber
1941        FROM old_issues
1942        WHERE returndate < ?
1943          AND borrowernumber IS NOT NULL
1944     ";
1945     my @query_params;
1946     push @query_params, $date;
1947     if ($filterbranch){
1948         $query.="   AND branchcode = ?";
1949         push @query_params, $filterbranch;
1950     }
1951     $query.=" GROUP BY borrowernumber ";
1952     warn $query if $debug;
1953     my $sth = $dbh->prepare($query);
1954     $sth->execute(@query_params);
1955     my @results;
1956
1957     while ( my $data = $sth->fetchrow_hashref ) {
1958         push @results, $data;
1959     }
1960     return \@results;
1961 }
1962
1963 =head2 GetBorrowersNamesAndLatestIssue
1964
1965 $results = &GetBorrowersNamesAndLatestIssueList(@borrowernumbers)
1966
1967 this function get borrowers Names and surnames and Issue information.
1968
1969 I<@borrowernumbers> is an array which all elements are borrowernumbers.
1970 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
1971
1972 =cut
1973
1974 sub GetBorrowersNamesAndLatestIssue {
1975     my $dbh  = C4::Context->dbh;
1976     my @borrowernumbers=@_;
1977     my $query = "
1978        SELECT surname,lastname, phone, email,max(timestamp)
1979        FROM borrowers
1980          LEFT JOIN issues ON borrowers.borrowernumber=issues.borrowernumber
1981        GROUP BY borrowernumber
1982    ";
1983     my $sth = $dbh->prepare($query);
1984     $sth->execute;
1985     my $results = $sth->fetchall_arrayref({});
1986     return $results;
1987 }
1988
1989 =head2 DebarMember
1990
1991 =over 4
1992
1993 my $success = DebarMember( $borrowernumber );
1994
1995 marks a Member as debarred, and therefore unable to checkout any more
1996 items.
1997
1998 return :
1999 true on success, false on failure
2000
2001 =back
2002
2003 =cut
2004
2005 sub DebarMember {
2006     my $borrowernumber = shift;
2007
2008     return unless defined $borrowernumber;
2009     return unless $borrowernumber =~ /^\d+$/;
2010
2011     return ModMember( borrowernumber => $borrowernumber,
2012                       debarred       => 1 );
2013
2014 }
2015
2016 =head2 AddMessage
2017
2018 =over 4
2019
2020 AddMessage( $borrowernumber, $message_type, $message, $branchcode );
2021
2022 Adds a message to the messages table for the given borrower.
2023
2024 Returns:
2025   True on success
2026   False on failure
2027
2028 =back
2029
2030 =cut
2031
2032 sub AddMessage {
2033     my ( $borrowernumber, $message_type, $message, $branchcode ) = @_;
2034
2035     my $dbh  = C4::Context->dbh;
2036
2037     if ( ! ( $borrowernumber && $message_type && $message && $branchcode ) ) {
2038       return;
2039     }
2040
2041     my $query = "INSERT INTO messages ( borrowernumber, branchcode, message_type, message ) VALUES ( ?, ?, ?, ? )";
2042     my $sth = $dbh->prepare($query);
2043     $sth->execute( $borrowernumber, $branchcode, $message_type, $message );
2044
2045     return 1;
2046 }
2047
2048 =head2 GetMessages
2049
2050 =over 4
2051
2052 GetMessages( $borrowernumber, $type );
2053
2054 $type is message type, B for borrower, or L for Librarian.
2055 Empty type returns all messages of any type.
2056
2057 Returns all messages for the given borrowernumber
2058
2059 =back
2060
2061 =cut
2062
2063 sub GetMessages {
2064     my ( $borrowernumber, $type, $branchcode ) = @_;
2065
2066     if ( ! $type ) {
2067       $type = '%';
2068     }
2069
2070     my $dbh  = C4::Context->dbh;
2071
2072     my $query = "SELECT
2073                   branches.branchname,
2074                   messages.*,
2075                   DATE_FORMAT( message_date, '%m/%d/%Y' ) AS message_date_formatted,
2076                   messages.branchcode LIKE '$branchcode' AS can_delete
2077                   FROM messages, branches
2078                   WHERE borrowernumber = ?
2079                   AND message_type LIKE ?
2080                   AND messages.branchcode = branches.branchcode
2081                   ORDER BY message_date DESC";
2082     my $sth = $dbh->prepare($query);
2083     $sth->execute( $borrowernumber, $type ) ;
2084     my @results;
2085
2086     while ( my $data = $sth->fetchrow_hashref ) {
2087         push @results, $data;
2088     }
2089     return \@results;
2090
2091 }
2092
2093 =head2 GetMessages
2094
2095 =over 4
2096
2097 GetMessagesCount( $borrowernumber, $type );
2098
2099 $type is message type, B for borrower, or L for Librarian.
2100 Empty type returns all messages of any type.
2101
2102 Returns the number of messages for the given borrowernumber
2103
2104 =back
2105
2106 =cut
2107
2108 sub GetMessagesCount {
2109     my ( $borrowernumber, $type, $branchcode ) = @_;
2110
2111     if ( ! $type ) {
2112       $type = '%';
2113     }
2114
2115     my $dbh  = C4::Context->dbh;
2116
2117     my $query = "SELECT COUNT(*) as MsgCount FROM messages WHERE borrowernumber = ? AND message_type LIKE ?";
2118     my $sth = $dbh->prepare($query);
2119     $sth->execute( $borrowernumber, $type ) ;
2120     my @results;
2121
2122     my $data = $sth->fetchrow_hashref;
2123     my $count = $data->{'MsgCount'};
2124
2125     return $count;
2126 }
2127
2128
2129
2130 =head2 DeleteMessage
2131
2132 =over 4
2133
2134 DeleteMessage( $message_id );
2135
2136 =back
2137
2138 =cut
2139
2140 sub DeleteMessage {
2141     my ( $message_id ) = @_;
2142
2143     my $dbh = C4::Context->dbh;
2144
2145     my $query = "DELETE FROM messages WHERE message_id = ?";
2146     my $sth = $dbh->prepare($query);
2147     $sth->execute( $message_id );
2148
2149 }
2150
2151 END { }    # module clean-up code here (global destructor)
2152
2153 1;
2154
2155 __END__
2156
2157 =head1 AUTHOR
2158
2159 Koha Team
2160
2161 =cut