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