C4/Members.pm

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