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