C4/Members.pm

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