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     defined($cardnumber) or return $cardnumber;
 913     my $checkdigit = C4::Context->preference('checkdigit');
 914     my $dbh = C4::Context->dbh;
 915     if ( $checkdigit and $checkdigit eq 'katipo' ) {
 916
 917         # if checkdigit is selected, calculate katipo-style cardnumber.
 918         # otherwise, just use the max()
 919         # purpose: generate checksum'd member numbers.
 920         # We'll assume we just got the max value of digits 2-8 of member #'s
 921         # from the database and our job is to increment that by one,
 922         # determine the 1st and 9th digits and return the full string.
 923         my $sth = $dbh->prepare(
 924             "select max(substring(borrowers.cardnumber,2,7)) as new_num from borrowers"
 925         );
 926         $sth->execute;
 927         my $data = $sth->fetchrow_hashref;
 928         $cardnumber = $data->{new_num};
 929         if ( !$cardnumber ) {    # If DB has no values,
 930             $cardnumber = 1000000;    # start at 1000000
 931         } else {
 932             $cardnumber += 1;
 933         }
 934
 935         my $sum = 0;
 936         for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
 937             # read weightings, left to right, 1 char at a time
 938             my $temp1 = $weightings[$i];
 939
 940             # sequence left to right, 1 char at a time
 941             my $temp2 = substr( $cardnumber, $i, 1 );
 942
 943             # mult each char 1-7 by its corresponding weighting
 944             $sum += $temp1 * $temp2;
 945         }
 946
 947         my $rem = ( $sum % 11 );
 948         $rem = 'X' if $rem == 10;
 949
 950         return "V$cardnumber$rem";
 951      } else {
 952
 953      # MODIFIED BY JF: mysql4.1 allows casting as an integer, which is probably
 954      # better. I'll leave the original in in case it needs to be changed for you
 955      # my $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers");
 956         my $sth = $dbh->prepare(
 957             "select max(cast(cardnumber as signed)) from borrowers"
 958         );
 959         $sth->execute;
 960         my ($result) = $sth->fetchrow;
 961         return $result + 1;
 962     }
 963     return $cardnumber;     # just here as a fallback/reminder
 964 }
 965
 966 =head2 GetGuarantees
 967
 968   ($num_children, $children_arrayref) = &GetGuarantees($parent_borrno);
 969   $child0_cardno = $children_arrayref->[0]{"cardnumber"};
 970   $child0_borrno = $children_arrayref->[0]{"borrowernumber"};
 971
 972 C<&GetGuarantees> takes a borrower number (e.g., that of a patron
 973 with children) and looks up the borrowers who are guaranteed by that
 974 borrower (i.e., the patron's children).
 975
 976 C<&GetGuarantees> returns two values: an integer giving the number of
 977 borrowers guaranteed by C<$parent_borrno>, and a reference to an array
 978 of references to hash, which gives the actual results.
 979
 980 =cut
 981
 982 #'
 983 sub GetGuarantees {
 984     my ($borrowernumber) = @_;
 985     my $dbh              = C4::Context->dbh;
 986     my $sth              =
 987       $dbh->prepare(
 988 "select cardnumber,borrowernumber, firstname, surname from borrowers where guarantorid=?"
 989       );
 990     $sth->execute($borrowernumber);
 991
 992     my @dat;
 993     my $data = $sth->fetchall_arrayref({});
 994     return ( scalar(@$data), $data );
 995 }
 996
 997 =head2 UpdateGuarantees
 998
 999   &UpdateGuarantees($parent_borrno);
1000
1001
1002 C<&UpdateGuarantees> borrower data for an adult and updates all the guarantees
1003 with the modified information
1004
1005 =cut
1006
1007 #'
1008 sub UpdateGuarantees {
1009     my %data = shift;
1010     my $dbh = C4::Context->dbh;
1011     my ( $count, $guarantees ) = GetGuarantees( $data{'borrowernumber'} );
1012     foreach my $guarantee (@$guarantees){
1013         my $guaquery = qq|UPDATE borrowers
1014               SET address=?,fax=?,B_city=?,mobile=?,city=?,phone=?
1015               WHERE borrowernumber=?
1016         |;
1017         my $sth = $dbh->prepare($guaquery);
1018         $sth->execute($data{'address'},$data{'fax'},$data{'B_city'},$data{'mobile'},$data{'city'},$data{'phone'},$guarantee->{'borrowernumber'});
1019     }
1020 }
1021 =head2 GetPendingIssues
1022
1023   my $issues = &GetPendingIssues(@borrowernumber);
1024
1025 Looks up what the patron with the given borrowernumber has borrowed.
1026
1027 C<&GetPendingIssues> returns a
1028 reference-to-array where each element is a reference-to-hash; the
1029 keys are the fields from the C<issues>, C<biblio>, and C<items> tables.
1030 The keys include C<biblioitems> fields except marc and marcxml.
1031
1032 =cut
1033
1034 #'
1035 sub GetPendingIssues {
1036     my (@borrowernumbers) = @_;
1037
1038     # Borrowers part of the query
1039     my $bquery = '';
1040     for (my $i = 0; $i < @borrowernumbers; $i++) {
1041         $bquery .= " borrowernumber = ?";
1042         $bquery .= " OR" if ($i < (scalar(@borrowernumbers) - 1));
1043     }
1044
1045     # must avoid biblioitems.* to prevent large marc and marcxml fields from killing performance
1046     # FIXME: namespace collision: each table has "timestamp" fields.  Which one is "timestamp" ?
1047     # FIXME: circ/ciculation.pl tries to sort by timestamp!
1048     # FIXME: C4::Print::printslip tries to sort by timestamp!
1049     # FIXME: namespace collision: other collisions possible.
1050     # FIXME: most of this data isn't really being used by callers.
1051     my $query =
1052    "SELECT issues.*,
1053             items.*,
1054            biblio.*,
1055            biblioitems.volume,
1056            biblioitems.number,
1057            biblioitems.itemtype,
1058            biblioitems.isbn,
1059            biblioitems.issn,
1060            biblioitems.publicationyear,
1061            biblioitems.publishercode,
1062            biblioitems.volumedate,
1063            biblioitems.volumedesc,
1064            biblioitems.lccn,
1065            biblioitems.url,
1066            issues.timestamp AS timestamp,
1067            issues.renewals  AS renewals,
1068            issues.borrowernumber AS borrowernumber,
1069             items.renewals  AS totalrenewals
1070     FROM   issues
1071     LEFT JOIN items       ON items.itemnumber       =      issues.itemnumber
1072     LEFT JOIN biblio      ON items.biblionumber     =      biblio.biblionumber
1073     LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
1074     WHERE
1075       $bquery
1076     ORDER BY issues.issuedate"
1077     ;
1078
1079     my $sth = C4::Context->dbh->prepare($query);
1080     $sth->execute(@borrowernumbers);
1081     my $data = $sth->fetchall_arrayref({});
1082     my $today = C4::Dates->new->output('iso');
1083     foreach (@$data) {
1084         $_->{date_due} or next;
1085         ($_->{date_due} lt $today) and $_->{overdue} = 1;
1086     }
1087     return $data;
1088 }
1089
1090 =head2 GetAllIssues
1091
1092   $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
1093
1094 Looks up what the patron with the given borrowernumber has borrowed,
1095 and sorts the results.
1096
1097 C<$sortkey> is the name of a field on which to sort the results. This
1098 should be the name of a field in the C<issues>, C<biblio>,
1099 C<biblioitems>, or C<items> table in the Koha database.
1100
1101 C<$limit> is the maximum number of results to return.
1102
1103 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
1104 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
1105 C<items> tables of the Koha database.
1106
1107 =cut
1108
1109 #'
1110 sub GetAllIssues {
1111     my ( $borrowernumber, $order, $limit ) = @_;
1112
1113     #FIXME: sanity-check order and limit
1114     my $dbh   = C4::Context->dbh;
1115     my $query =
1116   "SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1117   FROM issues
1118   LEFT JOIN items on items.itemnumber=issues.itemnumber
1119   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1120   LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1121   WHERE borrowernumber=?
1122   UNION ALL
1123   SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1124   FROM old_issues
1125   LEFT JOIN items on items.itemnumber=old_issues.itemnumber
1126   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1127   LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1128   WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL
1129   order by $order";
1130     if ( $limit != 0 ) {
1131         $query .= " limit $limit";
1132     }
1133
1134     my $sth = $dbh->prepare($query);
1135     $sth->execute($borrowernumber, $borrowernumber);
1136     my @result;
1137     my $i = 0;
1138     while ( my $data = $sth->fetchrow_hashref ) {
1139         push @result, $data;
1140     }
1141
1142     return \@result;
1143 }
1144
1145
1146 =head2 GetMemberAccountRecords
1147
1148   ($total, $acctlines, $count) = &GetMemberAccountRecords($borrowernumber);
1149
1150 Looks up accounting data for the patron with the given borrowernumber.
1151
1152 C<&GetMemberAccountRecords> returns a three-element array. C<$acctlines> is a
1153 reference-to-array, where each element is a reference-to-hash; the
1154 keys are the fields of the C<accountlines> table in the Koha database.
1155 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1156 total amount outstanding for all of the account lines.
1157
1158 =cut
1159
1160 #'
1161 sub GetMemberAccountRecords {
1162     my ($borrowernumber,$date) = @_;
1163     my $dbh = C4::Context->dbh;
1164     my @acctlines;
1165     my $numlines = 0;
1166     my $strsth      = qq(
1167                         SELECT *
1168                         FROM accountlines
1169                         WHERE borrowernumber=?);
1170     my @bind = ($borrowernumber);
1171     if ($date && $date ne ''){
1172             $strsth.=" AND date < ? ";
1173             push(@bind,$date);
1174     }
1175     $strsth.=" ORDER BY date desc,timestamp DESC";
1176     my $sth= $dbh->prepare( $strsth );
1177     $sth->execute( @bind );
1178     my $total = 0;
1179     while ( my $data = $sth->fetchrow_hashref ) {
1180         if ( $data->{itemnumber} ) {
1181             my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
1182             $data->{biblionumber} = $biblio->{biblionumber};
1183             $data->{title}        = $biblio->{title};
1184         }
1185         $acctlines[$numlines] = $data;
1186         $numlines++;
1187         $total += int(1000 * $data->{'amountoutstanding'}); # convert float to integer to avoid round-off errors
1188     }
1189     $total /= 1000;
1190     return ( $total, \@acctlines,$numlines);
1191 }
1192
1193 =head2 GetBorNotifyAcctRecord
1194
1195   ($count, $acctlines, $total) = &GetBorNotifyAcctRecord($params,$notifyid);
1196
1197 Looks up accounting data for the patron with the given borrowernumber per file number.
1198
1199 (FIXME - I'm not at all sure what this is about.)
1200
1201 C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a
1202 reference-to-array, where each element is a reference-to-hash; the
1203 keys are the fields of the C<accountlines> table in the Koha database.
1204 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1205 total amount outstanding for all of the account lines.
1206
1207 =cut
1208
1209 sub GetBorNotifyAcctRecord {
1210     my ( $borrowernumber, $notifyid ) = @_;
1211     my $dbh = C4::Context->dbh;
1212     my @acctlines;
1213     my $numlines = 0;
1214     my $sth = $dbh->prepare(
1215             "SELECT *
1216                 FROM accountlines
1217                 WHERE borrowernumber=?
1218                     AND notify_id=?
1219                     AND amountoutstanding != '0'
1220                 ORDER BY notify_id,accounttype
1221                 ");
1222 #                    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')
1223
1224     $sth->execute( $borrowernumber, $notifyid );
1225     my $total = 0;
1226     while ( my $data = $sth->fetchrow_hashref ) {
1227         $acctlines[$numlines] = $data;
1228         $numlines++;
1229         $total += int(100 * $data->{'amountoutstanding'});
1230     }
1231     $total /= 100;
1232     return ( $total, \@acctlines, $numlines );
1233 }
1234
1235 =head2 checkuniquemember (OUEST-PROVENCE)
1236
1237   ($result,$categorycode)  = &checkuniquemember($collectivity,$surname,$firstname,$dateofbirth);
1238
1239 Checks that a member exists or not in the database.
1240
1241 C<&result> is nonzero (=exist) or 0 (=does not exist)
1242 C<&categorycode> is from categorycode table
1243 C<&collectivity> is 1 (= we add a collectivity) or 0 (= we add a physical member)
1244 C<&surname> is the surname
1245 C<&firstname> is the firstname (only if collectivity=0)
1246 C<&dateofbirth> is the date of birth in ISO format (only if collectivity=0)
1247
1248 =cut
1249
1250 # FIXME: This function is not legitimate.  Multiple patrons might have the same first/last name and birthdate.
1251 # This is especially true since first name is not even a required field.
1252
1253 sub checkuniquemember {
1254     my ( $collectivity, $surname, $firstname, $dateofbirth ) = @_;
1255     my $dbh = C4::Context->dbh;
1256     my $request = ($collectivity) ?
1257         "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? " :
1258             ($dateofbirth) ?
1259             "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=?  and dateofbirth=?" :
1260             "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=?";
1261     my $sth = $dbh->prepare($request);
1262     if ($collectivity) {
1263         $sth->execute( uc($surname) );
1264     } elsif($dateofbirth){
1265         $sth->execute( uc($surname), ucfirst($firstname), $dateofbirth );
1266     }else{
1267         $sth->execute( uc($surname), ucfirst($firstname));
1268     }
1269     my @data = $sth->fetchrow;
1270     ( $data[0] ) and return $data[0], $data[1];
1271     return 0;
1272 }
1273
1274 sub checkcardnumber {
1275     my ($cardnumber,$borrowernumber) = @_;
1276     # If cardnumber is null, we assume they're allowed.
1277     return 0 if !defined($cardnumber);
1278     my $dbh = C4::Context->dbh;
1279     my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
1280     $query .= " AND borrowernumber <> ?" if ($borrowernumber);
1281   my $sth = $dbh->prepare($query);
1282   if ($borrowernumber) {
1283    $sth->execute($cardnumber,$borrowernumber);
1284   } else {
1285      $sth->execute($cardnumber);
1286   }
1287     if (my $data= $sth->fetchrow_hashref()){
1288         return 1;
1289     }
1290     else {
1291         return 0;
1292     }
1293 }
1294
1295
1296 =head2 getzipnamecity (OUEST-PROVENCE)
1297
1298 take all info from table city for the fields city and  zip
1299 check for the name and the zip code of the city selected
1300
1301 =cut
1302
1303 sub getzipnamecity {
1304     my ($cityid) = @_;
1305     my $dbh      = C4::Context->dbh;
1306     my $sth      =
1307       $dbh->prepare(
1308         "select city_name,city_zipcode from cities where cityid=? ");
1309     $sth->execute($cityid);
1310     my @data = $sth->fetchrow;
1311     return $data[0], $data[1];
1312 }
1313
1314
1315 =head2 getdcity (OUEST-PROVENCE)
1316
1317 recover cityid  with city_name condition
1318
1319 =cut
1320
1321 sub getidcity {
1322     my ($city_name) = @_;
1323     my $dbh = C4::Context->dbh;
1324     my $sth = $dbh->prepare("select cityid from cities where city_name=? ");
1325     $sth->execute($city_name);
1326     my $data = $sth->fetchrow;
1327     return $data;
1328 }
1329
1330 =head2 GetFirstValidEmailAddress
1331
1332   $email = GetFirstValidEmailAddress($borrowernumber);
1333
1334 Return the first valid email address for a borrower, given the borrowernumber.  For now, the order
1335 is defined as email, emailpro, B_email.  Returns the empty string if the borrower has no email
1336 addresses.
1337
1338 =cut
1339
1340 sub GetFirstValidEmailAddress {
1341     my $borrowernumber = shift;
1342     my $dbh = C4::Context->dbh;
1343     my $sth = $dbh->prepare( "SELECT email, emailpro, B_email FROM borrowers where borrowernumber = ? ");
1344     $sth->execute( $borrowernumber );
1345     my $data = $sth->fetchrow_hashref;
1346
1347     if ($data->{'email'}) {
1348        return $data->{'email'};
1349     } elsif ($data->{'emailpro'}) {
1350        return $data->{'emailpro'};
1351     } elsif ($data->{'B_email'}) {
1352        return $data->{'B_email'};
1353     } else {
1354        return '';
1355     }
1356 }
1357
1358 =head2 GetExpiryDate
1359
1360   $expirydate = GetExpiryDate($categorycode, $dateenrolled);
1361
1362 Calculate expiry date given a categorycode and starting date.  Date argument must be in ISO format.
1363 Return date is also in ISO format.
1364
1365 =cut
1366
1367 sub GetExpiryDate {
1368     my ( $categorycode, $dateenrolled ) = @_;
1369     my $enrolments;
1370     if ($categorycode) {
1371         my $dbh = C4::Context->dbh;
1372         my $sth = $dbh->prepare("SELECT enrolmentperiod,enrolmentperioddate FROM categories WHERE categorycode=?");
1373         $sth->execute($categorycode);
1374         $enrolments = $sth->fetchrow_hashref;
1375     }
1376     # die "GetExpiryDate: for enrollmentperiod $enrolmentperiod (category '$categorycode') starting $dateenrolled.\n";
1377     my @date = split (/-/,$dateenrolled);
1378     if($enrolments->{enrolmentperiod}){
1379         return sprintf("%04d-%02d-%02d", Add_Delta_YM(@date,0,$enrolments->{enrolmentperiod}));
1380     }else{
1381         return $enrolments->{enrolmentperioddate};
1382     }
1383 }
1384
1385 =head2 checkuserpassword (OUEST-PROVENCE)
1386
1387 check for the password and login are not used
1388 return the number of record
1389 0=> NOT USED 1=> USED
1390
1391 =cut
1392
1393 sub checkuserpassword {
1394     my ( $borrowernumber, $userid, $password ) = @_;
1395     $password = md5_base64($password);
1396     my $dbh = C4::Context->dbh;
1397     my $sth =
1398       $dbh->prepare(
1399 "Select count(*) from borrowers where borrowernumber !=? and userid =? and password=? "
1400       );
1401     $sth->execute( $borrowernumber, $userid, $password );
1402     my $number_rows = $sth->fetchrow;
1403     return $number_rows;
1404
1405 }
1406
1407 =head2 GetborCatFromCatType
1408
1409   ($codes_arrayref, $labels_hashref) = &GetborCatFromCatType();
1410
1411 Looks up the different types of borrowers in the database. Returns two
1412 elements: a reference-to-array, which lists the borrower category
1413 codes, and a reference-to-hash, which maps the borrower category codes
1414 to category descriptions.
1415
1416 =cut
1417
1418 #'
1419 sub GetborCatFromCatType {
1420     my ( $category_type, $action ) = @_;
1421         # FIXME - This API  seems both limited and dangerous.
1422     my $dbh     = C4::Context->dbh;
1423     my $request = qq|   SELECT categorycode,description
1424             FROM categories
1425             $action
1426             ORDER BY categorycode|;
1427     my $sth = $dbh->prepare($request);
1428         if ($action) {
1429         $sth->execute($category_type);
1430     }
1431     else {
1432         $sth->execute();
1433     }
1434
1435     my %labels;
1436     my @codes;
1437
1438     while ( my $data = $sth->fetchrow_hashref ) {
1439         push @codes, $data->{'categorycode'};
1440         $labels{ $data->{'categorycode'} } = $data->{'description'};
1441     }
1442     return ( \@codes, \%labels );
1443 }
1444
1445 =head2 GetBorrowercategory
1446
1447   $hashref = &GetBorrowercategory($categorycode);
1448
1449 Given the borrower's category code, the function returns the corresponding
1450 data hashref for a comprehensive information display.
1451
1452   $arrayref_hashref = &GetBorrowercategory;
1453
1454 If no category code provided, the function returns all the categories.
1455
1456 =cut
1457
1458 sub GetBorrowercategory {
1459     my ($catcode) = @_;
1460     my $dbh       = C4::Context->dbh;
1461     if ($catcode){
1462         my $sth       =
1463         $dbh->prepare(
1464     "SELECT description,dateofbirthrequired,upperagelimit,category_type
1465     FROM categories
1466     WHERE categorycode = ?"
1467         );
1468         $sth->execute($catcode);
1469         my $data =
1470         $sth->fetchrow_hashref;
1471         return $data;
1472     }
1473     return;
1474 }    # sub getborrowercategory
1475
1476 =head2 GetBorrowercategoryList
1477
1478   $arrayref_hashref = &GetBorrowercategoryList;
1479 If no category code provided, the function returns all the categories.
1480
1481 =cut
1482
1483 sub GetBorrowercategoryList {
1484     my $dbh       = C4::Context->dbh;
1485     my $sth       =
1486     $dbh->prepare(
1487     "SELECT *
1488     FROM categories
1489     ORDER BY description"
1490         );
1491     $sth->execute;
1492     my $data =
1493     $sth->fetchall_arrayref({});
1494     return $data;
1495 }    # sub getborrowercategory
1496
1497 =head2 ethnicitycategories
1498
1499   ($codes_arrayref, $labels_hashref) = &ethnicitycategories();
1500
1501 Looks up the different ethnic types in the database. Returns two
1502 elements: a reference-to-array, which lists the ethnicity codes, and a
1503 reference-to-hash, which maps the ethnicity codes to ethnicity
1504 descriptions.
1505
1506 =cut
1507
1508 #'
1509
1510 sub ethnicitycategories {
1511     my $dbh = C4::Context->dbh;
1512     my $sth = $dbh->prepare("Select code,name from ethnicity order by name");
1513     $sth->execute;
1514     my %labels;
1515     my @codes;
1516     while ( my $data = $sth->fetchrow_hashref ) {
1517         push @codes, $data->{'code'};
1518         $labels{ $data->{'code'} } = $data->{'name'};
1519     }
1520     return ( \@codes, \%labels );
1521 }
1522
1523 =head2 fixEthnicity
1524
1525   $ethn_name = &fixEthnicity($ethn_code);
1526
1527 Takes an ethnicity code (e.g., "european" or "pi") and returns the
1528 corresponding descriptive name from the C<ethnicity> table in the
1529 Koha database ("European" or "Pacific Islander").
1530
1531 =cut
1532
1533 #'
1534
1535 sub fixEthnicity {
1536     my $ethnicity = shift;
1537     return unless $ethnicity;
1538     my $dbh       = C4::Context->dbh;
1539     my $sth       = $dbh->prepare("Select name from ethnicity where code = ?");
1540     $sth->execute($ethnicity);
1541     my $data = $sth->fetchrow_hashref;
1542     return $data->{'name'};
1543 }    # sub fixEthnicity
1544
1545 =head2 GetAge
1546
1547   $dateofbirth,$date = &GetAge($date);
1548
1549 this function return the borrowers age with the value of dateofbirth
1550
1551 =cut
1552
1553 #'
1554 sub GetAge{
1555     my ( $date, $date_ref ) = @_;
1556
1557     if ( not defined $date_ref ) {
1558         $date_ref = sprintf( '%04d-%02d-%02d', Today() );
1559     }
1560
1561     my ( $year1, $month1, $day1 ) = split /-/, $date;
1562     my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
1563
1564     my $age = $year2 - $year1;
1565     if ( $month1 . $day1 > $month2 . $day2 ) {
1566         $age--;
1567     }
1568
1569     return $age;
1570 }    # sub get_age
1571
1572 =head2 get_institutions
1573
1574   $insitutions = get_institutions();
1575
1576 Just returns a list of all the borrowers of type I, borrownumber and name
1577
1578 =cut
1579
1580 #'
1581 sub get_institutions {
1582     my $dbh = C4::Context->dbh();
1583     my $sth =
1584       $dbh->prepare(
1585 "SELECT borrowernumber,surname FROM borrowers WHERE categorycode=? ORDER BY surname"
1586       );
1587     $sth->execute('I');
1588     my %orgs;
1589     while ( my $data = $sth->fetchrow_hashref() ) {
1590         $orgs{ $data->{'borrowernumber'} } = $data;
1591     }
1592     return ( \%orgs );
1593
1594 }    # sub get_institutions
1595
1596 =head2 add_member_orgs
1597
1598   add_member_orgs($borrowernumber,$borrowernumbers);
1599
1600 Takes a borrowernumber and a list of other borrowernumbers and inserts them into the borrowers_to_borrowers table
1601
1602 =cut
1603
1604 #'
1605 sub add_member_orgs {
1606     my ( $borrowernumber, $otherborrowers ) = @_;
1607     my $dbh   = C4::Context->dbh();
1608     my $query =
1609       "INSERT INTO borrowers_to_borrowers (borrower1,borrower2) VALUES (?,?)";
1610     my $sth = $dbh->prepare($query);
1611     foreach my $otherborrowernumber (@$otherborrowers) {
1612         $sth->execute( $borrowernumber, $otherborrowernumber );
1613     }
1614
1615 }    # sub add_member_orgs
1616
1617 =head2 GetCities
1618
1619   $cityarrayref = GetCities();
1620
1621   Returns an array_ref of the entries in the cities table
1622   If there are entries in the table an empty row is returned
1623   This is currently only used to populate a popup in memberentry
1624
1625 =cut
1626
1627 sub GetCities {
1628
1629     my $dbh   = C4::Context->dbh;
1630     my $city_arr = $dbh->selectall_arrayref(
1631         q|SELECT cityid,city_zipcode,city_name FROM cities ORDER BY city_name|,
1632         { Slice => {} });
1633     if ( @{$city_arr} ) {
1634         unshift @{$city_arr}, {
1635             city_zipcode => q{},
1636             city_name    => q{},
1637             cityid       => q{},
1638         };
1639     }
1640
1641     return  $city_arr;
1642 }
1643
1644 =head2 GetSortDetails (OUEST-PROVENCE)
1645
1646   ($lib) = &GetSortDetails($category,$sortvalue);
1647
1648 Returns the authorized value  details
1649 C<&$lib>return value of authorized value details
1650 C<&$sortvalue>this is the value of authorized value
1651 C<&$category>this is the value of authorized value category
1652
1653 =cut
1654
1655 sub GetSortDetails {
1656     my ( $category, $sortvalue ) = @_;
1657     my $dbh   = C4::Context->dbh;
1658     my $query = qq|SELECT lib
1659         FROM authorised_values
1660         WHERE category=?
1661         AND authorised_value=? |;
1662     my $sth = $dbh->prepare($query);
1663     $sth->execute( $category, $sortvalue );
1664     my $lib = $sth->fetchrow;
1665     return ($lib) if ($lib);
1666     return ($sortvalue) unless ($lib);
1667 }
1668
1669 =head2 MoveMemberToDeleted
1670
1671   $result = &MoveMemberToDeleted($borrowernumber);
1672
1673 Copy the record from borrowers to deletedborrowers table.
1674
1675 =cut
1676
1677 # FIXME: should do it in one SQL statement w/ subquery
1678 # Otherwise, we should return the @data on success
1679
1680 sub MoveMemberToDeleted {
1681     my ($member) = shift or return;
1682     my $dbh = C4::Context->dbh;
1683     my $query = qq|SELECT *
1684           FROM borrowers
1685           WHERE borrowernumber=?|;
1686     my $sth = $dbh->prepare($query);
1687     $sth->execute($member);
1688     my @data = $sth->fetchrow_array;
1689     (@data) or return;  # if we got a bad borrowernumber, there's nothing to insert
1690     $sth =
1691       $dbh->prepare( "INSERT INTO deletedborrowers VALUES ("
1692           . ( "?," x ( scalar(@data) - 1 ) )
1693           . "?)" );
1694     $sth->execute(@data);
1695 }
1696
1697 =head2 DelMember
1698
1699     DelMember($borrowernumber);
1700
1701 This function remove directly a borrower whitout writing it on deleteborrower.
1702 + Deletes reserves for the borrower
1703
1704 =cut
1705
1706 sub DelMember {
1707     my $dbh            = C4::Context->dbh;
1708     my $borrowernumber = shift;
1709     #warn "in delmember with $borrowernumber";
1710     return unless $borrowernumber;    # borrowernumber is mandatory.
1711
1712     my $query = qq|DELETE
1713           FROM  reserves
1714           WHERE borrowernumber=?|;
1715     my $sth = $dbh->prepare($query);
1716     $sth->execute($borrowernumber);
1717     $query = "
1718        DELETE
1719        FROM borrowers
1720        WHERE borrowernumber = ?
1721    ";
1722     $sth = $dbh->prepare($query);
1723     $sth->execute($borrowernumber);
1724     logaction("MEMBERS", "DELETE", $borrowernumber, "") if C4::Context->preference("BorrowersLog");
1725     return $sth->rows;
1726 }
1727
1728 =head2 ExtendMemberSubscriptionTo (OUEST-PROVENCE)
1729
1730     $date = ExtendMemberSubscriptionTo($borrowerid, $date);
1731
1732 Extending the subscription to a given date or to the expiry date calculated on ISO date.
1733 Returns ISO date.
1734
1735 =cut
1736
1737 sub ExtendMemberSubscriptionTo {
1738     my ( $borrowerid,$date) = @_;
1739     my $dbh = C4::Context->dbh;
1740     my $borrower = GetMember('borrowernumber'=>$borrowerid);
1741     unless ($date){
1742       $date=POSIX::strftime("%Y-%m-%d",localtime());
1743       $date = GetExpiryDate( $borrower->{'categorycode'}, $date );
1744     }
1745     my $sth = $dbh->do(<<EOF);
1746 UPDATE borrowers
1747 SET  dateexpiry='$date'
1748 WHERE borrowernumber='$borrowerid'
1749 EOF
1750     # add enrolmentfee if needed
1751     $sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
1752     $sth->execute($borrower->{'categorycode'});
1753     my ($enrolmentfee) = $sth->fetchrow;
1754     if ($enrolmentfee && $enrolmentfee > 0) {
1755         # insert fee in patron debts
1756         manualinvoice($borrower->{'borrowernumber'}, '', '', 'A', $enrolmentfee);
1757     }
1758     return $date if ($sth);
1759     return 0;
1760 }
1761
1762 =head2 GetRoadTypes (OUEST-PROVENCE)
1763
1764   ($idroadtypearrayref, $roadttype_hashref) = &GetRoadTypes();
1765
1766 Looks up the different road type . Returns two
1767 elements: a reference-to-array, which lists the id_roadtype
1768 codes, and a reference-to-hash, which maps the road type of the road .
1769
1770 =cut
1771
1772 sub GetRoadTypes {
1773     my $dbh   = C4::Context->dbh;
1774     my $query = qq|
1775 SELECT roadtypeid,road_type
1776 FROM roadtype
1777 ORDER BY road_type|;
1778     my $sth = $dbh->prepare($query);
1779     $sth->execute();
1780     my %roadtype;
1781     my @id;
1782
1783     #    insert empty value to create a empty choice in cgi popup
1784
1785     while ( my $data = $sth->fetchrow_hashref ) {
1786
1787         push @id, $data->{'roadtypeid'};
1788         $roadtype{ $data->{'roadtypeid'} } = $data->{'road_type'};
1789     }
1790
1791 #test to know if the table contain some records if no the function return nothing
1792     my $id = @id;
1793     if ( $id eq 0 ) {
1794         return ();
1795     }
1796     else {
1797         unshift( @id, "" );
1798         return ( \@id, \%roadtype );
1799     }
1800 }
1801
1802
1803
1804 =head2 GetTitles (OUEST-PROVENCE)
1805
1806   ($borrowertitle)= &GetTitles();
1807
1808 Looks up the different title . Returns array  with all borrowers title
1809
1810 =cut
1811
1812 sub GetTitles {
1813     my @borrowerTitle = split (/,|\|/,C4::Context->preference('BorrowersTitles'));
1814     unshift( @borrowerTitle, "" );
1815     my $count=@borrowerTitle;
1816     if ($count == 1){
1817         return ();
1818     }
1819     else {
1820         return ( \@borrowerTitle);
1821     }
1822 }
1823
1824 =head2 GetPatronImage
1825
1826     my ($imagedata, $dberror) = GetPatronImage($cardnumber);
1827
1828 Returns the mimetype and binary image data of the image for the patron with the supplied cardnumber.
1829
1830 =cut
1831
1832 sub GetPatronImage {
1833     my ($cardnumber) = @_;
1834     warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1835     my $dbh = C4::Context->dbh;
1836     my $query = 'SELECT mimetype, imagefile FROM patronimage WHERE cardnumber = ?';
1837     my $sth = $dbh->prepare($query);
1838     $sth->execute($cardnumber);
1839     my $imagedata = $sth->fetchrow_hashref;
1840     warn "Database error!" if $sth->errstr;
1841     return $imagedata, $sth->errstr;
1842 }
1843
1844 =head2 PutPatronImage
1845
1846     PutPatronImage($cardnumber, $mimetype, $imgfile);
1847
1848 Stores patron binary image data and mimetype in database.
1849 NOTE: This function is good for updating images as well as inserting new images in the database.
1850
1851 =cut
1852
1853 sub PutPatronImage {
1854     my ($cardnumber, $mimetype, $imgfile) = @_;
1855     warn "Parameters passed in: Cardnumber=$cardnumber, Mimetype=$mimetype, " . ($imgfile ? "Imagefile" : "No Imagefile") if $debug;
1856     my $dbh = C4::Context->dbh;
1857     my $query = "INSERT INTO patronimage (cardnumber, mimetype, imagefile) VALUES (?,?,?) ON DUPLICATE KEY UPDATE imagefile = ?;";
1858     my $sth = $dbh->prepare($query);
1859     $sth->execute($cardnumber,$mimetype,$imgfile,$imgfile);
1860     warn "Error returned inserting $cardnumber.$mimetype." if $sth->errstr;
1861     return $sth->errstr;
1862 }
1863
1864 =head2 RmPatronImage
1865
1866     my ($dberror) = RmPatronImage($cardnumber);
1867
1868 Removes the image for the patron with the supplied cardnumber.
1869
1870 =cut
1871
1872 sub RmPatronImage {
1873     my ($cardnumber) = @_;
1874     warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1875     my $dbh = C4::Context->dbh;
1876     my $query = "DELETE FROM patronimage WHERE cardnumber = ?;";
1877     my $sth = $dbh->prepare($query);
1878     $sth->execute($cardnumber);
1879     my $dberror = $sth->errstr;
1880     warn "Database error!" if $sth->errstr;
1881     return $dberror;
1882 }
1883
1884 =head2 GetHideLostItemsPreference
1885
1886   $hidelostitemspref = &GetHideLostItemsPreference($borrowernumber);
1887
1888 Returns the HideLostItems preference for the patron category of the supplied borrowernumber
1889 C<&$hidelostitemspref>return value of function, 0 or 1
1890
1891 =cut
1892
1893 sub GetHideLostItemsPreference {
1894     my ($borrowernumber) = @_;
1895     my $dbh = C4::Context->dbh;
1896     my $query = "SELECT hidelostitems FROM borrowers,categories WHERE borrowers.categorycode = categories.categorycode AND borrowernumber = ?";
1897     my $sth = $dbh->prepare($query);
1898     $sth->execute($borrowernumber);
1899     my $hidelostitems = $sth->fetchrow;
1900     return $hidelostitems;
1901 }
1902
1903 =head2 GetRoadTypeDetails (OUEST-PROVENCE)
1904
1905   ($roadtype) = &GetRoadTypeDetails($roadtypeid);
1906
1907 Returns the description of roadtype
1908 C<&$roadtype>return description of road type
1909 C<&$roadtypeid>this is the value of roadtype s
1910
1911 =cut
1912
1913 sub GetRoadTypeDetails {
1914     my ($roadtypeid) = @_;
1915     my $dbh          = C4::Context->dbh;
1916     my $query        = qq|
1917 SELECT road_type
1918 FROM roadtype
1919 WHERE roadtypeid=?|;
1920     my $sth = $dbh->prepare($query);
1921     $sth->execute($roadtypeid);
1922     my $roadtype = $sth->fetchrow;
1923     return ($roadtype);
1924 }
1925
1926 =head2 GetBorrowersWhoHaveNotBorrowedSince
1927
1928   &GetBorrowersWhoHaveNotBorrowedSince($date)
1929
1930 this function get all borrowers who haven't borrowed since the date given on input arg.
1931
1932 =cut
1933
1934 sub GetBorrowersWhoHaveNotBorrowedSince {
1935     my $filterdate = shift||POSIX::strftime("%Y-%m-%d",localtime());
1936     my $filterexpiry = shift;
1937     my $filterbranch = shift ||
1938                         ((C4::Context->preference('IndependantBranches')
1939                              && C4::Context->userenv
1940                              && C4::Context->userenv->{flags} % 2 !=1
1941                              && C4::Context->userenv->{branch})
1942                          ? C4::Context->userenv->{branch}
1943                          : "");
1944     my $dbh   = C4::Context->dbh;
1945     my $query = "
1946         SELECT borrowers.borrowernumber,
1947                max(old_issues.timestamp) as latestissue,
1948                max(issues.timestamp) as currentissue
1949         FROM   borrowers
1950         JOIN   categories USING (categorycode)
1951         LEFT JOIN old_issues USING (borrowernumber)
1952         LEFT JOIN issues USING (borrowernumber)
1953         WHERE  category_type <> 'S'
1954         AND borrowernumber NOT IN (SELECT guarantorid FROM borrowers WHERE guarantorid IS NOT NULL AND guarantorid <> 0)
1955    ";
1956     my @query_params;
1957     if ($filterbranch && $filterbranch ne ""){
1958         $query.=" AND borrowers.branchcode= ?";
1959         push @query_params,$filterbranch;
1960     }
1961     if($filterexpiry){
1962         $query .= " AND dateexpiry < ? ";
1963         push @query_params,$filterdate;
1964     }
1965     $query.=" GROUP BY borrowers.borrowernumber";
1966     if ($filterdate){
1967         $query.=" HAVING (latestissue < ? OR latestissue IS NULL)
1968                   AND currentissue IS NULL";
1969         push @query_params,$filterdate;
1970     }
1971     warn $query if $debug;
1972     my $sth = $dbh->prepare($query);
1973     if (scalar(@query_params)>0){
1974         $sth->execute(@query_params);
1975     }
1976     else {
1977         $sth->execute;
1978     }
1979
1980     my @results;
1981     while ( my $data = $sth->fetchrow_hashref ) {
1982         push @results, $data;
1983     }
1984     return \@results;
1985 }
1986
1987 =head2 GetBorrowersWhoHaveNeverBorrowed
1988
1989   $results = &GetBorrowersWhoHaveNeverBorrowed
1990
1991 This function get all borrowers who have never borrowed.
1992
1993 I<$result> is a ref to an array which all elements are a hasref.
1994
1995 =cut
1996
1997 sub GetBorrowersWhoHaveNeverBorrowed {
1998     my $filterbranch = shift ||
1999                         ((C4::Context->preference('IndependantBranches')
2000                              && C4::Context->userenv
2001                              && C4::Context->userenv->{flags} % 2 !=1
2002                              && C4::Context->userenv->{branch})
2003                          ? C4::Context->userenv->{branch}
2004                          : "");
2005     my $dbh   = C4::Context->dbh;
2006     my $query = "
2007         SELECT borrowers.borrowernumber,max(timestamp) as latestissue
2008         FROM   borrowers
2009           LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
2010         WHERE issues.borrowernumber IS NULL
2011    ";
2012     my @query_params;
2013     if ($filterbranch && $filterbranch ne ""){
2014         $query.=" AND borrowers.branchcode= ?";
2015         push @query_params,$filterbranch;
2016     }
2017     warn $query if $debug;
2018
2019     my $sth = $dbh->prepare($query);
2020     if (scalar(@query_params)>0){
2021         $sth->execute(@query_params);
2022     }
2023     else {
2024         $sth->execute;
2025     }
2026
2027     my @results;
2028     while ( my $data = $sth->fetchrow_hashref ) {
2029         push @results, $data;
2030     }
2031     return \@results;
2032 }
2033
2034 =head2 GetBorrowersWithIssuesHistoryOlderThan
2035
2036   $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
2037
2038 this function get all borrowers who has an issue history older than I<$date> given on input arg.
2039
2040 I<$result> is a ref to an array which all elements are a hashref.
2041 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2042
2043 =cut
2044
2045 sub GetBorrowersWithIssuesHistoryOlderThan {
2046     my $dbh  = C4::Context->dbh;
2047     my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
2048     my $filterbranch = shift ||
2049                         ((C4::Context->preference('IndependantBranches')
2050                              && C4::Context->userenv
2051                              && C4::Context->userenv->{flags} % 2 !=1
2052                              && C4::Context->userenv->{branch})
2053                          ? C4::Context->userenv->{branch}
2054                          : "");
2055     my $query = "
2056        SELECT count(borrowernumber) as n,borrowernumber
2057        FROM old_issues
2058        WHERE returndate < ?
2059          AND borrowernumber IS NOT NULL
2060     ";
2061     my @query_params;
2062     push @query_params, $date;
2063     if ($filterbranch){
2064         $query.="   AND branchcode = ?";
2065         push @query_params, $filterbranch;
2066     }
2067     $query.=" GROUP BY borrowernumber ";
2068     warn $query if $debug;
2069     my $sth = $dbh->prepare($query);
2070     $sth->execute(@query_params);
2071     my @results;
2072
2073     while ( my $data = $sth->fetchrow_hashref ) {
2074         push @results, $data;
2075     }
2076     return \@results;
2077 }
2078
2079 =head2 GetBorrowersNamesAndLatestIssue
2080
2081   $results = &GetBorrowersNamesAndLatestIssueList(@borrowernumbers)
2082
2083 this function get borrowers Names and surnames and Issue information.
2084
2085 I<@borrowernumbers> is an array which all elements are borrowernumbers.
2086 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2087
2088 =cut
2089
2090 sub GetBorrowersNamesAndLatestIssue {
2091     my $dbh  = C4::Context->dbh;
2092     my @borrowernumbers=@_;
2093     my $query = "
2094        SELECT surname,lastname, phone, email,max(timestamp)
2095        FROM borrowers
2096          LEFT JOIN issues ON borrowers.borrowernumber=issues.borrowernumber
2097        GROUP BY borrowernumber
2098    ";
2099     my $sth = $dbh->prepare($query);
2100     $sth->execute;
2101     my $results = $sth->fetchall_arrayref({});
2102     return $results;
2103 }
2104
2105 =head2 DebarMember
2106
2107   my $success = DebarMember( $borrowernumber );
2108
2109 marks a Member as debarred, and therefore unable to checkout any more
2110 items.
2111
2112 return :
2113 true on success, false on failure
2114
2115 =cut
2116
2117 sub DebarMember {
2118     my $borrowernumber = shift;
2119
2120     return unless defined $borrowernumber;
2121     return unless $borrowernumber =~ /^\d+$/;
2122
2123     return ModMember( borrowernumber => $borrowernumber,
2124                       debarred       => 1 );
2125
2126 }
2127
2128 =head2 ModPrivacy
2129
2130 =over 4
2131
2132 my $success = ModPrivacy( $borrowernumber, $privacy );
2133
2134 Update the privacy of a patron.
2135
2136 return :
2137 true on success, false on failure
2138
2139 =back
2140
2141 =cut
2142
2143 sub ModPrivacy {
2144     my $borrowernumber = shift;
2145     my $privacy = shift;
2146     return unless defined $borrowernumber;
2147     return unless $borrowernumber =~ /^\d+$/;
2148
2149     return ModMember( borrowernumber => $borrowernumber,
2150                       privacy        => $privacy );
2151 }
2152
2153 =head2 AddMessage
2154
2155   AddMessage( $borrowernumber, $message_type, $message, $branchcode );
2156
2157 Adds a message to the messages table for the given borrower.
2158
2159 Returns:
2160   True on success
2161   False on failure
2162
2163 =cut
2164
2165 sub AddMessage {
2166     my ( $borrowernumber, $message_type, $message, $branchcode ) = @_;
2167
2168     my $dbh  = C4::Context->dbh;
2169
2170     if ( ! ( $borrowernumber && $message_type && $message && $branchcode ) ) {
2171       return;
2172     }
2173
2174     my $query = "INSERT INTO messages ( borrowernumber, branchcode, message_type, message ) VALUES ( ?, ?, ?, ? )";
2175     my $sth = $dbh->prepare($query);
2176     $sth->execute( $borrowernumber, $branchcode, $message_type, $message );
2177
2178     return 1;
2179 }
2180
2181 =head2 GetMessages
2182
2183   GetMessages( $borrowernumber, $type );
2184
2185 $type is message type, B for borrower, or L for Librarian.
2186 Empty type returns all messages of any type.
2187
2188 Returns all messages for the given borrowernumber
2189
2190 =cut
2191
2192 sub GetMessages {
2193     my ( $borrowernumber, $type, $branchcode ) = @_;
2194
2195     if ( ! $type ) {
2196       $type = '%';
2197     }
2198
2199     my $dbh  = C4::Context->dbh;
2200
2201     my $query = "SELECT
2202                   branches.branchname,
2203                   messages.*,
2204                   message_date,
2205                   messages.branchcode LIKE '$branchcode' AS can_delete
2206                   FROM messages, branches
2207                   WHERE borrowernumber = ?
2208                   AND message_type LIKE ?
2209                   AND messages.branchcode = branches.branchcode
2210                   ORDER BY message_date DESC";
2211     my $sth = $dbh->prepare($query);
2212     $sth->execute( $borrowernumber, $type ) ;
2213     my @results;
2214
2215     while ( my $data = $sth->fetchrow_hashref ) {
2216         my $d = C4::Dates->new( $data->{message_date}, 'iso' );
2217         $data->{message_date_formatted} = $d->output;
2218         push @results, $data;
2219     }
2220     return \@results;
2221
2222 }
2223
2224 =head2 GetMessages
2225
2226   GetMessagesCount( $borrowernumber, $type );
2227
2228 $type is message type, B for borrower, or L for Librarian.
2229 Empty type returns all messages of any type.
2230
2231 Returns the number of messages for the given borrowernumber
2232
2233 =cut
2234
2235 sub GetMessagesCount {
2236     my ( $borrowernumber, $type, $branchcode ) = @_;
2237
2238     if ( ! $type ) {
2239       $type = '%';
2240     }
2241
2242     my $dbh  = C4::Context->dbh;
2243
2244     my $query = "SELECT COUNT(*) as MsgCount FROM messages WHERE borrowernumber = ? AND message_type LIKE ?";
2245     my $sth = $dbh->prepare($query);
2246     $sth->execute( $borrowernumber, $type ) ;
2247     my @results;
2248
2249     my $data = $sth->fetchrow_hashref;
2250     my $count = $data->{'MsgCount'};
2251
2252     return $count;
2253 }
2254
2255
2256
2257 =head2 DeleteMessage
2258
2259   DeleteMessage( $message_id );
2260
2261 =cut
2262
2263 sub DeleteMessage {
2264     my ( $message_id ) = @_;
2265
2266     my $dbh = C4::Context->dbh;
2267
2268     my $query = "DELETE FROM messages WHERE message_id = ?";
2269     my $sth = $dbh->prepare($query);
2270     $sth->execute( $message_id );
2271
2272 }
2273
2274 END { }    # module clean-up code here (global destructor)
2275
2276 1;
2277
2278 __END__
2279
2280 =head1 AUTHOR
2281
2282 Koha Team
2283
2284 =cut