|
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: CheckBranchTransferAllowed( $toBranch, $fromBranch, $item, $biblioitem] ); |
26 |
#howto use: CheckBranchTransferAllowed( $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: CheckBranchTransferAllowed( $toBranch, $fromBranch, $item, $biblioitem] ); |
66 |
#howto use: CheckBranchTransferAllowed( $toBranch, $fromBranch, $item, $biblioitem] ); |
|
Lines 88-208
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=qq(<?xml version="1.0" encoding="UTF-8"?> |
| 100 |
<record format="MARC21" type="Bibliographic"> |
| 101 |
<leader>00000cim a22000004a 4500</leader> |
| 102 |
<controlfield tag="001">1001</controlfield> |
| 103 |
<controlfield tag="005">2013-06-03 07:04:07+02</controlfield> |
| 104 |
<controlfield tag="007">ss||||j|||||||</controlfield> |
| 105 |
<controlfield tag="008"> uuuu xxk|||||||||||||||||eng|c</controlfield> |
| 106 |
<datafield tag="020" ind1=" " ind2=" "> |
| 107 |
<subfield code="a">0-00-103147-3</subfield> |
| 108 |
<subfield code="c">14.46 EUR</subfield> |
| 109 |
</datafield> |
| 110 |
<datafield tag="041" ind1="0" ind2=" "> |
| 111 |
<subfield code="d">eng</subfield> |
| 112 |
</datafield> |
| 113 |
<datafield tag="084" ind1=" " ind2=" "> |
| 114 |
<subfield code="a">83.5</subfield> |
| 115 |
<subfield code="2">ykl</subfield> |
| 116 |
</datafield> |
| 117 |
<datafield tag="100" ind1="1" ind2=" "> |
| 118 |
<subfield code="a">SHAKESPEARE, WILLIAM.</subfield> |
| 119 |
</datafield> |
| 120 |
<datafield tag="245" ind1="1" ind2="4"> |
| 121 |
<subfield code="a">THE TAMING OF THE SHREW /</subfield> |
| 122 |
<subfield code="c">WILLIAM SHAKESPEARE</subfield> |
| 123 |
<subfield code="h">[ÄÄNITE].</subfield> |
| 124 |
</datafield> |
| 125 |
<datafield tag="260" ind1=" " ind2=" "> |
| 126 |
<subfield code="a">LONDON :</subfield> |
| 127 |
<subfield code="b">COLLINS.</subfield> |
| 128 |
</datafield> |
| 129 |
<datafield tag="300" ind1=" " ind2=" "> |
| 130 |
<subfield code="a">2 ÄÄNIKASETTIA.</subfield> |
| 131 |
</datafield> |
| 132 |
<datafield tag="852" ind1=" " ind2=" "> |
| 133 |
<subfield code="a">FI-Jm</subfield> |
| 134 |
<subfield code="h">83.5</subfield> |
| 135 |
</datafield> |
| 136 |
<datafield tag="852" ind1=" " ind2=" "> |
| 137 |
<subfield code="a">FI-Konti</subfield> |
| 138 |
<subfield code="h">83.5</subfield> |
| 139 |
</datafield> |
| 140 |
</record> |
| 141 |
); |
| 142 |
my $record=C4::Record::marcxml2marc($marcxml); |
| 143 |
|
| 144 |
# Add a itemtype definition to the Record. |
| 145 |
my ( $biblioitemtypeTagid, $biblioitemtypeSubfieldid ) = |
| 146 |
C4::Biblio::GetMarcFromKohaField( 'biblioitems.itemtype', $bibFramework ); |
| 147 |
my $itemtypeField = MARC::Field->new($biblioitemtypeTagid, '', '', |
| 148 |
$biblioitemtypeSubfieldid => $itemtype); |
| 149 |
$record->append_fields( $itemtypeField ); |
| 150 |
|
| 151 |
my ( $newBiblionumber, $newBiblioitemnumber ) = C4::Biblio::AddBiblio( $record, $bibFramework, { defer_marc_save => 1 } ); |
| 152 |
|
| 153 |
## Add an item with a ccode. |
| 154 |
my ($item_bibnum, $item_bibitemnum); |
| 155 |
my ($itemCPLFull, $itemCPLFullId); #Item with a itemtype and ccode in its data. |
| 156 |
my ($itemCPLLite, $itemCPLLiteId); #Item with no itemtype nor ccode in its data. Forces to look for it from the biblio. |
| 157 |
($item_bibnum, $item_bibitemnum, $itemCPLFullId) = C4::Items::AddItem({ barcode => 'CPLFull', homebranch => 'CPL', holdingbranch => 'CPL', ccode => $ccode, itemtype => $itemtype}, $newBiblionumber);#, biblioitemnumber => $newBiblioitemnumber, biblionumber => $newBiblioitemnumber }); |
| 158 |
($item_bibnum, $item_bibitemnum, $itemCPLLiteId) = C4::Items::AddItem({ barcode => 'CPLLite', homebranch => 'CPL', holdingbranch => 'CPL'}, $newBiblionumber);# biblioitemnumber => $newBiblioitemnumber, biblionumber => $newBiblioitemnumber }); |
| 159 |
|
| 160 |
|
| 161 |
### Created the generic testing material. ### |
| 162 |
### Setting preferences for ccode use-case ### |
| 163 |
|
| 164 |
C4::Context->set_preference("BranchTransferLimitsType", 'ccode'); |
| 165 |
|
| 166 |
## Add the TransferLimit rules: |
| 167 |
## IPT -> CPL -> FFL -> IPT |
| 168 |
# to from |
| 169 |
C4::Circulation::CreateBranchTransferLimit( 'IPT', 'CPL', $ccode ); |
| 170 |
C4::Circulation::CreateBranchTransferLimit( 'CPL', 'FFL', $ccode ); |
| 171 |
C4::Circulation::CreateBranchTransferLimit( 'FFL', 'IPT', $ccode ); |
| 172 |
|
| 173 |
## Ready to start testing ccode use-case ## |
| 174 |
|
| 175 |
$itemCPLFull = C4::Items::GetItem($itemCPLFullId); |
| 176 |
$itemCPLLite = C4::Items::GetItem($itemCPLLiteId); |
| 177 |
my $biblioitem = C4::Biblio::GetBiblioFromItemNumber( $itemCPLFull->{itemnumber} ); |
| 178 |
|
| 179 |
|
| 180 |
runTestsForCCode($itemCPLFull, $itemCPLLite, $biblioitem); |
100 |
runTestsForCCode($itemCPLFull, $itemCPLLite, $biblioitem); |
| 181 |
|
101 |
|
|
|
102 |
runTestsForItype($itemCPLFull, $itemCPLLite, $biblioitem); |
| 103 |
|
| 182 |
|
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." ); |
| 183 |
|
109 |
|
| 184 |
### ccode tested |
|
|
| 185 |
### Setting preferences for itemtype use-case ### |
| 186 |
|
110 |
|
| 187 |
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." ); |
| 188 |
|
114 |
|
| 189 |
## Add the TransferLimit rules: |
|
|
| 190 |
## IPT -> CPL -> FFL -> IPT |
| 191 |
# to from |
| 192 |
C4::Circulation::CreateBranchTransferLimit( 'IPT', 'CPL', $itemtype ); |
| 193 |
C4::Circulation::CreateBranchTransferLimit( 'CPL', 'FFL', $itemtype ); |
| 194 |
C4::Circulation::CreateBranchTransferLimit( 'FFL', 'IPT', $itemtype ); |
| 195 |
|
115 |
|
| 196 |
## 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." ); |
| 197 |
|
120 |
|
| 198 |
$itemCPLFull = C4::Items::GetItem($itemCPLFullId); |
|
|
| 199 |
$itemCPLLite = C4::Items::GetItem($itemCPLLiteId); |
| 200 |
$biblioitem = C4::Biblio::GetBiblioFromItemNumber( $itemCPLFull->{itemnumber} ); |
| 201 |
|
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." ); |
| 202 |
|
128 |
|
| 203 |
runTestsForItype($itemCPLFull, $itemCPLLite, $biblioitem); |
|
|
| 204 |
|
129 |
|
| 205 |
### itemtype tested |
|
|
| 206 |
|
130 |
|
| 207 |
### Reset default preferences |
131 |
### Reset default preferences |
| 208 |
C4::Context->set_preference("BranchTransferLimitsType", $originalBranchTransferLimitsType); |
132 |
C4::Context->set_preference("BranchTransferLimitsType", $originalBranchTransferLimitsType); |