C4/Members.pm

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