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