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