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