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