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