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