C4/Members.pm

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