C4/Members.pm

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