3 use Test
::More tests
=> 142;
11 use C4
::Members
qw( AddMember );
13 use Koha
::Acquisition
::Order
;
14 use Koha
::Acquisition
::Booksellers
;
16 use t
::lib
::TestBuilder
;
20 my $schema = Koha
::Database
->new->schema;
21 $schema->storage->txn_begin;
22 my $builder = t
::lib
::TestBuilder
->new;
23 my $dbh = C4
::Context
->dbh;
24 $dbh->do(q
|DELETE FROM aqbudgetperiods
|);
25 $dbh->do(q
|DELETE FROM aqbudgets
|);
27 my $library = $builder->build({
32 local $SIG{__WARN__
} = sub { warn $_[0] unless $_[0] =~ /redefined/ };
34 *C4
::Context
::userenv
= \
&Mock_userenv
;
35 $userenv = { flags
=> 1, id
=> 'my_userid', branch
=> $library->{branchcode
} };
41 is
( AddBudgetPeriod
(), undef, 'AddBugetPeriod without argument returns undef' );
42 is
( AddBudgetPeriod
( { } ), undef, 'AddBugetPeriod with an empty argument returns undef' );
43 my $bpid = AddBudgetPeriod
({
44 budget_period_startdate
=> '2008-01-01',
46 is
( $bpid, undef, 'AddBugetPeriod without end date returns undef' );
47 $bpid = AddBudgetPeriod
({
48 budget_period_enddate
=> '2008-12-31',
50 is
( $bpid, undef, 'AddBugetPeriod without start date returns undef' );
51 is
( GetBudgetPeriod
(0), undef ,'GetBudgetPeriod(0) returned undef : noactive BudgetPeriod' );
52 my $budgetperiods = GetBudgetPeriods
();
53 is
( @
$budgetperiods, 0, 'GetBudgetPeriods returns the correct number of budget periods' );
55 my $my_budgetperiod = {
56 budget_period_startdate
=> '2008-01-01',
57 budget_period_enddate
=> '2008-12-31',
58 budget_period_description
=> 'MAPERI',
59 budget_period_active
=> 0,
61 $bpid = AddBudgetPeriod
($my_budgetperiod);
62 isnt
( $bpid, undef, 'AddBugetPeriod does not returns undef' );
63 my $budgetperiod = GetBudgetPeriod
($bpid);
64 is
( $budgetperiod->{budget_period_startdate
}, $my_budgetperiod->{budget_period_startdate
}, 'AddBudgetPeriod stores the start date correctly' );
65 is
( $budgetperiod->{budget_period_enddate
}, $my_budgetperiod->{budget_period_enddate
}, 'AddBudgetPeriod stores the end date correctly' );
66 is
( $budgetperiod->{budget_period_description
}, $my_budgetperiod->{budget_period_description
}, 'AddBudgetPeriod stores the description correctly' );
67 is
( $budgetperiod->{budget_period_active
}, $my_budgetperiod->{budget_period_active
}, 'AddBudgetPeriod stores active correctly' );
68 is
( GetBudgetPeriod
(0), undef ,'GetBudgetPeriod(0) returned undef : noactive BudgetPeriod' );
72 budget_period_startdate
=> '2009-01-01',
73 budget_period_enddate
=> '2009-12-31',
74 budget_period_description
=> 'MODIF_MAPERI',
75 budget_period_active
=> 1,
77 my $mod_status = ModBudgetPeriod
($my_budgetperiod);
78 is
( $mod_status, undef, 'ModBudgetPeriod without id returns undef' );
80 $my_budgetperiod->{budget_period_id
} = $bpid;
81 $mod_status = ModBudgetPeriod
($my_budgetperiod);
82 is
( $mod_status, 1, 'ModBudgetPeriod returnis true' );
83 $budgetperiod = GetBudgetPeriod
($bpid);
84 is
( $budgetperiod->{budget_period_startdate
}, $my_budgetperiod->{budget_period_startdate
}, 'ModBudgetPeriod updates the start date correctly' );
85 is
( $budgetperiod->{budget_period_enddate
}, $my_budgetperiod->{budget_period_enddate
}, 'ModBudgetPeriod updates the end date correctly' );
86 is
( $budgetperiod->{budget_period_description
}, $my_budgetperiod->{budget_period_description
}, 'ModBudgetPeriod updates the description correctly' );
87 is
( $budgetperiod->{budget_period_active
}, $my_budgetperiod->{budget_period_active
}, 'ModBudgetPeriod upates active correctly' );
88 isnt
( GetBudgetPeriod
(0), undef, 'GetBugetPeriods functions correctly' );
91 $budgetperiods = GetBudgetPeriods
();
92 is
( @
$budgetperiods, 1, 'GetBudgetPeriods returns the correct number of budget periods' );
93 is
( $budgetperiods->[0]->{budget_period_id
}, $my_budgetperiod->{budget_period_id
}, 'GetBudgetPeriods returns the id correctly' );
94 is
( $budgetperiods->[0]->{budget_period_startdate
}, $my_budgetperiod->{budget_period_startdate
}, 'GetBudgetPeriods returns the start date correctly' );
95 is
( $budgetperiods->[0]->{budget_period_enddate
}, $my_budgetperiod->{budget_period_enddate
}, 'GetBudgetPeriods returns the end date correctly' );
96 is
( $budgetperiods->[0]->{budget_period_description
}, $my_budgetperiod->{budget_period_description
}, 'GetBudgetPeriods returns the description correctly' );
97 is
( $budgetperiods->[0]->{budget_period_active
}, $my_budgetperiod->{budget_period_active
}, 'GetBudgetPeriods returns active correctly' );
99 is
( DelBudgetPeriod
($bpid), 1, 'DelBudgetPeriod returns true' );
100 $budgetperiods = GetBudgetPeriods
();
101 is
( @
$budgetperiods, 0, 'GetBudgetPeriods returns the correct number of budget periods' );
108 # The budget hierarchy will be:
116 is
( AddBudget
(), undef, 'AddBuget without argument returns undef' );
117 my $budgets = GetBudgets
();
118 is
( @
$budgets, 0, 'GetBudgets returns the correct number of budgets' );
120 $bpid = AddBudgetPeriod
($my_budgetperiod); #this is an active budget
123 budget_code
=> 'ABCD',
124 budget_amount
=> '123.132000',
125 budget_name
=> 'Periodiques',
126 budget_notes
=> 'This is a note',
127 budget_period_id
=> $bpid,
129 my $budget_id = AddBudget
($my_budget);
130 isnt
( $budget_id, undef, 'AddBudget does not returns undef' );
131 my $budget = GetBudget
($budget_id);
132 is
( $budget->{budget_code
}, $my_budget->{budget_code
}, 'AddBudget stores the budget code correctly' );
133 is
( $budget->{budget_amount
}, $my_budget->{budget_amount
}, 'AddBudget stores the budget amount correctly' );
134 is
( $budget->{budget_name
}, $my_budget->{budget_name
}, 'AddBudget stores the budget name correctly' );
135 is
( $budget->{budget_notes
}, $my_budget->{budget_notes
}, 'AddBudget stores the budget notes correctly' );
136 is
( $budget->{budget_period_id
}, $my_budget->{budget_period_id
}, 'AddBudget stores the budget period id correctly' );
140 budget_code
=> 'EFG',
141 budget_amount
=> '321.231000',
142 budget_name
=> 'Modified name',
143 budget_notes
=> 'This is a modified note',
144 budget_period_id
=> $bpid,
146 $mod_status = ModBudget
($my_budget);
147 is
( $mod_status, undef, 'ModBudget without id returns undef' );
149 $my_budget->{budget_id
} = $budget_id;
150 $mod_status = ModBudget
($my_budget);
151 is
( $mod_status, 1, 'ModBudget returns true' );
152 $budget = GetBudget
($budget_id);
153 is
( $budget->{budget_code
}, $my_budget->{budget_code
}, 'ModBudget updates the budget code correctly' );
154 is
( $budget->{budget_amount
}, $my_budget->{budget_amount
}, 'ModBudget updates the budget amount correctly' );
155 is
( $budget->{budget_name
}, $my_budget->{budget_name
}, 'ModBudget updates the budget name correctly' );
156 is
( $budget->{budget_notes
}, $my_budget->{budget_notes
}, 'ModBudget updates the budget notes correctly' );
157 is
( $budget->{budget_period_id
}, $my_budget->{budget_period_id
}, 'ModBudget updates the budget period id correctly' );
160 $budgets = GetBudgets
();
161 is
( @
$budgets, 1, 'GetBudgets returns the correct number of budgets' );
162 is
( $budgets->[0]->{budget_id
}, $my_budget->{budget_id
}, 'GetBudgets returns the budget id correctly' );
163 is
( $budgets->[0]->{budget_code
}, $my_budget->{budget_code
}, 'GetBudgets returns the budget code correctly' );
164 is
( $budgets->[0]->{budget_amount
}, $my_budget->{budget_amount
}, 'GetBudgets returns the budget amount correctly' );
165 is
( $budgets->[0]->{budget_name
}, $my_budget->{budget_name
}, 'GetBudgets returns the budget name correctly' );
166 is
( $budgets->[0]->{budget_notes
}, $my_budget->{budget_notes
}, 'GetBudgets returns the budget notes correctly' );
167 is
( $budgets->[0]->{budget_period_id
}, $my_budget->{budget_period_id
}, 'GetBudgets returns the budget period id correctly' );
169 $budgets = GetBudgets
( {budget_period_id
=> $bpid} );
170 is
( @
$budgets, 1, 'GetBudgets With Filter OK' );
171 $budgets = GetBudgets
( {budget_period_id
=> $bpid}, {-asc
=> "budget_name"} );
172 is
( @
$budgets, 1, 'GetBudgets With Order OK' );
173 $budgets = GetBudgets
( {budget_period_id
=> GetBudgetPeriod
($bpid)->{budget_period_id
}}, {-asc
=> "budget_name"} );
174 is
( @
$budgets, 1, 'GetBudgets With Order Getting Active budgetPeriod OK');
177 my $budget_name = GetBudgetName
( $budget_id );
178 is
($budget_name, $my_budget->{budget_name
}, "Test the GetBudgetName routine");
180 my $my_inactive_budgetperiod = { #let's add an inactive
181 budget_period_startdate
=> '2010-01-01',
182 budget_period_enddate
=> '2010-12-31',
183 budget_period_description
=> 'MODIF_MAPERI',
184 budget_period_active
=> 0,
186 my $bpid_i = AddBudgetPeriod
($my_inactive_budgetperiod); #this is an inactive budget
188 my $my_budget_inactive = {
189 budget_code
=> 'EFG',
190 budget_amount
=> '123.132000',
191 budget_name
=> 'Periodiques',
192 budget_notes
=> 'This is a note',
193 budget_period_id
=> $bpid_i,
195 my $budget_id_inactive = AddBudget
($my_budget_inactive);
197 my $budget_code = $my_budget->{budget_code
};
198 my $budget_by_code = GetBudgetByCode
( $budget_code );
199 is
($budget_by_code->{budget_id
}, $budget_id, "GetBudgetByCode, check id"); #this should match the active budget, not the inactive
200 is
($budget_by_code->{budget_notes
}, $my_budget->{budget_notes
}, "GetBudgetByCode, check notes");
202 my $second_budget_id = AddBudget
({
203 budget_code
=> "ZZZZ",
204 budget_amount
=> "500.00",
205 budget_name
=> "Art",
206 budget_notes
=> "This is a note",
207 budget_period_id
=> $bpid,
209 isnt
( $second_budget_id, undef, 'AddBudget does not returns undef' );
211 $budgets = GetBudgets
( {budget_period_id
=> $bpid} );
212 ok
( $budgets->[0]->{budget_name
} lt $budgets->[1]->{budget_name
}, 'default sort order for GetBudgets is by name' );
214 is
( DelBudget
($budget_id), 1, 'DelBudget returns true' );
215 $budgets = GetBudgets
();
216 is
( @
$budgets, 2, 'GetBudgets returns the correct number of budget periods' );
219 # GetBudgetHierarchySpent and GetBudgetHierarchyOrdered
220 my $budget_period_total = 10_000
;
221 my $budget_1_total = 1_000
;
222 my $budget_11_total = 100;
223 my $budget_111_total = 50;
224 my $budget_12_total = 100;
225 my $budget_2_total = 2_000
;
227 my $budget_period_id = AddBudgetPeriod
(
229 budget_period_startdate
=> '2013-01-01',
230 budget_period_enddate
=> '2014-12-31',
231 budget_period_description
=> 'Budget Period',
232 budget_period_active
=> 1,
233 budget_period_total
=> $budget_period_total,
236 my $budget_id1 = AddBudget
(
238 budget_code
=> 'budget_1',
239 budget_name
=> 'budget_1',
240 budget_period_id
=> $budget_period_id,
241 budget_parent_id
=> undef,
242 budget_amount
=> $budget_1_total,
245 my $budget_id2 = AddBudget
(
247 budget_code
=> 'budget_2',
248 budget_name
=> 'budget_2',
249 budget_period_id
=> $budget_period_id,
250 budget_parent_id
=> undef,
251 budget_amount
=> $budget_2_total,
254 my $budget_id12 = AddBudget
(
256 budget_code
=> 'budget_12',
257 budget_name
=> 'budget_12',
258 budget_period_id
=> $budget_period_id,
259 budget_parent_id
=> $budget_id1,
260 budget_amount
=> $budget_12_total,
263 my $budget_id11 = AddBudget
(
265 budget_code
=> 'budget_11',
266 budget_name
=> 'budget_11',
267 budget_period_id
=> $budget_period_id,
268 budget_parent_id
=> $budget_id1,
269 budget_amount
=> $budget_11_total,
272 my $budget_id111 = AddBudget
(
274 budget_code
=> 'budget_111',
275 budget_name
=> 'budget_111',
276 budget_period_id
=> $budget_period_id,
277 budget_parent_id
=> $budget_id11,
278 budget_owner_id
=> 1,
279 budget_amount
=> $budget_111_total,
282 my $budget_id21 = AddBudget
(
284 budget_code
=> 'budget_21',
285 budget_name
=> 'budget_21',
286 budget_period_id
=> $budget_period_id,
287 budget_parent_id
=> $budget_id2,
291 my $bookseller = Koha
::Acquisition
::Bookseller
->new(
294 address1
=> "bookseller's address",
300 my $booksellerid = $bookseller->id;
302 my $basketno = C4
::Acquisition
::NewBasket
( $booksellerid, 1 );
303 my ( $biblionumber, $biblioitemnumber ) =
304 C4
::Biblio
::AddBiblio
( MARC
::Record
->new, '' );
308 budget_id
=> $budget_id1,
309 pending_quantity
=> 1,
313 budget_id
=> $budget_id2,
314 pending_quantity
=> 2,
318 budget_id
=> $budget_id11,
319 pending_quantity
=> 3,
323 budget_id
=> $budget_id12,
324 pending_quantity
=> 4,
328 budget_id
=> $budget_id111,
329 pending_quantity
=> 2,
333 # No order for budget_21
338 my $invoiceid = AddInvoice
(invoicenumber
=> 'invoice_test_clone', booksellerid
=> $booksellerid, unknown
=> "unknown");
339 my $invoice = GetInvoice
( $invoiceid );
341 my $item_quantity = 2;
342 my $number_of_orders_to_move = 0;
343 for my $infos (@order_infos) {
344 for ( 1 .. $infos->{pending_quantity
} ) {
345 my $order = Koha
::Acquisition
::Order
->new(
347 basketno
=> $basketno,
348 biblionumber
=> $biblionumber,
349 budget_id
=> $infos->{budget_id
},
350 order_internalnote
=> "internal note",
351 order_vendornote
=> "vendor note",
353 cost_tax_included
=> $item_price,
354 rrp_tax_included
=> $item_price,
355 listprice
=> $item_price,
356 ecost_tax_include
=> $item_price,
361 my $ordernumber = $order->{ordernumber
};
362 push @
{ $budgets{$infos->{budget_id
}} }, $ordernumber;
363 $number_of_orders_to_move++;
365 for ( 1 .. $infos->{spent_quantity
} ) {
366 my $order = Koha
::Acquisition
::Order
->new(
368 basketno
=> $basketno,
369 biblionumber
=> $biblionumber,
370 budget_id
=> $infos->{budget_id
},
371 order_internalnote
=> "internal note",
372 order_vendornote
=> "vendor note",
373 quantity
=> $item_quantity,
375 rrp_tax_included
=> $item_price,
376 listprice
=> $item_price,
377 ecost_tax_included
=> $item_price,
382 my $ordernumber = $order->{ordernumber
};
384 biblionumber
=> $biblionumber,
386 budget_id
=> $infos->{budget_id
},
387 quantityreceived
=> $item_quantity,
389 received_items
=> [],
393 is
( GetBudgetHierarchySpent
( $budget_id1 ), 160, "total spent for budget1 is 160" );
394 is
( GetBudgetHierarchySpent
( $budget_id11 ), 100, "total spent for budget11 is 100" );
395 is
( GetBudgetHierarchySpent
( $budget_id111 ), 20, "total spent for budget111 is 20" );
398 my $budget_period_id_cloned = C4
::Budgets
::CloneBudgetPeriod
(
400 budget_period_id
=> $budget_period_id,
401 budget_period_startdate
=> '2014-01-01',
402 budget_period_enddate
=> '2014-12-31',
403 budget_period_description
=> 'Budget Period Cloned',
407 my $budget_period_cloned = C4
::Budgets
::GetBudgetPeriod
($budget_period_id_cloned);
408 is
($budget_period_cloned->{budget_period_description
}, 'Budget Period Cloned', 'Cloned budget\'s description is updated.');
410 my $budget_hierarchy = GetBudgetHierarchy
($budget_period_id);
411 my $budget_hierarchy_cloned = GetBudgetHierarchy
($budget_period_id_cloned);
414 scalar(@
$budget_hierarchy_cloned),
415 scalar(@
$budget_hierarchy),
416 'CloneBudgetPeriod clones the same number of budgets (funds)'
419 _get_dependencies
($budget_hierarchy),
420 _get_dependencies
($budget_hierarchy_cloned),
421 'CloneBudgetPeriod keeps the same dependencies order'
424 # CloneBudgetPeriod with param mark_original_budget_as_inactive
425 my $budget_period = C4
::Budgets
::GetBudgetPeriod
($budget_period_id);
426 is
( $budget_period->{budget_period_active
}, 1,
427 'CloneBudgetPeriod does not mark as inactive the budgetperiod if not needed'
430 $budget_hierarchy_cloned = GetBudgetHierarchy
($budget_period_id_cloned);
431 my $number_of_budgets_not_reset = 0;
432 for my $budget (@
$budget_hierarchy_cloned) {
433 $number_of_budgets_not_reset++ if $budget->{budget_amount
} > 0;
435 is
( $number_of_budgets_not_reset, 5,
436 'CloneBudgetPeriod does not reset budgets (funds) if not needed' );
438 $budget_period_id_cloned = C4
::Budgets
::CloneBudgetPeriod
(
440 budget_period_id
=> $budget_period_id,
441 budget_period_startdate
=> '2014-01-01',
442 budget_period_enddate
=> '2014-12-31',
443 mark_original_budget_as_inactive
=> 1,
447 $budget_hierarchy = GetBudgetHierarchy
($budget_period_id);
448 is
( $budget_hierarchy->[0]->{children
}->[0]->{budget_name
}, 'budget_11', 'GetBudgetHierarchy should return budgets ordered by name, first child is budget_11' );
449 is
( $budget_hierarchy->[0]->{children
}->[1]->{budget_name
}, 'budget_12', 'GetBudgetHierarchy should return budgets ordered by name, second child is budget_12' );
450 is
($budget_hierarchy->[0]->{budget_name
},'budget_1','GetBudgetHierarchy should return budgets ordered by name, first budget is budget_1');
451 is
($budget_hierarchy->[0]->{budget_level
},'0','budget_level of budget (budget_1) should be 0');
452 is
($budget_hierarchy->[0]->{children
}->[0]->{budget_level
},'1','budget_level of first fund(budget_11) should be 1');
453 is
($budget_hierarchy->[0]->{children
}->[1]->{budget_level
},'1','budget_level of second fund(budget_12) should be 1');
454 is
($budget_hierarchy->[0]->{children
}->[0]->{children
}->[0]->{budget_level
},'2','budget_level of child fund budget_11 should be 2');
455 $budget_hierarchy = GetBudgetHierarchy
($budget_period_id);
456 $budget_hierarchy_cloned = GetBudgetHierarchy
($budget_period_id_cloned);
458 is
( scalar(@
$budget_hierarchy_cloned), scalar(@
$budget_hierarchy),
459 'CloneBudgetPeriod (with inactive param) clones the same number of budgets (funds)'
462 _get_dependencies
($budget_hierarchy),
463 _get_dependencies
($budget_hierarchy_cloned),
464 'CloneBudgetPeriod (with inactive param) keeps the same dependencies order'
466 $budget_period = C4
::Budgets
::GetBudgetPeriod
($budget_period_id);
467 is
( $budget_period->{budget_period_active
}, 0,
468 'CloneBudgetPeriod (with inactive param) marks as inactive the budgetperiod'
471 # CloneBudgetPeriod with param reset_all_budgets
472 $budget_period_id_cloned = C4
::Budgets
::CloneBudgetPeriod
(
474 budget_period_id
=> $budget_period_id,
475 budget_period_startdate
=> '2014-01-01',
476 budget_period_enddate
=> '2014-12-31',
477 reset_all_budgets
=> 1,
481 $budget_hierarchy_cloned = GetBudgetHierarchy
($budget_period_id_cloned);
482 $number_of_budgets_not_reset = 0;
483 for my $budget (@
$budget_hierarchy_cloned) {
484 $number_of_budgets_not_reset++ if $budget->{budget_amount
} > 0;
486 is
( $number_of_budgets_not_reset, 0,
487 'CloneBudgetPeriod has reset all budgets (funds)' );
489 #GetBudgetsByActivity
490 my $result=C4
::Budgets
::GetBudgetsByActivity
(1);
491 isnt
( $result, undef ,'GetBudgetsByActivity return correct value with parameter 1');
492 $result=C4
::Budgets
::GetBudgetsByActivity
(0);
493 isnt
( $result, undef ,'GetBudgetsByActivity return correct value with parameter 0');
494 $result=C4
::Budgets
::GetBudgetsByActivity
();
495 is
( $result, 0 , 'GetBudgetsByActivity return 0 with none parameter or other 0 or 1' );
496 DelBudget
($budget_id);
497 DelBudgetPeriod
($bpid);
499 # CloneBudgetPeriod with param amount_change_*
500 $budget_period_id_cloned = C4
::Budgets
::CloneBudgetPeriod
(
502 budget_period_id
=> $budget_period_id,
503 budget_period_startdate
=> '2014-01-01',
504 budget_period_enddate
=> '2014-12-31',
505 amount_change_percentage
=> 16,
506 amount_change_round_increment
=> 5,
510 $budget_period_cloned = C4
::Budgets
::GetBudgetPeriod
($budget_period_id_cloned);
511 cmp_ok
($budget_period_cloned->{budget_period_total
}, '==', 11600, "CloneBudgetPeriod changed correctly budget amount");
512 $budget_hierarchy_cloned = GetBudgetHierarchy
($budget_period_id_cloned);
513 cmp_ok
($budget_hierarchy_cloned->[0]->{budget_amount
}, '==', 1160, "CloneBudgetPeriod changed correctly funds amounts");
514 cmp_ok
($budget_hierarchy_cloned->[1]->{budget_amount
}, '==', 115, "CloneBudgetPeriod changed correctly funds amounts");
515 cmp_ok
($budget_hierarchy_cloned->[2]->{budget_amount
}, '==', 55, "CloneBudgetPeriod changed correctly funds amounts");
516 cmp_ok
($budget_hierarchy_cloned->[3]->{budget_amount
}, '==', 115, "CloneBudgetPeriod changed correctly funds amounts");
517 cmp_ok
($budget_hierarchy_cloned->[4]->{budget_amount
}, '==', 2320, "CloneBudgetPeriod changed correctly funds amounts");
518 cmp_ok
($budget_hierarchy_cloned->[5]->{budget_amount
}, '==', 0, "CloneBudgetPeriod changed correctly funds amounts");
520 $budget_period_id_cloned = C4
::Budgets
::CloneBudgetPeriod
(
522 budget_period_id
=> $budget_period_id,
523 budget_period_startdate
=> '2014-01-01',
524 budget_period_enddate
=> '2014-12-31',
525 amount_change_percentage
=> 16,
526 amount_change_round_increment
=> 5,
527 reset_all_budgets
=> 1,
530 $budget_hierarchy_cloned = GetBudgetHierarchy
($budget_period_id_cloned);
531 cmp_ok
($budget_hierarchy_cloned->[0]->{budget_amount
}, '==', 0, "CloneBudgetPeriod reset all fund amounts");
534 my $number_orders_moved = C4
::Budgets
::MoveOrders
();
535 is
( $number_orders_moved, undef, 'MoveOrders return undef if no arg passed' );
536 $number_orders_moved =
537 C4
::Budgets
::MoveOrders
( { from_budget_period_id
=> $budget_period_id } );
538 is
( $number_orders_moved, undef,
539 'MoveOrders return undef if only 1 arg passed' );
540 $number_orders_moved =
541 C4
::Budgets
::MoveOrders
( { to_budget_period_id
=> $budget_period_id } );
542 is
( $number_orders_moved, undef,
543 'MoveOrders return undef if only 1 arg passed' );
544 $number_orders_moved = C4
::Budgets
::MoveOrders
(
546 from_budget_period_id
=> $budget_period_id,
547 to_budget_period_id
=> $budget_period_id
550 is
( $number_orders_moved, undef,
551 'MoveOrders return undef if 2 budget period id are the same' );
553 $budget_period_id_cloned = C4
::Budgets
::CloneBudgetPeriod
(
555 budget_period_id
=> $budget_period_id,
556 budget_period_startdate
=> '2014-01-01',
557 budget_period_enddate
=> '2014-12-31',
561 my $report = C4
::Budgets
::MoveOrders
(
563 from_budget_period_id
=> $budget_period_id,
564 to_budget_period_id
=> $budget_period_id_cloned,
565 move_remaining_unspent
=> 1,
568 is
( scalar( @
$report ), 6 , "MoveOrders has processed 6 funds" );
570 my $number_of_orders_moved = 0;
571 $number_of_orders_moved += scalar( @
{ $_->{orders_moved
} } ) for @
$report;
572 is
( $number_of_orders_moved, $number_of_orders_to_move, "MoveOrders has moved $number_of_orders_to_move orders" );
574 my @new_budget_ids = map { $_->{budget_id
} }
575 @
{ C4
::Budgets
::GetBudgetHierarchy
($budget_period_id_cloned) };
576 my @old_budget_ids = map { $_->{budget_id
} }
577 @
{ C4
::Budgets
::GetBudgetHierarchy
($budget_period_id) };
578 for my $budget_id ( keys %budgets ) {
579 for my $ordernumber ( @
{ $budgets{$budget_id} } ) {
580 my $budget = GetBudgetByOrderNumber
($ordernumber);
581 my $is_in_new_budgets = grep /^$budget->{budget_id}$/, @new_budget_ids;
582 my $is_in_old_budgets = grep /^$budget->{budget_id}$/, @old_budget_ids;
583 is
( $is_in_new_budgets, 1, "MoveOrders changed the budget_id for order $ordernumber" );
584 is
( $is_in_old_budgets, 0, "MoveOrders changed the budget_id for order $ordernumber" );
589 # MoveOrders with param move_remaining_unspent
590 my @new_budgets = @
{ C4
::Budgets
::GetBudgetHierarchy
($budget_period_id_cloned) };
591 my @old_budgets = @
{ C4
::Budgets
::GetBudgetHierarchy
($budget_period_id) };
593 for my $new_budget ( @new_budgets ) {
594 my ( $old_budget ) = map { $_->{budget_code
} eq $new_budget->{budget_code
} ?
$_ : () } @old_budgets;
595 my $new_budget_amount_should_be = $old_budget->{budget_amount
} * 2 - $old_budget->{total_spent
};
596 is
( $new_budget->{budget_amount
} + 0, $new_budget_amount_should_be, "MoveOrders updated the budget amount with the previous unspent budget (for budget $new_budget->{budget_code})" );
599 # Test SetOwnerToFundHierarchy
601 my $patron_category = $builder->build({ source
=> 'Category' });
602 my $branchcode = $library->{branchcode
};
603 my $john_doe = C4
::Members
::AddMember
(
604 cardnumber
=> '123456',
607 categorycode
=> $patron_category->{categorycode
},
608 branchcode
=> $branchcode,
610 dateexpiry
=> '9999-12-31',
614 C4
::Budgets
::SetOwnerToFundHierarchy
( $budget_id1, $john_doe );
615 is
( C4
::Budgets
::GetBudget
($budget_id1)->{budget_owner_id
},
616 $john_doe, "SetOwnerToFundHierarchy should have set John Doe for budget 1 ($budget_id1)" );
617 is
( C4
::Budgets
::GetBudget
($budget_id11)->{budget_owner_id
},
618 $john_doe, "SetOwnerToFundHierarchy should have set John Doe for budget 11 ($budget_id11)" );
619 is
( C4
::Budgets
::GetBudget
($budget_id111)->{budget_owner_id
},
620 $john_doe, "SetOwnerToFundHierarchy should have set John Doe for budget 111 ($budget_id111)" );
621 is
( C4
::Budgets
::GetBudget
($budget_id12)->{budget_owner_id
},
622 $john_doe, "SetOwnerToFundHierarchy should have set John Doe for budget 12 ($budget_id12 )" );
623 is
( C4
::Budgets
::GetBudget
($budget_id2)->{budget_owner_id
},
624 undef, "SetOwnerToFundHierarchy should not have set an owner for budget 2 ($budget_id2)" );
625 is
( C4
::Budgets
::GetBudget
($budget_id21)->{budget_owner_id
},
626 undef, "SetOwnerToFundHierarchy should not have set an owner for budget 21 ($budget_id21)" );
628 my $jane_doe = C4
::Members
::AddMember
(
629 cardnumber
=> '789012',
632 categorycode
=> $patron_category->{categorycode
},
633 branchcode
=> $branchcode,
635 dateexpiry
=> '9999-12-31',
639 C4
::Budgets
::SetOwnerToFundHierarchy
( $budget_id11, $jane_doe );
640 is
( C4
::Budgets
::GetBudget
($budget_id1)->{budget_owner_id
},
641 $john_doe, "SetOwnerToFundHierarchy should have set John Doe $john_doe for budget 1 ($budget_id1)" );
642 is
( C4
::Budgets
::GetBudget
($budget_id11)->{budget_owner_id
},
643 $jane_doe, "SetOwnerToFundHierarchy should have set John Doe $jane_doe for budget 11 ($budget_id11)" );
644 is
( C4
::Budgets
::GetBudget
($budget_id111)->{budget_owner_id
},
645 $jane_doe, "SetOwnerToFundHierarchy should have set John Doe $jane_doe for budget 111 ($budget_id111)" );
646 is
( C4
::Budgets
::GetBudget
($budget_id12)->{budget_owner_id
},
647 $john_doe, "SetOwnerToFundHierarchy should have set John Doe $john_doe for budget 12 ($budget_id12 )" );
648 is
( C4
::Budgets
::GetBudget
($budget_id2)->{budget_owner_id
},
649 undef, "SetOwnerToFundHierarchy should have set John Doe $john_doe for budget 2 ($budget_id2)" );
650 is
( C4
::Budgets
::GetBudget
($budget_id21)->{budget_owner_id
},
651 undef, "SetOwnerToFundHierarchy should have set John Doe $john_doe for budget 21 ($budget_id21)" );
653 # Test GetBudgetAuthCats
655 my $budgetPeriodId = AddBudgetPeriod
({
656 budget_period_startdate
=> '2008-01-01',
657 budget_period_enddate
=> '2008-12-31',
658 budget_period_description
=> 'just another budget',
659 budget_period_active
=> 0,
662 $budgets = GetBudgets
();
664 for my $budget ( @
$budgets )
666 $budget->{sort1_authcat
} = "sort1_authcat_$i";
667 $budget->{sort2_authcat
} = "sort2_authcat_$i";
668 $budget->{budget_period_id
} = $budgetPeriodId;
669 ModBudget
( $budget );
673 my $authCat = GetBudgetAuthCats
($budgetPeriodId);
675 is
( scalar @
{$authCat}, $i * 2, "GetBudgetAuthCats returns only non-empty sorting categories (no empty authCat in db)" );
678 for my $budget ( @
$budgets )
680 $budget->{sort1_authcat
} = "sort_authcat_$i";
681 $budget->{sort2_authcat
} = "sort_authcat_$i";
682 $budget->{budget_period_id
} = $budgetPeriodId;
683 ModBudget
( $budget );
687 $authCat = GetBudgetAuthCats
($budgetPeriodId);
688 is
( scalar @
$authCat, scalar @
$budgets, "GetBudgetAuthCats returns distinct authCat" );
691 for my $budget ( @
$budgets )
693 $budget->{sort1_authcat
} = "sort1_authcat_$i";
694 $budget->{sort2_authcat
} = "";
695 $budget->{budget_period_id
} = $budgetPeriodId;
696 ModBudget
( $budget );
700 $authCat = GetBudgetAuthCats
($budgetPeriodId);
702 is
( scalar @
{$authCat}, $i, "GetBudgetAuthCats returns only non-empty sorting categories (empty sort2_authcat on all records)" );
705 for my $budget ( @
$budgets )
707 $budget->{sort1_authcat
} = "";
708 $budget->{sort2_authcat
} = "";
709 $budget->{budget_period_id
} = $budgetPeriodId;
710 ModBudget
( $budget );
714 $authCat = GetBudgetAuthCats
($budgetPeriodId);
716 is
( scalar @
{$authCat}, 0, "GetBudgetAuthCats returns only non-empty sorting categories (all empty)" );
718 # /Test GetBudgetAuthCats
720 sub _get_dependencies
{
721 my ($budget_hierarchy) = @_;
723 for my $budget (@
$budget_hierarchy) {
724 if ( $budget->{child
} ) {
725 my @sorted = sort @
{ $budget->{child
} };
726 for my $child_id (@sorted) {
727 push @
{ $graph->{ $budget->{budget_name
} }{children
} },
728 _get_budgetname_by_id
( $budget_hierarchy, $child_id );
731 push @
{ $graph->{ $budget->{budget_name
} }{parents
} },
732 $budget->{parent_id
};
737 sub _get_budgetname_by_id
{
738 my ( $budgets, $budget_id ) = @_;
740 map { ( $_->{budget_id
} eq $budget_id ) ?
$_->{budget_name
} : () }
745 # C4::Context->userenv