File Coverage

File:C4/Circulation.pm
Coverage:7.7%

linestmtbrancondsubtimecode
1package C4::Circulation;
2
3# Copyright 2000-2002 Katipo Communications
4# copyright 2010 BibLibre
5#
6# This file is part of Koha.
7#
8# Koha is free software; you can redistribute it and/or modify it under the
9# terms of the GNU General Public License as published by the Free Software
10# Foundation; either version 2 of the License, or (at your option) any later
11# version.
12#
13# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
14# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
15# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
16#
17# You should have received a copy of the GNU General Public License along
18# with Koha; if not, write to the Free Software Foundation, Inc.,
19# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
20
21
22
14
14
14
445
122
1019
use strict;
23#use warnings; FIXME - Bug 2505
24
14
14
14
34935
2619489
1088
use DateTime;
25
14
14
14
739
254
439
use C4::Context;
26
14
14
14
2961
103
1591
use C4::Stats;
27
14
14
14
2425
296
5648
use C4::Reserves;
28
14
14
14
323
209
9084
use C4::Biblio;
29
14
14
14
235
144
2896
use C4::Items;
30
14
14
14
257
98
1223
use C4::Members;
31
14
14
14
175
82
688
use C4::Dates;
32
14
14
14
117
68
864
use C4::Dates qw(format_date);
33
14
14
14
119
113
2824
use C4::Accounts;
34
14
14
14
3643
132
679
use C4::ItemCirculationAlertPreference;
35
14
14
14
2118
173
792
use C4::Message;
36
14
14
14
203
146
1677
use C4::Debug;
37
14
14
14
257
139
2183
use C4::Branch; # GetBranches
38
14
14
14
165
100
1517
use C4::Log; # logaction
39
40
14
14
14
166
90
705
use Data::Dumper;
41
14
14
14
2589
45
2784
use Koha::DateUtils;
42
14
14
14
2444
105
783
use Koha::Calendar;
43
14
14
14
203
84
1151
use Carp;
44
45
14
14
14
149
74
3210
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
46
47BEGIN {
48
14
122
        require Exporter;
49
14
71
        $VERSION = 3.02; # for version checking
50
14
185
        @ISA = qw(Exporter);
51
52        # FIXME subs that should probably be elsewhere
53
14
97
        push @EXPORT, qw(
54                &barcodedecode
55        &LostItem
56        &ReturnLostItem
57        );
58
59        # subs to deal with issuing a book
60
14
169
        push @EXPORT, qw(
61                &CanBookBeIssued
62                &CanBookBeRenewed
63                &AddIssue
64                &AddRenewal
65                &GetRenewCount
66                &GetItemIssue
67                &GetItemIssues
68                &GetIssuingCharges
69                &GetIssuingRule
70        &GetBranchBorrowerCircRule
71        &GetBranchItemRule
72                &GetBiblioIssues
73                &GetOpenIssue
74                &AnonymiseIssueHistory
75        );
76
77        # subs to deal with returns
78
14
124
        push @EXPORT, qw(
79                &AddReturn
80        &MarkIssueReturned
81        );
82
83        # subs to deal with transfers
84
14
98
        push @EXPORT, qw(
85                &transferbook
86                &GetTransfers
87                &GetTransfersFromTo
88                &updateWrongTransfer
89                &DeleteTransfer
90                &IsBranchTransferAllowed
91                &CreateBranchTransferLimit
92                &DeleteBranchTransferLimits
93        &TransferSlip
94        );
95
96    # subs to deal with offline circulation
97
14
232351
    push @EXPORT, qw(
98      &GetOfflineOperations
99      &GetOfflineOperation
100      &AddOfflineOperation
101      &DeleteOfflineOperation
102      &ProcessOfflineOperation
103    );
104}
105
106 - 137
=head1 NAME

C4::Circulation - Koha circulation module

=head1 SYNOPSIS

use C4::Circulation;

=head1 DESCRIPTION

The functions in this module deal with circulation, issues, and
returns, as well as general information about the library.
Also deals with stocktaking.

=head1 FUNCTIONS

=head2 barcodedecode

  $str = &barcodedecode($barcode, [$filter]);

Generic filter function for barcode string.
Called on every circ if the System Pref itemBarcodeInputFilter is set.
Will do some manipulation of the barcode for systems that deliver a barcode
to circulation.pl that differs from the barcode stored for the item.
For proper functioning of this filter, calling the function on the 
correct barcode string (items.barcode) should return an unaltered barcode.

The optional $filter argument is to allow for testing or explicit 
behavior that ignores the System Pref.  Valid values are the same as the 
System Pref options.

=cut
138
139# FIXME -- the &decode fcn below should be wrapped into this one.
140# FIXME -- these plugins should be moved out of Circulation.pm
141#
142sub barcodedecode {
143
23
65
    my ($barcode, $filter) = @_;
144
23
139
    my $branch = C4::Branch::mybranch();
145
23
66
    $filter = C4::Context->preference('itemBarcodeInputFilter') unless $filter;
146
23
57
    $filter or return $barcode; # ensure filter is defined, else return untouched barcode
147
23
89
        if ($filter eq 'whitespace') {
148
3
19
                $barcode =~ s/\s//g;
149        } elsif ($filter eq 'cuecat') {
150
5
8
                chomp($barcode);
151
5
23
            my @fields = split( /\./, $barcode );
152
5
25
            my @results = map( decode($_), @fields[ 1 .. $#fields ] );
153
5
46
            ($#results == 2) and return $results[2];
154        } elsif ($filter eq 'T-prefix') {
155
2
12
                if ($barcode =~ /^[Tt](\d)/) {
156
2
23
                        (defined($1) and $1 eq '0') and return $barcode;
157
1
4
            $barcode = substr($barcode, 2) + 0; # FIXME: probably should be substr($barcode, 1)
158                }
159
1
11
        return sprintf("T%07d", $barcode);
160        # FIXME: $barcode could be "T1", causing warning: substr outside of string
161        # Why drop the nonzero digit after the T?
162        # Why pass non-digits (or empty string) to "T%07d"?
163        } elsif ($filter eq 'libsuite8') {
164
8
54
                unless($barcode =~ m/^($branch)-/i){ #if barcode starts with branch code its in Koha style. Skip it.
165
6
18
                        if($barcode =~ m/^(\d)/i){ #Some barcodes even start with 0's & numbers and are assumed to have b as the item type in the libsuite8 software
166
2
15
                                $barcode =~ s/^[0]*(\d+)$/$branch-b-$1/i;
167                        }else{
168
4
41
                                $barcode =~ s/^(\D+)[0]*(\d+)$/$branch-$1-$2/i;
169                        }
170                }
171        }
172
17
128
    return $barcode; # return barcode, modified or not
173}
174
175 - 185
=head2 decode

  $str = &decode($chunk);

Decodes a segment of a string emitted by a CueCat barcode scanner and
returns it.

FIXME: Should be replaced with Barcode::Cuecat from CPAN
or Javascript based decoding on the client side.

=cut
186
187sub decode {
188
13
22
    my ($encoded) = @_;
189
13
15
    my $seq =
190      'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
191
13
185
57
234
    my @s = map { index( $seq, $_ ); } split( //, $encoded );
192
13
48
    my $l = ( $#s + 1 ) % 4;
193
13
24
    if ($l) {
194
1
4
        if ( $l == 1 ) {
195            # warn "Error: Cuecat decode parsing failed!";
196
1
3
            return;
197        }
198
0
0
        $l = 4 - $l;
199
0
0
        $#s += $l;
200    }
201
12
15
    my $r = '';
202
12
40
    while ( $#s >= 0 ) {
203
46
67
        my $n = ( ( $s[0] << 6 | $s[1] ) << 6 | $s[2] ) << 6 | $s[3];
204
46
86
        $r .=
205            chr( ( $n >> 16 ) ^ 67 )
206         .chr( ( $n >> 8 & 255 ) ^ 67 )
207         .chr( ( $n & 255 ) ^ 67 );
208
46
233
        @s = @s[ 4 .. $#s ];
209    }
210
12
21
    $r = substr( $r, 0, length($r) - $l );
211
12
52
    return $r;
212}
213
214 - 270
=head2 transferbook

  ($dotransfer, $messages, $iteminformation) = &transferbook($newbranch, 
                                            $barcode, $ignore_reserves);

Transfers an item to a new branch. If the item is currently on loan, it is automatically returned before the actual transfer.

C<$newbranch> is the code for the branch to which the item should be transferred.

C<$barcode> is the barcode of the item to be transferred.

If C<$ignore_reserves> is true, C<&transferbook> ignores reserves.
Otherwise, if an item is reserved, the transfer fails.

Returns three values:

=over

=item $dotransfer 

is true if the transfer was successful.

=item $messages

is a reference-to-hash which may have any of the following keys:

=over

=item C<BadBarcode>

There is no item in the catalog with the given barcode. The value is C<$barcode>.

=item C<IsPermanent>

The item's home branch is permanent. This doesn't prevent the item from being transferred, though. The value is the code of the item's home branch.

=item C<DestinationEqualsHolding>

The item is already at the branch to which it is being transferred. The transfer is nonetheless considered to have failed. The value should be ignored.

=item C<WasReturned>

The item was on loan, and C<&transferbook> automatically returned it before transferring it. The value is the borrower number of the patron who had the item.

=item C<ResFound>

The item was reserved. The value is a reference-to-hash whose keys are fields from the reserves table of the Koha database, and C<biblioitemnumber>. It also has the key C<ResFound>, whose value is either C<Waiting> or C<Reserved>.

=item C<WasTransferred>

The item was eligible to be transferred. Barring problems communicating with the database, the transfer should indeed have succeeded. The value should be ignored.

=back

=back

=cut
271
272sub transferbook {
273
0
    my ( $tbr, $barcode, $ignoreRs ) = @_;
274
0
    my $messages;
275
0
    my $dotransfer = 1;
276
0
    my $branches = GetBranches();
277
0
    my $itemnumber = GetItemnumberFromBarcode( $barcode );
278
0
    my $issue = GetItemIssue($itemnumber);
279
0
    my $biblio = GetBiblioFromItemNumber($itemnumber);
280
281    # bad barcode..
282
0
    if ( not $itemnumber ) {
283
0
        $messages->{'BadBarcode'} = $barcode;
284
0
        $dotransfer = 0;
285    }
286
287    # get branches of book...
288
0
    my $hbr = $biblio->{'homebranch'};
289
0
    my $fbr = $biblio->{'holdingbranch'};
290
291    # if using Branch Transfer Limits
292
0
    if ( C4::Context->preference("UseBranchTransferLimits") == 1 ) {
293
0
        if ( C4::Context->preference("item-level_itypes") && C4::Context->preference("BranchTransferLimitsType") eq 'itemtype' ) {
294
0
            if ( ! IsBranchTransferAllowed( $tbr, $fbr, $biblio->{'itype'} ) ) {
295
0
                $messages->{'NotAllowed'} = $tbr . "::" . $biblio->{'itype'};
296
0
                $dotransfer = 0;
297            }
298        } elsif ( ! IsBranchTransferAllowed( $tbr, $fbr, $biblio->{ C4::Context->preference("BranchTransferLimitsType") } ) ) {
299
0
            $messages->{'NotAllowed'} = $tbr . "::" . $biblio->{ C4::Context->preference("BranchTransferLimitsType") };
300
0
            $dotransfer = 0;
301     }
302    }
303
304    # if is permanent...
305
0
    if ( $hbr && $branches->{$hbr}->{'PE'} ) {
306
0
        $messages->{'IsPermanent'} = $hbr;
307
0
        $dotransfer = 0;
308    }
309
310    # can't transfer book if is already there....
311
0
    if ( $fbr eq $tbr ) {
312
0
        $messages->{'DestinationEqualsHolding'} = 1;
313
0
        $dotransfer = 0;
314    }
315
316    # check if it is still issued to someone, return it...
317
0
    if ($issue->{borrowernumber}) {
318
0
        AddReturn( $barcode, $fbr );
319
0
        $messages->{'WasReturned'} = $issue->{borrowernumber};
320    }
321
322    # find reserves.....
323    # That'll save a database query.
324
0
    my ( $resfound, $resrec, undef ) =
325      CheckReserves( $itemnumber );
326
0
    if ( $resfound and not $ignoreRs ) {
327
0
        $resrec->{'ResFound'} = $resfound;
328
329        # $messages->{'ResFound'} = $resrec;
330
0
        $dotransfer = 1;
331    }
332
333    #actually do the transfer....
334
0
    if ($dotransfer) {
335
0
        ModItemTransfer( $itemnumber, $fbr, $tbr );
336
337        # don't need to update MARC anymore, we do it in batch now
338
0
        $messages->{'WasTransfered'} = 1;
339
340    }
341
0
    ModDateLastSeen( $itemnumber );
342
0
    return ( $dotransfer, $messages, $biblio );
343}
344
345
346sub TooMany {
347
0
    my $borrower = shift;
348
0
    my $biblionumber = shift;
349
0
        my $item = shift;
350
0
    my $cat_borrower = $borrower->{'categorycode'};
351
0
    my $dbh = C4::Context->dbh;
352
0
        my $branch;
353        # Get which branchcode we need
354
0
        $branch = _GetCircControlBranch($item,$borrower);
355
0
        my $type = (C4::Context->preference('item-level_itypes'))
356     ? $item->{'itype'} # item-level
357                        : $item->{'itemtype'}; # biblio-level
358
359    # given branch, patron category, and item type, determine
360    # applicable issuing rule
361
0
    my $issuing_rule = GetIssuingRule($cat_borrower, $type, $branch);
362
363    # if a rule is found and has a loan limit set, count
364    # how many loans the patron already has that meet that
365    # rule
366
0
    if (defined($issuing_rule) and defined($issuing_rule->{'maxissueqty'})) {
367
0
        my @bind_params;
368
0
        my $count_query = "SELECT COUNT(*) FROM issues
369                           JOIN items USING (itemnumber) ";
370
371
0
        my $rule_itemtype = $issuing_rule->{itemtype};
372
0
        if ($rule_itemtype eq "*") {
373            # matching rule has the default item type, so count only
374            # those existing loans that don't fall under a more
375            # specific rule
376
0
            if (C4::Context->preference('item-level_itypes')) {
377
0
                $count_query .= " WHERE items.itype NOT IN (
378                                    SELECT itemtype FROM issuingrules
379                                    WHERE branchcode = ?
380                                    AND (categorycode = ? OR categorycode = ?)
381                                    AND itemtype <> '*'
382                                  ) ";
383            } else {
384
0
                $count_query .= " JOIN biblioitems USING (biblionumber)
385                                  WHERE biblioitems.itemtype NOT IN (
386                                    SELECT itemtype FROM issuingrules
387                                    WHERE branchcode = ?
388                                    AND (categorycode = ? OR categorycode = ?)
389                                    AND itemtype <> '*'
390                                  ) ";
391            }
392
0
            push @bind_params, $issuing_rule->{branchcode};
393
0
            push @bind_params, $issuing_rule->{categorycode};
394
0
            push @bind_params, $cat_borrower;
395        } else {
396            # rule has specific item type, so count loans of that
397            # specific item type
398
0
            if (C4::Context->preference('item-level_itypes')) {
399
0
                $count_query .= " WHERE items.itype = ? ";
400            } else {
401
0
                $count_query .= " JOIN biblioitems USING (biblionumber)
402                                  WHERE biblioitems.itemtype= ? ";
403            }
404
0
            push @bind_params, $type;
405        }
406
407
0
        $count_query .= " AND borrowernumber = ? ";
408
0
        push @bind_params, $borrower->{'borrowernumber'};
409
0
        my $rule_branch = $issuing_rule->{branchcode};
410
0
        if ($rule_branch ne "*") {
411
0
            if (C4::Context->preference('CircControl') eq 'PickupLibrary') {
412
0
                $count_query .= " AND issues.branchcode = ? ";
413
0
                push @bind_params, $branch;
414            } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') {
415                ; # if branch is the patron's home branch, then count all loans by patron
416            } else {
417
0
                $count_query .= " AND items.homebranch = ? ";
418
0
                push @bind_params, $branch;
419            }
420        }
421
422
0
        my $count_sth = $dbh->prepare($count_query);
423
0
        $count_sth->execute(@bind_params);
424
0
        my ($current_loan_count) = $count_sth->fetchrow_array;
425
426
0
        my $max_loans_allowed = $issuing_rule->{'maxissueqty'};
427
0
        if ($current_loan_count >= $max_loans_allowed) {
428
0
            return ($current_loan_count, $max_loans_allowed);
429        }
430    }
431
432    # Now count total loans against the limit for the branch
433
0
    my $branch_borrower_circ_rule = GetBranchBorrowerCircRule($branch, $cat_borrower);
434
0
    if (defined($branch_borrower_circ_rule->{maxissueqty})) {
435
0
        my @bind_params = ();
436
0
        my $branch_count_query = "SELECT COUNT(*) FROM issues
437                                  JOIN items USING (itemnumber)
438                                  WHERE borrowernumber = ? ";
439
0
        push @bind_params, $borrower->{borrowernumber};
440
441
0
        if (C4::Context->preference('CircControl') eq 'PickupLibrary') {
442
0
            $branch_count_query .= " AND issues.branchcode = ? ";
443
0
            push @bind_params, $branch;
444        } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') {
445            ; # if branch is the patron's home branch, then count all loans by patron
446        } else {
447
0
            $branch_count_query .= " AND items.homebranch = ? ";
448
0
            push @bind_params, $branch;
449        }
450
0
        my $branch_count_sth = $dbh->prepare($branch_count_query);
451
0
        $branch_count_sth->execute(@bind_params);
452
0
        my ($current_loan_count) = $branch_count_sth->fetchrow_array;
453
454
0
        my $max_loans_allowed = $branch_borrower_circ_rule->{maxissueqty};
455
0
        if ($current_loan_count >= $max_loans_allowed) {
456
0
            return ($current_loan_count, $max_loans_allowed);
457        }
458    }
459
460    # OK, the patron can issue !!!
461
0
    return;
462}
463
464 - 506
=head2 itemissues

  @issues = &itemissues($biblioitemnumber, $biblio);

Looks up information about who has borrowed the bookZ<>(s) with the
given biblioitemnumber.

C<$biblio> is ignored.

C<&itemissues> returns an array of references-to-hash. The keys
include the fields from the C<items> table in the Koha database.
Additional keys include:

=over 4

=item C<date_due>

If the item is currently on loan, this gives the due date.

If the item is not on loan, then this is either "Available" or
"Cancelled", if the item has been withdrawn.

=item C<card>

If the item is currently on loan, this gives the card number of the
patron who currently has the item.

=item C<timestamp0>, C<timestamp1>, C<timestamp2>

These give the timestamp for the last three times the item was
borrowed.

=item C<card0>, C<card1>, C<card2>

The card number of the last three patrons who borrowed this item.

=item C<borrower0>, C<borrower1>, C<borrower2>

The borrower number of the last three patrons who borrowed this item.

=back

=cut
507
508#'
509sub itemissues {
510
0
    my ( $bibitem, $biblio ) = @_;
511
0
    my $dbh = C4::Context->dbh;
512
0
    my $sth =
513      $dbh->prepare("Select * from items where items.biblioitemnumber = ?")
514      || die $dbh->errstr;
515
0
    my $i = 0;
516
0
    my @results;
517
518
0
    $sth->execute($bibitem) || die $sth->errstr;
519
520
0
    while ( my $data = $sth->fetchrow_hashref ) {
521
522        # Find out who currently has this item.
523        # FIXME - Wouldn't it be better to do this as a left join of
524        # some sort? Currently, this code assumes that if
525        # fetchrow_hashref() fails, then the book is on the shelf.
526        # fetchrow_hashref() can fail for any number of reasons (e.g.,
527        # database server crash), not just because no items match the
528        # search criteria.
529
0
        my $sth2 = $dbh->prepare(
530            "SELECT * FROM issues
531                LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
532                WHERE itemnumber = ?
533            "
534        );
535
536
0
        $sth2->execute( $data->{'itemnumber'} );
537
0
        if ( my $data2 = $sth2->fetchrow_hashref ) {
538
0
            $data->{'date_due'} = $data2->{'date_due'};
539
0
            $data->{'card'} = $data2->{'cardnumber'};
540
0
            $data->{'borrower'} = $data2->{'borrowernumber'};
541        }
542        else {
543
0
            $data->{'date_due'} = ($data->{'wthdrawn'} eq '1') ? 'Cancelled' : 'Available';
544        }
545
546
547        # Find the last 3 people who borrowed this item.
548
0
        $sth2 = $dbh->prepare(
549            "SELECT * FROM old_issues
550                LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
551                WHERE itemnumber = ?
552                ORDER BY returndate DESC,timestamp DESC"
553        );
554
555
0
        $sth2->execute( $data->{'itemnumber'} );
556        for ( my $i2 = 0 ; $i2 < 2 ; $i2++ )
557        { # FIXME : error if there is less than 3 pple borrowing this item
558
0
            if ( my $data2 = $sth2->fetchrow_hashref ) {
559
0
                $data->{"timestamp$i2"} = $data2->{'timestamp'};
560
0
                $data->{"card$i2"} = $data2->{'cardnumber'};
561
0
                $data->{"borrower$i2"} = $data2->{'borrowernumber'};
562            } # if
563
0
        } # for
564
565
0
        $results[$i] = $data;
566
0
        $i++;
567    }
568
569
0
    return (@results);
570}
571
572 - 664
=head2 CanBookBeIssued

  ( $issuingimpossible, $needsconfirmation ) =  CanBookBeIssued( $borrower, 
                      $barcode, $duedatespec, $inprocess, $ignore_reserves );

Check if a book can be issued.

C<$issuingimpossible> and C<$needsconfirmation> are some hashref.

=over 4

=item C<$borrower> hash with borrower informations (from GetMember or GetMemberDetails)

=item C<$barcode> is the bar code of the book being issued.

=item C<$duedatespec> is a C4::Dates object.

=item C<$inprocess> boolean switch
=item C<$ignore_reserves> boolean switch

=back

Returns :

=over 4

=item C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
Possible values are :

=back

=head3 INVALID_DATE 

sticky due date is invalid

=head3 GNA

borrower gone with no address

=head3 CARD_LOST

borrower declared it's card lost

=head3 DEBARRED

borrower debarred

=head3 UNKNOWN_BARCODE

barcode unknown

=head3 NOT_FOR_LOAN

item is not for loan

=head3 WTHDRAWN

item withdrawn.

=head3 RESTRICTED

item is restricted (set by ??)

C<$needsconfirmation> a reference to a hash. It contains reasons why the loan 
could be prevented, but ones that can be overriden by the operator.

Possible values are :

=head3 DEBT

borrower has debts.

=head3 RENEW_ISSUE

renewing, not issuing

=head3 ISSUED_TO_ANOTHER

issued to someone else.

=head3 RESERVED

reserved for someone else.

=head3 INVALID_DATE

sticky due date is invalid or due date in the past

=head3 TOO_MANY

if the borrower borrows to much things

=cut
665
666sub CanBookBeIssued {
667
0
    my ( $borrower, $barcode, $duedate, $inprocess, $ignore_reserves ) = @_;
668
0
    my %needsconfirmation; # filled with problems that needs confirmations
669
0
    my %issuingimpossible; # filled with problems that causes the issue to be IMPOSSIBLE
670
0
    my $item = GetItem(GetItemnumberFromBarcode( $barcode ));
671
0
    my $issue = GetItemIssue($item->{itemnumber});
672
0
        my $biblioitem = GetBiblioItemData($item->{biblioitemnumber});
673
0
        $item->{'itemtype'}=$item->{'itype'};
674
0
    my $dbh = C4::Context->dbh;
675
676    # MANDATORY CHECKS - unless item exists, nothing else matters
677
0
    unless ( $item->{barcode} ) {
678
0
        $issuingimpossible{UNKNOWN_BARCODE} = 1;
679    }
680
0
        return ( \%issuingimpossible, \%needsconfirmation ) if %issuingimpossible;
681
682    #
683    # DUE DATE is OK ? -- should already have checked.
684    #
685
0
    if ($duedate && ref $duedate ne 'DateTime') {
686
0
        $duedate = dt_from_string($duedate);
687    }
688
0
    my $now = DateTime->now( time_zone => C4::Context->tz() );
689
0
    unless ( $duedate ) {
690
0
        my $issuedate = $now->clone();
691
692
0
        my $branch = _GetCircControlBranch($item,$borrower);
693
0
        my $itype = ( C4::Context->preference('item-level_itypes') ) ? $item->{'itype'} : $biblioitem->{'itemtype'};
694
0
        $duedate = CalcDateDue( $issuedate, $itype, $branch, $borrower );
695
696        # Offline circ calls AddIssue directly, doesn't run through here
697        # So issuingimpossible should be ok.
698    }
699
0
    if ($duedate) {
700
0
        my $today = $now->clone();
701
0
        $today->truncate( to => 'minutes');
702
0
        if (DateTime->compare($duedate,$today) == -1 ) { # duedate cannot be before now
703
0
            $needsconfirmation{INVALID_DATE} = output_pref($duedate);
704        }
705    } else {
706
0
            $issuingimpossible{INVALID_DATE} = output_pref($duedate);
707    }
708
709    #
710    # BORROWER STATUS
711    #
712
0
    if ( $borrower->{'category_type'} eq 'X' && ( $item->{barcode} )) {
713     # stats only borrower -- add entry to statistics table, and return issuingimpossible{STATS} = 1 .
714
0
        &UpdateStats(C4::Context->userenv->{'branch'},'localuse','','',$item->{'itemnumber'},$item->{'itemtype'},$borrower->{'borrowernumber'});
715
0
        ModDateLastSeen( $item->{'itemnumber'} );
716
0
        return( { STATS => 1 }, {});
717    }
718
0
    if ( $borrower->{flags}->{GNA} ) {
719
0
        $issuingimpossible{GNA} = 1;
720    }
721
0
    if ( $borrower->{flags}->{'LOST'} ) {
722
0
        $issuingimpossible{CARD_LOST} = 1;
723    }
724
0
    if ( $borrower->{flags}->{'DBARRED'} ) {
725
0
        $issuingimpossible{DEBARRED} = 1;
726    }
727
0
    if ( !defined $borrower->{dateexpiry} || $borrower->{'dateexpiry'} eq '0000-00-00') {
728
0
        $issuingimpossible{EXPIRED} = 1;
729    } else {
730
0
        my ($y, $m, $d) = split /-/,$borrower->{'dateexpiry'};
731
0
        if ($y && $m && $d) { # are we really writing oinvalid dates to borrs
732
0
            my $expiry_dt = DateTime->new(
733                year => $y,
734                month => $m,
735                day => $d,
736                time_zone => C4::Context->tz,
737            );
738
0
            $expiry_dt->truncate( to => 'days');
739
0
            my $today = $now->clone()->truncate(to => 'days');
740
0
            if (DateTime->compare($today, $expiry_dt) == 1) {
741
0
                $issuingimpossible{EXPIRED} = 1;
742            }
743        } else {
744
0
            carp("Invalid expity date in borr");
745
0
            $issuingimpossible{EXPIRED} = 1;
746        }
747    }
748    #
749    # BORROWER STATUS
750    #
751
752    # DEBTS
753
0
    my ($amount) =
754      C4::Members::GetMemberAccountRecords( $borrower->{'borrowernumber'}, '' && $duedate->ymd() );
755
0
    my $amountlimit = C4::Context->preference("noissuescharge");
756
0
    my $allowfineoverride = C4::Context->preference("AllowFineOverride");
757
0
    my $allfinesneedoverride = C4::Context->preference("AllFinesNeedOverride");
758
0
    if ( C4::Context->preference("IssuingInProcess") ) {
759
0
        if ( $amount > $amountlimit && !$inprocess && !$allowfineoverride) {
760
0
            $issuingimpossible{DEBT} = sprintf( "%.2f", $amount );
761        } elsif ( $amount > $amountlimit && !$inprocess && $allowfineoverride) {
762
0
            $needsconfirmation{DEBT} = sprintf( "%.2f", $amount );
763        } elsif ( $allfinesneedoverride && $amount > 0 && $amount <= $amountlimit && !$inprocess ) {
764
0
            $needsconfirmation{DEBT} = sprintf( "%.2f", $amount );
765        }
766    }
767    else {
768
0
        if ( $amount > $amountlimit && $allowfineoverride ) {
769
0
            $needsconfirmation{DEBT} = sprintf( "%.2f", $amount );
770        } elsif ( $amount > $amountlimit && !$allowfineoverride) {
771
0
            $issuingimpossible{DEBT} = sprintf( "%.2f", $amount );
772        } elsif ( $amount > 0 && $allfinesneedoverride ) {
773
0
            $needsconfirmation{DEBT} = sprintf( "%.2f", $amount );
774        }
775    }
776
777
0
    my ($blocktype, $count) = C4::Members::IsMemberBlocked($borrower->{'borrowernumber'});
778
0
    if ($blocktype == -1) {
779        ## patron has outstanding overdue loans
780
0
            if ( C4::Context->preference("OverduesBlockCirc") eq 'block'){
781
0
                $issuingimpossible{USERBLOCKEDOVERDUE} = $count;
782            }
783            elsif ( C4::Context->preference("OverduesBlockCirc") eq 'confirmation'){
784
0
                $needsconfirmation{USERBLOCKEDOVERDUE} = $count;
785            }
786    } elsif($blocktype == 1) {
787        # patron has accrued fine days
788
0
        $issuingimpossible{USERBLOCKEDREMAINING} = $count;
789    }
790
791#
792    # JB34 CHECKS IF BORROWERS DONT HAVE ISSUE TOO MANY BOOKS
793    #
794
0
        my ($current_loan_count, $max_loans_allowed) = TooMany( $borrower, $item->{biblionumber}, $item );
795    # if TooMany max_loans_allowed returns 0 the user doesn't have permission to check out this book
796
0
    if (defined $max_loans_allowed && $max_loans_allowed == 0) {
797
0
        $needsconfirmation{PATRON_CANT} = 1;
798    } else {
799
0
        if($max_loans_allowed){
800
0
            $needsconfirmation{TOO_MANY} = 1;
801
0
            $needsconfirmation{current_loan_count} = $current_loan_count;
802
0
            $needsconfirmation{max_loans_allowed} = $max_loans_allowed;
803        }
804    }
805
806    #
807    # ITEM CHECKING
808    #
809
0
    if ( $item->{'notforloan'}
810        && $item->{'notforloan'} > 0 )
811    {
812
0
        if(!C4::Context->preference("AllowNotForLoanOverride")){
813
0
            $issuingimpossible{NOT_FOR_LOAN} = 1;
814        }else{
815
0
            $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
816        }
817    }
818    elsif ( !$item->{'notforloan'} ){
819        # we have to check itemtypes.notforloan also
820
0
        if (C4::Context->preference('item-level_itypes')){
821            # this should probably be a subroutine
822
0
            my $sth = $dbh->prepare("SELECT notforloan FROM itemtypes WHERE itemtype = ?");
823
0
            $sth->execute($item->{'itemtype'});
824
0
            my $notforloan=$sth->fetchrow_hashref();
825
0
            $sth->finish();
826
0
            if ($notforloan->{'notforloan'}) {
827
0
                if (!C4::Context->preference("AllowNotForLoanOverride")) {
828
0
                    $issuingimpossible{NOT_FOR_LOAN} = 1;
829                } else {
830
0
                    $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
831                }
832            }
833        }
834        elsif ($biblioitem->{'notforloan'} == 1){
835
0
            if (!C4::Context->preference("AllowNotForLoanOverride")) {
836
0
                $issuingimpossible{NOT_FOR_LOAN} = 1;
837            } else {
838
0
                $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
839            }
840        }
841    }
842
0
    if ( $item->{'wthdrawn'} && $item->{'wthdrawn'} > 0 )
843    {
844
0
        $issuingimpossible{WTHDRAWN} = 1;
845    }
846
0
    if ( $item->{'restricted'}
847        && $item->{'restricted'} == 1 )
848    {
849
0
        $issuingimpossible{RESTRICTED} = 1;
850    }
851
0
    if ( C4::Context->preference("IndependantBranches") ) {
852
0
        my $userenv = C4::Context->userenv;
853
0
        if ( ($userenv) && ( $userenv->{flags} % 2 != 1 ) ) {
854
0
            $issuingimpossible{ITEMNOTSAMEBRANCH} = 1
855              if ( $item->{C4::Context->preference("HomeOrHoldingBranch")} ne $userenv->{branch} );
856
0
            $needsconfirmation{BORRNOTSAMEBRANCH} = GetBranchName( $borrower->{'branchcode'} )
857              if ( $borrower->{'branchcode'} ne $userenv->{branch} );
858        }
859    }
860
861    #
862    # CHECK IF BOOK ALREADY ISSUED TO THIS BORROWER
863    #
864
0
    if ( $issue->{borrowernumber} && $issue->{borrowernumber} eq $borrower->{'borrowernumber'} )
865    {
866
867        # Already issued to current borrower. Ask whether the loan should
868        # be renewed.
869
0
        my ($CanBookBeRenewed,$renewerror) = CanBookBeRenewed(
870            $borrower->{'borrowernumber'},
871            $item->{'itemnumber'}
872        );
873
0
        if ( $CanBookBeRenewed == 0 ) { # no more renewals allowed
874
0
            $issuingimpossible{NO_MORE_RENEWALS} = 1;
875        }
876        else {
877
0
            $needsconfirmation{RENEW_ISSUE} = 1;
878        }
879    }
880    elsif ($issue->{borrowernumber}) {
881
882        # issued to someone else
883
0
        my $currborinfo = C4::Members::GetMember( borrowernumber => $issue->{borrowernumber} );
884
885# warn "=>.$currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
886
0
        $needsconfirmation{ISSUED_TO_ANOTHER} = 1;
887
0
        $needsconfirmation{issued_firstname} = $currborinfo->{'firstname'};
888
0
        $needsconfirmation{issued_surname} = $currborinfo->{'surname'};
889
0
        $needsconfirmation{issued_cardnumber} = $currborinfo->{'cardnumber'};
890
0
        $needsconfirmation{issued_borrowernumber} = $currborinfo->{'borrowernumber'};
891    }
892
893
0
    unless ( $ignore_reserves ) {
894        # See if the item is on reserve.
895
0
        my ( $restype, $res ) = C4::Reserves::CheckReserves( $item->{'itemnumber'} );
896
0
        if ($restype) {
897
0
            my $resbor = $res->{'borrowernumber'};
898
0
            if ( $resbor ne $borrower->{'borrowernumber'} ) {
899
0
                my ( $resborrower ) = C4::Members::GetMember( borrowernumber => $resbor );
900
0
                my $branchname = GetBranchName( $res->{'branchcode'} );
901
0
                if ( $restype eq "Waiting" )
902                {
903                    # The item is on reserve and waiting, but has been
904                    # reserved by some other patron.
905
0
                    $needsconfirmation{RESERVE_WAITING} = 1;
906
0
                    $needsconfirmation{'resfirstname'} = $resborrower->{'firstname'};
907
0
                    $needsconfirmation{'ressurname'} = $resborrower->{'surname'};
908
0
                    $needsconfirmation{'rescardnumber'} = $resborrower->{'cardnumber'};
909
0
                    $needsconfirmation{'resborrowernumber'} = $resborrower->{'borrowernumber'};
910
0
                    $needsconfirmation{'resbranchname'} = $branchname;
911
0
                    $needsconfirmation{'reswaitingdate'} = format_date($res->{'waitingdate'});
912                }
913                elsif ( $restype eq "Reserved" ) {
914                    # The item is on reserve for someone else.
915
0
                    $needsconfirmation{RESERVED} = 1;
916
0
                    $needsconfirmation{'resfirstname'} = $resborrower->{'firstname'};
917
0
                    $needsconfirmation{'ressurname'} = $resborrower->{'surname'};
918
0
                    $needsconfirmation{'rescardnumber'} = $resborrower->{'cardnumber'};
919
0
                    $needsconfirmation{'resborrowernumber'} = $resborrower->{'borrowernumber'};
920
0
                    $needsconfirmation{'resbranchname'} = $branchname;
921
0
                    $needsconfirmation{'resreservedate'} = format_date($res->{'reservedate'});
922                }
923            }
924        }
925    }
926
0
    return ( \%issuingimpossible, \%needsconfirmation );
927}
928
929 - 965
=head2 AddIssue

  &AddIssue($borrower, $barcode, [$datedue], [$cancelreserve], [$issuedate])

Issue a book. Does no check, they are done in CanBookBeIssued. If we reach this sub, it means the user confirmed if needed.

=over 4

=item C<$borrower> is a hash with borrower informations (from GetMember or GetMemberDetails).

=item C<$barcode> is the barcode of the item being issued.

=item C<$datedue> is a C4::Dates object for the max date of return, i.e. the date due (optional).
Calculated if empty.

=item C<$cancelreserve> is 1 to override and cancel any pending reserves for the item (optional).

=item C<$issuedate> is the date to issue the item in iso (YYYY-MM-DD) format (optional).
Defaults to today.  Unlike C<$datedue>, NOT a C4::Dates object, unfortunately.

AddIssue does the following things :

  - step 01: check that there is a borrowernumber & a barcode provided
  - check for RENEWAL (book issued & being issued to the same patron)
      - renewal YES = Calculate Charge & renew
      - renewal NO  =
          * BOOK ACTUALLY ISSUED ? do a return if book is actually issued (but to someone else)
          * RESERVE PLACED ?
              - fill reserve if reserve to this patron
              - cancel reserve or not, otherwise
          * TRANSFERT PENDING ?
              - complete the transfert
          * ISSUE THE BOOK

=back

=cut
966
967sub AddIssue {
968
0
    my ( $borrower, $barcode, $datedue, $cancelreserve, $issuedate, $sipmode) = @_;
969
0
    my $dbh = C4::Context->dbh;
970
0
        my $barcodecheck=CheckValidBarcode($barcode);
971
0
    if ($datedue && ref $datedue ne 'DateTime') {
972
0
        $datedue = dt_from_string($datedue);
973    }
974    # $issuedate defaults to today.
975
0
    if ( ! defined $issuedate ) {
976
0
        $issuedate = DateTime->now(time_zone => C4::Context->tz());
977    }
978    else {
979
0
        if ( ref $issuedate ne 'DateTime') {
980
0
            $issuedate = dt_from_string($issuedate);
981
982        }
983    }
984
0
        if ($borrower and $barcode and $barcodecheck ne '0'){#??? wtf
985                # find which item we issue
986
0
                my $item = GetItem('', $barcode) or return undef; # if we don't get an Item, abort.
987
0
                my $branch = _GetCircControlBranch($item,$borrower);
988
989                # get actual issuing if there is one
990
0
                my $actualissue = GetItemIssue( $item->{itemnumber});
991
992                # get biblioinformation for this item
993
0
                my $biblio = GetBiblioFromItemNumber($item->{itemnumber});
994
995                #
996                # check if we just renew the issue.
997                #
998
0
                if ($actualissue->{borrowernumber} eq $borrower->{'borrowernumber'}) {
999
0
                    $datedue = AddRenewal(
1000                        $borrower->{'borrowernumber'},
1001                        $item->{'itemnumber'},
1002                        $branch,
1003                        $datedue,
1004                        $issuedate, # here interpreted as the renewal date
1005                        );
1006                }
1007                else {
1008        # it's NOT a renewal
1009
0
                        if ( $actualissue->{borrowernumber}) {
1010                                # This book is currently on loan, but not to the person
1011                                # who wants to borrow it now. mark it returned before issuing to the new borrower
1012
0
                                AddReturn(
1013                                        $item->{'barcode'},
1014                                        C4::Context->userenv->{'branch'}
1015                                );
1016                        }
1017
1018
0
            MoveReserve( $item->{'itemnumber'}, $borrower->{'borrowernumber'}, $cancelreserve );
1019                        # Starting process for transfer job (checking transfert and validate it if we have one)
1020
0
            my ($datesent) = GetTransfers($item->{'itemnumber'});
1021
0
            if ($datesent) {
1022        # updating line of branchtranfert to finish it, and changing the to branch value, implement a comment for visibility of this case (maybe for stats ....)
1023
0
                my $sth =
1024                    $dbh->prepare(
1025                    "UPDATE branchtransfers
1026                        SET datearrived = now(),
1027                        tobranch = ?,
1028                        comments = 'Forced branchtransfer'
1029                    WHERE itemnumber= ? AND datearrived IS NULL"
1030                    );
1031
0
                $sth->execute(C4::Context->userenv->{'branch'},$item->{'itemnumber'});
1032            }
1033
1034        # Record in the database the fact that the book was issued.
1035
0
        my $sth =
1036          $dbh->prepare(
1037                "INSERT INTO issues
1038                    (borrowernumber, itemnumber,issuedate, date_due, branchcode)
1039                VALUES (?,?,?,?,?)"
1040          );
1041
0
        unless ($datedue) {
1042
0
            my $itype = ( C4::Context->preference('item-level_itypes') ) ? $biblio->{'itype'} : $biblio->{'itemtype'};
1043
0
            $datedue = CalcDateDue( $issuedate, $itype, $branch, $borrower );
1044
1045        }
1046
0
        $datedue->truncate( to => 'minutes');
1047
0
        $sth->execute(
1048            $borrower->{'borrowernumber'}, # borrowernumber
1049            $item->{'itemnumber'}, # itemnumber
1050            $issuedate->strftime('%Y-%m-%d %H:%M:00'), # issuedate
1051            $datedue->strftime('%Y-%m-%d %H:%M:00'), # date_due
1052            C4::Context->userenv->{'branch'} # branchcode
1053        );
1054
0
        if ( C4::Context->preference('ReturnToShelvingCart') ) { ## ReturnToShelvingCart is on, anything issued should be taken off the cart.
1055
0
          CartToShelf( $item->{'itemnumber'} );
1056        }
1057
0
        $item->{'issues'}++;
1058
1059        ## If item was lost, it has now been found, reverse any list item charges if neccessary.
1060
0
        if ( $item->{'itemlost'} ) {
1061
0
            _FixAccountForLostAndReturned( $item->{'itemnumber'}, undef, $item->{'barcode'} );
1062        }
1063
1064
0
        ModItem({ issues => $item->{'issues'},
1065                  holdingbranch => C4::Context->userenv->{'branch'},
1066                  itemlost => 0,
1067                  datelastborrowed => DateTime->now(time_zone => C4::Context->tz())->ymd(),
1068                  onloan => $datedue->ymd(),
1069                }, $item->{'biblionumber'}, $item->{'itemnumber'});
1070
0
        ModDateLastSeen( $item->{'itemnumber'} );
1071
1072        # If it costs to borrow this book, charge it to the patron's account.
1073
0
        my ( $charge, $itemtype ) = GetIssuingCharges(
1074            $item->{'itemnumber'},
1075            $borrower->{'borrowernumber'}
1076        );
1077
0
        if ( $charge > 0 ) {
1078
0
            AddIssuingCharge(
1079                $item->{'itemnumber'},
1080                $borrower->{'borrowernumber'}, $charge
1081            );
1082
0
            $item->{'charge'} = $charge;
1083        }
1084
1085        # Record the fact that this book was issued.
1086        &UpdateStats(
1087
0
            C4::Context->userenv->{'branch'},
1088            'issue', $charge,
1089            ($sipmode ? "SIP-$sipmode" : ''), $item->{'itemnumber'},
1090            $item->{'itype'}, $borrower->{'borrowernumber'}
1091        );
1092
1093        # Send a checkout slip.
1094
0
        my $circulation_alert = 'C4::ItemCirculationAlertPreference';
1095
0
        my %conditions = (
1096            branchcode => $branch,
1097            categorycode => $borrower->{categorycode},
1098            item_type => $item->{itype},
1099            notification => 'CHECKOUT',
1100        );
1101
0
        if ($circulation_alert->is_enabled_for(\%conditions)) {
1102
0
            SendCirculationAlert({
1103                type => 'CHECKOUT',
1104                item => $item,
1105                borrower => $borrower,
1106                branch => $branch,
1107            });
1108        }
1109    }
1110
1111
0
    logaction("CIRCULATION", "ISSUE", $borrower->{'borrowernumber'}, $biblio->{'biblionumber'})
1112        if C4::Context->preference("IssueLog");
1113  }
1114
0
  return ($datedue); # not necessarily the same as when it came in!
1115}
1116
1117 - 1123
=head2 GetLoanLength

  my $loanlength = &GetLoanLength($borrowertype,$itemtype,branchcode)

Get loan length for an itemtype, a borrower type and a branch

=cut
1124
1125sub GetLoanLength {
1126
0
    my ( $borrowertype, $itemtype, $branchcode ) = @_;
1127
0
    my $dbh = C4::Context->dbh;
1128
0
    my $sth =
1129      $dbh->prepare(
1130'select issuelength, lengthunit from issuingrules where categorycode=? and itemtype=? and branchcode=? and issuelength is not null'
1131      );
1132# warn "in get loan lenght $borrowertype $itemtype $branchcode ";
1133# try to find issuelength & return the 1st available.
1134# check with borrowertype, itemtype and branchcode, then without one of those parameters
1135
0
    $sth->execute( $borrowertype, $itemtype, $branchcode );
1136
0
    my $loanlength = $sth->fetchrow_hashref;
1137
0
    return $loanlength
1138      if defined($loanlength) && $loanlength->{issuelength};
1139
1140
0
    $sth->execute( $borrowertype, '*', $branchcode );
1141
0
    $loanlength = $sth->fetchrow_hashref;
1142
0
    return $loanlength
1143      if defined($loanlength) && $loanlength->{issuelength};
1144
1145
0
    $sth->execute( '*', $itemtype, $branchcode );
1146
0
    $loanlength = $sth->fetchrow_hashref;
1147
0
    return $loanlength
1148      if defined($loanlength) && $loanlength->{issuelength};
1149
1150
0
    $sth->execute( '*', '*', $branchcode );
1151
0
    $loanlength = $sth->fetchrow_hashref;
1152
0
    return $loanlength
1153      if defined($loanlength) && $loanlength->{issuelength};
1154
1155
0
    $sth->execute( $borrowertype, $itemtype, '*' );
1156
0
    $loanlength = $sth->fetchrow_hashref;
1157
0
    return $loanlength
1158      if defined($loanlength) && $loanlength->{issuelength};
1159
1160
0
    $sth->execute( $borrowertype, '*', '*' );
1161
0
    $loanlength = $sth->fetchrow_hashref;
1162
0
    return $loanlength
1163      if defined($loanlength) && $loanlength->{issuelength};
1164
1165
0
    $sth->execute( '*', $itemtype, '*' );
1166
0
    $loanlength = $sth->fetchrow_hashref;
1167
0
    return $loanlength
1168      if defined($loanlength) && $loanlength->{issuelength};
1169
1170
0
    $sth->execute( '*', '*', '*' );
1171
0
    $loanlength = $sth->fetchrow_hashref;
1172
0
    return $loanlength
1173      if defined($loanlength) && $loanlength->{issuelength};
1174
1175    # if no rule is set => 21 days (hardcoded)
1176    return {
1177
0
        issuelength => 21,
1178        lengthunit => 'days',
1179    };
1180
1181}
1182
1183
1184 - 1190
=head2 GetHardDueDate

  my ($hardduedate,$hardduedatecompare) = &GetHardDueDate($borrowertype,$itemtype,branchcode)

Get the Hard Due Date and it's comparison for an itemtype, a borrower type and a branch

=cut
1191
1192sub GetHardDueDate {
1193
0
    my ( $borrowertype, $itemtype, $branchcode ) = @_;
1194
0
    my $dbh = C4::Context->dbh;
1195
0
    my $sth =
1196      $dbh->prepare(
1197"select hardduedate, hardduedatecompare from issuingrules where categorycode=? and itemtype=? and branchcode=?"
1198      );
1199
0
    $sth->execute( $borrowertype, $itemtype, $branchcode );
1200
0
    my $results = $sth->fetchrow_hashref;
1201
0
    return (dt_from_string($results->{hardduedate}, 'iso'),$results->{hardduedatecompare})
1202      if defined($results) && $results->{hardduedate};
1203
1204
0
    $sth->execute( $borrowertype, "*", $branchcode );
1205
0
    $results = $sth->fetchrow_hashref;
1206
0
    return (dt_from_string($results->{hardduedate}, 'iso'),$results->{hardduedatecompare})
1207      if defined($results) && $results->{hardduedate};
1208
1209
0
    $sth->execute( "*", $itemtype, $branchcode );
1210
0
    $results = $sth->fetchrow_hashref;
1211
0
    return (dt_from_string($results->{hardduedate}, 'iso'),$results->{hardduedatecompare})
1212      if defined($results) && $results->{hardduedate};
1213
1214
0
    $sth->execute( "*", "*", $branchcode );
1215
0
    $results = $sth->fetchrow_hashref;
1216
0
    return (dt_from_string($results->{hardduedate}, 'iso'),$results->{hardduedatecompare})
1217      if defined($results) && $results->{hardduedate};
1218
1219
0
    $sth->execute( $borrowertype, $itemtype, "*" );
1220
0
    $results = $sth->fetchrow_hashref;
1221
0
    return (dt_from_string($results->{hardduedate}, 'iso'),$results->{hardduedatecompare})
1222      if defined($results) && $results->{hardduedate};
1223
1224
0
    $sth->execute( $borrowertype, "*", "*" );
1225
0
    $results = $sth->fetchrow_hashref;
1226
0
    return (dt_from_string($results->{hardduedate}, 'iso'),$results->{hardduedatecompare})
1227      if defined($results) && $results->{hardduedate};
1228
1229
0
    $sth->execute( "*", $itemtype, "*" );
1230
0
    $results = $sth->fetchrow_hashref;
1231
0
    return (dt_from_string($results->{hardduedate}, 'iso'),$results->{hardduedatecompare})
1232      if defined($results) && $results->{hardduedate};
1233
1234
0
    $sth->execute( "*", "*", "*" );
1235
0
    $results = $sth->fetchrow_hashref;
1236
0
    return (dt_from_string($results->{hardduedate}, 'iso'),$results->{hardduedatecompare})
1237      if defined($results) && $results->{hardduedate};
1238
1239    # if no rule is set => return undefined
1240
0
    return (undef, undef);
1241}
1242
1243 - 1254
=head2 GetIssuingRule

  my $irule = &GetIssuingRule($borrowertype,$itemtype,branchcode)

FIXME - This is a copy-paste of GetLoanLength
as a stop-gap.  Do not wish to change API for GetLoanLength 
this close to release, however, Overdues::GetIssuingRules is broken.

Get the issuing rule for an itemtype, a borrower type and a branch
Returns a hashref from the issuingrules table.

=cut
1255
1256sub GetIssuingRule {
1257
0
    my ( $borrowertype, $itemtype, $branchcode ) = @_;
1258
0
    my $dbh = C4::Context->dbh;
1259
0
    my $sth = $dbh->prepare( "select * from issuingrules where categorycode=? and itemtype=? and branchcode=? and issuelength is not null" );
1260
0
    my $irule;
1261
1262
0
        $sth->execute( $borrowertype, $itemtype, $branchcode );
1263
0
    $irule = $sth->fetchrow_hashref;
1264
0
    return $irule if defined($irule) ;
1265
1266
0
    $sth->execute( $borrowertype, "*", $branchcode );
1267
0
    $irule = $sth->fetchrow_hashref;
1268
0
    return $irule if defined($irule) ;
1269
1270
0
    $sth->execute( "*", $itemtype, $branchcode );
1271
0
    $irule = $sth->fetchrow_hashref;
1272
0
    return $irule if defined($irule) ;
1273
1274
0
    $sth->execute( "*", "*", $branchcode );
1275
0
    $irule = $sth->fetchrow_hashref;
1276
0
    return $irule if defined($irule) ;
1277
1278
0
    $sth->execute( $borrowertype, $itemtype, "*" );
1279
0
    $irule = $sth->fetchrow_hashref;
1280
0
    return $irule if defined($irule) ;
1281
1282
0
    $sth->execute( $borrowertype, "*", "*" );
1283
0
    $irule = $sth->fetchrow_hashref;
1284
0
    return $irule if defined($irule) ;
1285
1286
0
    $sth->execute( "*", $itemtype, "*" );
1287
0
    $irule = $sth->fetchrow_hashref;
1288
0
    return $irule if defined($irule) ;
1289
1290
0
    $sth->execute( "*", "*", "*" );
1291
0
    $irule = $sth->fetchrow_hashref;
1292
0
    return $irule if defined($irule) ;
1293
1294    # if no rule matches,
1295
0
    return undef;
1296}
1297
1298 - 1328
=head2 GetBranchBorrowerCircRule

  my $branch_cat_rule = GetBranchBorrowerCircRule($branchcode, $categorycode);

Retrieves circulation rule attributes that apply to the given
branch and patron category, regardless of item type.  
The return value is a hashref containing the following key:

maxissueqty - maximum number of loans that a
patron of the given category can have at the given
branch.  If the value is undef, no limit.

This will first check for a specific branch and
category match from branch_borrower_circ_rules. 

If no rule is found, it will then check default_branch_circ_rules
(same branch, default category).  If no rule is found,
it will then check default_borrower_circ_rules (default 
branch, same category), then failing that, default_circ_rules
(default branch, default category).

If no rule has been found in the database, it will default to
the buillt in rule:

maxissueqty - undef

C<$branchcode> and C<$categorycode> should contain the
literal branch code and patron category code, respectively - no
wildcards.

=cut
1329
1330sub GetBranchBorrowerCircRule {
1331
0
    my $branchcode = shift;
1332
0
    my $categorycode = shift;
1333
1334
0
    my $branch_cat_query = "SELECT maxissueqty
1335                            FROM branch_borrower_circ_rules
1336                            WHERE branchcode = ?
1337                            AND categorycode = ?";
1338
0
    my $dbh = C4::Context->dbh();
1339
0
    my $sth = $dbh->prepare($branch_cat_query);
1340
0
    $sth->execute($branchcode, $categorycode);
1341
0
    my $result;
1342
0
    if ($result = $sth->fetchrow_hashref()) {
1343
0
        return $result;
1344    }
1345
1346    # try same branch, default borrower category
1347
0
    my $branch_query = "SELECT maxissueqty
1348                        FROM default_branch_circ_rules
1349                        WHERE branchcode = ?";
1350
0
    $sth = $dbh->prepare($branch_query);
1351
0
    $sth->execute($branchcode);
1352
0
    if ($result = $sth->fetchrow_hashref()) {
1353
0
        return $result;
1354    }
1355
1356    # try default branch, same borrower category
1357
0
    my $category_query = "SELECT maxissueqty
1358                          FROM default_borrower_circ_rules
1359                          WHERE categorycode = ?";
1360
0
    $sth = $dbh->prepare($category_query);
1361
0
    $sth->execute($categorycode);
1362
0
    if ($result = $sth->fetchrow_hashref()) {
1363
0
        return $result;
1364    }
1365
1366    # try default branch, default borrower category
1367
0
    my $default_query = "SELECT maxissueqty
1368                          FROM default_circ_rules";
1369
0
    $sth = $dbh->prepare($default_query);
1370
0
    $sth->execute();
1371
0
    if ($result = $sth->fetchrow_hashref()) {
1372
0
        return $result;
1373    }
1374
1375    # built-in default circulation rule
1376    return {
1377
0
        maxissueqty => undef,
1378    };
1379}
1380
1381 - 1408
=head2 GetBranchItemRule

  my $branch_item_rule = GetBranchItemRule($branchcode, $itemtype);

Retrieves circulation rule attributes that apply to the given
branch and item type, regardless of patron category.

The return value is a hashref containing the following keys:

holdallowed => Hold policy for this branch and itemtype. Possible values:
  0: No holds allowed.
  1: Holds allowed only by patrons that have the same homebranch as the item.
  2: Holds allowed from any patron.

returnbranch => branch to which to return item.  Possible values:
  noreturn: do not return, let item remain where checked in (floating collections)
  homebranch: return to item's home branch

This searches branchitemrules in the following order:

  * Same branchcode and itemtype
  * Same branchcode, itemtype '*'
  * branchcode '*', same itemtype
  * branchcode and itemtype '*'

Neither C<$branchcode> nor C<$itemtype> should be '*'.

=cut
1409
1410sub GetBranchItemRule {
1411
0
    my ( $branchcode, $itemtype ) = @_;
1412
0
    my $dbh = C4::Context->dbh();
1413
0
    my $result = {};
1414
1415
0
    my @attempts = (
1416        ['SELECT holdallowed, returnbranch
1417            FROM branch_item_rules
1418            WHERE branchcode = ?
1419              AND itemtype = ?', $branchcode, $itemtype],
1420        ['SELECT holdallowed, returnbranch
1421            FROM default_branch_circ_rules
1422            WHERE branchcode = ?', $branchcode],
1423        ['SELECT holdallowed, returnbranch
1424            FROM default_branch_item_rules
1425            WHERE itemtype = ?', $itemtype],
1426        ['SELECT holdallowed, returnbranch
1427            FROM default_circ_rules'],
1428    );
1429
1430
0
    foreach my $attempt (@attempts) {
1431
0
0
        my ($query, @bind_params) = @{$attempt};
1432
0
        my $search_result = $dbh->selectrow_hashref ( $query , {}, @bind_params );
1433
1434        # Since branch/category and branch/itemtype use the same per-branch
1435        # defaults tables, we have to check that the key we want is set, not
1436        # just that a row was returned
1437
0
        $result->{'holdallowed'} = $search_result->{'holdallowed'} unless ( defined $result->{'holdallowed'} );
1438
0
        $result->{'returnbranch'} = $search_result->{'returnbranch'} unless ( defined $result->{'returnbranch'} );
1439    }
1440
1441    # built-in default circulation rule
1442
0
    $result->{'holdallowed'} = 2 unless ( defined $result->{'holdallowed'} );
1443
0
    $result->{'returnbranch'} = 'homebranch' unless ( defined $result->{'returnbranch'} );
1444
1445
0
    return $result;
1446}
1447
1448 - 1520
=head2 AddReturn

  ($doreturn, $messages, $iteminformation, $borrower) =
      &AddReturn($barcode, $branch, $exemptfine, $dropbox);

Returns a book.

=over 4

=item C<$barcode> is the bar code of the book being returned.

=item C<$branch> is the code of the branch where the book is being returned.

=item C<$exemptfine> indicates that overdue charges for the item will be
removed.

=item C<$dropbox> indicates that the check-in date is assumed to be
yesterday, or the last non-holiday as defined in C4::Calendar .  If
overdue charges are applied and C<$dropbox> is true, the last charge
will be removed.  This assumes that the fines accrual script has run
for _today_.

=back

C<&AddReturn> returns a list of four items:

C<$doreturn> is true iff the return succeeded.

C<$messages> is a reference-to-hash giving feedback on the operation.
The keys of the hash are:

=over 4

=item C<BadBarcode>

No item with this barcode exists. The value is C<$barcode>.

=item C<NotIssued>

The book is not currently on loan. The value is C<$barcode>.

=item C<IsPermanent>

The book's home branch is a permanent collection. If you have borrowed
this book, you are not allowed to return it. The value is the code for
the book's home branch.

=item C<wthdrawn>

This book has been withdrawn/cancelled. The value should be ignored.

=item C<Wrongbranch>

This book has was returned to the wrong branch.  The value is a hashref
so that C<$messages->{Wrongbranch}->{Wrongbranch}> and C<$messages->{Wrongbranch}->{Rightbranch}>
contain the branchcode of the incorrect and correct return library, respectively.

=item C<ResFound>

The item was reserved. The value is a reference-to-hash whose keys are
fields from the reserves table of the Koha database, and
C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
either C<Waiting>, C<Reserved>, or 0.

=back

C<$iteminformation> is a reference-to-hash, giving information about the
returned item from the issues table.

C<$borrower> is a reference-to-hash, giving information about the
patron who last borrowed the book.

=cut
1521
1522sub AddReturn {
1523
0
    my ( $barcode, $branch, $exemptfine, $dropbox ) = @_;
1524
0
    if ($branch and not GetBranchDetail($branch)) {
1525
0
        warn "AddReturn error: branch '$branch' not found. Reverting to " . C4::Context->userenv->{'branch'};
1526
0
        undef $branch;
1527    }
1528
0
    $branch = C4::Context->userenv->{'branch'} unless $branch; # we trust userenv to be a safe fallback/default
1529
0
    my $messages;
1530
0
    my $borrower;
1531
0
    my $biblio;
1532
0
    my $doreturn = 1;
1533
0
    my $validTransfert = 0;
1534
0
    my $stat_type = 'return';
1535
1536    # get information on item
1537
0
    my $itemnumber = GetItemnumberFromBarcode( $barcode );
1538
0
    unless ($itemnumber) {
1539
0
        return (0, { BadBarcode => $barcode }); # no barcode means no item or borrower. bail out.
1540    }
1541
0
    my $issue = GetItemIssue($itemnumber);
1542# warn Dumper($iteminformation);
1543
0
    if ($issue and $issue->{borrowernumber}) {
1544
0
        $borrower = C4::Members::GetMemberDetails($issue->{borrowernumber})
1545            or die "Data inconsistency: barcode $barcode (itemnumber:$itemnumber) claims to be issued to non-existant borrowernumber '$issue->{borrowernumber}'\n"
1546                . Dumper($issue) . "\n";
1547    } else {
1548
0
        $messages->{'NotIssued'} = $barcode;
1549        # even though item is not on loan, it may still be transferred; therefore, get current branch info
1550
0
        $doreturn = 0;
1551        # No issue, no borrowernumber. ONLY if $doreturn, *might* you have a $borrower later.
1552        # Record this as a local use, instead of a return, if the RecordLocalUseOnReturn is on
1553
0
        if (C4::Context->preference("RecordLocalUseOnReturn")) {
1554
0
           $messages->{'LocalUse'} = 1;
1555
0
           $stat_type = 'localuse';
1556        }
1557    }
1558
1559
0
    my $item = GetItem($itemnumber) or die "GetItem($itemnumber) failed";
1560        # full item data, but no borrowernumber or checkout info (no issue)
1561        # we know GetItem should work because GetItemnumberFromBarcode worked
1562
0
    my $hbr = GetBranchItemRule($item->{'homebranch'}, $item->{'itype'})->{'returnbranch'} || "homebranch";
1563        # get the proper branch to which to return the item
1564
0
    $hbr = $item->{$hbr} || $branch ;
1565        # if $hbr was "noreturn" or any other non-item table value, then it should 'float' (i.e. stay at this branch)
1566
1567
0
    my $borrowernumber = $borrower->{'borrowernumber'} || undef; # we don't know if we had a borrower or not
1568
1569    # check if the book is in a permanent collection....
1570    # FIXME -- This 'PE' attribute is largely undocumented. afaict, there's no user interface that reflects this functionality.
1571
0
    if ( $hbr ) {
1572
0
        my $branches = GetBranches(); # a potentially expensive call for a non-feature.
1573
0
        $branches->{$hbr}->{PE} and $messages->{'IsPermanent'} = $hbr;
1574    }
1575
1576    # if indy branches and returning to different branch, refuse the return
1577
0
    if ($hbr ne $branch && C4::Context->preference("IndependantBranches")){
1578
0
        $messages->{'Wrongbranch'} = {
1579            Wrongbranch => $branch,
1580            Rightbranch => $hbr,
1581        };
1582
0
        $doreturn = 0;
1583        # bailing out here - in this case, current desired behavior
1584        # is to act as if no return ever happened at all.
1585        # FIXME - even in an indy branches situation, there should
1586        # still be an option for the library to accept the item
1587        # and transfer it to its owning library.
1588
0
        return ( $doreturn, $messages, $issue, $borrower );
1589    }
1590
1591
0
    if ( $item->{'wthdrawn'} ) { # book has been cancelled
1592
0
        $messages->{'wthdrawn'} = 1;
1593
0
        $doreturn = 0;
1594    }
1595
1596    # case of a return of document (deal with issues and holdingbranch)
1597
0
    if ($doreturn) {
1598
0
        $borrower or warn "AddReturn without current borrower";
1599
0
                my $circControlBranch;
1600
0
        if ($dropbox) {
1601            # define circControlBranch only if dropbox mode is set
1602            # don't allow dropbox mode to create an invalid entry in issues (issuedate > today)
1603            # FIXME: check issuedate > returndate, factoring in holidays
1604            #$circControlBranch = _GetCircControlBranch($item,$borrower) unless ( $item->{'issuedate'} eq C4::Dates->today('iso') );;
1605
0
            $circControlBranch = _GetCircControlBranch($item,$borrower);
1606        }
1607
1608
0
        if ($borrowernumber) {
1609
0
            MarkIssueReturned($borrowernumber, $item->{'itemnumber'}, $circControlBranch, '', $borrower->{'privacy'});
1610
0
            $messages->{'WasReturned'} = 1; # FIXME is the "= 1" right? This could be the borrower hash.
1611        }
1612
1613
0
        ModItem({ onloan => undef }, $issue->{'biblionumber'}, $item->{'itemnumber'});
1614    }
1615
1616    # the holdingbranch is updated if the document is returned to another location.
1617    # this is always done regardless of whether the item was on loan or not
1618
0
    if ($item->{'holdingbranch'} ne $branch) {
1619
0
        UpdateHoldingbranch($branch, $item->{'itemnumber'});
1620
0
        $item->{'holdingbranch'} = $branch; # update item data holdingbranch too
1621    }
1622
0
    ModDateLastSeen( $item->{'itemnumber'} );
1623
1624    # check if we have a transfer for this document
1625
0
    my ($datesent,$frombranch,$tobranch) = GetTransfers( $item->{'itemnumber'} );
1626
1627    # if we have a transfer to do, we update the line of transfers with the datearrived
1628
0
    if ($datesent) {
1629
0
        if ( $tobranch eq $branch ) {
1630
0
            my $sth = C4::Context->dbh->prepare(
1631                "UPDATE branchtransfers SET datearrived = now() WHERE itemnumber= ? AND datearrived IS NULL"
1632            );
1633
0
            $sth->execute( $item->{'itemnumber'} );
1634            # if we have a reservation with valid transfer, we can set it's status to 'W'
1635
0
            C4::Reserves::ModReserveStatus($item->{'itemnumber'}, 'W');
1636        } else {
1637
0
            $messages->{'WrongTransfer'} = $tobranch;
1638
0
            $messages->{'WrongTransferItem'} = $item->{'itemnumber'};
1639        }
1640
0
        $validTransfert = 1;
1641    }
1642
1643    # fix up the accounts.....
1644
0
    if ($item->{'itemlost'}) {
1645
0
        _FixAccountForLostAndReturned($item->{'itemnumber'}, $borrowernumber, $barcode); # can tolerate undef $borrowernumber
1646
0
        $messages->{'WasLost'} = 1;
1647    }
1648
1649    # fix up the overdues in accounts...
1650
0
    if ($borrowernumber) {
1651
0
        my $fix = _FixOverduesOnReturn($borrowernumber, $item->{itemnumber}, $exemptfine, $dropbox);
1652
0
        defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $item->{itemnumber}...) failed!"; # zero is OK, check defined
1653
1654        # fix fine days
1655
0
        my $debardate = _FixFineDaysOnReturn( $borrower, $item, $issue->{date_due} );
1656
0
        $messages->{'Debarred'} = $debardate if ($debardate);
1657    }
1658
1659    # find reserves.....
1660    # if we don't have a reserve with the status W, we launch the Checkreserves routine
1661
0
    my ($resfound, $resrec, undef) = C4::Reserves::CheckReserves( $item->{'itemnumber'} );
1662
0
    if ($resfound) {
1663
0
          $resrec->{'ResFound'} = $resfound;
1664
0
        $messages->{'ResFound'} = $resrec;
1665    }
1666
1667    # update stats?
1668    # Record the fact that this book was returned.
1669    UpdateStats(
1670
0
        $branch, $stat_type, '0', '',
1671        $item->{'itemnumber'},
1672        $biblio->{'itemtype'},
1673        $borrowernumber
1674    );
1675
1676    # Send a check-in slip. # NOTE: borrower may be undef. probably shouldn't try to send messages then.
1677
0
    my $circulation_alert = 'C4::ItemCirculationAlertPreference';
1678
0
    my %conditions = (
1679        branchcode => $branch,
1680        categorycode => $borrower->{categorycode},
1681        item_type => $item->{itype},
1682        notification => 'CHECKIN',
1683    );
1684
0
    if ($doreturn && $circulation_alert->is_enabled_for(\%conditions)) {
1685
0
        SendCirculationAlert({
1686            type => 'CHECKIN',
1687            item => $item,
1688            borrower => $borrower,
1689            branch => $branch,
1690        });
1691    }
1692
1693
0
    logaction("CIRCULATION", "RETURN", $borrowernumber, $item->{'biblionumber'})
1694        if C4::Context->preference("ReturnLog");
1695
1696    # FIXME: make this comment intelligible.
1697    #adding message if holdingbranch is non equal a userenv branch to return the document to homebranch
1698    #we check, if we don't have reserv or transfert for this document, if not, return it to homebranch .
1699
1700
0
    if (($doreturn or $messages->{'NotIssued'}) and !$resfound and ($branch ne $hbr) and not $messages->{'WrongTransfer'}){
1701
0
        if ( C4::Context->preference("AutomaticItemReturn" ) or
1702            (C4::Context->preference("UseBranchTransferLimits") and
1703             ! IsBranchTransferAllowed($branch, $hbr, $item->{C4::Context->preference("BranchTransferLimitsType")} )
1704           )) {
1705
0
            $debug and warn sprintf "about to call ModItemTransfer(%s, %s, %s)", $item->{'itemnumber'},$branch, $hbr;
1706
0
            $debug and warn "item: " . Dumper($item);
1707
0
            ModItemTransfer($item->{'itemnumber'}, $branch, $hbr);
1708
0
            $messages->{'WasTransfered'} = 1;
1709        } else {
1710
0
            $messages->{'NeedsTransfer'} = 1; # TODO: instead of 1, specify branchcode that the transfer SHOULD go to, $item->{homebranch}
1711        }
1712    }
1713
0
    return ( $doreturn, $messages, $issue, $borrower );
1714}
1715
1716 - 1737
=head2 MarkIssueReturned

  MarkIssueReturned($borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy);

Unconditionally marks an issue as being returned by
moving the C<issues> row to C<old_issues> and
setting C<returndate> to the current date, or
the last non-holiday date of the branccode specified in
C<dropbox_branch> .  Assumes you've already checked that 
it's safe to do this, i.e. last non-holiday > issuedate.

if C<$returndate> is specified (in iso format), it is used as the date
of the return. It is ignored when a dropbox_branch is passed in.

C<$privacy> contains the privacy parameter. If the patron has set privacy to 2,
the old_issue is immediately anonymised

Ideally, this function would be internal to C<C4::Circulation>,
not exported, but it is currently needed by one 
routine in C<C4::Accounts>.

=cut
1738
1739sub MarkIssueReturned {
1740
0
    my ( $borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy ) = @_;
1741
0
    my $dbh = C4::Context->dbh;
1742
0
    my $query = 'UPDATE issues SET returndate=';
1743
0
    my @bind;
1744
0
    if ($dropbox_branch) {
1745
0
        my $calendar = Koha::Calendar->new( branchcode => $dropbox_branch );
1746
0
        my $dropboxdate = $calendar->addDate( DateTime->now( time_zone => C4::Context->tz), -1 );
1747
0
        $query .= ' ? ';
1748
0
        push @bind, $dropboxdate->strftime('%Y-%m-%d %H:%M');
1749    } elsif ($returndate) {
1750
0
        $query .= ' ? ';
1751
0
        push @bind, $returndate;
1752    } else {
1753
0
        $query .= ' now() ';
1754    }
1755
0
    $query .= ' WHERE borrowernumber = ? AND itemnumber = ?';
1756
0
    push @bind, $borrowernumber, $itemnumber;
1757    # FIXME transaction
1758
0
    my $sth_upd = $dbh->prepare($query);
1759
0
    $sth_upd->execute(@bind);
1760
0
    my $sth_copy = $dbh->prepare('INSERT INTO old_issues SELECT * FROM issues
1761                                  WHERE borrowernumber = ?
1762                                  AND itemnumber = ?');
1763
0
    $sth_copy->execute($borrowernumber, $itemnumber);
1764    # anonymise patron checkout immediately if $privacy set to 2 and AnonymousPatron is set to a valid borrowernumber
1765
0
    if ( $privacy == 2) {
1766        # The default of 0 does not work due to foreign key constraints
1767        # The anonymisation will fail quietly if AnonymousPatron is not a valid entry
1768
0
        my $anonymouspatron = (C4::Context->preference('AnonymousPatron')) ? C4::Context->preference('AnonymousPatron') : 0;
1769
0
        my $sth_ano = $dbh->prepare("UPDATE old_issues SET borrowernumber=?
1770                                  WHERE borrowernumber = ?
1771                                  AND itemnumber = ?");
1772
0
       $sth_ano->execute($anonymouspatron, $borrowernumber, $itemnumber);
1773    }
1774
0
    my $sth_del = $dbh->prepare("DELETE FROM issues
1775                                  WHERE borrowernumber = ?
1776                                  AND itemnumber = ?");
1777
0
    $sth_del->execute($borrowernumber, $itemnumber);
1778}
1779
1780 - 1792
=head2 _FixFineDaysOnReturn

    &_FixFineDaysOnReturn($borrower, $item, $datedue);

C<$borrower> borrower hashref

C<$item> item hashref

C<$datedue> date due

Internal function, called only by AddReturn that calculate and update the user fine days, and debars him

=cut
1793
1794sub _FixFineDaysOnReturn {
1795
0
    my ( $borrower, $item, $datedue ) = @_;
1796
0
    return unless ($datedue);
1797
1798
0
    my $dt_due = dt_from_string( $datedue );
1799
0
    my $dt_today = DateTime->now( time_zone => C4::Context->tz() );
1800
1801
0
    my $branchcode = _GetCircControlBranch( $item, $borrower );
1802
0
    my $calendar = Koha::Calendar->new( branchcode => $branchcode );
1803
1804    # $deltadays is a DateTime::Duration object
1805
0
    my $deltadays = $calendar->days_between( $dt_due, $dt_today );
1806
1807
0
    my $circcontrol = C4::Context::preference('CircControl');
1808
0
    my $issuingrule = GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branchcode );
1809
0
    my $finedays = $issuingrule->{finedays};
1810
1811    # exit if no finedays defined
1812
0
    return unless $finedays;
1813
0
    my $grace = DateTime::Duration->new( days => $issuingrule->{firstremind} );
1814
1815
0
    if ( ( $deltadays - $grace )->is_positive ) { # you can't compare DateTime::Durations with logical operators
1816
0
        my $new_debar_dt = $dt_today->clone()->add_duration( $deltadays * $finedays );
1817
0
        my $borrower_debar_dt = dt_from_string( $borrower->{debarred} );
1818        # check to see if the current debar date is a valid date
1819
0
        if ( $borrower->{debarred} && $borrower_debar_dt ) {
1820        # if so, is it before the new date? update only if true
1821
0
            if ( DateTime->compare( $borrower_debar_dt, $new_debar_dt ) == -1 ) {
1822
0
                C4::Members::DebarMember( $borrower->{borrowernumber}, $new_debar_dt->ymd() );
1823
0
                return $new_debar_dt->ymd();
1824            }
1825        # if the borrower's debar date is not set or valid, debar them
1826        } else {
1827
0
            C4::Members::DebarMember( $borrower->{borrowernumber}, $new_debar_dt->ymd() );
1828
0
            return $new_debar_dt->ymd();
1829        }
1830    }
1831}
1832
1833 - 1846
=head2 _FixOverduesOnReturn

   &_FixOverduesOnReturn($brn,$itm, $exemptfine, $dropboxmode);

C<$brn> borrowernumber

C<$itm> itemnumber

C<$exemptfine> BOOL -- remove overdue charge associated with this issue. 
C<$dropboxmode> BOOL -- remove lastincrement on overdue charge associated with this issue.

Internal function, called only by AddReturn

=cut
1847
1848sub _FixOverduesOnReturn {
1849
0
    my ($borrowernumber, $item);
1850
0
    unless ($borrowernumber = shift) {
1851
0
        warn "_FixOverduesOnReturn() not supplied valid borrowernumber";
1852
0
        return;
1853    }
1854
0
    unless ($item = shift) {
1855
0
        warn "_FixOverduesOnReturn() not supplied valid itemnumber";
1856
0
        return;
1857    }
1858
0
    my ($exemptfine, $dropbox) = @_;
1859
0
    my $dbh = C4::Context->dbh;
1860
1861    # check for overdue fine
1862
0
    my $sth = $dbh->prepare(
1863"SELECT * FROM accountlines WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (accounttype='FU' OR accounttype='O')"
1864    );
1865
0
    $sth->execute( $borrowernumber, $item );
1866
1867    # alter fine to show that the book has been returned
1868
0
    my $data = $sth->fetchrow_hashref;
1869
0
    return 0 unless $data; # no warning, there's just nothing to fix
1870
1871
0
    my $uquery;
1872
0
    my @bind = ($borrowernumber, $item, $data->{'accountno'});
1873
0
    if ($exemptfine) {
1874
0
        $uquery = "update accountlines set accounttype='FFOR', amountoutstanding=0";
1875
0
        if (C4::Context->preference("FinesLog")) {
1876
0
            &logaction("FINES", 'MODIFY',$borrowernumber,"Overdue forgiven: item $item");
1877        }
1878    } elsif ($dropbox && $data->{lastincrement}) {
1879
0
        my $outstanding = $data->{amountoutstanding} - $data->{lastincrement} ;
1880
0
        my $amt = $data->{amount} - $data->{lastincrement} ;
1881
0
        if (C4::Context->preference("FinesLog")) {
1882
0
            &logaction("FINES", 'MODIFY',$borrowernumber,"Dropbox adjustment $amt, item $item");
1883        }
1884
0
         $uquery = "update accountlines set accounttype='F' ";
1885
0
         if($outstanding >= 0 && $amt >=0) {
1886
0
            $uquery .= ", amount = ? , amountoutstanding=? ";
1887
0
            unshift @bind, ($amt, $outstanding) ;
1888        }
1889    } else {
1890
0
        $uquery = "update accountlines set accounttype='F' ";
1891    }
1892
0
    $uquery .= " where (borrowernumber = ?) and (itemnumber = ?) and (accountno = ?)";
1893
0
    my $usth = $dbh->prepare($uquery);
1894
0
    return $usth->execute(@bind);
1895}
1896
1897 - 1908
=head2 _FixAccountForLostAndReturned

  &_FixAccountForLostAndReturned($itemnumber, [$borrowernumber, $barcode]);

Calculates the charge for a book lost and returned.

Internal function, not exported, called only by AddReturn.

FIXME: This function reflects how inscrutable fines logic is.  Fix both.
FIXME: Give a positive return value on success.  It might be the $borrowernumber who received credit, or the amount forgiven.

=cut
1909
1910sub _FixAccountForLostAndReturned {
1911
0
    my $itemnumber = shift or return;
1912
0
    my $borrowernumber = @_ ? shift : undef;
1913
0
    my $item_id = @_ ? shift : $itemnumber; # Send the barcode if you want that logged in the description
1914
0
    my $dbh = C4::Context->dbh;
1915    # check for charge made for lost book
1916
0
    my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE itemnumber = ? AND accounttype IN ('L', 'Rep', 'W') ORDER BY date DESC, accountno DESC");
1917
0
    $sth->execute($itemnumber);
1918
0
    my $data = $sth->fetchrow_hashref;
1919
0
    $data or return; # bail if there is nothing to do
1920
0
    $data->{accounttype} eq 'W' and return; # Written off
1921
1922    # writeoff this amount
1923
0
    my $offset;
1924
0
    my $amount = $data->{'amount'};
1925
0
    my $acctno = $data->{'accountno'};
1926
0
    my $amountleft; # Starts off undef/zero.
1927
0
    if ($data->{'amountoutstanding'} == $amount) {
1928
0
        $offset = $data->{'amount'};
1929
0
        $amountleft = 0; # Hey, it's zero here, too.
1930    } else {
1931
0
        $offset = $amount - $data->{'amountoutstanding'}; # Um, isn't this the same as ZERO? We just tested those two things are ==
1932
0
        $amountleft = $data->{'amountoutstanding'} - $amount; # Um, isn't this the same as ZERO? We just tested those two things are ==
1933    }
1934
0
    my $usth = $dbh->prepare("UPDATE accountlines SET accounttype = 'LR',amountoutstanding='0'
1935        WHERE (borrowernumber = ?)
1936        AND (itemnumber = ?) AND (accountno = ?) ");
1937
0
    $usth->execute($data->{'borrowernumber'},$itemnumber,$acctno); # We might be adjusting an account for some OTHER borrowernumber now. Not the one we passed in.
1938    #check if any credit is left if so writeoff other accounts
1939
0
    my $nextaccntno = getnextacctno($data->{'borrowernumber'});
1940
0
    $amountleft *= -1 if ($amountleft < 0);
1941
0
    if ($amountleft > 0) {
1942
0
        my $msth = $dbh->prepare("SELECT * FROM accountlines WHERE (borrowernumber = ?)
1943                            AND (amountoutstanding >0) ORDER BY date"); # might want to order by amountoustanding ASC (pay smallest first)
1944
0
        $msth->execute($data->{'borrowernumber'});
1945        # offset transactions
1946
0
        my $newamtos;
1947
0
        my $accdata;
1948
0
        while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
1949
0
            if ($accdata->{'amountoutstanding'} < $amountleft) {
1950
0
                $newamtos = 0;
1951
0
                $amountleft -= $accdata->{'amountoutstanding'};
1952            } else {
1953
0
                $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
1954
0
                $amountleft = 0;
1955            }
1956
0
            my $thisacct = $accdata->{'accountno'};
1957            # FIXME: move prepares outside while loop!
1958
0
            my $usth = $dbh->prepare("UPDATE accountlines SET amountoutstanding= ?
1959                    WHERE (borrowernumber = ?)
1960                    AND (accountno=?)");
1961
0
            $usth->execute($newamtos,$data->{'borrowernumber'},'$thisacct'); # FIXME: '$thisacct' is a string literal!
1962
0
            $usth = $dbh->prepare("INSERT INTO accountoffsets
1963                (borrowernumber, accountno, offsetaccount, offsetamount)
1964                VALUES
1965                (?,?,?,?)");
1966
0
            $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos);
1967        }
1968
0
        $msth->finish; # $msth might actually have data left
1969    }
1970
0
    $amountleft *= -1 if ($amountleft > 0);
1971
0
    my $desc = "Item Returned " . $item_id;
1972
0
    $usth = $dbh->prepare("INSERT INTO accountlines
1973        (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
1974        VALUES (?,?,now(),?,?,'CR',?)");
1975
0
    $usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft);
1976
0
    if ($borrowernumber) {
1977        # FIXME: same as query above. use 1 sth for both
1978
0
        $usth = $dbh->prepare("INSERT INTO accountoffsets
1979            (borrowernumber, accountno, offsetaccount, offsetamount)
1980            VALUES (?,?,?,?)");
1981
0
        $usth->execute($borrowernumber, $data->{'accountno'}, $nextaccntno, $offset);
1982    }
1983
0
    ModItem({ paidfor => '' }, undef, $itemnumber);
1984
0
    return;
1985}
1986
1987 - 2001
=head2 _GetCircControlBranch

   my $circ_control_branch = _GetCircControlBranch($iteminfos, $borrower);

Internal function : 

Return the library code to be used to determine which circulation
policy applies to a transaction.  Looks up the CircControl and
HomeOrHoldingBranch system preferences.

C<$iteminfos> is a hashref to iteminfo. Only {homebranch or holdingbranch} is used.

C<$borrower> is a hashref to borrower. Only {branchcode} is used.

=cut
2002
2003sub _GetCircControlBranch {
2004
0
    my ($item, $borrower) = @_;
2005
0
    my $circcontrol = C4::Context->preference('CircControl');
2006
0
    my $branch;
2007
2008
0
    if ($circcontrol eq 'PickupLibrary' and (C4::Context->userenv and C4::Context->userenv->{'branch'}) ) {
2009
0
        $branch= C4::Context->userenv->{'branch'};
2010    } elsif ($circcontrol eq 'PatronLibrary') {
2011
0
        $branch=$borrower->{branchcode};
2012    } else {
2013
0
        my $branchfield = C4::Context->preference('HomeOrHoldingBranch') || 'homebranch';
2014
0
        $branch = $item->{$branchfield};
2015        # default to item home branch if holdingbranch is used
2016        # and is not defined
2017
0
        if (!defined($branch) && $branchfield eq 'holdingbranch') {
2018
0
            $branch = $item->{homebranch};
2019        }
2020    }
2021
0
    return $branch;
2022}
2023
2024
2025
2026
2027
2028
2029 - 2039
=head2 GetItemIssue

  $issue = &GetItemIssue($itemnumber);

Returns patron currently having a book, or undef if not checked out.

C<$itemnumber> is the itemnumber.

C<$issue> is a hashref of the row from the issues table.

=cut
2040
2041sub GetItemIssue {
2042
0
    my ($itemnumber) = @_;
2043
0
    return unless $itemnumber;
2044
0
    my $sth = C4::Context->dbh->prepare(
2045        "SELECT *
2046        FROM issues
2047        LEFT JOIN items ON issues.itemnumber=items.itemnumber
2048        WHERE issues.itemnumber=?");
2049
0
    $sth->execute($itemnumber);
2050
0
    my $data = $sth->fetchrow_hashref;
2051
0
    return unless $data;
2052
0
    $data->{issuedate} = dt_from_string($data->{issuedate}, 'sql');
2053
0
    $data->{issuedate}->truncate(to => 'minutes');
2054
0
    $data->{date_due} = dt_from_string($data->{date_due}, 'sql');
2055
0
    $data->{date_due}->truncate(to => 'minutes');
2056
0
    my $dt = DateTime->now( time_zone => C4::Context->tz)->truncate( to => 'minutes');
2057
0
    $data->{'overdue'} = DateTime->compare($data->{'date_due'}, $dt ) == -1 ? 1 : 0;
2058
0
    return $data;
2059}
2060
2061 - 2071
=head2 GetOpenIssue

  $issue = GetOpenIssue( $itemnumber );

Returns the row from the issues table if the item is currently issued, undef if the item is not currently issued

C<$itemnumber> is the item's itemnumber

Returns a hashref

=cut
2072
2073sub GetOpenIssue {
2074
0
  my ( $itemnumber ) = @_;
2075
2076
0
  my $dbh = C4::Context->dbh;
2077
0
  my $sth = $dbh->prepare( "SELECT * FROM issues WHERE itemnumber = ? AND returndate IS NULL" );
2078
0
  $sth->execute( $itemnumber );
2079
0
  my $issue = $sth->fetchrow_hashref();
2080
0
  return $issue;
2081}
2082
2083 - 2095
=head2 GetItemIssues

  $issues = &GetItemIssues($itemnumber, $history);

Returns patrons that have issued a book

C<$itemnumber> is the itemnumber
C<$history> is false if you just want the current "issuer" (if any)
and true if you want issues history from old_issues also.

Returns reference to an array of hashes

=cut
2096
2097sub GetItemIssues {
2098
0
    my ( $itemnumber, $history ) = @_;
2099
2100
0
    my $today = DateTime->now( time_zome => C4::Context->tz); # get today date
2101
0
    $today->truncate( to => 'minutes' );
2102
0
    my $sql = "SELECT * FROM issues
2103              JOIN borrowers USING (borrowernumber)
2104              JOIN items USING (itemnumber)
2105              WHERE issues.itemnumber = ? ";
2106
0
    if ($history) {
2107
0
        $sql .= "UNION ALL
2108                 SELECT * FROM old_issues
2109                 LEFT JOIN borrowers USING (borrowernumber)
2110                 JOIN items USING (itemnumber)
2111                 WHERE old_issues.itemnumber = ? ";
2112    }
2113
0
    $sql .= "ORDER BY date_due DESC";
2114
0
    my $sth = C4::Context->dbh->prepare($sql);
2115
0
    if ($history) {
2116
0
        $sth->execute($itemnumber, $itemnumber);
2117    } else {
2118
0
        $sth->execute($itemnumber);
2119    }
2120
0
    my $results = $sth->fetchall_arrayref({});
2121
0
    foreach (@$results) {
2122
0
        my $date_due = dt_from_string($_->{date_due},'sql');
2123
0
        $date_due->truncate( to => 'minutes' );
2124
2125
0
        $_->{overdue} = (DateTime->compare($date_due, $today) == -1) ? 1 : 0;
2126    }
2127
0
    return $results;
2128}
2129
2130 - 2140
=head2 GetBiblioIssues

  $issues = GetBiblioIssues($biblionumber);

this function get all issues from a biblionumber.

Return:
C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash containts all column from
tables issues and the firstname,surname & cardnumber from borrowers.

=cut
2141
2142sub GetBiblioIssues {
2143
0
    my $biblionumber = shift;
2144
0
    return undef unless $biblionumber;
2145
0
    my $dbh = C4::Context->dbh;
2146
0
    my $query = "
2147        SELECT issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2148        FROM issues
2149            LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
2150            LEFT JOIN items ON issues.itemnumber = items.itemnumber
2151            LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2152            LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2153        WHERE biblio.biblionumber = ?
2154        UNION ALL
2155        SELECT old_issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2156        FROM old_issues
2157            LEFT JOIN borrowers ON borrowers.borrowernumber = old_issues.borrowernumber
2158            LEFT JOIN items ON old_issues.itemnumber = items.itemnumber
2159            LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2160            LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2161        WHERE biblio.biblionumber = ?
2162        ORDER BY timestamp
2163    ";
2164
0
    my $sth = $dbh->prepare($query);
2165
0
    $sth->execute($biblionumber, $biblionumber);
2166
2167
0
    my @issues;
2168
0
    while ( my $data = $sth->fetchrow_hashref ) {
2169
0
        push @issues, $data;
2170    }
2171
0
    return \@issues;
2172}
2173
2174 - 2178
=head2 GetUpcomingDueIssues

  my $upcoming_dues = GetUpcomingDueIssues( { days_in_advance => 4 } );

=cut
2179
2180sub GetUpcomingDueIssues {
2181
0
    my $params = shift;
2182
2183
0
    $params->{'days_in_advance'} = 7 unless exists $params->{'days_in_advance'};
2184
0
    my $dbh = C4::Context->dbh;
2185
2186
0
    my $statement = <<END_SQL;
2187SELECT issues.*, items.itype as itemtype, items.homebranch, TO_DAYS( date_due )-TO_DAYS( NOW() ) as days_until_due, branches.branchemail
2188FROM issues
2189LEFT JOIN items USING (itemnumber)
2190LEFT OUTER JOIN branches USING (branchcode)
2191WhERE returndate is NULL
2192AND ( TO_DAYS( NOW() )-TO_DAYS( date_due ) ) < ?
2193END_SQL
2194
2195
0
    my @bind_parameters = ( $params->{'days_in_advance'} );
2196
2197
0
    my $sth = $dbh->prepare( $statement );
2198
0
    $sth->execute( @bind_parameters );
2199
0
    my $upcoming_dues = $sth->fetchall_arrayref({});
2200
0
    $sth->finish;
2201
2202
0
    return $upcoming_dues;
2203}
2204
2205 - 2227
=head2 CanBookBeRenewed

  ($ok,$error) = &CanBookBeRenewed($borrowernumber, $itemnumber[, $override_limit]);

Find out whether a borrowed item may be renewed.

C<$dbh> is a DBI handle to the Koha database.

C<$borrowernumber> is the borrower number of the patron who currently
has the item on loan.

C<$itemnumber> is the number of the item to renew.

C<$override_limit>, if supplied with a true value, causes
the limit on the number of times that the loan can be renewed
(as controlled by the item type) to be ignored.

C<$CanBookBeRenewed> returns a true value iff the item may be renewed. The
item must currently be on loan to the specified borrower; renewals
must be allowed for the item's type; and the borrower must not have
already renewed the loan. $error will contain the reason the renewal can not proceed

=cut
2228
2229sub CanBookBeRenewed {
2230
2231    # check renewal status
2232
0
    my ( $borrowernumber, $itemnumber, $override_limit ) = @_;
2233
0
    my $dbh = C4::Context->dbh;
2234
0
    my $renews = 1;
2235
0
    my $renewokay = 0;
2236
0
        my $error;
2237
2238    # Look in the issues table for this item, lent to this borrower,
2239    # and not yet returned.
2240
2241    # Look in the issues table for this item, lent to this borrower,
2242    # and not yet returned.
2243
0
    my %branch = (
2244            'ItemHomeLibrary' => 'items.homebranch',
2245            'PickupLibrary' => 'items.holdingbranch',
2246            'PatronLibrary' => 'borrowers.branchcode'
2247            );
2248
0
    my $controlbranch = $branch{C4::Context->preference('CircControl')};
2249
0
    my $itype = C4::Context->preference('item-level_itypes') ? 'items.itype' : 'biblioitems.itemtype';
2250
2251
0
    my $sthcount = $dbh->prepare("
2252                   SELECT
2253                    borrowers.categorycode, biblioitems.itemtype, issues.renewals, renewalsallowed, $controlbranch
2254                   FROM issuingrules,
2255                   issues
2256                   LEFT JOIN items USING (itemnumber)
2257                   LEFT JOIN borrowers USING (borrowernumber)
2258                   LEFT JOIN biblioitems USING (biblioitemnumber)
2259
2260                   WHERE
2261                    (issuingrules.categorycode = borrowers.categorycode OR issuingrules.categorycode = '*')
2262                   AND
2263                    (issuingrules.itemtype = $itype OR issuingrules.itemtype = '*')
2264                   AND
2265                    (issuingrules.branchcode = $controlbranch OR issuingrules.branchcode = '*')
2266                   AND
2267                    borrowernumber = ?
2268                   AND
2269                    itemnumber = ?
2270                   ORDER BY
2271                    issuingrules.categorycode desc,
2272                    issuingrules.itemtype desc,
2273                    issuingrules.branchcode desc
2274                   LIMIT 1;
2275                  ");
2276
2277
0
    $sthcount->execute( $borrowernumber, $itemnumber );
2278
0
    if ( my $data1 = $sthcount->fetchrow_hashref ) {
2279
2280
0
        if ( ( $data1->{renewalsallowed} && $data1->{renewalsallowed} > $data1->{renewals} ) || $override_limit ) {
2281
0
            $renewokay = 1;
2282        }
2283        else {
2284
0
                        $error="too_many";
2285                }
2286
2287
0
        my ( $resfound, $resrec, undef ) = C4::Reserves::CheckReserves($itemnumber);
2288
0
        if ($resfound) {
2289
0
            $renewokay = 0;
2290
0
                        $error="on_reserve"
2291        }
2292
2293    }
2294
0
    return ($renewokay,$error);
2295}
2296
2297 - 2319
=head2 AddRenewal

  &AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue], [$lastreneweddate]);

Renews a loan.

C<$borrowernumber> is the borrower number of the patron who currently
has the item.

C<$itemnumber> is the number of the item to renew.

C<$branch> is the library where the renewal took place (if any).
           The library that controls the circ policies for the renewal is retrieved from the issues record.

C<$datedue> can be a C4::Dates object used to set the due date.

C<$lastreneweddate> is an optional ISO-formatted date used to set issues.lastreneweddate.  If
this parameter is not supplied, lastreneweddate is set to the current date.

If C<$datedue> is the empty string, C<&AddRenewal> will calculate the due date automatically
from the book's item type.

=cut
2320
2321sub AddRenewal {
2322
0
    my $borrowernumber = shift or return undef;
2323
0
    my $itemnumber = shift or return undef;
2324
0
    my $branch = shift;
2325
0
    my $datedue = shift;
2326
0
    my $lastreneweddate = shift || DateTime->now(time_zone => C4::Context->tz)->ymd();
2327
0
    my $item = GetItem($itemnumber) or return undef;
2328
0
    my $biblio = GetBiblioFromItemNumber($itemnumber) or return undef;
2329
2330
0
    my $dbh = C4::Context->dbh;
2331    # Find the issues record for this book
2332
0
    my $sth =
2333      $dbh->prepare("SELECT * FROM issues
2334                        WHERE borrowernumber=?
2335                        AND itemnumber=?"
2336      );
2337
0
    $sth->execute( $borrowernumber, $itemnumber );
2338
0
    my $issuedata = $sth->fetchrow_hashref;
2339
0
    $sth->finish;
2340
0
    if(defined $datedue && ref $datedue ne 'DateTime' ) {
2341
0
        carp 'Invalid date passed to AddRenewal.';
2342
0
        return;
2343    }
2344    # If the due date wasn't specified, calculate it by adding the
2345    # book's loan length to today's date or the current due date
2346    # based on the value of the RenewalPeriodBase syspref.
2347
0
    unless ($datedue) {
2348
2349
0
        my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber ) or return undef;
2350
0
        my $itemtype = (C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'};
2351
2352
0
        $datedue = (C4::Context->preference('RenewalPeriodBase') eq 'date_due') ?
2353                                        $issuedata->{date_due} :
2354                                        DateTime->now( time_zone => C4::Context->tz());
2355
0
        $datedue = CalcDateDue($datedue,$itemtype,$issuedata->{'branchcode'},$borrower);
2356    }
2357
2358    # Update the issues record to have the new due date, and a new count
2359    # of how many times it has been renewed.
2360
0
    my $renews = $issuedata->{'renewals'} + 1;
2361
0
    $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?, lastreneweddate = ?
2362                            WHERE borrowernumber=?
2363                            AND itemnumber=?"
2364    );
2365
2366
0
    $sth->execute( $datedue->strftime('%Y-%m-%d %H:%M'), $renews, $lastreneweddate, $borrowernumber, $itemnumber );
2367
0
    $sth->finish;
2368
2369    # Update the renewal count on the item, and tell zebra to reindex
2370
0
    $renews = $biblio->{'renewals'} + 1;
2371
0
    ModItem({ renewals => $renews, onloan => $datedue->strftime('%Y-%m-%d %H:%M')}, $biblio->{'biblionumber'}, $itemnumber);
2372
2373    # Charge a new rental fee, if applicable?
2374
0
    my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
2375
0
    if ( $charge > 0 ) {
2376
0
        my $accountno = getnextacctno( $borrowernumber );
2377
0
        my $item = GetBiblioFromItemNumber($itemnumber);
2378
0
        my $manager_id = 0;
2379
0
        $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
2380
0
        $sth = $dbh->prepare(
2381                "INSERT INTO accountlines
2382                    (date, borrowernumber, accountno, amount, manager_id,
2383                    description,accounttype, amountoutstanding, itemnumber)
2384                    VALUES (now(),?,?,?,?,?,?,?,?)"
2385        );
2386
0
        $sth->execute( $borrowernumber, $accountno, $charge, $manager_id,
2387            "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
2388            'Rent', $charge, $itemnumber );
2389    }
2390    # Log the renewal
2391
0
    UpdateStats( $branch, 'renew', $charge, '', $itemnumber, $item->{itype}, $borrowernumber);
2392
0
        return $datedue;
2393}
2394
2395sub GetRenewCount {
2396    # check renewal status
2397
0
    my ( $bornum, $itemno ) = @_;
2398
0
    my $dbh = C4::Context->dbh;
2399
0
    my $renewcount = 0;
2400
0
    my $renewsallowed = 0;
2401
0
    my $renewsleft = 0;
2402
2403
0
    my $borrower = C4::Members::GetMember( borrowernumber => $bornum);
2404
0
    my $item = GetItem($itemno);
2405
2406    # Look in the issues table for this item, lent to this borrower,
2407    # and not yet returned.
2408
2409    # FIXME - I think this function could be redone to use only one SQL call.
2410
0
    my $sth = $dbh->prepare(
2411        "select * from issues
2412                                where (borrowernumber = ?)
2413                                and (itemnumber = ?)"
2414    );
2415
0
    $sth->execute( $bornum, $itemno );
2416
0
    my $data = $sth->fetchrow_hashref;
2417
0
    $renewcount = $data->{'renewals'} if $data->{'renewals'};
2418
0
    $sth->finish;
2419    # $item and $borrower should be calculated
2420
0
    my $branchcode = _GetCircControlBranch($item, $borrower);
2421
2422
0
    my $issuingrule = GetIssuingRule($borrower->{categorycode}, $item->{itype}, $branchcode);
2423
2424
0
    $renewsallowed = $issuingrule->{'renewalsallowed'};
2425
0
    $renewsleft = $renewsallowed - $renewcount;
2426
0
0
    if($renewsleft < 0){ $renewsleft = 0; }
2427
0
    return ( $renewcount, $renewsallowed, $renewsleft );
2428}
2429
2430 - 2445
=head2 GetIssuingCharges

  ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);

Calculate how much it would cost for a given patron to borrow a given
item, including any applicable discounts.

C<$itemnumber> is the item number of item the patron wishes to borrow.

C<$borrowernumber> is the patron's borrower number.

C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
and C<$item_type> is the code for the item's item type (e.g., C<VID>
if it's a video).

=cut
2446
2447sub GetIssuingCharges {
2448
2449    # calculate charges due
2450
0
    my ( $itemnumber, $borrowernumber ) = @_;
2451
0
    my $charge = 0;
2452
0
    my $dbh = C4::Context->dbh;
2453
0
    my $item_type;
2454
2455    # Get the book's item type and rental charge (via its biblioitem).
2456
0
    my $charge_query = 'SELECT itemtypes.itemtype,rentalcharge FROM items
2457        LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber';
2458
0
    $charge_query .= (C4::Context->preference('item-level_itypes'))
2459        ? ' LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype'
2460        : ' LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype';
2461
2462
0
    $charge_query .= ' WHERE items.itemnumber =?';
2463
2464
0
    my $sth = $dbh->prepare($charge_query);
2465
0
    $sth->execute($itemnumber);
2466
0
    if ( my $item_data = $sth->fetchrow_hashref ) {
2467
0
        $item_type = $item_data->{itemtype};
2468
0
        $charge = $item_data->{rentalcharge};
2469
0
        my $branch = C4::Branch::mybranch();
2470
0
        my $discount_query = q|SELECT rentaldiscount,
2471            issuingrules.itemtype, issuingrules.branchcode
2472            FROM borrowers
2473            LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
2474            WHERE borrowers.borrowernumber = ?
2475            AND (issuingrules.itemtype = ? OR issuingrules.itemtype = '*')
2476            AND (issuingrules.branchcode = ? OR issuingrules.branchcode = '*')|;
2477
0
        my $discount_sth = $dbh->prepare($discount_query);
2478
0
        $discount_sth->execute( $borrowernumber, $item_type, $branch );
2479
0
        my $discount_rules = $discount_sth->fetchall_arrayref({});
2480
0
0
        if (@{$discount_rules}) {
2481            # We may have multiple rules so get the most specific
2482
0
            my $discount = _get_discount_from_rule($discount_rules, $branch, $item_type);
2483
0
            $charge = ( $charge * ( 100 - $discount ) ) / 100;
2484        }
2485    }
2486
2487
0
    $sth->finish; # we havent _explicitly_ fetched all rows
2488
0
    return ( $charge, $item_type );
2489}
2490
2491# Select most appropriate discount rule from those returned
2492sub _get_discount_from_rule {
2493
0
    my ($rules_ref, $branch, $itemtype) = @_;
2494
0
    my $discount;
2495
2496
0
0
    if (@{$rules_ref} == 1) { # only 1 applicable rule use it
2497
0
        $discount = $rules_ref->[0]->{rentaldiscount};
2498
0
        return (defined $discount) ? $discount : 0;
2499    }
2500    # could have up to 4 does one match $branch and $itemtype
2501
0
0
0
    my @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq $itemtype } @{$rules_ref};
2502
0
    if (@d) {
2503
0
        $discount = $d[0]->{rentaldiscount};
2504
0
        return (defined $discount) ? $discount : 0;
2505    }
2506    # do we have item type + all branches
2507
0
0
0
    @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq $itemtype } @{$rules_ref};
2508
0
    if (@d) {
2509
0
        $discount = $d[0]->{rentaldiscount};
2510
0
        return (defined $discount) ? $discount : 0;
2511    }
2512    # do we all item types + this branch
2513
0
0
0
    @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq q{*} } @{$rules_ref};
2514
0
    if (@d) {
2515
0
        $discount = $d[0]->{rentaldiscount};
2516
0
        return (defined $discount) ? $discount : 0;
2517    }
2518    # so all and all (surely we wont get here)
2519
0
0
0
    @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq q{*} } @{$rules_ref};
2520
0
    if (@d) {
2521
0
        $discount = $d[0]->{rentaldiscount};
2522
0
        return (defined $discount) ? $discount : 0;
2523    }
2524    # none of the above
2525
0
    return 0;
2526}
2527
2528 - 2532
=head2 AddIssuingCharge

  &AddIssuingCharge( $itemno, $borrowernumber, $charge )

=cut
2533
2534sub AddIssuingCharge {
2535
0
    my ( $itemnumber, $borrowernumber, $charge ) = @_;
2536
0
    my $dbh = C4::Context->dbh;
2537
0
    my $nextaccntno = getnextacctno( $borrowernumber );
2538
0
    my $manager_id = 0;
2539
0
    $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
2540
0
    my $query ="
2541        INSERT INTO accountlines
2542            (borrowernumber, itemnumber, accountno,
2543            date, amount, description, accounttype,
2544            amountoutstanding, manager_id)
2545        VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?,?)
2546    ";
2547
0
    my $sth = $dbh->prepare($query);
2548
0
    $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge, $manager_id );
2549
0
    $sth->finish;
2550}
2551
2552 - 2556
=head2 GetTransfers

  GetTransfers($itemnumber);

=cut
2557
2558sub GetTransfers {
2559
0
    my ($itemnumber) = @_;
2560
2561
0
    my $dbh = C4::Context->dbh;
2562
2563
0
    my $query = '
2564        SELECT datesent,
2565               frombranch,
2566               tobranch
2567        FROM branchtransfers
2568        WHERE itemnumber = ?
2569          AND datearrived IS NULL
2570        ';
2571
0
    my $sth = $dbh->prepare($query);
2572
0
    $sth->execute($itemnumber);
2573
0
    my @row = $sth->fetchrow_array();
2574
0
    $sth->finish;
2575
0
    return @row;
2576}
2577
2578 - 2584
=head2 GetTransfersFromTo

  @results = GetTransfersFromTo($frombranch,$tobranch);

Returns the list of pending transfers between $from and $to branch

=cut
2585
2586sub GetTransfersFromTo {
2587
0
    my ( $frombranch, $tobranch ) = @_;
2588
0
    return unless ( $frombranch && $tobranch );
2589
0
    my $dbh = C4::Context->dbh;
2590
0
    my $query = "
2591        SELECT itemnumber,datesent,frombranch
2592        FROM branchtransfers
2593        WHERE frombranch=?
2594          AND tobranch=?
2595          AND datearrived IS NULL
2596    ";
2597
0
    my $sth = $dbh->prepare($query);
2598
0
    $sth->execute( $frombranch, $tobranch );
2599
0
    my @gettransfers;
2600
2601
0
    while ( my $data = $sth->fetchrow_hashref ) {
2602
0
        push @gettransfers, $data;
2603    }
2604
0
    $sth->finish;
2605
0
    return (@gettransfers);
2606}
2607
2608 - 2612
=head2 DeleteTransfer

  &DeleteTransfer($itemnumber);

=cut
2613
2614sub DeleteTransfer {
2615
0
    my ($itemnumber) = @_;
2616
0
    my $dbh = C4::Context->dbh;
2617
0
    my $sth = $dbh->prepare(
2618        "DELETE FROM branchtransfers
2619         WHERE itemnumber=?
2620         AND datearrived IS NULL "
2621    );
2622
0
    $sth->execute($itemnumber);
2623
0
    $sth->finish;
2624}
2625
2626 - 2638
=head2 AnonymiseIssueHistory

  $rows = AnonymiseIssueHistory($date,$borrowernumber)

This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.

If c<$borrowernumber> is set, it will delete issue history for only that borrower, regardless of their opac privacy
setting (force delete).

return the number of affected rows.

=cut
2639
2640sub AnonymiseIssueHistory {
2641
0
    my $date = shift;
2642
0
    my $borrowernumber = shift;
2643
0
    my $dbh = C4::Context->dbh;
2644
0
    my $query = "
2645        UPDATE old_issues
2646        SET borrowernumber = ?
2647        WHERE returndate < ?
2648          AND borrowernumber IS NOT NULL
2649    ";
2650
2651    # The default of 0 does not work due to foreign key constraints
2652    # The anonymisation will fail quietly if AnonymousPatron is not a valid entry
2653
0
    my $anonymouspatron = (C4::Context->preference('AnonymousPatron')) ? C4::Context->preference('AnonymousPatron') : 0;
2654
0
    my @bind_params = ($anonymouspatron, $date);
2655
0
    if (defined $borrowernumber) {
2656
0
       $query .= " AND borrowernumber = ?";
2657
0
       push @bind_params, $borrowernumber;
2658    } else {
2659
0
       $query .= " AND (SELECT privacy FROM borrowers WHERE borrowers.borrowernumber=old_issues.borrowernumber) <> 0";
2660    }
2661
0
    my $sth = $dbh->prepare($query);
2662
0
    $sth->execute(@bind_params);
2663
0
    my $rows_affected = $sth->rows; ### doublecheck row count return function
2664
0
    return $rows_affected;
2665}
2666
2667 - 2702
=head2 SendCirculationAlert

Send out a C<check-in> or C<checkout> alert using the messaging system.

B<Parameters>:

=over 4

=item type

Valid values for this parameter are: C<CHECKIN> and C<CHECKOUT>.

=item item

Hashref of information about the item being checked in or out.

=item borrower

Hashref of information about the borrower of the item.

=item branch

The branchcode from where the checkout or check-in took place.

=back

B<Example>:

    SendCirculationAlert({
        type     => 'CHECKOUT',
        item     => $item,
        borrower => $borrower,
        branch   => $branch,
    });

=cut
2703
2704sub SendCirculationAlert {
2705
0
    my ($opts) = @_;
2706
0
    my ($type, $item, $borrower, $branch) =
2707        ($opts->{type}, $opts->{item}, $opts->{borrower}, $opts->{branch});
2708
0
    my %message_name = (
2709        CHECKIN => 'Item_Check_in',
2710        CHECKOUT => 'Item_Checkout',
2711    );
2712
0
    my $borrower_preferences = C4::Members::Messaging::GetMessagingPreferences({
2713        borrowernumber => $borrower->{borrowernumber},
2714        message_name => $message_name{$type},
2715    });
2716
0
    my $letter = C4::Letters::GetPreparedLetter (
2717        module => 'circulation',
2718        letter_code => $type,
2719        branchcode => $branch,
2720        tables => {
2721            'biblio' => $item->{biblionumber},
2722            'biblioitems' => $item->{biblionumber},
2723            'borrowers' => $borrower,
2724            'branches' => $branch,
2725        }
2726    ) or return;
2727
2728
0
0
    my @transports = @{ $borrower_preferences->{transports} };
2729    # warn "no transports" unless @transports;
2730
0
    for (@transports) {
2731        # warn "transport: $_";
2732
0
        my $message = C4::Message->find_last_message($borrower, $type, $_);
2733
0
        if (!$message) {
2734            #warn "create new message";
2735
0
            C4::Message->enqueue($letter, $borrower, $_);
2736        } else {
2737            #warn "append to old message";
2738
0
            $message->append($letter);
2739
0
            $message->update;
2740        }
2741    }
2742
2743
0
    return $letter;
2744}
2745
2746 - 2752
=head2 updateWrongTransfer

  $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);

This function validate the line of brachtransfer but with the wrong destination (mistake from a librarian ...), and create a new line in branchtransfer from the actual library to the original library of reservation 

=cut
2753
2754sub updateWrongTransfer {
2755
0
        my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
2756
0
        my $dbh = C4::Context->dbh;
2757# first step validate the actual line of transfert .
2758
0
        my $sth =
2759         $dbh->prepare(
2760                        "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
2761           );
2762
0
         $sth->execute($FromLibrary,$itemNumber);
2763
0
         $sth->finish;
2764
2765# second step create a new line of branchtransfer to the right location .
2766
0
        ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
2767
2768#third step changing holdingbranch of item
2769
0
        UpdateHoldingbranch($FromLibrary,$itemNumber);
2770}
2771
2772 - 2778
=head2 UpdateHoldingbranch

  $items = UpdateHoldingbranch($branch,$itmenumber);

Simple methode for updating hodlingbranch in items BDD line

=cut
2779
2780sub UpdateHoldingbranch {
2781
0
        my ( $branch,$itemnumber ) = @_;
2782
0
    ModItem({ holdingbranch => $branch }, undef, $itemnumber);
2783}
2784
2785 - 2796
=head2 CalcDateDue

$newdatedue = CalcDateDue($startdate,$itemtype,$branchcode,$borrower);

this function calculates the due date given the start date and configured circulation rules,
checking against the holidays calendar as per the 'useDaysMode' syspref.
C<$startdate>   = C4::Dates object representing start date of loan period (assumed to be today)
C<$itemtype>  = itemtype code of item in question
C<$branch>  = location whose calendar to use
C<$borrower> = Borrower object

=cut
2797
2798sub CalcDateDue {
2799
0
    my ( $startdate, $itemtype, $branch, $borrower ) = @_;
2800
2801    # loanlength now a href
2802
0
    my $loanlength =
2803      GetLoanLength( $borrower->{'categorycode'}, $itemtype, $branch );
2804
2805
0
    my $datedue;
2806
2807    # if globalDueDate ON the datedue is set to that date
2808
0
    if (C4::Context->preference('globalDueDate')
2809        && ( C4::Context->preference('globalDueDate') =~
2810            C4::Dates->regexp('syspref') )
2811      ) {
2812
0
        $datedue = dt_from_string(
2813            C4::Context->preference('globalDueDate'),
2814            C4::Context->preference('dateformat')
2815        );
2816    } else {
2817
2818        # otherwise, calculate the datedue as normal
2819
0
        if ( C4::Context->preference('useDaysMode') eq 'Days' )
2820        { # ignoring calendar
2821
0
            my $dt =
2822              DateTime->now( time_zone => C4::Context->tz() )
2823              ->truncate( to => 'minute' );
2824
0
            if ( $loanlength->{lengthunit} eq 'hours' ) {
2825
0
                $dt->add( hours => $loanlength->{issuelength} );
2826
0
                return $dt;
2827            } else { # days
2828
0
                $dt->add( days => $loanlength->{issuelength} );
2829
0
                $dt->set_hour(23);
2830
0
                $dt->set_minute(59);
2831
0
                return $dt;
2832            }
2833        } else {
2834
0
            my $dur;
2835
0
            if ($loanlength->{lengthunit} eq 'hours') {
2836
0
                $dur = DateTime::Duration->new( hours => $loanlength->{issuelength});
2837            }
2838            else { # days
2839
0
                $dur = DateTime::Duration->new( days => $loanlength->{issuelength});
2840            }
2841
0
            if (ref $startdate ne 'DateTime' ) {
2842
0
                $startdate = dt_from_string($startdate);
2843            }
2844
0
            my $calendar = Koha::Calendar->new( branchcode => $branch );
2845
0
            $datedue = $calendar->addDate( $startdate, $dur, $loanlength->{lengthunit} );
2846
0
            if ($loanlength->{lengthunit} eq 'days') {
2847
0
                $datedue->set_hour(23);
2848
0
                $datedue->set_minute(59);
2849            }
2850        }
2851    }
2852
2853    # if Hard Due Dates are used, retreive them and apply as necessary
2854
0
    my ( $hardduedate, $hardduedatecompare ) =
2855      GetHardDueDate( $borrower->{'categorycode'}, $itemtype, $branch );
2856
0
    if ($hardduedate) { # hardduedates are currently dates
2857
0
        $hardduedate->truncate( to => 'minute' );
2858
0
        $hardduedate->set_hour(23);
2859
0
        $hardduedate->set_minute(59);
2860
0
        my $cmp = DateTime->compare( $hardduedate, $datedue );
2861
2862# if the calculated due date is after the 'before' Hard Due Date (ceiling), override
2863# if the calculated date is before the 'after' Hard Due Date (floor), override
2864# if the hard due date is set to 'exactly', overrride
2865
0
        if ( $hardduedatecompare == 0 || $hardduedatecompare == $cmp ) {
2866
0
            $datedue = $hardduedate->clone;
2867        }
2868
2869        # in all other cases, keep the date due as it is
2870    }
2871
2872    # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
2873
0
    if ( C4::Context->preference('ReturnBeforeExpiry') ) {
2874
0
        my $expiry_dt = dt_from_string( $borrower->{dateexpiry}, 'iso' );
2875
0
        if ( DateTime->compare( $datedue, $expiry_dt ) == 1 ) {
2876
0
            $datedue = $expiry_dt->clone;
2877        }
2878    }
2879
2880
0
    return $datedue;
2881}
2882
2883
2884 - 2894
=head2 CheckRepeatableHolidays

  $countrepeatable = CheckRepeatableHoliday($itemnumber,$week_day,$branchcode);

This function checks if the date due is a repeatable holiday

C<$date_due>   = returndate calculate with no day check
C<$itemnumber>  = itemnumber
C<$branchcode>  = localisation of issue 

=cut
2895
2896sub CheckRepeatableHolidays{
2897
0
my($itemnumber,$week_day,$branchcode)=@_;
2898
0
my $dbh = C4::Context->dbh;
2899
0
my $query = qq|SELECT count(*)
2900        FROM repeatable_holidays
2901        WHERE branchcode=?
2902        AND weekday=?|;
2903
0
my $sth = $dbh->prepare($query);
2904
0
$sth->execute($branchcode,$week_day);
2905
0
my $result=$sth->fetchrow;
2906
0
$sth->finish;
2907
0
return $result;
2908}
2909
2910
2911 - 2923
=head2 CheckSpecialHolidays

  $countspecial = CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);

This function check if the date is a special holiday

C<$years>   = the years of datedue
C<$month>   = the month of datedue
C<$day>     = the day of datedue
C<$itemnumber>  = itemnumber
C<$branchcode>  = localisation of issue 

=cut
2924
2925sub CheckSpecialHolidays{
2926
0
my ($years,$month,$day,$itemnumber,$branchcode) = @_;
2927
0
my $dbh = C4::Context->dbh;
2928
0
my $query=qq|SELECT count(*)
2929             FROM `special_holidays`
2930             WHERE year=?
2931             AND month=?
2932             AND day=?
2933             AND branchcode=?
2934            |;
2935
0
my $sth = $dbh->prepare($query);
2936
0
$sth->execute($years,$month,$day,$branchcode);
2937
0
my $countspecial=$sth->fetchrow ;
2938
0
$sth->finish;
2939
0
return $countspecial;
2940}
2941
2942 - 2953
=head2 CheckRepeatableSpecialHolidays

  $countspecial = CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);

This function check if the date is a repeatble special holidays

C<$month>   = the month of datedue
C<$day>     = the day of datedue
C<$itemnumber>  = itemnumber
C<$branchcode>  = localisation of issue 

=cut
2954
2955sub CheckRepeatableSpecialHolidays{
2956
0
my ($month,$day,$itemnumber,$branchcode) = @_;
2957
0
my $dbh = C4::Context->dbh;
2958
0
my $query=qq|SELECT count(*)
2959             FROM `repeatable_holidays`
2960             WHERE month=?
2961             AND day=?
2962             AND branchcode=?
2963            |;
2964
0
my $sth = $dbh->prepare($query);
2965
0
$sth->execute($month,$day,$branchcode);
2966
0
my $countspecial=$sth->fetchrow ;
2967
0
$sth->finish;
2968
0
return $countspecial;
2969}
2970
2971
2972
2973sub CheckValidBarcode{
2974
0
my ($barcode) = @_;
2975
0
my $dbh = C4::Context->dbh;
2976
0
my $query=qq|SELECT count(*)
2977             FROM items
2978             WHERE barcode=?
2979            |;
2980
0
my $sth = $dbh->prepare($query);
2981
0
$sth->execute($barcode);
2982
0
my $exist=$sth->fetchrow ;
2983
0
$sth->finish;
2984
0
return $exist;
2985}
2986
2987 - 2993
=head2 IsBranchTransferAllowed

  $allowed = IsBranchTransferAllowed( $toBranch, $fromBranch, $code );

Code is either an itemtype or collection doe depending on the pref BranchTransferLimitsType

=cut
2994
2995sub IsBranchTransferAllowed {
2996
0
        my ( $toBranch, $fromBranch, $code ) = @_;
2997
2998
0
0
        if ( $toBranch eq $fromBranch ) { return 1; } ## Short circuit for speed.
2999
3000
0
        my $limitType = C4::Context->preference("BranchTransferLimitsType");
3001
0
        my $dbh = C4::Context->dbh;
3002
3003
0
        my $sth = $dbh->prepare("SELECT * FROM branch_transfer_limits WHERE toBranch = ? AND fromBranch = ? AND $limitType = ?");
3004
0
        $sth->execute( $toBranch, $fromBranch, $code );
3005
0
        my $limit = $sth->fetchrow_hashref();
3006
3007        ## If a row is found, then that combination is not allowed, if no matching row is found, then the combination *is allowed*
3008
0
        if ( $limit->{'limitId'} ) {
3009
0
                return 0;
3010        } else {
3011
0
                return 1;
3012        }
3013}
3014
3015 - 3021
=head2 CreateBranchTransferLimit

  CreateBranchTransferLimit( $toBranch, $fromBranch, $code );

$code is either itemtype or collection code depending on what the pref BranchTransferLimitsType is set to.

=cut
3022
3023sub CreateBranchTransferLimit {
3024
0
   my ( $toBranch, $fromBranch, $code ) = @_;
3025
3026
0
   my $limitType = C4::Context->preference("BranchTransferLimitsType");
3027
3028
0
   my $dbh = C4::Context->dbh;
3029
3030
0
   my $sth = $dbh->prepare("INSERT INTO branch_transfer_limits ( $limitType, toBranch, fromBranch ) VALUES ( ?, ?, ? )");
3031
0
   $sth->execute( $code, $toBranch, $fromBranch );
3032}
3033
3034 - 3040
=head2 DeleteBranchTransferLimits

DeleteBranchTransferLimits($frombranch);

Deletes all the branch transfer limits for one branch

=cut
3041
3042sub DeleteBranchTransferLimits {
3043
0
    my $branch = shift;
3044
0
    my $dbh = C4::Context->dbh;
3045
0
    my $sth = $dbh->prepare("DELETE FROM branch_transfer_limits WHERE fromBranch = ?");
3046
0
    $sth->execute($branch);
3047}
3048
3049sub ReturnLostItem{
3050
0
    my ( $borrowernumber, $itemnum ) = @_;
3051
3052
0
    MarkIssueReturned( $borrowernumber, $itemnum );
3053
0
    my $borrower = C4::Members::GetMember( 'borrowernumber'=>$borrowernumber );
3054
0
    my @datearr = localtime(time);
3055
0
    my $date = ( 1900 + $datearr[5] ) . "-" . ( $datearr[4] + 1 ) . "-" . $datearr[3];
3056
0
    my $bor = "$borrower->{'firstname'} $borrower->{'surname'} $borrower->{'cardnumber'}";
3057
0
    ModItem({ paidfor => "Paid for by $bor $date" }, undef, $itemnum);
3058}
3059
3060
3061sub LostItem{
3062
0
    my ($itemnumber, $mark_returned, $charge_fee) = @_;
3063
3064
0
    my $dbh = C4::Context->dbh();
3065
0
    my $sth=$dbh->prepare("SELECT issues.*,items.*,biblio.title
3066                           FROM issues
3067                           JOIN items USING (itemnumber)
3068                           JOIN biblio USING (biblionumber)
3069                           WHERE issues.itemnumber=?");
3070
0
    $sth->execute($itemnumber);
3071
0
    my $issues=$sth->fetchrow_hashref();
3072
0
    $sth->finish;
3073
3074    # if a borrower lost the item, add a replacement cost to the their record
3075
0
    if ( my $borrowernumber = $issues->{borrowernumber} ){
3076
3077
0
        C4::Accounts::chargelostitem($borrowernumber, $itemnumber, $issues->{'replacementprice'}, "Lost Item $issues->{'title'} $issues->{'barcode'}")
3078          if $charge_fee;
3079        #FIXME : Should probably have a way to distinguish this from an item that really was returned.
3080        #warn " $issues->{'borrowernumber'} / $itemnumber ";
3081
0
        MarkIssueReturned($borrowernumber,$itemnumber) if $mark_returned;
3082    }
3083}
3084
3085sub GetOfflineOperations {
3086
0
    my $dbh = C4::Context->dbh;
3087
0
    my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE branchcode=? ORDER BY timestamp");
3088
0
    $sth->execute(C4::Context->userenv->{'branch'});
3089
0
    my $results = $sth->fetchall_arrayref({});
3090
0
    $sth->finish;
3091
0
    return $results;
3092}
3093
3094sub GetOfflineOperation {
3095
0
    my $dbh = C4::Context->dbh;
3096
0
    my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE operationid=?");
3097
0
    $sth->execute( shift );
3098
0
    my $result = $sth->fetchrow_hashref;
3099
0
    $sth->finish;
3100
0
    return $result;
3101}
3102
3103sub AddOfflineOperation {
3104
0
    my $dbh = C4::Context->dbh;
3105
0
    my $sth = $dbh->prepare("INSERT INTO pending_offline_operations (userid, branchcode, timestamp, action, barcode, cardnumber) VALUES(?,?,?,?,?,?)");
3106
0
    $sth->execute( @_ );
3107
0
    return "Added.";
3108}
3109
3110sub DeleteOfflineOperation {
3111
0
    my $dbh = C4::Context->dbh;
3112
0
    my $sth = $dbh->prepare("DELETE FROM pending_offline_operations WHERE operationid=?");
3113
0
    $sth->execute( shift );
3114
0
    return "Deleted.";
3115}
3116
3117sub ProcessOfflineOperation {
3118
0
    my $operation = shift;
3119
3120
0
    my $report;
3121
0
    if ( $operation->{action} eq 'return' ) {
3122
0
        $report = ProcessOfflineReturn( $operation );
3123    } elsif ( $operation->{action} eq 'issue' ) {
3124
0
        $report = ProcessOfflineIssue( $operation );
3125    }
3126
3127
0
    DeleteOfflineOperation( $operation->{operationid} ) if $operation->{operationid};
3128
3129
0
    return $report;
3130}
3131
3132sub ProcessOfflineReturn {
3133
0
    my $operation = shift;
3134
3135
0
    my $itemnumber = C4::Items::GetItemnumberFromBarcode( $operation->{barcode} );
3136
3137
0
    if ( $itemnumber ) {
3138
0
        my $issue = GetOpenIssue( $itemnumber );
3139
0
        if ( $issue ) {
3140
0
            MarkIssueReturned(
3141                $issue->{borrowernumber},
3142                $itemnumber,
3143                undef,
3144                $operation->{timestamp},
3145            );
3146
0
            ModItem(
3147                { renewals => 0, onloan => undef },
3148                $issue->{'biblionumber'},
3149                $itemnumber
3150            );
3151
0
            return "Success.";
3152        } else {
3153
0
            return "Item not issued.";
3154        }
3155    } else {
3156
0
        return "Item not found.";
3157    }
3158}
3159
3160sub ProcessOfflineIssue {
3161
0
    my $operation = shift;
3162
3163
0
    my $borrower = C4::Members::GetMemberDetails( undef, $operation->{cardnumber} ); # Get borrower from operation cardnumber
3164
3165
0
    if ( $borrower->{borrowernumber} ) {
3166
0
        my $itemnumber = C4::Items::GetItemnumberFromBarcode( $operation->{barcode} );
3167
0
        unless ($itemnumber) {
3168
0
            return "Barcode not found.";
3169        }
3170
0
        my $issue = GetOpenIssue( $itemnumber );
3171
3172
0
        if ( $issue and ( $issue->{borrowernumber} ne $borrower->{borrowernumber} ) ) { # Item already issued to another borrower, mark it returned
3173
0
            MarkIssueReturned(
3174                $issue->{borrowernumber},
3175                $itemnumber,
3176                undef,
3177                $operation->{timestamp},
3178            );
3179        }
3180        AddIssue(
3181
0
            $borrower,
3182            $operation->{'barcode'},
3183            undef,
3184            1,
3185            $operation->{timestamp},
3186            undef,
3187        );
3188
0
        return "Success.";
3189    } else {
3190
0
        return "Borrower not found.";
3191    }
3192}
3193
3194
3195
3196 - 3202
=head2 TransferSlip

  TransferSlip($user_branch, $itemnumber, $to_branch)

  Returns letter hash ( see C4::Letters::GetPreparedLetter ) or undef

=cut
3203
3204sub TransferSlip {
3205
0
    my ($branch, $itemnumber, $to_branch) = @_;
3206
3207
0
    my $item = GetItem( $itemnumber )
3208      or return;
3209
3210
0
    my $pulldate = C4::Dates->new();
3211
3212
0
    return C4::Letters::GetPreparedLetter (
3213        module => 'circulation',
3214        letter_code => 'TRANSFERSLIP',
3215        branchcode => $branch,
3216        tables => {
3217            'branches' => $to_branch,
3218            'biblio' => $item->{biblionumber},
3219            'items' => $item,
3220        },
3221    );
3222}
3223
3224
32251;
3226