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 or a manual debarment, in which case
 654 C<$count> is the expiration date (9999-12-31 for indefinite)
 655
 656 -1 if the patron has overdue items, in which case C<$count> is the number of them
 657
 658 0 if the patron has no overdue items or outstanding fine days, in which case C<$count> is 0
 659
 660 Outstanding fine days are checked before current overdue items
 661 are.
 662
 663 FIXME: this needs to be split into two functions; a potential block
 664 based on the number of current overdue items could be orthogonal
 665 to a block based on whether the patron has any fine days accrued.
 666
 667 =cut
 668
 669 sub IsMemberBlocked {
 670     my $borrowernumber = shift;
 671     my $dbh            = C4::Context->dbh;
 672
 673     my $blockeddate = Koha::Borrower::Debarments::IsDebarred($borrowernumber);
 674
 675     return ( 1, $blockeddate ) if $blockeddate;
 676
 677     # if he have late issues
 678     my $sth = $dbh->prepare(
 679         "SELECT COUNT(*) as latedocs
 680          FROM issues
 681          WHERE borrowernumber = ?
 682          AND date_due < now()"
 683     );
 684     $sth->execute($borrowernumber);
 685     my $latedocs = $sth->fetchrow_hashref->{'latedocs'};
 686
 687     return ( -1, $latedocs ) if $latedocs > 0;
 688
 689     return ( 0, 0 );
 690 }
 691
 692 =head2 GetMemberIssuesAndFines
 693
 694   ($overdue_count, $issue_count, $total_fines) = &GetMemberIssuesAndFines($borrowernumber);
 695
 696 Returns aggregate data about items borrowed by the patron with the
 697 given borrowernumber.
 698
 699 C<&GetMemberIssuesAndFines> returns a three-element array.  C<$overdue_count> is the
 700 number of overdue items the patron currently has borrowed. C<$issue_count> is the
 701 number of books the patron currently has borrowed.  C<$total_fines> is
 702 the total fine currently due by the borrower.
 703
 704 =cut
 705
 706 #'
 707 sub GetMemberIssuesAndFines {
 708     my ( $borrowernumber ) = @_;
 709     my $dbh   = C4::Context->dbh;
 710     my $query = "SELECT COUNT(*) FROM issues WHERE borrowernumber = ?";
 711
 712     $debug and warn $query."\n";
 713     my $sth = $dbh->prepare($query);
 714     $sth->execute($borrowernumber);
 715     my $issue_count = $sth->fetchrow_arrayref->[0];
 716
 717     $sth = $dbh->prepare(
 718         "SELECT COUNT(*) FROM issues
 719          WHERE borrowernumber = ?
 720          AND date_due < now()"
 721     );
 722     $sth->execute($borrowernumber);
 723     my $overdue_count = $sth->fetchrow_arrayref->[0];
 724
 725     $sth = $dbh->prepare("SELECT SUM(amountoutstanding) FROM accountlines WHERE borrowernumber = ?");
 726     $sth->execute($borrowernumber);
 727     my $total_fines = $sth->fetchrow_arrayref->[0];
 728
 729     return ($overdue_count, $issue_count, $total_fines);
 730 }
 731
 732
 733 =head2 columns
 734
 735   my @columns = C4::Member::columns();
 736
 737 Returns an array of borrowers' table columns on success,
 738 and an empty array on failure.
 739
 740 =cut
 741
 742 sub columns {
 743
 744     # Pure ANSI SQL goodness.
 745     my $sql = 'SELECT * FROM borrowers WHERE 1=0;';
 746
 747     # Get the database handle.
 748     my $dbh = C4::Context->dbh;
 749
 750     # Run the SQL statement to load STH's readonly properties.
 751     my $sth = $dbh->prepare($sql);
 752     my $rv = $sth->execute();
 753
 754     # This only fails if the table doesn't exist.
 755     # This will always be called AFTER an install or upgrade,
 756     # so borrowers will exist!
 757     my @data;
 758     if ($sth->{NUM_OF_FIELDS}>0) {
 759         @data = @{$sth->{NAME}};
 760     }
 761     else {
 762         @data = ();
 763     }
 764     return @data;
 765 }
 766
 767
 768 =head2 ModMember
 769
 770   my $success = ModMember(borrowernumber => $borrowernumber,
 771                                             [ field => value ]... );
 772
 773 Modify borrower's data.  All date fields should ALREADY be in ISO format.
 774
 775 return :
 776 true on success, or false on failure
 777
 778 =cut
 779
 780 sub ModMember {
 781     my (%data) = @_;
 782     # test to know if you must update or not the borrower password
 783     if (exists $data{password}) {
 784         if ($data{password} eq '****' or $data{password} eq '') {
 785             delete $data{password};
 786         } else {
 787             $data{password} = hash_password($data{password});
 788         }
 789     }
 790     my $old_categorycode = GetBorrowerCategorycode( $data{borrowernumber} );
 791     my $execute_success=UpdateInTable("borrowers",\%data);
 792     if ($execute_success) { # only proceed if the update was a success
 793         # ok if its an adult (type) it may have borrowers that depend on it as a guarantor
 794         # so when we update information for an adult we should check for guarantees and update the relevant part
 795         # of their records, ie addresses and phone numbers
 796         my $borrowercategory= GetBorrowercategory( $data{'category_type'} );
 797         if ( exists  $borrowercategory->{'category_type'} && $borrowercategory->{'category_type'} eq ('A' || 'S') ) {
 798             # is adult check guarantees;
 799             UpdateGuarantees(%data);
 800         }
 801
 802         # If the patron changes to a category with enrollment fee, we add a fee
 803         if ( $data{categorycode} and $data{categorycode} ne $old_categorycode ) {
 804             AddEnrolmentFeeIfNeeded( $data{categorycode}, $data{borrowernumber} );
 805         }
 806
 807         logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "UPDATE (executed w/ arg: $data{'borrowernumber'})") if C4::Context->preference("BorrowersLog");
 808     }
 809     return $execute_success;
 810 }
 811
 812 =head2 AddMember
 813
 814   $borrowernumber = &AddMember(%borrower);
 815
 816 insert new borrower into table
 817 Returns the borrowernumber upon success
 818
 819 Returns as undef upon any db error without further processing
 820
 821 =cut
 822
 823 #'
 824 sub AddMember {
 825     my (%data) = @_;
 826     my $dbh = C4::Context->dbh;
 827
 828     # generate a proper login if none provided
 829     $data{'userid'} = Generate_Userid($data{'borrowernumber'}, $data{'firstname'}, $data{'surname'}) if $data{'userid'} eq '';
 830
 831     # add expiration date if it isn't already there
 832     unless ( $data{'dateexpiry'} ) {
 833         $data{'dateexpiry'} = GetExpiryDate( $data{'categorycode'}, C4::Dates->new()->output("iso") );
 834     }
 835
 836     # add enrollment date if it isn't already there
 837     unless ( $data{'dateenrolled'} ) {
 838         $data{'dateenrolled'} = C4::Dates->new()->output("iso");
 839     }
 840
 841     my $patron_category =
 842       Koha::Database->new()->schema()->resultset('Category')
 843       ->find( $data{'categorycode'} );
 844     $data{'privacy'} =
 845         $patron_category->default_privacy() eq 'default' ? 1
 846       : $patron_category->default_privacy() eq 'never'   ? 2
 847       : $patron_category->default_privacy() eq 'forever' ? 0
 848       :                                                    undef;
 849
 850     # create a disabled account if no password provided
 851     $data{'password'} = ($data{'password'})? hash_password($data{'password'}) : '!';
 852     $data{'borrowernumber'}=InsertInTable("borrowers",\%data);
 853
 854     # mysql_insertid is probably bad.  not necessarily accurate and mysql-specific at best.
 855     logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
 856
 857     AddEnrolmentFeeIfNeeded( $data{categorycode}, $data{borrowernumber} );
 858
 859     return $data{'borrowernumber'};
 860 }
 861
 862 =head2 Check_Userid
 863
 864     my $uniqueness = Check_Userid($userid,$borrowernumber);
 865
 866     $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 != '').
 867
 868     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.
 869
 870     return :
 871         0 for not unique (i.e. this $userid already exists)
 872         1 for unique (i.e. this $userid does not exist, or this $userid/$borrowernumber combination already exists)
 873
 874 =cut
 875
 876 sub Check_Userid {
 877     my ($uid,$member) = @_;
 878     my $dbh = C4::Context->dbh;
 879     my $sth =
 880       $dbh->prepare(
 881         "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
 882     $sth->execute( $uid, $member );
 883     if ( (( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref    )) or
 884          (( $uid ne '' ) && ( $uid eq C4::Context->config('user') )) ) {
 885         return 0;
 886     }
 887     else {
 888         return 1;
 889     }
 890 }
 891
 892 =head2 Generate_Userid
 893
 894     my $newuid = Generate_Userid($borrowernumber, $firstname, $surname);
 895
 896     Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
 897
 898     $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.
 899
 900     return :
 901         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).
 902
 903 =cut
 904
 905 sub Generate_Userid {
 906   my ($borrowernumber, $firstname, $surname) = @_;
 907   my $newuid;
 908   my $offset = 0;
 909   #The script will "do" the following code and increment the $offset until Check_Userid = 1 (i.e. until $newuid comes back as unique)
 910   do {
 911     $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
 912     $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
 913     $newuid = lc(($firstname)? "$firstname.$surname" : $surname);
 914     $newuid = unac_string('utf-8',$newuid);
 915     $newuid .= $offset unless $offset == 0;
 916     $offset++;
 917
 918    } while (!Check_Userid($newuid,$borrowernumber));
 919
 920    return $newuid;
 921 }
 922
 923 sub changepassword {
 924     my ( $uid, $member, $digest ) = @_;
 925     my $dbh = C4::Context->dbh;
 926
 927 #Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
 928 #Then we need to tell the user and have them create a new one.
 929     my $resultcode;
 930     my $sth =
 931       $dbh->prepare(
 932         "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
 933     $sth->execute( $uid, $member );
 934     if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
 935         $resultcode=0;
 936     }
 937     else {
 938         #Everything is good so we can update the information.
 939         $sth =
 940           $dbh->prepare(
 941             "update borrowers set userid=?, password=? where borrowernumber=?");
 942         $sth->execute( $uid, $digest, $member );
 943         $resultcode=1;
 944     }
 945
 946     logaction("MEMBERS", "CHANGE PASS", $member, "") if C4::Context->preference("BorrowersLog");
 947     return $resultcode;
 948 }
 949
 950
 951
 952 =head2 fixup_cardnumber
 953
 954 Warning: The caller is responsible for locking the members table in write
 955 mode, to avoid database corruption.
 956
 957 =cut
 958
 959 use vars qw( @weightings );
 960 my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
 961
 962 sub fixup_cardnumber {
 963     my ($cardnumber) = @_;
 964     my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;
 965
 966     # Find out whether member numbers should be generated
 967     # automatically. Should be either "1" or something else.
 968     # Defaults to "0", which is interpreted as "no".
 969
 970     #     if ($cardnumber !~ /\S/ && $autonumber_members) {
 971     ($autonumber_members) or return $cardnumber;
 972     my $checkdigit = C4::Context->preference('checkdigit');
 973     my $dbh = C4::Context->dbh;
 974     if ( $checkdigit and $checkdigit eq 'katipo' ) {
 975
 976         # if checkdigit is selected, calculate katipo-style cardnumber.
 977         # otherwise, just use the max()
 978         # purpose: generate checksum'd member numbers.
 979         # We'll assume we just got the max value of digits 2-8 of member #'s
 980         # from the database and our job is to increment that by one,
 981         # determine the 1st and 9th digits and return the full string.
 982         my $sth = $dbh->prepare(
 983             "select max(substring(borrowers.cardnumber,2,7)) as new_num from borrowers"
 984         );
 985         $sth->execute;
 986         my $data = $sth->fetchrow_hashref;
 987         $cardnumber = $data->{new_num};
 988         if ( !$cardnumber ) {    # If DB has no values,
 989             $cardnumber = 1000000;    # start at 1000000
 990         } else {
 991             $cardnumber += 1;
 992         }
 993
 994         my $sum = 0;
 995         for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
 996             # read weightings, left to right, 1 char at a time
 997             my $temp1 = $weightings[$i];
 998
 999             # sequence left to right, 1 char at a time
1000             my $temp2 = substr( $cardnumber, $i, 1 );
1001
1002             # mult each char 1-7 by its corresponding weighting
1003             $sum += $temp1 * $temp2;
1004         }
1005
1006         my $rem = ( $sum % 11 );
1007         $rem = 'X' if $rem == 10;
1008
1009         return "V$cardnumber$rem";
1010      } else {
1011
1012         my $sth = $dbh->prepare(
1013             'SELECT MAX( CAST( cardnumber AS SIGNED ) ) FROM borrowers WHERE cardnumber REGEXP "^-?[0-9]+$"'
1014         );
1015         $sth->execute;
1016         my ($result) = $sth->fetchrow;
1017         return $result + 1;
1018     }
1019     return $cardnumber;     # just here as a fallback/reminder
1020 }
1021
1022 =head2 GetGuarantees
1023
1024   ($num_children, $children_arrayref) = &GetGuarantees($parent_borrno);
1025   $child0_cardno = $children_arrayref->[0]{"cardnumber"};
1026   $child0_borrno = $children_arrayref->[0]{"borrowernumber"};
1027
1028 C<&GetGuarantees> takes a borrower number (e.g., that of a patron
1029 with children) and looks up the borrowers who are guaranteed by that
1030 borrower (i.e., the patron's children).
1031
1032 C<&GetGuarantees> returns two values: an integer giving the number of
1033 borrowers guaranteed by C<$parent_borrno>, and a reference to an array
1034 of references to hash, which gives the actual results.
1035
1036 =cut
1037
1038 #'
1039 sub GetGuarantees {
1040     my ($borrowernumber) = @_;
1041     my $dbh              = C4::Context->dbh;
1042     my $sth              =
1043       $dbh->prepare(
1044 "select cardnumber,borrowernumber, firstname, surname from borrowers where guarantorid=?"
1045       );
1046     $sth->execute($borrowernumber);
1047
1048     my @dat;
1049     my $data = $sth->fetchall_arrayref({});
1050     return ( scalar(@$data), $data );
1051 }
1052
1053 =head2 UpdateGuarantees
1054
1055   &UpdateGuarantees($parent_borrno);
1056
1057
1058 C<&UpdateGuarantees> borrower data for an adult and updates all the guarantees
1059 with the modified information
1060
1061 =cut
1062
1063 #'
1064 sub UpdateGuarantees {
1065     my %data = shift;
1066     my $dbh = C4::Context->dbh;
1067     my ( $count, $guarantees ) = GetGuarantees( $data{'borrowernumber'} );
1068     foreach my $guarantee (@$guarantees){
1069         my $guaquery = qq|UPDATE borrowers
1070               SET address=?,fax=?,B_city=?,mobile=?,city=?,phone=?
1071               WHERE borrowernumber=?
1072         |;
1073         my $sth = $dbh->prepare($guaquery);
1074         $sth->execute($data{'address'},$data{'fax'},$data{'B_city'},$data{'mobile'},$data{'city'},$data{'phone'},$guarantee->{'borrowernumber'});
1075     }
1076 }
1077 =head2 GetPendingIssues
1078
1079   my $issues = &GetPendingIssues(@borrowernumber);
1080
1081 Looks up what the patron with the given borrowernumber has borrowed.
1082
1083 C<&GetPendingIssues> returns a
1084 reference-to-array where each element is a reference-to-hash; the
1085 keys are the fields from the C<issues>, C<biblio>, and C<items> tables.
1086 The keys include C<biblioitems> fields except marc and marcxml.
1087
1088 =cut
1089
1090 #'
1091 sub GetPendingIssues {
1092     my @borrowernumbers = @_;
1093
1094     unless (@borrowernumbers ) { # return a ref_to_array
1095         return \@borrowernumbers; # to not cause surprise to caller
1096     }
1097
1098     # Borrowers part of the query
1099     my $bquery = '';
1100     for (my $i = 0; $i < @borrowernumbers; $i++) {
1101         $bquery .= ' issues.borrowernumber = ?';
1102         if ($i < $#borrowernumbers ) {
1103             $bquery .= ' OR';
1104         }
1105     }
1106
1107     # must avoid biblioitems.* to prevent large marc and marcxml fields from killing performance
1108     # FIXME: namespace collision: each table has "timestamp" fields.  Which one is "timestamp" ?
1109     # FIXME: circ/ciculation.pl tries to sort by timestamp!
1110     # FIXME: namespace collision: other collisions possible.
1111     # FIXME: most of this data isn't really being used by callers.
1112     my $query =
1113    "SELECT issues.*,
1114             items.*,
1115            biblio.*,
1116            biblioitems.volume,
1117            biblioitems.number,
1118            biblioitems.itemtype,
1119            biblioitems.isbn,
1120            biblioitems.issn,
1121            biblioitems.publicationyear,
1122            biblioitems.publishercode,
1123            biblioitems.volumedate,
1124            biblioitems.volumedesc,
1125            biblioitems.lccn,
1126            biblioitems.url,
1127            borrowers.firstname,
1128            borrowers.surname,
1129            borrowers.cardnumber,
1130            issues.timestamp AS timestamp,
1131            issues.renewals  AS renewals,
1132            issues.borrowernumber AS borrowernumber,
1133             items.renewals  AS totalrenewals
1134     FROM   issues
1135     LEFT JOIN items       ON items.itemnumber       =      issues.itemnumber
1136     LEFT JOIN biblio      ON items.biblionumber     =      biblio.biblionumber
1137     LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
1138     LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
1139     WHERE
1140       $bquery
1141     ORDER BY issues.issuedate"
1142     ;
1143
1144     my $sth = C4::Context->dbh->prepare($query);
1145     $sth->execute(@borrowernumbers);
1146     my $data = $sth->fetchall_arrayref({});
1147     my $tz = C4::Context->tz();
1148     my $today = DateTime->now( time_zone => $tz);
1149     foreach (@{$data}) {
1150         if ($_->{issuedate}) {
1151             $_->{issuedate} = dt_from_string($_->{issuedate}, 'sql');
1152         }
1153         $_->{date_due} or next;
1154         $_->{date_due} = DateTime::Format::DateParse->parse_datetime($_->{date_due}, $tz->name());
1155         if ( DateTime->compare($_->{date_due}, $today) == -1 ) {
1156             $_->{overdue} = 1;
1157         }
1158     }
1159     return $data;
1160 }
1161
1162 =head2 GetAllIssues
1163
1164   $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
1165
1166 Looks up what the patron with the given borrowernumber has borrowed,
1167 and sorts the results.
1168
1169 C<$sortkey> is the name of a field on which to sort the results. This
1170 should be the name of a field in the C<issues>, C<biblio>,
1171 C<biblioitems>, or C<items> table in the Koha database.
1172
1173 C<$limit> is the maximum number of results to return.
1174
1175 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
1176 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
1177 C<items> tables of the Koha database.
1178
1179 =cut
1180
1181 #'
1182 sub GetAllIssues {
1183     my ( $borrowernumber, $order, $limit ) = @_;
1184
1185     return unless $borrowernumber;
1186     $order = 'date_due desc' unless $order;
1187
1188     my $dbh = C4::Context->dbh;
1189     my $query =
1190 'SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1191   FROM issues
1192   LEFT JOIN items on items.itemnumber=issues.itemnumber
1193   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1194   LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1195   WHERE borrowernumber=?
1196   UNION ALL
1197   SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1198   FROM old_issues
1199   LEFT JOIN items on items.itemnumber=old_issues.itemnumber
1200   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1201   LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1202   WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL
1203   order by ' . $order;
1204     if ($limit) {
1205         $query .= " limit $limit";
1206     }
1207
1208     my $sth = $dbh->prepare($query);
1209     $sth->execute( $borrowernumber, $borrowernumber );
1210     return $sth->fetchall_arrayref( {} );
1211 }
1212
1213
1214 =head2 GetMemberAccountRecords
1215
1216   ($total, $acctlines, $count) = &GetMemberAccountRecords($borrowernumber);
1217
1218 Looks up accounting data for the patron with the given borrowernumber.
1219
1220 C<&GetMemberAccountRecords> returns a three-element array. C<$acctlines> is a
1221 reference-to-array, where each element is a reference-to-hash; the
1222 keys are the fields of the C<accountlines> table in the Koha database.
1223 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1224 total amount outstanding for all of the account lines.
1225
1226 =cut
1227
1228 sub GetMemberAccountRecords {
1229     my ($borrowernumber) = @_;
1230     my $dbh = C4::Context->dbh;
1231     my @acctlines;
1232     my $numlines = 0;
1233     my $strsth      = qq(
1234                         SELECT *
1235                         FROM accountlines
1236                         WHERE borrowernumber=?);
1237     $strsth.=" ORDER BY date desc,timestamp DESC";
1238     my $sth= $dbh->prepare( $strsth );
1239     $sth->execute( $borrowernumber );
1240
1241     my $total = 0;
1242     while ( my $data = $sth->fetchrow_hashref ) {
1243         if ( $data->{itemnumber} ) {
1244             my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
1245             $data->{biblionumber} = $biblio->{biblionumber};
1246             $data->{title}        = $biblio->{title};
1247         }
1248         $acctlines[$numlines] = $data;
1249         $numlines++;
1250         $total += int(1000 * $data->{'amountoutstanding'}); # convert float to integer to avoid round-off errors
1251     }
1252     $total /= 1000;
1253     return ( $total, \@acctlines,$numlines);
1254 }
1255
1256 =head2 GetMemberAccountBalance
1257
1258   ($total_balance, $non_issue_balance, $other_charges) = &GetMemberAccountBalance($borrowernumber);
1259
1260 Calculates amount immediately owing by the patron - non-issue charges.
1261 Based on GetMemberAccountRecords.
1262 Charges exempt from non-issue are:
1263 * Res (reserves)
1264 * Rent (rental) if RentalsInNoissuesCharge syspref is set to false
1265 * Manual invoices if ManInvInNoissuesCharge syspref is set to false
1266
1267 =cut
1268
1269 sub GetMemberAccountBalance {
1270     my ($borrowernumber) = @_;
1271
1272     my $ACCOUNT_TYPE_LENGTH = 5; # this is plain ridiculous...
1273
1274     my @not_fines;
1275     push @not_fines, 'Res' unless C4::Context->preference('HoldsInNoissuesCharge');
1276     push @not_fines, 'Rent' unless C4::Context->preference('RentalsInNoissuesCharge');
1277     unless ( C4::Context->preference('ManInvInNoissuesCharge') ) {
1278         my $dbh = C4::Context->dbh;
1279         my $man_inv_types = $dbh->selectcol_arrayref(qq{SELECT authorised_value FROM authorised_values WHERE category = 'MANUAL_INV'});
1280         push @not_fines, map substr($_, 0, $ACCOUNT_TYPE_LENGTH), @$man_inv_types;
1281     }
1282     my %not_fine = map {$_ => 1} @not_fines;
1283
1284     my ($total, $acctlines) = GetMemberAccountRecords($borrowernumber);
1285     my $other_charges = 0;
1286     foreach (@$acctlines) {
1287         $other_charges += $_->{amountoutstanding} if $not_fine{ substr($_->{accounttype}, 0, $ACCOUNT_TYPE_LENGTH) };
1288     }
1289
1290     return ( $total, $total - $other_charges, $other_charges);
1291 }
1292
1293 =head2 GetBorNotifyAcctRecord
1294
1295   ($total, $acctlines, $count) = &GetBorNotifyAcctRecord($params,$notifyid);
1296
1297 Looks up accounting data for the patron with the given borrowernumber per file number.
1298
1299 C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a
1300 reference-to-array, where each element is a reference-to-hash; the
1301 keys are the fields of the C<accountlines> table in the Koha database.
1302 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1303 total amount outstanding for all of the account lines.
1304
1305 =cut
1306
1307 sub GetBorNotifyAcctRecord {
1308     my ( $borrowernumber, $notifyid ) = @_;
1309     my $dbh = C4::Context->dbh;
1310     my @acctlines;
1311     my $numlines = 0;
1312     my $sth = $dbh->prepare(
1313             "SELECT *
1314                 FROM accountlines
1315                 WHERE borrowernumber=?
1316                     AND notify_id=?
1317                     AND amountoutstanding != '0'
1318                 ORDER BY notify_id,accounttype
1319                 ");
1320
1321     $sth->execute( $borrowernumber, $notifyid );
1322     my $total = 0;
1323     while ( my $data = $sth->fetchrow_hashref ) {
1324         if ( $data->{itemnumber} ) {
1325             my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
1326             $data->{biblionumber} = $biblio->{biblionumber};
1327             $data->{title}        = $biblio->{title};
1328         }
1329         $acctlines[$numlines] = $data;
1330         $numlines++;
1331         $total += int(100 * $data->{'amountoutstanding'});
1332     }
1333     $total /= 100;
1334     return ( $total, \@acctlines, $numlines );
1335 }
1336
1337 =head2 checkuniquemember (OUEST-PROVENCE)
1338
1339   ($result,$categorycode)  = &checkuniquemember($collectivity,$surname,$firstname,$dateofbirth);
1340
1341 Checks that a member exists or not in the database.
1342
1343 C<&result> is nonzero (=exist) or 0 (=does not exist)
1344 C<&categorycode> is from categorycode table
1345 C<&collectivity> is 1 (= we add a collectivity) or 0 (= we add a physical member)
1346 C<&surname> is the surname
1347 C<&firstname> is the firstname (only if collectivity=0)
1348 C<&dateofbirth> is the date of birth in ISO format (only if collectivity=0)
1349
1350 =cut
1351
1352 # FIXME: This function is not legitimate.  Multiple patrons might have the same first/last name and birthdate.
1353 # This is especially true since first name is not even a required field.
1354
1355 sub checkuniquemember {
1356     my ( $collectivity, $surname, $firstname, $dateofbirth ) = @_;
1357     my $dbh = C4::Context->dbh;
1358     my $request = ($collectivity) ?
1359         "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? " :
1360             ($dateofbirth) ?
1361             "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=?  and dateofbirth=?" :
1362             "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=?";
1363     my $sth = $dbh->prepare($request);
1364     if ($collectivity) {
1365         $sth->execute( uc($surname) );
1366     } elsif($dateofbirth){
1367         $sth->execute( uc($surname), ucfirst($firstname), $dateofbirth );
1368     }else{
1369         $sth->execute( uc($surname), ucfirst($firstname));
1370     }
1371     my @data = $sth->fetchrow;
1372     ( $data[0] ) and return $data[0], $data[1];
1373     return 0;
1374 }
1375
1376 sub checkcardnumber {
1377     my ( $cardnumber, $borrowernumber ) = @_;
1378
1379     # If cardnumber is null, we assume they're allowed.
1380     return 0 unless defined $cardnumber;
1381
1382     my $dbh = C4::Context->dbh;
1383     my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
1384     $query .= " AND borrowernumber <> ?" if ($borrowernumber);
1385     my $sth = $dbh->prepare($query);
1386     $sth->execute(
1387         $cardnumber,
1388         ( $borrowernumber ? $borrowernumber : () )
1389     );
1390
1391     return 1 if $sth->fetchrow_hashref;
1392
1393     my ( $min_length, $max_length ) = get_cardnumber_length();
1394     return 2
1395         if length $cardnumber > $max_length
1396         or length $cardnumber < $min_length;
1397
1398     return 0;
1399 }
1400
1401 =head2 get_cardnumber_length
1402
1403     my ($min, $max) = C4::Members::get_cardnumber_length()
1404
1405 Returns the minimum and maximum length for patron cardnumbers as
1406 determined by the CardnumberLength system preference, the
1407 BorrowerMandatoryField system preference, and the width of the
1408 database column.
1409
1410 =cut
1411
1412 sub get_cardnumber_length {
1413     my ( $min, $max ) = ( 0, 16 ); # borrowers.cardnumber is a nullable varchar(16)
1414     $min = 1 if C4::Context->preference('BorrowerMandatoryField') =~ /cardnumber/;
1415     if ( my $cardnumber_length = C4::Context->preference('CardnumberLength') ) {
1416         # Is integer and length match
1417         if ( $cardnumber_length =~ m|^\d+$| ) {
1418             $min = $max = $cardnumber_length
1419                 if $cardnumber_length >= $min
1420                     and $cardnumber_length <= $max;
1421         }
1422         # Else assuming it is a range
1423         elsif ( $cardnumber_length =~ m|(\d*),(\d*)| ) {
1424             $min = $1 if $1 and $min < $1;
1425             $max = $2 if $2 and $max > $2;
1426         }
1427
1428     }
1429     return ( $min, $max );
1430 }
1431
1432 =head2 getzipnamecity (OUEST-PROVENCE)
1433
1434 take all info from table city for the fields city and  zip
1435 check for the name and the zip code of the city selected
1436
1437 =cut
1438
1439 sub getzipnamecity {
1440     my ($cityid) = @_;
1441     my $dbh      = C4::Context->dbh;
1442     my $sth      =
1443       $dbh->prepare(
1444         "select city_name,city_state,city_zipcode,city_country from cities where cityid=? ");
1445     $sth->execute($cityid);
1446     my @data = $sth->fetchrow;
1447     return $data[0], $data[1], $data[2], $data[3];
1448 }
1449
1450
1451 =head2 getdcity (OUEST-PROVENCE)
1452
1453 recover cityid  with city_name condition
1454
1455 =cut
1456
1457 sub getidcity {
1458     my ($city_name) = @_;
1459     my $dbh = C4::Context->dbh;
1460     my $sth = $dbh->prepare("select cityid from cities where city_name=? ");
1461     $sth->execute($city_name);
1462     my $data = $sth->fetchrow;
1463     return $data;
1464 }
1465
1466 =head2 GetFirstValidEmailAddress
1467
1468   $email = GetFirstValidEmailAddress($borrowernumber);
1469
1470 Return the first valid email address for a borrower, given the borrowernumber.  For now, the order
1471 is defined as email, emailpro, B_email.  Returns the empty string if the borrower has no email
1472 addresses.
1473
1474 =cut
1475
1476 sub GetFirstValidEmailAddress {
1477     my $borrowernumber = shift;
1478     my $dbh = C4::Context->dbh;
1479     my $sth = $dbh->prepare( "SELECT email, emailpro, B_email FROM borrowers where borrowernumber = ? ");
1480     $sth->execute( $borrowernumber );
1481     my $data = $sth->fetchrow_hashref;
1482
1483     if ($data->{'email'}) {
1484        return $data->{'email'};
1485     } elsif ($data->{'emailpro'}) {
1486        return $data->{'emailpro'};
1487     } elsif ($data->{'B_email'}) {
1488        return $data->{'B_email'};
1489     } else {
1490        return '';
1491     }
1492 }
1493
1494 =head2 GetNoticeEmailAddress
1495
1496   $email = GetNoticeEmailAddress($borrowernumber);
1497
1498 Return the email address of borrower used for notices, given the borrowernumber.
1499 Returns the empty string if no email address.
1500
1501 =cut
1502
1503 sub GetNoticeEmailAddress {
1504     my $borrowernumber = shift;
1505
1506     my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
1507     # if syspref is set to 'first valid' (value == OFF), look up email address
1508     if ( $which_address eq 'OFF' ) {
1509         return GetFirstValidEmailAddress($borrowernumber);
1510     }
1511     # specified email address field
1512     my $dbh = C4::Context->dbh;
1513     my $sth = $dbh->prepare( qq{
1514         SELECT $which_address AS primaryemail
1515         FROM borrowers
1516         WHERE borrowernumber=?
1517     } );
1518     $sth->execute($borrowernumber);
1519     my $data = $sth->fetchrow_hashref;
1520     return $data->{'primaryemail'} || '';
1521 }
1522
1523 =head2 GetExpiryDate
1524
1525   $expirydate = GetExpiryDate($categorycode, $dateenrolled);
1526
1527 Calculate expiry date given a categorycode and starting date.  Date argument must be in ISO format.
1528 Return date is also in ISO format.
1529
1530 =cut
1531
1532 sub GetExpiryDate {
1533     my ( $categorycode, $dateenrolled ) = @_;
1534     my $enrolments;
1535     if ($categorycode) {
1536         my $dbh = C4::Context->dbh;
1537         my $sth = $dbh->prepare("SELECT enrolmentperiod,enrolmentperioddate FROM categories WHERE categorycode=?");
1538         $sth->execute($categorycode);
1539         $enrolments = $sth->fetchrow_hashref;
1540     }
1541     # die "GetExpiryDate: for enrollmentperiod $enrolmentperiod (category '$categorycode') starting $dateenrolled.\n";
1542     my @date = split (/-/,$dateenrolled);
1543     if($enrolments->{enrolmentperiod}){
1544         return sprintf("%04d-%02d-%02d", Add_Delta_YM(@date,0,$enrolments->{enrolmentperiod}));
1545     }else{
1546         return $enrolments->{enrolmentperioddate};
1547     }
1548 }
1549
1550 =head2 GetborCatFromCatType
1551
1552   ($codes_arrayref, $labels_hashref) = &GetborCatFromCatType();
1553
1554 Looks up the different types of borrowers in the database. Returns two
1555 elements: a reference-to-array, which lists the borrower category
1556 codes, and a reference-to-hash, which maps the borrower category codes
1557 to category descriptions.
1558
1559 =cut
1560
1561 #'
1562 sub GetborCatFromCatType {
1563     my ( $category_type, $action, $no_branch_limit ) = @_;
1564
1565     my $branch_limit = $no_branch_limit
1566         ? 0
1567         : C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1568
1569     # FIXME - This API  seems both limited and dangerous.
1570     my $dbh     = C4::Context->dbh;
1571
1572     my $request = qq{
1573         SELECT categories.categorycode, categories.description
1574         FROM categories
1575     };
1576     $request .= qq{
1577         LEFT JOIN categories_branches ON categories.categorycode = categories_branches.categorycode
1578     } if $branch_limit;
1579     if($action) {
1580         $request .= " $action ";
1581         $request .= " AND (branchcode = ? OR branchcode IS NULL) GROUP BY description" if $branch_limit;
1582     } else {
1583         $request .= " WHERE branchcode = ? OR branchcode IS NULL GROUP BY description" if $branch_limit;
1584     }
1585     $request .= " ORDER BY categorycode";
1586
1587     my $sth = $dbh->prepare($request);
1588     $sth->execute(
1589         $action ? $category_type : (),
1590         $branch_limit ? $branch_limit : ()
1591     );
1592
1593     my %labels;
1594     my @codes;
1595
1596     while ( my $data = $sth->fetchrow_hashref ) {
1597         push @codes, $data->{'categorycode'};
1598         $labels{ $data->{'categorycode'} } = $data->{'description'};
1599     }
1600     $sth->finish;
1601     return ( \@codes, \%labels );
1602 }
1603
1604 =head2 GetBorrowercategory
1605
1606   $hashref = &GetBorrowercategory($categorycode);
1607
1608 Given the borrower's category code, the function returns the corresponding
1609 data hashref for a comprehensive information display.
1610
1611 =cut
1612
1613 sub GetBorrowercategory {
1614     my ($catcode) = @_;
1615     my $dbh       = C4::Context->dbh;
1616     if ($catcode){
1617         my $sth       =
1618         $dbh->prepare(
1619     "SELECT description,dateofbirthrequired,upperagelimit,category_type
1620     FROM categories
1621     WHERE categorycode = ?"
1622         );
1623         $sth->execute($catcode);
1624         my $data =
1625         $sth->fetchrow_hashref;
1626         return $data;
1627     }
1628     return;
1629 }    # sub getborrowercategory
1630
1631
1632 =head2 GetBorrowerCategorycode
1633
1634     $categorycode = &GetBorrowerCategoryCode( $borrowernumber );
1635
1636 Given the borrowernumber, the function returns the corresponding categorycode
1637 =cut
1638
1639 sub GetBorrowerCategorycode {
1640     my ( $borrowernumber ) = @_;
1641     my $dbh = C4::Context->dbh;
1642     my $sth = $dbh->prepare( qq{
1643         SELECT categorycode
1644         FROM borrowers
1645         WHERE borrowernumber = ?
1646     } );
1647     $sth->execute( $borrowernumber );
1648     return $sth->fetchrow;
1649 }
1650
1651 =head2 GetBorrowercategoryList
1652
1653   $arrayref_hashref = &GetBorrowercategoryList;
1654 If no category code provided, the function returns all the categories.
1655
1656 =cut
1657
1658 sub GetBorrowercategoryList {
1659     my $no_branch_limit = @_ ? shift : 0;
1660     my $branch_limit = $no_branch_limit
1661         ? 0
1662         : C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1663     my $dbh       = C4::Context->dbh;
1664     my $query = "SELECT categories.* FROM categories";
1665     $query .= qq{
1666         LEFT JOIN categories_branches ON categories.categorycode = categories_branches.categorycode
1667         WHERE branchcode = ? OR branchcode IS NULL GROUP BY description
1668     } if $branch_limit;
1669     $query .= " ORDER BY description";
1670     my $sth = $dbh->prepare( $query );
1671     $sth->execute( $branch_limit ? $branch_limit : () );
1672     my $data = $sth->fetchall_arrayref( {} );
1673     $sth->finish;
1674     return $data;
1675 }    # sub getborrowercategory
1676
1677 =head2 ethnicitycategories
1678
1679   ($codes_arrayref, $labels_hashref) = &ethnicitycategories();
1680
1681 Looks up the different ethnic types in the database. Returns two
1682 elements: a reference-to-array, which lists the ethnicity codes, and a
1683 reference-to-hash, which maps the ethnicity codes to ethnicity
1684 descriptions.
1685
1686 =cut
1687
1688 #'
1689
1690 sub ethnicitycategories {
1691     my $dbh = C4::Context->dbh;
1692     my $sth = $dbh->prepare("Select code,name from ethnicity order by name");
1693     $sth->execute;
1694     my %labels;
1695     my @codes;
1696     while ( my $data = $sth->fetchrow_hashref ) {
1697         push @codes, $data->{'code'};
1698         $labels{ $data->{'code'} } = $data->{'name'};
1699     }
1700     return ( \@codes, \%labels );
1701 }
1702
1703 =head2 fixEthnicity
1704
1705   $ethn_name = &fixEthnicity($ethn_code);
1706
1707 Takes an ethnicity code (e.g., "european" or "pi") and returns the
1708 corresponding descriptive name from the C<ethnicity> table in the
1709 Koha database ("European" or "Pacific Islander").
1710
1711 =cut
1712
1713 #'
1714
1715 sub fixEthnicity {
1716     my $ethnicity = shift;
1717     return unless $ethnicity;
1718     my $dbh       = C4::Context->dbh;
1719     my $sth       = $dbh->prepare("Select name from ethnicity where code = ?");
1720     $sth->execute($ethnicity);
1721     my $data = $sth->fetchrow_hashref;
1722     return $data->{'name'};
1723 }    # sub fixEthnicity
1724
1725 =head2 GetAge
1726
1727   $dateofbirth,$date = &GetAge($date);
1728
1729 this function return the borrowers age with the value of dateofbirth
1730
1731 =cut
1732
1733 #'
1734 sub GetAge{
1735     my ( $date, $date_ref ) = @_;
1736
1737     if ( not defined $date_ref ) {
1738         $date_ref = sprintf( '%04d-%02d-%02d', Today() );
1739     }
1740
1741     my ( $year1, $month1, $day1 ) = split /-/, $date;
1742     my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
1743
1744     my $age = $year2 - $year1;
1745     if ( $month1 . $day1 > $month2 . $day2 ) {
1746         $age--;
1747     }
1748
1749     return $age;
1750 }    # sub get_age
1751
1752 =head2 SetAge
1753
1754   $borrower = C4::Members::SetAge($borrower, $datetimeduration);
1755   $borrower = C4::Members::SetAge($borrower, '0015-12-10');
1756   $borrower = C4::Members::SetAge($borrower, $datetimeduration, $datetime_reference);
1757
1758   eval { $borrower = C4::Members::SetAge($borrower, '015-1-10'); };
1759   if ($@) {print $@;} #Catch a bad ISO Date or kill your script!
1760
1761 This function sets the borrower's dateofbirth to match the given age.
1762 Optionally relative to the given $datetime_reference.
1763
1764 @PARAM1 koha.borrowers-object
1765 @PARAM2 DateTime::Duration-object as the desired age
1766         OR a ISO 8601 Date. (To make the API more pleasant)
1767 @PARAM3 DateTime-object as the relative date, defaults to now().
1768 RETURNS The given borrower reference @PARAM1.
1769 DIES    If there was an error with the ISO Date handling.
1770
1771 =cut
1772
1773 #'
1774 sub SetAge{
1775     my ( $borrower, $datetimeduration, $datetime_ref ) = @_;
1776     $datetime_ref = DateTime->now() unless $datetime_ref;
1777
1778     if ($datetimeduration && ref $datetimeduration ne 'DateTime::Duration') {
1779         if ($datetimeduration =~ /^(\d{4})-(\d{2})-(\d{2})/) {
1780             $datetimeduration = DateTime::Duration->new(years => $1, months => $2, days => $3);
1781         }
1782         else {
1783             die "C4::Members::SetAge($borrower, $datetimeduration), datetimeduration not a valid ISO 8601 Date!\n";
1784         }
1785     }
1786
1787     my $new_datetime_ref = $datetime_ref->clone();
1788     $new_datetime_ref->subtract_duration( $datetimeduration );
1789
1790     $borrower->{dateofbirth} = $new_datetime_ref->ymd();
1791
1792     return $borrower;
1793 }    # sub SetAge
1794
1795 =head2 GetCities
1796
1797   $cityarrayref = GetCities();
1798
1799   Returns an array_ref of the entries in the cities table
1800   If there are entries in the table an empty row is returned
1801   This is currently only used to populate a popup in memberentry
1802
1803 =cut
1804
1805 sub GetCities {
1806
1807     my $dbh   = C4::Context->dbh;
1808     my $city_arr = $dbh->selectall_arrayref(
1809         q|SELECT cityid,city_zipcode,city_name,city_state,city_country FROM cities ORDER BY city_name|,
1810         { Slice => {} });
1811     if ( @{$city_arr} ) {
1812         unshift @{$city_arr}, {
1813             city_zipcode => q{},
1814             city_name    => q{},
1815             cityid       => q{},
1816             city_state   => q{},
1817             city_country => q{},
1818         };
1819     }
1820
1821     return  $city_arr;
1822 }
1823
1824 =head2 GetSortDetails (OUEST-PROVENCE)
1825
1826   ($lib) = &GetSortDetails($category,$sortvalue);
1827
1828 Returns the authorized value  details
1829 C<&$lib>return value of authorized value details
1830 C<&$sortvalue>this is the value of authorized value
1831 C<&$category>this is the value of authorized value category
1832
1833 =cut
1834
1835 sub GetSortDetails {
1836     my ( $category, $sortvalue ) = @_;
1837     my $dbh   = C4::Context->dbh;
1838     my $query = qq|SELECT lib
1839         FROM authorised_values
1840         WHERE category=?
1841         AND authorised_value=? |;
1842     my $sth = $dbh->prepare($query);
1843     $sth->execute( $category, $sortvalue );
1844     my $lib = $sth->fetchrow;
1845     return ($lib) if ($lib);
1846     return ($sortvalue) unless ($lib);
1847 }
1848
1849 =head2 MoveMemberToDeleted
1850
1851   $result = &MoveMemberToDeleted($borrowernumber);
1852
1853 Copy the record from borrowers to deletedborrowers table.
1854 The routine returns 1 for success, undef for failure.
1855
1856 =cut
1857
1858 sub MoveMemberToDeleted {
1859     my ($member) = shift or return;
1860
1861     my $schema       = Koha::Database->new()->schema();
1862     my $borrowers_rs = $schema->resultset('Borrower');
1863     $borrowers_rs->result_class('DBIx::Class::ResultClass::HashRefInflator');
1864     my $borrower = $borrowers_rs->find($member);
1865     return unless $borrower;
1866
1867     my $deleted = $schema->resultset('Deletedborrower')->create($borrower);
1868
1869     return $deleted ? 1 : undef;
1870 }
1871
1872 =head2 DelMember
1873
1874     DelMember($borrowernumber);
1875
1876 This function remove directly a borrower whitout writing it on deleteborrower.
1877 + Deletes reserves for the borrower
1878
1879 =cut
1880
1881 sub DelMember {
1882     my $dbh            = C4::Context->dbh;
1883     my $borrowernumber = shift;
1884     #warn "in delmember with $borrowernumber";
1885     return unless $borrowernumber;    # borrowernumber is mandatory.
1886
1887     my $query = qq|DELETE
1888           FROM  reserves
1889           WHERE borrowernumber=?|;
1890     my $sth = $dbh->prepare($query);
1891     $sth->execute($borrowernumber);
1892     $query = "
1893        DELETE
1894        FROM borrowers
1895        WHERE borrowernumber = ?
1896    ";
1897     $sth = $dbh->prepare($query);
1898     $sth->execute($borrowernumber);
1899     logaction("MEMBERS", "DELETE", $borrowernumber, "") if C4::Context->preference("BorrowersLog");
1900     return $sth->rows;
1901 }
1902
1903 =head2 ExtendMemberSubscriptionTo (OUEST-PROVENCE)
1904
1905     $date = ExtendMemberSubscriptionTo($borrowerid, $date);
1906
1907 Extending the subscription to a given date or to the expiry date calculated on ISO date.
1908 Returns ISO date.
1909
1910 =cut
1911
1912 sub ExtendMemberSubscriptionTo {
1913     my ( $borrowerid,$date) = @_;
1914     my $dbh = C4::Context->dbh;
1915     my $borrower = GetMember('borrowernumber'=>$borrowerid);
1916     unless ($date){
1917       $date = (C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry') ?
1918                                         C4::Dates->new($borrower->{'dateexpiry'}, 'iso')->output("iso") :
1919                                         C4::Dates->new()->output("iso");
1920       $date = GetExpiryDate( $borrower->{'categorycode'}, $date );
1921     }
1922     my $sth = $dbh->do(<<EOF);
1923 UPDATE borrowers
1924 SET  dateexpiry='$date'
1925 WHERE borrowernumber='$borrowerid'
1926 EOF
1927
1928     AddEnrolmentFeeIfNeeded( $borrower->{categorycode}, $borrower->{borrowernumber} );
1929
1930     logaction("MEMBERS", "RENEW", $borrower->{'borrowernumber'}, "Membership renewed")if C4::Context->preference("BorrowersLog");
1931     return $date if ($sth);
1932     return 0;
1933 }
1934
1935 =head2 GetTitles (OUEST-PROVENCE)
1936
1937   ($borrowertitle)= &GetTitles();
1938
1939 Looks up the different title . Returns array  with all borrowers title
1940
1941 =cut
1942
1943 sub GetTitles {
1944     my @borrowerTitle = split (/,|\|/,C4::Context->preference('BorrowersTitles'));
1945     unshift( @borrowerTitle, "" );
1946     my $count=@borrowerTitle;
1947     if ($count == 1){
1948         return ();
1949     }
1950     else {
1951         return ( \@borrowerTitle);
1952     }
1953 }
1954
1955 =head2 GetPatronImage
1956
1957     my ($imagedata, $dberror) = GetPatronImage($borrowernumber);
1958
1959 Returns the mimetype and binary image data of the image for the patron with the supplied borrowernumber.
1960
1961 =cut
1962
1963 sub GetPatronImage {
1964     my ($borrowernumber) = @_;
1965     warn "Borrowernumber passed to GetPatronImage is $borrowernumber" if $debug;
1966     my $dbh = C4::Context->dbh;
1967     my $query = 'SELECT mimetype, imagefile FROM patronimage WHERE borrowernumber = ?';
1968     my $sth = $dbh->prepare($query);
1969     $sth->execute($borrowernumber);
1970     my $imagedata = $sth->fetchrow_hashref;
1971     warn "Database error!" if $sth->errstr;
1972     return $imagedata, $sth->errstr;
1973 }
1974
1975 =head2 PutPatronImage
1976
1977     PutPatronImage($cardnumber, $mimetype, $imgfile);
1978
1979 Stores patron binary image data and mimetype in database.
1980 NOTE: This function is good for updating images as well as inserting new images in the database.
1981
1982 =cut
1983
1984 sub PutPatronImage {
1985     my ($cardnumber, $mimetype, $imgfile) = @_;
1986     warn "Parameters passed in: Cardnumber=$cardnumber, Mimetype=$mimetype, " . ($imgfile ? "Imagefile" : "No Imagefile") if $debug;
1987     my $dbh = C4::Context->dbh;
1988     my $query = "INSERT INTO patronimage (borrowernumber, mimetype, imagefile) VALUES ( ( SELECT borrowernumber from borrowers WHERE cardnumber = ? ),?,?) ON DUPLICATE KEY UPDATE imagefile = ?;";
1989     my $sth = $dbh->prepare($query);
1990     $sth->execute($cardnumber,$mimetype,$imgfile,$imgfile);
1991     warn "Error returned inserting $cardnumber.$mimetype." if $sth->errstr;
1992     return $sth->errstr;
1993 }
1994
1995 =head2 RmPatronImage
1996
1997     my ($dberror) = RmPatronImage($borrowernumber);
1998
1999 Removes the image for the patron with the supplied borrowernumber.
2000
2001 =cut
2002
2003 sub RmPatronImage {
2004     my ($borrowernumber) = @_;
2005     warn "Borrowernumber passed to GetPatronImage is $borrowernumber" if $debug;
2006     my $dbh = C4::Context->dbh;
2007     my $query = "DELETE FROM patronimage WHERE borrowernumber = ?;";
2008     my $sth = $dbh->prepare($query);
2009     $sth->execute($borrowernumber);
2010     my $dberror = $sth->errstr;
2011     warn "Database error!" if $sth->errstr;
2012     return $dberror;
2013 }
2014
2015 =head2 GetHideLostItemsPreference
2016
2017   $hidelostitemspref = &GetHideLostItemsPreference($borrowernumber);
2018
2019 Returns the HideLostItems preference for the patron category of the supplied borrowernumber
2020 C<&$hidelostitemspref>return value of function, 0 or 1
2021
2022 =cut
2023
2024 sub GetHideLostItemsPreference {
2025     my ($borrowernumber) = @_;
2026     my $dbh = C4::Context->dbh;
2027     my $query = "SELECT hidelostitems FROM borrowers,categories WHERE borrowers.categorycode = categories.categorycode AND borrowernumber = ?";
2028     my $sth = $dbh->prepare($query);
2029     $sth->execute($borrowernumber);
2030     my $hidelostitems = $sth->fetchrow;
2031     return $hidelostitems;
2032 }
2033
2034 =head2 GetBorrowersToExpunge
2035
2036   $borrowers = &GetBorrowersToExpunge(
2037       not_borrowered_since => $not_borrowered_since,
2038       expired_before       => $expired_before,
2039       category_code        => $category_code,
2040       branchcode           => $branchcode
2041   );
2042
2043   This function get all borrowers based on the given criteria.
2044
2045 =cut
2046
2047 sub GetBorrowersToExpunge {
2048     my $params = shift;
2049
2050     my $filterdate     = $params->{'not_borrowered_since'};
2051     my $filterexpiry   = $params->{'expired_before'};
2052     my $filtercategory = $params->{'category_code'};
2053     my $filterbranch   = $params->{'branchcode'} ||
2054                         ((C4::Context->preference('IndependentBranches')
2055                              && C4::Context->userenv
2056                              && !C4::Context->IsSuperLibrarian()
2057                              && C4::Context->userenv->{branch})
2058                          ? C4::Context->userenv->{branch}
2059                          : "");
2060
2061     my $dbh   = C4::Context->dbh;
2062     my $query = "
2063         SELECT borrowers.borrowernumber,
2064                MAX(old_issues.timestamp) AS latestissue,
2065                MAX(issues.timestamp) AS currentissue
2066         FROM   borrowers
2067         JOIN   categories USING (categorycode)
2068         LEFT JOIN old_issues USING (borrowernumber)
2069         LEFT JOIN issues USING (borrowernumber)
2070         WHERE  category_type <> 'S'
2071         AND borrowernumber NOT IN (SELECT guarantorid FROM borrowers WHERE guarantorid IS NOT NULL AND guarantorid <> 0)
2072    ";
2073     my @query_params;
2074     if ( $filterbranch && $filterbranch ne "" ) {
2075         $query.= " AND borrowers.branchcode = ? ";
2076         push( @query_params, $filterbranch );
2077     }
2078     if ( $filterexpiry ) {
2079         $query .= " AND dateexpiry < ? ";
2080         push( @query_params, $filterexpiry );
2081     }
2082     if ( $filtercategory ) {
2083         $query .= " AND categorycode = ? ";
2084         push( @query_params, $filtercategory );
2085     }
2086     $query.=" GROUP BY borrowers.borrowernumber HAVING currentissue IS NULL ";
2087     if ( $filterdate ) {
2088         $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
2089         push @query_params,$filterdate;
2090     }
2091     warn $query if $debug;
2092
2093     my $sth = $dbh->prepare($query);
2094     if (scalar(@query_params)>0){
2095         $sth->execute(@query_params);
2096     }
2097     else {
2098         $sth->execute;
2099     }
2100
2101     my @results;
2102     while ( my $data = $sth->fetchrow_hashref ) {
2103         push @results, $data;
2104     }
2105     return \@results;
2106 }
2107
2108 =head2 GetBorrowersWhoHaveNeverBorrowed
2109
2110   $results = &GetBorrowersWhoHaveNeverBorrowed
2111
2112 This function get all borrowers who have never borrowed.
2113
2114 I<$result> is a ref to an array which all elements are a hasref.
2115
2116 =cut
2117
2118 sub GetBorrowersWhoHaveNeverBorrowed {
2119     my $filterbranch = shift ||
2120                         ((C4::Context->preference('IndependentBranches')
2121                              && C4::Context->userenv
2122                              && !C4::Context->IsSuperLibrarian()
2123                              && C4::Context->userenv->{branch})
2124                          ? C4::Context->userenv->{branch}
2125                          : "");
2126     my $dbh   = C4::Context->dbh;
2127     my $query = "
2128         SELECT borrowers.borrowernumber,max(timestamp) as latestissue
2129         FROM   borrowers
2130           LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
2131         WHERE issues.borrowernumber IS NULL
2132    ";
2133     my @query_params;
2134     if ($filterbranch && $filterbranch ne ""){
2135         $query.=" AND borrowers.branchcode= ?";
2136         push @query_params,$filterbranch;
2137     }
2138     warn $query if $debug;
2139
2140     my $sth = $dbh->prepare($query);
2141     if (scalar(@query_params)>0){
2142         $sth->execute(@query_params);
2143     }
2144     else {
2145         $sth->execute;
2146     }
2147
2148     my @results;
2149     while ( my $data = $sth->fetchrow_hashref ) {
2150         push @results, $data;
2151     }
2152     return \@results;
2153 }
2154
2155 =head2 GetBorrowersWithIssuesHistoryOlderThan
2156
2157   $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
2158
2159 this function get all borrowers who has an issue history older than I<$date> given on input arg.
2160
2161 I<$result> is a ref to an array which all elements are a hashref.
2162 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2163
2164 =cut
2165
2166 sub GetBorrowersWithIssuesHistoryOlderThan {
2167     my $dbh  = C4::Context->dbh;
2168     my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
2169     my $filterbranch = shift ||
2170                         ((C4::Context->preference('IndependentBranches')
2171                              && C4::Context->userenv
2172                              && !C4::Context->IsSuperLibrarian()
2173                              && C4::Context->userenv->{branch})
2174                          ? C4::Context->userenv->{branch}
2175                          : "");
2176     my $query = "
2177        SELECT count(borrowernumber) as n,borrowernumber
2178        FROM old_issues
2179        WHERE returndate < ?
2180          AND borrowernumber IS NOT NULL
2181     ";
2182     my @query_params;
2183     push @query_params, $date;
2184     if ($filterbranch){
2185         $query.="   AND branchcode = ?";
2186         push @query_params, $filterbranch;
2187     }
2188     $query.=" GROUP BY borrowernumber ";
2189     warn $query if $debug;
2190     my $sth = $dbh->prepare($query);
2191     $sth->execute(@query_params);
2192     my @results;
2193
2194     while ( my $data = $sth->fetchrow_hashref ) {
2195         push @results, $data;
2196     }
2197     return \@results;
2198 }
2199
2200 =head2 GetBorrowersNamesAndLatestIssue
2201
2202   $results = &GetBorrowersNamesAndLatestIssueList(@borrowernumbers)
2203
2204 this function get borrowers Names and surnames and Issue information.
2205
2206 I<@borrowernumbers> is an array which all elements are borrowernumbers.
2207 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2208
2209 =cut
2210
2211 sub GetBorrowersNamesAndLatestIssue {
2212     my $dbh  = C4::Context->dbh;
2213     my @borrowernumbers=@_;
2214     my $query = "
2215        SELECT surname,lastname, phone, email,max(timestamp)
2216        FROM borrowers
2217          LEFT JOIN issues ON borrowers.borrowernumber=issues.borrowernumber
2218        GROUP BY borrowernumber
2219    ";
2220     my $sth = $dbh->prepare($query);
2221     $sth->execute;
2222     my $results = $sth->fetchall_arrayref({});
2223     return $results;
2224 }
2225
2226 =head2 ModPrivacy
2227
2228 =over 4
2229
2230 my $success = ModPrivacy( $borrowernumber, $privacy );
2231
2232 Update the privacy of a patron.
2233
2234 return :
2235 true on success, false on failure
2236
2237 =back
2238
2239 =cut
2240
2241 sub ModPrivacy {
2242     my $borrowernumber = shift;
2243     my $privacy = shift;
2244     return unless defined $borrowernumber;
2245     return unless $borrowernumber =~ /^\d+$/;
2246
2247     return ModMember( borrowernumber => $borrowernumber,
2248                       privacy        => $privacy );
2249 }
2250
2251 =head2 AddMessage
2252
2253   AddMessage( $borrowernumber, $message_type, $message, $branchcode );
2254
2255 Adds a message to the messages table for the given borrower.
2256
2257 Returns:
2258   True on success
2259   False on failure
2260
2261 =cut
2262
2263 sub AddMessage {
2264     my ( $borrowernumber, $message_type, $message, $branchcode ) = @_;
2265
2266     my $dbh  = C4::Context->dbh;
2267
2268     if ( ! ( $borrowernumber && $message_type && $message && $branchcode ) ) {
2269       return;
2270     }
2271
2272     my $query = "INSERT INTO messages ( borrowernumber, branchcode, message_type, message ) VALUES ( ?, ?, ?, ? )";
2273     my $sth = $dbh->prepare($query);
2274     $sth->execute( $borrowernumber, $branchcode, $message_type, $message );
2275     logaction("MEMBERS", "ADDCIRCMESSAGE", $borrowernumber, $message) if C4::Context->preference("BorrowersLog");
2276     return 1;
2277 }
2278
2279 =head2 GetMessages
2280
2281   GetMessages( $borrowernumber, $type );
2282
2283 $type is message type, B for borrower, or L for Librarian.
2284 Empty type returns all messages of any type.
2285
2286 Returns all messages for the given borrowernumber
2287
2288 =cut
2289
2290 sub GetMessages {
2291     my ( $borrowernumber, $type, $branchcode ) = @_;
2292
2293     if ( ! $type ) {
2294       $type = '%';
2295     }
2296
2297     my $dbh  = C4::Context->dbh;
2298
2299     my $query = "SELECT
2300                   branches.branchname,
2301                   messages.*,
2302                   message_date,
2303                   messages.branchcode LIKE '$branchcode' AS can_delete
2304                   FROM messages, branches
2305                   WHERE borrowernumber = ?
2306                   AND message_type LIKE ?
2307                   AND messages.branchcode = branches.branchcode
2308                   ORDER BY message_date DESC";
2309     my $sth = $dbh->prepare($query);
2310     $sth->execute( $borrowernumber, $type ) ;
2311     my @results;
2312
2313     while ( my $data = $sth->fetchrow_hashref ) {
2314         my $d = C4::Dates->new( $data->{message_date}, 'iso' );
2315         $data->{message_date_formatted} = $d->output;
2316         push @results, $data;
2317     }
2318     return \@results;
2319
2320 }
2321
2322 =head2 GetMessages
2323
2324   GetMessagesCount( $borrowernumber, $type );
2325
2326 $type is message type, B for borrower, or L for Librarian.
2327 Empty type returns all messages of any type.
2328
2329 Returns the number of messages for the given borrowernumber
2330
2331 =cut
2332
2333 sub GetMessagesCount {
2334     my ( $borrowernumber, $type, $branchcode ) = @_;
2335
2336     if ( ! $type ) {
2337       $type = '%';
2338     }
2339
2340     my $dbh  = C4::Context->dbh;
2341
2342     my $query = "SELECT COUNT(*) as MsgCount FROM messages WHERE borrowernumber = ? AND message_type LIKE ?";
2343     my $sth = $dbh->prepare($query);
2344     $sth->execute( $borrowernumber, $type ) ;
2345     my @results;
2346
2347     my $data = $sth->fetchrow_hashref;
2348     my $count = $data->{'MsgCount'};
2349
2350     return $count;
2351 }
2352
2353
2354
2355 =head2 DeleteMessage
2356
2357   DeleteMessage( $message_id );
2358
2359 =cut
2360
2361 sub DeleteMessage {
2362     my ( $message_id ) = @_;
2363
2364     my $dbh = C4::Context->dbh;
2365     my $query = "SELECT * FROM messages WHERE message_id = ?";
2366     my $sth = $dbh->prepare($query);
2367     $sth->execute( $message_id );
2368     my $message = $sth->fetchrow_hashref();
2369
2370     $query = "DELETE FROM messages WHERE message_id = ?";
2371     $sth = $dbh->prepare($query);
2372     $sth->execute( $message_id );
2373     logaction("MEMBERS", "DELCIRCMESSAGE", $message->{'borrowernumber'}, $message->{'message'}) if C4::Context->preference("BorrowersLog");
2374 }
2375
2376 =head2 IssueSlip
2377
2378   IssueSlip($branchcode, $borrowernumber, $quickslip)
2379
2380   Returns letter hash ( see C4::Letters::GetPreparedLetter )
2381
2382   $quickslip is boolean, to indicate whether we want a quick slip
2383
2384 =cut
2385
2386 sub IssueSlip {
2387     my ($branch, $borrowernumber, $quickslip) = @_;
2388
2389 #   return unless ( C4::Context->boolean_preference('printcirculationslips') );
2390
2391     my $now       = POSIX::strftime("%Y-%m-%d", localtime);
2392
2393     my $issueslist = GetPendingIssues($borrowernumber);
2394     foreach my $it (@$issueslist){
2395         if ((substr $it->{'issuedate'}, 0, 10) eq $now || (substr $it->{'lastreneweddate'}, 0, 10) eq $now) {
2396             $it->{'now'} = 1;
2397         }
2398         elsif ((substr $it->{'date_due'}, 0, 10) le $now) {
2399             $it->{'overdue'} = 1;
2400         }
2401         my $dt = dt_from_string( $it->{'date_due'} );
2402         $it->{'date_due'} = output_pref( $dt );;
2403     }
2404     my @issues = sort { $b->{'timestamp'} <=> $a->{'timestamp'} } @$issueslist;
2405
2406     my ($letter_code, %repeat);
2407     if ( $quickslip ) {
2408         $letter_code = 'ISSUEQSLIP';
2409         %repeat =  (
2410             'checkedout' => [ map {
2411                 'biblio' => $_,
2412                 'items'  => $_,
2413                 'issues' => $_,
2414             }, grep { $_->{'now'} } @issues ],
2415         );
2416     }
2417     else {
2418         $letter_code = 'ISSUESLIP';
2419         %repeat =  (
2420             'checkedout' => [ map {
2421                 'biblio' => $_,
2422                 'items'  => $_,
2423                 'issues' => $_,
2424             }, grep { !$_->{'overdue'} } @issues ],
2425
2426             'overdue' => [ map {
2427                 'biblio' => $_,
2428                 'items'  => $_,
2429                 'issues' => $_,
2430             }, grep { $_->{'overdue'} } @issues ],
2431
2432             'news' => [ map {
2433                 $_->{'timestamp'} = $_->{'newdate'};
2434                 { opac_news => $_ }
2435             } @{ GetNewsToDisplay("slip",$branch) } ],
2436         );
2437     }
2438
2439     return  C4::Letters::GetPreparedLetter (
2440         module => 'circulation',
2441         letter_code => $letter_code,
2442         branchcode => $branch,
2443         tables => {
2444             'branches'    => $branch,
2445             'borrowers'   => $borrowernumber,
2446         },
2447         repeat => \%repeat,
2448     );
2449 }
2450
2451 =head2 GetBorrowersWithEmail
2452
2453     ([$borrnum,$userid], ...) = GetBorrowersWithEmail('me@example.com');
2454
2455 This gets a list of users and their basic details from their email address.
2456 As it's possible for multiple user to have the same email address, it provides
2457 you with all of them. If there is no userid for the user, there will be an
2458 C<undef> there. An empty list will be returned if there are no matches.
2459
2460 =cut
2461
2462 sub GetBorrowersWithEmail {
2463     my $email = shift;
2464
2465     my $dbh = C4::Context->dbh;
2466
2467     my $query = "SELECT borrowernumber, userid FROM borrowers WHERE email=?";
2468     my $sth=$dbh->prepare($query);
2469     $sth->execute($email);
2470     my @result = ();
2471     while (my $ref = $sth->fetch) {
2472         push @result, $ref;
2473     }
2474     die "Failure searching for borrowers by email address: $sth->errstr" if $sth->err;
2475     return @result;
2476 }
2477
2478 sub AddMember_Opac {
2479     my ( %borrower ) = @_;
2480
2481     $borrower{'categorycode'} = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
2482
2483     my $sr = new String::Random;
2484     $sr->{'A'} = [ 'A'..'Z', 'a'..'z' ];
2485     my $password = $sr->randpattern("AAAAAAAAAA");
2486     $borrower{'password'} = $password;
2487
2488     $borrower{'cardnumber'} = fixup_cardnumber();
2489
2490     my $borrowernumber = AddMember(%borrower);
2491
2492     return ( $borrowernumber, $password );
2493 }
2494
2495 =head2 AddEnrolmentFeeIfNeeded
2496
2497     AddEnrolmentFeeIfNeeded( $borrower->{categorycode}, $borrower->{borrowernumber} );
2498
2499 Add enrolment fee for a patron if needed.
2500
2501 =cut
2502
2503 sub AddEnrolmentFeeIfNeeded {
2504     my ( $categorycode, $borrowernumber ) = @_;
2505     # check for enrollment fee & add it if needed
2506     my $dbh = C4::Context->dbh;
2507     my $sth = $dbh->prepare(q{
2508         SELECT enrolmentfee
2509         FROM categories
2510         WHERE categorycode=?
2511     });
2512     $sth->execute( $categorycode );
2513     if ( $sth->err ) {
2514         warn sprintf('Database returned the following error: %s', $sth->errstr);
2515         return;
2516     }
2517     my ($enrolmentfee) = $sth->fetchrow;
2518     if ($enrolmentfee && $enrolmentfee > 0) {
2519         # insert fee in patron debts
2520         C4::Accounts::manualinvoice( $borrowernumber, '', '', 'A', $enrolmentfee );
2521     }
2522 }
2523
2524 sub HasOverdues {
2525     my ( $borrowernumber ) = @_;
2526
2527     my $sql = "SELECT COUNT(*) FROM issues WHERE date_due < NOW() AND borrowernumber = ?";
2528     my $sth = C4::Context->dbh->prepare( $sql );
2529     $sth->execute( $borrowernumber );
2530     my ( $count ) = $sth->fetchrow_array();
2531
2532     return $count;
2533 }
2534
2535 END { }    # module clean-up code here (global destructor)
2536
2537 1;
2538
2539 __END__
2540
2541 =head1 AUTHOR
2542
2543 Koha Team
2544
2545 =cut