3 use Test
::More tests
=> 146;
12 use Koha
::Acquisition
::Booksellers
;
13 use Koha
::Acquisition
::Orders
;
16 use t
::lib
::TestBuilder
;
21 my $schema = Koha
::Database
->new->schema;
22 $schema->storage->txn_begin;
23 my $builder = t
::lib
::TestBuilder
->new;
24 my $dbh = C4
::Context
->dbh;
25 $dbh->do(q
|DELETE FROM aqbudgetperiods
|);
26 $dbh->do(q
|DELETE FROM aqbudgets
|);
28 my $library = $builder->build({
33 local $SIG{__WARN__
} = sub { warn $_[0] unless $_[0] =~ /redefined/ };
35 *C4
::Context
::userenv
= \
&Mock_userenv
;
36 $userenv = { flags
=> 1, id
=> 'my_userid', branch
=> $library->{branchcode
} };
42 is
( AddBudgetPeriod
(), undef, 'AddBugetPeriod without argument returns undef' );
43 is
( AddBudgetPeriod
( { } ), undef, 'AddBugetPeriod with an empty argument returns undef' );
44 my $bpid = AddBudgetPeriod
({
45 budget_period_startdate
=> '2008-01-01',
47 is
( $bpid, undef, 'AddBugetPeriod without end date returns undef' );
48 $bpid = AddBudgetPeriod
({
49 budget_period_enddate
=> '2008-12-31',
51 is
( $bpid, undef, 'AddBugetPeriod without start date returns undef' );
52 is
( GetBudgetPeriod
(0), undef ,'GetBudgetPeriod(0) returned undef : noactive BudgetPeriod' );
53 my $budgetperiods = GetBudgetPeriods
();
54 is
( @
$budgetperiods, 0, 'GetBudgetPeriods returns the correct number of budget periods' );
56 my $my_budgetperiod = {
57 budget_period_startdate
=> '2008-01-01',
58 budget_period_enddate
=> '2008-12-31',
59 budget_period_description
=> 'MAPERI',
60 budget_period_active
=> 0,
62 $bpid = AddBudgetPeriod
($my_budgetperiod);
63 isnt
( $bpid, undef, 'AddBugetPeriod does not returns undef' );
64 my $budgetperiod = GetBudgetPeriod
($bpid);
65 is
( $budgetperiod->{budget_period_startdate
}, $my_budgetperiod->{budget_period_startdate
}, 'AddBudgetPeriod stores the start date correctly' );
66 is
( $budgetperiod->{budget_period_enddate
}, $my_budgetperiod->{budget_period_enddate
}, 'AddBudgetPeriod stores the end date correctly' );
67 is
( $budgetperiod->{budget_period_description
}, $my_budgetperiod->{budget_period_description
}, 'AddBudgetPeriod stores the description correctly' );
68 is
( $budgetperiod->{budget_period_active
}, $my_budgetperiod->{budget_period_active
}, 'AddBudgetPeriod stores active correctly' );
69 is
( GetBudgetPeriod
(0), undef ,'GetBudgetPeriod(0) returned undef : noactive BudgetPeriod' );
73 budget_period_startdate
=> '2009-01-01',
74 budget_period_enddate
=> '2009-12-31',
75 budget_period_description
=> 'MODIF_MAPERI',
76 budget_period_active
=> 1,
78 my $mod_status = ModBudgetPeriod
($my_budgetperiod);
79 is
( $mod_status, undef, 'ModBudgetPeriod without id returns undef' );
81 $my_budgetperiod->{budget_period_id
} = $bpid;
82 $mod_status = ModBudgetPeriod
($my_budgetperiod);
83 is
( $mod_status, 1, 'ModBudgetPeriod returnis true' );
84 $budgetperiod = GetBudgetPeriod
($bpid);
85 is
( $budgetperiod->{budget_period_startdate
}, $my_budgetperiod->{budget_period_startdate
}, 'ModBudgetPeriod updates the start date correctly' );
86 is
( $budgetperiod->{budget_period_enddate
}, $my_budgetperiod->{budget_period_enddate
}, 'ModBudgetPeriod updates the end date correctly' );
87 is
( $budgetperiod->{budget_period_description
}, $my_budgetperiod->{budget_period_description
}, 'ModBudgetPeriod updates the description correctly' );
88 is
( $budgetperiod->{budget_period_active
}, $my_budgetperiod->{budget_period_active
}, 'ModBudgetPeriod upates active correctly' );
89 isnt
( GetBudgetPeriod
(0), undef, 'GetBugetPeriods functions correctly' );
92 $budgetperiods = GetBudgetPeriods
();
93 is
( @
$budgetperiods, 1, 'GetBudgetPeriods returns the correct number of budget periods' );
94 is
( $budgetperiods->[0]->{budget_period_id
}, $my_budgetperiod->{budget_period_id
}, 'GetBudgetPeriods returns the id correctly' );
95 is
( $budgetperiods->[0]->{budget_period_startdate
}, $my_budgetperiod->{budget_period_startdate
}, 'GetBudgetPeriods returns the start date correctly' );
96 is
( $budgetperiods->[0]->{budget_period_enddate
}, $my_budgetperiod->{budget_period_enddate
}, 'GetBudgetPeriods returns the end date correctly' );
97 is
( $budgetperiods->[0]->{budget_period_description
}, $my_budgetperiod->{budget_period_description
}, 'GetBudgetPeriods returns the description correctly' );
98 is
( $budgetperiods->[0]->{budget_period_active
}, $my_budgetperiod->{budget_period_active
}, 'GetBudgetPeriods returns active correctly' );
100 is
( DelBudgetPeriod
($bpid), 1, 'DelBudgetPeriod returns true' );
101 $budgetperiods = GetBudgetPeriods
();
102 is
( @
$budgetperiods, 0, 'GetBudgetPeriods returns the correct number of budget periods' );
109 # The budget hierarchy will be:
117 is
( AddBudget
(), undef, 'AddBuget without argument returns undef' );
118 my $budgets = GetBudgets
();
119 is
( @
$budgets, 0, 'GetBudgets returns the correct number of budgets' );
121 $bpid = AddBudgetPeriod
($my_budgetperiod); #this is an active budget
124 budget_code
=> 'ABCD',
125 budget_amount
=> '123.132000',
126 budget_name
=> 'Periodiques',
127 budget_notes
=> 'This is a note',
128 budget_period_id
=> $bpid,
130 my $budget_id = AddBudget
($my_budget);
131 isnt
( $budget_id, undef, 'AddBudget does not returns undef' );
132 my $budget = GetBudget
($budget_id);
133 is
( $budget->{budget_code
}, $my_budget->{budget_code
}, 'AddBudget stores the budget code correctly' );
134 is
( $budget->{budget_amount
}, $my_budget->{budget_amount
}, 'AddBudget stores the budget amount correctly' );
135 is
( $budget->{budget_name
}, $my_budget->{budget_name
}, 'AddBudget stores the budget name correctly' );
136 is
( $budget->{budget_notes
}, $my_budget->{budget_notes
}, 'AddBudget stores the budget notes correctly' );
137 is
( $budget->{budget_period_id
}, $my_budget->{budget_period_id
}, 'AddBudget stores the budget period id correctly' );
141 budget_code
=> 'EFG',
142 budget_amount
=> '321.231000',
143 budget_name
=> 'Modified name',
144 budget_notes
=> 'This is a modified note',
145 budget_period_id
=> $bpid,
147 $mod_status = ModBudget
($my_budget);
148 is
( $mod_status, undef, 'ModBudget without id returns undef' );
150 $my_budget->{budget_id
} = $budget_id;
151 $mod_status = ModBudget
($my_budget);
152 is
( $mod_status, 1, 'ModBudget returns true' );
153 $budget = GetBudget
($budget_id);
154 is
( $budget->{budget_code
}, $my_budget->{budget_code
}, 'ModBudget updates the budget code correctly' );
155 is
( $budget->{budget_amount
}, $my_budget->{budget_amount
}, 'ModBudget updates the budget amount correctly' );
156 is
( $budget->{budget_name
}, $my_budget->{budget_name
}, 'ModBudget updates the budget name correctly' );
157 is
( $budget->{budget_notes
}, $my_budget->{budget_notes
}, 'ModBudget updates the budget notes correctly' );
158 is
( $budget->{budget_period_id
}, $my_budget->{budget_period_id
}, 'ModBudget updates the budget period id correctly' );
161 $budgets = GetBudgets
();
162 is
( @
$budgets, 1, 'GetBudgets returns the correct number of budgets' );
163 is
( $budgets->[0]->{budget_id
}, $my_budget->{budget_id
}, 'GetBudgets returns the budget id correctly' );
164 is
( $budgets->[0]->{budget_code
}, $my_budget->{budget_code
}, 'GetBudgets returns the budget code correctly' );
165 is
( $budgets->[0]->{budget_amount
}, $my_budget->{budget_amount
}, 'GetBudgets returns the budget amount correctly' );
166 is
( $budgets->[0]->{budget_name
}, $my_budget->{budget_name
}, 'GetBudgets returns the budget name correctly' );
167 is
( $budgets->[0]->{budget_notes
}, $my_budget->{budget_notes
}, 'GetBudgets returns the budget notes correctly' );
168 is
( $budgets->[0]->{budget_period_id
}, $my_budget->{budget_period_id
}, 'GetBudgets returns the budget period id correctly' );
170 $budgets = GetBudgets
( {budget_period_id
=> $bpid} );
171 is
( @
$budgets, 1, 'GetBudgets With Filter OK' );
172 $budgets = GetBudgets
( {budget_period_id
=> $bpid}, {-asc
=> "budget_name"} );
173 is
( @
$budgets, 1, 'GetBudgets With Order OK' );
174 $budgets = GetBudgets
( {budget_period_id
=> GetBudgetPeriod
($bpid)->{budget_period_id
}}, {-asc
=> "budget_name"} );
175 is
( @
$budgets, 1, 'GetBudgets With Order Getting Active budgetPeriod OK');
178 my $budget_name = GetBudgetName
( $budget_id );
179 is
($budget_name, $my_budget->{budget_name
}, "Test the GetBudgetName routine");
181 my $my_inactive_budgetperiod = { #let's add an inactive
182 budget_period_startdate
=> '2010-01-01',
183 budget_period_enddate
=> '2010-12-31',
184 budget_period_description
=> 'MODIF_MAPERI',
185 budget_period_active
=> 0,
187 my $bpid_i = AddBudgetPeriod
($my_inactive_budgetperiod); #this is an inactive budget
189 my $my_budget_inactive = {
190 budget_code
=> 'EFG',
191 budget_amount
=> '123.132000',
192 budget_name
=> 'Periodiques',
193 budget_notes
=> 'This is a note',
194 budget_period_id
=> $bpid_i,
196 my $budget_id_inactive = AddBudget
($my_budget_inactive);
198 my $budget_code = $my_budget->{budget_code
};
199 my $budget_by_code = GetBudgetByCode
( $budget_code );
200 is
($budget_by_code->{budget_id
}, $budget_id, "GetBudgetByCode, check id"); #this should match the active budget, not the inactive
201 is
($budget_by_code->{budget_notes
}, $my_budget->{budget_notes
}, "GetBudgetByCode, check notes");
203 my $second_budget_id = AddBudget
({
204 budget_code
=> "ZZZZ",
205 budget_amount
=> "500.00",
206 budget_name
=> "Art",
207 budget_notes
=> "This is a note",
208 budget_period_id
=> $bpid,
210 isnt
( $second_budget_id, undef, 'AddBudget does not returns undef' );
212 $budgets = GetBudgets
( {budget_period_id
=> $bpid} );
213 ok
( $budgets->[0]->{budget_name
} lt $budgets->[1]->{budget_name
}, 'default sort order for GetBudgets is by name' );
215 is
( DelBudget
($budget_id), 1, 'DelBudget returns true' );
216 $budgets = GetBudgets
();
217 is
( @
$budgets, 2, 'GetBudgets returns the correct number of budget periods' );
220 # GetBudgetHierarchySpent and GetBudgetHierarchyOrdered
221 my $budget_period_total = 10_000
;
222 my $budget_1_total = 1_000
;
223 my $budget_11_total = 100;
224 my $budget_111_total = 50;
225 my $budget_12_total = 100;
226 my $budget_2_total = 2_000
;
228 my $budget_period_id = AddBudgetPeriod
(
230 budget_period_startdate
=> '2013-01-01',
231 budget_period_enddate
=> '2014-12-31',
232 budget_period_description
=> 'Budget Period',
233 budget_period_active
=> 1,
234 budget_period_total
=> $budget_period_total,
237 my $budget_id1 = AddBudget
(
239 budget_code
=> 'budget_1',
240 budget_name
=> 'budget_1',
241 budget_period_id
=> $budget_period_id,
242 budget_parent_id
=> undef,
243 budget_amount
=> $budget_1_total,
246 my $budget_id2 = AddBudget
(
248 budget_code
=> 'budget_2',
249 budget_name
=> 'budget_2',
250 budget_period_id
=> $budget_period_id,
251 budget_parent_id
=> undef,
252 budget_amount
=> $budget_2_total,
255 my $budget_id12 = AddBudget
(
257 budget_code
=> 'budget_12',
258 budget_name
=> 'budget_12',
259 budget_period_id
=> $budget_period_id,
260 budget_parent_id
=> $budget_id1,
261 budget_amount
=> $budget_12_total,
264 my $budget_id11 = AddBudget
(
266 budget_code
=> 'budget_11',
267 budget_name
=> 'budget_11',
268 budget_period_id
=> $budget_period_id,
269 budget_parent_id
=> $budget_id1,
270 budget_amount
=> $budget_11_total,
273 my $budget_id111 = AddBudget
(
275 budget_code
=> 'budget_111',
276 budget_name
=> 'budget_111',
277 budget_period_id
=> $budget_period_id,
278 budget_parent_id
=> $budget_id11,
279 budget_owner_id
=> 1,
280 budget_amount
=> $budget_111_total,
283 my $budget_id21 = AddBudget
(
285 budget_code
=> 'budget_21',
286 budget_name
=> 'budget_21',
287 budget_period_id
=> $budget_period_id,
288 budget_parent_id
=> $budget_id2,
292 my $bookseller = Koha
::Acquisition
::Bookseller
->new(
295 address1
=> "bookseller's address",
301 my $booksellerid = $bookseller->id;
303 my $basketno = C4
::Acquisition
::NewBasket
( $booksellerid, 1 );
304 my ( $biblionumber, $biblioitemnumber ) =
305 C4
::Biblio
::AddBiblio
( MARC
::Record
->new, '' );
309 budget_id
=> $budget_id1,
310 pending_quantity
=> 1,
314 budget_id
=> $budget_id2,
315 pending_quantity
=> 2,
319 budget_id
=> $budget_id11,
320 pending_quantity
=> 3,
324 budget_id
=> $budget_id12,
325 pending_quantity
=> 4,
329 budget_id
=> $budget_id111,
330 pending_quantity
=> 2,
334 # No order for budget_21
339 my $invoiceid = AddInvoice
(invoicenumber
=> 'invoice_test_clone', booksellerid
=> $booksellerid, unknown
=> "unknown");
340 my $invoice = GetInvoice
( $invoiceid );
342 my $item_quantity = 2;
343 my $number_of_orders_to_move = 0;
344 for my $infos (@order_infos) {
345 for ( 1 .. $infos->{pending_quantity
} ) {
346 my $order = Koha
::Acquisition
::Order
->new(
348 basketno
=> $basketno,
349 biblionumber
=> $biblionumber,
350 budget_id
=> $infos->{budget_id
},
351 order_internalnote
=> "internal note",
352 order_vendornote
=> "vendor note",
354 cost_tax_included
=> $item_price,
355 rrp_tax_included
=> $item_price,
356 listprice
=> $item_price,
357 ecost_tax_include
=> $item_price,
362 my $ordernumber = $order->ordernumber;
363 push @
{ $budgets{$infos->{budget_id
}} }, $ordernumber;
364 $number_of_orders_to_move++;
366 for ( 1 .. $infos->{spent_quantity
} ) {
367 my $order = Koha
::Acquisition
::Order
->new(
369 basketno
=> $basketno,
370 biblionumber
=> $biblionumber,
371 budget_id
=> $infos->{budget_id
},
372 order_internalnote
=> "internal note",
373 order_vendornote
=> "vendor note",
374 quantity
=> $item_quantity,
376 rrp_tax_included
=> $item_price,
377 listprice
=> $item_price,
378 ecost_tax_included
=> $item_price,
383 my $ordernumber = $order->ordernumber;
385 biblionumber
=> $biblionumber,
386 order
=> $order->unblessed,
387 budget_id
=> $infos->{budget_id
},
388 quantityreceived
=> $item_quantity,
390 received_items
=> [],
394 is
( GetBudgetHierarchySpent
( $budget_id1 ), 160, "total spent for budget1 is 160" );
395 is
( GetBudgetHierarchySpent
( $budget_id11 ), 100, "total spent for budget11 is 100" );
396 is
( GetBudgetHierarchySpent
( $budget_id111 ), 20, "total spent for budget111 is 20" );
398 # GetBudgetSpent and GetBudgetOrdered
399 my $budget_period_amount = 100;
400 my $budget_amount = 50;
402 $budget = AddBudgetPeriod
(
404 budget_period_startdate
=> '2017-08-22',
405 budget_period_enddate
=> '2018-08-22',
406 budget_period_description
=> 'Test budget',
407 budget_period_active
=> 1,
408 budget_period_total
=> $budget_period_amount,
412 my $fund = AddBudget
(
414 budget_code
=> 'Test fund',
415 budget_name
=> 'Test fund',
416 budget_period_id
=> $budget,
417 budget_parent_id
=> undef,
418 budget_amount
=> $budget_amount,
422 my $vendor = Koha
::Acquisition
::Bookseller
->new(
424 name
=> "test vendor",
425 address1
=> "test address",
432 my $vendorid = $vendor->id;
434 my $basketnumber = C4
::Acquisition
::NewBasket
( $vendorid, 1 );
435 my ( $biblio, $biblioitem ) = C4
::Biblio
::AddBiblio
( MARC
::Record
->new, '' );
440 pending_quantity
=> 1,
445 my $invoiceident = AddInvoice
( invoicenumber
=> 'invoice_test_clone', booksellerid
=> $vendorid, shipmentdate
=> '2017-08-22', shipmentcost
=> 6, shipmentcost_budgetid
=> $fund );
446 my $test_invoice = GetInvoice
( $invoiceident );
447 my $individual_item_price = 10;
449 my $order = Koha
::Acquisition
::Order
->new(
451 basketno
=> $basketnumber,
452 biblionumber
=> $biblio,
454 order_internalnote
=> "internalnote",
455 order_vendornote
=> "vendor note",
457 cost_tax_included
=> $individual_item_price,
458 rrp_tax_included
=> $individual_item_price,
459 listprice
=> $individual_item_price,
460 ecost_tax_included
=> $individual_item_price,
467 bibionumber
=> $biblio,
468 order
=> $order->unblessed,
470 quantityreceived
=> 2,
471 invoice
=> $test_invoice,
472 received_items
=> [],
475 is
( GetBudgetSpent
( $fund ), 6, "total shipping cost is 6");
476 is
( GetBudgetOrdered
( $fund ), '20', "total ordered price is 20");
480 my $budget_period_id_cloned = C4
::Budgets
::CloneBudgetPeriod
(
482 budget_period_id
=> $budget_period_id,
483 budget_period_startdate
=> '2014-01-01',
484 budget_period_enddate
=> '2014-12-31',
485 budget_period_description
=> 'Budget Period Cloned',
489 my $budget_period_cloned = C4
::Budgets
::GetBudgetPeriod
($budget_period_id_cloned);
490 is
($budget_period_cloned->{budget_period_description
}, 'Budget Period Cloned', 'Cloned budget\'s description is updated.');
492 my $budget_cloned = C4
::Budgets
::GetBudgets
({ budget_period_id
=> $budget_period_id_cloned });
493 my $test = $budget_cloned->[0]->{timestamp
};
494 my $budget_time = Koha
::DateUtils
::dt_from_string
($test);
495 my $local_time = Koha
::DateUtils
::dt_from_string
();
498 is
(DateTime
::compare
($budget_time, $local_time), 0, "New budget got the right timestamp");
502 my $budget_hierarchy = GetBudgetHierarchy
($budget_period_id);
503 my $budget_hierarchy_cloned = GetBudgetHierarchy
($budget_period_id_cloned);
506 scalar(@
$budget_hierarchy_cloned),
507 scalar(@
$budget_hierarchy),
508 'CloneBudgetPeriod clones the same number of budgets (funds)'
511 _get_dependencies
($budget_hierarchy),
512 _get_dependencies
($budget_hierarchy_cloned),
513 'CloneBudgetPeriod keeps the same dependencies order'
516 # CloneBudgetPeriod with param mark_original_budget_as_inactive
517 my $budget_period = C4
::Budgets
::GetBudgetPeriod
($budget_period_id);
518 is
( $budget_period->{budget_period_active
}, 1,
519 'CloneBudgetPeriod does not mark as inactive the budgetperiod if not needed'
522 $budget_hierarchy_cloned = GetBudgetHierarchy
($budget_period_id_cloned);
523 my $number_of_budgets_not_reset = 0;
524 for my $budget (@
$budget_hierarchy_cloned) {
525 $number_of_budgets_not_reset++ if $budget->{budget_amount
} > 0;
527 is
( $number_of_budgets_not_reset, 5,
528 'CloneBudgetPeriod does not reset budgets (funds) if not needed' );
530 $budget_period_id_cloned = C4
::Budgets
::CloneBudgetPeriod
(
532 budget_period_id
=> $budget_period_id,
533 budget_period_startdate
=> '2014-01-01',
534 budget_period_enddate
=> '2014-12-31',
535 mark_original_budget_as_inactive
=> 1,
539 $budget_hierarchy = GetBudgetHierarchy
($budget_period_id);
540 is
( $budget_hierarchy->[0]->{children
}->[0]->{budget_name
}, 'budget_11', 'GetBudgetHierarchy should return budgets ordered by name, first child is budget_11' );
541 is
( $budget_hierarchy->[0]->{children
}->[1]->{budget_name
}, 'budget_12', 'GetBudgetHierarchy should return budgets ordered by name, second child is budget_12' );
542 is
($budget_hierarchy->[0]->{budget_name
},'budget_1','GetBudgetHierarchy should return budgets ordered by name, first budget is budget_1');
543 is
($budget_hierarchy->[0]->{budget_level
},'0','budget_level of budget (budget_1) should be 0');
544 is
($budget_hierarchy->[0]->{children
}->[0]->{budget_level
},'1','budget_level of first fund(budget_11) should be 1');
545 is
($budget_hierarchy->[0]->{children
}->[1]->{budget_level
},'1','budget_level of second fund(budget_12) should be 1');
546 is
($budget_hierarchy->[0]->{children
}->[0]->{children
}->[0]->{budget_level
},'2','budget_level of child fund budget_11 should be 2');
547 $budget_hierarchy = GetBudgetHierarchy
($budget_period_id);
548 $budget_hierarchy_cloned = GetBudgetHierarchy
($budget_period_id_cloned);
550 is
( scalar(@
$budget_hierarchy_cloned), scalar(@
$budget_hierarchy),
551 'CloneBudgetPeriod (with inactive param) clones the same number of budgets (funds)'
554 _get_dependencies
($budget_hierarchy),
555 _get_dependencies
($budget_hierarchy_cloned),
556 'CloneBudgetPeriod (with inactive param) keeps the same dependencies order'
558 $budget_period = C4
::Budgets
::GetBudgetPeriod
($budget_period_id);
559 is
( $budget_period->{budget_period_active
}, 0,
560 'CloneBudgetPeriod (with inactive param) marks as inactive the budgetperiod'
563 # CloneBudgetPeriod with param reset_all_budgets
564 $budget_period_id_cloned = C4
::Budgets
::CloneBudgetPeriod
(
566 budget_period_id
=> $budget_period_id,
567 budget_period_startdate
=> '2014-01-01',
568 budget_period_enddate
=> '2014-12-31',
569 reset_all_budgets
=> 1,
573 $budget_hierarchy_cloned = GetBudgetHierarchy
($budget_period_id_cloned);
574 $number_of_budgets_not_reset = 0;
575 for my $budget (@
$budget_hierarchy_cloned) {
576 $number_of_budgets_not_reset++ if $budget->{budget_amount
} > 0;
578 is
( $number_of_budgets_not_reset, 0,
579 'CloneBudgetPeriod has reset all budgets (funds)' );
581 #GetBudgetsByActivity
582 my $result=C4
::Budgets
::GetBudgetsByActivity
(1);
583 isnt
( $result, undef ,'GetBudgetsByActivity return correct value with parameter 1');
584 $result=C4
::Budgets
::GetBudgetsByActivity
(0);
585 isnt
( $result, undef ,'GetBudgetsByActivity return correct value with parameter 0');
586 $result=C4
::Budgets
::GetBudgetsByActivity
();
587 is
( $result, 0 , 'GetBudgetsByActivity return 0 with none parameter or other 0 or 1' );
588 DelBudget
($budget_id);
589 DelBudgetPeriod
($bpid);
591 # CloneBudgetPeriod with param amount_change_*
592 $budget_period_id_cloned = C4
::Budgets
::CloneBudgetPeriod
(
594 budget_period_id
=> $budget_period_id,
595 budget_period_startdate
=> '2014-01-01',
596 budget_period_enddate
=> '2014-12-31',
597 amount_change_percentage
=> 16,
598 amount_change_round_increment
=> 5,
602 $budget_period_cloned = C4
::Budgets
::GetBudgetPeriod
($budget_period_id_cloned);
603 cmp_ok
($budget_period_cloned->{budget_period_total
}, '==', 11600, "CloneBudgetPeriod changed correctly budget amount");
604 $budget_hierarchy_cloned = GetBudgetHierarchy
($budget_period_id_cloned);
605 cmp_ok
($budget_hierarchy_cloned->[0]->{budget_amount
}, '==', 1160, "CloneBudgetPeriod changed correctly funds amounts");
606 cmp_ok
($budget_hierarchy_cloned->[1]->{budget_amount
}, '==', 115, "CloneBudgetPeriod changed correctly funds amounts");
607 cmp_ok
($budget_hierarchy_cloned->[2]->{budget_amount
}, '==', 55, "CloneBudgetPeriod changed correctly funds amounts");
608 cmp_ok
($budget_hierarchy_cloned->[3]->{budget_amount
}, '==', 115, "CloneBudgetPeriod changed correctly funds amounts");
609 cmp_ok
($budget_hierarchy_cloned->[4]->{budget_amount
}, '==', 2320, "CloneBudgetPeriod changed correctly funds amounts");
610 cmp_ok
($budget_hierarchy_cloned->[5]->{budget_amount
}, '==', 0, "CloneBudgetPeriod changed correctly funds amounts");
612 $budget_period_id_cloned = C4
::Budgets
::CloneBudgetPeriod
(
614 budget_period_id
=> $budget_period_id,
615 budget_period_startdate
=> '2014-01-01',
616 budget_period_enddate
=> '2014-12-31',
617 amount_change_percentage
=> 16,
618 amount_change_round_increment
=> 5,
619 reset_all_budgets
=> 1,
622 $budget_hierarchy_cloned = GetBudgetHierarchy
($budget_period_id_cloned);
623 cmp_ok
($budget_hierarchy_cloned->[0]->{budget_amount
}, '==', 0, "CloneBudgetPeriod reset all fund amounts");
626 my $number_orders_moved = C4
::Budgets
::MoveOrders
();
627 is
( $number_orders_moved, undef, 'MoveOrders return undef if no arg passed' );
628 $number_orders_moved =
629 C4
::Budgets
::MoveOrders
( { from_budget_period_id
=> $budget_period_id } );
630 is
( $number_orders_moved, undef,
631 'MoveOrders return undef if only 1 arg passed' );
632 $number_orders_moved =
633 C4
::Budgets
::MoveOrders
( { to_budget_period_id
=> $budget_period_id } );
634 is
( $number_orders_moved, undef,
635 'MoveOrders return undef if only 1 arg passed' );
636 $number_orders_moved = C4
::Budgets
::MoveOrders
(
638 from_budget_period_id
=> $budget_period_id,
639 to_budget_period_id
=> $budget_period_id
642 is
( $number_orders_moved, undef,
643 'MoveOrders return undef if 2 budget period id are the same' );
645 $budget_period_id_cloned = C4
::Budgets
::CloneBudgetPeriod
(
647 budget_period_id
=> $budget_period_id,
648 budget_period_startdate
=> '2014-01-01',
649 budget_period_enddate
=> '2014-12-31',
653 my $report = C4
::Budgets
::MoveOrders
(
655 from_budget_period_id
=> $budget_period_id,
656 to_budget_period_id
=> $budget_period_id_cloned,
657 move_remaining_unspent
=> 1,
660 is
( scalar( @
$report ), 6 , "MoveOrders has processed 6 funds" );
662 my $number_of_orders_moved = 0;
663 $number_of_orders_moved += scalar( @
{ $_->{orders_moved
} } ) for @
$report;
664 is
( $number_of_orders_moved, $number_of_orders_to_move, "MoveOrders has moved $number_of_orders_to_move orders" );
666 my @new_budget_ids = map { $_->{budget_id
} }
667 @
{ C4
::Budgets
::GetBudgetHierarchy
($budget_period_id_cloned) };
668 my @old_budget_ids = map { $_->{budget_id
} }
669 @
{ C4
::Budgets
::GetBudgetHierarchy
($budget_period_id) };
670 for my $budget_id ( keys %budgets ) {
671 for my $ordernumber ( @
{ $budgets{$budget_id} } ) {
672 my $budget = GetBudgetByOrderNumber
($ordernumber);
673 my $is_in_new_budgets = grep /^$budget->{budget_id}$/, @new_budget_ids;
674 my $is_in_old_budgets = grep /^$budget->{budget_id}$/, @old_budget_ids;
675 is
( $is_in_new_budgets, 1, "MoveOrders changed the budget_id for order $ordernumber" );
676 is
( $is_in_old_budgets, 0, "MoveOrders changed the budget_id for order $ordernumber" );
681 # MoveOrders with param move_remaining_unspent
682 my @new_budgets = @
{ C4
::Budgets
::GetBudgetHierarchy
($budget_period_id_cloned) };
683 my @old_budgets = @
{ C4
::Budgets
::GetBudgetHierarchy
($budget_period_id) };
685 for my $new_budget ( @new_budgets ) {
686 my ( $old_budget ) = map { $_->{budget_code
} eq $new_budget->{budget_code
} ?
$_ : () } @old_budgets;
687 my $new_budget_amount_should_be = $old_budget->{budget_amount
} * 2 - $old_budget->{total_spent
};
688 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})" );
691 # Test SetOwnerToFundHierarchy
693 my $patron_category = $builder->build({ source
=> 'Category' });
694 my $branchcode = $library->{branchcode
};
695 my $john_doe = Koha
::Patron
->new({
696 cardnumber
=> '123456',
699 categorycode
=> $patron_category->{categorycode
},
700 branchcode
=> $branchcode,
702 dateexpiry
=> '9999-12-31',
704 })->store->borrowernumber;
706 C4
::Budgets
::SetOwnerToFundHierarchy
( $budget_id1, $john_doe );
707 is
( C4
::Budgets
::GetBudget
($budget_id1)->{budget_owner_id
},
708 $john_doe, "SetOwnerToFundHierarchy should have set John Doe for budget 1 ($budget_id1)" );
709 is
( C4
::Budgets
::GetBudget
($budget_id11)->{budget_owner_id
},
710 $john_doe, "SetOwnerToFundHierarchy should have set John Doe for budget 11 ($budget_id11)" );
711 is
( C4
::Budgets
::GetBudget
($budget_id111)->{budget_owner_id
},
712 $john_doe, "SetOwnerToFundHierarchy should have set John Doe for budget 111 ($budget_id111)" );
713 is
( C4
::Budgets
::GetBudget
($budget_id12)->{budget_owner_id
},
714 $john_doe, "SetOwnerToFundHierarchy should have set John Doe for budget 12 ($budget_id12 )" );
715 is
( C4
::Budgets
::GetBudget
($budget_id2)->{budget_owner_id
},
716 undef, "SetOwnerToFundHierarchy should not have set an owner for budget 2 ($budget_id2)" );
717 is
( C4
::Budgets
::GetBudget
($budget_id21)->{budget_owner_id
},
718 undef, "SetOwnerToFundHierarchy should not have set an owner for budget 21 ($budget_id21)" );
720 my $jane_doe = Koha
::Patron
->new({
721 cardnumber
=> '789012',
724 categorycode
=> $patron_category->{categorycode
},
725 branchcode
=> $branchcode,
727 dateexpiry
=> '9999-12-31',
729 })->store->borrowernumber;
731 C4
::Budgets
::SetOwnerToFundHierarchy
( $budget_id11, $jane_doe );
732 is
( C4
::Budgets
::GetBudget
($budget_id1)->{budget_owner_id
},
733 $john_doe, "SetOwnerToFundHierarchy should have set John Doe $john_doe for budget 1 ($budget_id1)" );
734 is
( C4
::Budgets
::GetBudget
($budget_id11)->{budget_owner_id
},
735 $jane_doe, "SetOwnerToFundHierarchy should have set John Doe $jane_doe for budget 11 ($budget_id11)" );
736 is
( C4
::Budgets
::GetBudget
($budget_id111)->{budget_owner_id
},
737 $jane_doe, "SetOwnerToFundHierarchy should have set John Doe $jane_doe for budget 111 ($budget_id111)" );
738 is
( C4
::Budgets
::GetBudget
($budget_id12)->{budget_owner_id
},
739 $john_doe, "SetOwnerToFundHierarchy should have set John Doe $john_doe for budget 12 ($budget_id12 )" );
740 is
( C4
::Budgets
::GetBudget
($budget_id2)->{budget_owner_id
},
741 undef, "SetOwnerToFundHierarchy should have set John Doe $john_doe for budget 2 ($budget_id2)" );
742 is
( C4
::Budgets
::GetBudget
($budget_id21)->{budget_owner_id
},
743 undef, "SetOwnerToFundHierarchy should have set John Doe $john_doe for budget 21 ($budget_id21)" );
745 # Test GetBudgetAuthCats
747 my $budgetPeriodId = AddBudgetPeriod
({
748 budget_period_startdate
=> '2008-01-01',
749 budget_period_enddate
=> '2008-12-31',
750 budget_period_description
=> 'just another budget',
751 budget_period_active
=> 0,
754 $budgets = GetBudgets
();
756 for my $budget ( @
$budgets )
758 $budget->{sort1_authcat
} = "sort1_authcat_$i";
759 $budget->{sort2_authcat
} = "sort2_authcat_$i";
760 $budget->{budget_period_id
} = $budgetPeriodId;
761 ModBudget
( $budget );
765 my $authCat = GetBudgetAuthCats
($budgetPeriodId);
767 is
( scalar @
{$authCat}, $i * 2, "GetBudgetAuthCats returns only non-empty sorting categories (no empty authCat in db)" );
770 for my $budget ( @
$budgets )
772 $budget->{sort1_authcat
} = "sort_authcat_$i";
773 $budget->{sort2_authcat
} = "sort_authcat_$i";
774 $budget->{budget_period_id
} = $budgetPeriodId;
775 ModBudget
( $budget );
779 $authCat = GetBudgetAuthCats
($budgetPeriodId);
780 is
( scalar @
$authCat, scalar @
$budgets, "GetBudgetAuthCats returns distinct authCat" );
783 for my $budget ( @
$budgets )
785 $budget->{sort1_authcat
} = "sort1_authcat_$i";
786 $budget->{sort2_authcat
} = "";
787 $budget->{budget_period_id
} = $budgetPeriodId;
788 ModBudget
( $budget );
792 $authCat = GetBudgetAuthCats
($budgetPeriodId);
794 is
( scalar @
{$authCat}, $i, "GetBudgetAuthCats returns only non-empty sorting categories (empty sort2_authcat on all records)" );
797 for my $budget ( @
$budgets )
799 $budget->{sort1_authcat
} = "";
800 $budget->{sort2_authcat
} = "";
801 $budget->{budget_period_id
} = $budgetPeriodId;
802 ModBudget
( $budget );
806 $authCat = GetBudgetAuthCats
($budgetPeriodId);
808 is
( scalar @
{$authCat}, 0, "GetBudgetAuthCats returns only non-empty sorting categories (all empty)" );
810 # /Test GetBudgetAuthCats
812 subtest
'GetBudgetSpent and GetBudgetOrdered' => sub {
815 my $budget = $builder->build({
816 source
=> 'Aqbudget',
818 budget_amount
=> 1000,
821 my $invoice = $builder->build({
822 source
=> 'Aqinvoice',
828 my $spent = GetBudgetSpent
( $budget->{budget_id
} );
829 my $ordered = GetBudgetOrdered
( $budget->{budget_id
} );
831 is
( $spent, 0, "New budget, no orders/invoices, should be nothing spent");
832 is
( $ordered, 0, "New budget, no orders/invoices, should be nothing ordered");
834 my $inv_adj_1 = $builder->build({
835 source
=> 'AqinvoiceAdjustment',
837 invoiceid
=> $invoice->{invoiceid
},
840 budget_id
=> $budget->{budget_id
},
844 $spent = GetBudgetSpent
( $budget->{budget_id
} );
845 $ordered = GetBudgetOrdered
( $budget->{budget_id
} );
846 is
( $spent, 0, "After adding invoice adjustment on open invoice, should be nothing spent");
847 is
( $ordered, 0, "After adding invoice adjustment on open invoice not encumbered, should be nothing ordered");
849 my $inv_adj_2 = $builder->build({
850 source
=> 'AqinvoiceAdjustment',
852 invoiceid
=> $invoice->{invoiceid
},
855 budget_id
=> $budget->{budget_id
},
859 $spent = GetBudgetSpent
( $budget->{budget_id
} );
860 $ordered = GetBudgetOrdered
( $budget->{budget_id
} );
861 is
( $spent, 0, "After adding invoice adjustment on open invoice, should be nothing spent");
862 is
( $ordered, 3, "After adding invoice adjustment on open invoice encumbered, should be 3 ordered");
864 my $invoice_2 = $builder->build({
865 source
=> 'Aqinvoice',
867 closedate
=> '2017-07-01',
870 my $inv_adj_3 = $builder->build({
871 source
=> 'AqinvoiceAdjustment',
873 invoiceid
=> $invoice_2->{invoiceid
},
876 budget_id
=> $budget->{budget_id
},
879 my $inv_adj_4 = $builder->build({
880 source
=> 'AqinvoiceAdjustment',
882 invoiceid
=> $invoice_2->{invoiceid
},
885 budget_id
=> $budget->{budget_id
},
889 $spent = GetBudgetSpent
( $budget->{budget_id
} );
890 $ordered = GetBudgetOrdered
( $budget->{budget_id
} );
891 is
( $spent, 6, "After adding invoice adjustment on closed invoice, should be 6 spent, encumber has no affect once closed");
892 is
( $ordered, 3, "After adding invoice adjustment on closed invoice, should still be 3 ordered");
894 my $budget_2 = $builder->build({
895 source
=> 'Aqbudget',
897 budget_amount
=> 1000,
900 my $inv_adj_5 = $builder->build({
901 source
=> 'AqinvoiceAdjustment',
903 invoiceid
=> $invoice->{invoiceid
},
906 budget_id
=> $budget_2->{budget_id
},
909 my $inv_adj_6 = $builder->build({
910 source
=> 'AqinvoiceAdjustment',
912 invoiceid
=> $invoice_2->{invoiceid
},
915 budget_id
=> $budget_2->{budget_id
},
919 $spent = GetBudgetSpent
( $budget->{budget_id
} );
920 $ordered = GetBudgetOrdered
( $budget->{budget_id
} );
921 is
( $spent, 6, "After adding invoice adjustment on a different budget should be 6 spent/budget unaffected");
922 is
( $ordered, 3, "After adding invoice adjustment on a different budget, should still be 3 ordered/budget unaffected");
926 sub _get_dependencies
{
927 my ($budget_hierarchy) = @_;
929 for my $budget (@
$budget_hierarchy) {
930 if ( $budget->{child
} ) {
931 my @sorted = sort @
{ $budget->{child
} };
932 for my $child_id (@sorted) {
933 push @
{ $graph->{ $budget->{budget_name
} }{children
} },
934 _get_budgetname_by_id
( $budget_hierarchy, $child_id );
937 push @
{ $graph->{ $budget->{budget_name
} }{parents
} },
938 $budget->{parent_id
};
943 sub _get_budgetname_by_id
{
944 my ( $budgets, $budget_id ) = @_;
946 map { ( $_->{budget_id
} eq $budget_id ) ?
$_->{budget_name
} : () }
951 # C4::Context->userenv