koha-dev.rot13.org Git - koha_gimpoz/blob - C4/Members.pm

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