C4/Members.pm

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