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