View | Details | Raw Unified | Return to bug 7376
Collapse All | Expand All

(-)a/C4/Circulation.pm (-29 / +83 lines)
Lines 1138-1146 sub CanBookBeIssued { Link Here
1138
    return ( \%issuingimpossible, \%needsconfirmation, \%alerts );
1138
    return ( \%issuingimpossible, \%needsconfirmation, \%alerts );
1139
}
1139
}
1140
1140
1141
=head2 CanBookBeReturned
1141
=head2 CanItemBeReturned
1142
1142
1143
  ($returnallowed, $message) = CanBookBeReturned($item, $branch)
1143
  ($returnallowed, $message) = CanItemBeReturned($item, $branch)
1144
1144
1145
Check whether the item can be returned to the provided branch
1145
Check whether the item can be returned to the provided branch
1146
1146
Lines 1158-1198 Returns: Link Here
1158
1158
1159
=item C<$returnallowed> is 0 or 1, corresponding to whether the return is allowed (1) or not (0)
1159
=item C<$returnallowed> is 0 or 1, corresponding to whether the return is allowed (1) or not (0)
1160
1160
1161
=item C<$message> is the branchcode where the item SHOULD be returned, if the return is not allowed
1161
=item C<$message> If $message->{Wrongbranch},
1162
                      $message->{Wrongbranch} is the branchcode where the item SHOULD be returned, if the return is not allowed.
1163
                  If $message->{BranchTransferDenied},
1164
                      $message->{BranchTransferDenied} is the CanItemBeTransferred() error code.
1162
1165
1163
=back
1166
=back
1164
1167
1165
=cut
1168
=cut
1166
1169
1167
sub CanBookBeReturned {
1170
sub CanItemBeReturned {
1168
    my ( $item, $branch ) = @_;
1171
    my ( $item, $branch ) = @_;
1169
    my $allowreturntobranch =
1172
    my $allowreturntobranch =
1170
      C4::Context->preference("AllowReturnToBranch") || 'anywhere';
1173
      C4::Context->preference("AllowReturnToBranch") || 'anywhere';
1171
1174
1172
    # assume return is allowed to start
1175
    # assume return is allowed to start
1173
    my $allowed = 1;
1176
    my $allowed = 1;
1177
    my $toBranch;    #The branch this item needs to be transferred.
1174
    my $message;
1178
    my $message;
1175
1179
1176
    # identify all cases where return is forbidden
1180
# identify all cases where return is forbidden and determine the transfer destination branch
1177
    if (   $allowreturntobranch eq 'homebranch'
1181
    if ( $allowreturntobranch eq 'homebranch' ) {
1178
        && $branch ne $item->{'homebranch'} )
1182
        $toBranch = $item->{'homebranch'};
1179
    {
1183
        if ( $branch ne $toBranch ) {
1180
        $allowed = 0;
1184
            $allowed = 0;
1181
        $message = $item->{'homebranch'};
1185
            $message->{Wrongbranch} = $toBranch;
1186
        }
1182
    }
1187
    }
1183
    elsif ($allowreturntobranch eq 'holdingbranch'
1188
    elsif ( $allowreturntobranch eq 'holdingbranch' ) {
1184
        && $branch ne $item->{'holdingbranch'} )
1189
        $toBranch = $item->{'holdingbranch'};
1185
    {
1190
        if ( $branch ne $toBranch ) {
1186
        $allowed = 0;
1191
            $allowed = 0;
1187
        $message = $item->{'holdingbranch'};
1192
            $message->{Wrongbranch} = $toBranch;
1193
        }
1194
    }
1195
    elsif ( $allowreturntobranch eq 'homeorholdingbranch' ) {
1196
        $toBranch =
1197
          $item->{'homebranch'};    # FIXME: choice of homebranch is arbitrary
1198
        if (   $branch ne $item->{'homebranch'}
1199
            && $branch ne $item->{'holdingbranch'} )
1200
        {
1201
            $allowed = 0;
1202
            $message->{Wrongbranch} = $toBranch;
1203
        }
1188
    }
1204
    }
1189
    elsif ($allowreturntobranch eq 'homeorholdingbranch'
1205
    else {
1190
        && $branch ne $item->{'homebranch'}
1206
        #
1191
        && $branch ne $item->{'holdingbranch'} )
1207
        $toBranch = $item->{'homebranch'};
1208
    }
1209
1210
# It needs to be ok to transfer the Item from the check-in branch to the $toBranch, for the Item to be accepted.
1211
#CanItemBeTransferred(), returns [1,undef] if transfer allowed, [0,errorMsg] if denied.
1212
    if (
1213
        '1' ne (
1214
            my $transferOk =
1215
              CanItemBeTransferred( $toBranch, $branch, $item, undef )
1216
        )
1217
      )
1192
    {
1218
    {
1193
        $allowed = 0;
1219
        $allowed = 0;
1194
        $message =
1220
        $message->{BranchTransferDenied} = $transferOk;
1195
          $item->{'homebranch'};    # FIXME: choice of homebranch is arbitrary
1196
    }
1221
    }
1197
1222
1198
    return ( $allowed, $message );
1223
    return ( $allowed, $message );
Lines 1776-1782 sub GetBranchItemRule { Link Here
1776
=head2 AddReturn
1801
=head2 AddReturn
1777
1802
1778
  ($doreturn, $messages, $iteminformation, $borrower) =
1803
  ($doreturn, $messages, $iteminformation, $borrower) =
1779
      &AddReturn($barcode, $branch, $exemptfine, $dropbox);
1804
      &AddReturn($barcode, $branch, $exemptfine, $dropbox, $overrides);
1780
1805
1781
Returns a book.
1806
Returns a book.
1782
1807
Lines 1795-1800 overdue charges are applied and C<$dropbox> is true, the last charge Link Here
1795
will be removed.  This assumes that the fines accrual script has run
1820
will be removed.  This assumes that the fines accrual script has run
1796
for _today_.
1821
for _today_.
1797
1822
1823
=item C<$overrides> A hash with various overrides as keys:
1824
$overrides->{overrideBranchTransferDenied} == 1
1825
TODO:: $exemptFine should be moved under this one as well, but the rule is,
1826
if it's not broken, don't fix it :)
1827
1798
=back
1828
=back
1799
1829
1800
C<&AddReturn> returns a list of four items:
1830
C<&AddReturn> returns a list of four items:
Lines 1830-1835 This book has was returned to the wrong branch. The value is a hashref Link Here
1830
so that C<$messages->{Wrongbranch}->{Wrongbranch}> and C<$messages->{Wrongbranch}->{Rightbranch}>
1860
so that C<$messages->{Wrongbranch}->{Wrongbranch}> and C<$messages->{Wrongbranch}->{Rightbranch}>
1831
contain the branchcode of the incorrect and correct return library, respectively.
1861
contain the branchcode of the incorrect and correct return library, respectively.
1832
1862
1863
=item C<BranchTransferDenied>
1864
1865
Implements the UseBranchTransferLimits-preference.
1866
This book cannot be transferred from this branch to the Item's homebranch, or other branch defined by
1867
the  AllowReturnToBranch-preference.
1868
C<$messages->{BranchTransferDenied}> contains the From-, To-branches and the code of failure.
1869
See CanBookBeIssued() for more.
1870
1833
=item C<ResFound>
1871
=item C<ResFound>
1834
1872
1835
The item was reserved. The value is a reference-to-hash whose keys are
1873
The item was reserved. The value is a reference-to-hash whose keys are
Lines 1848-1854 patron who last borrowed the book. Link Here
1848
=cut
1886
=cut
1849
1887
1850
sub AddReturn {
1888
sub AddReturn {
1851
    my ( $barcode, $branch, $exemptfine, $dropbox ) = @_;
1889
    my ( $barcode, $branch, $exemptfine, $dropbox, $overrides ) = @_;
1852
1890
1853
    if ( $branch and not GetBranchDetail($branch) ) {
1891
    if ( $branch and not GetBranchDetail($branch) ) {
1854
        warn "AddReturn error: branch '$branch' not found.  Reverting to "
1892
        warn "AddReturn error: branch '$branch' not found.  Reverting to "
Lines 1917-1930 sub AddReturn { Link Here
1917
    }
1955
    }
1918
1956
1919
    # check if the return is allowed at this branch
1957
    # check if the return is allowed at this branch
1920
    my ( $returnallowed, $message ) = CanBookBeReturned( $item, $branch );
1958
    my ( $returnallowed, $message ) = CanItemBeReturned( $item, $branch );
1921
    unless ($returnallowed) {
1959
    unless ($returnallowed) {
1922
        $messages->{'Wrongbranch'} = {
1960
        if ( defined $message->{Wrongbranch} ) {
1923
            Wrongbranch => $branch,
1961
            $messages->{'Wrongbranch'} = {
1924
            Rightbranch => $message
1962
                Wrongbranch => $branch,
1925
        };
1963
                Rightbranch => $message
1926
        $doreturn = 0;
1964
            };
1927
        return ( $doreturn, $messages, $issue, $borrower );
1965
            $doreturn = 0;
1966
            return ( $doreturn, $messages, $issue, $borrower );
1967
        }
1968
        if (   defined $message->{BranchTransferDenied}
1969
            && ( my @msgs = split( '->', $message->{BranchTransferDenied} ) )
1970
            && ( !exists $overrides->{overrideBranchTransferDenied} ) )
1971
        {
1972
            $messages->{BranchTransferDenied} = {
1973
                Frombranch => $msgs[0],
1974
                Tobranch   => $msgs[1],
1975
                Code       => $msgs[2]
1976
            };
1977
            $doreturn = 0;
1978
            return ( $doreturn, $messages, $issue, $borrower );
1979
        }
1980
1981
        #Some blocks can be overridden, so keep moving forward.
1928
    }
1982
    }
1929
1983
1930
    if ( $item->{'withdrawn'} ) {    # book has been cancelled
1984
    if ( $item->{'withdrawn'} ) {    # book has been cancelled
(-)a/C4/SIP/ILS/Transaction/Checkin.pm (+4 lines)
Lines 70-75 sub do_checkin { Link Here
70
        $self->destination_loc($messages->{Wrongbranch}->{Rightbranch});
70
        $self->destination_loc($messages->{Wrongbranch}->{Rightbranch});
71
        $self->alert_type('04');            # send to other branch
71
        $self->alert_type('04');            # send to other branch
72
    }
72
    }
73
	if ($messages->{BranchTransferDenied}) {
74
        $self->destination_loc($messages->{BranchTransferDenied}->{Tobranch});
75
        $self->alert_type('04');            # send to other branch
76
    }
73
    if ($messages->{WrongTransfer}) {
77
    if ($messages->{WrongTransfer}) {
74
        $self->destination_loc($messages->{WrongTransfer});
78
        $self->destination_loc($messages->{WrongTransfer});
75
        $self->alert_type('04');            # send to other branch
79
        $self->alert_type('04');            # send to other branch
(-)a/C4/SIP/README (+6 lines)
Lines 22-24 is already using that facililty, just change the definition of Link Here
22
22
23
Make sure to update your syslog configuration to capture facility
23
Make sure to update your syslog configuration to capture facility
24
'local6' and record it.
24
'local6' and record it.
25
26
UNIT TEST CASES!
27
-----------------
28
Remember that the SIP-server is a remote program and you cannot make test cases which depend on non-permanent DB changes,
29
Like when using the $dbh->{AutoCommit} = 0.
30
All testing material needs to be INSERTed for real to the Koha DB and cannot be just rolled back.
(-)a/C4/SIP/t/08checkin.t (-9 / +92 lines)
Lines 3-8 Link Here
3
3
4
use strict;
4
use strict;
5
use warnings;
5
use warnings;
6
#Can't run this test case without this directive from this directory.
7
# Can't run this test case from any other directory without some kind of a hack either.
8
use lib('../');
9
10
use lib('../../../t/db_dependent/');
11
use UseBranchTransferLimits::PreparedTestEnvironment;
12
6
use Clone qw(clone);
13
use Clone qw(clone);
7
14
8
use Sip::Constants qw(:all);
15
use Sip::Constants qw(:all);
Lines 24-29 use SIPtest qw(:basic :user1 :item1); Link Here
24
# alert: Y or N
31
# alert: Y or N
25
# date
32
# date
26
33
34
print "WARNING! This test will INSERT the necessary testing material PERMANENTLY to your Koha DB.\n";
35
print "You have 10 seconds to press CTRL-C.";
36
sleep(10);
37
38
27
my $checkout_template = {
39
my $checkout_template = {
28
    id  => "Checkin: prep: check out item ($item_barcode)",
40
    id  => "Checkin: prep: check out item ($item_barcode)",
29
    msg => "11YN20060329    203000                  AO$instid|AA$user_barcode|AB$item_barcode|AC|",
41
    msg => "11YN20060329    203000                  AO$instid|AA$user_barcode|AB$item_barcode|AC|",
Lines 31-36 my $checkout_template = { Link Here
31
    fields => [],
43
    fields => [],
32
};
44
};
33
45
46
34
my $checkin_test_template = {
47
my $checkin_test_template = {
35
    id  => "Checkin: Item ($item_barcode) is checked out",
48
    id  => "Checkin: Item ($item_barcode) is checked out",
36
    msg => "09N20060102    08423620060113    084235AP$item_owner|AO$instid|AB$item_barcode|AC$password|",
49
    msg => "09N20060102    08423620060113    084235AP$item_owner|AO$instid|AB$item_barcode|AC$password|",
Lines 56-70 my $checkin_test_template = { Link Here
56
          required => 0, }, # 3M Extension
69
          required => 0, }, # 3M Extension
57
   ],};
70
   ],};
58
71
59
my @tests = (
60
	$SIPtest::login_test,
61
	$SIPtest::sc_status_test,
62
	$checkout_template,
63
	$checkin_test_template,
64
	);
65
66
my $test;
72
my $test;
67
68
# Checkin item that's not checked out.  Basically, this
73
# Checkin item that's not checked out.  Basically, this
69
# is identical to the first case, except the header says that
74
# is identical to the first case, except the header says that
70
# the ILS didn't check the item in, and there's no patron id.
75
# the ILS didn't check the item in, and there's no patron id.
Lines 73-79 $test->{id} = 'Checkin: Item not checked out'; Link Here
73
$test->{pat} = qr/^100[NY][NYU][NY]$datepat/o;
78
$test->{pat} = qr/^100[NY][NYU][NY]$datepat/o;
74
$test->{fields} = [grep $_->{field} ne FID_PATRON_ID, @{$test->{fields}}];
79
$test->{fields} = [grep $_->{field} ne FID_PATRON_ID, @{$test->{fields}}];
75
80
76
push @tests, $test;
81
########################################
82
#>> Checking UseBranchTransferLimits >>#
83
########################################
84
85
### Use case1: BranchTransfer denied.
86
87
my $branchtransfer_checkout_ok = {
88
    id  => "Checkin: prep: BranchTransfer check out item (".$itemCPLFull->{barcode}." from CPL)",
89
    msg => "11YN20060329    203000                  AO$instid|AA".$borrower->{cardnumber}."|AB".$itemCPLFull->{barcode}."|AC|",
90
    pat => qr/^121N[NYU][NY]$datepat/,
91
    fields => [],
92
};
93
my $branchtransfer_checkin_fails = {
94
    id  => "Checkin: BranchTransfer Item (".$itemCPLFull->{barcode}.") check out denied to FFL",
95
    msg => "09N20060102    08423620060113    084235AP".'FFL'."|AO$instid|AB".$itemCPLFull->{barcode}."|AC$password|",
96
    pat => qr/^101[NY][NYU]Y$datepat/,
97
    fields => [
98
        $SIPtest::field_specs{(FID_INST_ID   )},
99
        $SIPtest::field_specs{(FID_SCREEN_MSG)},
100
        $SIPtest::field_specs{(FID_PRINT_LINE)},
101
        { field    => FID_PATRON_ID,
102
          pat      => qr/^$borrower->{cardnumber}$/,
103
          required => 1, },
104
        { field    => FID_ITEM_ID,
105
          pat      => qr/^$itemCPLFull->{barcode}$/,
106
          required => 1, },
107
        { field    => FID_PERM_LOCN,
108
          pat      => $textpat,
109
          required => 1, },
110
        { field    => FID_TITLE_ID,
111
          pat      => qr/^$biblioitem->{title}\s*$/,
112
          required => 1, }, # not required by the spec.
113
        { field    => FID_DESTINATION_LOCATION,
114
          pat      => qr/^FFL\s*$/,
115
          required => 0, }, # 3M Extension
116
   ],};
117
118
### Use case2: BranchTransfer allowed.
119
120
my $branchtransfer_checkin_ok = {
121
    id  => "Checkin: BranchTransfer Item (".$itemCPLFull->{barcode}.") check out allowed to IPT",
122
    msg => "09N20060102    08423620060113    084235AP".'IPT'."|AO$instid|AB".$itemCPLFull->{barcode}."|AC$password|",
123
    pat => qr/^101[NY][NYU]N$datepat/,
124
    fields => [
125
        $SIPtest::field_specs{(FID_INST_ID   )},
126
        $SIPtest::field_specs{(FID_SCREEN_MSG)},
127
        $SIPtest::field_specs{(FID_PRINT_LINE)},
128
        { field    => FID_PATRON_ID,
129
          pat      => qr/^$borrower->{cardnumber}$/,
130
          required => 1, },
131
        { field    => FID_ITEM_ID,
132
          pat      => qr/^$itemCPLFull->{barcode}$/,
133
          required => 1, },
134
        { field    => FID_PERM_LOCN,
135
          pat      => $textpat,
136
          required => 1, },
137
        { field    => FID_TITLE_ID,
138
          pat      => qr/^$biblioitem->{title}\s*$/,
139
          required => 1, }, # not required by the spec.
140
        { field    => FID_DESTINATION_LOCATION,
141
          pat      => qr/^IPT\s*$/,
142
          required => 0, }, # 3M Extension
143
   ],};
144
145
#######################################
146
#<< UseBranchTransferLimits Checked <<#
147
#######################################
148
149
150
my @tests = (
151
	$SIPtest::login_test,
152
	$SIPtest::sc_status_test,
153
	$checkout_template,
154
	$checkin_test_template,
155
    $test,
156
    $branchtransfer_checkout_ok,
157
    $branchtransfer_checkin_fails,
158
    $branchtransfer_checkin_ok,
159
);
77
160
78
# 
161
# 
79
# Still need tests for magnetic media
162
# Still need tests for magnetic media
(-)a/circ/returns.pl (-1 / +19 lines)
Lines 124-129 foreach ( $query->param ) { Link Here
124
    push( @inputloop, \%input );
124
    push( @inputloop, \%input );
125
}
125
}
126
126
127
### Build the overrides-object used to signal various modules about different overrides.
128
my $overrides;
129
130
#Used to skip the UseBranchTransferLimits-check in AddReserve.
131
if ($query->param('overrideBranchTransferDenied')) {
132
	$overrides->{overrideBranchTransferDenied} = 1;
133
}
134
135
127
############
136
############
128
# Deal with the requests....
137
# Deal with the requests....
129
138
Lines 216-222 if ($barcode) { Link Here
216
# save the return
225
# save the return
217
#
226
#
218
    ( $returned, $messages, $issueinformation, $borrower ) =
227
    ( $returned, $messages, $issueinformation, $borrower ) =
219
      AddReturn( $barcode, $userenv_branch, $exemptfine, $dropboxmode);     # do the return
228
      AddReturn( $barcode, $userenv_branch, $exemptfine, $dropboxmode, $overrides);     # do the return
220
    my $homeorholdingbranchreturn = C4::Context->preference('HomeOrHoldingBranchReturn');
229
    my $homeorholdingbranchreturn = C4::Context->preference('HomeOrHoldingBranchReturn');
221
    $homeorholdingbranchreturn ||= 'homebranch';
230
    $homeorholdingbranchreturn ||= 'homebranch';
222
231
Lines 329-334 if ( $messages->{'Wrongbranch'} ){ Link Here
329
    );
338
    );
330
}
339
}
331
340
341
if ( $messages->{'BranchTransferDenied'} ){
342
    $template->param(
343
        BranchTransferDenied => $messages->{'BranchTransferDenied'},
344
    );
345
}
346
332
# case of wrong transfert, if the document wasn't transfered to the right library (according to branchtransfer (tobranch) BDD)
347
# case of wrong transfert, if the document wasn't transfered to the right library (according to branchtransfer (tobranch) BDD)
333
348
334
if ( $messages->{'WrongTransfer'} and not $messages->{'WasTransfered'}) {
349
if ( $messages->{'WrongTransfer'} and not $messages->{'WasTransfered'}) {
Lines 440-445 foreach my $code ( keys %$messages ) { Link Here
440
    elsif ( $code eq 'WasTransfered' ) {
455
    elsif ( $code eq 'WasTransfered' ) {
441
        ;    # FIXME... anything to do here?
456
        ;    # FIXME... anything to do here?
442
    }
457
    }
458
	elsif ( $code eq 'BranchTransferDenied' ) {
459
		;	# I am confused as well # FIXME... anything to do here?
460
	}
443
    elsif ( $code eq 'withdrawn' ) {
461
    elsif ( $code eq 'withdrawn' ) {
444
        $err{withdrawn} = 1;
462
        $err{withdrawn} = 1;
445
        $exit_required_p = 1 if C4::Context->preference("BlockReturnOfWithdrawnItems");
463
        $exit_required_p = 1 if C4::Context->preference("BlockReturnOfWithdrawnItems");
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/circ/returns.tt (+14 lines)
Lines 91-96 $(document).ready(function () { Link Here
91
<div class="dialog alert"><h3>Cannot check in</h3><p>This item must be checked in at its home library. <strong>NOT CHECKED IN</strong></p>
91
<div class="dialog alert"><h3>Cannot check in</h3><p>This item must be checked in at its home library. <strong>NOT CHECKED IN</strong></p>
92
</div>
92
</div>
93
[% END %]
93
[% END %]
94
[% IF ( BranchTransferDenied ) %]
95
<div class="dialog alert"><h3>Cannot check in</h3>
96
	<p>Cannot receive this item because it cannot be transferred to it's original pickup location. This branch transfer rule blocks the check-in:<br/>
97
		[% BranchTransferDenied.Frombranch %] -> [% BranchTransferDenied.Tobranch %] -> [% BranchTransferDenied.Code %]
98
	</p>
99
	[% IF CAN_user_circulate %]
100
	<form method="post" action="returns.pl" class="confirm">
101
        <input type="hidden" name="barcode" value="[% itembarcode %]" />
102
        <input type="hidden" name="overrideBranchTransferDenied" value="1" />
103
        <input type="submit" value="Override" class="deny" />
104
    </form>
105
	[% END %]
106
</div>
107
[% END %]
94
<!-- case of a mistake in transfer loop -->
108
<!-- case of a mistake in transfer loop -->
95
[% IF ( WrongTransfer ) %]<div id="return2" class="dialog message"><!-- WrongTransfer --><h3>Please return <a href="/cgi-bin/koha/catalogue/detail.pl?type=intra&amp;biblionumber=[% itembiblionumber %]">[% title |html %]</a> to [% TransferWaitingAt | $KohaBranchName %]</h3><h3><a href="#" onclick="Dopop('transfer-slip.pl?transferitem=[% itemnumber %]&amp;&amp;branchcode=[% homebranch %]&amp;op=slip'); return true;">Print slip</a> or <a href="/cgi-bin/koha/circ/returns.pl?itemnumber=[% itemnumber %]&amp;canceltransfer=1">Cancel transfer</a></h3>
109
[% IF ( WrongTransfer ) %]<div id="return2" class="dialog message"><!-- WrongTransfer --><h3>Please return <a href="/cgi-bin/koha/catalogue/detail.pl?type=intra&amp;biblionumber=[% itembiblionumber %]">[% title |html %]</a> to [% TransferWaitingAt | $KohaBranchName %]</h3><h3><a href="#" onclick="Dopop('transfer-slip.pl?transferitem=[% itemnumber %]&amp;&amp;branchcode=[% homebranch %]&amp;op=slip'); return true;">Print slip</a> or <a href="/cgi-bin/koha/circ/returns.pl?itemnumber=[% itemnumber %]&amp;canceltransfer=1">Cancel transfer</a></h3>
96
[% IF ( wborcnum ) %]<h5>Hold for:</h5>
110
[% IF ( wborcnum ) %]<h5>Hold for:</h5>
(-)a/opac/opac-reserve.pl (-336 / +393 lines)
Lines 31-40 use C4::Output; Link Here
31
use C4::Dates qw/format_date/;
31
use C4::Dates qw/format_date/;
32
use C4::Context;
32
use C4::Context;
33
use C4::Members;
33
use C4::Members;
34
use C4::Branch; # GetBranches
34
use C4::Branch;    # GetBranches
35
use C4::Overdues;
35
use C4::Overdues;
36
use C4::Debug;
36
use C4::Debug;
37
use Koha::DateUtils;
37
use Koha::DateUtils;
38
38
# use Data::Dumper;
39
# use Data::Dumper;
39
40
40
my $MAXIMUM_NUMBER_OF_RESERVES = C4::Context->preference("maxreserves");
41
my $MAXIMUM_NUMBER_OF_RESERVES = C4::Context->preference("maxreserves");
Lines 51-93 my ( $template, $borrowernumber, $cookie ) = get_template_and_user( Link Here
51
    }
52
    }
52
);
53
);
53
54
54
my ($show_holds_count, $show_priority);
55
my ( $show_holds_count, $show_priority );
55
for ( C4::Context->preference("OPACShowHoldQueueDetails") ) {
56
for ( C4::Context->preference("OPACShowHoldQueueDetails") ) {
56
    m/holds/o and $show_holds_count = 1;
57
    m/holds/o   and $show_holds_count = 1;
57
    m/priority/ and $show_priority = 1;
58
    m/priority/ and $show_priority    = 1;
58
}
59
}
59
60
60
sub get_out {
61
sub get_out {
61
    output_html_with_http_headers(shift,shift,shift); # $query, $cookie, $template->output;
62
    output_html_with_http_headers( shift, shift, shift )
63
      ;    # $query, $cookie, $template->output;
62
    exit;
64
    exit;
63
}
65
}
64
66
65
# get borrower information ....
67
# get borrower information ....
66
my ( $borr ) = GetMemberDetails( $borrowernumber );
68
my ($borr) = GetMemberDetails($borrowernumber);
67
69
68
# Pass through any reserve charge
70
# Pass through any reserve charge
69
if ($borr->{reservefee} > 0){
71
if ( $borr->{reservefee} > 0 ) {
70
    $template->param( RESERVE_CHARGE => sprintf("%.2f",$borr->{reservefee}));
72
    $template->param(
73
        RESERVE_CHARGE => sprintf( "%.2f", $borr->{reservefee} ) );
71
}
74
}
75
72
# get branches and itemtypes
76
# get branches and itemtypes
73
my $branches = GetBranches();
77
my $branches  = GetBranches();
74
my $itemTypes = GetItemTypes();
78
my $itemTypes = GetItemTypes();
75
79
76
# There are two ways of calling this script, with a single biblio num
80
# There are two ways of calling this script, with a single biblio num
77
# or multiple biblio nums.
81
# or multiple biblio nums.
78
my $biblionumbers = $query->param('biblionumbers');
82
my $biblionumbers = $query->param('biblionumbers');
79
my $reserveMode = $query->param('reserve_mode');
83
my $reserveMode   = $query->param('reserve_mode');
80
if ($reserveMode && ($reserveMode eq 'single')) {
84
if ( $reserveMode && ( $reserveMode eq 'single' ) ) {
81
    my $bib = $query->param('single_bib');
85
    my $bib = $query->param('single_bib');
82
    $biblionumbers = "$bib/";
86
    $biblionumbers = "$bib/";
83
}
87
}
84
if (! $biblionumbers) {
88
if ( !$biblionumbers ) {
85
    $biblionumbers = $query->param('biblionumber');
89
    $biblionumbers = $query->param('biblionumber');
86
}
90
}
87
91
88
if ((! $biblionumbers) && (! $query->param('place_reserve'))) {
92
if ( ( !$biblionumbers ) && ( !$query->param('place_reserve') ) ) {
89
    $template->param(message=>1, no_biblionumber=>1);
93
    $template->param( message => 1, no_biblionumber => 1 );
90
    &get_out($query, $cookie, $template->output);
94
    &get_out( $query, $cookie, $template->output );
91
}
95
}
92
96
93
# Pass the numbers to the page so they can be fed back
97
# Pass the numbers to the page so they can be fed back
Lines 97-120 $template->param( biblionumbers => $biblionumbers ); Link Here
97
101
98
# Each biblio number is suffixed with '/', e.g. "1/2/3/"
102
# Each biblio number is suffixed with '/', e.g. "1/2/3/"
99
my @biblionumbers = split /\//, $biblionumbers;
103
my @biblionumbers = split /\//, $biblionumbers;
100
if (($#biblionumbers < 0) && (! $query->param('place_reserve'))) {
104
if ( ( $#biblionumbers < 0 ) && ( !$query->param('place_reserve') ) ) {
105
101
    # TODO: New message?
106
    # TODO: New message?
102
    $template->param(message=>1, no_biblionumber=>1);
107
    $template->param( message => 1, no_biblionumber => 1 );
103
    &get_out($query, $cookie, $template->output);
108
    &get_out( $query, $cookie, $template->output );
104
}
109
}
105
110
106
# pass the pickup branch along....
111
# pass the pickup branch along....
107
my $pickupBranch = $query->param('branch') || $borr->{'branchcode'} || C4::Context->userenv->{branch} || '' ;
112
my $pickupBranch =
108
($branches->{$pickupBranch}) or $pickupBranch = "";     # Confirm branch is real
113
     $query->param('branch')
114
  || $borr->{'branchcode'}
115
  || C4::Context->userenv->{branch}
116
  || '';
117
( $branches->{$pickupBranch} ) or $pickupBranch = "";   # Confirm branch is real
109
$template->param( branch => $pickupBranch );
118
$template->param( branch => $pickupBranch );
110
119
111
# make branch selection options...
120
# make branch selection options...
112
my $branchloop = GetBranchesLoop($pickupBranch);
121
my $branchloop = GetBranchesLoop($pickupBranch);
113
122
114
# Is the person allowed to choose their branch
123
# Is the person allowed to choose their branch
115
my $OPACChooseBranch = (C4::Context->preference("OPACAllowUserToChooseBranch")) ? 1 : 0;
124
my $OPACChooseBranch =
125
  ( C4::Context->preference("OPACAllowUserToChooseBranch") ) ? 1 : 0;
116
126
117
$template->param( choose_branch => $OPACChooseBranch);
127
$template->param( choose_branch => $OPACChooseBranch );
118
128
119
#
129
#
120
#
130
#
Lines 122-129 $template->param( choose_branch => $OPACChooseBranch); Link Here
122
#
132
#
123
#
133
#
124
134
125
my %biblioDataHash; # Hash of biblionumber to biblio/biblioitems record.
135
my %biblioDataHash;    # Hash of biblionumber to biblio/biblioitems record.
126
my %itemInfoHash; # Hash of itemnumber to item info.
136
my %itemInfoHash;      # Hash of itemnumber to item info.
127
foreach my $biblioNumber (@biblionumbers) {
137
foreach my $biblioNumber (@biblionumbers) {
128
138
129
    my $biblioData = GetBiblioData($biblioNumber);
139
    my $biblioData = GetBiblioData($biblioNumber);
Lines 131-157 foreach my $biblioNumber (@biblionumbers) { Link Here
131
141
132
    my @itemInfos = GetItemsInfo($biblioNumber);
142
    my @itemInfos = GetItemsInfo($biblioNumber);
133
143
134
    my $marcrecord= GetMarcBiblio($biblioNumber);
144
    my $marcrecord = GetMarcBiblio($biblioNumber);
135
145
136
    # flag indicating existence of at least one item linked via a host record
146
    # flag indicating existence of at least one item linked via a host record
137
    my $hostitemsflag;
147
    my $hostitemsflag;
148
138
    # adding items linked via host biblios
149
    # adding items linked via host biblios
139
    my @hostitemInfos = GetHostItemsInfo($marcrecord);
150
    my @hostitemInfos = GetHostItemsInfo($marcrecord);
140
    if (@hostitemInfos){
151
    if (@hostitemInfos) {
141
        $hostitemsflag =1;
152
        $hostitemsflag = 1;
142
        push (@itemInfos,@hostitemInfos);
153
        push( @itemInfos, @hostitemInfos );
143
    }
154
    }
144
155
145
    $biblioData->{itemInfos} = \@itemInfos;
156
    $biblioData->{itemInfos} = \@itemInfos;
146
    foreach my $itemInfo (@itemInfos) {
157
    foreach my $itemInfo (@itemInfos) {
147
        $itemInfoHash{$itemInfo->{itemnumber}} = $itemInfo;
158
        $itemInfoHash{ $itemInfo->{itemnumber} } = $itemInfo;
148
    }
159
    }
149
160
150
    # Compute the priority rank.
161
    # Compute the priority rank.
151
    my ( $rank, $reserves ) =
162
    my ( $rank, $reserves ) = GetReservesFromBiblionumber( $biblioNumber, 1 );
152
      GetReservesFromBiblionumber( $biblioNumber, 1 );
153
    $biblioData->{reservecount} = 1;    # new reserve
163
    $biblioData->{reservecount} = 1;    # new reserve
154
    foreach my $res (@{$reserves}) {
164
    foreach my $res ( @{$reserves} ) {
155
        my $found = $res->{found};
165
        my $found = $res->{found};
156
        if ( $found && $found eq 'W' ) {
166
        if ( $found && $found eq 'W' ) {
157
            $rank--;
167
            $rank--;
Lines 173-190 foreach my $biblioNumber (@biblionumbers) { Link Here
173
if ( $query->param('place_reserve') ) {
183
if ( $query->param('place_reserve') ) {
174
    my $reserve_cnt = 0;
184
    my $reserve_cnt = 0;
175
    if ($MAXIMUM_NUMBER_OF_RESERVES) {
185
    if ($MAXIMUM_NUMBER_OF_RESERVES) {
176
        $reserve_cnt = GetReservesFromBorrowernumber( $borrowernumber );
186
        $reserve_cnt = GetReservesFromBorrowernumber($borrowernumber);
177
    }
187
    }
178
188
179
    # List is composed of alternating biblio/item/branch
189
    # List is composed of alternating biblio/item/branch
180
    my $selectedItems = $query->param('selecteditems');
190
    my $selectedItems = $query->param('selecteditems');
181
191
182
    if ($query->param('reserve_mode') eq 'single') {
192
    if ( $query->param('reserve_mode') eq 'single' ) {
193
183
        # This indicates non-JavaScript mode, so there was
194
        # This indicates non-JavaScript mode, so there was
184
        # only a single biblio number selected.
195
        # only a single biblio number selected.
185
        my $bib = $query->param('single_bib');
196
        my $bib  = $query->param('single_bib');
186
        my $item = $query->param("checkitem_$bib");
197
        my $item = $query->param("checkitem_$bib");
187
        if ($item eq 'any') {
198
        if ( $item eq 'any' ) {
188
            $item = '';
199
            $item = '';
189
        }
200
        }
190
        my $branch = $query->param('branch');
201
        my $branch = $query->param('branch');
Lines 197-211 if ( $query->param('place_reserve') ) { Link Here
197
    # Make sure there is a biblionum/itemnum/branch triplet for each item.
208
    # Make sure there is a biblionum/itemnum/branch triplet for each item.
198
    # The itemnum can be 'any', meaning next available.
209
    # The itemnum can be 'any', meaning next available.
199
    my $selectionCount = @selectedItems;
210
    my $selectionCount = @selectedItems;
200
    if (($selectionCount == 0) || (($selectionCount % 3) != 0)) {
211
    if ( ( $selectionCount == 0 ) || ( ( $selectionCount % 3 ) != 0 ) ) {
201
        $template->param(message=>1, bad_data=>1);
212
        $template->param( message => 1, bad_data => 1 );
202
        &get_out($query, $cookie, $template->output);
213
        &get_out( $query, $cookie, $template->output );
203
    }
214
    }
204
215
205
    while (@selectedItems) {
216
    while (@selectedItems) {
206
        my $biblioNum 		= shift(@selectedItems);
217
        my $biblioNum = shift(@selectedItems);
207
        my $itemNum   		= shift(@selectedItems);
218
        my $itemNum   = shift(@selectedItems);
208
        my $pickupLocation  = shift(@selectedItems);    # i.e., branch code, not name,
219
        my $pickupLocation =
220
          shift(@selectedItems);    # i.e., branch code, not name,
209
221
210
        my $canreserve = 0;
222
        my $canreserve = 0;
211
223
Lines 215-221 if ( $query->param('place_reserve') ) { Link Here
215
            $pickupLocation = $borr->{'branchcode'};
227
            $pickupLocation = $borr->{'branchcode'};
216
        }
228
        }
217
229
218
        #item may belong to a host biblio, if yes change biblioNum to hosts bilbionumber
230
#item may belong to a host biblio, if yes change biblioNum to hosts bilbionumber
219
        if ( $itemNum ne '' ) {
231
        if ( $itemNum ne '' ) {
220
            my $hostbiblioNum = GetBiblionumberFromItemnumber($itemNum);
232
            my $hostbiblioNum = GetBiblionumberFromItemnumber($itemNum);
221
            if ( $hostbiblioNum ne $biblioNum ) {
233
            if ( $hostbiblioNum ne $biblioNum ) {
Lines 236-243 if ( $query->param('place_reserve') ) { Link Here
236
248
237
        my $expiration_date = $query->param("expiration_date_$biblioNum");
249
        my $expiration_date = $query->param("expiration_date_$biblioNum");
238
250
239
        # If a specific item was selected and the pickup branch is the same as the
251
      # If a specific item was selected and the pickup branch is the same as the
240
        # holdingbranch, force the value $rank and $found.
252
      # holdingbranch, force the value $rank and $found.
241
        my $rank = $biblioData->{rank};
253
        my $rank = $biblioData->{rank};
242
        if ( $itemNum ne '' ) {
254
        if ( $itemNum ne '' ) {
243
            my $item = GetItem($itemNum);
255
            my $item = GetItem($itemNum);
Lines 249-255 if ( $query->param('place_reserve') ) { Link Here
249
            }
261
            }
250
262
251
            # UseBranchTransferLimits checking.
263
            # UseBranchTransferLimits checking.
264
            <<<< <<< HEAD
252
            my ($transferOk, $message) = CheckBranchTransferAllowed( $pickupLocation, $item->{'holdingbranch'}, $item, undef );
265
            my ($transferOk, $message) = CheckBranchTransferAllowed( $pickupLocation, $item->{'holdingbranch'}, $item, undef );
266
=======
267
            my ($transferOk, $message) = CanItemBeTransferred( $pickupLocation, $item->{'holdingbranch'}, $item, undef );
268
>>>>>>> Bug 7376 - Transfer limits should be checked at check-in
253
            if (! $transferOk) {
269
            if (! $transferOk) {
254
                $canreserve = 0;
270
                $canreserve = 0;
255
            }
271
            }
Lines 262-608 if ( $query->param('place_reserve') ) { Link Here
262
        }
278
        }
263
        my $notes = $query->param('notes_'.$biblioNum)||'';
279
        my $notes = $query->param('notes_'.$biblioNum)||'';
264
280
265
        if (   $MAXIMUM_NUMBER_OF_RESERVES
281
              if ( $MAXIMUM_NUMBER_OF_RESERVES
266
            && $reserve_cnt >= $MAXIMUM_NUMBER_OF_RESERVES )
282
                && $reserve_cnt >= $MAXIMUM_NUMBER_OF_RESERVES )
267
        {
283
            {
268
            $canreserve = 0;
284
                $canreserve = 0;
269
        }
285
            }
270
286
271
        # Here we actually do the reserveration. Stage 3.
287
            # Here we actually do the reserveration. Stage 3.
272
        if ($canreserve) {
288
            if ($canreserve) {
273
            AddReserve(
289
                AddReserve(
274
                $pickupLocation,      $borrowernumber,
290
                    $pickupLocation, $borrowernumber,
275
                $biblioNum,   'a',
291
                    $biblioNum,      'a',
276
                [$biblioNum], $rank,
292
                    [$biblioNum],    $rank,
277
                $startdate,   $expiration_date,
293
                    $startdate,      $expiration_date,
278
                $notes,       $biblioData->{title},
294
                    $notes,          $biblioData->{title},
279
                $itemNum,     $found
295
                    $itemNum,        $found
280
            );
296
                );
281
            ++$reserve_cnt;
297
                ++$reserve_cnt;
298
            }
282
        }
299
        }
283
    }
284
300
285
    print $query->redirect("/cgi-bin/koha/opac-user.pl#opac-user-holds");
301
        print $query->redirect("/cgi-bin/koha/opac-user.pl#opac-user-holds");
286
    exit;
302
        exit;
287
}
303
    }
288
304
289
#
305
    #
290
#
306
    #
291
# Here we check that the borrower can actually make reserves Stage 1.
307
    # Here we check that the borrower can actually make reserves Stage 1.
292
#
308
    #
293
#
309
    #
294
my $noreserves     = 0;
310
    my $noreserves     = 0;
295
my $maxoutstanding = C4::Context->preference("maxoutstanding");
311
    my $maxoutstanding = C4::Context->preference("maxoutstanding");
296
$template->param( noreserve => 1 ) unless $maxoutstanding;
312
    $template->param( noreserve => 1 ) unless $maxoutstanding;
297
if ( $borr->{'amountoutstanding'} && ($borr->{'amountoutstanding'} > $maxoutstanding) ) {
313
    if ( $borr->{'amountoutstanding'}
298
    my $amount = sprintf "\$%.02f", $borr->{'amountoutstanding'};
314
        && ( $borr->{'amountoutstanding'} > $maxoutstanding ) )
299
    $template->param( message => 1 );
315
    {
300
    $noreserves = 1;
316
        my $amount = sprintf "\$%.02f", $borr->{'amountoutstanding'};
301
    $template->param( too_much_oweing => $amount );
317
        $template->param( message => 1 );
302
}
318
        $noreserves = 1;
303
if ( $borr->{gonenoaddress} && ($borr->{gonenoaddress} == 1) ) {
319
        $template->param( too_much_oweing => $amount );
304
    $noreserves = 1;
320
    }
305
    $template->param(
321
    if ( $borr->{gonenoaddress} && ( $borr->{gonenoaddress} == 1 ) ) {
306
                     message => 1,
322
        $noreserves = 1;
307
                     GNA     => 1
323
        $template->param(
308
                    );
324
            message => 1,
309
}
325
            GNA     => 1
310
if ( $borr->{lost} && ($borr->{lost} == 1) ) {
326
        );
311
    $noreserves = 1;
327
    }
312
    $template->param(
328
    if ( $borr->{lost} && ( $borr->{lost} == 1 ) ) {
313
                     message => 1,
329
        $noreserves = 1;
314
                     lost    => 1
330
        $template->param(
315
                    );
331
            message => 1,
316
}
332
            lost    => 1
317
if ( $borr->{'debarred'} ) {
333
        );
318
    $noreserves = 1;
334
    }
319
    $template->param(
335
    if ( $borr->{'debarred'} ) {
320
                     message  => 1,
336
        $noreserves = 1;
321
                     debarred => 1
337
        $template->param(
322
                    );
338
            message  => 1,
323
}
339
            debarred => 1
340
        );
341
    }
324
342
325
my @reserves = GetReservesFromBorrowernumber( $borrowernumber );
343
    my @reserves = GetReservesFromBorrowernumber($borrowernumber);
326
$template->param( RESERVES => \@reserves );
344
    $template->param( RESERVES => \@reserves );
327
if ( $MAXIMUM_NUMBER_OF_RESERVES && (scalar(@reserves) >= $MAXIMUM_NUMBER_OF_RESERVES) ) {
345
    if ( $MAXIMUM_NUMBER_OF_RESERVES
328
    $template->param( message => 1 );
346
        && ( scalar(@reserves) >= $MAXIMUM_NUMBER_OF_RESERVES ) )
329
    $noreserves = 1;
347
    {
330
    $template->param( too_many_reserves => scalar(@reserves));
348
        $template->param( message => 1 );
331
}
349
        $noreserves = 1;
332
foreach my $res (@reserves) {
350
        $template->param( too_many_reserves => scalar(@reserves) );
333
    foreach my $biblionumber (@biblionumbers) {
351
    }
334
        if ( $res->{'biblionumber'} == $biblionumber && $res->{'borrowernumber'} == $borrowernumber) {
352
    foreach my $res (@reserves) {
335
#            $template->param( message => 1 );
353
        foreach my $biblionumber (@biblionumbers) {
336
#            $noreserves = 1;
354
            if (   $res->{'biblionumber'} == $biblionumber
337
#            $template->param( already_reserved => 1 );
355
                && $res->{'borrowernumber'} == $borrowernumber )
338
            $biblioDataHash{$biblionumber}->{already_reserved} = 1;
356
            {
357
                #            $template->param( message => 1 );
358
                #            $noreserves = 1;
359
                #            $template->param( already_reserved => 1 );
360
                $biblioDataHash{$biblionumber}->{already_reserved} = 1;
361
            }
339
        }
362
        }
340
    }
363
    }
341
}
342
364
343
unless ($noreserves) {
365
    unless ($noreserves) {
344
    $template->param( select_item_types => 1 );
366
        $template->param( select_item_types => 1 );
345
}
367
    }
346
368
369
    #
370
    #
371
    # Build the template parameters that will show the info
372
    # and items for each biblionumber.
373
    #
374
    #
375
    my $notforloan_label_of = get_notforloan_label_of();
347
376
348
#
377
    my $biblioLoop         = [];
349
#
378
    my $numBibsAvailable   = 0;
350
# Build the template parameters that will show the info
379
    my $itemdata_enumchron = 0;
351
# and items for each biblionumber.
380
    my $anyholdable        = 0;
352
#
381
    my $itemLevelTypes     = C4::Context->preference('item-level_itypes');
353
#
382
    $template->param( 'item_level_itypes' => $itemLevelTypes );
354
my $notforloan_label_of = get_notforloan_label_of();
355
356
my $biblioLoop = [];
357
my $numBibsAvailable = 0;
358
my $itemdata_enumchron = 0;
359
my $anyholdable = 0;
360
my $itemLevelTypes = C4::Context->preference('item-level_itypes');
361
$template->param('item_level_itypes' => $itemLevelTypes);
362
363
foreach my $biblioNum (@biblionumbers) {
364
365
    my $record = GetMarcBiblio($biblioNum);
366
    # Init the bib item with the choices for branch pickup
367
    my %biblioLoopIter = ( branchloop => $branchloop );
368
369
    # Get relevant biblio data.
370
    my $biblioData = $biblioDataHash{$biblioNum};
371
    if (! $biblioData) {
372
        $template->param(message=>1, bad_biblionumber=>$biblioNum);
373
        &get_out($query, $cookie, $template->output);
374
    }
375
383
376
    $biblioLoopIter{biblionumber} = $biblioData->{biblionumber};
384
    foreach my $biblioNum (@biblionumbers) {
377
    $biblioLoopIter{title} = $biblioData->{title};
378
    $biblioLoopIter{subtitle} = GetRecordValue('subtitle', $record, GetFrameworkCode($biblioData->{biblionumber}));
379
    $biblioLoopIter{author} = $biblioData->{author};
380
    $biblioLoopIter{rank} = $biblioData->{rank};
381
    $biblioLoopIter{reservecount} = $biblioData->{reservecount};
382
    $biblioLoopIter{already_reserved} = $biblioData->{already_reserved};
383
    $biblioLoopIter{mandatorynotes}=0; #FIXME: For future use
384
385
    if (!$itemLevelTypes && $biblioData->{itemtype}) {
386
        $biblioLoopIter{description} = $itemTypes->{$biblioData->{itemtype}}{description};
387
        $biblioLoopIter{imageurl} = getitemtypeimagesrc() . "/". $itemTypes->{$biblioData->{itemtype}}{imageurl};
388
    }
389
385
390
    foreach my $itemInfo (@{$biblioData->{itemInfos}}) {
386
        my $record = GetMarcBiblio($biblioNum);
391
        $debug and warn $itemInfo->{'notforloan'};
392
387
393
        # Get reserve fee.
388
        # Init the bib item with the choices for branch pickup
394
        my $fee = GetReserveFee(undef, $borrowernumber, $itemInfo->{'biblionumber'}, 'a',
389
        my %biblioLoopIter = ( branchloop => $branchloop );
395
                                ( $itemInfo->{'biblioitemnumber'} ) );
396
        $itemInfo->{'reservefee'} = sprintf "%.02f", ($fee ? $fee : 0.0);
397
390
398
        if ($itemLevelTypes && $itemInfo->{itype}) {
391
        # Get relevant biblio data.
399
            $itemInfo->{description} = $itemTypes->{$itemInfo->{itype}}{description};
392
        my $biblioData = $biblioDataHash{$biblioNum};
400
            $itemInfo->{imageurl} = getitemtypeimagesrc() . "/". $itemTypes->{$itemInfo->{itype}}{imageurl};
393
        if ( !$biblioData ) {
394
            $template->param( message => 1, bad_biblionumber => $biblioNum );
395
            &get_out( $query, $cookie, $template->output );
401
        }
396
        }
402
397
403
        if (!$itemInfo->{'notforloan'} && !($itemInfo->{'itemnotforloan'} > 0)) {
398
        $biblioLoopIter{biblionumber} = $biblioData->{biblionumber};
404
            $biblioLoopIter{forloan} = 1;
399
        $biblioLoopIter{title}        = $biblioData->{title};
400
        $biblioLoopIter{subtitle} =
401
          GetRecordValue( 'subtitle', $record,
402
            GetFrameworkCode( $biblioData->{biblionumber} ) );
403
        $biblioLoopIter{author}           = $biblioData->{author};
404
        $biblioLoopIter{rank}             = $biblioData->{rank};
405
        $biblioLoopIter{reservecount}     = $biblioData->{reservecount};
406
        $biblioLoopIter{already_reserved} = $biblioData->{already_reserved};
407
        $biblioLoopIter{mandatorynotes} = 0;    #FIXME: For future use
408
409
        if ( !$itemLevelTypes && $biblioData->{itemtype} ) {
410
            $biblioLoopIter{description} =
411
              $itemTypes->{ $biblioData->{itemtype} }{description};
412
            $biblioLoopIter{imageurl} = getitemtypeimagesrc() . "/"
413
              . $itemTypes->{ $biblioData->{itemtype} }{imageurl};
405
        }
414
        }
406
    }
407
415
408
    #Collect the amout of items that pass the CheckBranchTransferAllowed-check. This is needed to tell
416
        foreach my $itemInfo ( @{ $biblioData->{itemInfos} } ) {
409
    #  the user if some or all Items cannot be transferred to the pickup location.
417
            $debug and warn $itemInfo->{'notforloan'};
410
    my $branchTransferableItemsCount = 0;
418
411
419
            # Get reserve fee.
412
    $biblioLoopIter{itemLoop} = [];
420
            my $fee =
413
    my $numCopiesAvailable = 0;
421
              GetReserveFee( undef, $borrowernumber,
414
    foreach my $itemInfo (@{$biblioData->{itemInfos}}) {
422
                $itemInfo->{'biblionumber'},
415
        my $itemNum = $itemInfo->{itemnumber};
423
                'a', ( $itemInfo->{'biblioitemnumber'} ) );
416
        my $itemLoopIter = {};
424
            $itemInfo->{'reservefee'} = sprintf "%.02f", ( $fee ? $fee : 0.0 );
417
425
418
        $itemLoopIter->{itemnumber} = $itemNum;
426
            if ( $itemLevelTypes && $itemInfo->{itype} ) {
419
        $itemLoopIter->{barcode} = $itemInfo->{barcode};
427
                $itemInfo->{description} =
420
        $itemLoopIter->{homeBranchName} = $branches->{$itemInfo->{homebranch}}{branchname};
428
                  $itemTypes->{ $itemInfo->{itype} }{description};
421
        $itemLoopIter->{callNumber} = $itemInfo->{itemcallnumber};
429
                $itemInfo->{imageurl} = getitemtypeimagesrc() . "/"
422
        $itemLoopIter->{enumchron} = $itemInfo->{enumchron};
430
                  . $itemTypes->{ $itemInfo->{itype} }{imageurl};
423
        $itemLoopIter->{copynumber} = $itemInfo->{copynumber};
431
            }
424
        if ($itemLevelTypes) {
425
            $itemLoopIter->{description} = $itemInfo->{description};
426
            $itemLoopIter->{imageurl} = $itemInfo->{imageurl};
427
        }
428
432
429
        # If the holdingbranch is different than the homebranch, we show the
433
            if (   !$itemInfo->{'notforloan'}
430
        # holdingbranch of the document too.
434
                && !( $itemInfo->{'itemnotforloan'} > 0 ) )
431
        if ( $itemInfo->{homebranch} ne $itemInfo->{holdingbranch} ) {
435
            {
432
            $itemLoopIter->{holdingBranchName} =
436
                $biblioLoopIter{forloan} = 1;
433
              $branches->{ $itemInfo->{holdingbranch} }{branchname};
437
            }
434
        }
438
        }
435
439
436
        # If the item is currently on loan, we display its return date and
440
#Collect the amout of items that pass the CanItemBeTransferred-check. This is needed to tell
437
        # change the background color.
441
#  the user if some or all Items cannot be transferred to the pickup location.
438
        my $issues= GetItemIssue($itemNum);
442
        my $branchTransferableItemsCount = 0;
439
        if ( $issues->{'date_due'} ) {
443
440
            $itemLoopIter->{dateDue} = format_sqlduedatetime($issues->{date_due});
444
        $biblioLoopIter{itemLoop} = [];
441
            $itemLoopIter->{backgroundcolor} = 'onloan';
445
        my $numCopiesAvailable = 0;
442
        }
446
        foreach my $itemInfo ( @{ $biblioData->{itemInfos} } ) {
447
            my $itemNum      = $itemInfo->{itemnumber};
448
            my $itemLoopIter = {};
449
450
            $itemLoopIter->{itemnumber} = $itemNum;
451
            $itemLoopIter->{barcode}    = $itemInfo->{barcode};
452
            $itemLoopIter->{homeBranchName} =
453
              $branches->{ $itemInfo->{homebranch} }{branchname};
454
            $itemLoopIter->{callNumber} = $itemInfo->{itemcallnumber};
455
            $itemLoopIter->{enumchron}  = $itemInfo->{enumchron};
456
            $itemLoopIter->{copynumber} = $itemInfo->{copynumber};
457
            if ($itemLevelTypes) {
458
                $itemLoopIter->{description} = $itemInfo->{description};
459
                $itemLoopIter->{imageurl}    = $itemInfo->{imageurl};
460
            }
443
461
444
        # checking reserve
462
            # If the holdingbranch is different than the homebranch, we show the
445
        my ($reservedate,$reservedfor,$expectedAt) = GetReservesFromItemnumber($itemNum);
463
            # holdingbranch of the document too.
446
        my $ItemBorrowerReserveInfo = GetMemberDetails( $reservedfor, 0);
464
            if ( $itemInfo->{homebranch} ne $itemInfo->{holdingbranch} ) {
465
                $itemLoopIter->{holdingBranchName} =
466
                  $branches->{ $itemInfo->{holdingbranch} }{branchname};
467
            }
447
468
448
        # the item could be reserved for this borrower vi a host record, flag this
469
            # If the item is currently on loan, we display its return date and
449
        if ($reservedfor eq $borrowernumber){
470
            # change the background color.
450
            $itemLoopIter->{already_reserved} = 1;
471
            my $issues = GetItemIssue($itemNum);
451
        }
472
            if ( $issues->{'date_due'} ) {
473
                $itemLoopIter->{dateDue} =
474
                  format_sqlduedatetime( $issues->{date_due} );
475
                $itemLoopIter->{backgroundcolor} = 'onloan';
476
            }
452
477
453
        if ( defined $reservedate ) {
478
            # checking reserve
454
            $itemLoopIter->{backgroundcolor} = 'reserved';
479
            my ( $reservedate, $reservedfor, $expectedAt ) =
455
            $itemLoopIter->{reservedate}     = format_date($reservedate);
480
              GetReservesFromItemnumber($itemNum);
456
            $itemLoopIter->{ReservedForBorrowernumber} = $reservedfor;
481
            my $ItemBorrowerReserveInfo = GetMemberDetails( $reservedfor, 0 );
457
            $itemLoopIter->{ReservedForSurname}        = $ItemBorrowerReserveInfo->{'surname'};
458
            $itemLoopIter->{ReservedForFirstname}      = $ItemBorrowerReserveInfo->{'firstname'};
459
            $itemLoopIter->{ExpectedAtLibrary}         = $expectedAt;
460
        }
461
482
462
        $itemLoopIter->{notforloan} = $itemInfo->{notforloan};
483
      # the item could be reserved for this borrower vi a host record, flag this
463
        $itemLoopIter->{itemnotforloan} = $itemInfo->{itemnotforloan};
484
            if ( $reservedfor eq $borrowernumber ) {
485
                $itemLoopIter->{already_reserved} = 1;
486
            }
464
487
465
        # Management of the notforloan document
488
            if ( defined $reservedate ) {
466
        if ( $itemLoopIter->{notforloan} || $itemLoopIter->{itemnotforloan}) {
489
                $itemLoopIter->{backgroundcolor} = 'reserved';
467
            $itemLoopIter->{backgroundcolor} = 'other';
490
                $itemLoopIter->{reservedate}     = format_date($reservedate);
468
            $itemLoopIter->{notforloanvalue} =
491
                $itemLoopIter->{ReservedForBorrowernumber} = $reservedfor;
469
              $notforloan_label_of->{ $itemLoopIter->{notforloan} };
492
                $itemLoopIter->{ReservedForSurname} =
470
        }
493
                  $ItemBorrowerReserveInfo->{'surname'};
494
                $itemLoopIter->{ReservedForFirstname} =
495
                  $ItemBorrowerReserveInfo->{'firstname'};
496
                $itemLoopIter->{ExpectedAtLibrary} = $expectedAt;
497
            }
471
498
472
        # Management of lost or long overdue items
499
            $itemLoopIter->{notforloan}     = $itemInfo->{notforloan};
473
        if ( $itemInfo->{itemlost} ) {
500
            $itemLoopIter->{itemnotforloan} = $itemInfo->{itemnotforloan};
474
501
475
            # FIXME localized strings should never be in Perl code
502
            # Management of the notforloan document
476
            $itemLoopIter->{message} =
503
            if (   $itemLoopIter->{notforloan}
477
                $itemInfo->{itemlost} == 1 ? "(lost)"
504
                || $itemLoopIter->{itemnotforloan} )
478
              : $itemInfo->{itemlost} == 2 ? "(long overdue)"
505
            {
479
              : "";
506
                $itemLoopIter->{backgroundcolor} = 'other';
480
            $itemInfo->{backgroundcolor} = 'other';
507
                $itemLoopIter->{notforloanvalue} =
481
        }
508
                  $notforloan_label_of->{ $itemLoopIter->{notforloan} };
509
            }
482
510
483
        # Check of the transfered documents
511
            # Management of lost or long overdue items
484
        my ( $transfertwhen, $transfertfrom, $transfertto ) =
512
            if ( $itemInfo->{itemlost} ) {
485
          GetTransfers($itemNum);
486
        if ( $transfertwhen && ($transfertwhen ne '') ) {
487
            $itemLoopIter->{transfertwhen} = format_date($transfertwhen);
488
            $itemLoopIter->{transfertfrom} =
489
              $branches->{$transfertfrom}{branchname};
490
            $itemLoopIter->{transfertto} = $branches->{$transfertto}{branchname};
491
            $itemLoopIter->{nocancel} = 1;
492
        }
493
513
494
        # if the items belongs to a host record, show link to host record
514
                # FIXME localized strings should never be in Perl code
495
        if ($itemInfo->{biblionumber} ne $biblioNum){
515
                $itemLoopIter->{message} =
496
            $biblioLoopIter{hostitemsflag} = 1;
516
                    $itemInfo->{itemlost} == 1 ? "(lost)"
497
            $itemLoopIter->{hostbiblionumber} = $itemInfo->{biblionumber};
517
                  : $itemInfo->{itemlost} == 2 ? "(long overdue)"
498
            $itemLoopIter->{hosttitle} = GetBiblioData($itemInfo->{biblionumber})->{title};
518
                  :                              "";
499
        }
519
                $itemInfo->{backgroundcolor} = 'other';
520
            }
500
521
501
        # If there is no loan, return and transfer, we show a checkbox.
522
            # Check of the transfered documents
502
        $itemLoopIter->{notforloan} = $itemLoopIter->{notforloan} || 0;
523
            my ( $transfertwhen, $transfertfrom, $transfertto ) =
524
              GetTransfers($itemNum);
525
            if ( $transfertwhen && ( $transfertwhen ne '' ) ) {
526
                $itemLoopIter->{transfertwhen} = format_date($transfertwhen);
527
                $itemLoopIter->{transfertfrom} =
528
                  $branches->{$transfertfrom}{branchname};
529
                $itemLoopIter->{transfertto} =
530
                  $branches->{$transfertto}{branchname};
531
                $itemLoopIter->{nocancel} = 1;
532
            }
503
533
504
        my $branch = GetReservesControlBranch( $itemInfo, $borr );
534
            # if the items belongs to a host record, show link to host record
535
            if ( $itemInfo->{biblionumber} ne $biblioNum ) {
536
                $biblioLoopIter{hostitemsflag} = 1;
537
                $itemLoopIter->{hostbiblionumber} = $itemInfo->{biblionumber};
538
                $itemLoopIter->{hosttitle} =
539
                  GetBiblioData( $itemInfo->{biblionumber} )->{title};
540
            }
505
541
506
        my $branchitemrule = GetBranchItemRule( $branch, $itemInfo->{'itype'} );
542
            # If there is no loan, return and transfer, we show a checkbox.
507
        my $policy_holdallowed = 1;
543
            $itemLoopIter->{notforloan} = $itemLoopIter->{notforloan} || 0;
508
544
509
        if ( $branchitemrule->{'holdallowed'} == 0 ||
545
            my $branch = GetReservesControlBranch( $itemInfo, $borr );
510
                ( $branchitemrule->{'holdallowed'} == 1 && $borr->{'branchcode'} ne $itemInfo->{'homebranch'} ) ) {
511
            $policy_holdallowed = 0;
512
        }
513
546
514
        if (IsAvailableForItemLevelRequest($itemNum) and $policy_holdallowed and CanItemBeReserved($borrowernumber,$itemNum) and ($itemLoopIter->{already_reserved} ne 1)) {
547
            my $branchitemrule =
548
              GetBranchItemRule( $branch, $itemInfo->{'itype'} );
549
            my $policy_holdallowed = 1;
515
550
516
            $itemLoopIter->{available} = 1;
551
            if (
517
            $numCopiesAvailable++;
552
                $branchitemrule->{'holdallowed'} == 0
553
                || (   $branchitemrule->{'holdallowed'} == 1
554
                    && $borr->{'branchcode'} ne $itemInfo->{'homebranch'} )
555
              )
556
            {
557
                $policy_holdallowed = 0;
558
            }
518
559
519
            #Check for UseBranchTransferLimit. $numCopiesAvailable is incremented because this Item
560
            if (    IsAvailableForItemLevelRequest($itemNum)
520
            #  could still be available from another pickup location
561
                and $policy_holdallowed
521
            my ($transferOk, $errorMsg) = CheckBranchTransferAllowed( $pickupBranch, undef, GetItem($itemNum), undef );
562
                and CanItemBeReserved( $borrowernumber, $itemNum )
522
            if (! $transferOk) {
563
                and ( $itemLoopIter->{already_reserved} ne 1 ) )
523
                $itemLoopIter->{available} = 0;
564
            {
524
                $itemLoopIter->{branchTransferBlocked} = 1;
565
566
                $itemLoopIter->{available} = 1;
567
                $numCopiesAvailable++;
568
569
#Check for UseBranchTransferLimit. $numCopiesAvailable is incremented because this Item
570
#  could still be available from another pickup location
571
                my ( $transferOk, $errorMsg ) =
572
                  CanItemBeTransferred( $pickupBranch, undef,
573
                    GetItem($itemNum), undef );
574
                if ( !$transferOk ) {
575
                    $itemLoopIter->{available}             = 0;
576
                    $itemLoopIter->{branchTransferBlocked} = 1;
577
                }
578
                else {
579
                    $branchTransferableItemsCount++;
580
                }
581
            }
582
583
            # FIXME: move this to a pm
584
            my $dbh  = C4::Context->dbh;
585
            my $sth2 = $dbh->prepare(
586
"SELECT * FROM reserves WHERE borrowernumber=? AND itemnumber=? AND found='W'"
587
            );
588
            $sth2->execute( $itemLoopIter->{ReservedForBorrowernumber},
589
                $itemNum );
590
            while ( my $wait_hashref = $sth2->fetchrow_hashref ) {
591
                $itemLoopIter->{waitingdate} =
592
                  format_date( $wait_hashref->{waitingdate} );
525
            }
593
            }
526
            else {
594
            $itemLoopIter->{imageurl} = getitemtypeimagelocation( 'opac',
527
                $branchTransferableItemsCount++;
595
                $itemTypes->{ $itemInfo->{itype} }{imageurl} );
596
597
            # Show serial enumeration when needed
598
            if ( $itemLoopIter->{enumchron} ) {
599
                $itemdata_enumchron = 1;
528
            }
600
            }
601
602
            push @{ $biblioLoopIter{itemLoop} }, $itemLoopIter;
529
        }
603
        }
604
        $template->param( itemdata_enumchron => $itemdata_enumchron );
530
605
531
        # FIXME: move this to a pm
606
        ## Set the behaviour flags for the template
532
        my $dbh = C4::Context->dbh;
607
        if ( $numCopiesAvailable > 0 ) {
533
        my $sth2 = $dbh->prepare("SELECT * FROM reserves WHERE borrowernumber=? AND itemnumber=? AND found='W'");
608
            $numBibsAvailable++;
534
        $sth2->execute($itemLoopIter->{ReservedForBorrowernumber}, $itemNum);
609
            $biblioLoopIter{bib_available} = 1;
535
        while (my $wait_hashref = $sth2->fetchrow_hashref) {
610
            $biblioLoopIter{holdable}      = 1;
536
            $itemLoopIter->{waitingdate} = format_date($wait_hashref->{waitingdate});
611
        }
612
        if ( $biblioLoopIter{already_reserved} ) {
613
            $biblioLoopIter{holdable} = undef;
614
        }
615
        if ( not CanBookBeReserved( $borrowernumber, $biblioNum ) ) {
616
            $biblioLoopIter{holdable} = undef;
537
        }
617
        }
538
        $itemLoopIter->{imageurl} = getitemtypeimagelocation( 'opac', $itemTypes->{ $itemInfo->{itype} }{imageurl} );
618
        if ( not C4::Context->preference('AllowHoldsOnPatronsPossessions')
619
            and CheckIfIssuedToPatron( $borrowernumber, $biblioNum ) )
620
        {
621
            $biblioLoopIter{holdable}                  = undef;
622
            $biblioLoopIter{already_patron_possession} = 1;
623
        }
624
        if ( $branchTransferableItemsCount == 0 ) {
539
625
540
        # Show serial enumeration when needed
626
#We can tell our Borrowers that they can try another pickup location if they don't find what they need.
541
        if ($itemLoopIter->{enumchron}) {
627
            $biblioLoopIter{suggestAnotherPickupLocation} = 1;
542
            $itemdata_enumchron = 1;
543
        }
628
        }
544
629
545
        push @{$biblioLoopIter{itemLoop}}, $itemLoopIter;
630
        if ( $biblioLoopIter{holdable} ) { $anyholdable++; }
546
    }
547
    $template->param( itemdata_enumchron => $itemdata_enumchron );
548
631
549
    ## Set the behaviour flags for the template
632
        push @$biblioLoop, \%biblioLoopIter;
550
    if ($numCopiesAvailable > 0) {
551
        $numBibsAvailable++;
552
        $biblioLoopIter{bib_available} = 1;
553
        $biblioLoopIter{holdable} = 1;
554
    }
633
    }
555
    if ($biblioLoopIter{already_reserved}) {
634
556
        $biblioLoopIter{holdable} = undef;
635
    if ( $numBibsAvailable == 0 || $anyholdable == 0 ) {
636
        $template->param( none_available => 1 );
557
    }
637
    }
558
    if(not CanBookBeReserved($borrowernumber,$biblioNum)){
638
559
        $biblioLoopIter{holdable} = undef;
639
    my $itemTableColspan = 9;
640
    if ( !$template->{VARS}->{'OPACItemHolds'} ) {
641
        $itemTableColspan--;
560
    }
642
    }
561
    if(not C4::Context->preference('AllowHoldsOnPatronsPossessions') and CheckIfIssuedToPatron($borrowernumber,$biblioNum)) {
643
    if ( !$template->{VARS}->{'singleBranchMode'} ) {
562
        $biblioLoopIter{holdable} = undef;
644
        $itemTableColspan--;
563
        $biblioLoopIter{already_patron_possession} = 1;
564
    }
645
    }
565
    if ($branchTransferableItemsCount == 0) {
646
    $itemTableColspan-- if !$show_holds_count && !$show_priority;
566
        #We can tell our Borrowers that they can try another pickup location if they don't find what they need.
647
    my $show_notes = C4::Context->preference('OpacHoldNotes');
567
        $biblioLoopIter{suggestAnotherPickupLocation} = 1 ;
648
    $template->param( OpacHoldNotes => $show_notes );
649
    $itemTableColspan-- if !$show_notes;
650
    $template->param( itemtable_colspan => $itemTableColspan );
651
652
    # display infos
653
    $template->param( bibitemloop  => $biblioLoop );
654
    $template->param( showholds    => $show_holds_count );
655
    $template->param( showpriority => $show_priority );
656
657
    # can set reserve date in future
658
    if (   C4::Context->preference('AllowHoldDateInFuture')
659
        && C4::Context->preference('OPACAllowHoldDateInFuture') )
660
    {
661
        $template->param( reserve_in_future => 1, );
568
    }
662
    }
569
663
570
664
    output_html_with_http_headers $query, $cookie, $template->output;
571
    if( $biblioLoopIter{holdable} ){ $anyholdable++; }
572
573
    push @$biblioLoop, \%biblioLoopIter;
574
}
575
576
if ( $numBibsAvailable == 0 || $anyholdable == 0 ) {
577
    $template->param( none_available => 1 );
578
}
579
580
my $itemTableColspan = 9;
581
if (! $template->{VARS}->{'OPACItemHolds'}) {
582
    $itemTableColspan--;
583
}
584
if (! $template->{VARS}->{'singleBranchMode'}) {
585
    $itemTableColspan--;
586
}
587
$itemTableColspan-- if !$show_holds_count && !$show_priority;
588
my $show_notes=C4::Context->preference('OpacHoldNotes');
589
$template->param(OpacHoldNotes=>$show_notes);
590
$itemTableColspan-- if !$show_notes;
591
$template->param(itemtable_colspan => $itemTableColspan);
592
593
# display infos
594
$template->param(bibitemloop => $biblioLoop);
595
$template->param( showholds=>$show_holds_count);
596
$template->param( showpriority=>$show_priority);
597
# can set reserve date in future
598
if (
599
    C4::Context->preference( 'AllowHoldDateInFuture' ) &&
600
    C4::Context->preference( 'OPACAllowHoldDateInFuture' )
601
    ) {
602
    $template->param(
603
        reserve_in_future         => 1,
604
    );
605
}
606
607
output_html_with_http_headers $query, $cookie, $template->output;
608
665
(-)a/t/db_dependent/Circulation/CanItemBeTransferred.t (-157 / +29 lines)
Lines 1-9 Link Here
1
use Modern::Perl;
1
use Modern::Perl;
2
use Test::More tests => 20;
2
use Test::More tests => 24;
3
4
use lib('../');
5
use UseBranchTransferLimits::PreparedTestEnvironment qw($biblioitem $itemCPLFull $itemCPLLite $borrower);
3
6
4
use C4::Circulation;
7
use C4::Circulation;
5
use C4::Context;
8
use C4::Context;
6
use C4::Record;
9
use C4::Record;
10
use C4::Members;
7
11
8
my $dbh = C4::Context->dbh;
12
my $dbh = C4::Context->dbh;
9
$dbh->{AutoCommit} = 0;
13
$dbh->{AutoCommit} = 0;
Lines 15-20 my $originalBranchTransferLimitsType = C4::Context->preference('BranchTransferLi Link Here
15
sub runTestsForCCode {
19
sub runTestsForCCode {
16
    my ($itemCPLFull, $itemCPLLite, $biblioitem) = @_;
20
    my ($itemCPLFull, $itemCPLLite, $biblioitem) = @_;
17
21
22
    C4::Context->set_preference("BranchTransferLimitsType", 'ccode');
23
18
    print 'Running tests for '.C4::Context->preference("BranchTransferLimitsType")."\n";
24
    print 'Running tests for '.C4::Context->preference("BranchTransferLimitsType")."\n";
19
25
20
    #howto use:               CanItemBeTransferred( $toBranch, $fromBranch, $item, $biblioitem] );
26
    #howto use:               CanItemBeTransferred( $toBranch, $fromBranch, $item, $biblioitem] );
Lines 53-58 sub runTestsForCCode { Link Here
53
sub runTestsForItype {
59
sub runTestsForItype {
54
    my ($itemCPLFull, $itemCPLLite, $biblioitem) = @_;
60
    my ($itemCPLFull, $itemCPLLite, $biblioitem) = @_;
55
61
62
    C4::Context->set_preference("BranchTransferLimitsType", 'itemtype');
63
56
    print 'Running tests for '.C4::Context->preference("BranchTransferLimitsType")."\n";
64
    print 'Running tests for '.C4::Context->preference("BranchTransferLimitsType")."\n";
57
65
58
    #howto use:               CanItemBeTransferred( $toBranch, $fromBranch, $item, $biblioitem] );
66
    #howto use:               CanItemBeTransferred( $toBranch, $fromBranch, $item, $biblioitem] );
Lines 88-260 sub runTestsForItype { Link Here
88
}
96
}
89
### Tests prepared
97
### Tests prepared
90
98
91
### Preparing our generic testing data ###
99
### Run them tests!
92
93
#Set the item variables
94
my $ccode = 'FANTASY';
95
my $itemtype = 'BK';
96
97
## Add a example Bibliographic record
98
my $bibFramework = ''; #Using the default bibliographic framework.
99
my $marcxml;
100
if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
101
    $marcxml=qq(
102
    <?xml version="1.0" encoding="UTF-8"?>
103
    <record
104
        xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
105
        xsi:schemaLocation="http://www.loc.gov/MARC21/slim http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
106
        xmlns="http://www.loc.gov/MARC21/slim">
107
      <leader>01534njm a2200229   4500</leader>
108
      <controlfield tag="001">4172</controlfield>
109
      <datafield tag="071" ind1=" " ind2=" ">
110
        <subfield code="a">8344482</subfield>
111
      </datafield>
112
      <datafield tag="090" ind1=" " ind2=" ">
113
        <subfield code="a">4172</subfield>
114
      </datafield>
115
      <datafield tag="100" ind1=" " ind2=" ">
116
        <subfield code="a">20040408              frey50        </subfield>
117
      </datafield>
118
      <datafield tag="126" ind1=" " ind2=" ">
119
        <subfield code="a">agbxhx       cd</subfield>
120
      </datafield>
121
      <datafield tag="200" ind1="1" ind2=" ">
122
        <subfield code="a">The Beatles anthology 1965-1967</subfield>
123
        <subfield code="e">vol.2</subfield>
124
        <subfield code="f">The Beatles</subfield>
125
        <subfield code="b">CD</subfield>
126
      </datafield>
127
      <datafield tag="210" ind1=" " ind2="1">
128
        <subfield code="a">Null</subfield>
129
        <subfield code="c">Emi music</subfield>
130
        <subfield code="d">1996</subfield>
131
      </datafield>
132
      <datafield tag="322" ind1=" " ind2="1">
133
        <subfield code="a">anthologie des beatles concernant l'&#xE9;poque musicale de 1965 &#xE0; 1968 p&#xE9;riode la plus exp&#xE9;rimentale et prolifique du groupe</subfield>
134
      </datafield>
135
      <datafield tag="327" ind1="1" ind2=" ">
136
        <subfield code="a">Real love</subfield>
137
        <subfield code="a">Yes it is</subfield>
138
      </datafield>
139
      <datafield tag="345" ind1=" " ind2=" ">
140
        <subfield code="a">CVS</subfield>
141
        <subfield code="b">0724383444823</subfield>
142
        <subfield code="c">disque compact</subfield>
143
        <subfield code="d">34 E</subfield>
144
      </datafield>
145
    </record>
146
    );
147
}
148
else { # Using Marc21 by default
149
    $marcxml=qq(<?xml version="1.0" encoding="UTF-8"?>
150
    <record format="MARC21" type="Bibliographic">
151
      <leader>00000cim a22000004a 4500</leader>
152
      <controlfield tag="001">1001</controlfield>
153
      <controlfield tag="005">2013-06-03 07:04:07+02</controlfield>
154
      <controlfield tag="007">ss||||j|||||||</controlfield>
155
      <controlfield tag="008">       uuuu    xxk|||||||||||||||||eng|c</controlfield>
156
      <datafield tag="020" ind1=" " ind2=" ">
157
        <subfield code="a">0-00-103147-3</subfield>
158
        <subfield code="c">14.46 EUR</subfield>
159
      </datafield>
160
      <datafield tag="041" ind1="0" ind2=" ">
161
        <subfield code="d">eng</subfield>
162
      </datafield>
163
      <datafield tag="084" ind1=" " ind2=" ">
164
        <subfield code="a">83.5</subfield>
165
        <subfield code="2">ykl</subfield>
166
      </datafield>
167
      <datafield tag="100" ind1="1" ind2=" ">
168
        <subfield code="a">SHAKESPEARE, WILLIAM.</subfield>
169
      </datafield>
170
      <datafield tag="245" ind1="1" ind2="4">
171
        <subfield code="a">THE TAMING OF THE SHREW /</subfield>
172
        <subfield code="c">WILLIAM SHAKESPEARE</subfield>
173
        <subfield code="h">[ÄÄNITE].</subfield>
174
      </datafield>
175
      <datafield tag="260" ind1=" " ind2=" ">
176
        <subfield code="a">LONDON :</subfield>
177
        <subfield code="b">COLLINS.</subfield>
178
      </datafield>
179
      <datafield tag="300" ind1=" " ind2=" ">
180
        <subfield code="a">2 ÄÄNIKASETTIA.</subfield>
181
      </datafield>
182
      <datafield tag="852" ind1=" " ind2=" ">
183
        <subfield code="a">FI-Jm</subfield>
184
        <subfield code="h">83.5</subfield>
185
      </datafield>
186
      <datafield tag="852" ind1=" " ind2=" ">
187
        <subfield code="a">FI-Konti</subfield>
188
        <subfield code="h">83.5</subfield>
189
      </datafield>
190
    </record>
191
    );
192
}
193
194
my $record=C4::Record::marcxml2marc($marcxml);
195
196
# This should work regardless of the Marc flavour.
197
my ( $biblioitemtypeTagid, $biblioitemtypeSubfieldid ) =
198
            C4::Biblio::GetMarcFromKohaField( 'biblioitems.itemtype', $bibFramework );
199
my $itemtypeField = MARC::Field->new($biblioitemtypeTagid, '', '',
200
                                     $biblioitemtypeSubfieldid => $itemtype);
201
$record->append_fields( $itemtypeField );
202
203
my ( $newBiblionumber, $newBiblioitemnumber ) = C4::Biblio::AddBiblio( $record, $bibFramework, { defer_marc_save => 1 } );
204
205
## Add an item with a ccode.
206
my ($item_bibnum, $item_bibitemnum);
207
my ($itemCPLFull, $itemCPLFullId); #Item with a itemtype and ccode in its data.
208
my ($itemCPLLite, $itemCPLLiteId); #Item with no itemtype nor ccode in its data. Forces to look for it from the biblio.
209
($item_bibnum, $item_bibitemnum, $itemCPLFullId) = C4::Items::AddItem({ barcode => 'CPLFull', homebranch => 'CPL', holdingbranch => 'CPL', ccode => $ccode, itemtype => $itemtype}, $newBiblionumber);#, biblioitemnumber => $newBiblioitemnumber, biblionumber => $newBiblioitemnumber });
210
($item_bibnum, $item_bibitemnum, $itemCPLLiteId) = C4::Items::AddItem({ barcode => 'CPLLite', homebranch => 'CPL', holdingbranch => 'CPL'}, $newBiblionumber);# biblioitemnumber => $newBiblioitemnumber, biblionumber => $newBiblioitemnumber });
211
212
213
### Created the generic testing material. ###
214
### Setting preferences for ccode use-case ###
215
216
C4::Context->set_preference("BranchTransferLimitsType", 'ccode');
217
218
## Add the TransferLimit rules:
219
## IPT -> CPL -> FFL -> IPT
220
#                                            to     from
221
C4::Circulation::CreateBranchTransferLimit( 'IPT', 'CPL', $ccode );
222
C4::Circulation::CreateBranchTransferLimit( 'CPL', 'FFL', $ccode );
223
C4::Circulation::CreateBranchTransferLimit( 'FFL', 'IPT', $ccode );
224
225
## Ready to start testing ccode use-case ##
226
227
$itemCPLFull = C4::Items::GetItem($itemCPLFullId);
228
$itemCPLLite = C4::Items::GetItem($itemCPLLiteId);
229
my $biblioitem = C4::Biblio::GetBiblioFromItemNumber( $itemCPLFull->{itemnumber} );
230
231
232
runTestsForCCode($itemCPLFull, $itemCPLLite, $biblioitem);
100
runTestsForCCode($itemCPLFull, $itemCPLLite, $biblioitem);
233
101
102
runTestsForItype($itemCPLFull, $itemCPLLite, $biblioitem);
234
103
235
104
236
### ccode tested
105
#One cannot return an Item which has homebranch in CPL to FFL
237
### Setting preferences for itemtype use-case ###
106
my $datedue = C4::Circulation::AddIssue( $borrower, 'CPLFull')    or BAIL_OUT("Cannot check-out an Item!");
107
my ($returnOk, $errorMessage) = C4::Circulation::AddReturn('CPLFull', 'FFL', undef, undef, undef);
108
is( exists $errorMessage->{BranchTransferDenied}, 1, "Check-in failed because of a branch transfer limitation." );
238
109
239
C4::Context->set_preference("BranchTransferLimitsType", 'itemtype');
240
110
241
## Add the TransferLimit rules:
111
#One can return an Item which has homebranch in FFL to CPL
242
## IPT -> CPL -> FFL -> IPT
112
($returnOk, $errorMessage) = C4::Circulation::AddReturn('CPLFull', 'CPL', undef, undef, undef);
243
#                                            to     from
113
is( $returnOk, 1, "Check-in succeeds." );
244
C4::Circulation::CreateBranchTransferLimit( 'IPT', 'CPL', $itemtype );
245
C4::Circulation::CreateBranchTransferLimit( 'CPL', 'FFL', $itemtype );
246
C4::Circulation::CreateBranchTransferLimit( 'FFL', 'IPT', $itemtype );
247
114
248
## Ready to start testing itemtype use-case ##
249
115
250
$itemCPLFull = C4::Items::GetItem($itemCPLFullId);
116
#One can override a denied branch transfer
251
$itemCPLLite = C4::Items::GetItem($itemCPLLiteId);
117
$datedue = C4::Circulation::AddIssue( $borrower, 'CPLFull')    or BAIL_OUT("Cannot check-out an Item!");
252
$biblioitem = C4::Biblio::GetBiblioFromItemNumber( $itemCPLFull->{itemnumber} );
118
($returnOk, $errorMessage) = C4::Circulation::AddReturn('CPLFull', 'FFL', undef, undef, {overrideBranchTransferDenied => 1});
119
is( $returnOk, 1, "Check-in succeeds because transfer limits are overridden." );
253
120
254
121
255
runTestsForItype($itemCPLFull, $itemCPLLite, $biblioitem);
122
#Failing a check-in regardless of override, since failure happens because Item's must be returned to their homebranches.
123
#Important to see that overriding BranchTransferDenied doesn't break other functionality.
124
C4::Context->set_preference("AllowReturnToBranch", 'homebranch');
125
$datedue = C4::Circulation::AddIssue( $borrower, 'CPLFull')    or BAIL_OUT("Cannot check-out an Item!");
126
($returnOk, $errorMessage) = C4::Circulation::AddReturn('CPLFull', 'FFL', undef, undef, {overrideBranchTransferDenied => 1});
127
is( $returnOk, 0, "Overridden check-in fails, because AllowReturnToBranch-check fails." );
128
256
129
257
### itemtype tested
258
130
259
### Reset default preferences
131
### Reset default preferences
260
C4::Context->set_preference("BranchTransferLimitsType", $originalBranchTransferLimitsType);
132
C4::Context->set_preference("BranchTransferLimitsType", $originalBranchTransferLimitsType);
(-)a/t/db_dependent/UseBranchTransferLimits/PreparedTestEnvironment.pm (-1 / +150 lines)
Line 0 Link Here
0
- 
1
package UseBranchTransferLimits::PreparedTestEnvironment;
2
3
use Modern::Perl;
4
5
use C4::Circulation;
6
use C4::Context;
7
use C4::Record;
8
use C4::Members;
9
10
### Naming shared variables ###
11
use base 'Exporter';
12
our @EXPORT = qw($biblioitem $itemCPLFull $itemCPLLite $borrower);
13
14
my $dbh = C4::Context->dbh;
15
16
##########################################
17
### Preparing our generic testing data ###
18
##########################################
19
20
### Naming shared variables ###
21
our ($biblioitem, $itemCPLFull, $itemCPLLite, $borrower);
22
23
#Set the item variables
24
my $ccode = 'FANTASY';
25
my $itemtype = 'BK';
26
27
28
## Check if defaults already exist
29
my $itemnumber = C4::Items::GetItemnumberFromBarcode('CPLFull');
30
unless ($itemnumber) {
31
32
    ## Add a example Bibliographic record
33
    my $bibFramework = ''; #Using the default bibliographic framework.
34
    my $marcxml=qq(<?xml version="1.0" encoding="UTF-8"?>
35
    <record format="MARC21" type="Bibliographic">
36
      <leader>00000cim a22000004a 4500</leader>
37
      <controlfield tag="007">ss||||j|||||||</controlfield>
38
      <controlfield tag="008">       uuuu    xxk|||||||||||||||||eng|c</controlfield>
39
      <datafield tag="100" ind1="1" ind2=" ">
40
        <subfield code="a">SHAKESPEARE, WILLIAM.</subfield>
41
      </datafield>
42
      <datafield tag="245" ind1="1" ind2="4">
43
        <subfield code="a">THE TAMING OF THE SHREW /</subfield>
44
        <subfield code="c">WILLIAM SHAKESPEARE</subfield>
45
        <subfield code="h">[ÄÄNITE].</subfield>
46
      </datafield>
47
    </record>
48
    );
49
    my $record=C4::Record::marcxml2marc($marcxml);
50
51
    # Add an itemtype definition to the Record.
52
    my ( $biblioitemtypeTagid, $biblioitemtypeSubfieldid ) =
53
                C4::Biblio::GetMarcFromKohaField( 'biblioitems.itemtype', $bibFramework );
54
    my $itemtypeField = MARC::Field->new($biblioitemtypeTagid, '', '',
55
                                         $biblioitemtypeSubfieldid => $itemtype);
56
    $record->append_fields( $itemtypeField );
57
58
    my ( $biblionumber, $biblioitemnumber ) = C4::Biblio::AddBiblio( $record, $bibFramework, { defer_marc_save => 1 } );
59
60
    ## Add an item with a ccode.
61
    my ($item_bibnum, $item_bibitemnum);
62
    my ($itemCPLFullId); #Item with a itemtype and ccode in its data.
63
    my ($itemCPLLiteId); #Item with no itemtype nor ccode in its data. Forces to look for it from the biblio.
64
    ($item_bibnum, $item_bibitemnum, $itemCPLFullId) = C4::Items::AddItem({ barcode => 'CPLFull', homebranch => 'CPL', holdingbranch => 'CPL', ccode => $ccode, itemtype => $itemtype}, $biblionumber);#, biblioitemnumber => $biblioitemnumber, biblionumber => $biblioitemnumber });
65
    ($item_bibnum, $item_bibitemnum, $itemCPLLiteId) = C4::Items::AddItem({ barcode => 'CPLLite', homebranch => 'CPL', holdingbranch => 'CPL'}, $biblionumber);# biblioitemnumber => $biblioitemnumber, biblionumber => $biblioitemnumber });
66
67
    $itemCPLFull = C4::Items::GetItem($itemCPLFullId);
68
    $itemCPLLite = C4::Items::GetItem($itemCPLLiteId);
69
    $biblioitem = C4::Biblio::GetBiblioFromItemNumber( $itemCPLFull->{itemnumber} );
70
}
71
else {
72
    $itemCPLFull = C4::Items::GetItem($itemnumber);
73
74
    $itemnumber = C4::Items::GetItemnumberFromBarcode('CPLLite');
75
    $itemCPLLite = C4::Items::GetItem($itemnumber);
76
77
    $biblioitem = C4::Biblio::GetBiblioFromItemNumber( $itemCPLFull->{itemnumber} );
78
}
79
80
81
82
83
### Created the generic testing material. ###
84
85
86
### Setting preferences for ccode use-case ###
87
C4::Context->set_preference("BranchTransferLimitsType", 'ccode');
88
## Add the TransferLimit rules:
89
## IPT -> CPL -> FFL -> IPT
90
#                                            to     from
91
C4::Circulation::CreateBranchTransferLimit( 'IPT', 'CPL', $ccode );
92
C4::Circulation::CreateBranchTransferLimit( 'CPL', 'FFL', $ccode );
93
C4::Circulation::CreateBranchTransferLimit( 'FFL', 'IPT', $ccode );
94
95
96
### Setting preferences for itemtype use-case ###
97
C4::Context->set_preference("BranchTransferLimitsType", 'itemtype');
98
## Add the TransferLimit rules:
99
## IPT -> CPL -> FFL -> IPT
100
#                                            to     from
101
C4::Circulation::CreateBranchTransferLimit( 'IPT', 'CPL', $itemtype );
102
C4::Circulation::CreateBranchTransferLimit( 'CPL', 'FFL', $itemtype );
103
C4::Circulation::CreateBranchTransferLimit( 'FFL', 'IPT', $itemtype );
104
105
106
107
############################
108
### Testing checking-in! ###
109
############################
110
111
## Set up the user environment to a funky branch
112
C4::Context->_new_userenv('xxx');
113
C4::Context::set_userenv(0,0,0,'firstname','surname', 'CPL', 'Centerville', '', '', '');
114
(C4::Context->userenv->{branch} eq 'CPL') or BAIL_OUT("Unable to set the userenv!");
115
116
## Set a simple circ policy
117
$dbh->do('DELETE FROM issuingrules');
118
$dbh->do(
119
    q{INSERT INTO issuingrules (categorycode, branchcode, itemtype, reservesallowed,
120
                                maxissueqty, issuelength, lengthunit,
121
                                renewalsallowed, renewalperiod,
122
                                fine, chargeperiod)
123
      VALUES (?, ?, ?, ?,
124
              ?, ?, ?,
125
              ?, ?,
126
              ?, ?
127
             )
128
    },
129
    {},
130
    '*', '*', '*', 25,
131
    20, 14, 'days',
132
    1, 7,
133
    .10, 1
134
);
135
136
## Add a Borrower
137
$borrower = C4::Members::GetMember(cardnumber => 'cardnumber1234');
138
unless ($borrower) {
139
    my %borrower_data = (
140
        firstname =>  'Katrin',
141
        surname => 'Reservation',
142
        categorycode => 'S',
143
        branchcode => 'CPL',
144
        cardnumber => 'cardnumber1234',
145
        userid => 'katrin.reservation',
146
        password => '1234',
147
    );
148
    my $borrowernumber = C4::Members::AddMember(%borrower_data);
149
    $borrower = C4::Members::GetMember(borrowernumber => $borrowernumber);
150
}

Return to bug 7376