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