Bug 24813: Prevent api/v1/holds.t to fail randomly
[koha.git] / acqui / addorder.pl
blobabbea1e0c2e6e225a83ce2260ca40b27cbbd4e19
1 #!/usr/bin/perl
3 #script to add an order into the system
4 #written 29/2/00 by chris@katipo.co.nz
6 # Copyright 2000-2002 Katipo Communications
8 # This file is part of Koha.
10 # Koha is free software; you can redistribute it and/or modify it
11 # under the terms of the GNU General Public License as published by
12 # the Free Software Foundation; either version 3 of the License, or
13 # (at your option) any later version.
15 # Koha is distributed in the hope that it will be useful, but
16 # WITHOUT ANY WARRANTY; without even the implied warranty of
17 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 # GNU General Public License for more details.
20 # You should have received a copy of the GNU General Public License
21 # along with Koha; if not, see <http://www.gnu.org/licenses>.
24 =head1 NAME
26 addorder.pl
28 =head1 DESCRIPTION
30 this script allows to add an order.
31 It is called by :
33 =over
35 =item neworderempty.pl to add an order from an existing record or from nothing.
37 =item newordersuggestion.pl to add an order from an existing suggestion.
39 =back
41 =head1 CGI PARAMETERS
43 All of the cgi parameters below are related to the new order.
45 =over
47 =item C<ordernumber>
48 the number of this new order.
50 =item C<basketno>
51 the number of this new basket
53 =item C<booksellerid>
54 the bookseller the librarian has to pay.
56 =item C<existing>
58 =item C<title>
59 the title of the record ordered.
61 =item C<author>
62 the author of the record ordered.
64 =item C<copyrightdate>
65 the copyrightdate of the record ordered.
67 =item C<ISBN>
68 the ISBN of the record ordered.
70 =item C<format>
72 =item C<quantity>
73 the quantity to order.
75 =item C<list_price>
76 the price of this order.
78 =item C<uncertainprice>
79 uncertain price, can't close basket until prices of all orders are known.
81 =item C<branch>
82 the branch where this order will be received.
84 =item C<series>
86 =item C<notes>
87 Notes on this basket.
89 =item C<budget_id>
90 budget_id used to pay this order.
92 =item C<sort1> & C<sort2>
94 =item C<rrp>
96 =item C<ecost>
98 =item C<GST>
100 =item C<budget>
102 =item C<cost>
104 =item C<sub>
106 =item C<invoice>
107 the number of the invoice for this order.
109 =item C<publishercode>
111 =item C<suggestionid>
112 if it is an order from an existing suggestion : the id of this suggestion.
114 =item C<donation>
116 =back
118 =cut
120 use Modern::Perl;
121 use CGI qw ( -utf8 );
122 use C4::Auth; # get_template_and_user
123 use C4::Acquisition; # ModOrder
124 use C4::Suggestions; # ModStatus
125 use C4::Biblio; # AddBiblio TransformKohaToMarc
126 use C4::Budgets;
127 use C4::Items;
128 use C4::Output;
129 use Koha::Acquisition::Currencies;
130 use Koha::Acquisition::Orders;
131 use C4::Barcodes;
133 ### "-------------------- addorder.pl ----------"
135 # FIXME: This needs to do actual error checking and possibly return user to the same form,
136 # not just blindly call C4 functions and print a redirect.
138 my $input = new CGI;
139 my $use_ACQ_framework = $input->param('use_ACQ_framework');
141 # Check if order total amount exceed allowed budget
142 my $confirm_budget_exceeding = $input->param('confirm_budget_exceeding');
143 unless($confirm_budget_exceeding) {
144 my $budget_id = $input->param('budget_id');
145 my $total = $input->param('total');
146 my $budget = GetBudget($budget_id);
147 my $budget_spent = GetBudgetSpent($budget_id);
148 my $budget_ordered = GetBudgetOrdered($budget_id);
149 my $budget_used = $budget_spent + $budget_ordered;
150 my $budget_remaining = $budget->{budget_amount} - $budget_used;
151 my $budget_encumbrance = $budget->{budget_amount} * $budget->{budget_encumb} / 100;
152 my $budget_expenditure = $budget->{budget_expend};
154 if ( $total > $budget_remaining
155 || ( ($budget_encumbrance+0) && ($budget_used + $total) > $budget_encumbrance)
156 || ( ($budget_expenditure+0) && ($budget_used + $total) > $budget_expenditure) )
158 my ($template, $loggedinuser, $cookie) = get_template_and_user({
159 template_name => "acqui/addorder.tt",
160 query => $input,
161 type => "intranet",
162 authnotrequired => 0,
163 flagsrequired => {acquisition => 'order_manage'},
166 my $url = $input->referer();
167 unless ( defined $url ) {
168 my $basketno = $input->param('basketno');
169 $url = "/cgi-bin/koha/acqui/basket.pl?basketno=$basketno";
172 my $vars = $input->Vars;
173 my @vars_loop;
174 foreach (keys %$vars) {
175 push @vars_loop, {
176 name => $_,
177 values => [$input->param($_)],
181 if( ($budget_encumbrance+0) && ($budget_used + $total) > $budget_encumbrance
182 && $total <= $budget_remaining)
184 $template->param(
185 encumbrance_exceeded => 1,
186 encumbrance => sprintf("%.2f", $budget->{'budget_encumb'}),
189 if( ($budget_expenditure+0) && ($budget_used + $total) > $budget_expenditure
190 && $total <= $budget_remaining )
192 my $currency = Koha::Acquisition::Currencies->get_active;
193 $template->param(
194 expenditure_exceeded => 1,
195 expenditure => sprintf("%.2f", $budget_expenditure),
196 currency => ($currency) ? $currency->symbol : '',
199 if($total > $budget_remaining){
200 $template->param(budget_exceeded => 1);
203 $template->param(
204 not_enough_budget => 1,
205 referer => $url,
206 vars_loop => \@vars_loop,
208 output_html_with_http_headers $input, $cookie, $template->output;
209 exit;
213 # get_template_and_user used only to check auth & get user id
214 my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
216 template_name => "acqui/booksellers.tt",
217 query => $input,
218 type => "intranet",
219 authnotrequired => 0,
220 flagsrequired => { acquisition => 'order_manage' },
221 debug => 1,
225 # get CGI parameters
226 my $orderinfo = $input->Vars;
227 $orderinfo->{'list_price'} ||= 0;
228 $orderinfo->{'uncertainprice'} ||= 0;
229 $orderinfo->{subscriptionid} ||= undef;
231 my $user = $input->remote_user;
232 my $basketno = $$orderinfo{basketno};
233 my $basket = Koha::Acquisition::Baskets->find($basketno);
235 # create, modify or delete biblio
236 # create if $quantity>0 and $existing='no'
237 # modify if $quantity>0 and $existing='yes'
238 if ( $basket->{is_standing} || $orderinfo->{quantity} ne '0' ) {
239 #TODO:check to see if biblio exists
240 unless ( $$orderinfo{biblionumber} ) {
242 my $record;
243 if ( $use_ACQ_framework ) {
244 my @tags = $input->multi_param('bib_tag');
245 my @subfields = $input->multi_param('bib_subfield');
246 my @field_values = $input->multi_param('bib_field_value');
247 my $xml = TransformHtmlToXml( \@tags, \@subfields, \@field_values );
248 $record=MARC::Record::new_from_xml($xml, 'UTF-8');
249 } else {
250 #if it doesn't create it
251 $record = TransformKohaToMarc(
253 "biblio.title" => "$$orderinfo{title}",
254 "biblio.author" => $$orderinfo{author} ? $$orderinfo{author} : "",
255 "biblio.seriestitle" => $$orderinfo{series} ? $$orderinfo{series} : "",
256 "biblioitems.isbn" => $$orderinfo{isbn} ? $$orderinfo{isbn} : "",
257 "biblioitems.ean" => $$orderinfo{ean} ? $$orderinfo{ean} : "",
258 "biblioitems.publishercode" => $$orderinfo{publishercode} ? $$orderinfo{publishercode} : "",
259 "biblioitems.publicationyear" => $$orderinfo{publicationyear} ? $$orderinfo{publicationyear}: "",
260 "biblio.copyrightdate" => $$orderinfo{publicationyear} ? $$orderinfo{publicationyear}: "",
261 "biblioitems.itemtype" => $$orderinfo{itemtype} ? $$orderinfo{itemtype} : "",
262 "biblioitems.editionstatement"=> $$orderinfo{editionstatement} ? $$orderinfo{editionstatement} : "",
266 C4::Acquisition::FillWithDefaultValues( $record );
268 # create the record in catalogue, with framework ''
269 my ($biblionumber,$bibitemnum) = AddBiblio($record,'');
271 $orderinfo->{biblionumber}=$biblionumber;
274 # change suggestion status if applicable
275 if ( $orderinfo->{suggestionid} ) {
276 ModSuggestion(
278 suggestionid => $orderinfo->{suggestionid},
279 biblionumber => $orderinfo->{biblionumber},
280 STATUS => 'ORDERED',
285 $orderinfo->{unitprice} = $orderinfo->{ecost} if not defined $orderinfo->{unitprice} or $orderinfo->{unitprice} eq '';
287 $orderinfo = C4::Acquisition::populate_order_with_prices(
289 order => $orderinfo,
290 booksellerid => $orderinfo->{booksellerid},
291 ordering => 1,
295 # if we already have $ordernumber, then it's an ordermodif
296 my $order = Koha::Acquisition::Order->new($orderinfo);
297 if ( $orderinfo->{ordernumber} ) {
298 ModOrder($orderinfo);
300 else { # else, it's a new line
301 $order->store;
303 my $order_users_ids = $input->param('users_ids');
304 my @order_users = split( /:/, $order_users_ids );
305 ModOrderUsers( $order->ordernumber, @order_users );
307 # now, add items if applicable
308 if ($basket->effective_create_items eq 'ordering') {
310 my @tags = $input->multi_param('tag');
311 my @subfields = $input->multi_param('subfield');
312 my @field_values = $input->multi_param('field_value');
313 my @serials = $input->multi_param('serial');
314 my @itemid = $input->multi_param('itemid');
315 my @ind_tag = $input->multi_param('ind_tag');
316 my @indicator = $input->multi_param('indicator');
317 #Rebuilding ALL the data for items into a hash
318 # parting them on $itemid.
320 my %itemhash;
321 my $countdistinct;
322 my $range=scalar(@itemid);
323 for (my $i=0; $i<$range; $i++){
324 unless ($itemhash{$itemid[$i]}){
325 $countdistinct++;
327 push @{$itemhash{$itemid[$i]}->{'tags'}},$tags[$i];
328 push @{$itemhash{$itemid[$i]}->{'subfields'}},$subfields[$i];
329 push @{$itemhash{$itemid[$i]}->{'field_values'}},$field_values[$i];
330 push @{$itemhash{$itemid[$i]}->{'ind_tag'}},$ind_tag[$i];
331 push @{$itemhash{$itemid[$i]}->{'indicator'}},$indicator[$i];
333 foreach my $item (keys %itemhash){
334 my $xml = TransformHtmlToXml( $itemhash{$item}->{'tags'},
335 $itemhash{$item}->{'subfields'},
336 $itemhash{$item}->{'field_values'},
337 $itemhash{$item}->{'indicator'},
338 $itemhash{$item}->{'ind_tag'},
339 'ITEM');
340 my $record=MARC::Record::new_from_xml($xml, 'UTF-8');
341 my ($barcodefield,$barcodesubfield) = GetMarcFromKohaField('items.barcode');
342 next unless ( defined $barcodefield && defined $barcodesubfield );
343 my $barcode = $record->subfield($barcodefield,$barcodesubfield) || '';
344 my $aBpref = C4::Context->preference('autoBarcode');
345 if( $barcode eq '' && $aBpref ne 'OFF'){
346 my $barcodeobj;
347 if ( $aBpref eq 'hbyymmincr'){
348 my ($homebranchfield,$homebranchsubfield) = GetMarcFromKohaField('items.homebranch');
349 my $homebranch = $record->subfield($homebranchfield,$homebranchsubfield);
350 $barcodeobj = C4::Barcodes->new($aBpref, $homebranch);
351 } else {
352 $barcodeobj = C4::Barcodes->new($aBpref);
354 $barcode = $barcodeobj->value();
355 $record->field($barcodefield)->delete_subfield( code => $barcodesubfield);
356 $record->field($barcodefield)->add_subfields($barcodesubfield => $barcode);
358 my ($biblionumber,$bibitemnum,$itemnumber) = AddItemFromMarc($record,$$orderinfo{biblionumber});
359 $order->add_item($itemnumber);
365 my $booksellerid=$$orderinfo{booksellerid};
366 if (my $import_batch_id=$$orderinfo{import_batch_id}) {
367 print $input->redirect("/cgi-bin/koha/acqui/addorderiso2709.pl?import_batch_id=$import_batch_id&basketno=$basketno&booksellerid=$booksellerid");
368 } elsif ( defined $orderinfo->{invoiceid} ) {
369 print $input->redirect("/cgi-bin/koha/acqui/parcel.pl?invoiceid=" . $orderinfo->{invoiceid});
370 } else {
371 print $input->redirect("/cgi-bin/koha/acqui/basket.pl?basketno=$basketno");