C4/Members.pm

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