Bug 26922: Regression tests
[koha.git] / acqui / basket.pl
blobf77d86b88c4b6f39dc1773a07bc3d8a3b00601ad
1 #!/usr/bin/perl
3 #script to show display basket of orders
5 # Copyright 2000 - 2004 Katipo
6 # Copyright 2008 - 2009 BibLibre SARL
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>.
23 use Modern::Perl;
24 use C4::Auth;
25 use C4::Koha;
26 use C4::Output;
27 use CGI qw ( -utf8 );
28 use C4::Acquisition;
29 use C4::Budgets;
30 use C4::Contract;
31 use C4::Debug;
32 use C4::Biblio;
33 use C4::Items;
34 use C4::Suggestions;
35 use Koha::Biblios;
36 use Koha::Acquisition::Baskets;
37 use Koha::Acquisition::Booksellers;
38 use Koha::Acquisition::Orders;
39 use Koha::Libraries;
40 use C4::Letters qw/SendAlerts/;
41 use Date::Calc qw/Add_Delta_Days/;
42 use Koha::Database;
43 use Koha::EDI qw( create_edi_order get_edifact_ean );
44 use Koha::CsvProfiles;
45 use Koha::Patrons;
47 use Koha::AdditionalFields;
49 =head1 NAME
51 basket.pl
53 =head1 DESCRIPTION
55 This script display all informations about basket for the supplier given
56 on input arg. Moreover, it allows us to add a new order for this supplier from
57 an existing record, a suggestion or a new record.
59 =head1 CGI PARAMETERS
61 =over 4
63 =item $basketno
65 The basket number.
67 =item booksellerid
69 the supplier this script have to display the basket.
71 =item order
73 =back
75 =cut
77 our $query = CGI->new;
78 our $basketno = $query->param('basketno');
79 our $ean = $query->param('ean');
80 our $booksellerid = $query->param('booksellerid');
81 my $duplinbatch = $query->param('duplinbatch');
83 our ( $template, $loggedinuser, $cookie, $userflags ) = get_template_and_user(
85 template_name => "acqui/basket.tt",
86 query => $query,
87 type => "intranet",
88 flagsrequired => { acquisition => 'order_manage' },
89 debug => 1,
93 my $logged_in_patron = Koha::Patrons->find( $loggedinuser );
95 our $basket = GetBasket($basketno);
96 $booksellerid = $basket->{booksellerid} unless $booksellerid;
97 my $bookseller = Koha::Acquisition::Booksellers->find( $booksellerid );
98 my $schema = Koha::Database->new()->schema();
99 my $rs = $schema->resultset('VendorEdiAccount')->search(
100 { vendor_id => $booksellerid, } );
101 $template->param( ediaccount => ($rs->count > 0));
103 unless (CanUserManageBasket($loggedinuser, $basket, $userflags)) {
104 $template->param(
105 cannot_manage_basket => 1,
106 basketno => $basketno,
107 basketname => $basket->{basketname},
108 booksellerid => $booksellerid,
109 booksellername => $bookseller->name,
111 output_html_with_http_headers $query, $cookie, $template->output;
112 exit;
115 # FIXME : what about the "discount" percentage?
116 # FIXME : the query->param('booksellerid') below is probably useless. The bookseller is always known from the basket
117 # if no booksellerid in parameter, get it from basket
118 # warn "=>".$basket->{booksellerid};
119 my $op = $query->param('op') // 'list';
121 our $confirm_pref= C4::Context->preference("BasketConfirmations") || '1';
122 $template->param( skip_confirm_reopen => 1) if $confirm_pref eq '2';
124 my @messages;
126 if ( $op eq 'delete_confirm' ) {
128 output_and_exit( $query, $cookie, $template, 'insufficient_permission' )
129 unless $logged_in_patron->has_permission( { acquisition => 'delete_baskets' } );
131 my $basketno = $query->param('basketno');
132 my $delbiblio = $query->param('delbiblio');
133 my $basket_obj = Koha::Acquisition::Baskets->find($basketno);
135 my $orders = $basket_obj->orders;
137 my @cannotdelbiblios;
139 while ( my $order = $orders->next ) {
140 # cancel the order
141 $order->cancel({ delete_biblio => $delbiblio });
142 my @messages = @{ $order->messages };
144 if ( scalar @messages > 0 ) {
146 my $biblio = $order->biblio;
148 push @cannotdelbiblios, {
149 biblionumber => $biblio->id,
150 title => $biblio->title // '',
151 author => $biblio->author // '',
152 countbiblio => $biblio->active_orders->count,
153 itemcount => $biblio->items->count,
154 subscriptions => $biblio->subscriptions->count,
159 $template->param( cannotdelbiblios => \@cannotdelbiblios );
161 # delete the basket
162 $basket_obj->delete;
163 $template->param(
164 delete_confirmed => 1,
165 booksellername => $bookseller->name,
166 booksellerid => $booksellerid,
168 } elsif ( !$bookseller ) {
169 $template->param( NO_BOOKSELLER => 1 );
170 } elsif ($op eq 'export') {
171 print $query->header(
172 -type => 'text/csv',
173 -attachment => 'basket' . $basket->{'basketno'} . '.csv',
175 my $csv_profile_id = $query->param('csv_profile');
176 print GetBasketAsCSV( scalar $query->param('basketno'), $query, $csv_profile_id ); # if no csv_profile_id passed, using default rows
177 exit;
178 } elsif ($op eq 'email') {
179 my $err = eval {
180 SendAlerts( 'orderacquisition', $query->param('basketno'), 'ACQORDER' );
182 if ( $@ ) {
183 push @messages, { type => 'error', code => $@ };
184 } elsif ( ref $err and exists $err->{error} ) {
185 push @messages, { type => 'error', code => $err->{error} };
186 } else {
187 push @messages, { type => 'message', code => 'email_sent' };
190 $op = 'list';
191 } elsif ($op eq 'close') {
192 my $confirm = $query->param('confirm') || $confirm_pref eq '2';
193 if ($confirm) {
195 # close the basket
196 # FIXME: we should fetch the object at the beginning of this script
197 # and get rid of the hash that is passed around
198 Koha::Acquisition::Baskets->find($basketno)->close;
200 # if requested, create basket group, close it and attach the basket
201 if ($query->param('createbasketgroup')) {
202 my $branchcode;
203 if(C4::Context->userenv and C4::Context->userenv->{'branch'}) {
204 $branchcode = C4::Context->userenv->{'branch'};
206 my $basketgroupid = NewBasketgroup( { name => $basket->{basketname},
207 booksellerid => $booksellerid,
208 deliveryplace => $branchcode,
209 billingplace => $branchcode,
210 closed => 1,
212 ModBasket( { basketno => $basketno,
213 basketgroupid => $basketgroupid } );
214 print $query->redirect('/cgi-bin/koha/acqui/basketgroup.pl?booksellerid='.$booksellerid.'&closed=1');
215 } else {
216 print $query->redirect('/cgi-bin/koha/acqui/booksellers.pl?booksellerid=' . $booksellerid);
218 exit;
219 } else {
220 $template->param(
221 confirm_close => "1",
222 booksellerid => $booksellerid,
223 booksellername => $bookseller->name,
224 basketno => $basket->{'basketno'},
225 basketname => $basket->{'basketname'},
226 basketgroupname => $basket->{'basketname'},
229 } elsif ($op eq 'reopen') {
230 ReopenBasket(scalar $query->param('basketno'));
231 print $query->redirect('/cgi-bin/koha/acqui/basket.pl?basketno='.$basket->{'basketno'})
233 elsif ( $op eq 'ediorder' ) {
234 edi_close_and_order()
235 } elsif ( $op eq 'mod_users' ) {
236 my $basketusers_ids = $query->param('users_ids');
237 my @basketusers = split( /:/, $basketusers_ids );
238 ModBasketUsers($basketno, @basketusers);
239 print $query->redirect("/cgi-bin/koha/acqui/basket.pl?basketno=$basketno");
240 exit;
241 } elsif ( $op eq 'mod_branch' ) {
242 my $branch = $query->param('branch');
243 $branch = undef if(defined $branch and $branch eq '');
244 ModBasket({
245 basketno => $basket->{basketno},
246 branch => $branch
248 print $query->redirect("/cgi-bin/koha/acqui/basket.pl?basketno=$basketno");
249 exit;
252 if ( $op eq 'list' ) {
253 my @branches_loop;
254 # get librarian branch...
255 if ( C4::Context->preference("IndependentBranches") ) {
256 my $userenv = C4::Context->userenv;
257 unless ( C4::Context->IsSuperLibrarian() ) {
258 my $validtest = ( $basket->{creationdate} eq '' )
259 || ( $userenv->{branch} eq $basket->{branch} )
260 || ( $userenv->{branch} eq '' )
261 || ( $basket->{branch} eq '' );
262 unless ($validtest) {
263 print $query->redirect("../mainpage.pl");
264 exit 0;
268 if (!defined $basket->{branch} or $basket->{branch} eq $userenv->{branch}) {
269 push @branches_loop, {
270 branchcode => $userenv->{branch},
271 branchname => $userenv->{branchname},
272 selected => 1,
275 } else {
276 # get branches
277 my $branches = Koha::Libraries->search( {}, { order_by => ['branchname'] } )->unblessed;
278 foreach my $branch (@$branches) {
279 my $selected = 0;
280 if (defined $basket->{branch}) {
281 $selected = 1 if $branch->{branchcode} eq $basket->{branch};
282 } else {
283 $selected = 1 if $branch->{branchcode} eq C4::Context->userenv->{branch};
285 push @branches_loop, {
286 branchcode => $branch->{branchcode},
287 branchname => $branch->{branchname},
288 selected => $selected
293 #if the basket is closed,and the user has the permission to edit basketgroups, display a list of basketgroups
294 my ($basketgroup, $basketgroups);
295 my $patron = Koha::Patrons->find($loggedinuser);
296 if ($basket->{closedate} && haspermission($patron->userid, { acquisition => 'group_manage'} )) {
297 $basketgroups = GetBasketgroups($basket->{booksellerid});
298 for my $bg ( @{$basketgroups} ) {
299 if ($basket->{basketgroupid} && $basket->{basketgroupid} == $bg->{id}){
300 $bg->{default} = 1;
301 $basketgroup = $bg;
306 # if the basket is closed, calculate estimated delivery date
307 my $estimateddeliverydate;
308 if( $basket->{closedate} ) {
309 my ($year, $month, $day) = ($basket->{closedate} =~ /(\d+)-(\d+)-(\d+)/);
310 ($year, $month, $day) = Add_Delta_Days($year, $month, $day, $bookseller->deliverytime);
311 $estimateddeliverydate = sprintf( "%04d-%02d-%02d", $year, $month, $day );
314 # if new basket, pre-fill infos
315 $basket->{creationdate} = "" unless ( $basket->{creationdate} );
316 $basket->{authorisedby} = $loggedinuser unless ( $basket->{authorisedby} );
317 $debug
318 and warn sprintf
319 "loggedinuser: $loggedinuser; creationdate: %s; authorisedby: %s",
320 $basket->{creationdate}, $basket->{authorisedby};
322 my @basketusers_ids = GetBasketUsers($basketno);
323 my @basketusers;
324 foreach my $basketuser_id (@basketusers_ids) {
325 # FIXME Could be improved with a search -in
326 my $basket_patron = Koha::Patrons->find( $basketuser_id );
327 push @basketusers, $basket_patron if $basket_patron;
330 my $active_currency = Koha::Acquisition::Currencies->get_active;
332 my @orders = GetOrders( $basketno );
333 my @books_loop;
335 my @book_foot_loop;
336 my %foot;
337 my $total_quantity = 0;
338 my $total_tax_excluded = 0;
339 my $total_tax_included = 0;
340 my $total_tax_value = 0;
341 for my $order (@orders) {
342 my $line = get_order_infos( $order, $bookseller);
343 if ( $line->{uncertainprice} ) {
344 $template->param( uncertainprices => 1 );
347 $line->{tax_rate} = $line->{tax_rate_on_ordering} // 0;
348 $line->{tax_value} = $line->{tax_value_on_ordering} // 0;
350 push @books_loop, $line;
352 $foot{$$line{tax_rate}}{tax_rate} = $$line{tax_rate};
353 $foot{$$line{tax_rate}}{tax_value} += get_rounded_price($$line{tax_value});
354 $total_tax_value += $$line{tax_value};
355 $foot{$$line{tax_rate}}{quantity} += get_rounded_price($$line{quantity});
356 $total_quantity += $$line{quantity};
357 $foot{$$line{tax_rate}}{total_tax_excluded} += $$line{total_tax_excluded};
358 $total_tax_excluded += $$line{total_tax_excluded};
359 $foot{$$line{tax_rate}}{total_tax_included} += $$line{total_tax_included};
360 $total_tax_included += $$line{total_tax_included};
363 push @book_foot_loop, map {$_} values %foot;
365 # Get cancelled orders
366 my @cancelledorders = GetOrders($basketno, { cancelled => 1 });
367 my @cancelledorders_loop;
368 for my $order (@cancelledorders) {
369 my $line = get_order_infos( $order, $bookseller);
370 push @cancelledorders_loop, $line;
373 my $contract = GetContract({
374 contractnumber => $basket->{contractnumber}
377 if ($basket->{basketgroupid}){
378 $basketgroup = GetBasketgroup($basket->{basketgroupid});
380 my $budgets = GetBudgetHierarchy;
381 my $has_budgets = 0;
382 foreach my $r (@{$budgets}) {
383 next unless (CanUserUseBudget($loggedinuser, $r, $userflags));
385 $has_budgets = 1;
386 last;
389 $template->param(
390 basketno => $basketno,
391 basket => $basket,
392 basketname => $basket->{'basketname'},
393 basketbranchcode => $basket->{branch},
394 basketnote => $basket->{note},
395 basketbooksellernote => $basket->{booksellernote},
396 basketcontractno => $basket->{contractnumber},
397 basketcontractname => $contract->{contractname},
398 branches_loop => \@branches_loop,
399 creationdate => $basket->{creationdate},
400 authorisedby => $basket->{authorisedby},
401 authorisedbyname => $basket->{authorisedbyname},
402 users_ids => join(':', @basketusers_ids),
403 users => \@basketusers,
404 closedate => $basket->{closedate},
405 estimateddeliverydate=> $estimateddeliverydate,
406 is_standing => $basket->{is_standing},
407 deliveryplace => $basket->{deliveryplace},
408 billingplace => $basket->{billingplace},
409 active => $bookseller->active,
410 booksellerid => $bookseller->id,
411 booksellername => $bookseller->name,
412 books_loop => \@books_loop,
413 book_foot_loop => \@book_foot_loop,
414 cancelledorders_loop => \@cancelledorders_loop,
415 total_quantity => $total_quantity,
416 total_tax_excluded => $total_tax_excluded,
417 total_tax_included => $total_tax_included,
418 total_tax_value => $total_tax_value,
419 currency => $active_currency->currency,
420 listincgst => $bookseller->listincgst,
421 basketgroups => $basketgroups,
422 basketgroup => $basketgroup,
423 grouped => $basket->{basketgroupid},
424 # The double negatives and booleans here mean:
425 # "A basket cannot be closed if there are no orders in it or it's a standing order basket."
427 # (The template has another implicit restriction that the order cannot be closed if there
428 # are any orders with uncertain prices.)
429 unclosable => @orders || @cancelledorders ? $basket->{is_standing} : 1,
430 has_budgets => $has_budgets,
431 duplinbatch => $duplinbatch,
432 csv_profiles => [ Koha::CsvProfiles->search({ type => 'sql', used_for => 'export_basket' }) ],
433 available_additional_fields => [ Koha::AdditionalFields->search( { tablename => 'aqbasket' } ) ],
434 additional_field_values => { map {
435 $_->field->name => $_->value
436 } Koha::Acquisition::Baskets->find($basketno)->additional_field_values->as_list },
440 $template->param( messages => \@messages );
441 output_html_with_http_headers $query, $cookie, $template->output;
443 sub get_order_infos {
444 my $order = shift;
445 my $bookseller = shift;
446 my $qty = $order->{'quantity'} || 0;
447 if ( !defined $order->{quantityreceived} ) {
448 $order->{quantityreceived} = 0;
450 my $budget = GetBudget($order->{budget_id});
451 my $basket = GetBasket($order->{basketno});
453 my %line = %{ $order };
454 # Don't show unreceived standing orders as received
455 $line{order_received} = ( $qty == $order->{'quantityreceived'} && ( $basket->{is_standing} ? $qty : 1 ) );
456 $line{basketno} = $basketno;
457 $line{budget_name} = $budget->{budget_name};
459 # If we have an actual cost that should be the total, otherwise use the ecost
460 $line{unitprice_tax_included} += 0;
461 $line{unitprice_tax_excluded} += 0;
462 my $cost_tax_included = $line{unitprice_tax_included} || $line{ecost_tax_included};
463 my $cost_tax_excluded = $line{unitprice_tax_excluded} || $line{ecost_tax_excluded};
464 $line{total_tax_included} = get_rounded_price($cost_tax_included) * $line{quantity};
465 $line{total_tax_excluded} = get_rounded_price($cost_tax_excluded) * $line{quantity};
466 $line{tax_value} = $line{tax_value_on_ordering};
467 $line{tax_rate} = $line{tax_rate_on_ordering};
469 if ( $line{'title'} ) {
470 my $volume = $order->{'volume'};
471 my $seriestitle = $order->{'seriestitle'};
472 $line{'title'} .= " / $seriestitle" if $seriestitle;
473 $line{'title'} .= " / $volume" if $volume;
476 my $biblionumber = $order->{'biblionumber'};
477 if ( $biblionumber ) { # The biblio still exists
478 my $biblio = Koha::Biblios->find( $biblionumber );
479 my $countbiblio = $biblio->active_orders->count;
481 my $ordernumber = $order->{'ordernumber'};
482 my $cnt_subscriptions = $biblio->subscriptions->count;
483 my $itemcount = $biblio->items->count;
484 my $holds_count = $biblio->holds->count;
485 my $order = Koha::Acquisition::Orders->find($ordernumber); # FIXME We should certainly do that at the beginning of this sub
486 my $items = $order->items;
487 my $itemholds = $biblio->holds->search({ itemnumber => { -in => [ $items->get_column('itemnumber') ] } })->count;
489 # if the biblio is not in other orders and if there is no items elsewhere and no subscriptions and no holds we can then show the link "Delete order and Biblio" see bug 5680
490 $line{can_del_bib} = 1 if $countbiblio <= 1 && $itemcount == $items->count && !($cnt_subscriptions) && !($holds_count);
491 $line{items} = $itemcount - $items->count;
492 $line{left_item} = 1 if $line{items} >= 1;
493 $line{left_biblio} = 1 if $countbiblio > 1;
494 $line{biblios} = $countbiblio - 1;
495 $line{left_subscription} = 1 if $cnt_subscriptions;
496 $line{subscriptions} = $cnt_subscriptions;
497 ($holds_count >= 1) ? $line{left_holds} = 1 : $line{left_holds} = 0;
498 $line{left_holds_on_order} = 1 if $line{left_holds}==1 && ($line{items} == 0 || $itemholds );
499 $line{holds} = $holds_count;
500 $line{holds_on_order} = $itemholds?$itemholds:$holds_count if $line{left_holds_on_order};
501 $line{order_object} = $order;
505 my $suggestion = GetSuggestionInfoFromBiblionumber($line{biblionumber});
506 $line{suggestionid} = $$suggestion{suggestionid};
507 $line{surnamesuggestedby} = $$suggestion{surnamesuggestedby};
508 $line{firstnamesuggestedby} = $$suggestion{firstnamesuggestedby};
510 foreach my $key (qw(transferred_from transferred_to)) {
511 if ($line{$key}) {
512 my $order = GetOrder($line{$key});
513 my $basket = GetBasket($order->{basketno});
514 my $bookseller = Koha::Acquisition::Booksellers->find( $basket->{booksellerid} );
515 $line{$key} = {
516 order => $order,
517 basket => $basket,
518 bookseller => $bookseller,
519 timestamp => $line{$key . '_timestamp'},
524 return \%line;
527 sub edi_close_and_order {
528 my $confirm = $query->param('confirm') || $confirm_pref eq '2';
529 if ($confirm) {
530 my $edi_params = {
531 basketno => $basketno,
532 ean => $ean,
534 if ( $basket->{branch} ) {
535 $edi_params->{branchcode} = $basket->{branch};
537 if ( create_edi_order($edi_params) ) {
538 #$template->param( edifile => 1 );
540 Koha::Acquisition::Baskets->find($basketno)->close;
542 # if requested, create basket group, close it and attach the basket
543 if ( $query->param('createbasketgroup') ) {
544 my $branchcode;
545 if ( C4::Context->userenv
546 and C4::Context->userenv->{'branch'} )
548 $branchcode = C4::Context->userenv->{'branch'};
550 my $basketgroupid = NewBasketgroup(
552 name => $basket->{basketname},
553 booksellerid => $booksellerid,
554 deliveryplace => $branchcode,
555 billingplace => $branchcode,
556 closed => 1,
559 ModBasket(
561 basketno => $basketno,
562 basketgroupid => $basketgroupid
565 print $query->redirect(
566 "/cgi-bin/koha/acqui/basketgroup.pl?booksellerid=$booksellerid&closed=1"
569 else {
570 print $query->redirect(
571 "/cgi-bin/koha/acqui/booksellers.pl?booksellerid=$booksellerid"
574 exit;
576 else {
577 $template->param(
578 edi_confirm => 1,
579 booksellerid => $booksellerid,
580 basketno => $basket->{basketno},
581 basketname => $basket->{basketname},
582 basketgroupname => $basket->{basketname},
584 if ($ean) {
585 $template->param( ean => $ean );
589 return;