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