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