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