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

(-)a/C4/Circulation.pm (-11 / +88 lines)
Lines 104-109 BEGIN { Link Here
104
		&GetTransfersFromTo
104
		&GetTransfersFromTo
105
		&updateWrongTransfer
105
		&updateWrongTransfer
106
		&DeleteTransfer
106
		&DeleteTransfer
107
				&CheckBranchTransferAllowed
107
                &IsBranchTransferAllowed
108
                &IsBranchTransferAllowed
108
                &CreateBranchTransferLimit
109
                &CreateBranchTransferLimit
109
                &DeleteBranchTransferLimits
110
                &DeleteBranchTransferLimits
Lines 299-305 sub transferbook { Link Here
299
    my $messages;
300
    my $messages;
300
    my $dotransfer      = 1;
301
    my $dotransfer      = 1;
301
    my $branches        = GetBranches();
302
    my $branches        = GetBranches();
302
    my $itemnumber = GetItemnumberFromBarcode( $barcode );
303
	my $item = GetItem(undef,$barcode,undef);
304
	my $itemnumber = $item->{itemnumber};
303
    my $issue      = GetItemIssue($itemnumber);
305
    my $issue      = GetItemIssue($itemnumber);
304
    my $biblio = GetBiblioFromItemNumber($itemnumber);
306
    my $biblio = GetBiblioFromItemNumber($itemnumber);
305
307
Lines 314-329 sub transferbook { Link Here
314
    my $fbr = $biblio->{'holdingbranch'};
316
    my $fbr = $biblio->{'holdingbranch'};
315
317
316
    # if using Branch Transfer Limits
318
    # if using Branch Transfer Limits
317
    if ( C4::Context->preference("UseBranchTransferLimits") == 1 ) {
319
	my $errMsg;
318
        if ( C4::Context->preference("item-level_itypes") && C4::Context->preference("BranchTransferLimitsType") eq 'itemtype' ) {
320
    ($dotransfer, $errMsg) = CheckBranchTransferAllowed( $tbr, $fbr, $item, $biblio );
319
            if ( ! IsBranchTransferAllowed( $tbr, $fbr, $biblio->{'itype'} ) ) {
321
    if ( ! $dotransfer ) {
320
                $messages->{'NotAllowed'} = $tbr . "::" . $biblio->{'itype'};
322
        $messages->{'NotAllowed'} = $errMsg;
321
                $dotransfer = 0;
322
            }
323
        } elsif ( ! IsBranchTransferAllowed( $tbr, $fbr, $biblio->{ C4::Context->preference("BranchTransferLimitsType") } ) ) {
324
            $messages->{'NotAllowed'} = $tbr . "::" . $biblio->{ C4::Context->preference("BranchTransferLimitsType") };
325
            $dotransfer = 0;
326
    	}
327
    }
323
    }
328
324
329
    # if is permanent...
325
    # if is permanent...
Lines 3200-3205 my $exist=$sth->fetchrow ; Link Here
3200
return $exist;
3196
return $exist;
3201
}
3197
}
3202
3198
3199
3200
=head2 CheckBranchTransferAllowed
3201
3202
A convenience function to easily check item transfer limits.
3203
3204
   ($allowed, $errorMessage) = CheckBranchTransferAllowed( $toBranch, $fromBranch, $item, $biblioitem );
3205
   ($allowed, $errorMessage) = CheckBranchTransferAllowed( $toBranch, undef, $item, undef] );
3206
  
3207
Checks if UseBranchTransferLimits global preference is in use.
3208
Checks if the given item can be transferred from $fromBranch to $toBranch.
3209
This is dependant on the global setting:
3210
* UseBranchTransferLimits
3211
and "Administration" -> "Library transfer limits"
3212
3213
C<$toBranch>   = the transfer destination library's code
3214
C<$fromBranch>     = OPTIONAL, the transfer departure library's code
3215
                     DEFAULT: using the item's holdingbranch
3216
C<$item>  = item-object from items-table
3217
C<$biblioitem>  = OPTIONAL, biblioitem-object, is needed when using CCODE instead if
3218
              using itemtype to limit branch transfers.
3219
              If biblioitem-object is available, it should be provided for performance reasons.
3220
C<returns> if transfer is not allowed: (0, "$fromBranch->$toBranch->transfer limit code")
3221
           (1) if transfer allowed.
3222
=cut
3223
3224
sub CheckBranchTransferAllowed {
3225
3226
	#When we check for BranchTransferLimit global settings centrally, it makes
3227
	#  using this functionality much easier.
3228
	unless ( C4::Context->preference("UseBranchTransferLimits") == 1 ) {
3229
		   return 1;
3230
	}
3231
	
3232
	#Init parameter variables
3233
	my ( $toBranch, $fromBranch, $item, $biblioitem ) = @_;
3234
	
3235
	#Check the $fromBranch and set the DEFAULT value
3236
	$fromBranch = $item->{holdingbranch} if ! defined $fromBranch;
3237
	
3238
	if ( $toBranch eq $fromBranch ) { return 1; } ## Short circuit for speed.
3239
	
3240
	#This is the CCode or itemtype value used to find the correct transfer rule for this item.
3241
	my $code;
3242
	
3243
	## Figure out the $code!
3244
	## First we need to figure out are we using CCODE or itemtype, this limits do we need $biblioitem or not.
3245
	## Since $biblioitem can be optional, we cannot count that it is defined.
3246
	if ( C4::Context->preference("BranchTransferLimitsType") eq 'itemtype' ) {
3247
			if (C4::Context->preference("item-level_itypes") && defined $item->{'itype'}) {
3248
					$code = $item->{'itype'}; #Easiest way to get the $code is from the item.
3249
			}
3250
			elsif (defined $biblioitem->{itemtype}) {
3251
					$code = $biblioitem->{itemtype}
3252
			}
3253
			#If code cannot be resolved from $item or $biblioitem, we need to escalate to the DB
3254
			else {
3255
					$biblioitem = C4::Biblio::GetBiblioFromItemNumber( $item->{itemnumber} );
3256
					$code = $biblioitem->{itemtype}
3257
			}
3258
			
3259
	} else {
3260
			my $limitType = C4::Context->preference("BranchTransferLimitsType");
3261
			if (defined $biblioitem->{ $limitType }) {
3262
					$code = $biblioitem->{ $limitType };
3263
			}
3264
			else {
3265
					#collection code (ccode) is not present in the Biblio, so no point looking there.
3266
					#  If the Item doesn't have a itemtype, then give up and let the transfer pass.
3267
			}
3268
	}
3269
	## Phew we finally got the $code, now it's time to rumble!
3270
	
3271
	if (! IsBranchTransferAllowed($toBranch, $fromBranch, $code)) {
3272
			return 0, "$fromBranch->$toBranch->$code";
3273
	}
3274
	else {
3275
			return 1;
3276
	}
3277
}          
3278
3279
3203
=head2 IsBranchTransferAllowed
3280
=head2 IsBranchTransferAllowed
3204
3281
3205
  $allowed = IsBranchTransferAllowed( $toBranch, $fromBranch, $code );
3282
  $allowed = IsBranchTransferAllowed( $toBranch, $fromBranch, $code );
(-)a/circ/branchtransfers.pl (-1 / +2 lines)
Lines 207-215 foreach my $code ( keys %$messages ) { Link Here
207
        }
207
        }
208
        elsif ( $code eq "NotAllowed" ) {
208
        elsif ( $code eq "NotAllowed" ) {
209
            warn "NotAllowed: $messages->{'NotAllowed'} to  " . $branches->{ $messages->{'NotAllowed'} }->{'branchname'};
209
            warn "NotAllowed: $messages->{'NotAllowed'} to  " . $branches->{ $messages->{'NotAllowed'} }->{'branchname'};
210
			
210
            # Do we really want a error log message here? --atz
211
            # Do we really want a error log message here? --atz
211
            $err{errnotallowed} =  1;
212
            $err{errnotallowed} =  1;
212
            my ( $tbr, $typecode ) = split( /::/,  $messages->{'NotAllowed'} );
213
            my ( $fbr, $tbr, $typecode ) = split( '->',  $messages->{'NotAllowed'} );
213
            $err{tbr}      = $branches->{ $tbr }->{'branchname'};
214
            $err{tbr}      = $branches->{ $tbr }->{'branchname'};
214
            $err{code}     = $typecode;
215
            $err{code}     = $typecode;
215
            $err{codeType} = $codeTypeDescription;
216
            $err{codeType} = $codeTypeDescription;
(-)a/t/db_dependent/Circulation/CheckBranchTransferAllowed.t (-1 / +180 lines)
Line 0 Link Here
0
- 
1
use Modern::Perl;
2
use Test::More tests => 20;
3
4
use C4::Circulation;
5
use C4::Context;
6
use C4::Record;
7
8
my $dbh = C4::Context->dbh;
9
$dbh->{AutoCommit} = 0;
10
$dbh->{RaiseError} = 1;
11
12
my $originalBranchTransferLimitsType = C4::Context->preference('BranchTransferLimitsType');
13
14
### Preparing our tests we want to run ###
15
sub runTestsForCCodeOrItemtype {
16
    my ($itemCPLFull, $itemCPLLite, $biblioitem) = @_;
17
    
18
    print 'Running tests for '.C4::Context->preference("BranchTransferLimitsType")."\n";
19
    
20
    #howto use:               CheckBranchTransferAllowed( $toBranch, $fromBranch, $item, $biblioitem] );
21
    my $result = C4::Circulation::CheckBranchTransferAllowed( 'CPL', 'IPT', $itemCPLFull, $biblioitem );
22
    is ( $result, 1, "Successful branch transfer, full parameters" );
23
    
24
    $result = C4::Circulation::CheckBranchTransferAllowed( 'IPT', 'CPL', $itemCPLFull, $biblioitem );
25
    is ( $result, 0, "Failing branch transfer, full parameters" );
26
    
27
    $result = C4::Circulation::CheckBranchTransferAllowed( 'CPL', 'IPT', $itemCPLFull, undef );
28
    is ( $result, 1, "Successful branch transfer, full parameters, no Biblio defined" );
29
    
30
    $result = C4::Circulation::CheckBranchTransferAllowed( 'IPT', 'CPL', $itemCPLFull, undef );
31
    is ( $result, 0, "Failing branch transfer, full parameters, no Biblio defined" );
32
    
33
    $result = C4::Circulation::CheckBranchTransferAllowed( 'FFL', undef, $itemCPLFull, $biblioitem );
34
    is ( $result, 1, "Successful branch transfer, using defaults for \$fromBranch" );
35
    
36
    $result = C4::Circulation::CheckBranchTransferAllowed( 'IPT', undef, $itemCPLFull, $biblioitem );
37
    is ( $result, 0, "Failing branch transfer, using defaults for \$fromBranch" );
38
    
39
    $result = C4::Circulation::CheckBranchTransferAllowed( 'FFL', undef, $itemCPLFull, undef );
40
    is ( $result, 1, "Successful branch transfer, using minimum parameters" );
41
    
42
    $result = C4::Circulation::CheckBranchTransferAllowed( 'IPT', undef, $itemCPLFull, undef );
43
    is ( $result, 0, "Failing branch transfer, using minimum parameters" );
44
    
45
    $result = C4::Circulation::CheckBranchTransferAllowed( 'FFL', undef, $itemCPLLite, undef );
46
    is ( $result, 1, "Successful branch transfer, using minimum parameters, code is pulled from Biblio" );
47
    
48
    if (C4::Context->preference("BranchTransferLimitsType") eq 'ccode') {
49
        $result = C4::Circulation::CheckBranchTransferAllowed( 'IPT', undef, $itemCPLLite, undef );
50
        is ( $result, 1, "Not failing branch transfer even if should, because CCODE cannot be found from the item and it is not a part of the biblio." );
51
    }
52
    else {
53
        $result = C4::Circulation::CheckBranchTransferAllowed( 'IPT', undef, $itemCPLLite, undef );
54
        is ( $result, 0, "Failing branch transfer, using minimum parameters, itemtype is pulled from Biblio" );
55
    }
56
    
57
    
58
}
59
### Tests prepared
60
61
### Preparing our generic testing data ###
62
63
#Set the item variables
64
my $ccode = 'FANTASY';
65
my $itemtype = 'BK';
66
67
## Add a example Bibliographic record
68
my $bibFramework = ''; #Using the default bibliographic framework.
69
my $marcxml=qq(<?xml version="1.0" encoding="UTF-8"?>
70
<record format="MARC21" type="Bibliographic">
71
  <leader>00000cim a22000004a 4500</leader>
72
  <controlfield tag="001">1001</controlfield>
73
  <controlfield tag="005">2013-06-03 07:04:07+02</controlfield>
74
  <controlfield tag="007">ss||||j|||||||</controlfield>
75
  <controlfield tag="008">       uuuu    xxk|||||||||||||||||eng|c</controlfield>
76
  <datafield tag="020" ind1=" " ind2=" ">
77
    <subfield code="a">0-00-103147-3</subfield>
78
    <subfield code="c">14.46 EUR</subfield>
79
  </datafield>
80
  <datafield tag="041" ind1="0" ind2=" ">
81
    <subfield code="d">eng</subfield>
82
  </datafield>
83
  <datafield tag="084" ind1=" " ind2=" ">
84
    <subfield code="a">83.5</subfield>
85
    <subfield code="2">ykl</subfield>
86
  </datafield>
87
  <datafield tag="100" ind1="1" ind2=" ">
88
    <subfield code="a">SHAKESPEARE, WILLIAM.</subfield>
89
  </datafield>
90
  <datafield tag="245" ind1="1" ind2="4">
91
    <subfield code="a">THE TAMING OF THE SHREW /</subfield>
92
    <subfield code="c">WILLIAM SHAKESPEARE</subfield>
93
    <subfield code="h">[ÄÄNITE].</subfield>
94
  </datafield>
95
  <datafield tag="260" ind1=" " ind2=" ">
96
    <subfield code="a">LONDON :</subfield>
97
    <subfield code="b">COLLINS.</subfield>
98
  </datafield>
99
  <datafield tag="300" ind1=" " ind2=" ">
100
    <subfield code="a">2 ÄÄNIKASETTIA.</subfield>
101
  </datafield>
102
  <datafield tag="852" ind1=" " ind2=" ">
103
    <subfield code="a">FI-Jm</subfield>
104
    <subfield code="h">83.5</subfield>
105
  </datafield>
106
  <datafield tag="852" ind1=" " ind2=" ">
107
    <subfield code="a">FI-Konti</subfield>
108
    <subfield code="h">83.5</subfield>
109
  </datafield>
110
</record>
111
);
112
my $record=C4::Record::marcxml2marc($marcxml);
113
114
# Add a itemtype definition to the Record.
115
my ( $biblioitemtypeTagid, $biblioitemtypeSubfieldid ) =
116
            C4::Biblio::GetMarcFromKohaField( 'biblioitems.itemtype', $bibFramework );
117
my $itemtypeField = MARC::Field->new($biblioitemtypeTagid, '', '',
118
                                     $biblioitemtypeSubfieldid => $itemtype);
119
$record->append_fields( $itemtypeField );
120
121
my ( $newBiblionumber, $newBiblioitemnumber ) = C4::Biblio::AddBiblio( $record, $bibFramework, { defer_marc_save => 1 } );
122
123
## Add an item with a ccode.
124
my ($item_bibnum, $item_bibitemnum);
125
my ($itemCPLFull, $itemCPLFullId); #Item with a itemtype and ccode in its data.
126
my ($itemCPLLite, $itemCPLLiteId); #Item with no itemtype nor ccode in its data. Forces to look for it from the biblio.
127
($item_bibnum, $item_bibitemnum, $itemCPLFullId) = C4::Items::AddItem({ barcode => 'CPLFull', homebranch => 'CPL', holdingbranch => 'CPL', ccode => $ccode, itemtype => $itemtype}, $newBiblionumber);#, biblioitemnumber => $newBiblioitemnumber, biblionumber => $newBiblioitemnumber });
128
($item_bibnum, $item_bibitemnum, $itemCPLLiteId) = C4::Items::AddItem({ barcode => 'CPLLite', homebranch => 'CPL', holdingbranch => 'CPL'}, $newBiblionumber);# biblioitemnumber => $newBiblioitemnumber, biblionumber => $newBiblioitemnumber });
129
130
131
### Created the generic testing material. ###
132
### Setting preferences for ccode use-case ###
133
134
C4::Context->set_preference("BranchTransferLimitsType", 'ccode');
135
136
## Add the TransferLimit rules:
137
## IPT -> CPL -> FFL -> IPT
138
#                                            to     from
139
C4::Circulation::CreateBranchTransferLimit( 'IPT', 'CPL', $ccode );
140
C4::Circulation::CreateBranchTransferLimit( 'CPL', 'FFL', $ccode );
141
C4::Circulation::CreateBranchTransferLimit( 'FFL', 'IPT', $ccode );
142
143
## Ready to start testing ccode use-case ##
144
145
$itemCPLFull = C4::Items::GetItem($itemCPLFullId);
146
$itemCPLLite = C4::Items::GetItem($itemCPLLiteId);
147
my $biblioitem = C4::Biblio::GetBiblioFromItemNumber( $itemCPLFull->{itemnumber} );
148
149
150
runTestsForCCodeOrItemtype($itemCPLFull, $itemCPLLite, $biblioitem);
151
152
153
154
### ccode tested
155
### Setting preferences for itemtype use-case ###
156
157
C4::Context->set_preference("BranchTransferLimitsType", 'itemtype');
158
159
## Add the TransferLimit rules:
160
## IPT -> CPL -> FFL -> IPT
161
#                                            to     from
162
C4::Circulation::CreateBranchTransferLimit( 'IPT', 'CPL', $itemtype );
163
C4::Circulation::CreateBranchTransferLimit( 'CPL', 'FFL', $itemtype );
164
C4::Circulation::CreateBranchTransferLimit( 'FFL', 'IPT', $itemtype );
165
166
## Ready to start testing itemtype use-case ##
167
168
$itemCPLFull = C4::Items::GetItem($itemCPLFullId);
169
$itemCPLLite = C4::Items::GetItem($itemCPLLiteId);
170
$biblioitem = C4::Biblio::GetBiblioFromItemNumber( $itemCPLFull->{itemnumber} );
171
172
173
runTestsForCCodeOrItemtype($itemCPLFull, $itemCPLLite, $biblioitem);
174
175
### itemtype tested
176
177
### Reset default preferences
178
C4::Context->set_preference("BranchTransferLimitsType", $originalBranchTransferLimitsType);
179
180
$dbh->rollback;

Return to bug 11005