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