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