Bug 11549: Add regression test
[koha.git] / t / db_dependent / Acquisition / TransferOrder.t
1 #!/usr/bin/perl
2
3 use Modern::Perl;
4
5 use Test::More tests => 8;
6 use C4::Context;
7 use C4::Acquisition;
8 use C4::Biblio;
9 use C4::Items;
10 use C4::Bookseller;
11 use C4::Budgets;
12 use Koha::DateUtils;
13 use MARC::Record;
14
15 my $dbh = C4::Context->dbh;
16 $dbh->{RaiseError} = 1;
17 $dbh->{AutoCommit} = 0;
18
19 my $booksellerid1 = C4::Bookseller::AddBookseller(
20     {
21         name => "my vendor 1",
22         address1 => "bookseller's address",
23         phone => "0123456",
24         active => 1
25     }
26 );
27
28 my $basketno1 = C4::Acquisition::NewBasket(
29     $booksellerid1
30 );
31
32 my $booksellerid2 = C4::Bookseller::AddBookseller(
33     {
34         name => "my vendor 2",
35         address1 => "bookseller's address",
36         phone => "0123456",
37         active => 1
38     }
39 );
40
41 my $basketno2 = C4::Acquisition::NewBasket(
42     $booksellerid2
43 );
44
45 my $budgetid = C4::Budgets::AddBudget(
46     {
47         budget_code => "budget_code_test_transferorder",
48         budget_name => "budget_name_test_transferorder",
49     }
50 );
51
52 my $budget = C4::Budgets::GetBudget( $budgetid );
53
54 my ($biblionumber, $biblioitemnumber) = AddBiblio(MARC::Record->new, '');
55 my $itemnumber = AddItem({}, $biblionumber);
56
57 my ( undef, $ordernumber ) = C4::Acquisition::NewOrder(
58     {
59         basketno => $basketno1,
60         quantity => 2,
61         biblionumber => $biblionumber,
62         budget_id => $budget->{budget_id},
63     }
64 );
65 NewOrderItem($itemnumber, $ordernumber);
66
67 # Begin tests
68 my $order;
69 is(scalar GetOrders($basketno1), 1, "1 order in basket1");
70 ($order) = GetOrders($basketno1);
71 is(scalar GetItemnumbersFromOrder($order->{ordernumber}), 1, "1 item in basket1's order");
72 is(scalar GetOrders($basketno2), 0, "0 order in basket2");
73
74 diag("Transfering order to basket2");
75 my $newordernumber = TransferOrder($ordernumber, $basketno2);
76 is(scalar GetOrders($basketno1), 0, "0 order in basket1");
77 is(scalar GetOrders($basketno2), 1, "1 order in basket2");
78 ($order) = GetOrders($basketno2);
79 is(scalar GetItemnumbersFromOrder($order->{ordernumber}), 1, "1 item in basket2's order");
80
81 ModReceiveOrder( $biblionumber, $newordernumber, 2, undef, undef, undef, undef, undef, undef, dt_from_string );
82 CancelReceipt( $newordernumber );
83 $order = GetOrder( $newordernumber );
84 is ( $order->{ordernumber}, $newordernumber, 'Regression test Bug 11549: After a transfer, receive and cancel the receive should be possible.' );
85 is ( $order->{basketno}, $basketno2, 'Regression test Bug 11549: The order still exist in the basket where the transfer has been done.');
86
87 $dbh->rollback;