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