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