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