C4/Members.pm

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