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