3 # This file is part of Koha.
5 # Koha is free software; you can redistribute it and/or modify it
6 # under the terms of the GNU General Public License as published by
7 # the Free Software Foundation; either version 3 of the License, or
8 # (at your option) any later version.
10 # Koha is distributed in the hope that it will be useful, but
11 # WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 # GNU General Public License for more details.
15 # You should have received a copy of the GNU General Public License
16 # along with Koha; if not, see <http://www.gnu.org/licenses>.
20 use POSIX
qw(strftime);
22 use Test
::More tests
=> 63;
26 use_ok
('C4::Acquisition');
28 use_ok
('C4::Budgets');
29 use_ok
('Koha::Acquisition::Order');
30 use_ok
('Koha::Acquisition::Booksellers');
33 # Sub used for testing C4::Acquisition subs returning order(s):
34 # GetOrdersByStatus, GetOrders, GetDeletedOrders, GetOrder etc.
35 # (\@test_missing_fields,\@test_extra_fields,\@test_different_fields,$test_nbr_fields) =
36 # _check_fields_of_order ($exp_fields, $original_order_content, $order_to_check);
38 # $exp_fields : arrayref whose elements are the keys we expect to find
39 # $original_order_content : hashref whose 2 keys str and num contains hashrefs
40 # containing content fields of the order created with Koha::Acquisition::Order
41 # $order_to_check : hashref whose keys/values are the content of an order
42 # returned by the C4::Acquisition sub we are testing
44 # \@test_missing_fields : arrayref void if ok ; otherwise contains the list of
45 # fields missing in $order_to_check
46 # \@test_extra_fields : arrayref void if ok ; otherwise contains the list of
47 # fields unexpected in $order_to_check
48 # \@test_different_fields : arrayref void if ok ; otherwise contains the list of
49 # fields which value is not the same in between $order_to_check and
50 # $test_nbr_fields : contains the number of fields of $order_to_check
52 sub _check_fields_of_order
{
53 my ( $exp_fields, $original_order_content, $order_to_check ) = @_;
54 my @test_missing_fields = ();
55 my @test_extra_fields = ();
56 my @test_different_fields = ();
57 my $test_nbr_fields = scalar( keys %$order_to_check );
58 foreach my $field (@
$exp_fields) {
59 push @test_missing_fields, $field
60 unless exists( $order_to_check->{$field} );
62 foreach my $field ( keys %$order_to_check ) {
63 push @test_extra_fields, $field
64 unless grep ( /^$field$/, @
$exp_fields );
66 foreach my $field ( keys %{ $original_order_content->{str
} } ) {
67 push @test_different_fields, $field
68 unless ( !exists $order_to_check->{$field} )
69 or ( $original_order_content->{str
}->{$field} eq
70 $order_to_check->{$field} );
72 foreach my $field ( keys %{ $original_order_content->{num
} } ) {
73 push @test_different_fields, $field
74 unless ( !exists $order_to_check->{$field} )
75 or ( $original_order_content->{num
}->{$field} ==
76 $order_to_check->{$field} );
79 \
@test_missing_fields, \
@test_extra_fields,
80 \
@test_different_fields, $test_nbr_fields
84 # Sub used for testing C4::Acquisition subs returning several orders
85 # (\@test_missing_fields,\@test_extra_fields,\@test_different_fields,\@test_nbr_fields) =
86 # _check_fields_of_orders ($exp_fields, $original_orders_content, $orders_to_check)
87 sub _check_fields_of_orders
{
88 my ( $exp_fields, $original_orders_content, $orders_to_check ) = @_;
89 my @test_missing_fields = ();
90 my @test_extra_fields = ();
91 my @test_different_fields = ();
92 my @test_nbr_fields = ();
93 foreach my $order_to_check (@
$orders_to_check) {
94 my $original_order_content =
95 ( grep { $_->{str
}->{ordernumber
} eq $order_to_check->{ordernumber
} }
96 @
$original_orders_content )[0];
98 $t_missing_fields, $t_extra_fields,
99 $t_different_fields, $t_nbr_fields
101 = _check_fields_of_order
( $exp_fields, $original_order_content,
103 push @test_missing_fields, @
$t_missing_fields;
104 push @test_extra_fields, @
$t_extra_fields;
105 push @test_different_fields, @
$t_different_fields;
106 push @test_nbr_fields, $t_nbr_fields;
108 @test_missing_fields = keys %{ { map { $_ => 1 } @test_missing_fields } };
109 @test_extra_fields = keys %{ { map { $_ => 1 } @test_extra_fields } };
110 @test_different_fields =
111 keys %{ { map { $_ => 1 } @test_different_fields } };
113 \
@test_missing_fields, \
@test_extra_fields,
114 \
@test_different_fields, \
@test_nbr_fields
119 my $schema = Koha
::Database
->new()->schema();
120 $schema->storage->txn_begin();
122 my $dbh = C4
::Context
->dbh;
123 $dbh->{RaiseError
} = 1;
125 # Creating some orders
126 my $bookseller = Koha
::Acquisition
::Bookseller
->new(
129 address1
=> "bookseller's address",
135 my $booksellerid = $bookseller->id;
137 my $booksellerinfo = Koha
::Acquisition
::Booksellers
->find( $booksellerid );
138 is
( $booksellerinfo->deliverytime,
139 5, 'set deliverytime when creating vendor (Bug 10556)' );
141 my ( $basket, $basketno );
143 $basketno = NewBasket
( $booksellerid, 1 ),
144 "NewBasket( $booksellerid , 1 ) returns $basketno"
146 ok
( $basket = GetBasket
($basketno), "GetBasket($basketno) returns $basket" );
148 my $bpid=AddBudgetPeriod
({
149 budget_period_startdate
=> '2008-01-01'
150 , budget_period_enddate
=> '2008-12-31'
151 , budget_period_active
=> 1
152 , budget_period_description
=> "MAPERI"
155 my $budgetid = C4
::Budgets
::AddBudget
(
157 budget_code
=> "budget_code_test_getordersbybib",
158 budget_name
=> "budget_name_test_getordersbybib",
159 budget_period_id
=> $bpid,
162 my $budget = C4
::Budgets
::GetBudget
($budgetid);
165 my ( $biblionumber1, $biblioitemnumber1 ) = AddBiblio
( MARC
::Record
->new, '' );
166 my ( $biblionumber2, $biblioitemnumber2 ) = AddBiblio
( MARC
::Record
->new, '' );
167 my ( $biblionumber3, $biblioitemnumber3 ) = AddBiblio
( MARC
::Record
->new, '' );
168 my ( $biblionumber4, $biblioitemnumber4 ) = AddBiblio
( MARC
::Record
->new, '' );
170 # Prepare 5 orders, and make distinction beween fields to be tested with eq and with ==
171 # Ex : a price of 50.1 will be stored internally as 5.100000
173 my @order_content = (
176 basketno
=> $basketno,
177 biblionumber
=> $biblionumber1,
178 budget_id
=> $budget->{budget_id
},
180 order_internalnote
=> "internal note",
181 order_vendornote
=> "vendor note",
186 listprice
=> 50.121111,
195 basketno
=> $basketno,
196 biblionumber
=> $biblionumber2,
197 budget_id
=> $budget->{budget_id
}
199 num
=> { quantity
=> 42 }
203 basketno
=> $basketno,
204 biblionumber
=> $biblionumber2,
205 budget_id
=> $budget->{budget_id
},
207 order_internalnote
=> "internal note",
208 order_vendornote
=> "vendor note"
223 basketno
=> $basketno,
224 biblionumber
=> $biblionumber3,
225 budget_id
=> $budget->{budget_id
},
226 order_internalnote
=> "internal note",
227 order_vendornote
=> "vendor note"
243 basketno
=> $basketno,
244 biblionumber
=> $biblionumber4,
245 budget_id
=> $budget->{budget_id
},
246 order_internalnote
=> "internal note",
247 order_vendornote
=> "vendor note"
263 # Create 4 orders in database
266 @ocontent{ keys %{ $order_content[$_]->{num
} } } =
267 values %{ $order_content[$_]->{num
} };
268 @ocontent{ keys %{ $order_content[$_]->{str
} } } =
269 values %{ $order_content[$_]->{str
} };
270 $ordernumbers[$_] = Koha
::Acquisition
::Order
->new( \
%ocontent )->insert->{ordernumber
};
271 $order_content[$_]->{str
}->{ordernumber
} = $ordernumbers[$_];
274 DelOrder
( $order_content[3]->{str
}->{biblionumber
}, $ordernumbers[3] );
276 my $invoiceid = AddInvoice
(
277 invoicenumber
=> 'invoice',
278 booksellerid
=> $booksellerid,
282 my $invoice = GetInvoice
( $invoiceid );
284 my ($datereceived, $new_ordernumber) = ModReceiveOrder
(
286 biblionumber
=> $biblionumber4,
287 order
=> GetOrder
( $ordernumbers[4] ),
288 quantityreceived
=> 1,
290 budget_id
=> $order_content[4]->{str
}->{budget_id
},
294 my $search_orders = SearchOrders
({
295 booksellerid
=> $booksellerid,
296 basketno
=> $basketno
298 isa_ok
( $search_orders, 'ARRAY' );
301 ( scalar @
$search_orders == 4 )
302 and !grep ( $_->{ordernumber
} eq $ordernumbers[3], @
$search_orders )
304 "SearchOrders only gets non-cancelled orders"
307 $search_orders = SearchOrders
({
308 booksellerid
=> $booksellerid,
309 basketno
=> $basketno,
314 ( scalar @
$search_orders == 3 ) and !grep ( (
315 ( $_->{ordernumber
} eq $ordernumbers[3] )
316 or ( $_->{ordernumber
} eq $ordernumbers[4] )
320 "SearchOrders with pending params gets only pending orders (bug 10723)"
323 $search_orders = SearchOrders
({
324 booksellerid
=> $booksellerid,
325 basketno
=> $basketno,
329 is
( scalar (@
$search_orders), 0, "SearchOrders with pending and ordered params gets only pending ordered orders (bug 11170)" );
331 $search_orders = SearchOrders
({
332 ordernumber
=> $ordernumbers[4]
334 is
( scalar (@
$search_orders), 1, "SearchOrders takes into account the ordernumber filter" );
336 $search_orders = SearchOrders
({
337 biblionumber
=> $biblionumber4
339 is
( scalar (@
$search_orders), 1, "SearchOrders takes into account the biblionumber filter" );
341 $search_orders = SearchOrders
({
342 biblionumber
=> $biblionumber4,
345 is
( scalar (@
$search_orders), 0, "SearchOrders takes into account the biblionumber and pending filters" );
348 # Test GetBudgetByOrderNumber
350 ok
( GetBudgetByOrderNumber
( $ordernumbers[0] )->{'budget_id'} eq $budgetid,
351 "GetBudgetByOrderNumber returns expected budget" );
353 my @lateorders = GetLateOrders
(0);
354 is
( scalar grep ( $_->{basketno
} eq $basketno, @lateorders ),
355 0, "GetLateOrders does not get orders from opened baskets" );
356 C4
::Acquisition
::CloseBasket
($basketno);
357 @lateorders = GetLateOrders
(0);
358 isnt
( scalar grep ( $_->{basketno
} eq $basketno, @lateorders ),
359 0, "GetLateOrders gets orders from closed baskets" );
360 ok
( !grep ( $_->{ordernumber
} eq $ordernumbers[3], @lateorders ),
361 "GetLateOrders does not gets cancelled orders" );
362 ok
( !grep ( $_->{ordernumber
} eq $ordernumbers[4], @lateorders ),
363 "GetLateOrders does not gets reveived orders" );
365 $search_orders = SearchOrders
({
366 booksellerid
=> $booksellerid,
367 basketno
=> $basketno,
371 is
( scalar (@
$search_orders), 3, "SearchOrders with pending and ordered params gets only pending ordered orders. After closing the basket, orders are marked as 'ordered' (bug 11170)" );
377 my $order = $lateorders[0];
378 AddClaim
( $order->{ordernumber
} );
379 my $neworder = GetOrder
( $order->{ordernumber
} );
381 $neworder->{claimed_date
},
382 strftime
( "%Y-%m-%d", localtime(time) ),
383 "AddClaim : Check claimed_date"
386 my $order2 = GetOrder
( $ordernumbers[1] );
387 $order2->{order_internalnote
} = "my notes";
388 ( $datereceived, $new_ordernumber ) = ModReceiveOrder
(
390 biblionumber
=> $biblionumber2,
392 quantityreceived
=> 2,
397 $order2 = GetOrder
( $ordernumbers[1] );
398 is
( $order2->{'quantityreceived'},
399 0, 'Splitting up order did not receive any on original order' );
400 is
( $order2->{'quantity'}, 40, '40 items on original order' );
401 is
( $order2->{'budget_id'}, $budgetid,
402 'Budget on original order is unchanged' );
403 is
( $order2->{order_internalnote
}, "my notes",
404 'ModReceiveOrder and GetOrder deal with internal notes' );
406 $neworder = GetOrder
($new_ordernumber);
407 is
( $neworder->{'quantity'}, 2, '2 items on new order' );
408 is
( $neworder->{'quantityreceived'},
409 2, 'Splitting up order received items on new order' );
410 is
( $neworder->{'budget_id'}, $budgetid, 'Budget on new order is unchanged' );
412 is
( $neworder->{ordernumber
}, $new_ordernumber, 'Split: test ordernumber' );
413 is
( $neworder->{parent_ordernumber
}, $ordernumbers[1], 'Split: test parent_ordernumber' );
415 my $orders = GetHistory
( ordernumber
=> $ordernumbers[1] );
416 is
( scalar( @
$orders ), 1, 'GetHistory with a given ordernumber returns 1 order' );
417 $orders = GetHistory
( ordernumber
=> $ordernumbers[1], search_children_too
=> 1 );
418 is
( scalar( @
$orders ), 2, 'GetHistory with a given ordernumber and search_children_too set returns 2 orders' );
420 my $budgetid2 = C4
::Budgets
::AddBudget
(
422 budget_code
=> "budget_code_test_modrecv",
423 budget_name
=> "budget_name_test_modrecv",
427 my $order3 = GetOrder
( $ordernumbers[2] );
428 $order3->{order_internalnote
} = "my other notes";
429 ( $datereceived, $new_ordernumber ) = ModReceiveOrder
(
431 biblionumber
=> $biblionumber2,
433 quantityreceived
=> 2,
435 budget_id
=> $budgetid2,
439 $order3 = GetOrder
( $ordernumbers[2] );
440 is
( $order3->{'quantityreceived'},
441 0, 'Splitting up order did not receive any on original order' );
442 is
( $order3->{'quantity'}, 2, '2 items on original order' );
443 is
( $order3->{'budget_id'}, $budgetid,
444 'Budget on original order is unchanged' );
445 is
( $order3->{order_internalnote
}, "my other notes",
446 'ModReceiveOrder and GetOrder deal with notes' );
448 $neworder = GetOrder
($new_ordernumber);
449 is
( $neworder->{'quantity'}, 2, '2 items on new order' );
450 is
( $neworder->{'quantityreceived'},
451 2, 'Splitting up order received items on new order' );
452 is
( $neworder->{'budget_id'}, $budgetid2, 'Budget on new order is changed' );
454 $order3 = GetOrder
( $ordernumbers[2] );
455 $order3->{order_internalnote
} = "my third notes";
456 ( $datereceived, $new_ordernumber ) = ModReceiveOrder
(
458 biblionumber
=> $biblionumber2,
460 quantityreceived
=> 2,
462 budget_id
=> $budgetid2,
466 $order3 = GetOrder
( $ordernumbers[2] );
467 is
( $order3->{'quantityreceived'}, 2, 'Order not split up' );
468 is
( $order3->{'quantity'}, 2, '2 items on order' );
469 is
( $order3->{'budget_id'}, $budgetid2, 'Budget has changed' );
470 is
( $order3->{order_internalnote
}, "my third notes", 'ModReceiveOrder and GetOrder deal with notes' );
472 my $nonexistent_order = GetOrder
();
473 is
( $nonexistent_order, undef, 'GetOrder returns undef if no ordernumber is given' );
474 $nonexistent_order = GetOrder
( 424242424242 );
475 is
( $nonexistent_order, undef, 'GetOrder returns undef if a nonexistent ordernumber is given' );
478 my $order1 = GetOrder
($ordernumbers[0]);
479 my $error = DelOrder
($order1->{biblionumber
}, $order1->{ordernumber
});
480 ok
((not defined $error), "DelOrder does not fail");
481 $order1 = GetOrder
($order1->{ordernumber
});
482 ok
((defined $order1->{datecancellationprinted
}), "order is cancelled");
483 ok
((not defined $order1->{cancellationreason
}), "order has no cancellation reason");
484 ok
((defined GetBiblio
($order1->{biblionumber
})), "biblio still exists");
486 $order2 = GetOrder
($ordernumbers[1]);
487 $error = DelOrder
($order2->{biblionumber
}, $order2->{ordernumber
}, 1);
488 ok
((not defined $error), "DelOrder does not fail");
489 $order2 = GetOrder
($order2->{ordernumber
});
490 ok
((defined $order2->{datecancellationprinted
}), "order is cancelled");
491 ok
((not defined $order2->{cancellationreason
}), "order has no cancellation reason");
492 ok
((not defined GetBiblio
($order2->{biblionumber
})), "biblio does not exist anymore");
494 my $order4 = GetOrder
($ordernumbers[3]);
495 $error = DelOrder
($order4->{biblionumber
}, $order4->{ordernumber
}, 1, "foobar");
496 ok
((not defined $error), "DelOrder does not fail");
497 $order4 = GetOrder
($order4->{ordernumber
});
498 ok
((defined $order4->{datecancellationprinted
}), "order is cancelled");
499 ok
(($order4->{cancellationreason
} eq "foobar"), "order has cancellation reason \"foobar\"");
500 ok
((not defined GetBiblio
($order4->{biblionumber
})), "biblio does not exist anymore");
501 # End of tests for DelOrder
503 subtest
'ModOrder' => sub {
505 ModOrder
( { ordernumber
=> $order1->{ordernumber
}, unitprice
=> 42 } );
506 my $order = GetOrder
( $order1->{ordernumber
} );
507 is
( int($order->{unitprice
}), 42, 'ModOrder should work even if biblionumber if not passed');
511 my $all_count = scalar GetBudgetsReport
();
512 ok
($all_count >= 1, "GetBudgetReport OK");
514 my $active_count = scalar GetBudgetsReport
(1);
515 ok
($active_count >= 1 , "GetBudgetsReport(1) OK");
517 is
($all_count, scalar GetBudgetsReport
(), "GetBudgetReport returns inactive budget period acquisitions.");
518 ok
($active_count >= scalar GetBudgetsReport
(1), "GetBudgetReport doesn't return inactive budget period acquisitions.");
520 $schema->storage->txn_rollback();