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("IndependentBranches") ) { # && !$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
 699 =head2 columns
 700
 701   my @columns = C4::Member::columns();
 702
 703 Returns an array of borrowers' table columns on success,
 704 and an empty array on failure.
 705
 706 =cut
 707
 708 sub columns {
 709
 710     # Pure ANSI SQL goodness.
 711     my $sql = 'SELECT * FROM borrowers WHERE 1=0;';
 712
 713     # Get the database handle.
 714     my $dbh = C4::Context->dbh;
 715
 716     # Run the SQL statement to load STH's readonly properties.
 717     my $sth = $dbh->prepare($sql);
 718     my $rv = $sth->execute();
 719
 720     # This only fails if the table doesn't exist.
 721     # This will always be called AFTER an install or upgrade,
 722     # so borrowers will exist!
 723     my @data;
 724     if ($sth->{NUM_OF_FIELDS}>0) {
 725         @data = @{$sth->{NAME}};
 726     }
 727     else {
 728         @data = ();
 729     }
 730     return @data;
 731 }
 732
 733
 734 =head2 ModMember
 735
 736   my $success = ModMember(borrowernumber => $borrowernumber,
 737                                             [ field => value ]... );
 738
 739 Modify borrower's data.  All date fields should ALREADY be in ISO format.
 740
 741 return :
 742 true on success, or false on failure
 743
 744 =cut
 745
 746 sub ModMember {
 747     my (%data) = @_;
 748     # test to know if you must update or not the borrower password
 749     if (exists $data{password}) {
 750         if ($data{password} eq '****' or $data{password} eq '') {
 751             delete $data{password};
 752         } else {
 753             $data{password} = md5_base64($data{password});
 754         }
 755     }
 756         my $execute_success=UpdateInTable("borrowers",\%data);
 757     if ($execute_success) { # only proceed if the update was a success
 758         # ok if its an adult (type) it may have borrowers that depend on it as a guarantor
 759         # so when we update information for an adult we should check for guarantees and update the relevant part
 760         # of their records, ie addresses and phone numbers
 761         my $borrowercategory= GetBorrowercategory( $data{'category_type'} );
 762         if ( exists  $borrowercategory->{'category_type'} && $borrowercategory->{'category_type'} eq ('A' || 'S') ) {
 763             # is adult check guarantees;
 764             UpdateGuarantees(%data);
 765         }
 766         logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "UPDATE (executed w/ arg: $data{'borrowernumber'})") if C4::Context->preference("BorrowersLog");
 767     }
 768     return $execute_success;
 769 }
 770
 771
 772 =head2 AddMember
 773
 774   $borrowernumber = &AddMember(%borrower);
 775
 776 insert new borrower into table
 777 Returns the borrowernumber upon success
 778
 779 Returns as undef upon any db error without further processing
 780
 781 =cut
 782
 783 #'
 784 sub AddMember {
 785     my (%data) = @_;
 786     my $dbh = C4::Context->dbh;
 787
 788     # generate a proper login if none provided
 789     $data{'userid'} = Generate_Userid($data{'borrowernumber'}, $data{'firstname'}, $data{'surname'}) if $data{'userid'} eq '';
 790
 791     # add expiration date if it isn't already there
 792     unless ( $data{'dateexpiry'} ) {
 793         $data{'dateexpiry'} = GetExpiryDate( $data{'categorycode'}, C4::Dates->new()->output("iso") );
 794     }
 795
 796     # add enrollment date if it isn't already there
 797     unless ( $data{'dateenrolled'} ) {
 798         $data{'dateenrolled'} = C4::Dates->new()->output("iso");
 799     }
 800
 801     # create a disabled account if no password provided
 802     $data{'password'} = ($data{'password'})? md5_base64($data{'password'}) : '!';
 803     $data{'borrowernumber'}=InsertInTable("borrowers",\%data);
 804
 805
 806     # mysql_insertid is probably bad.  not necessarily accurate and mysql-specific at best.
 807     logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
 808
 809     # check for enrollment fee & add it if needed
 810     my $sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
 811     $sth->execute($data{'categorycode'});
 812     my ($enrolmentfee) = $sth->fetchrow;
 813     if ($sth->err) {
 814         warn sprintf('Database returned the following error: %s', $sth->errstr);
 815         return;
 816     }
 817     if ($enrolmentfee && $enrolmentfee > 0) {
 818         # insert fee in patron debts
 819         manualinvoice($data{'borrowernumber'}, '', '', 'A', $enrolmentfee);
 820     }
 821
 822     return $data{'borrowernumber'};
 823 }
 824
 825 =head2 Check_Userid
 826
 827     my $uniqueness = Check_Userid($userid,$borrowernumber);
 828
 829     $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 != '').
 830
 831     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.
 832
 833     return :
 834         0 for not unique (i.e. this $userid already exists)
 835         1 for unique (i.e. this $userid does not exist, or this $userid/$borrowernumber combination already exists)
 836
 837 =cut
 838
 839 sub Check_Userid {
 840     my ($uid,$member) = @_;
 841     my $dbh = C4::Context->dbh;
 842     my $sth =
 843       $dbh->prepare(
 844         "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
 845     $sth->execute( $uid, $member );
 846     if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
 847         return 0;
 848     }
 849     else {
 850         return 1;
 851     }
 852 }
 853
 854 =head2 Generate_Userid
 855
 856     my $newuid = Generate_Userid($borrowernumber, $firstname, $surname);
 857
 858     Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
 859
 860     $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.
 861
 862     return :
 863         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).
 864
 865 =cut
 866
 867 sub Generate_Userid {
 868   my ($borrowernumber, $firstname, $surname) = @_;
 869   my $newuid;
 870   my $offset = 0;
 871   #The script will "do" the following code and increment the $offset until Check_Userid = 1 (i.e. until $newuid comes back as unique)
 872   do {
 873     $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
 874     $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
 875     $newuid = lc(($firstname)? "$firstname.$surname" : $surname);
 876     $newuid = unac_string('utf-8',$newuid);
 877     $newuid .= $offset unless $offset == 0;
 878     $offset++;
 879
 880    } while (!Check_Userid($newuid,$borrowernumber));
 881
 882    return $newuid;
 883 }
 884
 885 sub changepassword {
 886     my ( $uid, $member, $digest ) = @_;
 887     my $dbh = C4::Context->dbh;
 888
 889 #Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
 890 #Then we need to tell the user and have them create a new one.
 891     my $resultcode;
 892     my $sth =
 893       $dbh->prepare(
 894         "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
 895     $sth->execute( $uid, $member );
 896     if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
 897         $resultcode=0;
 898     }
 899     else {
 900         #Everything is good so we can update the information.
 901         $sth =
 902           $dbh->prepare(
 903             "update borrowers set userid=?, password=? where borrowernumber=?");
 904         $sth->execute( $uid, $digest, $member );
 905         $resultcode=1;
 906     }
 907
 908     logaction("MEMBERS", "CHANGE PASS", $member, "") if C4::Context->preference("BorrowersLog");
 909     return $resultcode;
 910 }
 911
 912
 913
 914 =head2 fixup_cardnumber
 915
 916 Warning: The caller is responsible for locking the members table in write
 917 mode, to avoid database corruption.
 918
 919 =cut
 920
 921 use vars qw( @weightings );
 922 my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
 923
 924 sub fixup_cardnumber {
 925     my ($cardnumber) = @_;
 926     my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;
 927
 928     # Find out whether member numbers should be generated
 929     # automatically. Should be either "1" or something else.
 930     # Defaults to "0", which is interpreted as "no".
 931
 932     #     if ($cardnumber !~ /\S/ && $autonumber_members) {
 933     ($autonumber_members) or return $cardnumber;
 934     my $checkdigit = C4::Context->preference('checkdigit');
 935     my $dbh = C4::Context->dbh;
 936     if ( $checkdigit and $checkdigit eq 'katipo' ) {
 937
 938         # if checkdigit is selected, calculate katipo-style cardnumber.
 939         # otherwise, just use the max()
 940         # purpose: generate checksum'd member numbers.
 941         # We'll assume we just got the max value of digits 2-8 of member #'s
 942         # from the database and our job is to increment that by one,
 943         # determine the 1st and 9th digits and return the full string.
 944         my $sth = $dbh->prepare(
 945             "select max(substring(borrowers.cardnumber,2,7)) as new_num from borrowers"
 946         );
 947         $sth->execute;
 948         my $data = $sth->fetchrow_hashref;
 949         $cardnumber = $data->{new_num};
 950         if ( !$cardnumber ) {    # If DB has no values,
 951             $cardnumber = 1000000;    # start at 1000000
 952         } else {
 953             $cardnumber += 1;
 954         }
 955
 956         my $sum = 0;
 957         for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
 958             # read weightings, left to right, 1 char at a time
 959             my $temp1 = $weightings[$i];
 960
 961             # sequence left to right, 1 char at a time
 962             my $temp2 = substr( $cardnumber, $i, 1 );
 963
 964             # mult each char 1-7 by its corresponding weighting
 965             $sum += $temp1 * $temp2;
 966         }
 967
 968         my $rem = ( $sum % 11 );
 969         $rem = 'X' if $rem == 10;
 970
 971         return "V$cardnumber$rem";
 972      } else {
 973
 974         my $sth = $dbh->prepare(
 975             'SELECT MAX( CAST( cardnumber AS SIGNED ) ) FROM borrowers WHERE cardnumber REGEXP "^-?[0-9]+$"'
 976         );
 977         $sth->execute;
 978         my ($result) = $sth->fetchrow;
 979         return $result + 1;
 980     }
 981     return $cardnumber;     # just here as a fallback/reminder
 982 }
 983
 984 =head2 GetGuarantees
 985
 986   ($num_children, $children_arrayref) = &GetGuarantees($parent_borrno);
 987   $child0_cardno = $children_arrayref->[0]{"cardnumber"};
 988   $child0_borrno = $children_arrayref->[0]{"borrowernumber"};
 989
 990 C<&GetGuarantees> takes a borrower number (e.g., that of a patron
 991 with children) and looks up the borrowers who are guaranteed by that
 992 borrower (i.e., the patron's children).
 993
 994 C<&GetGuarantees> returns two values: an integer giving the number of
 995 borrowers guaranteed by C<$parent_borrno>, and a reference to an array
 996 of references to hash, which gives the actual results.
 997
 998 =cut
 999
1000 #'
1001 sub GetGuarantees {
1002     my ($borrowernumber) = @_;
1003     my $dbh              = C4::Context->dbh;
1004     my $sth              =
1005       $dbh->prepare(
1006 "select cardnumber,borrowernumber, firstname, surname from borrowers where guarantorid=?"
1007       );
1008     $sth->execute($borrowernumber);
1009
1010     my @dat;
1011     my $data = $sth->fetchall_arrayref({});
1012     return ( scalar(@$data), $data );
1013 }
1014
1015 =head2 UpdateGuarantees
1016
1017   &UpdateGuarantees($parent_borrno);
1018
1019
1020 C<&UpdateGuarantees> borrower data for an adult and updates all the guarantees
1021 with the modified information
1022
1023 =cut
1024
1025 #'
1026 sub UpdateGuarantees {
1027     my %data = shift;
1028     my $dbh = C4::Context->dbh;
1029     my ( $count, $guarantees ) = GetGuarantees( $data{'borrowernumber'} );
1030     foreach my $guarantee (@$guarantees){
1031         my $guaquery = qq|UPDATE borrowers
1032               SET address=?,fax=?,B_city=?,mobile=?,city=?,phone=?
1033               WHERE borrowernumber=?
1034         |;
1035         my $sth = $dbh->prepare($guaquery);
1036         $sth->execute($data{'address'},$data{'fax'},$data{'B_city'},$data{'mobile'},$data{'city'},$data{'phone'},$guarantee->{'borrowernumber'});
1037     }
1038 }
1039 =head2 GetPendingIssues
1040
1041   my $issues = &GetPendingIssues(@borrowernumber);
1042
1043 Looks up what the patron with the given borrowernumber has borrowed.
1044
1045 C<&GetPendingIssues> returns a
1046 reference-to-array where each element is a reference-to-hash; the
1047 keys are the fields from the C<issues>, C<biblio>, and C<items> tables.
1048 The keys include C<biblioitems> fields except marc and marcxml.
1049
1050 =cut
1051
1052 #'
1053 sub GetPendingIssues {
1054     my @borrowernumbers = @_;
1055
1056     unless (@borrowernumbers ) { # return a ref_to_array
1057         return \@borrowernumbers; # to not cause surprise to caller
1058     }
1059
1060     # Borrowers part of the query
1061     my $bquery = '';
1062     for (my $i = 0; $i < @borrowernumbers; $i++) {
1063         $bquery .= ' issues.borrowernumber = ?';
1064         if ($i < $#borrowernumbers ) {
1065             $bquery .= ' OR';
1066         }
1067     }
1068
1069     # must avoid biblioitems.* to prevent large marc and marcxml fields from killing performance
1070     # FIXME: namespace collision: each table has "timestamp" fields.  Which one is "timestamp" ?
1071     # FIXME: circ/ciculation.pl tries to sort by timestamp!
1072     # FIXME: namespace collision: other collisions possible.
1073     # FIXME: most of this data isn't really being used by callers.
1074     my $query =
1075    "SELECT issues.*,
1076             items.*,
1077            biblio.*,
1078            biblioitems.volume,
1079            biblioitems.number,
1080            biblioitems.itemtype,
1081            biblioitems.isbn,
1082            biblioitems.issn,
1083            biblioitems.publicationyear,
1084            biblioitems.publishercode,
1085            biblioitems.volumedate,
1086            biblioitems.volumedesc,
1087            biblioitems.lccn,
1088            biblioitems.url,
1089            borrowers.firstname,
1090            borrowers.surname,
1091            borrowers.cardnumber,
1092            issues.timestamp AS timestamp,
1093            issues.renewals  AS renewals,
1094            issues.borrowernumber AS borrowernumber,
1095             items.renewals  AS totalrenewals
1096     FROM   issues
1097     LEFT JOIN items       ON items.itemnumber       =      issues.itemnumber
1098     LEFT JOIN biblio      ON items.biblionumber     =      biblio.biblionumber
1099     LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
1100     LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
1101     WHERE
1102       $bquery
1103     ORDER BY issues.issuedate"
1104     ;
1105
1106     my $sth = C4::Context->dbh->prepare($query);
1107     $sth->execute(@borrowernumbers);
1108     my $data = $sth->fetchall_arrayref({});
1109     my $tz = C4::Context->tz();
1110     my $today = DateTime->now( time_zone => $tz);
1111     foreach (@{$data}) {
1112         if ($_->{issuedate}) {
1113             $_->{issuedate} = dt_from_string($_->{issuedate}, 'sql');
1114         }
1115         $_->{date_due} or next;
1116         $_->{date_due} = DateTime::Format::DateParse->parse_datetime($_->{date_due}, $tz->name());
1117         if ( DateTime->compare($_->{date_due}, $today) == -1 ) {
1118             $_->{overdue} = 1;
1119         }
1120     }
1121     return $data;
1122 }
1123
1124 =head2 GetAllIssues
1125
1126   $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
1127
1128 Looks up what the patron with the given borrowernumber has borrowed,
1129 and sorts the results.
1130
1131 C<$sortkey> is the name of a field on which to sort the results. This
1132 should be the name of a field in the C<issues>, C<biblio>,
1133 C<biblioitems>, or C<items> table in the Koha database.
1134
1135 C<$limit> is the maximum number of results to return.
1136
1137 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
1138 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
1139 C<items> tables of the Koha database.
1140
1141 =cut
1142
1143 #'
1144 sub GetAllIssues {
1145     my ( $borrowernumber, $order, $limit ) = @_;
1146
1147     my $dbh = C4::Context->dbh;
1148     my $query =
1149 'SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1150   FROM issues
1151   LEFT JOIN items on items.itemnumber=issues.itemnumber
1152   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1153   LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1154   WHERE borrowernumber=?
1155   UNION ALL
1156   SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1157   FROM old_issues
1158   LEFT JOIN items on items.itemnumber=old_issues.itemnumber
1159   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1160   LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1161   WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL
1162   order by ' . $order;
1163     if ($limit) {
1164         $query .= " limit $limit";
1165     }
1166
1167     my $sth = $dbh->prepare($query);
1168     $sth->execute( $borrowernumber, $borrowernumber );
1169     return $sth->fetchall_arrayref( {} );
1170 }
1171
1172
1173 =head2 GetMemberAccountRecords
1174
1175   ($total, $acctlines, $count) = &GetMemberAccountRecords($borrowernumber);
1176
1177 Looks up accounting data for the patron with the given borrowernumber.
1178
1179 C<&GetMemberAccountRecords> returns a three-element array. C<$acctlines> is a
1180 reference-to-array, where each element is a reference-to-hash; the
1181 keys are the fields of the C<accountlines> table in the Koha database.
1182 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1183 total amount outstanding for all of the account lines.
1184
1185 =cut
1186
1187 sub GetMemberAccountRecords {
1188     my ($borrowernumber) = @_;
1189     my $dbh = C4::Context->dbh;
1190     my @acctlines;
1191     my $numlines = 0;
1192     my $strsth      = qq(
1193                         SELECT *
1194                         FROM accountlines
1195                         WHERE borrowernumber=?);
1196     $strsth.=" ORDER BY date desc,timestamp DESC";
1197     my $sth= $dbh->prepare( $strsth );
1198     $sth->execute( $borrowernumber );
1199
1200     my $total = 0;
1201     while ( my $data = $sth->fetchrow_hashref ) {
1202         if ( $data->{itemnumber} ) {
1203             my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
1204             $data->{biblionumber} = $biblio->{biblionumber};
1205             $data->{title}        = $biblio->{title};
1206         }
1207         $acctlines[$numlines] = $data;
1208         $numlines++;
1209         $total += int(1000 * $data->{'amountoutstanding'}); # convert float to integer to avoid round-off errors
1210     }
1211     $total /= 1000;
1212     return ( $total, \@acctlines,$numlines);
1213 }
1214
1215 =head2 GetMemberAccountBalance
1216
1217   ($total_balance, $non_issue_balance, $other_charges) = &GetMemberAccountBalance($borrowernumber);
1218
1219 Calculates amount immediately owing by the patron - non-issue charges.
1220 Based on GetMemberAccountRecords.
1221 Charges exempt from non-issue are:
1222 * Res (reserves)
1223 * Rent (rental) if RentalsInNoissuesCharge syspref is set to false
1224 * Manual invoices if ManInvInNoissuesCharge syspref is set to false
1225
1226 =cut
1227
1228 sub GetMemberAccountBalance {
1229     my ($borrowernumber) = @_;
1230
1231     my $ACCOUNT_TYPE_LENGTH = 5; # this is plain ridiculous...
1232
1233     my @not_fines = ('Res');
1234     push @not_fines, 'Rent' unless C4::Context->preference('RentalsInNoissuesCharge');
1235     unless ( C4::Context->preference('ManInvInNoissuesCharge') ) {
1236         my $dbh = C4::Context->dbh;
1237         my $man_inv_types = $dbh->selectcol_arrayref(qq{SELECT authorised_value FROM authorised_values WHERE category = 'MANUAL_INV'});
1238         push @not_fines, map substr($_, 0, $ACCOUNT_TYPE_LENGTH), @$man_inv_types;
1239     }
1240     my %not_fine = map {$_ => 1} @not_fines;
1241
1242     my ($total, $acctlines) = GetMemberAccountRecords($borrowernumber);
1243     my $other_charges = 0;
1244     foreach (@$acctlines) {
1245         $other_charges += $_->{amountoutstanding} if $not_fine{ substr($_->{accounttype}, 0, $ACCOUNT_TYPE_LENGTH) };
1246     }
1247
1248     return ( $total, $total - $other_charges, $other_charges);
1249 }
1250
1251 =head2 GetBorNotifyAcctRecord
1252
1253   ($total, $acctlines, $count) = &GetBorNotifyAcctRecord($params,$notifyid);
1254
1255 Looks up accounting data for the patron with the given borrowernumber per file number.
1256
1257 C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a
1258 reference-to-array, where each element is a reference-to-hash; the
1259 keys are the fields of the C<accountlines> table in the Koha database.
1260 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1261 total amount outstanding for all of the account lines.
1262
1263 =cut
1264
1265 sub GetBorNotifyAcctRecord {
1266     my ( $borrowernumber, $notifyid ) = @_;
1267     my $dbh = C4::Context->dbh;
1268     my @acctlines;
1269     my $numlines = 0;
1270     my $sth = $dbh->prepare(
1271             "SELECT *
1272                 FROM accountlines
1273                 WHERE borrowernumber=?
1274                     AND notify_id=?
1275                     AND amountoutstanding != '0'
1276                 ORDER BY notify_id,accounttype
1277                 ");
1278
1279     $sth->execute( $borrowernumber, $notifyid );
1280     my $total = 0;
1281     while ( my $data = $sth->fetchrow_hashref ) {
1282         if ( $data->{itemnumber} ) {
1283             my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
1284             $data->{biblionumber} = $biblio->{biblionumber};
1285             $data->{title}        = $biblio->{title};
1286         }
1287         $acctlines[$numlines] = $data;
1288         $numlines++;
1289         $total += int(100 * $data->{'amountoutstanding'});
1290     }
1291     $total /= 100;
1292     return ( $total, \@acctlines, $numlines );
1293 }
1294
1295 =head2 checkuniquemember (OUEST-PROVENCE)
1296
1297   ($result,$categorycode)  = &checkuniquemember($collectivity,$surname,$firstname,$dateofbirth);
1298
1299 Checks that a member exists or not in the database.
1300
1301 C<&result> is nonzero (=exist) or 0 (=does not exist)
1302 C<&categorycode> is from categorycode table
1303 C<&collectivity> is 1 (= we add a collectivity) or 0 (= we add a physical member)
1304 C<&surname> is the surname
1305 C<&firstname> is the firstname (only if collectivity=0)
1306 C<&dateofbirth> is the date of birth in ISO format (only if collectivity=0)
1307
1308 =cut
1309
1310 # FIXME: This function is not legitimate.  Multiple patrons might have the same first/last name and birthdate.
1311 # This is especially true since first name is not even a required field.
1312
1313 sub checkuniquemember {
1314     my ( $collectivity, $surname, $firstname, $dateofbirth ) = @_;
1315     my $dbh = C4::Context->dbh;
1316     my $request = ($collectivity) ?
1317         "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? " :
1318             ($dateofbirth) ?
1319             "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=?  and dateofbirth=?" :
1320             "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=?";
1321     my $sth = $dbh->prepare($request);
1322     if ($collectivity) {
1323         $sth->execute( uc($surname) );
1324     } elsif($dateofbirth){
1325         $sth->execute( uc($surname), ucfirst($firstname), $dateofbirth );
1326     }else{
1327         $sth->execute( uc($surname), ucfirst($firstname));
1328     }
1329     my @data = $sth->fetchrow;
1330     ( $data[0] ) and return $data[0], $data[1];
1331     return 0;
1332 }
1333
1334 sub checkcardnumber {
1335     my ($cardnumber,$borrowernumber) = @_;
1336     # If cardnumber is null, we assume they're allowed.
1337     return 0 if !defined($cardnumber);
1338     my $dbh = C4::Context->dbh;
1339     my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
1340     $query .= " AND borrowernumber <> ?" if ($borrowernumber);
1341   my $sth = $dbh->prepare($query);
1342   if ($borrowernumber) {
1343    $sth->execute($cardnumber,$borrowernumber);
1344   } else {
1345      $sth->execute($cardnumber);
1346   }
1347     if (my $data= $sth->fetchrow_hashref()){
1348         return 1;
1349     }
1350     else {
1351         return 0;
1352     }
1353 }
1354
1355
1356 =head2 getzipnamecity (OUEST-PROVENCE)
1357
1358 take all info from table city for the fields city and  zip
1359 check for the name and the zip code of the city selected
1360
1361 =cut
1362
1363 sub getzipnamecity {
1364     my ($cityid) = @_;
1365     my $dbh      = C4::Context->dbh;
1366     my $sth      =
1367       $dbh->prepare(
1368         "select city_name,city_state,city_zipcode,city_country from cities where cityid=? ");
1369     $sth->execute($cityid);
1370     my @data = $sth->fetchrow;
1371     return $data[0], $data[1], $data[2], $data[3];
1372 }
1373
1374
1375 =head2 getdcity (OUEST-PROVENCE)
1376
1377 recover cityid  with city_name condition
1378
1379 =cut
1380
1381 sub getidcity {
1382     my ($city_name) = @_;
1383     my $dbh = C4::Context->dbh;
1384     my $sth = $dbh->prepare("select cityid from cities where city_name=? ");
1385     $sth->execute($city_name);
1386     my $data = $sth->fetchrow;
1387     return $data;
1388 }
1389
1390 =head2 GetFirstValidEmailAddress
1391
1392   $email = GetFirstValidEmailAddress($borrowernumber);
1393
1394 Return the first valid email address for a borrower, given the borrowernumber.  For now, the order
1395 is defined as email, emailpro, B_email.  Returns the empty string if the borrower has no email
1396 addresses.
1397
1398 =cut
1399
1400 sub GetFirstValidEmailAddress {
1401     my $borrowernumber = shift;
1402     my $dbh = C4::Context->dbh;
1403     my $sth = $dbh->prepare( "SELECT email, emailpro, B_email FROM borrowers where borrowernumber = ? ");
1404     $sth->execute( $borrowernumber );
1405     my $data = $sth->fetchrow_hashref;
1406
1407     if ($data->{'email'}) {
1408        return $data->{'email'};
1409     } elsif ($data->{'emailpro'}) {
1410        return $data->{'emailpro'};
1411     } elsif ($data->{'B_email'}) {
1412        return $data->{'B_email'};
1413     } else {
1414        return '';
1415     }
1416 }
1417
1418 =head2 GetNoticeEmailAddress
1419
1420   $email = GetNoticeEmailAddress($borrowernumber);
1421
1422 Return the email address of borrower used for notices, given the borrowernumber.
1423 Returns the empty string if no email address.
1424
1425 =cut
1426
1427 sub GetNoticeEmailAddress {
1428     my $borrowernumber = shift;
1429
1430     my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
1431     # if syspref is set to 'first valid' (value == OFF), look up email address
1432     if ( $which_address eq 'OFF' ) {
1433         return GetFirstValidEmailAddress($borrowernumber);
1434     }
1435     # specified email address field
1436     my $dbh = C4::Context->dbh;
1437     my $sth = $dbh->prepare( qq{
1438         SELECT $which_address AS primaryemail
1439         FROM borrowers
1440         WHERE borrowernumber=?
1441     } );
1442     $sth->execute($borrowernumber);
1443     my $data = $sth->fetchrow_hashref;
1444     return $data->{'primaryemail'} || '';
1445 }
1446
1447 =head2 GetExpiryDate
1448
1449   $expirydate = GetExpiryDate($categorycode, $dateenrolled);
1450
1451 Calculate expiry date given a categorycode and starting date.  Date argument must be in ISO format.
1452 Return date is also in ISO format.
1453
1454 =cut
1455
1456 sub GetExpiryDate {
1457     my ( $categorycode, $dateenrolled ) = @_;
1458     my $enrolments;
1459     if ($categorycode) {
1460         my $dbh = C4::Context->dbh;
1461         my $sth = $dbh->prepare("SELECT enrolmentperiod,enrolmentperioddate FROM categories WHERE categorycode=?");
1462         $sth->execute($categorycode);
1463         $enrolments = $sth->fetchrow_hashref;
1464     }
1465     # die "GetExpiryDate: for enrollmentperiod $enrolmentperiod (category '$categorycode') starting $dateenrolled.\n";
1466     my @date = split (/-/,$dateenrolled);
1467     if($enrolments->{enrolmentperiod}){
1468         return sprintf("%04d-%02d-%02d", Add_Delta_YM(@date,0,$enrolments->{enrolmentperiod}));
1469     }else{
1470         return $enrolments->{enrolmentperioddate};
1471     }
1472 }
1473
1474 =head2 checkuserpassword (OUEST-PROVENCE)
1475
1476 check for the password and login are not used
1477 return the number of record
1478 0=> NOT USED 1=> USED
1479
1480 =cut
1481
1482 sub checkuserpassword {
1483     my ( $borrowernumber, $userid, $password ) = @_;
1484     $password = md5_base64($password);
1485     my $dbh = C4::Context->dbh;
1486     my $sth =
1487       $dbh->prepare(
1488 "Select count(*) from borrowers where borrowernumber !=? and userid =? and password=? "
1489       );
1490     $sth->execute( $borrowernumber, $userid, $password );
1491     my $number_rows = $sth->fetchrow;
1492     return $number_rows;
1493
1494 }
1495
1496 =head2 GetborCatFromCatType
1497
1498   ($codes_arrayref, $labels_hashref) = &GetborCatFromCatType();
1499
1500 Looks up the different types of borrowers in the database. Returns two
1501 elements: a reference-to-array, which lists the borrower category
1502 codes, and a reference-to-hash, which maps the borrower category codes
1503 to category descriptions.
1504
1505 =cut
1506
1507 #'
1508 sub GetborCatFromCatType {
1509     my ( $category_type, $action, $no_branch_limit ) = @_;
1510
1511     my $branch_limit = $no_branch_limit
1512         ? 0
1513         : C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1514
1515     # FIXME - This API  seems both limited and dangerous.
1516     my $dbh     = C4::Context->dbh;
1517
1518     my $request = qq{
1519         SELECT categories.categorycode, categories.description
1520         FROM categories
1521     };
1522     $request .= qq{
1523         LEFT JOIN categories_branches ON categories.categorycode = categories_branches.categorycode
1524     } if $branch_limit;
1525     if($action) {
1526         $request .= " $action ";
1527         $request .= " AND (branchcode = ? OR branchcode IS NULL) GROUP BY description" if $branch_limit;
1528     } else {
1529         $request .= " WHERE branchcode = ? OR branchcode IS NULL GROUP BY description" if $branch_limit;
1530     }
1531     $request .= " ORDER BY categorycode";
1532
1533     my $sth = $dbh->prepare($request);
1534     $sth->execute(
1535         $action ? $category_type : (),
1536         $branch_limit ? $branch_limit : ()
1537     );
1538
1539     my %labels;
1540     my @codes;
1541
1542     while ( my $data = $sth->fetchrow_hashref ) {
1543         push @codes, $data->{'categorycode'};
1544         $labels{ $data->{'categorycode'} } = $data->{'description'};
1545     }
1546     $sth->finish;
1547     return ( \@codes, \%labels );
1548 }
1549
1550 =head2 GetBorrowercategory
1551
1552   $hashref = &GetBorrowercategory($categorycode);
1553
1554 Given the borrower's category code, the function returns the corresponding
1555 data hashref for a comprehensive information display.
1556
1557 =cut
1558
1559 sub GetBorrowercategory {
1560     my ($catcode) = @_;
1561     my $dbh       = C4::Context->dbh;
1562     if ($catcode){
1563         my $sth       =
1564         $dbh->prepare(
1565     "SELECT description,dateofbirthrequired,upperagelimit,category_type
1566     FROM categories
1567     WHERE categorycode = ?"
1568         );
1569         $sth->execute($catcode);
1570         my $data =
1571         $sth->fetchrow_hashref;
1572         return $data;
1573     }
1574     return;
1575 }    # sub getborrowercategory
1576
1577
1578 =head2 GetBorrowerCategorycode
1579
1580     $categorycode = &GetBorrowerCategoryCode( $borrowernumber );
1581
1582 Given the borrowernumber, the function returns the corresponding categorycode
1583 =cut
1584
1585 sub GetBorrowerCategorycode {
1586     my ( $borrowernumber ) = @_;
1587     my $dbh = C4::Context->dbh;
1588     my $sth = $dbh->prepare( qq{
1589         SELECT categorycode
1590         FROM borrowers
1591         WHERE borrowernumber = ?
1592     } );
1593     $sth->execute( $borrowernumber );
1594     return $sth->fetchrow;
1595 }
1596
1597 =head2 GetBorrowercategoryList
1598
1599   $arrayref_hashref = &GetBorrowercategoryList;
1600 If no category code provided, the function returns all the categories.
1601
1602 =cut
1603
1604 sub GetBorrowercategoryList {
1605     my $no_branch_limit = @_ ? shift : 0;
1606     my $branch_limit = $no_branch_limit
1607         ? 0
1608         : C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1609     my $dbh       = C4::Context->dbh;
1610     my $query = "SELECT categories.* FROM categories";
1611     $query .= qq{
1612         LEFT JOIN categories_branches ON categories.categorycode = categories_branches.categorycode
1613         WHERE branchcode = ? OR branchcode IS NULL GROUP BY description
1614     } if $branch_limit;
1615     $query .= " ORDER BY description";
1616     my $sth = $dbh->prepare( $query );
1617     $sth->execute( $branch_limit ? $branch_limit : () );
1618     my $data = $sth->fetchall_arrayref( {} );
1619     $sth->finish;
1620     return $data;
1621 }    # sub getborrowercategory
1622
1623 =head2 ethnicitycategories
1624
1625   ($codes_arrayref, $labels_hashref) = &ethnicitycategories();
1626
1627 Looks up the different ethnic types in the database. Returns two
1628 elements: a reference-to-array, which lists the ethnicity codes, and a
1629 reference-to-hash, which maps the ethnicity codes to ethnicity
1630 descriptions.
1631
1632 =cut
1633
1634 #'
1635
1636 sub ethnicitycategories {
1637     my $dbh = C4::Context->dbh;
1638     my $sth = $dbh->prepare("Select code,name from ethnicity order by name");
1639     $sth->execute;
1640     my %labels;
1641     my @codes;
1642     while ( my $data = $sth->fetchrow_hashref ) {
1643         push @codes, $data->{'code'};
1644         $labels{ $data->{'code'} } = $data->{'name'};
1645     }
1646     return ( \@codes, \%labels );
1647 }
1648
1649 =head2 fixEthnicity
1650
1651   $ethn_name = &fixEthnicity($ethn_code);
1652
1653 Takes an ethnicity code (e.g., "european" or "pi") and returns the
1654 corresponding descriptive name from the C<ethnicity> table in the
1655 Koha database ("European" or "Pacific Islander").
1656
1657 =cut
1658
1659 #'
1660
1661 sub fixEthnicity {
1662     my $ethnicity = shift;
1663     return unless $ethnicity;
1664     my $dbh       = C4::Context->dbh;
1665     my $sth       = $dbh->prepare("Select name from ethnicity where code = ?");
1666     $sth->execute($ethnicity);
1667     my $data = $sth->fetchrow_hashref;
1668     return $data->{'name'};
1669 }    # sub fixEthnicity
1670
1671 =head2 GetAge
1672
1673   $dateofbirth,$date = &GetAge($date);
1674
1675 this function return the borrowers age with the value of dateofbirth
1676
1677 =cut
1678
1679 #'
1680 sub GetAge{
1681     my ( $date, $date_ref ) = @_;
1682
1683     if ( not defined $date_ref ) {
1684         $date_ref = sprintf( '%04d-%02d-%02d', Today() );
1685     }
1686
1687     my ( $year1, $month1, $day1 ) = split /-/, $date;
1688     my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
1689
1690     my $age = $year2 - $year1;
1691     if ( $month1 . $day1 > $month2 . $day2 ) {
1692         $age--;
1693     }
1694
1695     return $age;
1696 }    # sub get_age
1697
1698 =head2 get_institutions
1699
1700   $insitutions = get_institutions();
1701
1702 Just returns a list of all the borrowers of type I, borrownumber and name
1703
1704 =cut
1705
1706 #'
1707 sub get_institutions {
1708     my $dbh = C4::Context->dbh();
1709     my $sth =
1710       $dbh->prepare(
1711 "SELECT borrowernumber,surname FROM borrowers WHERE categorycode=? ORDER BY surname"
1712       );
1713     $sth->execute('I');
1714     my %orgs;
1715     while ( my $data = $sth->fetchrow_hashref() ) {
1716         $orgs{ $data->{'borrowernumber'} } = $data;
1717     }
1718     return ( \%orgs );
1719
1720 }    # sub get_institutions
1721
1722 =head2 add_member_orgs
1723
1724   add_member_orgs($borrowernumber,$borrowernumbers);
1725
1726 Takes a borrowernumber and a list of other borrowernumbers and inserts them into the borrowers_to_borrowers table
1727
1728 =cut
1729
1730 #'
1731 sub add_member_orgs {
1732     my ( $borrowernumber, $otherborrowers ) = @_;
1733     my $dbh   = C4::Context->dbh();
1734     my $query =
1735       "INSERT INTO borrowers_to_borrowers (borrower1,borrower2) VALUES (?,?)";
1736     my $sth = $dbh->prepare($query);
1737     foreach my $otherborrowernumber (@$otherborrowers) {
1738         $sth->execute( $borrowernumber, $otherborrowernumber );
1739     }
1740
1741 }    # sub add_member_orgs
1742
1743 =head2 GetCities
1744
1745   $cityarrayref = GetCities();
1746
1747   Returns an array_ref of the entries in the cities table
1748   If there are entries in the table an empty row is returned
1749   This is currently only used to populate a popup in memberentry
1750
1751 =cut
1752
1753 sub GetCities {
1754
1755     my $dbh   = C4::Context->dbh;
1756     my $city_arr = $dbh->selectall_arrayref(
1757         q|SELECT cityid,city_zipcode,city_name,city_state,city_country FROM cities ORDER BY city_name|,
1758         { Slice => {} });
1759     if ( @{$city_arr} ) {
1760         unshift @{$city_arr}, {
1761             city_zipcode => q{},
1762             city_name    => q{},
1763             cityid       => q{},
1764             city_state   => q{},
1765             city_country => q{},
1766         };
1767     }
1768
1769     return  $city_arr;
1770 }
1771
1772 =head2 GetSortDetails (OUEST-PROVENCE)
1773
1774   ($lib) = &GetSortDetails($category,$sortvalue);
1775
1776 Returns the authorized value  details
1777 C<&$lib>return value of authorized value details
1778 C<&$sortvalue>this is the value of authorized value
1779 C<&$category>this is the value of authorized value category
1780
1781 =cut
1782
1783 sub GetSortDetails {
1784     my ( $category, $sortvalue ) = @_;
1785     my $dbh   = C4::Context->dbh;
1786     my $query = qq|SELECT lib
1787         FROM authorised_values
1788         WHERE category=?
1789         AND authorised_value=? |;
1790     my $sth = $dbh->prepare($query);
1791     $sth->execute( $category, $sortvalue );
1792     my $lib = $sth->fetchrow;
1793     return ($lib) if ($lib);
1794     return ($sortvalue) unless ($lib);
1795 }
1796
1797 =head2 MoveMemberToDeleted
1798
1799   $result = &MoveMemberToDeleted($borrowernumber);
1800
1801 Copy the record from borrowers to deletedborrowers table.
1802
1803 =cut
1804
1805 # FIXME: should do it in one SQL statement w/ subquery
1806 # Otherwise, we should return the @data on success
1807
1808 sub MoveMemberToDeleted {
1809     my ($member) = shift or return;
1810     my $dbh = C4::Context->dbh;
1811     my $query = qq|SELECT *
1812           FROM borrowers
1813           WHERE borrowernumber=?|;
1814     my $sth = $dbh->prepare($query);
1815     $sth->execute($member);
1816     my @data = $sth->fetchrow_array;
1817     (@data) or return;  # if we got a bad borrowernumber, there's nothing to insert
1818     $sth =
1819       $dbh->prepare( "INSERT INTO deletedborrowers VALUES ("
1820           . ( "?," x ( scalar(@data) - 1 ) )
1821           . "?)" );
1822     $sth->execute(@data);
1823 }
1824
1825 =head2 DelMember
1826
1827     DelMember($borrowernumber);
1828
1829 This function remove directly a borrower whitout writing it on deleteborrower.
1830 + Deletes reserves for the borrower
1831
1832 =cut
1833
1834 sub DelMember {
1835     my $dbh            = C4::Context->dbh;
1836     my $borrowernumber = shift;
1837     #warn "in delmember with $borrowernumber";
1838     return unless $borrowernumber;    # borrowernumber is mandatory.
1839
1840     my $query = qq|DELETE
1841           FROM  reserves
1842           WHERE borrowernumber=?|;
1843     my $sth = $dbh->prepare($query);
1844     $sth->execute($borrowernumber);
1845     $query = "
1846        DELETE
1847        FROM borrowers
1848        WHERE borrowernumber = ?
1849    ";
1850     $sth = $dbh->prepare($query);
1851     $sth->execute($borrowernumber);
1852     logaction("MEMBERS", "DELETE", $borrowernumber, "") if C4::Context->preference("BorrowersLog");
1853     return $sth->rows;
1854 }
1855
1856 =head2 ExtendMemberSubscriptionTo (OUEST-PROVENCE)
1857
1858     $date = ExtendMemberSubscriptionTo($borrowerid, $date);
1859
1860 Extending the subscription to a given date or to the expiry date calculated on ISO date.
1861 Returns ISO date.
1862
1863 =cut
1864
1865 sub ExtendMemberSubscriptionTo {
1866     my ( $borrowerid,$date) = @_;
1867     my $dbh = C4::Context->dbh;
1868     my $borrower = GetMember('borrowernumber'=>$borrowerid);
1869     unless ($date){
1870       $date = (C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry') ?
1871                                         C4::Dates->new($borrower->{'dateexpiry'}, 'iso')->output("iso") :
1872                                         C4::Dates->new()->output("iso");
1873       $date = GetExpiryDate( $borrower->{'categorycode'}, $date );
1874     }
1875     my $sth = $dbh->do(<<EOF);
1876 UPDATE borrowers
1877 SET  dateexpiry='$date'
1878 WHERE borrowernumber='$borrowerid'
1879 EOF
1880     # add enrolmentfee if needed
1881     $sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
1882     $sth->execute($borrower->{'categorycode'});
1883     my ($enrolmentfee) = $sth->fetchrow;
1884     if ($enrolmentfee && $enrolmentfee > 0) {
1885         # insert fee in patron debts
1886         manualinvoice($borrower->{'borrowernumber'}, '', '', 'A', $enrolmentfee);
1887     }
1888      logaction("MEMBERS", "RENEW", $borrower->{'borrowernumber'}, "Membership renewed")if C4::Context->preference("BorrowersLog");
1889     return $date if ($sth);
1890     return 0;
1891 }
1892
1893 =head2 GetRoadTypes (OUEST-PROVENCE)
1894
1895   ($idroadtypearrayref, $roadttype_hashref) = &GetRoadTypes();
1896
1897 Looks up the different road type . Returns two
1898 elements: a reference-to-array, which lists the id_roadtype
1899 codes, and a reference-to-hash, which maps the road type of the road .
1900
1901 =cut
1902
1903 sub GetRoadTypes {
1904     my $dbh   = C4::Context->dbh;
1905     my $query = qq|
1906 SELECT roadtypeid,road_type
1907 FROM roadtype
1908 ORDER BY road_type|;
1909     my $sth = $dbh->prepare($query);
1910     $sth->execute();
1911     my %roadtype;
1912     my @id;
1913
1914     #    insert empty value to create a empty choice in cgi popup
1915
1916     while ( my $data = $sth->fetchrow_hashref ) {
1917
1918         push @id, $data->{'roadtypeid'};
1919         $roadtype{ $data->{'roadtypeid'} } = $data->{'road_type'};
1920     }
1921
1922 #test to know if the table contain some records if no the function return nothing
1923     my $id = @id;
1924     if ( $id eq 0 ) {
1925         return ();
1926     }
1927     else {
1928         unshift( @id, "" );
1929         return ( \@id, \%roadtype );
1930     }
1931 }
1932
1933
1934
1935 =head2 GetTitles (OUEST-PROVENCE)
1936
1937   ($borrowertitle)= &GetTitles();
1938
1939 Looks up the different title . Returns array  with all borrowers title
1940
1941 =cut
1942
1943 sub GetTitles {
1944     my @borrowerTitle = split (/,|\|/,C4::Context->preference('BorrowersTitles'));
1945     unshift( @borrowerTitle, "" );
1946     my $count=@borrowerTitle;
1947     if ($count == 1){
1948         return ();
1949     }
1950     else {
1951         return ( \@borrowerTitle);
1952     }
1953 }
1954
1955 =head2 GetPatronImage
1956
1957     my ($imagedata, $dberror) = GetPatronImage($cardnumber);
1958
1959 Returns the mimetype and binary image data of the image for the patron with the supplied cardnumber.
1960
1961 =cut
1962
1963 sub GetPatronImage {
1964     my ($cardnumber) = @_;
1965     warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1966     my $dbh = C4::Context->dbh;
1967     my $query = 'SELECT mimetype, imagefile FROM patronimage WHERE cardnumber = ?';
1968     my $sth = $dbh->prepare($query);
1969     $sth->execute($cardnumber);
1970     my $imagedata = $sth->fetchrow_hashref;
1971     warn "Database error!" if $sth->errstr;
1972     return $imagedata, $sth->errstr;
1973 }
1974
1975 =head2 PutPatronImage
1976
1977     PutPatronImage($cardnumber, $mimetype, $imgfile);
1978
1979 Stores patron binary image data and mimetype in database.
1980 NOTE: This function is good for updating images as well as inserting new images in the database.
1981
1982 =cut
1983
1984 sub PutPatronImage {
1985     my ($cardnumber, $mimetype, $imgfile) = @_;
1986     warn "Parameters passed in: Cardnumber=$cardnumber, Mimetype=$mimetype, " . ($imgfile ? "Imagefile" : "No Imagefile") if $debug;
1987     my $dbh = C4::Context->dbh;
1988     my $query = "INSERT INTO patronimage (cardnumber, mimetype, imagefile) VALUES (?,?,?) ON DUPLICATE KEY UPDATE imagefile = ?;";
1989     my $sth = $dbh->prepare($query);
1990     $sth->execute($cardnumber,$mimetype,$imgfile,$imgfile);
1991     warn "Error returned inserting $cardnumber.$mimetype." if $sth->errstr;
1992     return $sth->errstr;
1993 }
1994
1995 =head2 RmPatronImage
1996
1997     my ($dberror) = RmPatronImage($cardnumber);
1998
1999 Removes the image for the patron with the supplied cardnumber.
2000
2001 =cut
2002
2003 sub RmPatronImage {
2004     my ($cardnumber) = @_;
2005     warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
2006     my $dbh = C4::Context->dbh;
2007     my $query = "DELETE FROM patronimage WHERE cardnumber = ?;";
2008     my $sth = $dbh->prepare($query);
2009     $sth->execute($cardnumber);
2010     my $dberror = $sth->errstr;
2011     warn "Database error!" if $sth->errstr;
2012     return $dberror;
2013 }
2014
2015 =head2 GetHideLostItemsPreference
2016
2017   $hidelostitemspref = &GetHideLostItemsPreference($borrowernumber);
2018
2019 Returns the HideLostItems preference for the patron category of the supplied borrowernumber
2020 C<&$hidelostitemspref>return value of function, 0 or 1
2021
2022 =cut
2023
2024 sub GetHideLostItemsPreference {
2025     my ($borrowernumber) = @_;
2026     my $dbh = C4::Context->dbh;
2027     my $query = "SELECT hidelostitems FROM borrowers,categories WHERE borrowers.categorycode = categories.categorycode AND borrowernumber = ?";
2028     my $sth = $dbh->prepare($query);
2029     $sth->execute($borrowernumber);
2030     my $hidelostitems = $sth->fetchrow;
2031     return $hidelostitems;
2032 }
2033
2034 =head2 GetRoadTypeDetails (OUEST-PROVENCE)
2035
2036   ($roadtype) = &GetRoadTypeDetails($roadtypeid);
2037
2038 Returns the description of roadtype
2039 C<&$roadtype>return description of road type
2040 C<&$roadtypeid>this is the value of roadtype s
2041
2042 =cut
2043
2044 sub GetRoadTypeDetails {
2045     my ($roadtypeid) = @_;
2046     my $dbh          = C4::Context->dbh;
2047     my $query        = qq|
2048 SELECT road_type
2049 FROM roadtype
2050 WHERE roadtypeid=?|;
2051     my $sth = $dbh->prepare($query);
2052     $sth->execute($roadtypeid);
2053     my $roadtype = $sth->fetchrow;
2054     return ($roadtype);
2055 }
2056
2057 =head2 GetBorrowersToExpunge
2058
2059   $borrowers = &GetBorrowersToExpunge(
2060       not_borrowered_since => $not_borrowered_since,
2061       expired_before       => $expired_before,
2062       category_code        => $category_code,
2063       branchcode           => $branchcode
2064   );
2065
2066   This function get all borrowers based on the given criteria.
2067
2068 =cut
2069
2070 sub GetBorrowersToExpunge {
2071     my $params = shift;
2072
2073     my $filterdate     = $params->{'not_borrowered_since'};
2074     my $filterexpiry   = $params->{'expired_before'};
2075     my $filtercategory = $params->{'category_code'};
2076     my $filterbranch   = $params->{'branchcode'} ||
2077                         ((C4::Context->preference('IndependentBranches')
2078                              && C4::Context->userenv
2079                              && C4::Context->userenv->{flags} % 2 !=1
2080                              && C4::Context->userenv->{branch})
2081                          ? C4::Context->userenv->{branch}
2082                          : "");
2083
2084     my $dbh   = C4::Context->dbh;
2085     my $query = "
2086         SELECT borrowers.borrowernumber,
2087                MAX(old_issues.timestamp) AS latestissue,
2088                MAX(issues.timestamp) AS currentissue
2089         FROM   borrowers
2090         JOIN   categories USING (categorycode)
2091         LEFT JOIN old_issues USING (borrowernumber)
2092         LEFT JOIN issues USING (borrowernumber)
2093         WHERE  category_type <> 'S'
2094         AND borrowernumber NOT IN (SELECT guarantorid FROM borrowers WHERE guarantorid IS NOT NULL AND guarantorid <> 0)
2095    ";
2096     my @query_params;
2097     if ( $filterbranch && $filterbranch ne "" ) {
2098         $query.= " AND borrowers.branchcode = ? ";
2099         push( @query_params, $filterbranch );
2100     }
2101     if ( $filterexpiry ) {
2102         $query .= " AND dateexpiry < ? ";
2103         push( @query_params, $filterexpiry );
2104     }
2105     if ( $filtercategory ) {
2106         $query .= " AND categorycode = ? ";
2107         push( @query_params, $filtercategory );
2108     }
2109     $query.=" GROUP BY borrowers.borrowernumber HAVING currentissue IS NULL ";
2110     if ( $filterdate ) {
2111         $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
2112         push @query_params,$filterdate;
2113     }
2114     warn $query if $debug;
2115
2116     my $sth = $dbh->prepare($query);
2117     if (scalar(@query_params)>0){
2118         $sth->execute(@query_params);
2119     }
2120     else {
2121         $sth->execute;
2122     }
2123
2124     my @results;
2125     while ( my $data = $sth->fetchrow_hashref ) {
2126         push @results, $data;
2127     }
2128     return \@results;
2129 }
2130
2131 =head2 GetBorrowersWhoHaveNeverBorrowed
2132
2133   $results = &GetBorrowersWhoHaveNeverBorrowed
2134
2135 This function get all borrowers who have never borrowed.
2136
2137 I<$result> is a ref to an array which all elements are a hasref.
2138
2139 =cut
2140
2141 sub GetBorrowersWhoHaveNeverBorrowed {
2142     my $filterbranch = shift ||
2143                         ((C4::Context->preference('IndependentBranches')
2144                              && C4::Context->userenv
2145                              && C4::Context->userenv->{flags} % 2 !=1
2146                              && C4::Context->userenv->{branch})
2147                          ? C4::Context->userenv->{branch}
2148                          : "");
2149     my $dbh   = C4::Context->dbh;
2150     my $query = "
2151         SELECT borrowers.borrowernumber,max(timestamp) as latestissue
2152         FROM   borrowers
2153           LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
2154         WHERE issues.borrowernumber IS NULL
2155    ";
2156     my @query_params;
2157     if ($filterbranch && $filterbranch ne ""){
2158         $query.=" AND borrowers.branchcode= ?";
2159         push @query_params,$filterbranch;
2160     }
2161     warn $query if $debug;
2162
2163     my $sth = $dbh->prepare($query);
2164     if (scalar(@query_params)>0){
2165         $sth->execute(@query_params);
2166     }
2167     else {
2168         $sth->execute;
2169     }
2170
2171     my @results;
2172     while ( my $data = $sth->fetchrow_hashref ) {
2173         push @results, $data;
2174     }
2175     return \@results;
2176 }
2177
2178 =head2 GetBorrowersWithIssuesHistoryOlderThan
2179
2180   $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
2181
2182 this function get all borrowers who has an issue history older than I<$date> given on input arg.
2183
2184 I<$result> is a ref to an array which all elements are a hashref.
2185 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2186
2187 =cut
2188
2189 sub GetBorrowersWithIssuesHistoryOlderThan {
2190     my $dbh  = C4::Context->dbh;
2191     my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
2192     my $filterbranch = shift ||
2193                         ((C4::Context->preference('IndependentBranches')
2194                              && C4::Context->userenv
2195                              && C4::Context->userenv->{flags} % 2 !=1
2196                              && C4::Context->userenv->{branch})
2197                          ? C4::Context->userenv->{branch}
2198                          : "");
2199     my $query = "
2200        SELECT count(borrowernumber) as n,borrowernumber
2201        FROM old_issues
2202        WHERE returndate < ?
2203          AND borrowernumber IS NOT NULL
2204     ";
2205     my @query_params;
2206     push @query_params, $date;
2207     if ($filterbranch){
2208         $query.="   AND branchcode = ?";
2209         push @query_params, $filterbranch;
2210     }
2211     $query.=" GROUP BY borrowernumber ";
2212     warn $query if $debug;
2213     my $sth = $dbh->prepare($query);
2214     $sth->execute(@query_params);
2215     my @results;
2216
2217     while ( my $data = $sth->fetchrow_hashref ) {
2218         push @results, $data;
2219     }
2220     return \@results;
2221 }
2222
2223 =head2 GetBorrowersNamesAndLatestIssue
2224
2225   $results = &GetBorrowersNamesAndLatestIssueList(@borrowernumbers)
2226
2227 this function get borrowers Names and surnames and Issue information.
2228
2229 I<@borrowernumbers> is an array which all elements are borrowernumbers.
2230 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2231
2232 =cut
2233
2234 sub GetBorrowersNamesAndLatestIssue {
2235     my $dbh  = C4::Context->dbh;
2236     my @borrowernumbers=@_;
2237     my $query = "
2238        SELECT surname,lastname, phone, email,max(timestamp)
2239        FROM borrowers
2240          LEFT JOIN issues ON borrowers.borrowernumber=issues.borrowernumber
2241        GROUP BY borrowernumber
2242    ";
2243     my $sth = $dbh->prepare($query);
2244     $sth->execute;
2245     my $results = $sth->fetchall_arrayref({});
2246     return $results;
2247 }
2248
2249 =head2 DebarMember
2250
2251 my $success = DebarMember( $borrowernumber, $todate );
2252
2253 marks a Member as debarred, and therefore unable to checkout any more
2254 items.
2255
2256 return :
2257 true on success, false on failure
2258
2259 =cut
2260
2261 sub DebarMember {
2262     my $borrowernumber = shift;
2263     my $todate         = shift;
2264
2265     return unless defined $borrowernumber;
2266     return unless $borrowernumber =~ /^\d+$/;
2267
2268     return ModMember(
2269         borrowernumber => $borrowernumber,
2270         debarred       => $todate
2271     );
2272
2273 }
2274
2275 =head2 ModPrivacy
2276
2277 =over 4
2278
2279 my $success = ModPrivacy( $borrowernumber, $privacy );
2280
2281 Update the privacy of a patron.
2282
2283 return :
2284 true on success, false on failure
2285
2286 =back
2287
2288 =cut
2289
2290 sub ModPrivacy {
2291     my $borrowernumber = shift;
2292     my $privacy = shift;
2293     return unless defined $borrowernumber;
2294     return unless $borrowernumber =~ /^\d+$/;
2295
2296     return ModMember( borrowernumber => $borrowernumber,
2297                       privacy        => $privacy );
2298 }
2299
2300 =head2 AddMessage
2301
2302   AddMessage( $borrowernumber, $message_type, $message, $branchcode );
2303
2304 Adds a message to the messages table for the given borrower.
2305
2306 Returns:
2307   True on success
2308   False on failure
2309
2310 =cut
2311
2312 sub AddMessage {
2313     my ( $borrowernumber, $message_type, $message, $branchcode ) = @_;
2314
2315     my $dbh  = C4::Context->dbh;
2316
2317     if ( ! ( $borrowernumber && $message_type && $message && $branchcode ) ) {
2318       return;
2319     }
2320
2321     my $query = "INSERT INTO messages ( borrowernumber, branchcode, message_type, message ) VALUES ( ?, ?, ?, ? )";
2322     my $sth = $dbh->prepare($query);
2323     $sth->execute( $borrowernumber, $branchcode, $message_type, $message );
2324     logaction("MEMBERS", "ADDCIRCMESSAGE", $borrowernumber, $message) if C4::Context->preference("BorrowersLog");
2325     return 1;
2326 }
2327
2328 =head2 GetMessages
2329
2330   GetMessages( $borrowernumber, $type );
2331
2332 $type is message type, B for borrower, or L for Librarian.
2333 Empty type returns all messages of any type.
2334
2335 Returns all messages for the given borrowernumber
2336
2337 =cut
2338
2339 sub GetMessages {
2340     my ( $borrowernumber, $type, $branchcode ) = @_;
2341
2342     if ( ! $type ) {
2343       $type = '%';
2344     }
2345
2346     my $dbh  = C4::Context->dbh;
2347
2348     my $query = "SELECT
2349                   branches.branchname,
2350                   messages.*,
2351                   message_date,
2352                   messages.branchcode LIKE '$branchcode' AS can_delete
2353                   FROM messages, branches
2354                   WHERE borrowernumber = ?
2355                   AND message_type LIKE ?
2356                   AND messages.branchcode = branches.branchcode
2357                   ORDER BY message_date DESC";
2358     my $sth = $dbh->prepare($query);
2359     $sth->execute( $borrowernumber, $type ) ;
2360     my @results;
2361
2362     while ( my $data = $sth->fetchrow_hashref ) {
2363         my $d = C4::Dates->new( $data->{message_date}, 'iso' );
2364         $data->{message_date_formatted} = $d->output;
2365         push @results, $data;
2366     }
2367     return \@results;
2368
2369 }
2370
2371 =head2 GetMessages
2372
2373   GetMessagesCount( $borrowernumber, $type );
2374
2375 $type is message type, B for borrower, or L for Librarian.
2376 Empty type returns all messages of any type.
2377
2378 Returns the number of messages for the given borrowernumber
2379
2380 =cut
2381
2382 sub GetMessagesCount {
2383     my ( $borrowernumber, $type, $branchcode ) = @_;
2384
2385     if ( ! $type ) {
2386       $type = '%';
2387     }
2388
2389     my $dbh  = C4::Context->dbh;
2390
2391     my $query = "SELECT COUNT(*) as MsgCount FROM messages WHERE borrowernumber = ? AND message_type LIKE ?";
2392     my $sth = $dbh->prepare($query);
2393     $sth->execute( $borrowernumber, $type ) ;
2394     my @results;
2395
2396     my $data = $sth->fetchrow_hashref;
2397     my $count = $data->{'MsgCount'};
2398
2399     return $count;
2400 }
2401
2402
2403
2404 =head2 DeleteMessage
2405
2406   DeleteMessage( $message_id );
2407
2408 =cut
2409
2410 sub DeleteMessage {
2411     my ( $message_id ) = @_;
2412
2413     my $dbh = C4::Context->dbh;
2414     my $query = "SELECT * FROM messages WHERE message_id = ?";
2415     my $sth = $dbh->prepare($query);
2416     $sth->execute( $message_id );
2417     my $message = $sth->fetchrow_hashref();
2418
2419     $query = "DELETE FROM messages WHERE message_id = ?";
2420     $sth = $dbh->prepare($query);
2421     $sth->execute( $message_id );
2422     logaction("MEMBERS", "DELCIRCMESSAGE", $message->{'borrowernumber'}, $message->{'message'}) if C4::Context->preference("BorrowersLog");
2423 }
2424
2425 =head2 IssueSlip
2426
2427   IssueSlip($branchcode, $borrowernumber, $quickslip)
2428
2429   Returns letter hash ( see C4::Letters::GetPreparedLetter )
2430
2431   $quickslip is boolean, to indicate whether we want a quick slip
2432
2433 =cut
2434
2435 sub IssueSlip {
2436     my ($branch, $borrowernumber, $quickslip) = @_;
2437
2438 #   return unless ( C4::Context->boolean_preference('printcirculationslips') );
2439
2440     my $now       = POSIX::strftime("%Y-%m-%d", localtime);
2441
2442     my $issueslist = GetPendingIssues($borrowernumber);
2443     foreach my $it (@$issueslist){
2444         if ((substr $it->{'issuedate'}, 0, 10) eq $now || (substr $it->{'lastreneweddate'}, 0, 10) eq $now) {
2445             $it->{'now'} = 1;
2446         }
2447         elsif ((substr $it->{'date_due'}, 0, 10) le $now) {
2448             $it->{'overdue'} = 1;
2449         }
2450         my $dt = dt_from_string( $it->{'date_due'} );
2451         $it->{'date_due'} = output_pref( $dt );;
2452     }
2453     my @issues = sort { $b->{'timestamp'} <=> $a->{'timestamp'} } @$issueslist;
2454
2455     my ($letter_code, %repeat);
2456     if ( $quickslip ) {
2457         $letter_code = 'ISSUEQSLIP';
2458         %repeat =  (
2459             'checkedout' => [ map {
2460                 'biblio' => $_,
2461                 'items'  => $_,
2462                 'issues' => $_,
2463             }, grep { $_->{'now'} } @issues ],
2464         );
2465     }
2466     else {
2467         $letter_code = 'ISSUESLIP';
2468         %repeat =  (
2469             'checkedout' => [ map {
2470                 'biblio' => $_,
2471                 'items'  => $_,
2472                 'issues' => $_,
2473             }, grep { !$_->{'overdue'} } @issues ],
2474
2475             'overdue' => [ map {
2476                 'biblio' => $_,
2477                 'items'  => $_,
2478                 'issues' => $_,
2479             }, grep { $_->{'overdue'} } @issues ],
2480
2481             'news' => [ map {
2482                 $_->{'timestamp'} = $_->{'newdate'};
2483                 { opac_news => $_ }
2484             } @{ GetNewsToDisplay("slip") } ],
2485         );
2486     }
2487
2488     return  C4::Letters::GetPreparedLetter (
2489         module => 'circulation',
2490         letter_code => $letter_code,
2491         branchcode => $branch,
2492         tables => {
2493             'branches'    => $branch,
2494             'borrowers'   => $borrowernumber,
2495         },
2496         repeat => \%repeat,
2497     );
2498 }
2499
2500 =head2 GetBorrowersWithEmail
2501
2502     ([$borrnum,$userid], ...) = GetBorrowersWithEmail('me@example.com');
2503
2504 This gets a list of users and their basic details from their email address.
2505 As it's possible for multiple user to have the same email address, it provides
2506 you with all of them. If there is no userid for the user, there will be an
2507 C<undef> there. An empty list will be returned if there are no matches.
2508
2509 =cut
2510
2511 sub GetBorrowersWithEmail {
2512     my $email = shift;
2513
2514     my $dbh = C4::Context->dbh;
2515
2516     my $query = "SELECT borrowernumber, userid FROM borrowers WHERE email=?";
2517     my $sth=$dbh->prepare($query);
2518     $sth->execute($email);
2519     my @result = ();
2520     while (my $ref = $sth->fetch) {
2521         push @result, $ref;
2522     }
2523     die "Failure searching for borrowers by email address: $sth->errstr" if $sth->err;
2524     return @result;
2525 }
2526
2527 sub AddMember_Opac {
2528     my ( %borrower ) = @_;
2529
2530     $borrower{'categorycode'} = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
2531
2532     my $sr = new String::Random;
2533     $sr->{'A'} = [ 'A'..'Z', 'a'..'z' ];
2534     my $password = $sr->randpattern("AAAAAAAAAA");
2535     $borrower{'password'} = $password;
2536
2537     $borrower{'cardnumber'} = fixup_cardnumber();
2538
2539     my $borrowernumber = AddMember(%borrower);
2540
2541     return ( $borrowernumber, $password );
2542 }
2543
2544 END { }    # module clean-up code here (global destructor)
2545
2546 1;
2547
2548 __END__
2549
2550 =head1 AUTHOR
2551
2552 Koha Team
2553
2554 =cut