Bug 26579: Remove unused C4::Acquisition::DelOrder function
[koha.git] / C4 / Acquisition.pm
1 package C4::Acquisition;
2
3 # Copyright 2000-2002 Katipo Communications
4 #
5 # This file is part of Koha.
6 #
7 # Koha is free software; you can redistribute it and/or modify it
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
11 #
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
16 #
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20
21 use Modern::Perl;
22 use Carp;
23 use Text::CSV_XS;
24 use C4::Context;
25 use C4::Debug;
26 use C4::Suggestions;
27 use C4::Biblio;
28 use C4::Contract;
29 use C4::Debug;
30 use C4::Templates qw(gettemplate);
31 use Koha::DateUtils qw( dt_from_string output_pref );
32 use Koha::Acquisition::Baskets;
33 use Koha::Acquisition::Booksellers;
34 use Koha::Acquisition::Orders;
35 use Koha::Biblios;
36 use Koha::Exceptions;
37 use Koha::Items;
38 use Koha::Number::Price;
39 use Koha::Libraries;
40 use Koha::CsvProfiles;
41 use Koha::Patrons;
42
43 use C4::Koha;
44
45 use MARC::Field;
46 use MARC::Record;
47
48 use Time::localtime;
49
50 use vars qw(@ISA @EXPORT);
51
52 BEGIN {
53     require Exporter;
54     @ISA    = qw(Exporter);
55     @EXPORT = qw(
56         &GetBasket &NewBasket &CloseBasket &ReopenBasket &DelBasket &ModBasket
57         &GetBasketAsCSV &GetBasketGroupAsCSV
58         &GetBasketsByBookseller &GetBasketsByBasketgroup
59         &GetBasketsInfosByBookseller
60
61         &GetBasketUsers &ModBasketUsers
62         &CanUserManageBasket
63
64         &ModBasketHeader
65
66         &ModBasketgroup &NewBasketgroup &DelBasketgroup &GetBasketgroup &CloseBasketgroup
67         &GetBasketgroups &ReOpenBasketgroup
68
69         &ModOrder &GetOrder &GetOrders &GetOrdersByBiblionumber
70         &GetOrderFromItemnumber
71         &SearchOrders &GetHistory &GetRecentAcqui
72         &ModReceiveOrder &CancelReceipt
73         &TransferOrder
74         &ModItemOrder
75
76         &GetParcels
77
78         &GetInvoices
79         &GetInvoice
80         &GetInvoiceDetails
81         &AddInvoice
82         &ModInvoice
83         &CloseInvoice
84         &ReopenInvoice
85         &DelInvoice
86         &MergeInvoices
87
88         &AddClaim
89         &GetBiblioCountByBasketno
90
91         &GetOrderUsers
92         &ModOrderUsers
93         &NotifyOrderUsers
94
95         &FillWithDefaultValues
96
97         &get_rounded_price
98         &get_rounding_sql
99     );
100 }
101
102
103
104
105
106 sub GetOrderFromItemnumber {
107     my ($itemnumber) = @_;
108     my $dbh          = C4::Context->dbh;
109     my $query        = qq|
110
111     SELECT  * from aqorders    LEFT JOIN aqorders_items
112     ON (     aqorders.ordernumber = aqorders_items.ordernumber   )
113     WHERE itemnumber = ?  |;
114
115     my $sth = $dbh->prepare($query);
116
117 #    $sth->trace(3);
118
119     $sth->execute($itemnumber);
120
121     my $order = $sth->fetchrow_hashref;
122     return ( $order  );
123
124 }
125
126 =head1 NAME
127
128 C4::Acquisition - Koha functions for dealing with orders and acquisitions
129
130 =head1 SYNOPSIS
131
132 use C4::Acquisition;
133
134 =head1 DESCRIPTION
135
136 The functions in this module deal with acquisitions, managing book
137 orders, basket and parcels.
138
139 =head1 FUNCTIONS
140
141 =head2 FUNCTIONS ABOUT BASKETS
142
143 =head3 GetBasket
144
145   $aqbasket = &GetBasket($basketnumber);
146
147 get all basket informations in aqbasket for a given basket
148
149 B<returns:> informations for a given basket returned as a hashref.
150
151 =cut
152
153 sub GetBasket {
154     my ($basketno) = @_;
155     my $dbh        = C4::Context->dbh;
156     my $query = "
157         SELECT  aqbasket.*,
158                 concat( b.firstname,' ',b.surname) AS authorisedbyname
159         FROM    aqbasket
160         LEFT JOIN borrowers b ON aqbasket.authorisedby=b.borrowernumber
161         WHERE basketno=?
162     ";
163     my $sth=$dbh->prepare($query);
164     $sth->execute($basketno);
165     my $basket = $sth->fetchrow_hashref;
166     return ( $basket );
167 }
168
169 #------------------------------------------------------------#
170
171 =head3 NewBasket
172
173   $basket = &NewBasket( $booksellerid, $authorizedby, $basketname,
174       $basketnote, $basketbooksellernote, $basketcontractnumber, $deliveryplace, $billingplace, $is_standing, $create_items );
175
176 Create a new basket in aqbasket table
177
178 =over
179
180 =item C<$booksellerid> is a foreign key in the aqbasket table
181
182 =item C<$authorizedby> is the username of who created the basket
183
184 =back
185
186 The other parameters are optional, see ModBasketHeader for more info on them.
187
188 =cut
189
190 sub NewBasket {
191     my ( $booksellerid, $authorisedby, $basketname, $basketnote,
192         $basketbooksellernote, $basketcontractnumber, $deliveryplace,
193         $billingplace, $is_standing, $create_items ) = @_;
194     my $dbh = C4::Context->dbh;
195     my $query =
196         'INSERT INTO aqbasket (creationdate,booksellerid,authorisedby) '
197       . 'VALUES  (now(),?,?)';
198     $dbh->do( $query, {}, $booksellerid, $authorisedby );
199
200     my $basket = $dbh->{mysql_insertid};
201     $basketname           ||= q{}; # default to empty strings
202     $basketnote           ||= q{};
203     $basketbooksellernote ||= q{};
204     ModBasketHeader( $basket, $basketname, $basketnote, $basketbooksellernote,
205         $basketcontractnumber, $booksellerid, $deliveryplace, $billingplace, $is_standing, $create_items );
206     return $basket;
207 }
208
209 #------------------------------------------------------------#
210
211 =head3 CloseBasket
212
213   &CloseBasket($basketno);
214
215 close a basket (becomes unmodifiable, except for receives)
216
217 =cut
218
219 sub CloseBasket {
220     my ($basketno) = @_;
221     my $dbh        = C4::Context->dbh;
222     $dbh->do('UPDATE aqbasket SET closedate=now() WHERE basketno=?', {}, $basketno );
223
224     $dbh->do(
225 q{UPDATE aqorders SET orderstatus = 'ordered' WHERE basketno = ? AND orderstatus NOT IN ( 'complete', 'cancelled')},
226         {}, $basketno
227     );
228     return;
229 }
230
231 =head3 ReopenBasket
232
233   &ReopenBasket($basketno);
234
235 reopen a basket
236
237 =cut
238
239 sub ReopenBasket {
240     my ($basketno) = @_;
241     my $dbh        = C4::Context->dbh;
242     $dbh->do( q{UPDATE aqbasket SET closedate=NULL WHERE  basketno=?}, {}, $basketno );
243
244     $dbh->do( q{
245         UPDATE aqorders
246         SET orderstatus = 'new'
247         WHERE basketno = ?
248         AND orderstatus NOT IN ( 'complete', 'cancelled' )
249         }, {}, $basketno);
250     return;
251 }
252
253 #------------------------------------------------------------#
254
255 =head3 GetBasketAsCSV
256
257   &GetBasketAsCSV($basketno);
258
259 Export a basket as CSV
260
261 $cgi parameter is needed for column name translation
262
263 =cut
264
265 sub GetBasketAsCSV {
266     my ($basketno, $cgi, $csv_profile_id) = @_;
267     my $basket = GetBasket($basketno);
268     my @orders = GetOrders($basketno);
269     my $contract = GetContract({
270         contractnumber => $basket->{'contractnumber'}
271     });
272
273     my $template = C4::Templates::gettemplate("acqui/csv/basket.tt", "intranet", $cgi);
274     my @rows;
275     if ($csv_profile_id) {
276         my $csv_profile = Koha::CsvProfiles->find( $csv_profile_id );
277         Koha::Exceptions::ObjectNotFound->throw( 'There is no valid csv profile given') unless $csv_profile;
278
279         my $csv = Text::CSV_XS->new({'quote_char'=>'"','escape_char'=>'"','sep_char'=>$csv_profile->csv_separator,'binary'=>1});
280         my $csv_profile_content = $csv_profile->content;
281         my ( @headers, @fields );
282         while ( $csv_profile_content =~ /
283             ([^=\|]+) # header
284             =?
285             ([^\|]*) # fieldname (table.row or row)
286             \|? /gxms
287         ) {
288             my $header = $1;
289             my $field = ($2 eq '') ? $1 : $2;
290
291             $header =~ s/^\s+|\s+$//g; # Trim whitespaces
292             push @headers, $header;
293
294             $field =~ s/[^\.]*\.{1}//; # Remove the table name if exists.
295             $field =~ s/^\s+|\s+$//g; # Trim whitespaces
296             push @fields, $field;
297         }
298         for my $order (@orders) {
299             my @row;
300             my $biblio = Koha::Biblios->find( $order->{biblionumber} );
301             my $biblioitem = $biblio->biblioitem;
302             $order = { %$order, %{ $biblioitem->unblessed } };
303             if ($contract) {
304                 $order = {%$order, %$contract};
305             }
306             $order = {%$order, %$basket, %{ $biblio->unblessed }};
307             for my $field (@fields) {
308                 push @row, $order->{$field};
309             }
310             push @rows, \@row;
311         }
312         my $content = join( $csv_profile->csv_separator, @headers ) . "\n";
313         for my $row ( @rows ) {
314             $csv->combine(@$row);
315             my $string = $csv->string;
316             $content .= $string . "\n";
317         }
318         return $content;
319     }
320     else {
321         foreach my $order (@orders) {
322             my $biblio = Koha::Biblios->find( $order->{biblionumber} );
323             my $biblioitem = $biblio->biblioitem;
324             my $row = {
325                 contractname => $contract->{'contractname'},
326                 ordernumber => $order->{'ordernumber'},
327                 entrydate => $order->{'entrydate'},
328                 isbn => $order->{'isbn'},
329                 author => $biblio->author,
330                 title => $biblio->title,
331                 publicationyear => $biblioitem->publicationyear,
332                 publishercode => $biblioitem->publishercode,
333                 collectiontitle => $biblioitem->collectiontitle,
334                 notes => $order->{'order_vendornote'},
335                 quantity => $order->{'quantity'},
336                 rrp => $order->{'rrp'},
337             };
338             for my $place ( qw( deliveryplace billingplace ) ) {
339                 if ( my $library = Koha::Libraries->find( $row->{deliveryplace} ) ) {
340                     $row->{$place} = $library->branchname
341                 }
342             }
343             foreach(qw(
344                 contractname author title publishercode collectiontitle notes
345                 deliveryplace billingplace
346             ) ) {
347                 # Double the quotes to not be interpreted as a field end
348                 $row->{$_} =~ s/"/""/g if $row->{$_};
349             }
350             push @rows, $row;
351          }
352
353         @rows = sort {
354             if(defined $a->{publishercode} and defined $b->{publishercode}) {
355                 $a->{publishercode} cmp $b->{publishercode};
356             }
357         } @rows;
358
359         $template->param(rows => \@rows);
360
361         return $template->output;
362     }
363 }
364
365
366 =head3 GetBasketGroupAsCSV
367
368   &GetBasketGroupAsCSV($basketgroupid);
369
370 Export a basket group as CSV
371
372 $cgi parameter is needed for column name translation
373
374 =cut
375
376 sub GetBasketGroupAsCSV {
377     my ($basketgroupid, $cgi) = @_;
378     my $baskets = GetBasketsByBasketgroup($basketgroupid);
379
380     my $template = C4::Templates::gettemplate('acqui/csv/basketgroup.tt', 'intranet', $cgi);
381
382     my @rows;
383     for my $basket (@$baskets) {
384         my @orders     = GetOrders( $basket->{basketno} );
385         my $contract   = GetContract({
386             contractnumber => $basket->{contractnumber}
387         });
388         my $bookseller = Koha::Acquisition::Booksellers->find( $basket->{booksellerid} );
389         my $basketgroup = GetBasketgroup( $$basket{basketgroupid} );
390
391         foreach my $order (@orders) {
392             my $biblio = Koha::Biblios->find( $order->{biblionumber} );
393             my $biblioitem = $biblio->biblioitem;
394             my $row = {
395                 clientnumber => $bookseller->accountnumber,
396                 basketname => $basket->{basketname},
397                 ordernumber => $order->{ordernumber},
398                 author => $biblio->author,
399                 title => $biblio->title,
400                 publishercode => $biblioitem->publishercode,
401                 publicationyear => $biblioitem->publicationyear,
402                 collectiontitle => $biblioitem->collectiontitle,
403                 isbn => $order->{isbn},
404                 quantity => $order->{quantity},
405                 rrp_tax_included => $order->{rrp_tax_included},
406                 rrp_tax_excluded => $order->{rrp_tax_excluded},
407                 discount => $bookseller->discount,
408                 ecost_tax_included => $order->{ecost_tax_included},
409                 ecost_tax_excluded => $order->{ecost_tax_excluded},
410                 notes => $order->{order_vendornote},
411                 entrydate => $order->{entrydate},
412                 booksellername => $bookseller->name,
413                 bookselleraddress => $bookseller->address1,
414                 booksellerpostal => $bookseller->postal,
415                 contractnumber => $contract->{contractnumber},
416                 contractname => $contract->{contractname},
417             };
418             my $temp = {
419                 basketgroupdeliveryplace => $basketgroup->{deliveryplace},
420                 basketgroupbillingplace  => $basketgroup->{billingplace},
421                 basketdeliveryplace      => $basket->{deliveryplace},
422                 basketbillingplace       => $basket->{billingplace},
423             };
424             for my $place (qw( basketgroupdeliveryplace basketgroupbillingplace basketdeliveryplace basketbillingplace )) {
425                 if ( my $library = Koha::Libraries->find( $temp->{$place} ) ) {
426                     $row->{$place} = $library->branchname;
427                 }
428             }
429             foreach(qw(
430                 basketname author title publishercode collectiontitle notes
431                 booksellername bookselleraddress booksellerpostal contractname
432                 basketgroupdeliveryplace basketgroupbillingplace
433                 basketdeliveryplace basketbillingplace
434             ) ) {
435                 # Double the quotes to not be interpreted as a field end
436                 $row->{$_} =~ s/"/""/g if $row->{$_};
437             }
438             push @rows, $row;
439          }
440      }
441     $template->param(rows => \@rows);
442
443     return $template->output;
444
445 }
446
447 =head3 CloseBasketgroup
448
449   &CloseBasketgroup($basketgroupno);
450
451 close a basketgroup
452
453 =cut
454
455 sub CloseBasketgroup {
456     my ($basketgroupno) = @_;
457     my $dbh        = C4::Context->dbh;
458     my $sth = $dbh->prepare("
459         UPDATE aqbasketgroups
460         SET    closed=1
461         WHERE  id=?
462     ");
463     $sth->execute($basketgroupno);
464 }
465
466 #------------------------------------------------------------#
467
468 =head3 ReOpenBaskergroup($basketgroupno)
469
470   &ReOpenBaskergroup($basketgroupno);
471
472 reopen a basketgroup
473
474 =cut
475
476 sub ReOpenBasketgroup {
477     my ($basketgroupno) = @_;
478     my $dbh        = C4::Context->dbh;
479     my $sth = $dbh->prepare("
480         UPDATE aqbasketgroups
481         SET    closed=0
482         WHERE  id=?
483     ");
484     $sth->execute($basketgroupno);
485 }
486
487 #------------------------------------------------------------#
488
489
490 =head3 DelBasket
491
492   &DelBasket($basketno);
493
494 Deletes the basket that has basketno field $basketno in the aqbasket table.
495
496 =over
497
498 =item C<$basketno> is the primary key of the basket in the aqbasket table.
499
500 =back
501
502 =cut
503
504 sub DelBasket {
505     my ( $basketno ) = @_;
506     my $query = "DELETE FROM aqbasket WHERE basketno=?";
507     my $dbh = C4::Context->dbh;
508     my $sth = $dbh->prepare($query);
509     $sth->execute($basketno);
510     return;
511 }
512
513 #------------------------------------------------------------#
514
515 =head3 ModBasket
516
517   &ModBasket($basketinfo);
518
519 Modifies a basket, using a hashref $basketinfo for the relevant information, only $basketinfo->{'basketno'} is required.
520
521 =over
522
523 =item C<$basketno> is the primary key of the basket in the aqbasket table.
524
525 =back
526
527 =cut
528
529 sub ModBasket {
530     my $basketinfo = shift;
531     my $query = "UPDATE aqbasket SET ";
532     my @params;
533     foreach my $key (keys %$basketinfo){
534         if ($key ne 'basketno'){
535             $query .= "$key=?, ";
536             push(@params, $basketinfo->{$key} || undef );
537         }
538     }
539 # get rid of the "," at the end of $query
540     if (substr($query, length($query)-2) eq ', '){
541         chop($query);
542         chop($query);
543         $query .= ' ';
544     }
545     $query .= "WHERE basketno=?";
546     push(@params, $basketinfo->{'basketno'});
547     my $dbh = C4::Context->dbh;
548     my $sth = $dbh->prepare($query);
549     $sth->execute(@params);
550
551     return;
552 }
553
554 #------------------------------------------------------------#
555
556 =head3 ModBasketHeader
557
558   &ModBasketHeader($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid);
559
560 Modifies a basket's header.
561
562 =over
563
564 =item C<$basketno> is the "basketno" field in the "aqbasket" table;
565
566 =item C<$basketname> is the "basketname" field in the "aqbasket" table;
567
568 =item C<$note> is the "note" field in the "aqbasket" table;
569
570 =item C<$booksellernote> is the "booksellernote" field in the "aqbasket" table;
571
572 =item C<$contractnumber> is the "contractnumber" (foreign) key in the "aqbasket" table.
573
574 =item C<$booksellerid> is the id (foreign) key in the "aqbooksellers" table for the vendor.
575
576 =item C<$deliveryplace> is the "deliveryplace" field in the aqbasket table.
577
578 =item C<$billingplace> is the "billingplace" field in the aqbasket table.
579
580 =item C<$is_standing> is the "is_standing" field in the aqbasket table.
581
582 =item C<$create_items> should be set to 'ordering', 'receiving' or 'cataloguing' (or undef, in which
583 case the AcqCreateItem syspref takes precedence).
584
585 =back
586
587 =cut
588
589 sub ModBasketHeader {
590     my ($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid, $deliveryplace, $billingplace, $is_standing, $create_items) = @_;
591
592     $is_standing ||= 0;
593     my $query = qq{
594         UPDATE aqbasket
595         SET basketname=?, note=?, booksellernote=?, booksellerid=?, deliveryplace=?, billingplace=?, is_standing=?, create_items=?
596         WHERE basketno=?
597     };
598
599     my $dbh = C4::Context->dbh;
600     my $sth = $dbh->prepare($query);
601     $sth->execute($basketname, $note, $booksellernote, $booksellerid, $deliveryplace, $billingplace, $is_standing, $create_items || undef, $basketno);
602
603     if ( $contractnumber ) {
604         my $query2 ="UPDATE aqbasket SET contractnumber=? WHERE basketno=?";
605         my $sth2 = $dbh->prepare($query2);
606         $sth2->execute($contractnumber,$basketno);
607     }
608     return;
609 }
610
611 #------------------------------------------------------------#
612
613 =head3 GetBasketsByBookseller
614
615   @results = &GetBasketsByBookseller($booksellerid, $extra);
616
617 Returns a list of hashes of all the baskets that belong to bookseller 'booksellerid'.
618
619 =over
620
621 =item C<$booksellerid> is the 'id' field of the bookseller in the aqbooksellers table
622
623 =item C<$extra> is the extra sql parameters, can be
624
625  $extra->{groupby}: group baskets by column
626     ex. $extra->{groupby} = aqbasket.basketgroupid
627  $extra->{orderby}: order baskets by column
628  $extra->{limit}: limit number of results (can be helpful for pagination)
629
630 =back
631
632 =cut
633
634 sub GetBasketsByBookseller {
635     my ($booksellerid, $extra) = @_;
636     my $query = "SELECT * FROM aqbasket WHERE booksellerid=?";
637     if ($extra){
638         if ($extra->{groupby}) {
639             $query .= " GROUP by $extra->{groupby}";
640         }
641         if ($extra->{orderby}){
642             $query .= " ORDER by $extra->{orderby}";
643         }
644         if ($extra->{limit}){
645             $query .= " LIMIT $extra->{limit}";
646         }
647     }
648     my $dbh = C4::Context->dbh;
649     my $sth = $dbh->prepare($query);
650     $sth->execute($booksellerid);
651     return $sth->fetchall_arrayref({});
652 }
653
654 =head3 GetBasketsInfosByBookseller
655
656     my $baskets = GetBasketsInfosByBookseller($supplierid, $allbaskets);
657
658 The optional second parameter allbaskets is a boolean allowing you to
659 select all baskets from the supplier; by default only active baskets (open or 
660 closed but still something to receive) are returned.
661
662 Returns in a arrayref of hashref all about booksellers baskets, plus:
663     total_biblios: Number of distinct biblios in basket
664     total_items: Number of items in basket
665     expected_items: Number of non-received items in basket
666
667 =cut
668
669 sub GetBasketsInfosByBookseller {
670     my ($supplierid, $allbaskets) = @_;
671
672     return unless $supplierid;
673
674     my $dbh = C4::Context->dbh;
675     my $query = q{
676         SELECT aqbasket.basketno, aqbasket.basketname, aqbasket.note, aqbasket.booksellernote, aqbasket.contractnumber, aqbasket.creationdate, aqbasket.closedate, aqbasket.booksellerid, aqbasket.authorisedby, aqbasket.booksellerinvoicenumber, aqbasket.basketgroupid, aqbasket.deliveryplace, aqbasket.billingplace, aqbasket.branch, aqbasket.is_standing, aqbasket.create_items,
677           SUM(aqorders.quantity) AS total_items,
678           SUM(
679             IF ( aqorders.orderstatus = 'cancelled', aqorders.quantity, 0 )
680           ) AS total_items_cancelled,
681           COUNT(DISTINCT aqorders.biblionumber) AS total_biblios,
682           SUM(
683             IF(aqorders.datereceived IS NULL
684               AND aqorders.datecancellationprinted IS NULL
685             , aqorders.quantity
686             , 0)
687           ) AS expected_items,
688         SUM( aqorders.uncertainprice ) AS uncertainprices
689         FROM aqbasket
690           LEFT JOIN aqorders ON aqorders.basketno = aqbasket.basketno
691         WHERE booksellerid = ?};
692
693     $query.=" GROUP BY aqbasket.basketno, aqbasket.basketname, aqbasket.note, aqbasket.booksellernote, aqbasket.contractnumber, aqbasket.creationdate, aqbasket.closedate, aqbasket.booksellerid, aqbasket.authorisedby, aqbasket.booksellerinvoicenumber, aqbasket.basketgroupid, aqbasket.deliveryplace, aqbasket.billingplace, aqbasket.branch, aqbasket.is_standing, aqbasket.create_items";
694
695     unless ( $allbaskets ) {
696         # Don't show the basket if it's NOT CLOSED or is FULLY RECEIVED
697         $query.=" HAVING (closedate IS NULL OR (
698           SUM(
699             IF(aqorders.datereceived IS NULL
700               AND aqorders.datecancellationprinted IS NULL
701             , aqorders.quantity
702             , 0)
703             ) > 0))"
704     }
705
706     my $sth = $dbh->prepare($query);
707     $sth->execute($supplierid);
708     my $baskets = $sth->fetchall_arrayref({});
709
710     # Retrieve the number of biblios cancelled
711     my $cancelled_biblios = $dbh->selectall_hashref( q|
712         SELECT COUNT(DISTINCT(biblionumber)) AS total_biblios_cancelled, aqbasket.basketno
713         FROM aqbasket
714         LEFT JOIN aqorders ON aqorders.basketno = aqbasket.basketno
715         WHERE booksellerid = ?
716         AND aqorders.orderstatus = 'cancelled'
717         GROUP BY aqbasket.basketno
718     |, 'basketno', {}, $supplierid );
719     map {
720         $_->{total_biblios_cancelled} = $cancelled_biblios->{$_->{basketno}}{total_biblios_cancelled} || 0
721     } @$baskets;
722
723     return $baskets;
724 }
725
726 =head3 GetBasketUsers
727
728     $basketusers_ids = &GetBasketUsers($basketno);
729
730 Returns a list of all borrowernumbers that are in basket users list
731
732 =cut
733
734 sub GetBasketUsers {
735     my $basketno = shift;
736
737     return unless $basketno;
738
739     my $query = qq{
740         SELECT borrowernumber
741         FROM aqbasketusers
742         WHERE basketno = ?
743     };
744     my $dbh = C4::Context->dbh;
745     my $sth = $dbh->prepare($query);
746     $sth->execute($basketno);
747     my $results = $sth->fetchall_arrayref( {} );
748
749     my @borrowernumbers;
750     foreach (@$results) {
751         push @borrowernumbers, $_->{'borrowernumber'};
752     }
753
754     return @borrowernumbers;
755 }
756
757 =head3 ModBasketUsers
758
759     my @basketusers_ids = (1, 2, 3);
760     &ModBasketUsers($basketno, @basketusers_ids);
761
762 Delete all users from basket users list, and add users in C<@basketusers_ids>
763 to this users list.
764
765 =cut
766
767 sub ModBasketUsers {
768     my ($basketno, @basketusers_ids) = @_;
769
770     return unless $basketno;
771
772     my $dbh = C4::Context->dbh;
773     my $query = qq{
774         DELETE FROM aqbasketusers
775         WHERE basketno = ?
776     };
777     my $sth = $dbh->prepare($query);
778     $sth->execute($basketno);
779
780     $query = qq{
781         INSERT INTO aqbasketusers (basketno, borrowernumber)
782         VALUES (?, ?)
783     };
784     $sth = $dbh->prepare($query);
785     foreach my $basketuser_id (@basketusers_ids) {
786         $sth->execute($basketno, $basketuser_id);
787     }
788     return;
789 }
790
791 =head3 CanUserManageBasket
792
793     my $bool = CanUserManageBasket($borrower, $basket[, $userflags]);
794     my $bool = CanUserManageBasket($borrowernumber, $basketno[, $userflags]);
795
796 Check if a borrower can manage a basket, according to system preference
797 AcqViewBaskets, user permissions and basket properties (creator, users list,
798 branch).
799
800 First parameter can be either a borrowernumber or a hashref as returned by
801 Koha::Patron->unblessed
802
803 Second parameter can be either a basketno or a hashref as returned by
804 C4::Acquisition::GetBasket.
805
806 The third parameter is optional. If given, it should be a hashref as returned
807 by C4::Auth::getuserflags. If not, getuserflags is called.
808
809 If user is authorised to manage basket, returns 1.
810 Otherwise returns 0.
811
812 =cut
813
814 sub CanUserManageBasket {
815     my ($borrower, $basket, $userflags) = @_;
816
817     if (!ref $borrower) {
818         # FIXME This needs to be replaced
819         # We should not accept both scalar and array
820         # Tests need to be updated
821         $borrower = Koha::Patrons->find( $borrower )->unblessed;
822     }
823     if (!ref $basket) {
824         $basket = GetBasket($basket);
825     }
826
827     return 0 unless ($basket and $borrower);
828
829     my $borrowernumber = $borrower->{borrowernumber};
830     my $basketno = $basket->{basketno};
831
832     my $AcqViewBaskets = C4::Context->preference('AcqViewBaskets');
833
834     if (!defined $userflags) {
835         my $dbh = C4::Context->dbh;
836         my $sth = $dbh->prepare("SELECT flags FROM borrowers WHERE borrowernumber = ?");
837         $sth->execute($borrowernumber);
838         my ($flags) = $sth->fetchrow_array;
839         $sth->finish;
840
841         $userflags = C4::Auth::getuserflags($flags, $borrower->{userid}, $dbh);
842     }
843
844     unless ($userflags->{superlibrarian}
845     || (ref $userflags->{acquisition} && $userflags->{acquisition}->{order_manage_all})
846     || (!ref $userflags->{acquisition} && $userflags->{acquisition}))
847     {
848         if (not exists $userflags->{acquisition}) {
849             return 0;
850         }
851
852         if ( (ref $userflags->{acquisition} && !$userflags->{acquisition}->{order_manage})
853         || (!ref $userflags->{acquisition} && !$userflags->{acquisition}) ) {
854             return 0;
855         }
856
857         if ($AcqViewBaskets eq 'user'
858         && $basket->{authorisedby} != $borrowernumber
859         && ! grep { $borrowernumber eq $_ } GetBasketUsers($basketno)) {
860              return 0;
861         }
862
863         if ($AcqViewBaskets eq 'branch' && defined $basket->{branch}
864         && $basket->{branch} ne $borrower->{branchcode}) {
865             return 0;
866         }
867     }
868
869     return 1;
870 }
871
872 #------------------------------------------------------------#
873
874 =head3 GetBasketsByBasketgroup
875
876   $baskets = &GetBasketsByBasketgroup($basketgroupid);
877
878 Returns a reference to all baskets that belong to basketgroup $basketgroupid.
879
880 =cut
881
882 sub GetBasketsByBasketgroup {
883     my $basketgroupid = shift;
884     my $query = qq{
885         SELECT *, aqbasket.booksellerid as booksellerid
886         FROM aqbasket
887         LEFT JOIN aqcontract USING(contractnumber) WHERE basketgroupid=?
888     };
889     my $dbh = C4::Context->dbh;
890     my $sth = $dbh->prepare($query);
891     $sth->execute($basketgroupid);
892     return $sth->fetchall_arrayref({});
893 }
894
895 #------------------------------------------------------------#
896
897 =head3 NewBasketgroup
898
899   $basketgroupid = NewBasketgroup(\%hashref);
900
901 Adds a basketgroup to the aqbasketgroups table, and add the initial baskets to it.
902
903 $hashref->{'booksellerid'} is the 'id' field of the bookseller in the aqbooksellers table,
904
905 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
906
907 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
908
909 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
910
911 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
912
913 $hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table,
914
915 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
916
917 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
918
919 =cut
920
921 sub NewBasketgroup {
922     my $basketgroupinfo = shift;
923     die "booksellerid is required to create a basketgroup" unless $basketgroupinfo->{'booksellerid'};
924     my $query = "INSERT INTO aqbasketgroups (";
925     my @params;
926     foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
927         if ( defined $basketgroupinfo->{$field} ) {
928             $query .= "$field, ";
929             push(@params, $basketgroupinfo->{$field});
930         }
931     }
932     $query .= "booksellerid) VALUES (";
933     foreach (@params) {
934         $query .= "?, ";
935     }
936     $query .= "?)";
937     push(@params, $basketgroupinfo->{'booksellerid'});
938     my $dbh = C4::Context->dbh;
939     my $sth = $dbh->prepare($query);
940     $sth->execute(@params);
941     my $basketgroupid = $dbh->{'mysql_insertid'};
942     if( $basketgroupinfo->{'basketlist'} ) {
943         foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
944             my $query2 = "UPDATE aqbasket SET basketgroupid=? WHERE basketno=?";
945             my $sth2 = $dbh->prepare($query2);
946             $sth2->execute($basketgroupid, $basketno);
947         }
948     }
949     return $basketgroupid;
950 }
951
952 #------------------------------------------------------------#
953
954 =head3 ModBasketgroup
955
956   ModBasketgroup(\%hashref);
957
958 Modifies a basketgroup in the aqbasketgroups table, and add the baskets to it.
959
960 $hashref->{'id'} is the 'id' field of the basketgroup in the aqbasketgroup table, this parameter is mandatory,
961
962 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
963
964 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
965
966 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
967
968 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
969
970 $hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table,
971
972 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
973
974 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
975
976 =cut
977
978 sub ModBasketgroup {
979     my $basketgroupinfo = shift;
980     die "basketgroup id is required to edit a basketgroup" unless $basketgroupinfo->{'id'};
981     my $dbh = C4::Context->dbh;
982     my $query = "UPDATE aqbasketgroups SET ";
983     my @params;
984     foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
985         if ( defined $basketgroupinfo->{$field} ) {
986             $query .= "$field=?, ";
987             push(@params, $basketgroupinfo->{$field});
988         }
989     }
990     chop($query);
991     chop($query);
992     $query .= " WHERE id=?";
993     push(@params, $basketgroupinfo->{'id'});
994     my $sth = $dbh->prepare($query);
995     $sth->execute(@params);
996
997     $sth = $dbh->prepare('UPDATE aqbasket SET basketgroupid = NULL WHERE basketgroupid = ?');
998     $sth->execute($basketgroupinfo->{'id'});
999
1000     if($basketgroupinfo->{'basketlist'} && @{$basketgroupinfo->{'basketlist'}}){
1001         $sth = $dbh->prepare("UPDATE aqbasket SET basketgroupid=? WHERE basketno=?");
1002         foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
1003             $sth->execute($basketgroupinfo->{'id'}, $basketno);
1004         }
1005     }
1006     return;
1007 }
1008
1009 #------------------------------------------------------------#
1010
1011 =head3 DelBasketgroup
1012
1013   DelBasketgroup($basketgroupid);
1014
1015 Deletes a basketgroup in the aqbasketgroups table, and removes the reference to it from the baskets,
1016
1017 =over
1018
1019 =item C<$basketgroupid> is the 'id' field of the basket in the aqbasketgroup table
1020
1021 =back
1022
1023 =cut
1024
1025 sub DelBasketgroup {
1026     my $basketgroupid = shift;
1027     die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
1028     my $query = "DELETE FROM aqbasketgroups WHERE id=?";
1029     my $dbh = C4::Context->dbh;
1030     my $sth = $dbh->prepare($query);
1031     $sth->execute($basketgroupid);
1032     return;
1033 }
1034
1035 #------------------------------------------------------------#
1036
1037
1038 =head2 FUNCTIONS ABOUT ORDERS
1039
1040 =head3 GetBasketgroup
1041
1042   $basketgroup = &GetBasketgroup($basketgroupid);
1043
1044 Returns a reference to the hash containing all information about the basketgroup.
1045
1046 =cut
1047
1048 sub GetBasketgroup {
1049     my $basketgroupid = shift;
1050     die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
1051     my $dbh = C4::Context->dbh;
1052     my $result_set = $dbh->selectall_arrayref(
1053         'SELECT * FROM aqbasketgroups WHERE id=?',
1054         { Slice => {} },
1055         $basketgroupid
1056     );
1057     return $result_set->[0];    # id is unique
1058 }
1059
1060 #------------------------------------------------------------#
1061
1062 =head3 GetBasketgroups
1063
1064   $basketgroups = &GetBasketgroups($booksellerid);
1065
1066 Returns a reference to the array of all the basketgroups of bookseller $booksellerid.
1067
1068 =cut
1069
1070 sub GetBasketgroups {
1071     my $booksellerid = shift;
1072     die 'bookseller id is required to edit a basketgroup' unless $booksellerid;
1073     my $query = 'SELECT * FROM aqbasketgroups WHERE booksellerid=? ORDER BY id DESC';
1074     my $dbh = C4::Context->dbh;
1075     my $sth = $dbh->prepare($query);
1076     $sth->execute($booksellerid);
1077     return $sth->fetchall_arrayref({});
1078 }
1079
1080 #------------------------------------------------------------#
1081
1082 =head2 FUNCTIONS ABOUT ORDERS
1083
1084 =head3 GetOrders
1085
1086   @orders = &GetOrders( $basketno, { orderby => 'biblio.title', cancelled => 0|1 } );
1087
1088 Looks up the pending (non-cancelled) orders with the given basket
1089 number.
1090
1091 If cancelled is set, only cancelled orders will be returned.
1092
1093 =cut
1094
1095 sub GetOrders {
1096     my ( $basketno, $params ) = @_;
1097
1098     return () unless $basketno;
1099
1100     my $orderby = $params->{orderby};
1101     my $cancelled = $params->{cancelled} || 0;
1102
1103     my $dbh   = C4::Context->dbh;
1104     my $query = q|
1105         SELECT biblio.*,biblioitems.*,
1106                 aqorders.*,
1107                 aqbudgets.*,
1108         |;
1109     $query .= $cancelled
1110       ? q|
1111                 aqorders_transfers.ordernumber_to AS transferred_to,
1112                 aqorders_transfers.timestamp AS transferred_to_timestamp
1113     |
1114       : q|
1115                 aqorders_transfers.ordernumber_from AS transferred_from,
1116                 aqorders_transfers.timestamp AS transferred_from_timestamp
1117     |;
1118     $query .= q|
1119         FROM    aqorders
1120             LEFT JOIN aqbudgets        ON aqbudgets.budget_id = aqorders.budget_id
1121             LEFT JOIN biblio           ON biblio.biblionumber = aqorders.biblionumber
1122             LEFT JOIN biblioitems      ON biblioitems.biblionumber =biblio.biblionumber
1123     |;
1124     $query .= $cancelled
1125       ? q|
1126             LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_from = aqorders.ordernumber
1127     |
1128       : q|
1129             LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber
1130
1131     |;
1132     $query .= q|
1133         WHERE   basketno=?
1134     |;
1135
1136     if ($cancelled) {
1137         $orderby ||= q|biblioitems.publishercode, biblio.title|;
1138         $query .= q|
1139             AND datecancellationprinted IS NOT NULL
1140         |;
1141     }
1142     else {
1143         $orderby ||=
1144           q|aqorders.datecancellationprinted desc, aqorders.timestamp desc|;
1145         $query .= q|
1146             AND datecancellationprinted IS NULL
1147         |;
1148     }
1149
1150     $query .= " ORDER BY $orderby";
1151     my $orders =
1152       $dbh->selectall_arrayref( $query, { Slice => {} }, $basketno );
1153     return @{$orders};
1154
1155 }
1156
1157 #------------------------------------------------------------#
1158
1159 =head3 GetOrdersByBiblionumber
1160
1161   @orders = &GetOrdersByBiblionumber($biblionumber);
1162
1163 Looks up the orders with linked to a specific $biblionumber, including
1164 cancelled orders and received orders.
1165
1166 return :
1167 C<@orders> is an array of references-to-hash, whose keys are the
1168 fields from the aqorders, biblio, and biblioitems tables in the Koha database.
1169
1170 =cut
1171
1172 sub GetOrdersByBiblionumber {
1173     my $biblionumber = shift;
1174     return unless $biblionumber;
1175     my $dbh   = C4::Context->dbh;
1176     my $query  ="
1177         SELECT biblio.*,biblioitems.*,
1178                 aqorders.*,
1179                 aqbudgets.*
1180         FROM    aqorders
1181             LEFT JOIN aqbudgets        ON aqbudgets.budget_id = aqorders.budget_id
1182             LEFT JOIN biblio           ON biblio.biblionumber = aqorders.biblionumber
1183             LEFT JOIN biblioitems      ON biblioitems.biblionumber =biblio.biblionumber
1184         WHERE   aqorders.biblionumber=?
1185     ";
1186     my $result_set =
1187       $dbh->selectall_arrayref( $query, { Slice => {} }, $biblionumber );
1188     return @{$result_set};
1189
1190 }
1191
1192 #------------------------------------------------------------#
1193
1194 =head3 GetOrder
1195
1196   $order = &GetOrder($ordernumber);
1197
1198 Looks up an order by order number.
1199
1200 Returns a reference-to-hash describing the order. The keys of
1201 C<$order> are fields from the biblio, biblioitems, aqorders tables of the Koha database.
1202
1203 =cut
1204
1205 sub GetOrder {
1206     my ($ordernumber) = @_;
1207     return unless $ordernumber;
1208
1209     my $dbh      = C4::Context->dbh;
1210     my $query = qq{SELECT
1211                 aqorders.*,
1212                 biblio.title,
1213                 biblio.author,
1214                 aqbasket.basketname,
1215                 borrowers.branchcode,
1216                 biblioitems.publicationyear,
1217                 biblio.copyrightdate,
1218                 biblioitems.editionstatement,
1219                 biblioitems.isbn,
1220                 biblioitems.ean,
1221                 biblio.seriestitle,
1222                 biblioitems.publishercode,
1223                 aqorders.rrp              AS unitpricesupplier,
1224                 aqorders.ecost            AS unitpricelib,
1225                 aqbudgets.budget_name     AS budget,
1226                 aqbooksellers.name        AS supplier,
1227                 aqbooksellers.id          AS supplierid,
1228                 biblioitems.publishercode AS publisher,
1229                 ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
1230                 DATE(aqbasket.closedate)  AS orderdate,
1231                 aqorders.quantity - COALESCE(aqorders.quantityreceived,0)                 AS quantity_to_receive,
1232                 (aqorders.quantity - COALESCE(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1233                 DATEDIFF(CURDATE( ),closedate) AS latesince
1234                 FROM aqorders LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1235                 LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
1236                 LEFT JOIN aqbudgets ON aqorders.budget_id = aqbudgets.budget_id,
1237                 aqbasket LEFT JOIN borrowers  ON aqbasket.authorisedby = borrowers.borrowernumber
1238                 LEFT JOIN aqbooksellers       ON aqbasket.booksellerid = aqbooksellers.id
1239                 WHERE aqorders.basketno = aqbasket.basketno
1240                     AND ordernumber=?};
1241     my $result_set =
1242       $dbh->selectall_arrayref( $query, { Slice => {} }, $ordernumber );
1243
1244     # result_set assumed to contain 1 match
1245     return $result_set->[0];
1246 }
1247
1248 =head3 ModOrder
1249
1250   &ModOrder(\%hashref);
1251
1252 Modifies an existing order. Updates the order with order number
1253 $hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All 
1254 other keys of the hash update the fields with the same name in the aqorders 
1255 table of the Koha database.
1256
1257 =cut
1258
1259 sub ModOrder {
1260     my $orderinfo = shift;
1261
1262     die "Ordernumber is required" if $orderinfo->{'ordernumber'} eq '';
1263
1264     my $dbh = C4::Context->dbh;
1265     my @params;
1266
1267     # update uncertainprice to an integer, just in case (under FF, checked boxes have the value "ON" by default)
1268     $orderinfo->{uncertainprice}=1 if $orderinfo->{uncertainprice};
1269
1270 #    delete($orderinfo->{'branchcode'});
1271     # the hash contains a lot of entries not in aqorders, so get the columns ...
1272     my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
1273     $sth->execute;
1274     my $colnames = $sth->{NAME};
1275         #FIXME Be careful. If aqorders would have columns with diacritics,
1276         #you should need to decode what you get back from NAME.
1277         #See report 10110 and guided_reports.pl
1278     my $query = "UPDATE aqorders SET ";
1279
1280     foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
1281         # ... and skip hash entries that are not in the aqorders table
1282         # FIXME : probably not the best way to do it (would be better to have a correct hash)
1283         next unless grep { $_ eq $orderinfokey } @$colnames;
1284             $query .= "$orderinfokey=?, ";
1285             push(@params, $orderinfo->{$orderinfokey});
1286     }
1287
1288     $query .= "timestamp=NOW()  WHERE  ordernumber=?";
1289     push(@params, $orderinfo->{'ordernumber'} );
1290     $sth = $dbh->prepare($query);
1291     $sth->execute(@params);
1292     return;
1293 }
1294
1295 #------------------------------------------------------------#
1296
1297 =head3 ModItemOrder
1298
1299     ModItemOrder($itemnumber, $ordernumber);
1300
1301 Modifies the ordernumber of an item in aqorders_items.
1302
1303 =cut
1304
1305 sub ModItemOrder {
1306     my ($itemnumber, $ordernumber) = @_;
1307
1308     return unless ($itemnumber and $ordernumber);
1309
1310     my $dbh = C4::Context->dbh;
1311     my $query = qq{
1312         UPDATE aqorders_items
1313         SET ordernumber = ?
1314         WHERE itemnumber = ?
1315     };
1316     my $sth = $dbh->prepare($query);
1317     return $sth->execute($ordernumber, $itemnumber);
1318 }
1319
1320 #------------------------------------------------------------#
1321
1322 =head3 ModReceiveOrder
1323
1324     my ( $date_received, $new_ordernumber ) = ModReceiveOrder(
1325         {
1326             biblionumber         => $biblionumber,
1327             order                => $order,
1328             quantityreceived     => $quantityreceived,
1329             user                 => $user,
1330             invoice              => $invoice,
1331             budget_id            => $budget_id,
1332             datereceived         => $datereceived,
1333             received_itemnumbers => \@received_itemnumbers,
1334         }
1335     );
1336
1337 Updates an order, to reflect the fact that it was received, at least
1338 in part.
1339
1340 If a partial order is received, splits the order into two.
1341
1342 Updates the order with biblionumber C<$biblionumber> and ordernumber
1343 C<$order->{ordernumber}>.
1344
1345 =cut
1346
1347
1348 sub ModReceiveOrder {
1349     my ($params)       = @_;
1350     my $biblionumber   = $params->{biblionumber};
1351     my $order          = { %{ $params->{order} } }; # Copy the order, we don't want to modify it
1352     my $invoice        = $params->{invoice};
1353     my $quantrec       = $params->{quantityreceived};
1354     my $user           = $params->{user};
1355     my $budget_id      = $params->{budget_id};
1356     my $datereceived   = $params->{datereceived};
1357     my $received_items = $params->{received_items};
1358
1359     my $dbh = C4::Context->dbh;
1360     $datereceived = output_pref(
1361         {
1362             dt => ( $datereceived ? dt_from_string( $datereceived ) : dt_from_string ),
1363             dateformat => 'iso',
1364             dateonly => 1,
1365         }
1366     );
1367
1368     my $suggestionid = GetSuggestionFromBiblionumber( $biblionumber );
1369     if ($suggestionid) {
1370         ModSuggestion( {suggestionid=>$suggestionid,
1371                         STATUS=>'AVAILABLE',
1372                         biblionumber=> $biblionumber}
1373                         );
1374     }
1375
1376     my $result_set = $dbh->selectrow_arrayref(
1377             q{SELECT aqbasket.is_standing
1378             FROM aqbasket
1379             WHERE basketno=?},{ Slice => {} }, $order->{basketno});
1380     my $is_standing = $result_set->[0];  # we assume we have a unique basket
1381
1382     my $new_ordernumber = $order->{ordernumber};
1383     if ( $is_standing || $order->{quantity} > $quantrec ) {
1384         # Split order line in two parts: the first is the original order line
1385         # without received items (the quantity is decreased),
1386         # the second part is a new order line with quantity=quantityrec
1387         # (entirely received)
1388         my $query = q|
1389             UPDATE aqorders
1390             SET quantity = ?,
1391                 orderstatus = 'partial'|;
1392         $query .= q| WHERE ordernumber = ?|;
1393         my $sth = $dbh->prepare($query);
1394
1395         $sth->execute(
1396             ( $is_standing ? 1 : ($order->{quantity} - $quantrec) ),
1397             $order->{ordernumber}
1398         );
1399
1400         if ( not $order->{subscriptionid} && defined $order->{order_internalnote} ) {
1401             $dbh->do(
1402                 q|UPDATE aqorders
1403                 SET order_internalnote = ?
1404                 WHERE ordernumber = ?|, {},
1405                 $order->{order_internalnote}, $order->{ordernumber}
1406             );
1407         }
1408
1409         # Recalculate tax_value
1410         $dbh->do(q|
1411             UPDATE aqorders
1412             SET
1413                 tax_value_on_ordering = quantity * | . get_rounding_sql(q|ecost_tax_excluded|) . q| * tax_rate_on_ordering,
1414                 tax_value_on_receiving = quantity * | . get_rounding_sql(q|unitprice_tax_excluded|) . q| * tax_rate_on_receiving
1415             WHERE ordernumber = ?
1416         |, undef, $order->{ordernumber});
1417
1418         delete $order->{ordernumber};
1419         $order->{budget_id} = ( $budget_id || $order->{budget_id} );
1420         $order->{quantity} = $quantrec;
1421         $order->{quantityreceived} = $quantrec;
1422         $order->{ecost_tax_excluded} //= 0;
1423         $order->{tax_rate_on_ordering} //= 0;
1424         $order->{unitprice_tax_excluded} //= 0;
1425         $order->{tax_rate_on_receiving} //= 0;
1426         $order->{tax_value_on_ordering} = $order->{quantity} * get_rounded_price($order->{ecost_tax_excluded}) * $order->{tax_rate_on_ordering};
1427         $order->{tax_value_on_receiving} = $order->{quantity} * get_rounded_price($order->{unitprice_tax_excluded}) * $order->{tax_rate_on_receiving};
1428         $order->{datereceived} = $datereceived;
1429         $order->{invoiceid} = $invoice->{invoiceid};
1430         $order->{orderstatus} = 'complete';
1431         $new_ordernumber = Koha::Acquisition::Order->new($order)->store->ordernumber; # TODO What if the store fails?
1432
1433         if ($received_items) {
1434             foreach my $itemnumber (@$received_items) {
1435                 ModItemOrder($itemnumber, $new_ordernumber);
1436             }
1437         }
1438     } else {
1439         my $query = q|
1440             UPDATE aqorders
1441             SET quantityreceived = ?,
1442                 datereceived = ?,
1443                 invoiceid = ?,
1444                 budget_id = ?,
1445                 orderstatus = 'complete'
1446         |;
1447
1448         $query .= q|
1449             , replacementprice = ?
1450         | if defined $order->{replacementprice};
1451
1452         $query .= q|
1453             , unitprice = ?, unitprice_tax_included = ?, unitprice_tax_excluded = ?
1454         | if defined $order->{unitprice};
1455
1456         $query .= q|
1457             ,tax_value_on_receiving = ?
1458         | if defined $order->{tax_value_on_receiving};
1459
1460         $query .= q|
1461             ,tax_rate_on_receiving = ?
1462         | if defined $order->{tax_rate_on_receiving};
1463
1464         $query .= q|
1465             , order_internalnote = ?
1466         | if defined $order->{order_internalnote};
1467
1468         $query .= q| where biblionumber=? and ordernumber=?|;
1469
1470         my $sth = $dbh->prepare( $query );
1471         my @params = ( $quantrec, $datereceived, $invoice->{invoiceid}, ( $budget_id ? $budget_id : $order->{budget_id} ) );
1472
1473         if ( defined $order->{replacementprice} ) {
1474             push @params, $order->{replacementprice};
1475         }
1476
1477         if ( defined $order->{unitprice} ) {
1478             push @params, $order->{unitprice}, $order->{unitprice_tax_included}, $order->{unitprice_tax_excluded};
1479         }
1480
1481         if ( defined $order->{tax_value_on_receiving} ) {
1482             push @params, $order->{tax_value_on_receiving};
1483         }
1484
1485         if ( defined $order->{tax_rate_on_receiving} ) {
1486             push @params, $order->{tax_rate_on_receiving};
1487         }
1488
1489         if ( defined $order->{order_internalnote} ) {
1490             push @params, $order->{order_internalnote};
1491         }
1492
1493         push @params, ( $biblionumber, $order->{ordernumber} );
1494
1495         $sth->execute( @params );
1496
1497         # All items have been received, sent a notification to users
1498         NotifyOrderUsers( $order->{ordernumber} );
1499
1500     }
1501     return ($datereceived, $new_ordernumber);
1502 }
1503
1504 =head3 CancelReceipt
1505
1506     my $parent_ordernumber = CancelReceipt($ordernumber);
1507
1508     Cancel an order line receipt and update the parent order line, as if no
1509     receipt was made.
1510     If items are created at receipt (AcqCreateItem = receiving) then delete
1511     these items.
1512
1513 =cut
1514
1515 sub CancelReceipt {
1516     my $ordernumber = shift;
1517
1518     return unless $ordernumber;
1519
1520     my $dbh = C4::Context->dbh;
1521     my $query = qq{
1522         SELECT datereceived, parent_ordernumber, quantity
1523         FROM aqorders
1524         WHERE ordernumber = ?
1525     };
1526     my $sth = $dbh->prepare($query);
1527     $sth->execute($ordernumber);
1528     my $order = $sth->fetchrow_hashref;
1529     unless($order) {
1530         warn "CancelReceipt: order $ordernumber does not exist";
1531         return;
1532     }
1533     unless($order->{'datereceived'}) {
1534         warn "CancelReceipt: order $ordernumber is not received";
1535         return;
1536     }
1537
1538     my $parent_ordernumber = $order->{'parent_ordernumber'};
1539
1540     my $order_obj = Koha::Acquisition::Orders->find( $ordernumber ); # FIXME rewrite all this subroutine using this object
1541     my @itemnumbers = $order_obj->items->get_column('itemnumber');
1542
1543     if($parent_ordernumber == $ordernumber || not $parent_ordernumber) {
1544         # The order line has no parent, just mark it as not received
1545         $query = qq{
1546             UPDATE aqorders
1547             SET quantityreceived = ?,
1548                 datereceived = ?,
1549                 invoiceid = ?,
1550                 orderstatus = 'ordered'
1551             WHERE ordernumber = ?
1552         };
1553         $sth = $dbh->prepare($query);
1554         $sth->execute(0, undef, undef, $ordernumber);
1555         _cancel_items_receipt( $order_obj );
1556     } else {
1557         # The order line has a parent, increase parent quantity and delete
1558         # the order line.
1559         unless ( $order_obj->basket->is_standing ) {
1560             $query = qq{
1561                 SELECT quantity, datereceived
1562                 FROM aqorders
1563                 WHERE ordernumber = ?
1564             };
1565             $sth = $dbh->prepare($query);
1566             $sth->execute($parent_ordernumber);
1567             my $parent_order = $sth->fetchrow_hashref;
1568             unless($parent_order) {
1569                 warn "Parent order $parent_ordernumber does not exist.";
1570                 return;
1571             }
1572             if($parent_order->{'datereceived'}) {
1573                 warn "CancelReceipt: parent order is received.".
1574                     " Can't cancel receipt.";
1575                 return;
1576             }
1577             $query = qq{
1578                 UPDATE aqorders
1579                 SET quantity = ?,
1580                     orderstatus = 'ordered'
1581                 WHERE ordernumber = ?
1582             };
1583             $sth = $dbh->prepare($query);
1584             my $rv = $sth->execute(
1585                 $order->{'quantity'} + $parent_order->{'quantity'},
1586                 $parent_ordernumber
1587             );
1588             unless($rv) {
1589                 warn "Cannot update parent order line, so do not cancel".
1590                     " receipt";
1591                 return;
1592             }
1593
1594             # Recalculate tax_value
1595             $dbh->do(q|
1596                 UPDATE aqorders
1597                 SET
1598                     tax_value_on_ordering = quantity * | . get_rounding_sql(q|ecost_tax_excluded|) . q| * tax_rate_on_ordering,
1599                     tax_value_on_receiving = quantity * | . get_rounding_sql(q|unitprice_tax_excluded|) . q| * tax_rate_on_receiving
1600                 WHERE ordernumber = ?
1601             |, undef, $parent_ordernumber);
1602         }
1603
1604         _cancel_items_receipt( $order_obj, $parent_ordernumber );
1605         # Delete order line
1606         $query = qq{
1607             DELETE FROM aqorders
1608             WHERE ordernumber = ?
1609         };
1610         $sth = $dbh->prepare($query);
1611         $sth->execute($ordernumber);
1612
1613     }
1614
1615     if( $order_obj->basket->effective_create_items eq 'ordering' ) {
1616         my @affects = split q{\|}, C4::Context->preference("AcqItemSetSubfieldsWhenReceiptIsCancelled");
1617         if ( @affects ) {
1618             for my $in ( @itemnumbers ) {
1619                 my $item = Koha::Items->find( $in ); # FIXME We do not need that, we already have Koha::Items from $order_obj->items
1620                 my $biblio = $item->biblio;
1621                 my ( $itemfield ) = GetMarcFromKohaField( 'items.itemnumber' );
1622                 my $item_marc = C4::Items::GetMarcItem( $biblio->biblionumber, $in );
1623                 for my $affect ( @affects ) {
1624                     my ( $sf, $v ) = split q{=}, $affect, 2;
1625                     foreach ( $item_marc->field($itemfield) ) {
1626                         $_->update( $sf => $v );
1627                     }
1628                 }
1629                 C4::Items::ModItemFromMarc( $item_marc, $biblio->biblionumber, $in );
1630             }
1631         }
1632     }
1633
1634     return $parent_ordernumber;
1635 }
1636
1637 sub _cancel_items_receipt {
1638     my ( $order, $parent_ordernumber ) = @_;
1639     $parent_ordernumber ||= $order->ordernumber;
1640
1641     my $items = $order->items;
1642     if ( $order->basket->effective_create_items eq 'receiving' ) {
1643         # Remove items that were created at receipt
1644         my $query = qq{
1645             DELETE FROM items, aqorders_items
1646             USING items, aqorders_items
1647             WHERE items.itemnumber = ? AND aqorders_items.itemnumber = ?
1648         };
1649         my $dbh = C4::Context->dbh;
1650         my $sth = $dbh->prepare($query);
1651         while ( my $item = $items->next ) {
1652             $sth->execute($item->itemnumber, $item->itemnumber);
1653         }
1654     } else {
1655         # Update items
1656         while ( my $item = $items->next ) {
1657             ModItemOrder($item->itemnumber, $parent_ordernumber);
1658         }
1659     }
1660 }
1661
1662 #------------------------------------------------------------#
1663
1664 =head3 SearchOrders
1665
1666 @results = &SearchOrders({
1667     ordernumber => $ordernumber,
1668     search => $search,
1669     ean => $ean,
1670     booksellerid => $booksellerid,
1671     basketno => $basketno,
1672     basketname => $basketname,
1673     basketgroupname => $basketgroupname,
1674     owner => $owner,
1675     pending => $pending
1676     ordered => $ordered
1677     biblionumber => $biblionumber,
1678     budget_id => $budget_id
1679 });
1680
1681 Searches for orders filtered by criteria.
1682
1683 C<$ordernumber> Finds matching orders or transferred orders by ordernumber.
1684 C<$search> Finds orders matching %$search% in title, author, or isbn.
1685 C<$owner> Finds order for the logged in user.
1686 C<$pending> Finds pending orders. Ignores completed and cancelled orders.
1687 C<$ordered> Finds orders to receive only (status 'ordered' or 'partial').
1688
1689
1690 C<@results> is an array of references-to-hash with the keys are fields
1691 from aqorders, biblio, biblioitems and aqbasket tables.
1692
1693 =cut
1694
1695 sub SearchOrders {
1696     my ( $params ) = @_;
1697     my $ordernumber = $params->{ordernumber};
1698     my $search = $params->{search};
1699     my $ean = $params->{ean};
1700     my $booksellerid = $params->{booksellerid};
1701     my $basketno = $params->{basketno};
1702     my $basketname = $params->{basketname};
1703     my $basketgroupname = $params->{basketgroupname};
1704     my $owner = $params->{owner};
1705     my $pending = $params->{pending};
1706     my $ordered = $params->{ordered};
1707     my $biblionumber = $params->{biblionumber};
1708     my $budget_id = $params->{budget_id};
1709
1710     my $dbh = C4::Context->dbh;
1711     my @args = ();
1712     my $query = q{
1713         SELECT aqbasket.basketno,
1714                borrowers.surname,
1715                borrowers.firstname,
1716                biblio.*,
1717                biblioitems.isbn,
1718                biblioitems.biblioitemnumber,
1719                biblioitems.publishercode,
1720                biblioitems.publicationyear,
1721                aqbasket.authorisedby,
1722                aqbasket.booksellerid,
1723                aqbasket.closedate,
1724                aqbasket.creationdate,
1725                aqbasket.basketname,
1726                aqbasketgroups.id as basketgroupid,
1727                aqbasketgroups.name as basketgroupname,
1728                aqorders.*
1729         FROM aqorders
1730             LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1731             LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
1732             LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1733             LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1734             LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1735     };
1736
1737     # If we search on ordernumber, we retrieve the transferred order if a transfer has been done.
1738     $query .= q{
1739             LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber
1740     } if $ordernumber;
1741
1742     $query .= q{
1743         WHERE (datecancellationprinted is NULL)
1744     };
1745
1746     if ( $pending or $ordered ) {
1747         $query .= q{
1748             AND (
1749                 ( aqbasket.is_standing AND aqorders.orderstatus IN ( "new", "ordered", "partial" ) )
1750                 OR (
1751                     ( quantity > quantityreceived OR quantityreceived is NULL )
1752         };
1753
1754         if ( $ordered ) {
1755             $query .= q{ AND aqorders.orderstatus IN ( "ordered", "partial" )};
1756         }
1757         $query .= q{
1758                 )
1759             )
1760         };
1761     }
1762
1763     my $userenv = C4::Context->userenv;
1764     if ( C4::Context->preference("IndependentBranches") ) {
1765         unless ( C4::Context->IsSuperLibrarian() ) {
1766             $query .= q{
1767                 AND (
1768                     borrowers.branchcode = ?
1769                     OR borrowers.branchcode  = ''
1770                 )
1771             };
1772             push @args, $userenv->{branch};
1773         }
1774     }
1775
1776     if ( $ordernumber ) {
1777         $query .= ' AND ( aqorders.ordernumber = ? OR aqorders_transfers.ordernumber_from = ? ) ';
1778         push @args, ( $ordernumber, $ordernumber );
1779     }
1780     if ( $biblionumber ) {
1781         $query .= 'AND aqorders.biblionumber = ?';
1782         push @args, $biblionumber;
1783     }
1784     if( $search ) {
1785         $query .= ' AND (biblio.title LIKE ? OR biblio.author LIKE ? OR biblioitems.isbn LIKE ?)';
1786         push @args, ("%$search%","%$search%","%$search%");
1787     }
1788     if ( $ean ) {
1789         $query .= ' AND biblioitems.ean = ?';
1790         push @args, $ean;
1791     }
1792     if ( $booksellerid ) {
1793         $query .= 'AND aqbasket.booksellerid = ?';
1794         push @args, $booksellerid;
1795     }
1796     if( $basketno ) {
1797         $query .= 'AND aqbasket.basketno = ?';
1798         push @args, $basketno;
1799     }
1800     if( $basketname ) {
1801         $query .= 'AND aqbasket.basketname LIKE ?';
1802         push @args, "%$basketname%";
1803     }
1804     if( $basketgroupname ) {
1805         $query .= ' AND aqbasketgroups.name LIKE ?';
1806         push @args, "%$basketgroupname%";
1807     }
1808
1809     if ( $owner ) {
1810         $query .= ' AND aqbasket.authorisedby=? ';
1811         push @args, $userenv->{'number'};
1812     }
1813
1814     if ( $budget_id ) {
1815         $query .= ' AND aqorders.budget_id = ?';
1816         push @args, $budget_id;
1817     }
1818
1819     $query .= ' ORDER BY aqbasket.basketno';
1820
1821     my $sth = $dbh->prepare($query);
1822     $sth->execute(@args);
1823     return $sth->fetchall_arrayref({});
1824 }
1825
1826 #------------------------------------------------------------#
1827
1828 =head3 TransferOrder
1829
1830     my $newordernumber = TransferOrder($ordernumber, $basketno);
1831
1832 Transfer an order line to a basket.
1833 Mark $ordernumber as cancelled with an internal note 'Cancelled and transferred
1834 to BOOKSELLER on DATE' and create new order with internal note
1835 'Transferred from BOOKSELLER on DATE'.
1836 Move all attached items to the new order.
1837 Received orders cannot be transferred.
1838 Return the ordernumber of created order.
1839
1840 =cut
1841
1842 sub TransferOrder {
1843     my ($ordernumber, $basketno) = @_;
1844
1845     return unless ($ordernumber and $basketno);
1846
1847     my $order = Koha::Acquisition::Orders->find( $ordernumber ) or return;
1848     return if $order->datereceived;
1849
1850     $order = $order->unblessed;
1851
1852     my $basket = GetBasket($basketno);
1853     return unless $basket;
1854
1855     my $dbh = C4::Context->dbh;
1856     my ($query, $sth, $rv);
1857
1858     $query = q{
1859         UPDATE aqorders
1860         SET datecancellationprinted = CAST(NOW() AS date), orderstatus = ?
1861         WHERE ordernumber = ?
1862     };
1863     $sth = $dbh->prepare($query);
1864     $rv = $sth->execute('cancelled', $ordernumber);
1865
1866     delete $order->{'ordernumber'};
1867     delete $order->{parent_ordernumber};
1868     $order->{'basketno'} = $basketno;
1869
1870     my $newordernumber = Koha::Acquisition::Order->new($order)->store->ordernumber;
1871
1872     $query = q{
1873         UPDATE aqorders_items
1874         SET ordernumber = ?
1875         WHERE ordernumber = ?
1876     };
1877     $sth = $dbh->prepare($query);
1878     $sth->execute($newordernumber, $ordernumber);
1879
1880     $query = q{
1881         INSERT INTO aqorders_transfers (ordernumber_from, ordernumber_to)
1882         VALUES (?, ?)
1883     };
1884     $sth = $dbh->prepare($query);
1885     $sth->execute($ordernumber, $newordernumber);
1886
1887     return $newordernumber;
1888 }
1889
1890 =head3 get_rounding_sql
1891
1892     $rounding_sql = get_rounding_sql($column_name);
1893
1894 returns the correct SQL routine based on OrderPriceRounding system preference.
1895
1896 =cut
1897
1898 sub get_rounding_sql {
1899     my ( $round_string ) = @_;
1900     my $rounding_pref = C4::Context->preference('OrderPriceRounding') // q{};
1901     if ( $rounding_pref eq "nearest_cent"  ) {
1902         return "CAST($round_string*100 AS SIGNED)/100";
1903     }
1904     return $round_string;
1905 }
1906
1907 =head3 get_rounded_price
1908
1909     $rounded_price = get_rounded_price( $price );
1910
1911 returns a price rounded as specified in OrderPriceRounding system preference.
1912
1913 =cut
1914
1915 sub get_rounded_price {
1916     my ( $price ) =  @_;
1917     my $rounding_pref = C4::Context->preference('OrderPriceRounding') // q{};
1918     if( $rounding_pref eq 'nearest_cent' ) {
1919         return Koha::Number::Price->new( $price )->round();
1920     }
1921     return $price;
1922 }
1923
1924
1925 =head2 FUNCTIONS ABOUT PARCELS
1926
1927 =head3 GetParcels
1928
1929   $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1930
1931 get a lists of parcels.
1932
1933 * Input arg :
1934
1935 =over
1936
1937 =item $bookseller
1938 is the bookseller this function has to get parcels.
1939
1940 =item $order
1941 To know on what criteria the results list has to be ordered.
1942
1943 =item $code
1944 is the booksellerinvoicenumber.
1945
1946 =item $datefrom & $dateto
1947 to know on what date this function has to filter its search.
1948
1949 =back
1950
1951 * return:
1952 a pointer on a hash list containing parcel informations as such :
1953
1954 =over
1955
1956 =item Creation date
1957
1958 =item Last operation
1959
1960 =item Number of biblio
1961
1962 =item Number of items
1963
1964 =back
1965
1966 =cut
1967
1968 sub GetParcels {
1969     my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
1970     my $dbh    = C4::Context->dbh;
1971     my @query_params = ();
1972     my $strsth ="
1973         SELECT  aqinvoices.invoicenumber,
1974                 datereceived,purchaseordernumber,
1975                 count(DISTINCT biblionumber) AS biblio,
1976                 sum(quantity) AS itemsexpected,
1977                 sum(quantityreceived) AS itemsreceived
1978         FROM   aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
1979         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
1980         WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
1981     ";
1982     push @query_params, $bookseller;
1983
1984     if ( defined $code ) {
1985         $strsth .= ' and aqinvoices.invoicenumber like ? ';
1986         # add a % to the end of the code to allow stemming.
1987         push @query_params, "$code%";
1988     }
1989
1990     if ( defined $datefrom ) {
1991         $strsth .= ' and datereceived >= ? ';
1992         push @query_params, $datefrom;
1993     }
1994
1995     if ( defined $dateto ) {
1996         $strsth .=  'and datereceived <= ? ';
1997         push @query_params, $dateto;
1998     }
1999
2000     $strsth .= "group by aqinvoices.invoicenumber,datereceived ";
2001
2002     # can't use a placeholder to place this column name.
2003     # but, we could probably be checking to make sure it is a column that will be fetched.
2004     $strsth .= "order by $order " if ($order);
2005
2006     my $sth = $dbh->prepare($strsth);
2007
2008     $sth->execute( @query_params );
2009     my $results = $sth->fetchall_arrayref({});
2010     return @{$results};
2011 }
2012
2013 #------------------------------------------------------------#
2014
2015 =head3 GetHistory
2016
2017   \@order_loop = GetHistory( %params );
2018
2019 Retreives some acquisition history information
2020
2021 params:  
2022   title
2023   author
2024   name
2025   isbn
2026   ean
2027   from_placed_on
2028   to_placed_on
2029   basket                  - search both basket name and number
2030   booksellerinvoicenumber 
2031   basketgroupname
2032   budget
2033   orderstatus (note that orderstatus '' will retrieve orders
2034                of any status except cancelled)
2035   is_standing
2036   managing_library
2037   biblionumber
2038   get_canceled_order (if set to a true value, cancelled orders will
2039                       be included)
2040
2041 returns:
2042     $order_loop is a list of hashrefs that each look like this:
2043             {
2044                 'author'           => 'Twain, Mark',
2045                 'basketno'         => '1',
2046                 'biblionumber'     => '215',
2047                 'count'            => 1,
2048                 'creationdate'     => 'MM/DD/YYYY',
2049                 'datereceived'     => undef,
2050                 'ecost'            => '1.00',
2051                 'id'               => '1',
2052                 'invoicenumber'    => undef,
2053                 'name'             => '',
2054                 'ordernumber'      => '1',
2055                 'quantity'         => 1,
2056                 'quantityreceived' => undef,
2057                 'title'            => 'The Adventures of Huckleberry Finn',
2058                 'managing_library' => 'CPL'
2059                 'is_standing'      => '1'
2060             }
2061
2062 =cut
2063
2064 sub GetHistory {
2065 # don't run the query if there are no parameters (list would be too long for sure !)
2066     croak "No search params" unless @_;
2067     my %params = @_;
2068     my $title = $params{title};
2069     my $author = $params{author};
2070     my $isbn   = $params{isbn};
2071     my $ean    = $params{ean};
2072     my $name = $params{name};
2073     my $from_placed_on = $params{from_placed_on};
2074     my $to_placed_on = $params{to_placed_on};
2075     my $basket = $params{basket};
2076     my $booksellerinvoicenumber = $params{booksellerinvoicenumber};
2077     my $basketgroupname = $params{basketgroupname};
2078     my $budget = $params{budget};
2079     my $orderstatus = $params{orderstatus};
2080     my $is_standing = $params{is_standing};
2081     my $biblionumber = $params{biblionumber};
2082     my $get_canceled_order = $params{get_canceled_order} || 0;
2083     my $ordernumber = $params{ordernumber};
2084     my $search_children_too = $params{search_children_too} || 0;
2085     my $created_by = $params{created_by} || [];
2086     my $managing_library = $params{managing_library};
2087     my $ordernumbers = $params{ordernumbers} || [];
2088     my $additional_fields = $params{additional_fields} // [];
2089
2090     my $total_qty         = 0;
2091     my $total_qtyreceived = 0;
2092     my $total_price       = 0;
2093
2094     #get variation of isbn
2095     my @isbn_params;
2096     my @isbns;
2097     if ($isbn){
2098         if ( C4::Context->preference("SearchWithISBNVariations") ){
2099             @isbns = C4::Koha::GetVariationsOfISBN( $isbn );
2100             foreach my $isb (@isbns){
2101                 push @isbn_params, '?';
2102             }
2103         }
2104         unless (@isbns){
2105             push @isbns, $isbn;
2106             push @isbn_params, '?';
2107         }
2108     }
2109
2110     my $dbh   = C4::Context->dbh;
2111     my $query ="
2112         SELECT
2113             COALESCE(biblio.title,     deletedbiblio.title)     AS title,
2114             COALESCE(biblio.author,    deletedbiblio.author)    AS author,
2115             COALESCE(biblioitems.isbn, deletedbiblioitems.isbn) AS isbn,
2116             COALESCE(biblioitems.ean,  deletedbiblioitems.ean)  AS ean,
2117             aqorders.basketno,
2118             aqbasket.basketname,
2119             aqbasket.basketgroupid,
2120             aqbasket.authorisedby,
2121             aqbasket.is_standing,
2122             concat( borrowers.firstname,' ',borrowers.surname) AS authorisedbyname,
2123             branch as managing_library,
2124             aqbasketgroups.name as groupname,
2125             aqbooksellers.name,
2126             aqbasket.creationdate,
2127             aqorders.datereceived,
2128             aqorders.quantity,
2129             aqorders.quantityreceived,
2130             aqorders.ecost,
2131             aqorders.ordernumber,
2132             aqorders.invoiceid,
2133             aqinvoices.invoicenumber,
2134             aqbooksellers.id as id,
2135             aqorders.biblionumber,
2136             aqorders.orderstatus,
2137             aqorders.parent_ordernumber,
2138             aqbudgets.budget_name
2139             ";
2140     $query .= ", aqbudgets.budget_id AS budget" if defined $budget;
2141     $query .= "
2142         FROM aqorders
2143         LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
2144         LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
2145         LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
2146         LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
2147         LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
2148         LEFT JOIN aqbudgets ON aqorders.budget_id=aqbudgets.budget_id
2149         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2150         LEFT JOIN deletedbiblio ON deletedbiblio.biblionumber=aqorders.biblionumber
2151         LEFT JOIN deletedbiblioitems ON deletedbiblioitems.biblionumber=aqorders.biblionumber
2152         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2153         ";
2154
2155     $query .= " WHERE 1 ";
2156
2157     unless ($get_canceled_order or (defined $orderstatus and $orderstatus eq 'cancelled')) {
2158         $query .= " AND datecancellationprinted IS NULL ";
2159     }
2160
2161     my @query_params  = ();
2162
2163     if ( $biblionumber ) {
2164         $query .= " AND biblio.biblionumber = ?";
2165         push @query_params, $biblionumber;
2166     }
2167
2168     if ( $title ) {
2169         $query .= " AND biblio.title LIKE ? ";
2170         $title =~ s/\s+/%/g;
2171         push @query_params, "%$title%";
2172     }
2173
2174     if ( $author ) {
2175         $query .= " AND biblio.author LIKE ? ";
2176         push @query_params, "%$author%";
2177     }
2178
2179     if ( @isbns ) {
2180         $query .= " AND ( biblioitems.isbn LIKE " . join (" OR biblioitems.isbn LIKE ", @isbn_params ) . ")";
2181         foreach my $isb (@isbns){
2182             push @query_params, "%$isb%";
2183         }
2184     }
2185
2186     if ( $ean ) {
2187         $query .= " AND biblioitems.ean = ? ";
2188         push @query_params, "$ean";
2189     }
2190     if ( $name ) {
2191         $query .= " AND aqbooksellers.name LIKE ? ";
2192         push @query_params, "%$name%";
2193     }
2194
2195     if ( $budget ) {
2196         $query .= " AND aqbudgets.budget_id = ? ";
2197         push @query_params, "$budget";
2198     }
2199
2200     if ( $from_placed_on ) {
2201         $query .= " AND creationdate >= ? ";
2202         push @query_params, $from_placed_on;
2203     }
2204
2205     if ( $to_placed_on ) {
2206         $query .= " AND creationdate <= ? ";
2207         push @query_params, $to_placed_on;
2208     }
2209
2210     if ( defined $orderstatus and $orderstatus ne '') {
2211         $query .= " AND aqorders.orderstatus = ? ";
2212         push @query_params, "$orderstatus";
2213     }
2214
2215     if ( $is_standing ) {
2216         $query .= " AND is_standing = ? ";
2217         push @query_params, $is_standing;
2218     }
2219
2220     if ($basket) {
2221         if ($basket =~ m/^\d+$/) {
2222             $query .= " AND aqorders.basketno = ? ";
2223             push @query_params, $basket;
2224         } else {
2225             $query .= " AND aqbasket.basketname LIKE ? ";
2226             push @query_params, "%$basket%";
2227         }
2228     }
2229
2230     if ($booksellerinvoicenumber) {
2231         $query .= " AND aqinvoices.invoicenumber LIKE ? ";
2232         push @query_params, "%$booksellerinvoicenumber%";
2233     }
2234
2235     if ($basketgroupname) {
2236         $query .= " AND aqbasketgroups.name LIKE ? ";
2237         push @query_params, "%$basketgroupname%";
2238     }
2239
2240     if ($ordernumber) {
2241         $query .= " AND (aqorders.ordernumber = ? ";
2242         push @query_params, $ordernumber;
2243         if ($search_children_too) {
2244             $query .= " OR aqorders.parent_ordernumber = ? ";
2245             push @query_params, $ordernumber;
2246         }
2247         $query .= ") ";
2248     }
2249
2250     if ( @$created_by ) {
2251         $query .= ' AND aqbasket.authorisedby IN ( ' . join( ',', ('?') x @$created_by ) . ')';
2252         push @query_params, @$created_by;
2253     }
2254
2255     if ( $managing_library ) {
2256         $query .= " AND aqbasket.branch = ? ";
2257         push @query_params, $managing_library;
2258     }
2259
2260     if ( @$ordernumbers ) {
2261         $query .= ' AND (aqorders.ordernumber IN ( ' . join (',', ('?') x @$ordernumbers ) . '))';
2262         push @query_params, @$ordernumbers;
2263     }
2264     if ( @$additional_fields ) {
2265         my @baskets = Koha::Acquisition::Baskets->filter_by_additional_fields($additional_fields);
2266
2267         return [] unless @baskets;
2268
2269         # No parameterization because record IDs come directly from DB
2270         $query .= ' AND aqbasket.basketno IN ( ' . join( ',', map { $_->basketno } @baskets ) . ' )';
2271     }
2272
2273     if ( C4::Context->preference("IndependentBranches") ) {
2274         unless ( C4::Context->IsSuperLibrarian() ) {
2275             $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
2276             push @query_params, C4::Context->userenv->{branch};
2277         }
2278     }
2279     $query .= " ORDER BY id";
2280
2281     return $dbh->selectall_arrayref( $query, { Slice => {} }, @query_params );
2282 }
2283
2284 =head2 GetRecentAcqui
2285
2286   $results = GetRecentAcqui($days);
2287
2288 C<$results> is a ref to a table which contains hashref
2289
2290 =cut
2291
2292 sub GetRecentAcqui {
2293     my $limit  = shift;
2294     my $dbh    = C4::Context->dbh;
2295     my $query = "
2296         SELECT *
2297         FROM   biblio
2298         ORDER BY timestamp DESC
2299         LIMIT  0,".$limit;
2300
2301     my $sth = $dbh->prepare($query);
2302     $sth->execute;
2303     my $results = $sth->fetchall_arrayref({});
2304     return $results;
2305 }
2306
2307 #------------------------------------------------------------#
2308
2309 =head3 AddClaim
2310
2311   &AddClaim($ordernumber);
2312
2313 Add a claim for an order
2314
2315 =cut
2316
2317 sub AddClaim {
2318     my ($ordernumber) = @_;
2319     my $dbh          = C4::Context->dbh;
2320     my $query        = "
2321         UPDATE aqorders SET
2322             claims_count = claims_count + 1,
2323             claimed_date = CURDATE()
2324         WHERE ordernumber = ?
2325         ";
2326     my $sth = $dbh->prepare($query);
2327     $sth->execute($ordernumber);
2328 }
2329
2330 =head3 GetInvoices
2331
2332     my @invoices = GetInvoices(
2333         invoicenumber => $invoicenumber,
2334         supplierid => $supplierid,
2335         suppliername => $suppliername,
2336         shipmentdatefrom => $shipmentdatefrom, # ISO format
2337         shipmentdateto => $shipmentdateto, # ISO format
2338         billingdatefrom => $billingdatefrom, # ISO format
2339         billingdateto => $billingdateto, # ISO format
2340         isbneanissn => $isbn_or_ean_or_issn,
2341         title => $title,
2342         author => $author,
2343         publisher => $publisher,
2344         publicationyear => $publicationyear,
2345         branchcode => $branchcode,
2346         order_by => $order_by
2347     );
2348
2349 Return a list of invoices that match all given criteria.
2350
2351 $order_by is "column_name (asc|desc)", where column_name is any of
2352 'invoicenumber', 'booksellerid', 'shipmentdate', 'billingdate', 'closedate',
2353 'shipmentcost', 'shipmentcost_budgetid'.
2354
2355 asc is the default if omitted
2356
2357 =cut
2358
2359 sub GetInvoices {
2360     my %args = @_;
2361
2362     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2363         closedate shipmentcost shipmentcost_budgetid);
2364
2365     my $dbh = C4::Context->dbh;
2366     my $query = qq{
2367         SELECT aqinvoices.invoiceid, aqinvoices.invoicenumber, aqinvoices.booksellerid, aqinvoices.shipmentdate, aqinvoices.billingdate, aqinvoices.closedate, aqinvoices.shipmentcost, aqinvoices.shipmentcost_budgetid, aqinvoices.message_id,
2368             aqbooksellers.name AS suppliername,
2369           COUNT(
2370             DISTINCT IF(
2371               aqorders.datereceived IS NOT NULL,
2372               aqorders.biblionumber,
2373               NULL
2374             )
2375           ) AS receivedbiblios,
2376           COUNT(
2377              DISTINCT IF(
2378               aqorders.subscriptionid IS NOT NULL,
2379               aqorders.subscriptionid,
2380               NULL
2381             )
2382           ) AS is_linked_to_subscriptions,
2383           SUM(aqorders.quantityreceived) AS receiveditems
2384         FROM aqinvoices
2385           LEFT JOIN aqbooksellers ON aqbooksellers.id = aqinvoices.booksellerid
2386           LEFT JOIN aqorders ON aqorders.invoiceid = aqinvoices.invoiceid
2387           LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
2388           LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2389           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2390           LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
2391           LEFT JOIN subscription ON biblio.biblionumber = subscription.biblionumber
2392     };
2393
2394     my @bind_args;
2395     my @bind_strs;
2396     if($args{supplierid}) {
2397         push @bind_strs, " aqinvoices.booksellerid = ? ";
2398         push @bind_args, $args{supplierid};
2399     }
2400     if($args{invoicenumber}) {
2401         push @bind_strs, " aqinvoices.invoicenumber LIKE ? ";
2402         push @bind_args, "%$args{invoicenumber}%";
2403     }
2404     if($args{suppliername}) {
2405         push @bind_strs, " aqbooksellers.name LIKE ? ";
2406         push @bind_args, "%$args{suppliername}%";
2407     }
2408     if($args{shipmentdatefrom}) {
2409         push @bind_strs, " aqinvoices.shipmentdate >= ? ";
2410         push @bind_args, $args{shipmentdatefrom};
2411     }
2412     if($args{shipmentdateto}) {
2413         push @bind_strs, " aqinvoices.shipmentdate <= ? ";
2414         push @bind_args, $args{shipmentdateto};
2415     }
2416     if($args{billingdatefrom}) {
2417         push @bind_strs, " aqinvoices.billingdate >= ? ";
2418         push @bind_args, $args{billingdatefrom};
2419     }
2420     if($args{billingdateto}) {
2421         push @bind_strs, " aqinvoices.billingdate <= ? ";
2422         push @bind_args, $args{billingdateto};
2423     }
2424     if($args{isbneanissn}) {
2425         push @bind_strs, " (biblioitems.isbn LIKE CONCAT('%', ?, '%') OR biblioitems.ean LIKE CONCAT('%', ?, '%') OR biblioitems.issn LIKE CONCAT('%', ?, '%') ) ";
2426         push @bind_args, $args{isbneanissn}, $args{isbneanissn}, $args{isbneanissn};
2427     }
2428     if($args{title}) {
2429         push @bind_strs, " biblio.title LIKE CONCAT('%', ?, '%') ";
2430         push @bind_args, $args{title};
2431     }
2432     if($args{author}) {
2433         push @bind_strs, " biblio.author LIKE CONCAT('%', ?, '%') ";
2434         push @bind_args, $args{author};
2435     }
2436     if($args{publisher}) {
2437         push @bind_strs, " biblioitems.publishercode LIKE CONCAT('%', ?, '%') ";
2438         push @bind_args, $args{publisher};
2439     }
2440     if($args{publicationyear}) {
2441         push @bind_strs, " ((biblioitems.publicationyear LIKE CONCAT('%', ?, '%')) OR (biblio.copyrightdate LIKE CONCAT('%', ?, '%'))) ";
2442         push @bind_args, $args{publicationyear}, $args{publicationyear};
2443     }
2444     if($args{branchcode}) {
2445         push @bind_strs, " borrowers.branchcode = ? ";
2446         push @bind_args, $args{branchcode};
2447     }
2448     if($args{message_id}) {
2449         push @bind_strs, " aqinvoices.message_id = ? ";
2450         push @bind_args, $args{message_id};
2451     }
2452
2453     $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2454     $query .= " GROUP BY aqinvoices.invoiceid, aqinvoices.invoicenumber, aqinvoices.booksellerid, aqinvoices.shipmentdate, aqinvoices.billingdate, aqinvoices.closedate, aqinvoices.shipmentcost, aqinvoices.shipmentcost_budgetid, aqinvoices.message_id, aqbooksellers.name";
2455
2456     if($args{order_by}) {
2457         my ($column, $direction) = split / /, $args{order_by};
2458         if(grep  { $_ eq $column } @columns) {
2459             $direction ||= 'ASC';
2460             $query .= " ORDER BY $column $direction";
2461         }
2462     }
2463
2464     my $sth = $dbh->prepare($query);
2465     $sth->execute(@bind_args);
2466
2467     my $results = $sth->fetchall_arrayref({});
2468     return @$results;
2469 }
2470
2471 =head3 GetInvoice
2472
2473     my $invoice = GetInvoice($invoiceid);
2474
2475 Get informations about invoice with given $invoiceid
2476
2477 Return a hash filled with aqinvoices.* fields
2478
2479 =cut
2480
2481 sub GetInvoice {
2482     my ($invoiceid) = @_;
2483     my $invoice;
2484
2485     return unless $invoiceid;
2486
2487     my $dbh = C4::Context->dbh;
2488     my $query = qq{
2489         SELECT *
2490         FROM aqinvoices
2491         WHERE invoiceid = ?
2492     };
2493     my $sth = $dbh->prepare($query);
2494     $sth->execute($invoiceid);
2495
2496     $invoice = $sth->fetchrow_hashref;
2497     return $invoice;
2498 }
2499
2500 =head3 GetInvoiceDetails
2501
2502     my $invoice = GetInvoiceDetails($invoiceid)
2503
2504 Return informations about an invoice + the list of related order lines
2505
2506 Orders informations are in $invoice->{orders} (array ref)
2507
2508 =cut
2509
2510 sub GetInvoiceDetails {
2511     my ($invoiceid) = @_;
2512
2513     if ( !defined $invoiceid ) {
2514         carp 'GetInvoiceDetails called without an invoiceid';
2515         return;
2516     }
2517
2518     my $dbh = C4::Context->dbh;
2519     my $query = q{
2520         SELECT aqinvoices.*, aqbooksellers.name AS suppliername
2521         FROM aqinvoices
2522           LEFT JOIN aqbooksellers ON aqinvoices.booksellerid = aqbooksellers.id
2523         WHERE invoiceid = ?
2524     };
2525     my $sth = $dbh->prepare($query);
2526     $sth->execute($invoiceid);
2527
2528     my $invoice = $sth->fetchrow_hashref;
2529
2530     $query = q{
2531         SELECT aqorders.*,
2532                 biblio.*,
2533                 biblio.copyrightdate,
2534                 biblioitems.isbn,
2535                 biblioitems.publishercode,
2536                 biblioitems.publicationyear,
2537                 aqbasket.basketname,
2538                 aqbasketgroups.id AS basketgroupid,
2539                 aqbasketgroups.name AS basketgroupname
2540         FROM aqorders
2541           LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
2542           LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
2543           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2544           LEFT JOIN biblioitems ON aqorders.biblionumber = biblioitems.biblionumber
2545         WHERE invoiceid = ?
2546     };
2547     $sth = $dbh->prepare($query);
2548     $sth->execute($invoiceid);
2549     $invoice->{orders} = $sth->fetchall_arrayref({});
2550     $invoice->{orders} ||= []; # force an empty arrayref if fetchall_arrayref fails
2551
2552     return $invoice;
2553 }
2554
2555 =head3 AddInvoice
2556
2557     my $invoiceid = AddInvoice(
2558         invoicenumber => $invoicenumber,
2559         booksellerid => $booksellerid,
2560         shipmentdate => $shipmentdate,
2561         billingdate => $billingdate,
2562         closedate => $closedate,
2563         shipmentcost => $shipmentcost,
2564         shipmentcost_budgetid => $shipmentcost_budgetid
2565     );
2566
2567 Create a new invoice and return its id or undef if it fails.
2568
2569 =cut
2570
2571 sub AddInvoice {
2572     my %invoice = @_;
2573
2574     return unless(%invoice and $invoice{invoicenumber});
2575
2576     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2577         closedate shipmentcost shipmentcost_budgetid message_id);
2578
2579     my @set_strs;
2580     my @set_args;
2581     foreach my $key (keys %invoice) {
2582         if(0 < grep { $_ eq $key } @columns) {
2583             push @set_strs, "$key = ?";
2584             push @set_args, ($invoice{$key} || undef);
2585         }
2586     }
2587
2588     my $rv;
2589     if(@set_args > 0) {
2590         my $dbh = C4::Context->dbh;
2591         my $query = "INSERT INTO aqinvoices SET ";
2592         $query .= join (",", @set_strs);
2593         my $sth = $dbh->prepare($query);
2594         $rv = $sth->execute(@set_args);
2595         if($rv) {
2596             $rv = $dbh->last_insert_id(undef, undef, 'aqinvoices', undef);
2597         }
2598     }
2599     return $rv;
2600 }
2601
2602 =head3 ModInvoice
2603
2604     ModInvoice(
2605         invoiceid => $invoiceid,    # Mandatory
2606         invoicenumber => $invoicenumber,
2607         booksellerid => $booksellerid,
2608         shipmentdate => $shipmentdate,
2609         billingdate => $billingdate,
2610         closedate => $closedate,
2611         shipmentcost => $shipmentcost,
2612         shipmentcost_budgetid => $shipmentcost_budgetid
2613     );
2614
2615 Modify an invoice, invoiceid is mandatory.
2616
2617 Return undef if it fails.
2618
2619 =cut
2620
2621 sub ModInvoice {
2622     my %invoice = @_;
2623
2624     return unless(%invoice and $invoice{invoiceid});
2625
2626     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2627         closedate shipmentcost shipmentcost_budgetid);
2628
2629     my @set_strs;
2630     my @set_args;
2631     foreach my $key (keys %invoice) {
2632         if(0 < grep { $_ eq $key } @columns) {
2633             push @set_strs, "$key = ?";
2634             push @set_args, ($invoice{$key} || undef);
2635         }
2636     }
2637
2638     my $dbh = C4::Context->dbh;
2639     my $query = "UPDATE aqinvoices SET ";
2640     $query .= join(",", @set_strs);
2641     $query .= " WHERE invoiceid = ?";
2642
2643     my $sth = $dbh->prepare($query);
2644     $sth->execute(@set_args, $invoice{invoiceid});
2645 }
2646
2647 =head3 CloseInvoice
2648
2649     CloseInvoice($invoiceid);
2650
2651 Close an invoice.
2652
2653 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => undef);
2654
2655 =cut
2656
2657 sub CloseInvoice {
2658     my ($invoiceid) = @_;
2659
2660     return unless $invoiceid;
2661
2662     my $dbh = C4::Context->dbh;
2663     my $query = qq{
2664         UPDATE aqinvoices
2665         SET closedate = CAST(NOW() AS DATE)
2666         WHERE invoiceid = ?
2667     };
2668     my $sth = $dbh->prepare($query);
2669     $sth->execute($invoiceid);
2670 }
2671
2672 =head3 ReopenInvoice
2673
2674     ReopenInvoice($invoiceid);
2675
2676 Reopen an invoice
2677
2678 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => output_pref({ dt=>dt_from_string, dateonly=>1, otputpref=>'iso' }))
2679
2680 =cut
2681
2682 sub ReopenInvoice {
2683     my ($invoiceid) = @_;
2684
2685     return unless $invoiceid;
2686
2687     my $dbh = C4::Context->dbh;
2688     my $query = qq{
2689         UPDATE aqinvoices
2690         SET closedate = NULL
2691         WHERE invoiceid = ?
2692     };
2693     my $sth = $dbh->prepare($query);
2694     $sth->execute($invoiceid);
2695 }
2696
2697 =head3 DelInvoice
2698
2699     DelInvoice($invoiceid);
2700
2701 Delete an invoice if there are no items attached to it.
2702
2703 =cut
2704
2705 sub DelInvoice {
2706     my ($invoiceid) = @_;
2707
2708     return unless $invoiceid;
2709
2710     my $dbh   = C4::Context->dbh;
2711     my $query = qq{
2712         SELECT COUNT(*)
2713         FROM aqorders
2714         WHERE invoiceid = ?
2715     };
2716     my $sth = $dbh->prepare($query);
2717     $sth->execute($invoiceid);
2718     my $res = $sth->fetchrow_arrayref;
2719     if ( $res && $res->[0] == 0 ) {
2720         $query = qq{
2721             DELETE FROM aqinvoices
2722             WHERE invoiceid = ?
2723         };
2724         my $sth = $dbh->prepare($query);
2725         return ( $sth->execute($invoiceid) > 0 );
2726     }
2727     return;
2728 }
2729
2730 =head3 MergeInvoices
2731
2732     MergeInvoices($invoiceid, \@sourceids);
2733
2734 Merge the invoices identified by the IDs in \@sourceids into
2735 the invoice identified by $invoiceid.
2736
2737 =cut
2738
2739 sub MergeInvoices {
2740     my ($invoiceid, $sourceids) = @_;
2741
2742     return unless $invoiceid;
2743     foreach my $sourceid (@$sourceids) {
2744         next if $sourceid == $invoiceid;
2745         my $source = GetInvoiceDetails($sourceid);
2746         foreach my $order (@{$source->{'orders'}}) {
2747             $order->{'invoiceid'} = $invoiceid;
2748             ModOrder($order);
2749         }
2750         DelInvoice($source->{'invoiceid'});
2751     }
2752     return;
2753 }
2754
2755 =head3 GetBiblioCountByBasketno
2756
2757 $biblio_count = &GetBiblioCountByBasketno($basketno);
2758
2759 Looks up the biblio's count that has basketno value $basketno
2760
2761 Returns a quantity
2762
2763 =cut
2764
2765 sub GetBiblioCountByBasketno {
2766     my ($basketno) = @_;
2767     my $dbh          = C4::Context->dbh;
2768     my $query        = "
2769         SELECT COUNT( DISTINCT( biblionumber ) )
2770         FROM   aqorders
2771         WHERE  basketno = ?
2772             AND datecancellationprinted IS NULL
2773         ";
2774
2775     my $sth = $dbh->prepare($query);
2776     $sth->execute($basketno);
2777     return $sth->fetchrow;
2778 }
2779
2780 =head3 populate_order_with_prices
2781
2782 $order = populate_order_with_prices({
2783     order        => $order #a hashref with the order values
2784     booksellerid => $booksellerid #FIXME - should obtain from order basket
2785     receiving    => 1 # boolean representing order stage, should pass only this or ordering
2786     ordering     => 1 # boolean representing order stage
2787 });
2788
2789
2790 Sets calculated values for an order - all values are stored with full precision
2791 regardless of rounding preference except for tax value which is calculated
2792 on rounded values if requested
2793
2794 For ordering the values set are:
2795     rrp_tax_included
2796     rrp_tax_excluded
2797     ecost_tax_included
2798     ecost_tax_excluded
2799     tax_value_on_ordering
2800 For receiving the value set are:
2801     unitprice_tax_included
2802     unitprice_tax_excluded
2803     tax_value_on_receiving
2804
2805 Note: When receiving, if the rounded value of the unitprice matches the rounded
2806 value of the ecost then then ecost (full precision) is used.
2807
2808 Returns a hashref of the order
2809
2810 FIXME: Move this to Koha::Acquisition::Order.pm
2811
2812 =cut
2813
2814 sub populate_order_with_prices {
2815     my ($params) = @_;
2816
2817     my $order        = $params->{order};
2818     my $booksellerid = $params->{booksellerid};
2819     return unless $booksellerid;
2820
2821     my $bookseller = Koha::Acquisition::Booksellers->find( $booksellerid );
2822
2823     my $receiving = $params->{receiving};
2824     my $ordering  = $params->{ordering};
2825     my $discount  = $order->{discount};
2826     $discount /= 100 if $discount > 1;
2827
2828     if ($ordering) {
2829         $order->{tax_rate_on_ordering} //= $order->{tax_rate};
2830         if ( $bookseller->listincgst ) {
2831
2832             # The user entered the prices tax included
2833             $order->{unitprice} += 0;
2834             $order->{unitprice_tax_included} = $order->{unitprice};
2835             $order->{rrp_tax_included} = $order->{rrp};
2836
2837             # price tax excluded = price tax included / ( 1 + tax rate )
2838             $order->{unitprice_tax_excluded} = $order->{unitprice_tax_included} / ( 1 + $order->{tax_rate_on_ordering} );
2839             $order->{rrp_tax_excluded} = $order->{rrp_tax_included} / ( 1 + $order->{tax_rate_on_ordering} );
2840
2841             # ecost tax included = rrp tax included  ( 1 - discount )
2842             $order->{ecost_tax_included} = $order->{rrp_tax_included} * ( 1 - $discount );
2843
2844             # ecost tax excluded = rrp tax excluded * ( 1 - discount )
2845             $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount );
2846
2847             # tax value = quantity * ecost tax excluded * tax rate
2848             # we should use the unitprice if included
2849             my $cost_tax_included = $order->{unitprice_tax_included} || $order->{ecost_tax_included};
2850             my $cost_tax_excluded = $order->{unitprice_tax_excluded} || $order->{ecost_tax_excluded};
2851             $order->{tax_value_on_ordering} = ( get_rounded_price($cost_tax_included) - get_rounded_price($cost_tax_excluded) ) * $order->{quantity};
2852
2853         }
2854         else {
2855             # The user entered the prices tax excluded
2856             $order->{unitprice_tax_excluded} = $order->{unitprice};
2857             $order->{rrp_tax_excluded} = $order->{rrp};
2858
2859             # price tax included = price tax excluded * ( 1 - tax rate )
2860             $order->{unitprice_tax_included} = $order->{unitprice_tax_excluded} * ( 1 + $order->{tax_rate_on_ordering} );
2861             $order->{rrp_tax_included} = $order->{rrp_tax_excluded} * ( 1 + $order->{tax_rate_on_ordering} );
2862
2863             # ecost tax excluded = rrp tax excluded * ( 1 - discount )
2864             $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount );
2865
2866             # ecost tax included = rrp tax excluded * ( 1 + tax rate ) * ( 1 - discount ) = ecost tax excluded * ( 1 + tax rate )
2867             $order->{ecost_tax_included} = $order->{ecost_tax_excluded} * ( 1 + $order->{tax_rate_on_ordering} );
2868
2869             # tax value = quantity * ecost tax included * tax rate
2870             # we should use the unitprice if included
2871             my $cost_tax_excluded = $order->{unitprice_tax_excluded} || $order->{ecost_tax_excluded};
2872             $order->{tax_value_on_ordering} = $order->{quantity} * get_rounded_price($cost_tax_excluded) * $order->{tax_rate_on_ordering};
2873         }
2874     }
2875
2876     if ($receiving) {
2877         $order->{tax_rate_on_receiving} //= $order->{tax_rate};
2878         if ( $bookseller->invoiceincgst ) {
2879             # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
2880             # we need to keep the exact ecost value
2881             if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_included} )->round ) {
2882                 $order->{unitprice} = $order->{ecost_tax_included};
2883             }
2884
2885             # The user entered the unit price tax included
2886             $order->{unitprice_tax_included} = $order->{unitprice};
2887
2888             # unit price tax excluded = unit price tax included / ( 1 + tax rate )
2889             $order->{unitprice_tax_excluded} = $order->{unitprice_tax_included} / ( 1 + $order->{tax_rate_on_receiving} );
2890         }
2891         else {
2892             # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
2893             # we need to keep the exact ecost value
2894             if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_excluded} )->round ) {
2895                 $order->{unitprice} = $order->{ecost_tax_excluded};
2896             }
2897
2898             # The user entered the unit price tax excluded
2899             $order->{unitprice_tax_excluded} = $order->{unitprice};
2900
2901
2902             # unit price tax included = unit price tax included * ( 1 + tax rate )
2903             $order->{unitprice_tax_included} = $order->{unitprice_tax_excluded} * ( 1 + $order->{tax_rate_on_receiving} );
2904         }
2905
2906         # tax value = quantity * unit price tax excluded * tax rate
2907         $order->{tax_value_on_receiving} = $order->{quantity} * get_rounded_price($order->{unitprice_tax_excluded}) * $order->{tax_rate_on_receiving};
2908     }
2909
2910     return $order;
2911 }
2912
2913 =head3 GetOrderUsers
2914
2915     $order_users_ids = &GetOrderUsers($ordernumber);
2916
2917 Returns a list of all borrowernumbers that are in order users list
2918
2919 =cut
2920
2921 sub GetOrderUsers {
2922     my ($ordernumber) = @_;
2923
2924     return unless $ordernumber;
2925
2926     my $query = q|
2927         SELECT borrowernumber
2928         FROM aqorder_users
2929         WHERE ordernumber = ?
2930     |;
2931     my $dbh = C4::Context->dbh;
2932     my $sth = $dbh->prepare($query);
2933     $sth->execute($ordernumber);
2934     my $results = $sth->fetchall_arrayref( {} );
2935
2936     my @borrowernumbers;
2937     foreach (@$results) {
2938         push @borrowernumbers, $_->{'borrowernumber'};
2939     }
2940
2941     return @borrowernumbers;
2942 }
2943
2944 =head3 ModOrderUsers
2945
2946     my @order_users_ids = (1, 2, 3);
2947     &ModOrderUsers($ordernumber, @basketusers_ids);
2948
2949 Delete all users from order users list, and add users in C<@order_users_ids>
2950 to this users list.
2951
2952 =cut
2953
2954 sub ModOrderUsers {
2955     my ( $ordernumber, @order_users_ids ) = @_;
2956
2957     return unless $ordernumber;
2958
2959     my $dbh   = C4::Context->dbh;
2960     my $query = q|
2961         DELETE FROM aqorder_users
2962         WHERE ordernumber = ?
2963     |;
2964     my $sth = $dbh->prepare($query);
2965     $sth->execute($ordernumber);
2966
2967     $query = q|
2968         INSERT INTO aqorder_users (ordernumber, borrowernumber)
2969         VALUES (?, ?)
2970     |;
2971     $sth = $dbh->prepare($query);
2972     foreach my $order_user_id (@order_users_ids) {
2973         $sth->execute( $ordernumber, $order_user_id );
2974     }
2975 }
2976
2977 sub NotifyOrderUsers {
2978     my ($ordernumber) = @_;
2979
2980     my @borrowernumbers = GetOrderUsers($ordernumber);
2981     return unless @borrowernumbers;
2982
2983     my $order = GetOrder( $ordernumber );
2984     for my $borrowernumber (@borrowernumbers) {
2985         my $patron = Koha::Patrons->find( $borrowernumber );
2986         my $library = $patron->library->unblessed;
2987         my $biblio = Koha::Biblios->find( $order->{biblionumber} )->unblessed;
2988         my $letter = C4::Letters::GetPreparedLetter(
2989             module      => 'acquisition',
2990             letter_code => 'ACQ_NOTIF_ON_RECEIV',
2991             branchcode  => $library->{branchcode},
2992             lang        => $patron->lang,
2993             tables      => {
2994                 'branches'    => $library,
2995                 'borrowers'   => $patron->unblessed,
2996                 'biblio'      => $biblio,
2997                 'aqorders'    => $order,
2998             },
2999         );
3000         if ( $letter ) {
3001             C4::Letters::EnqueueLetter(
3002                 {
3003                     letter         => $letter,
3004                     borrowernumber => $borrowernumber,
3005                     LibraryName    => C4::Context->preference("LibraryName"),
3006                     message_transport_type => 'email',
3007                 }
3008             ) or warn "can't enqueue letter $letter";
3009         }
3010     }
3011 }
3012
3013 =head3 FillWithDefaultValues
3014
3015 FillWithDefaultValues( $marc_record, $params );
3016
3017 This will update the record with default value defined in the ACQ framework.
3018 For all existing fields, if a default value exists and there are no subfield, it will be created.
3019 If the field does not exist, it will be created too.
3020
3021 If the parameter only_mandatory => 1 is passed via $params, only the mandatory
3022 defaults are being applied to the record.
3023
3024 =cut
3025
3026 sub FillWithDefaultValues {
3027     my ( $record, $params ) = @_;
3028     my $mandatory = $params->{only_mandatory};
3029     my $tagslib = C4::Biblio::GetMarcStructure( 1, 'ACQ', { unsafe => 1 } );
3030     if ($tagslib) {
3031         my ($itemfield) =
3032           C4::Biblio::GetMarcFromKohaField( 'items.itemnumber' );
3033         for my $tag ( sort keys %$tagslib ) {
3034             next unless $tag;
3035             next if $tag == $itemfield;
3036             for my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
3037                 next if IsMarcStructureInternal($tagslib->{$tag}{$subfield});
3038                 next if $mandatory && !$tagslib->{$tag}{$subfield}{mandatory};
3039                 my $defaultvalue = $tagslib->{$tag}{$subfield}{defaultvalue};
3040                 if ( defined $defaultvalue and $defaultvalue ne '' ) {
3041                     my @fields = $record->field($tag);
3042                     if (@fields) {
3043                         for my $field (@fields) {
3044                             if ( $field->is_control_field ) {
3045                                 $field->update($defaultvalue) if not defined $field->data;
3046                             }
3047                             elsif ( not defined $field->subfield($subfield) ) {
3048                                 $field->add_subfields(
3049                                     $subfield => $defaultvalue );
3050                             }
3051                         }
3052                     }
3053                     else {
3054                         if ( $tag < 10 ) { # is_control_field
3055                             $record->insert_fields_ordered(
3056                                 MARC::Field->new(
3057                                     $tag, $defaultvalue
3058                                 )
3059                             );
3060                         }
3061                         else {
3062                             $record->insert_fields_ordered(
3063                                 MARC::Field->new(
3064                                     $tag, '', '', $subfield => $defaultvalue
3065                                 )
3066                             );
3067                         }
3068                     }
3069                 }
3070             }
3071         }
3072     }
3073 }
3074
3075 1;
3076 __END__
3077
3078 =head1 AUTHOR
3079
3080 Koha Development Team <http://koha-community.org/>
3081
3082 =cut