C4/Members.pm

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