C4/Members.pm

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