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