3 use Test
::More tests
=> 144;
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" );
397 # GetBudgetSpent and GetBudgetOrdered
398 my $budget_period_amount = 100;
399 my $budget_amount = 50;
401 $budget = AddBudgetPeriod
(
403 budget_period_startdate
=> '2017-08-22',
404 budget_period_enddate
=> '2018-08-22',
405 budget_period_description
=> 'Test budget',
406 budget_period_active
=> 1,
407 budget_period_total
=> $budget_period_amount,
411 my $fund = AddBudget
(
413 budget_code
=> 'Test fund',
414 budget_name
=> 'Test fund',
415 budget_period_id
=> $budget,
416 budget_parent_id
=> undef,
417 budget_amount
=> $budget_amount,
421 my $vendor = Koha
::Acquisition
::Bookseller
->new(
423 name
=> "test vendor",
424 address1
=> "test address",
431 my $vendorid = $vendor->id;
433 my $basketnumber = C4
::Acquisition
::NewBasket
( $vendorid, 1 );
434 my ( $biblio, $biblioitem ) = C4
::Biblio
::AddBiblio
( MARC
::Record
->new, '' );
439 pending_quantity
=> 1,
444 my $invoiceident = AddInvoice
( invoicenumber
=> 'invoice_test_clone', booksellerid
=> $vendorid, shipmentdate
=> '2017-08-22', shipmentcost
=> 6, shipmentcost_budgetid
=> $fund );
445 my $test_invoice = GetInvoice
( $invoiceident );
446 my $individual_item_price = 10;
448 my $order = Koha
::Acquisition
::Order
->new(
450 basketno
=> $basketnumber,
451 biblionumber
=> $biblio,
453 order_internalnote
=> "internalnote",
454 order_vendornote
=> "vendor note",
456 cost_tax_included
=> $individual_item_price,
457 rrp_tax_included
=> $individual_item_price,
458 listprice
=> $individual_item_price,
459 ecost_tax_included
=> $individual_item_price,
466 bibionumber
=> $biblio,
469 quantityreceived
=> 2,
470 invoice
=> $test_invoice,
471 received_items
=> [],
474 is
( GetBudgetSpent
( $fund ), 6, "total shipping cost is 6");
475 is
( GetBudgetOrdered
( $fund ), '20.000000', "total ordered price is 20");
479 my $budget_period_id_cloned = C4
::Budgets
::CloneBudgetPeriod
(
481 budget_period_id
=> $budget_period_id,
482 budget_period_startdate
=> '2014-01-01',
483 budget_period_enddate
=> '2014-12-31',
484 budget_period_description
=> 'Budget Period Cloned',
488 my $budget_period_cloned = C4
::Budgets
::GetBudgetPeriod
($budget_period_id_cloned);
489 is
($budget_period_cloned->{budget_period_description
}, 'Budget Period Cloned', 'Cloned budget\'s description is updated.');
491 my $budget_hierarchy = GetBudgetHierarchy
($budget_period_id);
492 my $budget_hierarchy_cloned = GetBudgetHierarchy
($budget_period_id_cloned);
495 scalar(@
$budget_hierarchy_cloned),
496 scalar(@
$budget_hierarchy),
497 'CloneBudgetPeriod clones the same number of budgets (funds)'
500 _get_dependencies
($budget_hierarchy),
501 _get_dependencies
($budget_hierarchy_cloned),
502 'CloneBudgetPeriod keeps the same dependencies order'
505 # CloneBudgetPeriod with param mark_original_budget_as_inactive
506 my $budget_period = C4
::Budgets
::GetBudgetPeriod
($budget_period_id);
507 is
( $budget_period->{budget_period_active
}, 1,
508 'CloneBudgetPeriod does not mark as inactive the budgetperiod if not needed'
511 $budget_hierarchy_cloned = GetBudgetHierarchy
($budget_period_id_cloned);
512 my $number_of_budgets_not_reset = 0;
513 for my $budget (@
$budget_hierarchy_cloned) {
514 $number_of_budgets_not_reset++ if $budget->{budget_amount
} > 0;
516 is
( $number_of_budgets_not_reset, 5,
517 'CloneBudgetPeriod does not reset budgets (funds) if not needed' );
519 $budget_period_id_cloned = C4
::Budgets
::CloneBudgetPeriod
(
521 budget_period_id
=> $budget_period_id,
522 budget_period_startdate
=> '2014-01-01',
523 budget_period_enddate
=> '2014-12-31',
524 mark_original_budget_as_inactive
=> 1,
528 $budget_hierarchy = GetBudgetHierarchy
($budget_period_id);
529 is
( $budget_hierarchy->[0]->{children
}->[0]->{budget_name
}, 'budget_11', 'GetBudgetHierarchy should return budgets ordered by name, first child is budget_11' );
530 is
( $budget_hierarchy->[0]->{children
}->[1]->{budget_name
}, 'budget_12', 'GetBudgetHierarchy should return budgets ordered by name, second child is budget_12' );
531 is
($budget_hierarchy->[0]->{budget_name
},'budget_1','GetBudgetHierarchy should return budgets ordered by name, first budget is budget_1');
532 is
($budget_hierarchy->[0]->{budget_level
},'0','budget_level of budget (budget_1) should be 0');
533 is
($budget_hierarchy->[0]->{children
}->[0]->{budget_level
},'1','budget_level of first fund(budget_11) should be 1');
534 is
($budget_hierarchy->[0]->{children
}->[1]->{budget_level
},'1','budget_level of second fund(budget_12) should be 1');
535 is
($budget_hierarchy->[0]->{children
}->[0]->{children
}->[0]->{budget_level
},'2','budget_level of child fund budget_11 should be 2');
536 $budget_hierarchy = GetBudgetHierarchy
($budget_period_id);
537 $budget_hierarchy_cloned = GetBudgetHierarchy
($budget_period_id_cloned);
539 is
( scalar(@
$budget_hierarchy_cloned), scalar(@
$budget_hierarchy),
540 'CloneBudgetPeriod (with inactive param) clones the same number of budgets (funds)'
543 _get_dependencies
($budget_hierarchy),
544 _get_dependencies
($budget_hierarchy_cloned),
545 'CloneBudgetPeriod (with inactive param) keeps the same dependencies order'
547 $budget_period = C4
::Budgets
::GetBudgetPeriod
($budget_period_id);
548 is
( $budget_period->{budget_period_active
}, 0,
549 'CloneBudgetPeriod (with inactive param) marks as inactive the budgetperiod'
552 # CloneBudgetPeriod with param reset_all_budgets
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',
558 reset_all_budgets
=> 1,
562 $budget_hierarchy_cloned = GetBudgetHierarchy
($budget_period_id_cloned);
563 $number_of_budgets_not_reset = 0;
564 for my $budget (@
$budget_hierarchy_cloned) {
565 $number_of_budgets_not_reset++ if $budget->{budget_amount
} > 0;
567 is
( $number_of_budgets_not_reset, 0,
568 'CloneBudgetPeriod has reset all budgets (funds)' );
570 #GetBudgetsByActivity
571 my $result=C4
::Budgets
::GetBudgetsByActivity
(1);
572 isnt
( $result, undef ,'GetBudgetsByActivity return correct value with parameter 1');
573 $result=C4
::Budgets
::GetBudgetsByActivity
(0);
574 isnt
( $result, undef ,'GetBudgetsByActivity return correct value with parameter 0');
575 $result=C4
::Budgets
::GetBudgetsByActivity
();
576 is
( $result, 0 , 'GetBudgetsByActivity return 0 with none parameter or other 0 or 1' );
577 DelBudget
($budget_id);
578 DelBudgetPeriod
($bpid);
580 # CloneBudgetPeriod with param amount_change_*
581 $budget_period_id_cloned = C4
::Budgets
::CloneBudgetPeriod
(
583 budget_period_id
=> $budget_period_id,
584 budget_period_startdate
=> '2014-01-01',
585 budget_period_enddate
=> '2014-12-31',
586 amount_change_percentage
=> 16,
587 amount_change_round_increment
=> 5,
591 $budget_period_cloned = C4
::Budgets
::GetBudgetPeriod
($budget_period_id_cloned);
592 cmp_ok
($budget_period_cloned->{budget_period_total
}, '==', 11600, "CloneBudgetPeriod changed correctly budget amount");
593 $budget_hierarchy_cloned = GetBudgetHierarchy
($budget_period_id_cloned);
594 cmp_ok
($budget_hierarchy_cloned->[0]->{budget_amount
}, '==', 1160, "CloneBudgetPeriod changed correctly funds amounts");
595 cmp_ok
($budget_hierarchy_cloned->[1]->{budget_amount
}, '==', 115, "CloneBudgetPeriod changed correctly funds amounts");
596 cmp_ok
($budget_hierarchy_cloned->[2]->{budget_amount
}, '==', 55, "CloneBudgetPeriod changed correctly funds amounts");
597 cmp_ok
($budget_hierarchy_cloned->[3]->{budget_amount
}, '==', 115, "CloneBudgetPeriod changed correctly funds amounts");
598 cmp_ok
($budget_hierarchy_cloned->[4]->{budget_amount
}, '==', 2320, "CloneBudgetPeriod changed correctly funds amounts");
599 cmp_ok
($budget_hierarchy_cloned->[5]->{budget_amount
}, '==', 0, "CloneBudgetPeriod changed correctly funds amounts");
601 $budget_period_id_cloned = C4
::Budgets
::CloneBudgetPeriod
(
603 budget_period_id
=> $budget_period_id,
604 budget_period_startdate
=> '2014-01-01',
605 budget_period_enddate
=> '2014-12-31',
606 amount_change_percentage
=> 16,
607 amount_change_round_increment
=> 5,
608 reset_all_budgets
=> 1,
611 $budget_hierarchy_cloned = GetBudgetHierarchy
($budget_period_id_cloned);
612 cmp_ok
($budget_hierarchy_cloned->[0]->{budget_amount
}, '==', 0, "CloneBudgetPeriod reset all fund amounts");
615 my $number_orders_moved = C4
::Budgets
::MoveOrders
();
616 is
( $number_orders_moved, undef, 'MoveOrders return undef if no arg passed' );
617 $number_orders_moved =
618 C4
::Budgets
::MoveOrders
( { from_budget_period_id
=> $budget_period_id } );
619 is
( $number_orders_moved, undef,
620 'MoveOrders return undef if only 1 arg passed' );
621 $number_orders_moved =
622 C4
::Budgets
::MoveOrders
( { to_budget_period_id
=> $budget_period_id } );
623 is
( $number_orders_moved, undef,
624 'MoveOrders return undef if only 1 arg passed' );
625 $number_orders_moved = C4
::Budgets
::MoveOrders
(
627 from_budget_period_id
=> $budget_period_id,
628 to_budget_period_id
=> $budget_period_id
631 is
( $number_orders_moved, undef,
632 'MoveOrders return undef if 2 budget period id are the same' );
634 $budget_period_id_cloned = C4
::Budgets
::CloneBudgetPeriod
(
636 budget_period_id
=> $budget_period_id,
637 budget_period_startdate
=> '2014-01-01',
638 budget_period_enddate
=> '2014-12-31',
642 my $report = C4
::Budgets
::MoveOrders
(
644 from_budget_period_id
=> $budget_period_id,
645 to_budget_period_id
=> $budget_period_id_cloned,
646 move_remaining_unspent
=> 1,
649 is
( scalar( @
$report ), 6 , "MoveOrders has processed 6 funds" );
651 my $number_of_orders_moved = 0;
652 $number_of_orders_moved += scalar( @
{ $_->{orders_moved
} } ) for @
$report;
653 is
( $number_of_orders_moved, $number_of_orders_to_move, "MoveOrders has moved $number_of_orders_to_move orders" );
655 my @new_budget_ids = map { $_->{budget_id
} }
656 @
{ C4
::Budgets
::GetBudgetHierarchy
($budget_period_id_cloned) };
657 my @old_budget_ids = map { $_->{budget_id
} }
658 @
{ C4
::Budgets
::GetBudgetHierarchy
($budget_period_id) };
659 for my $budget_id ( keys %budgets ) {
660 for my $ordernumber ( @
{ $budgets{$budget_id} } ) {
661 my $budget = GetBudgetByOrderNumber
($ordernumber);
662 my $is_in_new_budgets = grep /^$budget->{budget_id}$/, @new_budget_ids;
663 my $is_in_old_budgets = grep /^$budget->{budget_id}$/, @old_budget_ids;
664 is
( $is_in_new_budgets, 1, "MoveOrders changed the budget_id for order $ordernumber" );
665 is
( $is_in_old_budgets, 0, "MoveOrders changed the budget_id for order $ordernumber" );
670 # MoveOrders with param move_remaining_unspent
671 my @new_budgets = @
{ C4
::Budgets
::GetBudgetHierarchy
($budget_period_id_cloned) };
672 my @old_budgets = @
{ C4
::Budgets
::GetBudgetHierarchy
($budget_period_id) };
674 for my $new_budget ( @new_budgets ) {
675 my ( $old_budget ) = map { $_->{budget_code
} eq $new_budget->{budget_code
} ?
$_ : () } @old_budgets;
676 my $new_budget_amount_should_be = $old_budget->{budget_amount
} * 2 - $old_budget->{total_spent
};
677 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})" );
680 # Test SetOwnerToFundHierarchy
682 my $patron_category = $builder->build({ source
=> 'Category' });
683 my $branchcode = $library->{branchcode
};
684 my $john_doe = C4
::Members
::AddMember
(
685 cardnumber
=> '123456',
688 categorycode
=> $patron_category->{categorycode
},
689 branchcode
=> $branchcode,
691 dateexpiry
=> '9999-12-31',
695 C4
::Budgets
::SetOwnerToFundHierarchy
( $budget_id1, $john_doe );
696 is
( C4
::Budgets
::GetBudget
($budget_id1)->{budget_owner_id
},
697 $john_doe, "SetOwnerToFundHierarchy should have set John Doe for budget 1 ($budget_id1)" );
698 is
( C4
::Budgets
::GetBudget
($budget_id11)->{budget_owner_id
},
699 $john_doe, "SetOwnerToFundHierarchy should have set John Doe for budget 11 ($budget_id11)" );
700 is
( C4
::Budgets
::GetBudget
($budget_id111)->{budget_owner_id
},
701 $john_doe, "SetOwnerToFundHierarchy should have set John Doe for budget 111 ($budget_id111)" );
702 is
( C4
::Budgets
::GetBudget
($budget_id12)->{budget_owner_id
},
703 $john_doe, "SetOwnerToFundHierarchy should have set John Doe for budget 12 ($budget_id12 )" );
704 is
( C4
::Budgets
::GetBudget
($budget_id2)->{budget_owner_id
},
705 undef, "SetOwnerToFundHierarchy should not have set an owner for budget 2 ($budget_id2)" );
706 is
( C4
::Budgets
::GetBudget
($budget_id21)->{budget_owner_id
},
707 undef, "SetOwnerToFundHierarchy should not have set an owner for budget 21 ($budget_id21)" );
709 my $jane_doe = C4
::Members
::AddMember
(
710 cardnumber
=> '789012',
713 categorycode
=> $patron_category->{categorycode
},
714 branchcode
=> $branchcode,
716 dateexpiry
=> '9999-12-31',
720 C4
::Budgets
::SetOwnerToFundHierarchy
( $budget_id11, $jane_doe );
721 is
( C4
::Budgets
::GetBudget
($budget_id1)->{budget_owner_id
},
722 $john_doe, "SetOwnerToFundHierarchy should have set John Doe $john_doe for budget 1 ($budget_id1)" );
723 is
( C4
::Budgets
::GetBudget
($budget_id11)->{budget_owner_id
},
724 $jane_doe, "SetOwnerToFundHierarchy should have set John Doe $jane_doe for budget 11 ($budget_id11)" );
725 is
( C4
::Budgets
::GetBudget
($budget_id111)->{budget_owner_id
},
726 $jane_doe, "SetOwnerToFundHierarchy should have set John Doe $jane_doe for budget 111 ($budget_id111)" );
727 is
( C4
::Budgets
::GetBudget
($budget_id12)->{budget_owner_id
},
728 $john_doe, "SetOwnerToFundHierarchy should have set John Doe $john_doe for budget 12 ($budget_id12 )" );
729 is
( C4
::Budgets
::GetBudget
($budget_id2)->{budget_owner_id
},
730 undef, "SetOwnerToFundHierarchy should have set John Doe $john_doe for budget 2 ($budget_id2)" );
731 is
( C4
::Budgets
::GetBudget
($budget_id21)->{budget_owner_id
},
732 undef, "SetOwnerToFundHierarchy should have set John Doe $john_doe for budget 21 ($budget_id21)" );
734 # Test GetBudgetAuthCats
736 my $budgetPeriodId = AddBudgetPeriod
({
737 budget_period_startdate
=> '2008-01-01',
738 budget_period_enddate
=> '2008-12-31',
739 budget_period_description
=> 'just another budget',
740 budget_period_active
=> 0,
743 $budgets = GetBudgets
();
745 for my $budget ( @
$budgets )
747 $budget->{sort1_authcat
} = "sort1_authcat_$i";
748 $budget->{sort2_authcat
} = "sort2_authcat_$i";
749 $budget->{budget_period_id
} = $budgetPeriodId;
750 ModBudget
( $budget );
754 my $authCat = GetBudgetAuthCats
($budgetPeriodId);
756 is
( scalar @
{$authCat}, $i * 2, "GetBudgetAuthCats returns only non-empty sorting categories (no empty authCat in db)" );
759 for my $budget ( @
$budgets )
761 $budget->{sort1_authcat
} = "sort_authcat_$i";
762 $budget->{sort2_authcat
} = "sort_authcat_$i";
763 $budget->{budget_period_id
} = $budgetPeriodId;
764 ModBudget
( $budget );
768 $authCat = GetBudgetAuthCats
($budgetPeriodId);
769 is
( scalar @
$authCat, scalar @
$budgets, "GetBudgetAuthCats returns distinct authCat" );
772 for my $budget ( @
$budgets )
774 $budget->{sort1_authcat
} = "sort1_authcat_$i";
775 $budget->{sort2_authcat
} = "";
776 $budget->{budget_period_id
} = $budgetPeriodId;
777 ModBudget
( $budget );
781 $authCat = GetBudgetAuthCats
($budgetPeriodId);
783 is
( scalar @
{$authCat}, $i, "GetBudgetAuthCats returns only non-empty sorting categories (empty sort2_authcat on all records)" );
786 for my $budget ( @
$budgets )
788 $budget->{sort1_authcat
} = "";
789 $budget->{sort2_authcat
} = "";
790 $budget->{budget_period_id
} = $budgetPeriodId;
791 ModBudget
( $budget );
795 $authCat = GetBudgetAuthCats
($budgetPeriodId);
797 is
( scalar @
{$authCat}, 0, "GetBudgetAuthCats returns only non-empty sorting categories (all empty)" );
799 # /Test GetBudgetAuthCats
801 sub _get_dependencies
{
802 my ($budget_hierarchy) = @_;
804 for my $budget (@
$budget_hierarchy) {
805 if ( $budget->{child
} ) {
806 my @sorted = sort @
{ $budget->{child
} };
807 for my $child_id (@sorted) {
808 push @
{ $graph->{ $budget->{budget_name
} }{children
} },
809 _get_budgetname_by_id
( $budget_hierarchy, $child_id );
812 push @
{ $graph->{ $budget->{budget_name
} }{parents
} },
813 $budget->{parent_id
};
818 sub _get_budgetname_by_id
{
819 my ( $budgets, $budget_id ) = @_;
821 map { ( $_->{budget_id
} eq $budget_id ) ?
$_->{budget_name
} : () }
826 # C4::Context->userenv