C4/Members.pm

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