C4/Members.pm

   1 package C4::Members;
   2
   3 # Copyright 2000-2003 Katipo Communications
   4 # Copyright 2010 BibLibre
   5 # Parts Copyright 2010 Catalyst IT
   6 #
   7 # This file is part of Koha.
   8 #
   9 # Koha is free software; you can redistribute it and/or modify it
  10 # under the terms of the GNU General Public License as published by
  11 # the Free Software Foundation; either version 3 of the License, or
  12 # (at your option) any later version.
  13 #
  14 # Koha is distributed in the hope that it will be useful, but
  15 # WITHOUT ANY WARRANTY; without even the implied warranty of
  16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  17 # GNU General Public License for more details.
  18 #
  19 # You should have received a copy of the GNU General Public License
  20 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  21
  22
  23 use strict;
  24 #use warnings; FIXME - Bug 2505
  25 use C4::Context;
  26 use String::Random qw( random_string );
  27 use Scalar::Util qw( looks_like_number );
  28 use Date::Calc qw/Today 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 Text::Unaccent qw( unac_string );
  41 use Koha::AuthUtils qw(hash_password);
  42 use Koha::Database;
  43 use Koha::Holds;
  44 use Koha::List::Patron;
  45 use Koha::Patrons;
  46 use Koha::Patron::Categories;
  47 use Koha::Schema;
  48
  49 our (@ISA,@EXPORT,@EXPORT_OK,$debug);
  50
  51 use Module::Load::Conditional qw( can_load );
  52 if ( ! can_load( modules => { 'Koha::NorwegianPatronDB' => undef } ) ) {
  53    $debug && warn "Unable to load Koha::NorwegianPatronDB";
  54 }
  55
  56
  57 BEGIN {
  58     $debug = $ENV{DEBUG} || 0;
  59     require Exporter;
  60     @ISA = qw(Exporter);
  61     #Get data
  62     push @EXPORT, qw(
  63         &GetMember
  64
  65         &GetPendingIssues
  66         &GetAllIssues
  67
  68         &GetFirstValidEmailAddress
  69         &GetNoticeEmailAddress
  70
  71         &GetMemberAccountRecords
  72         &GetBorNotifyAcctRecord
  73
  74         &GetBorrowersToExpunge
  75         &GetBorrowersWithIssuesHistoryOlderThan
  76
  77         &IssueSlip
  78         GetBorrowersWithEmail
  79
  80         GetOverduesForPatron
  81     );
  82
  83     #Modify data
  84     push @EXPORT, qw(
  85         &ModMember
  86         &changepassword
  87     );
  88
  89     #Insert data
  90     push @EXPORT, qw(
  91         &AddMember
  92         &AddMember_Opac
  93     );
  94
  95     #Check data
  96     push @EXPORT, qw(
  97         &checkuniquemember
  98         &checkuserpassword
  99         &Check_Userid
 100         &Generate_Userid
 101         &fixup_cardnumber
 102         &checkcardnumber
 103     );
 104 }
 105
 106 =head1 NAME
 107
 108 C4::Members - Perl Module containing convenience functions for member handling
 109
 110 =head1 SYNOPSIS
 111
 112 use C4::Members;
 113
 114 =head1 DESCRIPTION
 115
 116 This module contains routines for adding, modifying and deleting members/patrons/borrowers
 117
 118 =head1 FUNCTIONS
 119
 120 =head2 patronflags
 121
 122  $flags = &patronflags($patron);
 123
 124 This function is not exported.
 125
 126 The following will be set where applicable:
 127  $flags->{CHARGES}->{amount}        Amount of debt
 128  $flags->{CHARGES}->{noissues}      Set if debt amount >$5.00 (or syspref noissuescharge)
 129  $flags->{CHARGES}->{message}       Message -- deprecated
 130
 131  $flags->{CREDITS}->{amount}        Amount of credit
 132  $flags->{CREDITS}->{message}       Message -- deprecated
 133
 134  $flags->{  GNA  }                  Patron has no valid address
 135  $flags->{  GNA  }->{noissues}      Set for each GNA
 136  $flags->{  GNA  }->{message}       "Borrower has no valid address" -- deprecated
 137
 138  $flags->{ LOST  }                  Patron's card reported lost
 139  $flags->{ LOST  }->{noissues}      Set for each LOST
 140  $flags->{ LOST  }->{message}       Message -- deprecated
 141
 142  $flags->{DBARRED}                  Set if patron debarred, no access
 143  $flags->{DBARRED}->{noissues}      Set for each DBARRED
 144  $flags->{DBARRED}->{message}       Message -- deprecated
 145
 146  $flags->{ NOTES }
 147  $flags->{ NOTES }->{message}       The note itself.  NOT deprecated
 148
 149  $flags->{ ODUES }                  Set if patron has overdue books.
 150  $flags->{ ODUES }->{message}       "Yes"  -- deprecated
 151  $flags->{ ODUES }->{itemlist}      ref-to-array: list of overdue books
 152  $flags->{ ODUES }->{itemlisttext}  Text list of overdue items -- deprecated
 153
 154  $flags->{WAITING}                  Set if any of patron's reserves are available
 155  $flags->{WAITING}->{message}       Message -- deprecated
 156  $flags->{WAITING}->{itemlist}      ref-to-array: list of available items
 157
 158 =over
 159
 160 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
 161 overdue items. Its elements are references-to-hash, each describing an
 162 overdue item. The keys are selected fields from the issues, biblio,
 163 biblioitems, and items tables of the Koha database.
 164
 165 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
 166 the overdue items, one per line.  Deprecated.
 167
 168 =item C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
 169 available items. Each element is a reference-to-hash whose keys are
 170 fields from the reserves table of the Koha database.
 171
 172 =back
 173
 174 All the "message" fields that include language generated in this function are deprecated,
 175 because such strings belong properly in the display layer.
 176
 177 The "message" field that comes from the DB is OK.
 178
 179 =cut
 180
 181 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
 182 # FIXME rename this function.
 183 sub patronflags {
 184     my %flags;
 185     my ( $patroninformation) = @_;
 186     my $dbh=C4::Context->dbh;
 187     my ($balance, $owing) = GetMemberAccountBalance( $patroninformation->{'borrowernumber'});
 188     if ( $owing > 0 ) {
 189         my %flaginfo;
 190         my $noissuescharge = C4::Context->preference("noissuescharge") || 5;
 191         $flaginfo{'message'} = sprintf 'Patron owes %.02f', $owing;
 192         $flaginfo{'amount'}  = sprintf "%.02f", $owing;
 193         if ( $owing > $noissuescharge && !C4::Context->preference("AllowFineOverride") ) {
 194             $flaginfo{'noissues'} = 1;
 195         }
 196         $flags{'CHARGES'} = \%flaginfo;
 197     }
 198     elsif ( $balance < 0 ) {
 199         my %flaginfo;
 200         $flaginfo{'message'} = sprintf 'Patron has credit of %.02f', -$balance;
 201         $flaginfo{'amount'}  = sprintf "%.02f", $balance;
 202         $flags{'CREDITS'} = \%flaginfo;
 203     }
 204
 205     # Check the debt of the guarntees of this patron
 206     my $no_issues_charge_guarantees = C4::Context->preference("NoIssuesChargeGuarantees");
 207     $no_issues_charge_guarantees = undef unless looks_like_number( $no_issues_charge_guarantees );
 208     if ( defined $no_issues_charge_guarantees ) {
 209         my $p = Koha::Patrons->find( $patroninformation->{borrowernumber} );
 210         my @guarantees = $p->guarantees();
 211         my $guarantees_non_issues_charges;
 212         foreach my $g ( @guarantees ) {
 213             my ( $b, $n, $o ) = C4::Members::GetMemberAccountBalance( $g->id );
 214             $guarantees_non_issues_charges += $n;
 215         }
 216
 217         if ( $guarantees_non_issues_charges > $no_issues_charge_guarantees ) {
 218             my %flaginfo;
 219             $flaginfo{'message'} = sprintf 'patron guarantees owe %.02f', $guarantees_non_issues_charges;
 220             $flaginfo{'amount'}  = $guarantees_non_issues_charges;
 221             $flaginfo{'noissues'} = 1 unless C4::Context->preference("allowfineoverride");
 222             $flags{'CHARGES_GUARANTEES'} = \%flaginfo;
 223         }
 224     }
 225
 226     if (   $patroninformation->{'gonenoaddress'}
 227         && $patroninformation->{'gonenoaddress'} == 1 )
 228     {
 229         my %flaginfo;
 230         $flaginfo{'message'}  = 'Borrower has no valid address.';
 231         $flaginfo{'noissues'} = 1;
 232         $flags{'GNA'}         = \%flaginfo;
 233     }
 234     if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
 235         my %flaginfo;
 236         $flaginfo{'message'}  = 'Borrower\'s card reported lost.';
 237         $flaginfo{'noissues'} = 1;
 238         $flags{'LOST'}        = \%flaginfo;
 239     }
 240     if ( $patroninformation->{'debarred'} && check_date( split( /-/, $patroninformation->{'debarred'} ) ) ) {
 241         if ( Date_to_Days(Date::Calc::Today) < Date_to_Days( split( /-/, $patroninformation->{'debarred'} ) ) ) {
 242             my %flaginfo;
 243             $flaginfo{'debarredcomment'} = $patroninformation->{'debarredcomment'};
 244             $flaginfo{'message'}         = $patroninformation->{'debarredcomment'};
 245             $flaginfo{'noissues'}        = 1;
 246             $flaginfo{'dateend'}         = $patroninformation->{'debarred'};
 247             $flags{'DBARRED'}           = \%flaginfo;
 248         }
 249     }
 250     if (   $patroninformation->{'borrowernotes'}
 251         && $patroninformation->{'borrowernotes'} )
 252     {
 253         my %flaginfo;
 254         $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
 255         $flags{'NOTES'}      = \%flaginfo;
 256     }
 257     my ( $odues, $itemsoverdue ) = C4::Overdues::checkoverdues($patroninformation->{'borrowernumber'});
 258     if ( $odues && $odues > 0 ) {
 259         my %flaginfo;
 260         $flaginfo{'message'}  = "Yes";
 261         $flaginfo{'itemlist'} = $itemsoverdue;
 262         foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
 263             @$itemsoverdue )
 264         {
 265             $flaginfo{'itemlisttext'} .=
 266               "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n";  # newline is display layer
 267         }
 268         $flags{'ODUES'} = \%flaginfo;
 269     }
 270     my @itemswaiting = C4::Reserves::GetReservesFromBorrowernumber( $patroninformation->{'borrowernumber'},'W' );
 271     my $nowaiting = scalar @itemswaiting;
 272     if ( $nowaiting > 0 ) {
 273         my %flaginfo;
 274         $flaginfo{'message'}  = "Reserved items available";
 275         $flaginfo{'itemlist'} = \@itemswaiting;
 276         $flags{'WAITING'}     = \%flaginfo;
 277     }
 278     return ( \%flags );
 279 }
 280
 281
 282 =head2 GetMember
 283
 284   $borrower = &GetMember(%information);
 285
 286 Retrieve the first patron record meeting on criteria listed in the
 287 C<%information> hash, which should contain one or more
 288 pairs of borrowers column names and values, e.g.,
 289
 290    $borrower = GetMember(borrowernumber => id);
 291
 292 C<&GetBorrower> returns a reference-to-hash whose keys are the fields of
 293 the C<borrowers> table in the Koha database.
 294
 295 FIXME: GetMember() is used throughout the code as a lookup
 296 on a unique key such as the borrowernumber, but this meaning is not
 297 enforced in the routine itself.
 298
 299 =cut
 300
 301 #'
 302 sub GetMember {
 303     my ( %information ) = @_;
 304     if (exists $information{borrowernumber} && !defined $information{borrowernumber}) {
 305         #passing mysql's kohaadmin?? Makes no sense as a query
 306         return;
 307     }
 308     my $dbh = C4::Context->dbh;
 309     my $select =
 310     q{SELECT borrowers.*, categories.category_type, categories.description
 311     FROM borrowers
 312     LEFT JOIN categories on borrowers.categorycode=categories.categorycode WHERE };
 313     my $more_p = 0;
 314     my @values = ();
 315     for (keys %information ) {
 316         if ($more_p) {
 317             $select .= ' AND ';
 318         }
 319         else {
 320             $more_p++;
 321         }
 322
 323         if (defined $information{$_}) {
 324             $select .= "$_ = ?";
 325             push @values, $information{$_};
 326         }
 327         else {
 328             $select .= "$_ IS NULL";
 329         }
 330     }
 331     $debug && warn $select, " ",values %information;
 332     my $sth = $dbh->prepare("$select");
 333     $sth->execute(@values);
 334     my $data = $sth->fetchall_arrayref({});
 335     #FIXME interface to this routine now allows generation of a result set
 336     #so whole array should be returned but bowhere in the current code expects this
 337     if (@{$data} ) {
 338         return $data->[0];
 339     }
 340
 341     return;
 342 }
 343
 344 =head2 ModMember
 345
 346   my $success = ModMember(borrowernumber => $borrowernumber,
 347                                             [ field => value ]... );
 348
 349 Modify borrower's data.  All date fields should ALREADY be in ISO format.
 350
 351 return :
 352 true on success, or false on failure
 353
 354 =cut
 355
 356 sub ModMember {
 357     my (%data) = @_;
 358     # test to know if you must update or not the borrower password
 359     if (exists $data{password}) {
 360         if ($data{password} eq '****' or $data{password} eq '') {
 361             delete $data{password};
 362         } else {
 363             if ( C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
 364                 # Update the hashed PIN in borrower_sync.hashed_pin, before Koha hashes it
 365                 Koha::NorwegianPatronDB::NLUpdateHashedPIN( $data{'borrowernumber'}, $data{password} );
 366             }
 367             $data{password} = hash_password($data{password});
 368         }
 369     }
 370
 371     my $old_categorycode = Koha::Patrons->find( $data{borrowernumber} )->categorycode;
 372
 373     # get only the columns of a borrower
 374     my $schema = Koha::Database->new()->schema;
 375     my @columns = $schema->source('Borrower')->columns;
 376     my $new_borrower = { map { join(' ', @columns) =~ /$_/ ? ( $_ => $data{$_} ) : () } keys(%data) };
 377
 378     $new_borrower->{dateofbirth}     ||= undef if exists $new_borrower->{dateofbirth};
 379     $new_borrower->{dateenrolled}    ||= undef if exists $new_borrower->{dateenrolled};
 380     $new_borrower->{dateexpiry}      ||= undef if exists $new_borrower->{dateexpiry};
 381     $new_borrower->{debarred}        ||= undef if exists $new_borrower->{debarred};
 382     $new_borrower->{sms_provider_id} ||= undef if exists $new_borrower->{sms_provider_id};
 383     $new_borrower->{guarantorid}     ||= undef if exists $new_borrower->{guarantorid};
 384
 385     my $patron = Koha::Patrons->find( $new_borrower->{borrowernumber} );
 386
 387     delete $new_borrower->{userid} if exists $new_borrower->{userid} and not $new_borrower->{userid};
 388
 389     my $execute_success = $patron->store if $patron->set($new_borrower);
 390
 391     if ($execute_success) { # only proceed if the update was a success
 392         # If the patron changes to a category with enrollment fee, we add a fee
 393         if ( $data{categorycode} and $data{categorycode} ne $old_categorycode ) {
 394             if ( C4::Context->preference('FeeOnChangePatronCategory') ) {
 395                 $patron->add_enrolment_fee_if_needed;
 396             }
 397         }
 398
 399         # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
 400         # cronjob will use for syncing with NL
 401         if ( C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
 402             my $borrowersync = Koha::Database->new->schema->resultset('BorrowerSync')->find({
 403                 'synctype'       => 'norwegianpatrondb',
 404                 'borrowernumber' => $data{'borrowernumber'}
 405             });
 406             # Do not set to "edited" if syncstatus is "new". We need to sync as new before
 407             # we can sync as changed. And the "new sync" will pick up all changes since
 408             # the patron was created anyway.
 409             if ( $borrowersync->syncstatus ne 'new' && $borrowersync->syncstatus ne 'delete' ) {
 410                 $borrowersync->update( { 'syncstatus' => 'edited' } );
 411             }
 412             # Set the value of 'sync'
 413             $borrowersync->update( { 'sync' => $data{'sync'} } );
 414             # Try to do the live sync
 415             Koha::NorwegianPatronDB::NLSync({ 'borrowernumber' => $data{'borrowernumber'} });
 416         }
 417
 418         logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "UPDATE (executed w/ arg: $data{'borrowernumber'})") if C4::Context->preference("BorrowersLog");
 419     }
 420     return $execute_success;
 421 }
 422
 423 =head2 AddMember
 424
 425   $borrowernumber = &AddMember(%borrower);
 426
 427 insert new borrower into table
 428
 429 (%borrower keys are database columns. Database columns could be
 430 different in different versions. Please look into database for correct
 431 column names.)
 432
 433 Returns the borrowernumber upon success
 434
 435 Returns as undef upon any db error without further processing
 436
 437 =cut
 438
 439 #'
 440 sub AddMember {
 441     my (%data) = @_;
 442     my $dbh = C4::Context->dbh;
 443     my $schema = Koha::Database->new()->schema;
 444
 445     # generate a proper login if none provided
 446     $data{'userid'} = Generate_Userid( $data{'borrowernumber'}, $data{'firstname'}, $data{'surname'} )
 447       if ( $data{'userid'} eq '' || !Check_Userid( $data{'userid'} ) );
 448
 449     # add expiration date if it isn't already there
 450     $data{dateexpiry} ||= Koha::Patron::Categories->find( $data{categorycode} )->get_expiry_date;
 451
 452     # add enrollment date if it isn't already there
 453     unless ( $data{'dateenrolled'} ) {
 454         $data{'dateenrolled'} = output_pref( { dt => dt_from_string, dateonly => 1, dateformat => 'iso' } );
 455     }
 456
 457     if ( C4::Context->preference("autoMemberNum") ) {
 458         if ( not exists $data{cardnumber} or not defined $data{cardnumber} or $data{cardnumber} eq '' ) {
 459             $data{cardnumber} = fixup_cardnumber( $data{cardnumber} );
 460         }
 461     }
 462
 463     my $patron_category = $schema->resultset('Category')->find( $data{'categorycode'} );
 464     $data{'privacy'} =
 465         $patron_category->default_privacy() eq 'default' ? 1
 466       : $patron_category->default_privacy() eq 'never'   ? 2
 467       : $patron_category->default_privacy() eq 'forever' ? 0
 468       :                                                    undef;
 469
 470     $data{'privacy_guarantor_checkouts'} = 0 unless defined( $data{'privacy_guarantor_checkouts'} );
 471
 472     # Make a copy of the plain text password for later use
 473     my $plain_text_password = $data{'password'};
 474
 475     # create a disabled account if no password provided
 476     $data{'password'} = ($data{'password'})? hash_password($data{'password'}) : '!';
 477
 478     # we don't want invalid dates in the db (mysql has a bad habit of inserting 0000-00-00
 479     $data{'dateofbirth'}     = undef if ( not $data{'dateofbirth'} );
 480     $data{'debarred'}        = undef if ( not $data{'debarred'} );
 481     $data{'sms_provider_id'} = undef if ( not $data{'sms_provider_id'} );
 482
 483     # get only the columns of Borrower
 484     # FIXME Do we really need this check?
 485     my @columns = $schema->source('Borrower')->columns;
 486     my $new_member = { map { join(' ',@columns) =~ /$_/ ? ( $_ => $data{$_} )  : () } keys(%data) } ;
 487
 488     delete $new_member->{borrowernumber};
 489
 490     my $patron = Koha::Patron->new( $new_member )->store;
 491     $data{borrowernumber} = $patron->borrowernumber;
 492
 493     # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
 494     # cronjob will use for syncing with NL
 495     if ( exists $data{'borrowernumber'} && C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
 496         Koha::Database->new->schema->resultset('BorrowerSync')->create({
 497             'borrowernumber' => $data{'borrowernumber'},
 498             'synctype'       => 'norwegianpatrondb',
 499             'sync'           => 1,
 500             'syncstatus'     => 'new',
 501             'hashed_pin'     => Koha::NorwegianPatronDB::NLEncryptPIN( $plain_text_password ),
 502         });
 503     }
 504
 505     logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
 506
 507     $patron->add_enrolment_fee_if_needed;
 508
 509     return $data{borrowernumber};
 510 }
 511
 512 =head2 Check_Userid
 513
 514     my $uniqueness = Check_Userid($userid,$borrowernumber);
 515
 516     $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 != '').
 517
 518     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.
 519
 520     return :
 521         0 for not unique (i.e. this $userid already exists)
 522         1 for unique (i.e. this $userid does not exist, or this $userid/$borrowernumber combination already exists)
 523
 524 =cut
 525
 526 sub Check_Userid {
 527     my ( $uid, $borrowernumber ) = @_;
 528
 529     return 0 unless ($uid); # userid is a unique column, we should assume NULL is not unique
 530
 531     return 0 if ( $uid eq C4::Context->config('user') );
 532
 533     my $rs = Koha::Database->new()->schema()->resultset('Borrower');
 534
 535     my $params;
 536     $params->{userid} = $uid;
 537     $params->{borrowernumber} = { '!=' => $borrowernumber } if ($borrowernumber);
 538
 539     my $count = $rs->count( $params );
 540
 541     return $count ? 0 : 1;
 542 }
 543
 544 =head2 Generate_Userid
 545
 546     my $newuid = Generate_Userid($borrowernumber, $firstname, $surname);
 547
 548     Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
 549
 550     $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.
 551
 552     return :
 553         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).
 554
 555 =cut
 556
 557 sub Generate_Userid {
 558   my ($borrowernumber, $firstname, $surname) = @_;
 559   my $newuid;
 560   my $offset = 0;
 561   #The script will "do" the following code and increment the $offset until Check_Userid = 1 (i.e. until $newuid comes back as unique)
 562   do {
 563     $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
 564     $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
 565     $newuid = lc(($firstname)? "$firstname.$surname" : $surname);
 566     $newuid = unac_string('utf-8',$newuid);
 567     $newuid .= $offset unless $offset == 0;
 568     $offset++;
 569
 570    } while (!Check_Userid($newuid,$borrowernumber));
 571
 572    return $newuid;
 573 }
 574
 575 =head2 fixup_cardnumber
 576
 577 Warning: The caller is responsible for locking the members table in write
 578 mode, to avoid database corruption.
 579
 580 =cut
 581
 582 use vars qw( @weightings );
 583 my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
 584
 585 sub fixup_cardnumber {
 586     my ($cardnumber) = @_;
 587     my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;
 588
 589     # Find out whether member numbers should be generated
 590     # automatically. Should be either "1" or something else.
 591     # Defaults to "0", which is interpreted as "no".
 592
 593     #     if ($cardnumber !~ /\S/ && $autonumber_members) {
 594     ($autonumber_members) or return $cardnumber;
 595     my $checkdigit = C4::Context->preference('checkdigit');
 596     my $dbh = C4::Context->dbh;
 597     if ( $checkdigit and $checkdigit eq 'katipo' ) {
 598
 599         # if checkdigit is selected, calculate katipo-style cardnumber.
 600         # otherwise, just use the max()
 601         # purpose: generate checksum'd member numbers.
 602         # We'll assume we just got the max value of digits 2-8 of member #'s
 603         # from the database and our job is to increment that by one,
 604         # determine the 1st and 9th digits and return the full string.
 605         my $sth = $dbh->prepare(
 606             "select max(substring(borrowers.cardnumber,2,7)) as new_num from borrowers"
 607         );
 608         $sth->execute;
 609         my $data = $sth->fetchrow_hashref;
 610         $cardnumber = $data->{new_num};
 611         if ( !$cardnumber ) {    # If DB has no values,
 612             $cardnumber = 1000000;    # start at 1000000
 613         } else {
 614             $cardnumber += 1;
 615         }
 616
 617         my $sum = 0;
 618         for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
 619             # read weightings, left to right, 1 char at a time
 620             my $temp1 = $weightings[$i];
 621
 622             # sequence left to right, 1 char at a time
 623             my $temp2 = substr( $cardnumber, $i, 1 );
 624
 625             # mult each char 1-7 by its corresponding weighting
 626             $sum += $temp1 * $temp2;
 627         }
 628
 629         my $rem = ( $sum % 11 );
 630         $rem = 'X' if $rem == 10;
 631
 632         return "V$cardnumber$rem";
 633      } else {
 634
 635         my $sth = $dbh->prepare(
 636             'SELECT MAX( CAST( cardnumber AS SIGNED ) ) FROM borrowers WHERE cardnumber REGEXP "^-?[0-9]+$"'
 637         );
 638         $sth->execute;
 639         my ($result) = $sth->fetchrow;
 640         return $result + 1;
 641     }
 642     return $cardnumber;     # just here as a fallback/reminder
 643 }
 644
 645 =head2 GetPendingIssues
 646
 647   my $issues = &GetPendingIssues(@borrowernumber);
 648
 649 Looks up what the patron with the given borrowernumber has borrowed.
 650
 651 C<&GetPendingIssues> returns a
 652 reference-to-array where each element is a reference-to-hash; the
 653 keys are the fields from the C<issues>, C<biblio>, and C<items> tables.
 654 The keys include C<biblioitems> fields.
 655
 656 =cut
 657
 658 sub GetPendingIssues {
 659     my @borrowernumbers = @_;
 660
 661     unless (@borrowernumbers ) { # return a ref_to_array
 662         return \@borrowernumbers; # to not cause surprise to caller
 663     }
 664
 665     # Borrowers part of the query
 666     my $bquery = '';
 667     for (my $i = 0; $i < @borrowernumbers; $i++) {
 668         $bquery .= ' issues.borrowernumber = ?';
 669         if ($i < $#borrowernumbers ) {
 670             $bquery .= ' OR';
 671         }
 672     }
 673
 674     # FIXME: namespace collision: each table has "timestamp" fields.  Which one is "timestamp" ?
 675     # FIXME: circ/ciculation.pl tries to sort by timestamp!
 676     # FIXME: namespace collision: other collisions possible.
 677     # FIXME: most of this data isn't really being used by callers.
 678     my $query =
 679    "SELECT issues.*,
 680             items.*,
 681            biblio.*,
 682            biblioitems.volume,
 683            biblioitems.number,
 684            biblioitems.itemtype,
 685            biblioitems.isbn,
 686            biblioitems.issn,
 687            biblioitems.publicationyear,
 688            biblioitems.publishercode,
 689            biblioitems.volumedate,
 690            biblioitems.volumedesc,
 691            biblioitems.lccn,
 692            biblioitems.url,
 693            borrowers.firstname,
 694            borrowers.surname,
 695            borrowers.cardnumber,
 696            issues.timestamp AS timestamp,
 697            issues.renewals  AS renewals,
 698            issues.borrowernumber AS borrowernumber,
 699             items.renewals  AS totalrenewals
 700     FROM   issues
 701     LEFT JOIN items       ON items.itemnumber       =      issues.itemnumber
 702     LEFT JOIN biblio      ON items.biblionumber     =      biblio.biblionumber
 703     LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
 704     LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
 705     WHERE
 706       $bquery
 707     ORDER BY issues.issuedate"
 708     ;
 709
 710     my $sth = C4::Context->dbh->prepare($query);
 711     $sth->execute(@borrowernumbers);
 712     my $data = $sth->fetchall_arrayref({});
 713     my $today = dt_from_string;
 714     foreach (@{$data}) {
 715         if ($_->{issuedate}) {
 716             $_->{issuedate} = dt_from_string($_->{issuedate}, 'sql');
 717         }
 718         $_->{date_due_sql} = $_->{date_due};
 719         # FIXME no need to have this value
 720         $_->{date_due} or next;
 721         $_->{date_due_sql} = $_->{date_due};
 722         # FIXME no need to have this value
 723         $_->{date_due} = dt_from_string($_->{date_due}, 'sql');
 724         if ( DateTime->compare($_->{date_due}, $today) == -1 ) {
 725             $_->{overdue} = 1;
 726         }
 727     }
 728     return $data;
 729 }
 730
 731 =head2 GetAllIssues
 732
 733   $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
 734
 735 Looks up what the patron with the given borrowernumber has borrowed,
 736 and sorts the results.
 737
 738 C<$sortkey> is the name of a field on which to sort the results. This
 739 should be the name of a field in the C<issues>, C<biblio>,
 740 C<biblioitems>, or C<items> table in the Koha database.
 741
 742 C<$limit> is the maximum number of results to return.
 743
 744 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
 745 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
 746 C<items> tables of the Koha database.
 747
 748 =cut
 749
 750 #'
 751 sub GetAllIssues {
 752     my ( $borrowernumber, $order, $limit ) = @_;
 753
 754     return unless $borrowernumber;
 755     $order = 'date_due desc' unless $order;
 756
 757     my $dbh = C4::Context->dbh;
 758     my $query =
 759 'SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
 760   FROM issues
 761   LEFT JOIN items on items.itemnumber=issues.itemnumber
 762   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
 763   LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
 764   WHERE borrowernumber=?
 765   UNION ALL
 766   SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
 767   FROM old_issues
 768   LEFT JOIN items on items.itemnumber=old_issues.itemnumber
 769   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
 770   LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
 771   WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL
 772   order by ' . $order;
 773     if ($limit) {
 774         $query .= " limit $limit";
 775     }
 776
 777     my $sth = $dbh->prepare($query);
 778     $sth->execute( $borrowernumber, $borrowernumber );
 779     return $sth->fetchall_arrayref( {} );
 780 }
 781
 782
 783 =head2 GetMemberAccountRecords
 784
 785   ($total, $acctlines, $count) = &GetMemberAccountRecords($borrowernumber);
 786
 787 Looks up accounting data for the patron with the given borrowernumber.
 788
 789 C<&GetMemberAccountRecords> returns a three-element array. C<$acctlines> is a
 790 reference-to-array, where each element is a reference-to-hash; the
 791 keys are the fields of the C<accountlines> table in the Koha database.
 792 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
 793 total amount outstanding for all of the account lines.
 794
 795 =cut
 796
 797 sub GetMemberAccountRecords {
 798     my ($borrowernumber) = @_;
 799     my $dbh = C4::Context->dbh;
 800     my @acctlines;
 801     my $numlines = 0;
 802     my $strsth      = qq(
 803                         SELECT *
 804                         FROM accountlines
 805                         WHERE borrowernumber=?);
 806     $strsth.=" ORDER BY accountlines_id desc";
 807     my $sth= $dbh->prepare( $strsth );
 808     $sth->execute( $borrowernumber );
 809
 810     my $total = 0;
 811     while ( my $data = $sth->fetchrow_hashref ) {
 812         if ( $data->{itemnumber} ) {
 813             my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
 814             $data->{biblionumber} = $biblio->{biblionumber};
 815             $data->{title}        = $biblio->{title};
 816         }
 817         $acctlines[$numlines] = $data;
 818         $numlines++;
 819         $total += sprintf "%.0f", 1000*$data->{amountoutstanding}; # convert float to integer to avoid round-off errors
 820     }
 821     $total /= 1000;
 822     return ( $total, \@acctlines,$numlines);
 823 }
 824
 825 =head2 GetMemberAccountBalance
 826
 827   ($total_balance, $non_issue_balance, $other_charges) = &GetMemberAccountBalance($borrowernumber);
 828
 829 Calculates amount immediately owing by the patron - non-issue charges.
 830 Based on GetMemberAccountRecords.
 831 Charges exempt from non-issue are:
 832 * Res (reserves)
 833 * Rent (rental) if RentalsInNoissuesCharge syspref is set to false
 834 * Manual invoices if ManInvInNoissuesCharge syspref is set to false
 835
 836 =cut
 837
 838 sub GetMemberAccountBalance {
 839     my ($borrowernumber) = @_;
 840
 841     my $ACCOUNT_TYPE_LENGTH = 5; # this is plain ridiculous...
 842
 843     my @not_fines;
 844     push @not_fines, 'Res' unless C4::Context->preference('HoldsInNoissuesCharge');
 845     push @not_fines, 'Rent' unless C4::Context->preference('RentalsInNoissuesCharge');
 846     unless ( C4::Context->preference('ManInvInNoissuesCharge') ) {
 847         my $dbh = C4::Context->dbh;
 848         my $man_inv_types = $dbh->selectcol_arrayref(qq{SELECT authorised_value FROM authorised_values WHERE category = 'MANUAL_INV'});
 849         push @not_fines, map substr($_, 0, $ACCOUNT_TYPE_LENGTH), @$man_inv_types;
 850     }
 851     my %not_fine = map {$_ => 1} @not_fines;
 852
 853     my ($total, $acctlines) = GetMemberAccountRecords($borrowernumber);
 854     my $other_charges = 0;
 855     foreach (@$acctlines) {
 856         $other_charges += $_->{amountoutstanding} if $not_fine{ substr($_->{accounttype}, 0, $ACCOUNT_TYPE_LENGTH) };
 857     }
 858
 859     return ( $total, $total - $other_charges, $other_charges);
 860 }
 861
 862 =head2 GetBorNotifyAcctRecord
 863
 864   ($total, $acctlines, $count) = &GetBorNotifyAcctRecord($params,$notifyid);
 865
 866 Looks up accounting data for the patron with the given borrowernumber per file number.
 867
 868 C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a
 869 reference-to-array, where each element is a reference-to-hash; the
 870 keys are the fields of the C<accountlines> table in the Koha database.
 871 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
 872 total amount outstanding for all of the account lines.
 873
 874 =cut
 875
 876 sub GetBorNotifyAcctRecord {
 877     my ( $borrowernumber, $notifyid ) = @_;
 878     my $dbh = C4::Context->dbh;
 879     my @acctlines;
 880     my $numlines = 0;
 881     my $sth = $dbh->prepare(
 882             "SELECT *
 883                 FROM accountlines
 884                 WHERE borrowernumber=?
 885                     AND notify_id=?
 886                     AND amountoutstanding != '0'
 887                 ORDER BY notify_id,accounttype
 888                 ");
 889
 890     $sth->execute( $borrowernumber, $notifyid );
 891     my $total = 0;
 892     while ( my $data = $sth->fetchrow_hashref ) {
 893         if ( $data->{itemnumber} ) {
 894             my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
 895             $data->{biblionumber} = $biblio->{biblionumber};
 896             $data->{title}        = $biblio->{title};
 897         }
 898         $acctlines[$numlines] = $data;
 899         $numlines++;
 900         $total += int(100 * $data->{'amountoutstanding'});
 901     }
 902     $total /= 100;
 903     return ( $total, \@acctlines, $numlines );
 904 }
 905
 906 sub checkcardnumber {
 907     my ( $cardnumber, $borrowernumber ) = @_;
 908
 909     # If cardnumber is null, we assume they're allowed.
 910     return 0 unless defined $cardnumber;
 911
 912     my $dbh = C4::Context->dbh;
 913     my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
 914     $query .= " AND borrowernumber <> ?" if ($borrowernumber);
 915     my $sth = $dbh->prepare($query);
 916     $sth->execute(
 917         $cardnumber,
 918         ( $borrowernumber ? $borrowernumber : () )
 919     );
 920
 921     return 1 if $sth->fetchrow_hashref;
 922
 923     my ( $min_length, $max_length ) = get_cardnumber_length();
 924     return 2
 925         if length $cardnumber > $max_length
 926         or length $cardnumber < $min_length;
 927
 928     return 0;
 929 }
 930
 931 =head2 get_cardnumber_length
 932
 933     my ($min, $max) = C4::Members::get_cardnumber_length()
 934
 935 Returns the minimum and maximum length for patron cardnumbers as
 936 determined by the CardnumberLength system preference, the
 937 BorrowerMandatoryField system preference, and the width of the
 938 database column.
 939
 940 =cut
 941
 942 sub get_cardnumber_length {
 943     my ( $min, $max ) = ( 0, 16 ); # borrowers.cardnumber is a nullable varchar(16)
 944     $min = 1 if C4::Context->preference('BorrowerMandatoryField') =~ /cardnumber/;
 945     if ( my $cardnumber_length = C4::Context->preference('CardnumberLength') ) {
 946         # Is integer and length match
 947         if ( $cardnumber_length =~ m|^\d+$| ) {
 948             $min = $max = $cardnumber_length
 949                 if $cardnumber_length >= $min
 950                     and $cardnumber_length <= $max;
 951         }
 952         # Else assuming it is a range
 953         elsif ( $cardnumber_length =~ m|(\d*),(\d*)| ) {
 954             $min = $1 if $1 and $min < $1;
 955             $max = $2 if $2 and $max > $2;
 956         }
 957
 958     }
 959     my $borrower = Koha::Schema->resultset('Borrower');
 960     my $field_size = $borrower->result_source->column_info('cardnumber')->{size};
 961     $min = $field_size if $min > $field_size;
 962     return ( $min, $max );
 963 }
 964
 965 =head2 GetFirstValidEmailAddress
 966
 967   $email = GetFirstValidEmailAddress($borrowernumber);
 968
 969 Return the first valid email address for a borrower, given the borrowernumber.  For now, the order
 970 is defined as email, emailpro, B_email.  Returns the empty string if the borrower has no email
 971 addresses.
 972
 973 =cut
 974
 975 sub GetFirstValidEmailAddress {
 976     my $borrowernumber = shift;
 977     my $dbh = C4::Context->dbh;
 978     my $sth = $dbh->prepare( "SELECT email, emailpro, B_email FROM borrowers where borrowernumber = ? ");
 979     $sth->execute( $borrowernumber );
 980     my $data = $sth->fetchrow_hashref;
 981
 982     if ($data->{'email'}) {
 983        return $data->{'email'};
 984     } elsif ($data->{'emailpro'}) {
 985        return $data->{'emailpro'};
 986     } elsif ($data->{'B_email'}) {
 987        return $data->{'B_email'};
 988     } else {
 989        return '';
 990     }
 991 }
 992
 993 =head2 GetNoticeEmailAddress
 994
 995   $email = GetNoticeEmailAddress($borrowernumber);
 996
 997 Return the email address of borrower used for notices, given the borrowernumber.
 998 Returns the empty string if no email address.
 999
1000 =cut
1001
1002 sub GetNoticeEmailAddress {
1003     my $borrowernumber = shift;
1004
1005     my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
1006     # if syspref is set to 'first valid' (value == OFF), look up email address
1007     if ( $which_address eq 'OFF' ) {
1008         return GetFirstValidEmailAddress($borrowernumber);
1009     }
1010     # specified email address field
1011     my $dbh = C4::Context->dbh;
1012     my $sth = $dbh->prepare( qq{
1013         SELECT $which_address AS primaryemail
1014         FROM borrowers
1015         WHERE borrowernumber=?
1016     } );
1017     $sth->execute($borrowernumber);
1018     my $data = $sth->fetchrow_hashref;
1019     return $data->{'primaryemail'} || '';
1020 }
1021
1022 =head2 GetBorrowersToExpunge
1023
1024   $borrowers = &GetBorrowersToExpunge(
1025       not_borrowed_since => $not_borrowed_since,
1026       expired_before       => $expired_before,
1027       category_code        => $category_code,
1028       patron_list_id       => $patron_list_id,
1029       branchcode           => $branchcode
1030   );
1031
1032   This function get all borrowers based on the given criteria.
1033
1034 =cut
1035
1036 sub GetBorrowersToExpunge {
1037
1038     my $params = shift;
1039     my $filterdate       = $params->{'not_borrowed_since'};
1040     my $filterexpiry     = $params->{'expired_before'};
1041     my $filterlastseen   = $params->{'last_seen'};
1042     my $filtercategory   = $params->{'category_code'};
1043     my $filterbranch     = $params->{'branchcode'} ||
1044                         ((C4::Context->preference('IndependentBranches')
1045                              && C4::Context->userenv
1046                              && !C4::Context->IsSuperLibrarian()
1047                              && C4::Context->userenv->{branch})
1048                          ? C4::Context->userenv->{branch}
1049                          : "");
1050     my $filterpatronlist = $params->{'patron_list_id'};
1051
1052     my $dbh   = C4::Context->dbh;
1053     my $query = q|
1054         SELECT borrowers.borrowernumber,
1055                MAX(old_issues.timestamp) AS latestissue,
1056                MAX(issues.timestamp) AS currentissue
1057         FROM   borrowers
1058         JOIN   categories USING (categorycode)
1059         LEFT JOIN (
1060             SELECT guarantorid
1061             FROM borrowers
1062             WHERE guarantorid IS NOT NULL
1063                 AND guarantorid <> 0
1064         ) as tmp ON borrowers.borrowernumber=tmp.guarantorid
1065         LEFT JOIN old_issues USING (borrowernumber)
1066         LEFT JOIN issues USING (borrowernumber)|;
1067     if ( $filterpatronlist  ){
1068         $query .= q| LEFT JOIN patron_list_patrons USING (borrowernumber)|;
1069     }
1070     $query .= q| WHERE  category_type <> 'S'
1071         AND tmp.guarantorid IS NULL
1072    |;
1073     my @query_params;
1074     if ( $filterbranch && $filterbranch ne "" ) {
1075         $query.= " AND borrowers.branchcode = ? ";
1076         push( @query_params, $filterbranch );
1077     }
1078     if ( $filterexpiry ) {
1079         $query .= " AND dateexpiry < ? ";
1080         push( @query_params, $filterexpiry );
1081     }
1082     if ( $filterlastseen ) {
1083         $query .= ' AND lastseen < ? ';
1084         push @query_params, $filterlastseen;
1085     }
1086     if ( $filtercategory ) {
1087         $query .= " AND categorycode = ? ";
1088         push( @query_params, $filtercategory );
1089     }
1090     if ( $filterpatronlist ){
1091         $query.=" AND patron_list_id = ? ";
1092         push( @query_params, $filterpatronlist );
1093     }
1094     $query.=" GROUP BY borrowers.borrowernumber HAVING currentissue IS NULL ";
1095     if ( $filterdate ) {
1096         $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
1097         push @query_params,$filterdate;
1098     }
1099     warn $query if $debug;
1100
1101     my $sth = $dbh->prepare($query);
1102     if (scalar(@query_params)>0){
1103         $sth->execute(@query_params);
1104     }
1105     else {
1106         $sth->execute;
1107     }
1108
1109     my @results;
1110     while ( my $data = $sth->fetchrow_hashref ) {
1111         push @results, $data;
1112     }
1113     return \@results;
1114 }
1115
1116 =head2 GetBorrowersWithIssuesHistoryOlderThan
1117
1118   $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
1119
1120 this function get all borrowers who has an issue history older than I<$date> given on input arg.
1121
1122 I<$result> is a ref to an array which all elements are a hashref.
1123 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
1124
1125 =cut
1126
1127 sub GetBorrowersWithIssuesHistoryOlderThan {
1128     my $dbh  = C4::Context->dbh;
1129     my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
1130     my $filterbranch = shift ||
1131                         ((C4::Context->preference('IndependentBranches')
1132                              && C4::Context->userenv
1133                              && !C4::Context->IsSuperLibrarian()
1134                              && C4::Context->userenv->{branch})
1135                          ? C4::Context->userenv->{branch}
1136                          : "");
1137     my $query = "
1138        SELECT count(borrowernumber) as n,borrowernumber
1139        FROM old_issues
1140        WHERE returndate < ?
1141          AND borrowernumber IS NOT NULL
1142     ";
1143     my @query_params;
1144     push @query_params, $date;
1145     if ($filterbranch){
1146         $query.="   AND branchcode = ?";
1147         push @query_params, $filterbranch;
1148     }
1149     $query.=" GROUP BY borrowernumber ";
1150     warn $query if $debug;
1151     my $sth = $dbh->prepare($query);
1152     $sth->execute(@query_params);
1153     my @results;
1154
1155     while ( my $data = $sth->fetchrow_hashref ) {
1156         push @results, $data;
1157     }
1158     return \@results;
1159 }
1160
1161 =head2 IssueSlip
1162
1163   IssueSlip($branchcode, $borrowernumber, $quickslip)
1164
1165   Returns letter hash ( see C4::Letters::GetPreparedLetter )
1166
1167   $quickslip is boolean, to indicate whether we want a quick slip
1168
1169   IssueSlip populates ISSUESLIP and ISSUEQSLIP, and will make the following expansions:
1170
1171   Both slips:
1172
1173       <<branches.*>>
1174       <<borrowers.*>>
1175
1176   ISSUESLIP:
1177
1178       <checkedout>
1179          <<biblio.*>>
1180          <<items.*>>
1181          <<biblioitems.*>>
1182          <<issues.*>>
1183       </checkedout>
1184
1185       <overdue>
1186          <<biblio.*>>
1187          <<items.*>>
1188          <<biblioitems.*>>
1189          <<issues.*>>
1190       </overdue>
1191
1192       <news>
1193          <<opac_news.*>>
1194       </news>
1195
1196   ISSUEQSLIP:
1197
1198       <checkedout>
1199          <<biblio.*>>
1200          <<items.*>>
1201          <<biblioitems.*>>
1202          <<issues.*>>
1203       </checkedout>
1204
1205   NOTE: Not all table fields are available, pleasee see GetPendingIssues for a list of available fields.
1206
1207 =cut
1208
1209 sub IssueSlip {
1210     my ($branch, $borrowernumber, $quickslip) = @_;
1211
1212     # FIXME Check callers before removing this statement
1213     #return unless $borrowernumber;
1214
1215     my @issues = @{ GetPendingIssues($borrowernumber) };
1216
1217     for my $issue (@issues) {
1218         $issue->{date_due} = $issue->{date_due_sql};
1219         if ($quickslip) {
1220             my $today = output_pref({ dt => dt_from_string, dateformat => 'iso', dateonly => 1 });
1221             if ( substr( $issue->{issuedate}, 0, 10 ) eq $today
1222                 or substr( $issue->{lastreneweddate}, 0, 10 ) eq $today ) {
1223                   $issue->{now} = 1;
1224             };
1225         }
1226     }
1227
1228     # Sort on timestamp then on issuedate (useful for tests and could be if modified in a batch
1229     @issues = sort {
1230         my $s = $b->{timestamp} <=> $a->{timestamp};
1231         $s == 0 ?
1232              $b->{issuedate} <=> $a->{issuedate} : $s;
1233     } @issues;
1234
1235     my ($letter_code, %repeat);
1236     if ( $quickslip ) {
1237         $letter_code = 'ISSUEQSLIP';
1238         %repeat =  (
1239             'checkedout' => [ map {
1240                 'biblio'       => $_,
1241                 'items'        => $_,
1242                 'biblioitems'  => $_,
1243                 'issues'       => $_,
1244             }, grep { $_->{'now'} } @issues ],
1245         );
1246     }
1247     else {
1248         $letter_code = 'ISSUESLIP';
1249         %repeat =  (
1250             'checkedout' => [ map {
1251                 'biblio'       => $_,
1252                 'items'        => $_,
1253                 'biblioitems'  => $_,
1254                 'issues'       => $_,
1255             }, grep { !$_->{'overdue'} } @issues ],
1256
1257             'overdue' => [ map {
1258                 'biblio'       => $_,
1259                 'items'        => $_,
1260                 'biblioitems'  => $_,
1261                 'issues'       => $_,
1262             }, grep { $_->{'overdue'} } @issues ],
1263
1264             'news' => [ map {
1265                 $_->{'timestamp'} = $_->{'newdate'};
1266                 { opac_news => $_ }
1267             } @{ GetNewsToDisplay("slip",$branch) } ],
1268         );
1269     }
1270
1271     return  C4::Letters::GetPreparedLetter (
1272         module => 'circulation',
1273         letter_code => $letter_code,
1274         branchcode => $branch,
1275         tables => {
1276             'branches'    => $branch,
1277             'borrowers'   => $borrowernumber,
1278         },
1279         repeat => \%repeat,
1280     );
1281 }
1282
1283 =head2 GetBorrowersWithEmail
1284
1285     ([$borrnum,$userid], ...) = GetBorrowersWithEmail('me@example.com');
1286
1287 This gets a list of users and their basic details from their email address.
1288 As it's possible for multiple user to have the same email address, it provides
1289 you with all of them. If there is no userid for the user, there will be an
1290 C<undef> there. An empty list will be returned if there are no matches.
1291
1292 =cut
1293
1294 sub GetBorrowersWithEmail {
1295     my $email = shift;
1296
1297     my $dbh = C4::Context->dbh;
1298
1299     my $query = "SELECT borrowernumber, userid FROM borrowers WHERE email=?";
1300     my $sth=$dbh->prepare($query);
1301     $sth->execute($email);
1302     my @result = ();
1303     while (my $ref = $sth->fetch) {
1304         push @result, $ref;
1305     }
1306     die "Failure searching for borrowers by email address: $sth->errstr" if $sth->err;
1307     return @result;
1308 }
1309
1310 =head2 AddMember_Opac
1311
1312 =cut
1313
1314 sub AddMember_Opac {
1315     my ( %borrower ) = @_;
1316
1317     $borrower{'categorycode'} //= C4::Context->preference('PatronSelfRegistrationDefaultCategory');
1318     if (not defined $borrower{'password'}){
1319         my $sr = new String::Random;
1320         $sr->{'A'} = [ 'A'..'Z', 'a'..'z' ];
1321         my $password = $sr->randpattern("AAAAAAAAAA");
1322         $borrower{'password'} = $password;
1323     }
1324
1325     $borrower{'cardnumber'} = fixup_cardnumber( $borrower{'cardnumber'} );
1326
1327     my $borrowernumber = AddMember(%borrower);
1328
1329     return ( $borrowernumber, $borrower{'password'} );
1330 }
1331
1332 =head2 DeleteExpiredOpacRegistrations
1333
1334     Delete accounts that haven't been upgraded from the 'temporary' category
1335     Returns the number of removed patrons
1336
1337 =cut
1338
1339 sub DeleteExpiredOpacRegistrations {
1340
1341     my $delay = C4::Context->preference('PatronSelfRegistrationExpireTemporaryAccountsDelay');
1342     my $category_code = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
1343
1344     return 0 if not $category_code or not defined $delay or $delay eq q||;
1345
1346     my $query = qq|
1347 SELECT borrowernumber
1348 FROM borrowers
1349 WHERE categorycode = ? AND DATEDIFF( NOW(), dateenrolled ) > ? |;
1350
1351     my $dbh = C4::Context->dbh;
1352     my $sth = $dbh->prepare($query);
1353     $sth->execute( $category_code, $delay );
1354     my $cnt=0;
1355     while ( my ($borrowernumber) = $sth->fetchrow_array() ) {
1356         Koha::Patrons->find($borrowernumber)->delete;
1357         $cnt++;
1358     }
1359     return $cnt;
1360 }
1361
1362 =head2 DeleteUnverifiedOpacRegistrations
1363
1364     Delete all unverified self registrations in borrower_modifications,
1365     older than the specified number of days.
1366
1367 =cut
1368
1369 sub DeleteUnverifiedOpacRegistrations {
1370     my ( $days ) = @_;
1371     my $dbh = C4::Context->dbh;
1372     my $sql=qq|
1373 DELETE FROM borrower_modifications
1374 WHERE borrowernumber = 0 AND DATEDIFF( NOW(), timestamp ) > ?|;
1375     my $cnt=$dbh->do($sql, undef, ($days) );
1376     return $cnt eq '0E0'? 0: $cnt;
1377 }
1378
1379 sub GetOverduesForPatron {
1380     my ( $borrowernumber ) = @_;
1381
1382     my $sql = "
1383         SELECT *
1384         FROM issues, items, biblio, biblioitems
1385         WHERE items.itemnumber=issues.itemnumber
1386           AND biblio.biblionumber   = items.biblionumber
1387           AND biblio.biblionumber   = biblioitems.biblionumber
1388           AND issues.borrowernumber = ?
1389           AND date_due < NOW()
1390     ";
1391
1392     my $sth = C4::Context->dbh->prepare( $sql );
1393     $sth->execute( $borrowernumber );
1394
1395     return $sth->fetchall_arrayref({});
1396 }
1397
1398 END { }    # module clean-up code here (global destructor)
1399
1400 1;
1401
1402 __END__
1403
1404 =head1 AUTHOR
1405
1406 Koha Team
1407
1408 =cut