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