4 use Test
::More tests
=> 69;
8 # Avoid "redefined subroutine" warnings
9 local $SIG{__WARN__
} = sub { warn $_[0] unless $_[0] =~ /redefined/ };
11 *C4
::Budgets
::GetBudgetUsers
= \
&Mock_GetBudgetUsers
;
12 *C4
::Context
::userenv
= \
&Mock_userenv
;
42 budget_permission
=> 0,
43 budget_owner_id
=> undef,
44 budget_branchcode
=> undef,
48 budget_permission
=> 0,
49 budget_owner_id
=> undef,
50 budget_branchcode
=> 'B1',
54 budget_permission
=> 0,
56 budget_branchcode
=> undef,
60 budget_permission
=> 0,
62 budget_branchcode
=> 'B1',
66 budget_permission
=> 1,
67 budget_owner_id
=> undef,
68 budget_branchcode
=> undef,
72 budget_permission
=> 1,
73 budget_owner_id
=> undef,
74 budget_branchcode
=> 'B1',
78 budget_permission
=> 1,
80 budget_branchcode
=> undef,
84 budget_permission
=> 1,
86 budget_branchcode
=> 'B1',
90 budget_permission
=> 2,
91 budget_owner_id
=> undef,
92 budget_branchcode
=> undef,
96 budget_permission
=> 2,
97 budget_owner_id
=> undef,
98 budget_branchcode
=> 'B1',
102 budget_permission
=> 2,
103 budget_owner_id
=> 1,
104 budget_branchcode
=> undef,
108 budget_permission
=> 2,
109 budget_owner_id
=> 1,
110 budget_branchcode
=> 'B1',
114 budget_permission
=> 3,
115 budget_owner_id
=> undef,
116 budget_branchcode
=> undef,
120 budget_permission
=> 3,
121 budget_owner_id
=> undef,
122 budget_branchcode
=> 'B1',
126 budget_permission
=> 3,
127 budget_owner_id
=> 1,
128 budget_branchcode
=> undef,
132 budget_permission
=> 3,
133 budget_owner_id
=> 1,
134 budget_branchcode
=> 'B1',
139 ok
(CanUserUseBudget
($borrower1, $budget1, {superlibrarian
=> 1}));
140 ok
(CanUserUseBudget
($borrower1, $budget1, {
142 budget_manage_all
=> 1
145 ok
(CanUserUseBudget
($borrower1, $budget1, {acquisition
=> 1}));
147 ok
(!CanUserUseBudget
($borrower1, $budget1, {}));
148 ok
(!CanUserUseBudget
($borrower1, $budget1, {acquisition
=> 0}));
150 my $flags = {acquisition
=> {order_manage
=> 1}};
152 $userenv->{branch
} = 'B1';
154 # Restriction is 'none'
155 ok
(CanUserUseBudget
($borrower1, $budget1, $flags));
156 ok
(CanUserUseBudget
($borrower1, $budget2, $flags));
157 ok
(CanUserUseBudget
($borrower1, $budget3, $flags));
158 ok
(CanUserUseBudget
($borrower1, $budget4, $flags));
159 ok
(CanUserUseBudget
($borrower2, $budget1, $flags));
160 ok
(CanUserUseBudget
($borrower2, $budget2, $flags));
161 ok
(CanUserUseBudget
($borrower2, $budget3, $flags));
162 ok
(CanUserUseBudget
($borrower2, $budget4, $flags));
164 # Restriction is 'owner'
165 ok
(CanUserUseBudget
($borrower1, $budget5, $flags));
166 ok
(CanUserUseBudget
($borrower1, $budget6, $flags));
167 ok
(CanUserUseBudget
($borrower1, $budget7, $flags));
168 ok
(CanUserUseBudget
($borrower1, $budget8, $flags));
169 ok
(CanUserUseBudget
($borrower2, $budget5, $flags));
170 ok
(CanUserUseBudget
($borrower2, $budget6, $flags));
171 ok
(!CanUserUseBudget
($borrower2, $budget7, $flags));
172 ok
(!CanUserUseBudget
($borrower2, $budget8, $flags));
174 # Restriction is 'owner, users and library'
175 ok
(CanUserUseBudget
($borrower1, $budget9, $flags));
176 ok
(CanUserUseBudget
($borrower1, $budget10, $flags));
177 ok
(CanUserUseBudget
($borrower1, $budget11, $flags));
178 ok
(CanUserUseBudget
($borrower1, $budget12, $flags));
179 ok
(CanUserUseBudget
($borrower2, $budget9, $flags));
180 ok
(CanUserUseBudget
($borrower2, $budget10, $flags));
181 ok
(CanUserUseBudget
($borrower2, $budget11, $flags));
182 ok
(CanUserUseBudget
($borrower2, $budget12, $flags));
184 # Restriction is 'owner and users'
185 ok
(!CanUserUseBudget
($borrower1, $budget13, $flags)); # No user, no owner
186 ok
(CanUserUseBudget
($borrower1, $budget14, $flags));
187 ok
(CanUserUseBudget
($borrower1, $budget15, $flags));
188 ok
(CanUserUseBudget
($borrower1, $budget16, $flags));
189 ok
(!CanUserUseBudget
($borrower2, $budget13, $flags)); # No user, no owner
190 ok
(!CanUserUseBudget
($borrower2, $budget14, $flags)); # No owner and user list contains borrower1
191 ok
(CanUserUseBudget
($borrower2, $budget15, $flags));
192 ok
(!CanUserUseBudget
($borrower2, $budget16, $flags));
195 $userenv->{branch
} = 'B2';
197 # Restriction is 'none'
198 ok
(CanUserUseBudget
($borrower1, $budget1, $flags));
199 ok
(CanUserUseBudget
($borrower1, $budget2, $flags));
200 ok
(CanUserUseBudget
($borrower1, $budget3, $flags));
201 ok
(CanUserUseBudget
($borrower1, $budget4, $flags));
202 ok
(CanUserUseBudget
($borrower2, $budget1, $flags));
203 ok
(CanUserUseBudget
($borrower2, $budget2, $flags));
204 ok
(CanUserUseBudget
($borrower2, $budget3, $flags));
205 ok
(CanUserUseBudget
($borrower2, $budget4, $flags));
207 # Restriction is 'owner'
208 ok
(CanUserUseBudget
($borrower1, $budget5, $flags));
209 ok
(CanUserUseBudget
($borrower1, $budget6, $flags));
210 ok
(CanUserUseBudget
($borrower1, $budget7, $flags));
211 ok
(CanUserUseBudget
($borrower1, $budget8, $flags));
212 ok
(CanUserUseBudget
($borrower2, $budget5, $flags));
213 ok
(CanUserUseBudget
($borrower2, $budget6, $flags));
214 ok
(!CanUserUseBudget
($borrower2, $budget7, $flags));
215 ok
(!CanUserUseBudget
($borrower2, $budget8, $flags));
217 # Restriction is 'owner, users and library'
218 ok
(CanUserUseBudget
($borrower1, $budget9, $flags));
219 ok
(CanUserUseBudget
($borrower1, $budget10, $flags));
220 ok
(CanUserUseBudget
($borrower1, $budget11, $flags));
221 ok
(CanUserUseBudget
($borrower1, $budget12, $flags));
222 ok
(CanUserUseBudget
($borrower2, $budget9, $flags));
223 ok
(!CanUserUseBudget
($borrower2, $budget10, $flags)); # Limited to library B1
224 ok
(CanUserUseBudget
($borrower2, $budget11, $flags));
225 ok
(!CanUserUseBudget
($borrower2, $budget12, $flags));
227 # Restriction is 'owner and users'
228 ok
(!CanUserUseBudget
($borrower1, $budget13, $flags)); # No owner, no user
229 ok
(CanUserUseBudget
($borrower1, $budget14, $flags));
230 ok
(CanUserUseBudget
($borrower1, $budget15, $flags));
231 ok
(CanUserUseBudget
($borrower1, $budget16, $flags));
232 ok
(!CanUserUseBudget
($borrower2, $budget13, $flags)); # No owner, no user
233 ok
(!CanUserUseBudget
($borrower2, $budget14, $flags)); # No owner and user list contains borrower1
234 ok
(CanUserUseBudget
($borrower2, $budget15, $flags));
235 ok
(!CanUserUseBudget
($borrower2, $budget16, $flags));
240 # C4::Acquisition::GetBudgetUsers
241 sub Mock_GetBudgetUsers
{
242 my ($budget_id) = @_;
244 return @
{ $budgetusers{$budget_id} };
247 # C4::Context->userenv