Bug 21765: Regression tests
[koha.git] / acqui / basket.pl
blob1b55e74763e98b2a3634a520578f13a636014eb1
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::Booksellers;
37 use Koha::Acquisition::Orders;
38 use Koha::Libraries;
39 use C4::Letters qw/SendAlerts/;
40 use Date::Calc qw/Add_Delta_Days/;
41 use Koha::Database;
42 use Koha::EDI qw( create_edi_order get_edifact_ean );
43 use Koha::CsvProfiles;
44 use Koha::Patrons;
46 =head1 NAME
48 basket.pl
50 =head1 DESCRIPTION
52 This script display all informations about basket for the supplier given
53 on input arg. Moreover, it allows us to add a new order for this supplier from
54 an existing record, a suggestion or a new record.
56 =head1 CGI PARAMETERS
58 =over 4
60 =item $basketno
62 The basket number.
64 =item booksellerid
66 the supplier this script have to display the basket.
68 =item order
70 =back
72 =cut
74 our $query = new CGI;
75 our $basketno = $query->param('basketno');
76 our $ean = $query->param('ean');
77 our $booksellerid = $query->param('booksellerid');
78 my $duplinbatch = $query->param('duplinbatch');
80 our ( $template, $loggedinuser, $cookie, $userflags ) = get_template_and_user(
82 template_name => "acqui/basket.tt",
83 query => $query,
84 type => "intranet",
85 authnotrequired => 0,
86 flagsrequired => { acquisition => 'order_manage' },
87 debug => 1,
91 our $basket = GetBasket($basketno);
92 $booksellerid = $basket->{booksellerid} unless $booksellerid;
93 my $bookseller = Koha::Acquisition::Booksellers->find( $booksellerid );
94 my $schema = Koha::Database->new()->schema();
95 my $rs = $schema->resultset('VendorEdiAccount')->search(
96 { vendor_id => $booksellerid, } );
97 $template->param( ediaccount => ($rs->count > 0));
99 unless (CanUserManageBasket($loggedinuser, $basket, $userflags)) {
100 $template->param(
101 cannot_manage_basket => 1,
102 basketno => $basketno,
103 basketname => $basket->{basketname},
104 booksellerid => $booksellerid,
105 booksellername => $bookseller->name,
107 output_html_with_http_headers $query, $cookie, $template->output;
108 exit;
111 # FIXME : what about the "discount" percentage?
112 # FIXME : the query->param('booksellerid') below is probably useless. The bookseller is always known from the basket
113 # if no booksellerid in parameter, get it from basket
114 # warn "=>".$basket->{booksellerid};
115 my $op = $query->param('op') // 'list';
117 our $confirm_pref= C4::Context->preference("BasketConfirmations") || '1';
118 $template->param( skip_confirm_reopen => 1) if $confirm_pref eq '2';
120 my @messages;
122 if ( $op eq 'delete_confirm' ) {
123 my $basketno = $query->param('basketno');
124 my $delbiblio = $query->param('delbiblio');
125 my @orders = GetOrders($basketno);
126 #Delete all orders included in that basket, and all items received.
127 foreach my $myorder (@orders){
128 DelOrder($myorder->{biblionumber},$myorder->{ordernumber});
130 # if $delbiblio = 1, delete the records if possible
131 if ((defined $delbiblio)and ($delbiblio ==1)){
132 my @cannotdelbiblios ;
133 foreach my $myorder (@orders){
134 my $biblionumber = $myorder->{'biblionumber'};
135 my $biblio = Koha::Biblios->find( $biblionumber );
136 my $countbiblio = CountBiblioInOrders($biblionumber);
137 my $ordernumber = $myorder->{'ordernumber'};
138 my $cnt_subscriptions = $biblio->subscriptions->count;
139 my $itemcount = $biblio->items->count;
140 my $error;
141 if ($countbiblio == 0 && $itemcount == 0 && not $cnt_subscriptions ) {
142 $error = DelBiblio($myorder->{biblionumber}) }
143 else {
144 push @cannotdelbiblios, {biblionumber=> ($myorder->{biblionumber}),
145 title=> $myorder->{'title'},
146 author=> $myorder->{'author'},
147 countbiblio=> $countbiblio,
148 itemcount=>$itemcount,
149 subscriptions => $cnt_subscriptions};
151 if ($error) {
152 push @cannotdelbiblios, {biblionumber=> ($myorder->{biblionumber}),
153 title=> $myorder->{'title'},
154 author=> $myorder->{'author'},
155 othererror=> $error};
158 $template->param( cannotdelbiblios => \@cannotdelbiblios );
160 # delete the basket
161 DelBasket($basketno,);
162 $template->param(
163 delete_confirmed => 1,
164 booksellername => $bookseller->name,
165 booksellerid => $booksellerid,
167 } elsif ( !$bookseller ) {
168 $template->param( NO_BOOKSELLER => 1 );
169 } elsif ($op eq 'export') {
170 print $query->header(
171 -type => 'text/csv',
172 -attachment => 'basket' . $basket->{'basketno'} . '.csv',
174 my $csv_profile_id = $query->param('csv_profile');
175 print GetBasketAsCSV( scalar $query->param('basketno'), $query, $csv_profile_id ); # if no csv_profile_id passed, using default rows
176 exit;
177 } elsif ($op eq 'email') {
178 my $err = eval {
179 SendAlerts( 'orderacquisition', $query->param('basketno'), 'ACQORDER' );
181 if ( $@ ) {
182 push @messages, { type => 'error', code => $@ };
183 } elsif ( ref $err and exists $err->{error} ) {
184 push @messages, { type => 'error', code => $err->{error} };
185 } else {
186 push @messages, { type => 'message', code => 'email_sent' };
189 $op = 'list';
190 } elsif ($op eq 'close') {
191 my $confirm = $query->param('confirm') || $confirm_pref eq '2';
192 if ($confirm) {
193 my $basketno = $query->param('basketno');
194 my $booksellerid = $query->param('booksellerid');
195 $basketno =~ /^\d+$/ and CloseBasket($basketno);
196 # if requested, create basket group, close it and attach the basket
197 if ($query->param('createbasketgroup')) {
198 my $branchcode;
199 if(C4::Context->userenv and C4::Context->userenv->{'branch'}
200 and C4::Context->userenv->{'branch'} ne "NO_LIBRARY_SET") {
201 $branchcode = C4::Context->userenv->{'branch'};
203 my $basketgroupid = NewBasketgroup( { name => $basket->{basketname},
204 booksellerid => $booksellerid,
205 deliveryplace => $branchcode,
206 billingplace => $branchcode,
207 closed => 1,
209 ModBasket( { basketno => $basketno,
210 basketgroupid => $basketgroupid } );
211 print $query->redirect('/cgi-bin/koha/acqui/basketgroup.pl?booksellerid='.$booksellerid.'&closed=1');
212 } else {
213 print $query->redirect('/cgi-bin/koha/acqui/booksellers.pl?booksellerid=' . $booksellerid);
215 exit;
216 } else {
217 $template->param(
218 confirm_close => "1",
219 booksellerid => $booksellerid,
220 booksellername => $bookseller->name,
221 basketno => $basket->{'basketno'},
222 basketname => $basket->{'basketname'},
223 basketgroupname => $basket->{'basketname'},
226 } elsif ($op eq 'reopen') {
227 ReopenBasket(scalar $query->param('basketno'));
228 print $query->redirect('/cgi-bin/koha/acqui/basket.pl?basketno='.$basket->{'basketno'})
230 elsif ( $op eq 'ediorder' ) {
231 edi_close_and_order()
232 } elsif ( $op eq 'mod_users' ) {
233 my $basketusers_ids = $query->param('users_ids');
234 my @basketusers = split( /:/, $basketusers_ids );
235 ModBasketUsers($basketno, @basketusers);
236 print $query->redirect("/cgi-bin/koha/acqui/basket.pl?basketno=$basketno");
237 exit;
238 } elsif ( $op eq 'mod_branch' ) {
239 my $branch = $query->param('branch');
240 $branch = undef if(defined $branch and $branch eq '');
241 ModBasket({
242 basketno => $basket->{basketno},
243 branch => $branch
245 print $query->redirect("/cgi-bin/koha/acqui/basket.pl?basketno=$basketno");
246 exit;
249 if ( $op eq 'list' ) {
250 my @branches_loop;
251 # get librarian branch...
252 if ( C4::Context->preference("IndependentBranches") ) {
253 my $userenv = C4::Context->userenv;
254 unless ( C4::Context->IsSuperLibrarian() ) {
255 my $validtest = ( $basket->{creationdate} eq '' )
256 || ( $userenv->{branch} eq $basket->{branch} )
257 || ( $userenv->{branch} eq '' )
258 || ( $basket->{branch} eq '' );
259 unless ($validtest) {
260 print $query->redirect("../mainpage.pl");
261 exit 0;
265 if (!defined $basket->{branch} or $basket->{branch} eq $userenv->{branch}) {
266 push @branches_loop, {
267 branchcode => $userenv->{branch},
268 branchname => $userenv->{branchname},
269 selected => 1,
272 } else {
273 # get branches
274 my $branches = Koha::Libraries->search( {}, { order_by => ['branchname'] } )->unblessed;
275 foreach my $branch (@$branches) {
276 my $selected = 0;
277 if (defined $basket->{branch}) {
278 $selected = 1 if $branch->{branchcode} eq $basket->{branch};
279 } else {
280 $selected = 1 if $branch->{branchcode} eq C4::Context->userenv->{branch};
282 push @branches_loop, {
283 branchcode => $branch->{branchcode},
284 branchname => $branch->{branchname},
285 selected => $selected
290 #if the basket is closed,and the user has the permission to edit basketgroups, display a list of basketgroups
291 my ($basketgroup, $basketgroups);
292 my $patron = Koha::Patrons->find($loggedinuser);
293 if ($basket->{closedate} && haspermission($patron->userid, { acquisition => 'group_manage'} )) {
294 $basketgroups = GetBasketgroups($basket->{booksellerid});
295 for my $bg ( @{$basketgroups} ) {
296 if ($basket->{basketgroupid} && $basket->{basketgroupid} == $bg->{id}){
297 $bg->{default} = 1;
298 $basketgroup = $bg;
303 # if the basket is closed, calculate estimated delivery date
304 my $estimateddeliverydate;
305 if( $basket->{closedate} ) {
306 my ($year, $month, $day) = ($basket->{closedate} =~ /(\d+)-(\d+)-(\d+)/);
307 ($year, $month, $day) = Add_Delta_Days($year, $month, $day, $bookseller->deliverytime);
308 $estimateddeliverydate = sprintf( "%04d-%02d-%02d", $year, $month, $day );
311 # if new basket, pre-fill infos
312 $basket->{creationdate} = "" unless ( $basket->{creationdate} );
313 $basket->{authorisedby} = $loggedinuser unless ( $basket->{authorisedby} );
314 $debug
315 and warn sprintf
316 "loggedinuser: $loggedinuser; creationdate: %s; authorisedby: %s",
317 $basket->{creationdate}, $basket->{authorisedby};
319 my @basketusers_ids = GetBasketUsers($basketno);
320 my @basketusers;
321 foreach my $basketuser_id (@basketusers_ids) {
322 # FIXME Could be improved with a search -in
323 my $basket_patron = Koha::Patrons->find( $basketuser_id );
324 push @basketusers, $basket_patron if $basket_patron;
327 my $active_currency = Koha::Acquisition::Currencies->get_active;
329 my @orders = GetOrders( $basketno );
330 my @books_loop;
332 my @book_foot_loop;
333 my %foot;
334 my $total_quantity = 0;
335 my $total_tax_excluded = 0;
336 my $total_tax_included = 0;
337 my $total_tax_value = 0;
338 for my $order (@orders) {
339 my $line = get_order_infos( $order, $bookseller);
340 if ( $line->{uncertainprice} ) {
341 $template->param( uncertainprices => 1 );
344 $line->{tax_rate} = $line->{tax_rate_on_ordering} // 0;
345 $line->{tax_value} = $line->{tax_value_on_ordering} // 0;
347 push @books_loop, $line;
349 $foot{$$line{tax_rate}}{tax_rate} = $$line{tax_rate};
350 $foot{$$line{tax_rate}}{tax_value} += $$line{tax_value};
351 $total_tax_value += $$line{tax_value};
352 $foot{$$line{tax_rate}}{quantity} += $$line{quantity};
353 $total_quantity += $$line{quantity};
354 $foot{$$line{tax_rate}}{total_tax_excluded} += $$line{total_tax_excluded};
355 $total_tax_excluded += $$line{total_tax_excluded};
356 $foot{$$line{tax_rate}}{total_tax_included} += $$line{total_tax_included};
357 $total_tax_included += $$line{total_tax_included};
360 push @book_foot_loop, map {$_} values %foot;
362 # Get cancelled orders
363 my @cancelledorders = GetOrders($basketno, { cancelled => 1 });
364 my @cancelledorders_loop;
365 for my $order (@cancelledorders) {
366 my $line = get_order_infos( $order, $bookseller);
367 push @cancelledorders_loop, $line;
370 my $contract = GetContract({
371 contractnumber => $basket->{contractnumber}
374 if ($basket->{basketgroupid}){
375 $basketgroup = GetBasketgroup($basket->{basketgroupid});
377 my $budgets = GetBudgetHierarchy;
378 my $has_budgets = 0;
379 foreach my $r (@{$budgets}) {
380 if (!defined $r->{budget_amount} || $r->{budget_amount} == 0) {
381 next;
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 ? $basket->{is_standing} : 1,
430 has_budgets => $has_budgets,
431 duplinbatch => $duplinbatch,
432 csv_profiles => [ Koha::CsvProfiles->search({ type => 'sql', used_for => 'export_basket' }) ],
436 $template->param( messages => \@messages );
437 output_html_with_http_headers $query, $cookie, $template->output;
439 sub get_order_infos {
440 my $order = shift;
441 my $bookseller = shift;
442 my $qty = $order->{'quantity'} || 0;
443 if ( !defined $order->{quantityreceived} ) {
444 $order->{quantityreceived} = 0;
446 my $budget = GetBudget($order->{budget_id});
447 my $basket = GetBasket($order->{basketno});
449 my %line = %{ $order };
450 # Don't show unreceived standing orders as received
451 $line{order_received} = ( $qty == $order->{'quantityreceived'} && ( $basket->{is_standing} ? $qty : 1 ) );
452 $line{basketno} = $basketno;
453 $line{budget_name} = $budget->{budget_name};
455 $line{total_tax_included} = $line{ecost_tax_included} * $line{quantity};
456 $line{total_tax_excluded} = $line{ecost_tax_excluded} * $line{quantity};
457 $line{tax_value} = $line{tax_value_on_ordering};
458 $line{tax_rate} = $line{tax_rate_on_ordering};
460 if ( $line{uncertainprice} ) {
461 $line{rrp_tax_excluded} .= ' (Uncertain)';
463 if ( $line{'title'} ) {
464 my $volume = $order->{'volume'};
465 my $seriestitle = $order->{'seriestitle'};
466 $line{'title'} .= " / $seriestitle" if $seriestitle;
467 $line{'title'} .= " / $volume" if $volume;
470 my $biblionumber = $order->{'biblionumber'};
471 if ( $biblionumber ) { # The biblio still exists
472 my $biblio = Koha::Biblios->find( $biblionumber );
473 my $countbiblio = CountBiblioInOrders($biblionumber);
474 my $ordernumber = $order->{'ordernumber'};
475 my $cnt_subscriptions = $biblio->subscriptions->count;
476 my $itemcount = $biblio->items->count;
477 my $holds_count = $biblio->holds->count;
478 my $order = Koha::Acquisition::Orders->find($ordernumber); # FIXME We should certainly do that at the beginning of this sub
479 my $items = $order->items;
480 my $itemholds = $biblio->holds->search({ itemnumber => { -in => [ $items->get_column('itemnumber') ] } })->count;
482 # 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
483 $line{can_del_bib} = 1 if $countbiblio <= 1 && $itemcount == $items->count && !($cnt_subscriptions) && !($holds_count);
484 $line{items} = $itemcount - $items->count;
485 $line{left_item} = 1 if $line{items} >= 1;
486 $line{left_biblio} = 1 if $countbiblio > 1;
487 $line{biblios} = $countbiblio - 1;
488 $line{left_subscription} = 1 if $cnt_subscriptions;
489 $line{subscriptions} = $cnt_subscriptions;
490 ($holds_count >= 1) ? $line{left_holds} = 1 : $line{left_holds} = 0;
491 $line{left_holds_on_order} = 1 if $line{left_holds}==1 && ($line{items} == 0 || $itemholds );
492 $line{holds} = $holds_count;
493 $line{holds_on_order} = $itemholds?$itemholds:$holds_count if $line{left_holds_on_order};
497 my $suggestion = GetSuggestionInfoFromBiblionumber($line{biblionumber});
498 $line{suggestionid} = $$suggestion{suggestionid};
499 $line{surnamesuggestedby} = $$suggestion{surnamesuggestedby};
500 $line{firstnamesuggestedby} = $$suggestion{firstnamesuggestedby};
502 foreach my $key (qw(transferred_from transferred_to)) {
503 if ($line{$key}) {
504 my $order = GetOrder($line{$key});
505 my $basket = GetBasket($order->{basketno});
506 my $bookseller = Koha::Acquisition::Booksellers->find( $basket->{booksellerid} );
507 $line{$key} = {
508 order => $order,
509 basket => $basket,
510 bookseller => $bookseller,
511 timestamp => $line{$key . '_timestamp'},
516 return \%line;
519 sub edi_close_and_order {
520 my $confirm = $query->param('confirm') || $confirm_pref eq '2';
521 if ($confirm) {
522 my $edi_params = {
523 basketno => $basketno,
524 ean => $ean,
526 if ( $basket->{branch} ) {
527 $edi_params->{branchcode} = $basket->{branch};
529 if ( create_edi_order($edi_params) ) {
530 #$template->param( edifile => 1 );
532 CloseBasket($basketno);
534 # if requested, create basket group, close it and attach the basket
535 if ( $query->param('createbasketgroup') ) {
536 my $branchcode;
537 if ( C4::Context->userenv
538 and C4::Context->userenv->{'branch'}
539 and C4::Context->userenv->{'branch'} ne "NO_LIBRARY_SET" )
541 $branchcode = C4::Context->userenv->{'branch'};
543 my $basketgroupid = NewBasketgroup(
545 name => $basket->{basketname},
546 booksellerid => $booksellerid,
547 deliveryplace => $branchcode,
548 billingplace => $branchcode,
549 closed => 1,
552 ModBasket(
554 basketno => $basketno,
555 basketgroupid => $basketgroupid
558 print $query->redirect(
559 "/cgi-bin/koha/acqui/basketgroup.pl?booksellerid=$booksellerid&closed=1"
562 else {
563 print $query->redirect(
564 "/cgi-bin/koha/acqui/booksellers.pl?booksellerid=$booksellerid"
567 exit;
569 else {
570 $template->param(
571 edi_confirm => 1,
572 booksellerid => $booksellerid,
573 basketno => $basket->{basketno},
574 basketname => $basket->{basketname},
575 basketgroupname => $basket->{basketname},
577 if ($ean) {
578 $template->param( ean => $ean );
582 return;