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