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 ### TODO : It could be dangerous to delete Borrowers who have just been entered and who have not yet borrowed any book. May be good to add a dateexpiry or dateenrolled filter.
1831
1832                 my $filterdate = shift||POSIX::strftime("%Y-%m-%d",localtime());
1833     my $filterbranch = shift ||
1834                         ((C4::Context->preference('IndependantBranches')
1835                              && C4::Context->userenv
1836                              && C4::Context->userenv->{flags} % 2 !=1
1837                              && C4::Context->userenv->{branch})
1838                          ? C4::Context->userenv->{branch}
1839                          : "");
1840     my $dbh   = C4::Context->dbh;
1841     my $query = "
1842         SELECT borrowers.borrowernumber,max(issues.timestamp) as latestissue
1843         FROM   borrowers
1844         JOIN   categories USING (categorycode)
1845         LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
1846         WHERE  category_type <> 'S'
1847    ";
1848     my @query_params;
1849     if ($filterbranch && $filterbranch ne ""){
1850         $query.=" AND borrowers.branchcode= ?";
1851         push @query_params,$filterbranch;
1852     }
1853     $query.=" GROUP BY borrowers.borrowernumber";
1854     if ($filterdate){
1855         $query.=" HAVING latestissue <? OR latestissue IS NULL";
1856         push @query_params,$filterdate;
1857     }
1858     warn $query if $debug;
1859     my $sth = $dbh->prepare($query);
1860     if (scalar(@query_params)>0){
1861         $sth->execute(@query_params);
1862     }
1863     else {
1864         $sth->execute;
1865     }
1866
1867     my @results;
1868     while ( my $data = $sth->fetchrow_hashref ) {
1869         push @results, $data;
1870     }
1871     return \@results;
1872 }
1873
1874 =head2 GetBorrowersWhoHaveNeverBorrowed
1875
1876 $results = &GetBorrowersWhoHaveNeverBorrowed
1877
1878 this function get all borrowers who have never borrowed.
1879
1880 I<$result> is a ref to an array which all elements are a hasref.
1881
1882 =cut
1883
1884 sub GetBorrowersWhoHaveNeverBorrowed {
1885     my $filterbranch = shift ||
1886                         ((C4::Context->preference('IndependantBranches')
1887                              && C4::Context->userenv
1888                              && C4::Context->userenv->{flags} % 2 !=1
1889                              && C4::Context->userenv->{branch})
1890                          ? C4::Context->userenv->{branch}
1891                          : "");
1892     my $dbh   = C4::Context->dbh;
1893     my $query = "
1894         SELECT borrowers.borrowernumber,max(timestamp) as latestissue
1895         FROM   borrowers
1896           LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
1897         WHERE issues.borrowernumber IS NULL
1898    ";
1899     my @query_params;
1900     if ($filterbranch && $filterbranch ne ""){
1901         $query.=" AND borrowers.branchcode= ?";
1902         push @query_params,$filterbranch;
1903     }
1904     warn $query if $debug;
1905
1906     my $sth = $dbh->prepare($query);
1907     if (scalar(@query_params)>0){
1908         $sth->execute(@query_params);
1909     }
1910     else {
1911         $sth->execute;
1912     }
1913
1914     my @results;
1915     while ( my $data = $sth->fetchrow_hashref ) {
1916         push @results, $data;
1917     }
1918     return \@results;
1919 }
1920
1921 =head2 GetBorrowersWithIssuesHistoryOlderThan
1922
1923 $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
1924
1925 this function get all borrowers who has an issue history older than I<$date> given on input arg.
1926
1927 I<$result> is a ref to an array which all elements are a hashref.
1928 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
1929
1930 =cut
1931
1932 sub GetBorrowersWithIssuesHistoryOlderThan {
1933     my $dbh  = C4::Context->dbh;
1934     my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
1935     my $filterbranch = shift ||
1936                         ((C4::Context->preference('IndependantBranches')
1937                              && C4::Context->userenv
1938                              && C4::Context->userenv->{flags} % 2 !=1
1939                              && C4::Context->userenv->{branch})
1940                          ? C4::Context->userenv->{branch}
1941                          : "");
1942     my $query = "
1943        SELECT count(borrowernumber) as n,borrowernumber
1944        FROM old_issues
1945        WHERE returndate < ?
1946          AND borrowernumber IS NOT NULL
1947     ";
1948     my @query_params;
1949     push @query_params, $date;
1950     if ($filterbranch){
1951         $query.="   AND branchcode = ?";
1952         push @query_params, $filterbranch;
1953     }
1954     $query.=" GROUP BY borrowernumber ";
1955     warn $query if $debug;
1956     my $sth = $dbh->prepare($query);
1957     $sth->execute(@query_params);
1958     my @results;
1959
1960     while ( my $data = $sth->fetchrow_hashref ) {
1961         push @results, $data;
1962     }
1963     return \@results;
1964 }
1965
1966 =head2 GetBorrowersNamesAndLatestIssue
1967
1968 $results = &GetBorrowersNamesAndLatestIssueList(@borrowernumbers)
1969
1970 this function get borrowers Names and surnames and Issue information.
1971
1972 I<@borrowernumbers> is an array which all elements are borrowernumbers.
1973 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
1974
1975 =cut
1976
1977 sub GetBorrowersNamesAndLatestIssue {
1978     my $dbh  = C4::Context->dbh;
1979     my @borrowernumbers=@_;
1980     my $query = "
1981        SELECT surname,lastname, phone, email,max(timestamp)
1982        FROM borrowers
1983          LEFT JOIN issues ON borrowers.borrowernumber=issues.borrowernumber
1984        GROUP BY borrowernumber
1985    ";
1986     my $sth = $dbh->prepare($query);
1987     $sth->execute;
1988     my $results = $sth->fetchall_arrayref({});
1989     return $results;
1990 }
1991
1992 =head2 DebarMember
1993
1994 =over 4
1995
1996 my $success = DebarMember( $borrowernumber );
1997
1998 marks a Member as debarred, and therefore unable to checkout any more
1999 items.
2000
2001 return :
2002 true on success, false on failure
2003
2004 =back
2005
2006 =cut
2007
2008 sub DebarMember {
2009     my $borrowernumber = shift;
2010
2011     return unless defined $borrowernumber;
2012     return unless $borrowernumber =~ /^\d+$/;
2013
2014     return ModMember( borrowernumber => $borrowernumber,
2015                       debarred       => 1 );
2016
2017 }
2018
2019 =head2 AddMessage
2020
2021 =over 4
2022
2023 AddMessage( $borrowernumber, $message_type, $message, $branchcode );
2024
2025 Adds a message to the messages table for the given borrower.
2026
2027 Returns:
2028   True on success
2029   False on failure
2030
2031 =back
2032
2033 =cut
2034
2035 sub AddMessage {
2036     my ( $borrowernumber, $message_type, $message, $branchcode ) = @_;
2037
2038     my $dbh  = C4::Context->dbh;
2039
2040     if ( ! ( $borrowernumber && $message_type && $message && $branchcode ) ) {
2041       return;
2042     }
2043
2044     my $query = "INSERT INTO messages ( borrowernumber, branchcode, message_type, message ) VALUES ( ?, ?, ?, ? )";
2045     my $sth = $dbh->prepare($query);
2046     $sth->execute( $borrowernumber, $branchcode, $message_type, $message );
2047
2048     return 1;
2049 }
2050
2051 =head2 GetMessages
2052
2053 =over 4
2054
2055 GetMessages( $borrowernumber, $type );
2056
2057 $type is message type, B for borrower, or L for Librarian.
2058 Empty type returns all messages of any type.
2059
2060 Returns all messages for the given borrowernumber
2061
2062 =back
2063
2064 =cut
2065
2066 sub GetMessages {
2067     my ( $borrowernumber, $type, $branchcode ) = @_;
2068
2069     if ( ! $type ) {
2070       $type = '%';
2071     }
2072
2073     my $dbh  = C4::Context->dbh;
2074
2075     my $query = "SELECT
2076                   branches.branchname,
2077                   messages.*,
2078                   DATE_FORMAT( message_date, '%m/%d/%Y' ) AS message_date_formatted,
2079                   messages.branchcode LIKE '$branchcode' AS can_delete
2080                   FROM messages, branches
2081                   WHERE borrowernumber = ?
2082                   AND message_type LIKE ?
2083                   AND messages.branchcode = branches.branchcode
2084                   ORDER BY message_date DESC";
2085     my $sth = $dbh->prepare($query);
2086     $sth->execute( $borrowernumber, $type ) ;
2087     my @results;
2088
2089     while ( my $data = $sth->fetchrow_hashref ) {
2090         push @results, $data;
2091     }
2092     return \@results;
2093
2094 }
2095
2096 =head2 GetMessages
2097
2098 =over 4
2099
2100 GetMessagesCount( $borrowernumber, $type );
2101
2102 $type is message type, B for borrower, or L for Librarian.
2103 Empty type returns all messages of any type.
2104
2105 Returns the number of messages for the given borrowernumber
2106
2107 =back
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 =over 4
2136
2137 DeleteMessage( $message_id );
2138
2139 =back
2140
2141 =cut
2142
2143 sub DeleteMessage {
2144     my ( $message_id ) = @_;
2145
2146     my $dbh = C4::Context->dbh;
2147
2148     my $query = "DELETE FROM messages WHERE message_id = ?";
2149     my $sth = $dbh->prepare($query);
2150     $sth->execute( $message_id );
2151
2152 }
2153
2154 END { }    # module clean-up code here (global destructor)
2155
2156 1;
2157
2158 __END__
2159
2160 =head1 AUTHOR
2161
2162 Koha Team
2163
2164 =cut