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") || 0;
1497     my $dateexpiry = output_pref({ dt => (dt_from_string()->add( days => $days)), dateformat => 'iso', dateonly => 1 });
1498
1499     my $query = "
1500         SELECT borrowers.*, categories.description,
1501         branches.branchname, branches.branchemail FROM borrowers
1502         LEFT JOIN branches on borrowers.branchcode = branches.branchcode
1503         LEFT JOIN categories on borrowers.categorycode = categories.categorycode
1504         WHERE dateexpiry = ?;
1505     ";
1506     my $sth = $dbh->prepare($query);
1507     $sth->execute($dateexpiry);
1508     my $results = $sth->fetchall_arrayref({});
1509     return $results;
1510 }
1511
1512 =head2 GetborCatFromCatType
1513
1514   ($codes_arrayref, $labels_hashref) = &GetborCatFromCatType();
1515
1516 Looks up the different types of borrowers in the database. Returns two
1517 elements: a reference-to-array, which lists the borrower category
1518 codes, and a reference-to-hash, which maps the borrower category codes
1519 to category descriptions.
1520
1521 =cut
1522
1523 #'
1524 sub GetborCatFromCatType {
1525     my ( $category_type, $action, $no_branch_limit ) = @_;
1526
1527     my $branch_limit = $no_branch_limit
1528         ? 0
1529         : C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1530
1531     # FIXME - This API  seems both limited and dangerous.
1532     my $dbh     = C4::Context->dbh;
1533
1534     my $request = qq{
1535         SELECT categories.categorycode, categories.description
1536         FROM categories
1537     };
1538     $request .= qq{
1539         LEFT JOIN categories_branches ON categories.categorycode = categories_branches.categorycode
1540     } if $branch_limit;
1541     if($action) {
1542         $request .= " $action ";
1543         $request .= " AND (branchcode = ? OR branchcode IS NULL) GROUP BY description" if $branch_limit;
1544     } else {
1545         $request .= " WHERE branchcode = ? OR branchcode IS NULL GROUP BY description" if $branch_limit;
1546     }
1547     $request .= " ORDER BY categorycode";
1548
1549     my $sth = $dbh->prepare($request);
1550     $sth->execute(
1551         $action ? $category_type : (),
1552         $branch_limit ? $branch_limit : ()
1553     );
1554
1555     my %labels;
1556     my @codes;
1557
1558     while ( my $data = $sth->fetchrow_hashref ) {
1559         push @codes, $data->{'categorycode'};
1560         $labels{ $data->{'categorycode'} } = $data->{'description'};
1561     }
1562     $sth->finish;
1563     return ( \@codes, \%labels );
1564 }
1565
1566 =head2 GetBorrowercategory
1567
1568   $hashref = &GetBorrowercategory($categorycode);
1569
1570 Given the borrower's category code, the function returns the corresponding
1571 data hashref for a comprehensive information display.
1572
1573 =cut
1574
1575 sub GetBorrowercategory {
1576     my ($catcode) = @_;
1577     my $dbh       = C4::Context->dbh;
1578     if ($catcode){
1579         my $sth       =
1580         $dbh->prepare(
1581     "SELECT description,dateofbirthrequired,upperagelimit,category_type
1582     FROM categories
1583     WHERE categorycode = ?"
1584         );
1585         $sth->execute($catcode);
1586         my $data =
1587         $sth->fetchrow_hashref;
1588         return $data;
1589     }
1590     return;
1591 }    # sub getborrowercategory
1592
1593
1594 =head2 GetBorrowerCategorycode
1595
1596     $categorycode = &GetBorrowerCategoryCode( $borrowernumber );
1597
1598 Given the borrowernumber, the function returns the corresponding categorycode
1599
1600 =cut
1601
1602 sub GetBorrowerCategorycode {
1603     my ( $borrowernumber ) = @_;
1604     my $dbh = C4::Context->dbh;
1605     my $sth = $dbh->prepare( qq{
1606         SELECT categorycode
1607         FROM borrowers
1608         WHERE borrowernumber = ?
1609     } );
1610     $sth->execute( $borrowernumber );
1611     return $sth->fetchrow;
1612 }
1613
1614 =head2 GetBorrowercategoryList
1615
1616   $arrayref_hashref = &GetBorrowercategoryList;
1617 If no category code provided, the function returns all the categories.
1618
1619 =cut
1620
1621 sub GetBorrowercategoryList {
1622     my $no_branch_limit = @_ ? shift : 0;
1623     my $branch_limit = $no_branch_limit
1624         ? 0
1625         : C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1626     my $dbh       = C4::Context->dbh;
1627     my $query = "SELECT categories.* FROM categories";
1628     $query .= qq{
1629         LEFT JOIN categories_branches ON categories.categorycode = categories_branches.categorycode
1630         WHERE branchcode = ? OR branchcode IS NULL GROUP BY description
1631     } if $branch_limit;
1632     $query .= " ORDER BY description";
1633     my $sth = $dbh->prepare( $query );
1634     $sth->execute( $branch_limit ? $branch_limit : () );
1635     my $data = $sth->fetchall_arrayref( {} );
1636     $sth->finish;
1637     return $data;
1638 }    # sub getborrowercategory
1639
1640 =head2 GetAge
1641
1642   $dateofbirth,$date = &GetAge($date);
1643
1644 this function return the borrowers age with the value of dateofbirth
1645
1646 =cut
1647
1648 #'
1649 sub GetAge{
1650     my ( $date, $date_ref ) = @_;
1651
1652     if ( not defined $date_ref ) {
1653         $date_ref = sprintf( '%04d-%02d-%02d', Today() );
1654     }
1655
1656     my ( $year1, $month1, $day1 ) = split /-/, $date;
1657     my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
1658
1659     my $age = $year2 - $year1;
1660     if ( $month1 . $day1 > $month2 . $day2 ) {
1661         $age--;
1662     }
1663
1664     return $age;
1665 }    # sub get_age
1666
1667 =head2 SetAge
1668
1669   $borrower = C4::Members::SetAge($borrower, $datetimeduration);
1670   $borrower = C4::Members::SetAge($borrower, '0015-12-10');
1671   $borrower = C4::Members::SetAge($borrower, $datetimeduration, $datetime_reference);
1672
1673   eval { $borrower = C4::Members::SetAge($borrower, '015-1-10'); };
1674   if ($@) {print $@;} #Catch a bad ISO Date or kill your script!
1675
1676 This function sets the borrower's dateofbirth to match the given age.
1677 Optionally relative to the given $datetime_reference.
1678
1679 @PARAM1 koha.borrowers-object
1680 @PARAM2 DateTime::Duration-object as the desired age
1681         OR a ISO 8601 Date. (To make the API more pleasant)
1682 @PARAM3 DateTime-object as the relative date, defaults to now().
1683 RETURNS The given borrower reference @PARAM1.
1684 DIES    If there was an error with the ISO Date handling.
1685
1686 =cut
1687
1688 #'
1689 sub SetAge{
1690     my ( $borrower, $datetimeduration, $datetime_ref ) = @_;
1691     $datetime_ref = DateTime->now() unless $datetime_ref;
1692
1693     if ($datetimeduration && ref $datetimeduration ne 'DateTime::Duration') {
1694         if ($datetimeduration =~ /^(\d{4})-(\d{2})-(\d{2})/) {
1695             $datetimeduration = DateTime::Duration->new(years => $1, months => $2, days => $3);
1696         }
1697         else {
1698             die "C4::Members::SetAge($borrower, $datetimeduration), datetimeduration not a valid ISO 8601 Date!\n";
1699         }
1700     }
1701
1702     my $new_datetime_ref = $datetime_ref->clone();
1703     $new_datetime_ref->subtract_duration( $datetimeduration );
1704
1705     $borrower->{dateofbirth} = $new_datetime_ref->ymd();
1706
1707     return $borrower;
1708 }    # sub SetAge
1709
1710 =head2 GetCities
1711
1712   $cityarrayref = GetCities();
1713
1714   Returns an array_ref of the entries in the cities table
1715   If there are entries in the table an empty row is returned
1716   This is currently only used to populate a popup in memberentry
1717
1718 =cut
1719
1720 sub GetCities {
1721
1722     my $dbh   = C4::Context->dbh;
1723     my $city_arr = $dbh->selectall_arrayref(
1724         q|SELECT cityid,city_zipcode,city_name,city_state,city_country FROM cities ORDER BY city_name|,
1725         { Slice => {} });
1726     if ( @{$city_arr} ) {
1727         unshift @{$city_arr}, {
1728             city_zipcode => q{},
1729             city_name    => q{},
1730             cityid       => q{},
1731             city_state   => q{},
1732             city_country => q{},
1733         };
1734     }
1735
1736     return  $city_arr;
1737 }
1738
1739 =head2 GetSortDetails (OUEST-PROVENCE)
1740
1741   ($lib) = &GetSortDetails($category,$sortvalue);
1742
1743 Returns the authorized value  details
1744 C<&$lib>return value of authorized value details
1745 C<&$sortvalue>this is the value of authorized value
1746 C<&$category>this is the value of authorized value category
1747
1748 =cut
1749
1750 sub GetSortDetails {
1751     my ( $category, $sortvalue ) = @_;
1752     my $dbh   = C4::Context->dbh;
1753     my $query = qq|SELECT lib
1754         FROM authorised_values
1755         WHERE category=?
1756         AND authorised_value=? |;
1757     my $sth = $dbh->prepare($query);
1758     $sth->execute( $category, $sortvalue );
1759     my $lib = $sth->fetchrow;
1760     return ($lib) if ($lib);
1761     return ($sortvalue) unless ($lib);
1762 }
1763
1764 =head2 MoveMemberToDeleted
1765
1766   $result = &MoveMemberToDeleted($borrowernumber);
1767
1768 Copy the record from borrowers to deletedborrowers table.
1769 The routine returns 1 for success, undef for failure.
1770
1771 =cut
1772
1773 sub MoveMemberToDeleted {
1774     my ($member) = shift or return;
1775
1776     my $schema       = Koha::Database->new()->schema();
1777     my $borrowers_rs = $schema->resultset('Borrower');
1778     $borrowers_rs->result_class('DBIx::Class::ResultClass::HashRefInflator');
1779     my $borrower = $borrowers_rs->find($member);
1780     return unless $borrower;
1781
1782     my $deleted = $schema->resultset('Deletedborrower')->create($borrower);
1783
1784     return $deleted ? 1 : undef;
1785 }
1786
1787 =head2 DelMember
1788
1789     DelMember($borrowernumber);
1790
1791 This function remove directly a borrower whitout writing it on deleteborrower.
1792 + Deletes reserves for the borrower
1793
1794 =cut
1795
1796 sub DelMember {
1797     my $dbh            = C4::Context->dbh;
1798     my $borrowernumber = shift;
1799     #warn "in delmember with $borrowernumber";
1800     return unless $borrowernumber;    # borrowernumber is mandatory.
1801
1802     my $query = qq|DELETE
1803           FROM  reserves
1804           WHERE borrowernumber=?|;
1805     my $sth = $dbh->prepare($query);
1806     $sth->execute($borrowernumber);
1807     $query = "
1808        DELETE
1809        FROM borrowers
1810        WHERE borrowernumber = ?
1811    ";
1812     $sth = $dbh->prepare($query);
1813     $sth->execute($borrowernumber);
1814     logaction("MEMBERS", "DELETE", $borrowernumber, "") if C4::Context->preference("BorrowersLog");
1815     return $sth->rows;
1816 }
1817
1818 =head2 ExtendMemberSubscriptionTo (OUEST-PROVENCE)
1819
1820     $date = ExtendMemberSubscriptionTo($borrowerid, $date);
1821
1822 Extending the subscription to a given date or to the expiry date calculated on ISO date.
1823 Returns ISO date.
1824
1825 =cut
1826
1827 sub ExtendMemberSubscriptionTo {
1828     my ( $borrowerid,$date) = @_;
1829     my $dbh = C4::Context->dbh;
1830     my $borrower = GetMember('borrowernumber'=>$borrowerid);
1831     unless ($date){
1832       $date = (C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry') ?
1833                                         C4::Dates->new($borrower->{'dateexpiry'}, 'iso')->output("iso") :
1834                                         C4::Dates->new()->output("iso");
1835       $date = GetExpiryDate( $borrower->{'categorycode'}, $date );
1836     }
1837     my $sth = $dbh->do(<<EOF);
1838 UPDATE borrowers
1839 SET  dateexpiry='$date'
1840 WHERE borrowernumber='$borrowerid'
1841 EOF
1842
1843     AddEnrolmentFeeIfNeeded( $borrower->{categorycode}, $borrower->{borrowernumber} );
1844
1845     logaction("MEMBERS", "RENEW", $borrower->{'borrowernumber'}, "Membership renewed")if C4::Context->preference("BorrowersLog");
1846     return $date if ($sth);
1847     return 0;
1848 }
1849
1850 =head2 GetTitles (OUEST-PROVENCE)
1851
1852   ($borrowertitle)= &GetTitles();
1853
1854 Looks up the different title . Returns array  with all borrowers title
1855
1856 =cut
1857
1858 sub GetTitles {
1859     my @borrowerTitle = split (/,|\|/,C4::Context->preference('BorrowersTitles'));
1860     unshift( @borrowerTitle, "" );
1861     my $count=@borrowerTitle;
1862     if ($count == 1){
1863         return ();
1864     }
1865     else {
1866         return ( \@borrowerTitle);
1867     }
1868 }
1869
1870 =head2 GetPatronImage
1871
1872     my ($imagedata, $dberror) = GetPatronImage($borrowernumber);
1873
1874 Returns the mimetype and binary image data of the image for the patron with the supplied borrowernumber.
1875
1876 =cut
1877
1878 sub GetPatronImage {
1879     my ($borrowernumber) = @_;
1880     warn "Borrowernumber passed to GetPatronImage is $borrowernumber" if $debug;
1881     my $dbh = C4::Context->dbh;
1882     my $query = 'SELECT mimetype, imagefile FROM patronimage WHERE borrowernumber = ?';
1883     my $sth = $dbh->prepare($query);
1884     $sth->execute($borrowernumber);
1885     my $imagedata = $sth->fetchrow_hashref;
1886     warn "Database error!" if $sth->errstr;
1887     return $imagedata, $sth->errstr;
1888 }
1889
1890 =head2 PutPatronImage
1891
1892     PutPatronImage($cardnumber, $mimetype, $imgfile);
1893
1894 Stores patron binary image data and mimetype in database.
1895 NOTE: This function is good for updating images as well as inserting new images in the database.
1896
1897 =cut
1898
1899 sub PutPatronImage {
1900     my ($cardnumber, $mimetype, $imgfile) = @_;
1901     warn "Parameters passed in: Cardnumber=$cardnumber, Mimetype=$mimetype, " . ($imgfile ? "Imagefile" : "No Imagefile") if $debug;
1902     my $dbh = C4::Context->dbh;
1903     my $query = "INSERT INTO patronimage (borrowernumber, mimetype, imagefile) VALUES ( ( SELECT borrowernumber from borrowers WHERE cardnumber = ? ),?,?) ON DUPLICATE KEY UPDATE imagefile = ?;";
1904     my $sth = $dbh->prepare($query);
1905     $sth->execute($cardnumber,$mimetype,$imgfile,$imgfile);
1906     warn "Error returned inserting $cardnumber.$mimetype." if $sth->errstr;
1907     return $sth->errstr;
1908 }
1909
1910 =head2 RmPatronImage
1911
1912     my ($dberror) = RmPatronImage($borrowernumber);
1913
1914 Removes the image for the patron with the supplied borrowernumber.
1915
1916 =cut
1917
1918 sub RmPatronImage {
1919     my ($borrowernumber) = @_;
1920     warn "Borrowernumber passed to GetPatronImage is $borrowernumber" if $debug;
1921     my $dbh = C4::Context->dbh;
1922     my $query = "DELETE FROM patronimage WHERE borrowernumber = ?;";
1923     my $sth = $dbh->prepare($query);
1924     $sth->execute($borrowernumber);
1925     my $dberror = $sth->errstr;
1926     warn "Database error!" if $sth->errstr;
1927     return $dberror;
1928 }
1929
1930 =head2 GetHideLostItemsPreference
1931
1932   $hidelostitemspref = &GetHideLostItemsPreference($borrowernumber);
1933
1934 Returns the HideLostItems preference for the patron category of the supplied borrowernumber
1935 C<&$hidelostitemspref>return value of function, 0 or 1
1936
1937 =cut
1938
1939 sub GetHideLostItemsPreference {
1940     my ($borrowernumber) = @_;
1941     my $dbh = C4::Context->dbh;
1942     my $query = "SELECT hidelostitems FROM borrowers,categories WHERE borrowers.categorycode = categories.categorycode AND borrowernumber = ?";
1943     my $sth = $dbh->prepare($query);
1944     $sth->execute($borrowernumber);
1945     my $hidelostitems = $sth->fetchrow;
1946     return $hidelostitems;
1947 }
1948
1949 =head2 GetBorrowersToExpunge
1950
1951   $borrowers = &GetBorrowersToExpunge(
1952       not_borrowered_since => $not_borrowered_since,
1953       expired_before       => $expired_before,
1954       category_code        => $category_code,
1955       branchcode           => $branchcode
1956   );
1957
1958   This function get all borrowers based on the given criteria.
1959
1960 =cut
1961
1962 sub GetBorrowersToExpunge {
1963     my $params = shift;
1964
1965     my $filterdate     = $params->{'not_borrowered_since'};
1966     my $filterexpiry   = $params->{'expired_before'};
1967     my $filtercategory = $params->{'category_code'};
1968     my $filterbranch   = $params->{'branchcode'} ||
1969                         ((C4::Context->preference('IndependentBranches')
1970                              && C4::Context->userenv
1971                              && !C4::Context->IsSuperLibrarian()
1972                              && C4::Context->userenv->{branch})
1973                          ? C4::Context->userenv->{branch}
1974                          : "");
1975
1976     my $dbh   = C4::Context->dbh;
1977     my $query = q|
1978         SELECT borrowers.borrowernumber,
1979                MAX(old_issues.timestamp) AS latestissue,
1980                MAX(issues.timestamp) AS currentissue
1981         FROM   borrowers
1982         JOIN   categories USING (categorycode)
1983         LEFT JOIN (
1984             SELECT guarantorid
1985             FROM borrowers
1986             WHERE guarantorid IS NOT NULL
1987                 AND guarantorid <> 0
1988         ) as tmp ON borrowers.borrowernumber=tmp.guarantorid
1989         LEFT JOIN old_issues USING (borrowernumber)
1990         LEFT JOIN issues USING (borrowernumber)
1991         WHERE  category_type <> 'S'
1992         AND tmp.guarantorid IS NULL
1993    |;
1994
1995     my @query_params;
1996     if ( $filterbranch && $filterbranch ne "" ) {
1997         $query.= " AND borrowers.branchcode = ? ";
1998         push( @query_params, $filterbranch );
1999     }
2000     if ( $filterexpiry ) {
2001         $query .= " AND dateexpiry < ? ";
2002         push( @query_params, $filterexpiry );
2003     }
2004     if ( $filtercategory ) {
2005         $query .= " AND categorycode = ? ";
2006         push( @query_params, $filtercategory );
2007     }
2008     $query.=" GROUP BY borrowers.borrowernumber HAVING currentissue IS NULL ";
2009     if ( $filterdate ) {
2010         $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
2011         push @query_params,$filterdate;
2012     }
2013     warn $query if $debug;
2014
2015     my $sth = $dbh->prepare($query);
2016     if (scalar(@query_params)>0){
2017         $sth->execute(@query_params);
2018     }
2019     else {
2020         $sth->execute;
2021     }
2022
2023     my @results;
2024     while ( my $data = $sth->fetchrow_hashref ) {
2025         push @results, $data;
2026     }
2027     return \@results;
2028 }
2029
2030 =head2 GetBorrowersWhoHaveNeverBorrowed
2031
2032   $results = &GetBorrowersWhoHaveNeverBorrowed
2033
2034 This function get all borrowers who have never borrowed.
2035
2036 I<$result> is a ref to an array which all elements are a hasref.
2037
2038 =cut
2039
2040 sub GetBorrowersWhoHaveNeverBorrowed {
2041     my $filterbranch = shift ||
2042                         ((C4::Context->preference('IndependentBranches')
2043                              && C4::Context->userenv
2044                              && !C4::Context->IsSuperLibrarian()
2045                              && C4::Context->userenv->{branch})
2046                          ? C4::Context->userenv->{branch}
2047                          : "");
2048     my $dbh   = C4::Context->dbh;
2049     my $query = "
2050         SELECT borrowers.borrowernumber,max(timestamp) as latestissue
2051         FROM   borrowers
2052           LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
2053         WHERE issues.borrowernumber IS NULL
2054    ";
2055     my @query_params;
2056     if ($filterbranch && $filterbranch ne ""){
2057         $query.=" AND borrowers.branchcode= ?";
2058         push @query_params,$filterbranch;
2059     }
2060     warn $query if $debug;
2061
2062     my $sth = $dbh->prepare($query);
2063     if (scalar(@query_params)>0){
2064         $sth->execute(@query_params);
2065     }
2066     else {
2067         $sth->execute;
2068     }
2069
2070     my @results;
2071     while ( my $data = $sth->fetchrow_hashref ) {
2072         push @results, $data;
2073     }
2074     return \@results;
2075 }
2076
2077 =head2 GetBorrowersWithIssuesHistoryOlderThan
2078
2079   $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
2080
2081 this function get all borrowers who has an issue history older than I<$date> given on input arg.
2082
2083 I<$result> is a ref to an array which all elements are a hashref.
2084 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2085
2086 =cut
2087
2088 sub GetBorrowersWithIssuesHistoryOlderThan {
2089     my $dbh  = C4::Context->dbh;
2090     my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
2091     my $filterbranch = shift ||
2092                         ((C4::Context->preference('IndependentBranches')
2093                              && C4::Context->userenv
2094                              && !C4::Context->IsSuperLibrarian()
2095                              && C4::Context->userenv->{branch})
2096                          ? C4::Context->userenv->{branch}
2097                          : "");
2098     my $query = "
2099        SELECT count(borrowernumber) as n,borrowernumber
2100        FROM old_issues
2101        WHERE returndate < ?
2102          AND borrowernumber IS NOT NULL
2103     ";
2104     my @query_params;
2105     push @query_params, $date;
2106     if ($filterbranch){
2107         $query.="   AND branchcode = ?";
2108         push @query_params, $filterbranch;
2109     }
2110     $query.=" GROUP BY borrowernumber ";
2111     warn $query if $debug;
2112     my $sth = $dbh->prepare($query);
2113     $sth->execute(@query_params);
2114     my @results;
2115
2116     while ( my $data = $sth->fetchrow_hashref ) {
2117         push @results, $data;
2118     }
2119     return \@results;
2120 }
2121
2122 =head2 GetBorrowersNamesAndLatestIssue
2123
2124   $results = &GetBorrowersNamesAndLatestIssueList(@borrowernumbers)
2125
2126 this function get borrowers Names and surnames and Issue information.
2127
2128 I<@borrowernumbers> is an array which all elements are borrowernumbers.
2129 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2130
2131 =cut
2132
2133 sub GetBorrowersNamesAndLatestIssue {
2134     my $dbh  = C4::Context->dbh;
2135     my @borrowernumbers=@_;
2136     my $query = "
2137        SELECT surname,lastname, phone, email,max(timestamp)
2138        FROM borrowers
2139          LEFT JOIN issues ON borrowers.borrowernumber=issues.borrowernumber
2140        GROUP BY borrowernumber
2141    ";
2142     my $sth = $dbh->prepare($query);
2143     $sth->execute;
2144     my $results = $sth->fetchall_arrayref({});
2145     return $results;
2146 }
2147
2148 =head2 ModPrivacy
2149
2150   my $success = ModPrivacy( $borrowernumber, $privacy );
2151
2152 Update the privacy of a patron.
2153
2154 return :
2155 true on success, false on failure
2156
2157 =cut
2158
2159 sub ModPrivacy {
2160     my $borrowernumber = shift;
2161     my $privacy = shift;
2162     return unless defined $borrowernumber;
2163     return unless $borrowernumber =~ /^\d+$/;
2164
2165     return ModMember( borrowernumber => $borrowernumber,
2166                       privacy        => $privacy );
2167 }
2168
2169 =head2 AddMessage
2170
2171   AddMessage( $borrowernumber, $message_type, $message, $branchcode );
2172
2173 Adds a message to the messages table for the given borrower.
2174
2175 Returns:
2176   True on success
2177   False on failure
2178
2179 =cut
2180
2181 sub AddMessage {
2182     my ( $borrowernumber, $message_type, $message, $branchcode ) = @_;
2183
2184     my $dbh  = C4::Context->dbh;
2185
2186     if ( ! ( $borrowernumber && $message_type && $message && $branchcode ) ) {
2187       return;
2188     }
2189
2190     my $query = "INSERT INTO messages ( borrowernumber, branchcode, message_type, message ) VALUES ( ?, ?, ?, ? )";
2191     my $sth = $dbh->prepare($query);
2192     $sth->execute( $borrowernumber, $branchcode, $message_type, $message );
2193     logaction("MEMBERS", "ADDCIRCMESSAGE", $borrowernumber, $message) if C4::Context->preference("BorrowersLog");
2194     return 1;
2195 }
2196
2197 =head2 GetMessages
2198
2199   GetMessages( $borrowernumber, $type );
2200
2201 $type is message type, B for borrower, or L for Librarian.
2202 Empty type returns all messages of any type.
2203
2204 Returns all messages for the given borrowernumber
2205
2206 =cut
2207
2208 sub GetMessages {
2209     my ( $borrowernumber, $type, $branchcode ) = @_;
2210
2211     if ( ! $type ) {
2212       $type = '%';
2213     }
2214
2215     my $dbh  = C4::Context->dbh;
2216
2217     my $query = "SELECT
2218                   branches.branchname,
2219                   messages.*,
2220                   message_date,
2221                   messages.branchcode LIKE '$branchcode' AS can_delete
2222                   FROM messages, branches
2223                   WHERE borrowernumber = ?
2224                   AND message_type LIKE ?
2225                   AND messages.branchcode = branches.branchcode
2226                   ORDER BY message_date DESC";
2227     my $sth = $dbh->prepare($query);
2228     $sth->execute( $borrowernumber, $type ) ;
2229     my @results;
2230
2231     while ( my $data = $sth->fetchrow_hashref ) {
2232         my $d = C4::Dates->new( $data->{message_date}, 'iso' );
2233         $data->{message_date_formatted} = $d->output;
2234         push @results, $data;
2235     }
2236     return \@results;
2237
2238 }
2239
2240 =head2 GetMessages
2241
2242   GetMessagesCount( $borrowernumber, $type );
2243
2244 $type is message type, B for borrower, or L for Librarian.
2245 Empty type returns all messages of any type.
2246
2247 Returns the number of messages for the given borrowernumber
2248
2249 =cut
2250
2251 sub GetMessagesCount {
2252     my ( $borrowernumber, $type, $branchcode ) = @_;
2253
2254     if ( ! $type ) {
2255       $type = '%';
2256     }
2257
2258     my $dbh  = C4::Context->dbh;
2259
2260     my $query = "SELECT COUNT(*) as MsgCount FROM messages WHERE borrowernumber = ? AND message_type LIKE ?";
2261     my $sth = $dbh->prepare($query);
2262     $sth->execute( $borrowernumber, $type ) ;
2263     my @results;
2264
2265     my $data = $sth->fetchrow_hashref;
2266     my $count = $data->{'MsgCount'};
2267
2268     return $count;
2269 }
2270
2271
2272
2273 =head2 DeleteMessage
2274
2275   DeleteMessage( $message_id );
2276
2277 =cut
2278
2279 sub DeleteMessage {
2280     my ( $message_id ) = @_;
2281
2282     my $dbh = C4::Context->dbh;
2283     my $query = "SELECT * FROM messages WHERE message_id = ?";
2284     my $sth = $dbh->prepare($query);
2285     $sth->execute( $message_id );
2286     my $message = $sth->fetchrow_hashref();
2287
2288     $query = "DELETE FROM messages WHERE message_id = ?";
2289     $sth = $dbh->prepare($query);
2290     $sth->execute( $message_id );
2291     logaction("MEMBERS", "DELCIRCMESSAGE", $message->{'borrowernumber'}, $message->{'message'}) if C4::Context->preference("BorrowersLog");
2292 }
2293
2294 =head2 IssueSlip
2295
2296   IssueSlip($branchcode, $borrowernumber, $quickslip)
2297
2298   Returns letter hash ( see C4::Letters::GetPreparedLetter )
2299
2300   $quickslip is boolean, to indicate whether we want a quick slip
2301
2302   IssueSlip populates ISSUESLIP and ISSUEQSLIP, and will make the following expansions:
2303
2304   Both slips:
2305
2306       <<branches.*>>
2307       <<borrowers.*>>
2308
2309   ISSUESLIP:
2310
2311       <checkedout>
2312          <<biblio.*>>
2313          <<items.*>>
2314          <<biblioitems.*>>
2315          <<issues.*>>
2316       </checkedout>
2317
2318       <overdue>
2319          <<biblio.*>>
2320          <<items.*>>
2321          <<biblioitems.*>>
2322          <<issues.*>>
2323       </overdue>
2324
2325       <news>
2326          <<opac_news.*>>
2327       </news>
2328
2329   ISSUEQSLIP:
2330
2331       <checkedout>
2332          <<biblio.*>>
2333          <<items.*>>
2334          <<biblioitems.*>>
2335          <<issues.*>>
2336       </checkedout>
2337
2338   NOTE: Not all table fields are available, pleasee see GetPendingIssues for a list of available fields.
2339
2340 =cut
2341
2342 sub IssueSlip {
2343     my ($branch, $borrowernumber, $quickslip) = @_;
2344
2345     # FIXME Check callers before removing this statement
2346     #return unless $borrowernumber;
2347
2348     my @issues = @{ GetPendingIssues($borrowernumber) };
2349
2350     for my $issue (@issues) {
2351         $issue->{date_due} = $issue->{date_due_sql};
2352         if ($quickslip) {
2353             my $today = output_pref({ dt => dt_from_string, dateformat => 'iso', dateonly => 1 });
2354             if ( substr( $issue->{issuedate}, 0, 10 ) eq $today
2355                 or substr( $issue->{lastreneweddate}, 0, 10 ) eq $today ) {
2356                   $issue->{now} = 1;
2357             };
2358         }
2359     }
2360
2361     # Sort on timestamp then on issuedate (useful for tests and could be if modified in a batch
2362     @issues = sort {
2363         my $s = $b->{timestamp} <=> $a->{timestamp};
2364         $s == 0 ?
2365              $b->{issuedate} <=> $a->{issuedate} : $s;
2366     } @issues;
2367
2368     my ($letter_code, %repeat);
2369     if ( $quickslip ) {
2370         $letter_code = 'ISSUEQSLIP';
2371         %repeat =  (
2372             'checkedout' => [ map {
2373                 'biblio'       => $_,
2374                 'items'        => $_,
2375                 'biblioitems'  => $_,
2376                 'issues'       => $_,
2377             }, grep { $_->{'now'} } @issues ],
2378         );
2379     }
2380     else {
2381         $letter_code = 'ISSUESLIP';
2382         %repeat =  (
2383             'checkedout' => [ map {
2384                 'biblio'       => $_,
2385                 'items'        => $_,
2386                 'biblioitems'  => $_,
2387                 'issues'       => $_,
2388             }, grep { !$_->{'overdue'} } @issues ],
2389
2390             'overdue' => [ map {
2391                 'biblio'       => $_,
2392                 'items'        => $_,
2393                 'biblioitems'  => $_,
2394                 'issues'       => $_,
2395             }, grep { $_->{'overdue'} } @issues ],
2396
2397             'news' => [ map {
2398                 $_->{'timestamp'} = $_->{'newdate'};
2399                 { opac_news => $_ }
2400             } @{ GetNewsToDisplay("slip",$branch) } ],
2401         );
2402     }
2403
2404     return  C4::Letters::GetPreparedLetter (
2405         module => 'circulation',
2406         letter_code => $letter_code,
2407         branchcode => $branch,
2408         tables => {
2409             'branches'    => $branch,
2410             'borrowers'   => $borrowernumber,
2411         },
2412         repeat => \%repeat,
2413     );
2414 }
2415
2416 =head2 GetBorrowersWithEmail
2417
2418     ([$borrnum,$userid], ...) = GetBorrowersWithEmail('me@example.com');
2419
2420 This gets a list of users and their basic details from their email address.
2421 As it's possible for multiple user to have the same email address, it provides
2422 you with all of them. If there is no userid for the user, there will be an
2423 C<undef> there. An empty list will be returned if there are no matches.
2424
2425 =cut
2426
2427 sub GetBorrowersWithEmail {
2428     my $email = shift;
2429
2430     my $dbh = C4::Context->dbh;
2431
2432     my $query = "SELECT borrowernumber, userid FROM borrowers WHERE email=?";
2433     my $sth=$dbh->prepare($query);
2434     $sth->execute($email);
2435     my @result = ();
2436     while (my $ref = $sth->fetch) {
2437         push @result, $ref;
2438     }
2439     die "Failure searching for borrowers by email address: $sth->errstr" if $sth->err;
2440     return @result;
2441 }
2442
2443 =head2 AddMember_Opac
2444
2445 =cut
2446
2447 sub AddMember_Opac {
2448     my ( %borrower ) = @_;
2449
2450     $borrower{'categorycode'} = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
2451
2452     my $sr = new String::Random;
2453     $sr->{'A'} = [ 'A'..'Z', 'a'..'z' ];
2454     my $password = $sr->randpattern("AAAAAAAAAA");
2455     $borrower{'password'} = $password;
2456
2457     $borrower{'cardnumber'} = fixup_cardnumber();
2458
2459     my $borrowernumber = AddMember(%borrower);
2460
2461     return ( $borrowernumber, $password );
2462 }
2463
2464 =head2 AddEnrolmentFeeIfNeeded
2465
2466     AddEnrolmentFeeIfNeeded( $borrower->{categorycode}, $borrower->{borrowernumber} );
2467
2468 Add enrolment fee for a patron if needed.
2469
2470 =cut
2471
2472 sub AddEnrolmentFeeIfNeeded {
2473     my ( $categorycode, $borrowernumber ) = @_;
2474     # check for enrollment fee & add it if needed
2475     my $dbh = C4::Context->dbh;
2476     my $sth = $dbh->prepare(q{
2477         SELECT enrolmentfee
2478         FROM categories
2479         WHERE categorycode=?
2480     });
2481     $sth->execute( $categorycode );
2482     if ( $sth->err ) {
2483         warn sprintf('Database returned the following error: %s', $sth->errstr);
2484         return;
2485     }
2486     my ($enrolmentfee) = $sth->fetchrow;
2487     if ($enrolmentfee && $enrolmentfee > 0) {
2488         # insert fee in patron debts
2489         C4::Accounts::manualinvoice( $borrowernumber, '', '', 'A', $enrolmentfee );
2490     }
2491 }
2492
2493 =head2 HasOverdues
2494
2495 =cut
2496
2497 sub HasOverdues {
2498     my ( $borrowernumber ) = @_;
2499
2500     my $sql = "SELECT COUNT(*) FROM issues WHERE date_due < NOW() AND borrowernumber = ?";
2501     my $sth = C4::Context->dbh->prepare( $sql );
2502     $sth->execute( $borrowernumber );
2503     my ( $count ) = $sth->fetchrow_array();
2504
2505     return $count;
2506 }
2507
2508 =head2 DeleteExpiredOpacRegistrations
2509
2510     Delete accounts that haven't been upgraded from the 'temporary' category
2511     Returns the number of removed patrons
2512
2513 =cut
2514
2515 sub DeleteExpiredOpacRegistrations {
2516
2517     my $delay = C4::Context->preference('PatronSelfRegistrationExpireTemporaryAccountsDelay');
2518     my $category_code = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
2519
2520     return 0 if not $category_code or not defined $delay or $delay eq q||;
2521
2522     my $query = qq|
2523 SELECT borrowernumber
2524 FROM borrowers
2525 WHERE categorycode = ? AND DATEDIFF( NOW(), dateenrolled ) > ? |;
2526
2527     my $dbh = C4::Context->dbh;
2528     my $sth = $dbh->prepare($query);
2529     $sth->execute( $category_code, $delay );
2530     my $cnt=0;
2531     while ( my ($borrowernumber) = $sth->fetchrow_array() ) {
2532         DelMember($borrowernumber);
2533         $cnt++;
2534     }
2535     return $cnt;
2536 }
2537
2538 =head2 DeleteUnverifiedOpacRegistrations
2539
2540     Delete all unverified self registrations in borrower_modifications,
2541     older than the specified number of days.
2542
2543 =cut
2544
2545 sub DeleteUnverifiedOpacRegistrations {
2546     my ( $days ) = @_;
2547     my $dbh = C4::Context->dbh;
2548     my $sql=qq|
2549 DELETE FROM borrower_modifications
2550 WHERE borrowernumber = 0 AND DATEDIFF( NOW(), timestamp ) > ?|;
2551     my $cnt=$dbh->do($sql, undef, ($days) );
2552     return $cnt eq '0E0'? 0: $cnt;
2553 }
2554
2555 END { }    # module clean-up code here (global destructor)
2556
2557 1;
2558
2559 __END__
2560
2561 =head1 AUTHOR
2562
2563 Koha Team
2564
2565 =cut