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