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

(-)a/C4/Circulation.pm (-24 / +76 lines)
Lines 1041-1049 sub CanBookBeIssued { Link Here
1041
    return ( \%issuingimpossible, \%needsconfirmation, \%alerts );
1041
    return ( \%issuingimpossible, \%needsconfirmation, \%alerts );
1042
}
1042
}
1043
1043
1044
=head2 CanBookBeReturned
1044
=head2 CanItemBeReturned
1045
1045
1046
  ($returnallowed, $message) = CanBookBeReturned($item, $branch)
1046
  ($returnallowed, $message) = CanItemBeReturned($item, $branch)
1047
1047
1048
Check whether the item can be returned to the provided branch
1048
Check whether the item can be returned to the provided branch
1049
1049
Lines 1061-1090 Returns: Link Here
1061
1061
1062
=item C<$returnallowed> is 0 or 1, corresponding to whether the return is allowed (1) or not (0)
1062
=item C<$returnallowed> is 0 or 1, corresponding to whether the return is allowed (1) or not (0)
1063
1063
1064
=item C<$message> is the branchcode where the item SHOULD be returned, if the return is not allowed
1064
=item C<$message> If $message->{Wrongbranch},
1065
                      $message->{Wrongbranch} is the branchcode where the item SHOULD be returned, if the return is not allowed.
1066
                  If $message->{BranchTransferDenied},
1067
                      $message->{BranchTransferDenied} is the CanItemBeTransferred() error code.
1065
1068
1066
=back
1069
=back
1067
1070
1068
=cut
1071
=cut
1069
1072
1070
sub CanBookBeReturned {
1073
sub CanItemBeReturned {
1071
  my ($item, $branch) = @_;
1074
  my ($item, $branch) = @_;
1072
  my $allowreturntobranch = C4::Context->preference("AllowReturnToBranch") || 'anywhere';
1075
  my $allowreturntobranch = C4::Context->preference("AllowReturnToBranch") || 'anywhere';
1073
1076
1074
  # assume return is allowed to start
1077
  # assume return is allowed to start
1075
  my $allowed = 1;
1078
  my $allowed = 1;
1079
  my $toBranch; #The branch this item needs to be transferred.
1076
  my $message;
1080
  my $message;
1077
1081
1078
  # identify all cases where return is forbidden
1082
  # identify all cases where return is forbidden and determine the transfer destination branch
1079
  if ($allowreturntobranch eq 'homebranch' && $branch ne $item->{'homebranch'}) {
1083
  if ($allowreturntobranch eq 'homebranch') {
1080
     $allowed = 0;
1084
    $toBranch = $item->{'homebranch'};
1081
     $message = $item->{'homebranch'};
1085
    if ($branch ne $toBranch) {
1082
  } elsif ($allowreturntobranch eq 'holdingbranch' && $branch ne $item->{'holdingbranch'}) {
1086
      $allowed = 0;
1083
     $allowed = 0;
1087
      $message->{Wrongbranch} = $toBranch;
1084
     $message = $item->{'holdingbranch'};
1088
    }
1085
  } elsif ($allowreturntobranch eq 'homeorholdingbranch' && $branch ne $item->{'homebranch'} && $branch ne $item->{'holdingbranch'}) {
1089
  }
1086
     $allowed = 0;
1090
  elsif ($allowreturntobranch eq 'holdingbranch') {
1087
     $message = $item->{'homebranch'}; # FIXME: choice of homebranch is arbitrary
1091
    $toBranch = $item->{'holdingbranch'};
1092
    if ($branch ne $toBranch) {
1093
      $allowed = 0;
1094
      $message->{Wrongbranch} = $toBranch;
1095
    }
1096
  }
1097
  elsif ($allowreturntobranch eq 'homeorholdingbranch') {
1098
    $toBranch = $item->{'homebranch'}; # FIXME: choice of homebranch is arbitrary
1099
    if ($branch ne $item->{'homebranch'} && $branch ne $item->{'holdingbranch'}) {
1100
      $allowed = 0;
1101
      $message->{Wrongbranch} = $toBranch;
1102
    }
1103
  }
1104
  else {
1105
    #
1106
    $toBranch = $item->{'homebranch'};
1107
  }
1108
  # It needs to be ok to transfer the Item from the check-in branch to the $toBranch, for the Item to be accepted.
1109
  #CanItemBeTransferred(), returns [1,undef] if transfer allowed, [0,errorMsg] if denied.
1110
  if ( '1' ne   ( my $transferOk = CanItemBeTransferred($toBranch, $branch, $item, undef) )   ) {
1111
	$allowed = 0;
1112
    $message->{BranchTransferDenied} = $transferOk;
1088
  }
1113
  }
1089
1114
1090
  return ($allowed, $message);
1115
  return ($allowed, $message);
Lines 1631-1637 sub GetBranchItemRule { Link Here
1631
=head2 AddReturn
1656
=head2 AddReturn
1632
1657
1633
  ($doreturn, $messages, $iteminformation, $borrower) =
1658
  ($doreturn, $messages, $iteminformation, $borrower) =
1634
      &AddReturn($barcode, $branch, $exemptfine, $dropbox);
1659
      &AddReturn($barcode, $branch, $exemptfine, $dropbox, $overrides);
1635
1660
1636
Returns a book.
1661
Returns a book.
1637
1662
Lines 1650-1655 overdue charges are applied and C<$dropbox> is true, the last charge Link Here
1650
will be removed.  This assumes that the fines accrual script has run
1675
will be removed.  This assumes that the fines accrual script has run
1651
for _today_.
1676
for _today_.
1652
1677
1678
=item C<$overrides> A hash with various overrides as keys:
1679
$overrides->{overrideBranchTransferDenied} == 1
1680
TODO:: $exemptFine should be moved under this one as well, but the rule is,
1681
if it's not broken, don't fix it :)
1682
1653
=back
1683
=back
1654
1684
1655
C<&AddReturn> returns a list of four items:
1685
C<&AddReturn> returns a list of four items:
Lines 1685-1690 This book has was returned to the wrong branch. The value is a hashref Link Here
1685
so that C<$messages->{Wrongbranch}->{Wrongbranch}> and C<$messages->{Wrongbranch}->{Rightbranch}>
1715
so that C<$messages->{Wrongbranch}->{Wrongbranch}> and C<$messages->{Wrongbranch}->{Rightbranch}>
1686
contain the branchcode of the incorrect and correct return library, respectively.
1716
contain the branchcode of the incorrect and correct return library, respectively.
1687
1717
1718
=item C<BranchTransferDenied>
1719
1720
Implements the UseBranchTransferLimits-preference.
1721
This book cannot be transferred from this branch to the Item's homebranch, or other branch defined by
1722
the  AllowReturnToBranch-preference.
1723
C<$messages->{BranchTransferDenied}> contains the From-, To-branches and the code of failure.
1724
See CanBookBeIssued() for more.
1725
1688
=item C<ResFound>
1726
=item C<ResFound>
1689
1727
1690
The item was reserved. The value is a reference-to-hash whose keys are
1728
The item was reserved. The value is a reference-to-hash whose keys are
Lines 1703-1709 patron who last borrowed the book. Link Here
1703
=cut
1741
=cut
1704
1742
1705
sub AddReturn {
1743
sub AddReturn {
1706
    my ( $barcode, $branch, $exemptfine, $dropbox ) = @_;
1744
    my ( $barcode, $branch, $exemptfine, $dropbox, $overrides ) = @_;
1707
1745
1708
    if ($branch and not GetBranchDetail($branch)) {
1746
    if ($branch and not GetBranchDetail($branch)) {
1709
        warn "AddReturn error: branch '$branch' not found.  Reverting to " . C4::Context->userenv->{'branch'};
1747
        warn "AddReturn error: branch '$branch' not found.  Reverting to " . C4::Context->userenv->{'branch'};
Lines 1722-1728 sub AddReturn { Link Here
1722
    unless ($itemnumber) {
1760
    unless ($itemnumber) {
1723
        return (0, { BadBarcode => $barcode }); # no barcode means no item or borrower.  bail out.
1761
        return (0, { BadBarcode => $barcode }); # no barcode means no item or borrower.  bail out.
1724
    }
1762
    }
1725
    my $issue  = GetItemIssue($itemnumber);
1763
    my $issue = GetItemIssue($itemnumber);
1726
#   warn Dumper($iteminformation);
1764
#   warn Dumper($iteminformation);
1727
    if ($issue and $issue->{borrowernumber}) {
1765
    if ($issue and $issue->{borrowernumber}) {
1728
        $borrower = C4::Members::GetMemberDetails($issue->{borrowernumber})
1766
        $borrower = C4::Members::GetMemberDetails($issue->{borrowernumber})
Lines 1758-1771 sub AddReturn { Link Here
1758
    }
1796
    }
1759
1797
1760
    # check if the return is allowed at this branch
1798
    # check if the return is allowed at this branch
1761
    my ($returnallowed, $message) = CanBookBeReturned($item, $branch);
1799
    my ($returnallowed, $message) = CanItemBeReturned($item, $branch);
1762
    unless ($returnallowed){
1800
    unless ($returnallowed){
1763
        $messages->{'Wrongbranch'} = {
1801
        if (defined $message->{Wrongbranch}) {
1764
            Wrongbranch => $branch,
1802
            $messages->{'Wrongbranch'} = {
1765
            Rightbranch => $message
1803
                Wrongbranch => $branch,
1766
        };
1804
                Rightbranch => $message
1767
        $doreturn = 0;
1805
            };
1768
        return ( $doreturn, $messages, $issue, $borrower );
1806
            $doreturn = 0;
1807
            return ( $doreturn, $messages, $issue, $borrower );
1808
        }
1809
        if (defined $message->{BranchTransferDenied} &&
1810
                (my @msgs = split('->', $message->{BranchTransferDenied}) ) &&
1811
                ( ! exists $overrides->{overrideBranchTransferDenied} )      ) {
1812
            $messages->{BranchTransferDenied} = {
1813
                Frombranch => $msgs[0],
1814
                Tobranch => $msgs[1],
1815
                Code => $msgs[2]
1816
            };
1817
            $doreturn = 0;
1818
            return ( $doreturn, $messages, $issue, $borrower );
1819
        }
1820
        #Some blocks can be overridden, so keep moving forward.
1769
    }
1821
    }
1770
1822
1771
    if ( $item->{'withdrawn'} ) { # book has been cancelled
1823
    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 (-3 / +3 lines)
Lines 249-255 if ( $query->param('place_reserve') ) { Link Here
249
            }
249
            }
250
250
251
            # UseBranchTransferLimits checking.
251
            # UseBranchTransferLimits checking.
252
            my ($transferOk, $message) = CheckBranchTransferAllowed( $pickupLocation, $item->{'holdingbranch'}, $item, undef );
252
            my ($transferOk, $message) = CanItemBeTransferred( $pickupLocation, $item->{'holdingbranch'}, $item, undef );
253
            if (! $transferOk) {
253
            if (! $transferOk) {
254
                $canreserve = 0;
254
                $canreserve = 0;
255
            }
255
            }
Lines 405-411 foreach my $biblioNum (@biblionumbers) { Link Here
405
        }
405
        }
406
    }
406
    }
407
407
408
    #Collect the amout of items that pass the CheckBranchTransferAllowed-check. This is needed to tell
408
    #Collect the amout of items that pass the CanItemBeTransferred-check. This is needed to tell
409
    #  the user if some or all Items cannot be transferred to the pickup location.
409
    #  the user if some or all Items cannot be transferred to the pickup location.
410
    my $branchTransferableItemsCount = 0;
410
    my $branchTransferableItemsCount = 0;
411
411
Lines 518-524 foreach my $biblioNum (@biblionumbers) { Link Here
518
518
519
            #Check for UseBranchTransferLimit. $numCopiesAvailable is incremented because this Item
519
            #Check for UseBranchTransferLimit. $numCopiesAvailable is incremented because this Item
520
            #  could still be available from another pickup location
520
            #  could still be available from another pickup location
521
            my ($transferOk, $errorMsg) = CheckBranchTransferAllowed( $pickupBranch, undef, GetItem($itemNum), undef );
521
            my ($transferOk, $errorMsg) = CanItemBeTransferred( $pickupBranch, undef, GetItem($itemNum), undef );
522
            if (! $transferOk) {
522
            if (! $transferOk) {
523
                $itemLoopIter->{available} = 0;
523
                $itemLoopIter->{available} = 0;
524
                $itemLoopIter->{branchTransferBlocked} = 1;
524
                $itemLoopIter->{branchTransferBlocked} = 1;
(-)a/t/db_dependent/Circulation/CanItemBeTransferred.t (-176 / +48 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 14-50 my $originalBranchTransferLimitsType = C4::Context->preference('BranchTransferLi Link Here
14
### Preparing our tests we want to run ###
18
### Preparing our tests we want to run ###
15
sub runTestsForCCode {
19
sub runTestsForCCode {
16
    my ($itemCPLFull, $itemCPLLite, $biblioitem) = @_;
20
    my ($itemCPLFull, $itemCPLLite, $biblioitem) = @_;
21
    
22
    C4::Context->set_preference("BranchTransferLimitsType", 'ccode');
17
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] );
21
    my $result = C4::Circulation::CanItemBeTransferred( 'CPL', 'IPT', $itemCPLFull, $biblioitem );
27
    my $result = C4::Circulation::CanItemBeTransferred( 'CPL', 'IPT', $itemCPLFull, $biblioitem );
22
    is ( $result, 1, "Successful branch transfer, full parameters" );
28
    is ( $result, 1, "Successful branch transfer, full parameters" );
23
29
    
24
    $result = C4::Circulation::CanItemBeTransferred( 'IPT', 'CPL', $itemCPLFull, $biblioitem );
30
    $result = C4::Circulation::CanItemBeTransferred( 'IPT', 'CPL', $itemCPLFull, $biblioitem );
25
    is ( $result, 'CPL->IPT->FANTASY', "Failing branch transfer, full parameters" );
31
    is ( $result, 'CPL->IPT->FANTASY', "Failing branch transfer, full parameters" );
26
32
    
27
    $result = C4::Circulation::CanItemBeTransferred( 'CPL', 'IPT', $itemCPLFull, undef );
33
    $result = C4::Circulation::CanItemBeTransferred( 'CPL', 'IPT', $itemCPLFull, undef );
28
    is ( $result, 1, "Successful branch transfer, full parameters, no Biblio defined" );
34
    is ( $result, 1, "Successful branch transfer, full parameters, no Biblio defined" );
29
35
    
30
    $result = C4::Circulation::CanItemBeTransferred( 'IPT', 'CPL', $itemCPLFull, undef );
36
    $result = C4::Circulation::CanItemBeTransferred( 'IPT', 'CPL', $itemCPLFull, undef );
31
    is ( $result, 'CPL->IPT->FANTASY', "Failing branch transfer, full parameters, no Biblio defined" );
37
    is ( $result, 'CPL->IPT->FANTASY', "Failing branch transfer, full parameters, no Biblio defined" );
32
38
    
33
    $result = C4::Circulation::CanItemBeTransferred( 'FFL', undef, $itemCPLFull, $biblioitem );
39
    $result = C4::Circulation::CanItemBeTransferred( 'FFL', undef, $itemCPLFull, $biblioitem );
34
    is ( $result, 1, "Successful branch transfer, using defaults for \$fromBranch" );
40
    is ( $result, 1, "Successful branch transfer, using defaults for \$fromBranch" );
35
41
    
36
    $result = C4::Circulation::CanItemBeTransferred( 'IPT', undef, $itemCPLFull, $biblioitem );
42
    $result = C4::Circulation::CanItemBeTransferred( 'IPT', undef, $itemCPLFull, $biblioitem );
37
    is ( $result, 'CPL->IPT->FANTASY', "Failing branch transfer, using defaults for \$fromBranch" );
43
    is ( $result, 'CPL->IPT->FANTASY', "Failing branch transfer, using defaults for \$fromBranch" );
38
44
    
39
    $result = C4::Circulation::CanItemBeTransferred( 'FFL', undef, $itemCPLFull, undef );
45
    $result = C4::Circulation::CanItemBeTransferred( 'FFL', undef, $itemCPLFull, undef );
40
    is ( $result, 1, "Successful branch transfer, using minimum parameters" );
46
    is ( $result, 1, "Successful branch transfer, using minimum parameters" );
41
47
    
42
    $result = C4::Circulation::CanItemBeTransferred( 'IPT', undef, $itemCPLFull, undef );
48
    $result = C4::Circulation::CanItemBeTransferred( 'IPT', undef, $itemCPLFull, undef );
43
    is ( $result, 'CPL->IPT->FANTASY', "Failing branch transfer, using minimum parameters" );
49
    is ( $result, 'CPL->IPT->FANTASY', "Failing branch transfer, using minimum parameters" );
44
50
    
45
    $result = C4::Circulation::CanItemBeTransferred( 'FFL', undef, $itemCPLLite, undef );
51
    $result = C4::Circulation::CanItemBeTransferred( 'FFL', undef, $itemCPLLite, undef );
46
    is ( $result, 1, "Successful branch transfer, using minimum parameters" );
52
    is ( $result, 1, "Successful branch transfer, using minimum parameters" );
47
53
    
48
    $result = C4::Circulation::CanItemBeTransferred( 'IPT', undef, $itemCPLLite, undef );
54
    $result = C4::Circulation::CanItemBeTransferred( 'IPT', undef, $itemCPLLite, undef );
49
    is ( $result, 1, "Not failing branch transfer, because CCODE cannot be found from the item and it is not a part of the biblio." );
55
    is ( $result, 1, "Not failing branch transfer, because CCODE cannot be found from the item and it is not a part of the biblio." );
50
}
56
}
Lines 52-85 sub runTestsForCCode { Link Here
52
58
53
sub runTestsForItype {
59
sub runTestsForItype {
54
    my ($itemCPLFull, $itemCPLLite, $biblioitem) = @_;
60
    my ($itemCPLFull, $itemCPLLite, $biblioitem) = @_;
61
    
62
    C4::Context->set_preference("BranchTransferLimitsType", 'itemtype');
55
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] );
59
    my $result = C4::Circulation::CanItemBeTransferred( 'CPL', 'IPT', $itemCPLFull, $biblioitem );
67
    my $result = C4::Circulation::CanItemBeTransferred( 'CPL', 'IPT', $itemCPLFull, $biblioitem );
60
    is ( $result, 1, "Successful branch transfer, full parameters" );
68
    is ( $result, 1, "Successful branch transfer, full parameters" );
61
69
    
62
    $result = C4::Circulation::CanItemBeTransferred( 'IPT', 'CPL', $itemCPLFull, $biblioitem );
70
    $result = C4::Circulation::CanItemBeTransferred( 'IPT', 'CPL', $itemCPLFull, $biblioitem );
63
    is ( $result, 'CPL->IPT->BK', "Failing branch transfer, full parameters" );
71
    is ( $result, 'CPL->IPT->BK', "Failing branch transfer, full parameters" );
64
72
    
65
    $result = C4::Circulation::CanItemBeTransferred( 'CPL', 'IPT', $itemCPLFull, undef );
73
    $result = C4::Circulation::CanItemBeTransferred( 'CPL', 'IPT', $itemCPLFull, undef );
66
    is ( $result, 1, "Successful branch transfer, full parameters, no Biblio defined" );
74
    is ( $result, 1, "Successful branch transfer, full parameters, no Biblio defined" );
67
75
    
68
    $result = C4::Circulation::CanItemBeTransferred( 'IPT', 'CPL', $itemCPLFull, undef );
76
    $result = C4::Circulation::CanItemBeTransferred( 'IPT', 'CPL', $itemCPLFull, undef );
69
    is ( $result, 'CPL->IPT->BK', "Failing branch transfer, full parameters, no Biblio defined" );
77
    is ( $result, 'CPL->IPT->BK', "Failing branch transfer, full parameters, no Biblio defined" );
70
78
    
71
    $result = C4::Circulation::CanItemBeTransferred( 'FFL', undef, $itemCPLFull, $biblioitem );
79
    $result = C4::Circulation::CanItemBeTransferred( 'FFL', undef, $itemCPLFull, $biblioitem );
72
    is ( $result, 1, "Successful branch transfer, using defaults for \$fromBranch" );
80
    is ( $result, 1, "Successful branch transfer, using defaults for \$fromBranch" );
73
81
    
74
    $result = C4::Circulation::CanItemBeTransferred( 'IPT', undef, $itemCPLFull, $biblioitem );
82
    $result = C4::Circulation::CanItemBeTransferred( 'IPT', undef, $itemCPLFull, $biblioitem );
75
    is ( $result, 'CPL->IPT->BK', "Failing branch transfer, using defaults for \$fromBranch" );
83
    is ( $result, 'CPL->IPT->BK', "Failing branch transfer, using defaults for \$fromBranch" );
76
84
    
77
    $result = C4::Circulation::CanItemBeTransferred( 'FFL', undef, $itemCPLFull, undef );
85
    $result = C4::Circulation::CanItemBeTransferred( 'FFL', undef, $itemCPLFull, undef );
78
    is ( $result, 1, "Successful branch transfer, using minimum parameters" );
86
    is ( $result, 1, "Successful branch transfer, using minimum parameters" );
79
87
    
80
    $result = C4::Circulation::CanItemBeTransferred( 'IPT', undef, $itemCPLFull, undef );
88
    $result = C4::Circulation::CanItemBeTransferred( 'IPT', undef, $itemCPLFull, undef );
81
    is ( $result, 'CPL->IPT->BK', "Failing branch transfer, using minimum parameters" );
89
    is ( $result, 'CPL->IPT->BK', "Failing branch transfer, using minimum parameters" );
82
90
    
83
    $result = C4::Circulation::CanItemBeTransferred( 'FFL', undef, $itemCPLLite, undef );
91
    $result = C4::Circulation::CanItemBeTransferred( 'FFL', undef, $itemCPLLite, undef );
84
    is ( $result, 1, "Successful branch transfer, using minimum parameters, itemtype is pulled from Biblio" );
92
    is ( $result, 1, "Successful branch transfer, using minimum parameters, itemtype is pulled from Biblio" );
85
93
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);
103
234
104
105
#One cannot return an Item which has homebranch in CPL to FFL
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." );
235
109
236
### ccode tested
237
### Setting preferences for itemtype use-case ###
238
110
239
C4::Context->set_preference("BranchTransferLimitsType", 'itemtype');
111
#One can return an Item which has homebranch in FFL to CPL
112
($returnOk, $errorMessage) = C4::Circulation::AddReturn('CPLFull', 'CPL', undef, undef, undef);
113
is( $returnOk, 1, "Check-in succeeds." );
240
114
241
## Add the TransferLimit rules:
242
## IPT -> CPL -> FFL -> IPT
243
#                                            to     from
244
C4::Circulation::CreateBranchTransferLimit( 'IPT', 'CPL', $itemtype );
245
C4::Circulation::CreateBranchTransferLimit( 'CPL', 'FFL', $itemtype );
246
C4::Circulation::CreateBranchTransferLimit( 'FFL', 'IPT', $itemtype );
247
115
248
## Ready to start testing itemtype use-case ##
116
#One can override a denied branch transfer
117
$datedue = C4::Circulation::AddIssue( $borrower, 'CPLFull')    or BAIL_OUT("Cannot check-out an Item!");
118
($returnOk, $errorMessage) = C4::Circulation::AddReturn('CPLFull', 'FFL', undef, undef, {overrideBranchTransferDenied => 1});
119
is( $returnOk, 1, "Check-in succeeds because transfer limits are overridden." );
249
120
250
$itemCPLFull = C4::Items::GetItem($itemCPLFullId);
251
$itemCPLLite = C4::Items::GetItem($itemCPLLiteId);
252
$biblioitem = C4::Biblio::GetBiblioFromItemNumber( $itemCPLFull->{itemnumber} );
253
121
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." );
254
128
255
runTestsForItype($itemCPLFull, $itemCPLLite, $biblioitem);
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