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 $from_placed_on = $params{from_placed_on};
2089     my $to_placed_on = $params{to_placed_on};
2090     my $basket = $params{basket};
2091     my $booksellerinvoicenumber = $params{booksellerinvoicenumber};
2092     my $basketgroupname = $params{basketgroupname};
2093     my $budget = $params{budget};
2094     my $orderstatus = $params{orderstatus};
2095     my $is_standing = $params{is_standing};
2096     my $biblionumber = $params{biblionumber};
2097     my $get_canceled_order = $params{get_canceled_order} || 0;
2098     my $ordernumber = $params{ordernumber};
2099     my $search_children_too = $params{search_children_too} || 0;
2100     my $created_by = $params{created_by} || [];
2101     my $managing_library = $params{managing_library};
2102     my $ordernumbers = $params{ordernumbers} || [];
2103     my $additional_fields = $params{additional_fields} // [];
2104
2105     my $total_qty         = 0;
2106     my $total_qtyreceived = 0;
2107     my $total_price       = 0;
2108
2109     #get variation of isbn
2110     my @isbn_params;
2111     my @isbns;
2112     if ($isbn){
2113         if ( C4::Context->preference("SearchWithISBNVariations") ){
2114             @isbns = C4::Koha::GetVariationsOfISBN( $isbn );
2115             foreach my $isb (@isbns){
2116                 push @isbn_params, '?';
2117             }
2118         }
2119         unless (@isbns){
2120             push @isbns, $isbn;
2121             push @isbn_params, '?';
2122         }
2123     }
2124
2125     my $dbh   = C4::Context->dbh;
2126     my $query ="
2127         SELECT
2128             COALESCE(biblio.title,     deletedbiblio.title)     AS title,
2129             COALESCE(biblio.author,    deletedbiblio.author)    AS author,
2130             COALESCE(biblioitems.isbn, deletedbiblioitems.isbn) AS isbn,
2131             COALESCE(biblioitems.ean,  deletedbiblioitems.ean)  AS ean,
2132             aqorders.basketno,
2133             aqbasket.basketname,
2134             aqbasket.basketgroupid,
2135             aqbasket.authorisedby,
2136             aqbasket.is_standing,
2137             concat( borrowers.firstname,' ',borrowers.surname) AS authorisedbyname,
2138             branch as managing_library,
2139             aqbasketgroups.name as groupname,
2140             aqbooksellers.name,
2141             aqbasket.creationdate,
2142             aqorders.datereceived,
2143             aqorders.quantity,
2144             aqorders.quantityreceived,
2145             aqorders.ecost,
2146             aqorders.ordernumber,
2147             aqorders.invoiceid,
2148             aqinvoices.invoicenumber,
2149             aqbooksellers.id as id,
2150             aqorders.biblionumber,
2151             aqorders.orderstatus,
2152             aqorders.parent_ordernumber,
2153             aqbudgets.budget_name
2154             ";
2155     $query .= ", aqbudgets.budget_id AS budget" if defined $budget;
2156     $query .= "
2157         FROM aqorders
2158         LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
2159         LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
2160         LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
2161         LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
2162         LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
2163         LEFT JOIN aqbudgets ON aqorders.budget_id=aqbudgets.budget_id
2164         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2165         LEFT JOIN deletedbiblio ON deletedbiblio.biblionumber=aqorders.biblionumber
2166         LEFT JOIN deletedbiblioitems ON deletedbiblioitems.biblionumber=aqorders.biblionumber
2167         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2168         ";
2169
2170     $query .= " WHERE 1 ";
2171
2172     unless ($get_canceled_order or (defined $orderstatus and $orderstatus eq 'cancelled')) {
2173         $query .= " AND datecancellationprinted IS NULL ";
2174     }
2175
2176     my @query_params  = ();
2177
2178     if ( $biblionumber ) {
2179         $query .= " AND biblio.biblionumber = ?";
2180         push @query_params, $biblionumber;
2181     }
2182
2183     if ( $title ) {
2184         $query .= " AND biblio.title LIKE ? ";
2185         $title =~ s/\s+/%/g;
2186         push @query_params, "%$title%";
2187     }
2188
2189     if ( $author ) {
2190         $query .= " AND biblio.author LIKE ? ";
2191         push @query_params, "%$author%";
2192     }
2193
2194     if ( @isbns ) {
2195         $query .= " AND ( biblioitems.isbn LIKE " . join (" OR biblioitems.isbn LIKE ", @isbn_params ) . ")";
2196         foreach my $isb (@isbns){
2197             push @query_params, "%$isb%";
2198         }
2199     }
2200
2201     if ( $ean ) {
2202         $query .= " AND biblioitems.ean = ? ";
2203         push @query_params, "$ean";
2204     }
2205     if ( $name ) {
2206         $query .= " AND aqbooksellers.name LIKE ? ";
2207         push @query_params, "%$name%";
2208     }
2209
2210     if ( $budget ) {
2211         $query .= " AND aqbudgets.budget_id = ? ";
2212         push @query_params, "$budget";
2213     }
2214
2215     if ( $from_placed_on ) {
2216         $query .= " AND creationdate >= ? ";
2217         push @query_params, $from_placed_on;
2218     }
2219
2220     if ( $to_placed_on ) {
2221         $query .= " AND creationdate <= ? ";
2222         push @query_params, $to_placed_on;
2223     }
2224
2225     if ( defined $orderstatus and $orderstatus ne '') {
2226         $query .= " AND aqorders.orderstatus = ? ";
2227         push @query_params, "$orderstatus";
2228     }
2229
2230     if ( $is_standing ) {
2231         $query .= " AND is_standing = ? ";
2232         push @query_params, $is_standing;
2233     }
2234
2235     if ($basket) {
2236         if ($basket =~ m/^\d+$/) {
2237             $query .= " AND aqorders.basketno = ? ";
2238             push @query_params, $basket;
2239         } else {
2240             $query .= " AND aqbasket.basketname LIKE ? ";
2241             push @query_params, "%$basket%";
2242         }
2243     }
2244
2245     if ($booksellerinvoicenumber) {
2246         $query .= " AND aqinvoices.invoicenumber LIKE ? ";
2247         push @query_params, "%$booksellerinvoicenumber%";
2248     }
2249
2250     if ($basketgroupname) {
2251         $query .= " AND aqbasketgroups.name LIKE ? ";
2252         push @query_params, "%$basketgroupname%";
2253     }
2254
2255     if ($ordernumber) {
2256         $query .= " AND (aqorders.ordernumber = ? ";
2257         push @query_params, $ordernumber;
2258         if ($search_children_too) {
2259             $query .= " OR aqorders.parent_ordernumber = ? ";
2260             push @query_params, $ordernumber;
2261         }
2262         $query .= ") ";
2263     }
2264
2265     if ( @$created_by ) {
2266         $query .= ' AND aqbasket.authorisedby IN ( ' . join( ',', ('?') x @$created_by ) . ')';
2267         push @query_params, @$created_by;
2268     }
2269
2270     if ( $managing_library ) {
2271         $query .= " AND aqbasket.branch = ? ";
2272         push @query_params, $managing_library;
2273     }
2274
2275     if ( @$ordernumbers ) {
2276         $query .= ' AND (aqorders.ordernumber IN ( ' . join (',', ('?') x @$ordernumbers ) . '))';
2277         push @query_params, @$ordernumbers;
2278     }
2279     if ( @$additional_fields ) {
2280         my @baskets = Koha::Acquisition::Baskets->filter_by_additional_fields($additional_fields);
2281
2282         return [] unless @baskets;
2283
2284         # No parameterization because record IDs come directly from DB
2285         $query .= ' AND aqbasket.basketno IN ( ' . join( ',', map { $_->basketno } @baskets ) . ' )';
2286     }
2287
2288     if ( C4::Context->preference("IndependentBranches") ) {
2289         unless ( C4::Context->IsSuperLibrarian() ) {
2290             $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
2291             push @query_params, C4::Context->userenv->{branch};
2292         }
2293     }
2294     $query .= " ORDER BY id";
2295
2296     return $dbh->selectall_arrayref( $query, { Slice => {} }, @query_params );
2297 }
2298
2299 =head2 GetRecentAcqui
2300
2301   $results = GetRecentAcqui($days);
2302
2303 C<$results> is a ref to a table which contains hashref
2304
2305 =cut
2306
2307 sub GetRecentAcqui {
2308     my $limit  = shift;
2309     my $dbh    = C4::Context->dbh;
2310     my $query = "
2311         SELECT *
2312         FROM   biblio
2313         ORDER BY timestamp DESC
2314         LIMIT  0,".$limit;
2315
2316     my $sth = $dbh->prepare($query);
2317     $sth->execute;
2318     my $results = $sth->fetchall_arrayref({});
2319     return $results;
2320 }
2321
2322 #------------------------------------------------------------#
2323
2324 =head3 AddClaim
2325
2326   &AddClaim($ordernumber);
2327
2328 Add a claim for an order
2329
2330 =cut
2331
2332 sub AddClaim {
2333     my ($ordernumber) = @_;
2334     my $dbh          = C4::Context->dbh;
2335     my $query        = "
2336         UPDATE aqorders SET
2337             claims_count = claims_count + 1,
2338             claimed_date = CURDATE()
2339         WHERE ordernumber = ?
2340         ";
2341     my $sth = $dbh->prepare($query);
2342     $sth->execute($ordernumber);
2343 }
2344
2345 =head3 GetInvoices
2346
2347     my @invoices = GetInvoices(
2348         invoicenumber => $invoicenumber,
2349         supplierid => $supplierid,
2350         suppliername => $suppliername,
2351         shipmentdatefrom => $shipmentdatefrom, # ISO format
2352         shipmentdateto => $shipmentdateto, # ISO format
2353         billingdatefrom => $billingdatefrom, # ISO format
2354         billingdateto => $billingdateto, # ISO format
2355         isbneanissn => $isbn_or_ean_or_issn,
2356         title => $title,
2357         author => $author,
2358         publisher => $publisher,
2359         publicationyear => $publicationyear,
2360         branchcode => $branchcode,
2361         order_by => $order_by
2362     );
2363
2364 Return a list of invoices that match all given criteria.
2365
2366 $order_by is "column_name (asc|desc)", where column_name is any of
2367 'invoicenumber', 'booksellerid', 'shipmentdate', 'billingdate', 'closedate',
2368 'shipmentcost', 'shipmentcost_budgetid'.
2369
2370 asc is the default if omitted
2371
2372 =cut
2373
2374 sub GetInvoices {
2375     my %args = @_;
2376
2377     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2378         closedate shipmentcost shipmentcost_budgetid);
2379
2380     my $dbh = C4::Context->dbh;
2381     my $query = qq{
2382         SELECT aqinvoices.invoiceid, aqinvoices.invoicenumber, aqinvoices.booksellerid, aqinvoices.shipmentdate, aqinvoices.billingdate, aqinvoices.closedate, aqinvoices.shipmentcost, aqinvoices.shipmentcost_budgetid, aqinvoices.message_id,
2383             aqbooksellers.name AS suppliername,
2384           COUNT(
2385             DISTINCT IF(
2386               aqorders.datereceived IS NOT NULL,
2387               aqorders.biblionumber,
2388               NULL
2389             )
2390           ) AS receivedbiblios,
2391           COUNT(
2392              DISTINCT IF(
2393               aqorders.subscriptionid IS NOT NULL,
2394               aqorders.subscriptionid,
2395               NULL
2396             )
2397           ) AS is_linked_to_subscriptions,
2398           SUM(aqorders.quantityreceived) AS receiveditems
2399         FROM aqinvoices
2400           LEFT JOIN aqbooksellers ON aqbooksellers.id = aqinvoices.booksellerid
2401           LEFT JOIN aqorders ON aqorders.invoiceid = aqinvoices.invoiceid
2402           LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
2403           LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2404           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2405           LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
2406           LEFT JOIN subscription ON biblio.biblionumber = subscription.biblionumber
2407     };
2408
2409     my @bind_args;
2410     my @bind_strs;
2411     if($args{supplierid}) {
2412         push @bind_strs, " aqinvoices.booksellerid = ? ";
2413         push @bind_args, $args{supplierid};
2414     }
2415     if($args{invoicenumber}) {
2416         push @bind_strs, " aqinvoices.invoicenumber LIKE ? ";
2417         push @bind_args, "%$args{invoicenumber}%";
2418     }
2419     if($args{suppliername}) {
2420         push @bind_strs, " aqbooksellers.name LIKE ? ";
2421         push @bind_args, "%$args{suppliername}%";
2422     }
2423     if($args{shipmentdatefrom}) {
2424         push @bind_strs, " aqinvoices.shipmentdate >= ? ";
2425         push @bind_args, $args{shipmentdatefrom};
2426     }
2427     if($args{shipmentdateto}) {
2428         push @bind_strs, " aqinvoices.shipmentdate <= ? ";
2429         push @bind_args, $args{shipmentdateto};
2430     }
2431     if($args{billingdatefrom}) {
2432         push @bind_strs, " aqinvoices.billingdate >= ? ";
2433         push @bind_args, $args{billingdatefrom};
2434     }
2435     if($args{billingdateto}) {
2436         push @bind_strs, " aqinvoices.billingdate <= ? ";
2437         push @bind_args, $args{billingdateto};
2438     }
2439     if($args{isbneanissn}) {
2440         push @bind_strs, " (biblioitems.isbn LIKE CONCAT('%', ?, '%') OR biblioitems.ean LIKE CONCAT('%', ?, '%') OR biblioitems.issn LIKE CONCAT('%', ?, '%') ) ";
2441         push @bind_args, $args{isbneanissn}, $args{isbneanissn}, $args{isbneanissn};
2442     }
2443     if($args{title}) {
2444         push @bind_strs, " biblio.title LIKE CONCAT('%', ?, '%') ";
2445         push @bind_args, $args{title};
2446     }
2447     if($args{author}) {
2448         push @bind_strs, " biblio.author LIKE CONCAT('%', ?, '%') ";
2449         push @bind_args, $args{author};
2450     }
2451     if($args{publisher}) {
2452         push @bind_strs, " biblioitems.publishercode LIKE CONCAT('%', ?, '%') ";
2453         push @bind_args, $args{publisher};
2454     }
2455     if($args{publicationyear}) {
2456         push @bind_strs, " ((biblioitems.publicationyear LIKE CONCAT('%', ?, '%')) OR (biblio.copyrightdate LIKE CONCAT('%', ?, '%'))) ";
2457         push @bind_args, $args{publicationyear}, $args{publicationyear};
2458     }
2459     if($args{branchcode}) {
2460         push @bind_strs, " borrowers.branchcode = ? ";
2461         push @bind_args, $args{branchcode};
2462     }
2463     if($args{message_id}) {
2464         push @bind_strs, " aqinvoices.message_id = ? ";
2465         push @bind_args, $args{message_id};
2466     }
2467
2468     $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2469     $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";
2470
2471     if($args{order_by}) {
2472         my ($column, $direction) = split / /, $args{order_by};
2473         if(grep  { $_ eq $column } @columns) {
2474             $direction ||= 'ASC';
2475             $query .= " ORDER BY $column $direction";
2476         }
2477     }
2478
2479     my $sth = $dbh->prepare($query);
2480     $sth->execute(@bind_args);
2481
2482     my $results = $sth->fetchall_arrayref({});
2483     return @$results;
2484 }
2485
2486 =head3 GetInvoice
2487
2488     my $invoice = GetInvoice($invoiceid);
2489
2490 Get informations about invoice with given $invoiceid
2491
2492 Return a hash filled with aqinvoices.* fields
2493
2494 =cut
2495
2496 sub GetInvoice {
2497     my ($invoiceid) = @_;
2498     my $invoice;
2499
2500     return unless $invoiceid;
2501
2502     my $dbh = C4::Context->dbh;
2503     my $query = qq{
2504         SELECT *
2505         FROM aqinvoices
2506         WHERE invoiceid = ?
2507     };
2508     my $sth = $dbh->prepare($query);
2509     $sth->execute($invoiceid);
2510
2511     $invoice = $sth->fetchrow_hashref;
2512     return $invoice;
2513 }
2514
2515 =head3 GetInvoiceDetails
2516
2517     my $invoice = GetInvoiceDetails($invoiceid)
2518
2519 Return informations about an invoice + the list of related order lines
2520
2521 Orders informations are in $invoice->{orders} (array ref)
2522
2523 =cut
2524
2525 sub GetInvoiceDetails {
2526     my ($invoiceid) = @_;
2527
2528     if ( !defined $invoiceid ) {
2529         carp 'GetInvoiceDetails called without an invoiceid';
2530         return;
2531     }
2532
2533     my $dbh = C4::Context->dbh;
2534     my $query = q{
2535         SELECT aqinvoices.*, aqbooksellers.name AS suppliername
2536         FROM aqinvoices
2537           LEFT JOIN aqbooksellers ON aqinvoices.booksellerid = aqbooksellers.id
2538         WHERE invoiceid = ?
2539     };
2540     my $sth = $dbh->prepare($query);
2541     $sth->execute($invoiceid);
2542
2543     my $invoice = $sth->fetchrow_hashref;
2544
2545     $query = q{
2546         SELECT aqorders.*,
2547                 biblio.*,
2548                 biblio.copyrightdate,
2549                 biblioitems.isbn,
2550                 biblioitems.publishercode,
2551                 biblioitems.publicationyear,
2552                 aqbasket.basketname,
2553                 aqbasketgroups.id AS basketgroupid,
2554                 aqbasketgroups.name AS basketgroupname
2555         FROM aqorders
2556           LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
2557           LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
2558           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2559           LEFT JOIN biblioitems ON aqorders.biblionumber = biblioitems.biblionumber
2560         WHERE invoiceid = ?
2561     };
2562     $sth = $dbh->prepare($query);
2563     $sth->execute($invoiceid);
2564     $invoice->{orders} = $sth->fetchall_arrayref({});
2565     $invoice->{orders} ||= []; # force an empty arrayref if fetchall_arrayref fails
2566
2567     return $invoice;
2568 }
2569
2570 =head3 AddInvoice
2571
2572     my $invoiceid = AddInvoice(
2573         invoicenumber => $invoicenumber,
2574         booksellerid => $booksellerid,
2575         shipmentdate => $shipmentdate,
2576         billingdate => $billingdate,
2577         closedate => $closedate,
2578         shipmentcost => $shipmentcost,
2579         shipmentcost_budgetid => $shipmentcost_budgetid
2580     );
2581
2582 Create a new invoice and return its id or undef if it fails.
2583
2584 =cut
2585
2586 sub AddInvoice {
2587     my %invoice = @_;
2588
2589     return unless(%invoice and $invoice{invoicenumber});
2590
2591     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2592         closedate shipmentcost shipmentcost_budgetid message_id);
2593
2594     my @set_strs;
2595     my @set_args;
2596     foreach my $key (keys %invoice) {
2597         if(0 < grep { $_ eq $key } @columns) {
2598             push @set_strs, "$key = ?";
2599             push @set_args, ($invoice{$key} || undef);
2600         }
2601     }
2602
2603     my $rv;
2604     if(@set_args > 0) {
2605         my $dbh = C4::Context->dbh;
2606         my $query = "INSERT INTO aqinvoices SET ";
2607         $query .= join (",", @set_strs);
2608         my $sth = $dbh->prepare($query);
2609         $rv = $sth->execute(@set_args);
2610         if($rv) {
2611             $rv = $dbh->last_insert_id(undef, undef, 'aqinvoices', undef);
2612         }
2613     }
2614     return $rv;
2615 }
2616
2617 =head3 ModInvoice
2618
2619     ModInvoice(
2620         invoiceid => $invoiceid,    # Mandatory
2621         invoicenumber => $invoicenumber,
2622         booksellerid => $booksellerid,
2623         shipmentdate => $shipmentdate,
2624         billingdate => $billingdate,
2625         closedate => $closedate,
2626         shipmentcost => $shipmentcost,
2627         shipmentcost_budgetid => $shipmentcost_budgetid
2628     );
2629
2630 Modify an invoice, invoiceid is mandatory.
2631
2632 Return undef if it fails.
2633
2634 =cut
2635
2636 sub ModInvoice {
2637     my %invoice = @_;
2638
2639     return unless(%invoice and $invoice{invoiceid});
2640
2641     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2642         closedate shipmentcost shipmentcost_budgetid);
2643
2644     my @set_strs;
2645     my @set_args;
2646     foreach my $key (keys %invoice) {
2647         if(0 < grep { $_ eq $key } @columns) {
2648             push @set_strs, "$key = ?";
2649             push @set_args, ($invoice{$key} || undef);
2650         }
2651     }
2652
2653     my $dbh = C4::Context->dbh;
2654     my $query = "UPDATE aqinvoices SET ";
2655     $query .= join(",", @set_strs);
2656     $query .= " WHERE invoiceid = ?";
2657
2658     my $sth = $dbh->prepare($query);
2659     $sth->execute(@set_args, $invoice{invoiceid});
2660 }
2661
2662 =head3 CloseInvoice
2663
2664     CloseInvoice($invoiceid);
2665
2666 Close an invoice.
2667
2668 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => undef);
2669
2670 =cut
2671
2672 sub CloseInvoice {
2673     my ($invoiceid) = @_;
2674
2675     return unless $invoiceid;
2676
2677     my $dbh = C4::Context->dbh;
2678     my $query = qq{
2679         UPDATE aqinvoices
2680         SET closedate = CAST(NOW() AS DATE)
2681         WHERE invoiceid = ?
2682     };
2683     my $sth = $dbh->prepare($query);
2684     $sth->execute($invoiceid);
2685 }
2686
2687 =head3 ReopenInvoice
2688
2689     ReopenInvoice($invoiceid);
2690
2691 Reopen an invoice
2692
2693 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => output_pref({ dt=>dt_from_string, dateonly=>1, otputpref=>'iso' }))
2694
2695 =cut
2696
2697 sub ReopenInvoice {
2698     my ($invoiceid) = @_;
2699
2700     return unless $invoiceid;
2701
2702     my $dbh = C4::Context->dbh;
2703     my $query = qq{
2704         UPDATE aqinvoices
2705         SET closedate = NULL
2706         WHERE invoiceid = ?
2707     };
2708     my $sth = $dbh->prepare($query);
2709     $sth->execute($invoiceid);
2710 }
2711
2712 =head3 DelInvoice
2713
2714     DelInvoice($invoiceid);
2715
2716 Delete an invoice if there are no items attached to it.
2717
2718 =cut
2719
2720 sub DelInvoice {
2721     my ($invoiceid) = @_;
2722
2723     return unless $invoiceid;
2724
2725     my $dbh   = C4::Context->dbh;
2726     my $query = qq{
2727         SELECT COUNT(*)
2728         FROM aqorders
2729         WHERE invoiceid = ?
2730     };
2731     my $sth = $dbh->prepare($query);
2732     $sth->execute($invoiceid);
2733     my $res = $sth->fetchrow_arrayref;
2734     if ( $res && $res->[0] == 0 ) {
2735         $query = qq{
2736             DELETE FROM aqinvoices
2737             WHERE invoiceid = ?
2738         };
2739         my $sth = $dbh->prepare($query);
2740         return ( $sth->execute($invoiceid) > 0 );
2741     }
2742     return;
2743 }
2744
2745 =head3 MergeInvoices
2746
2747     MergeInvoices($invoiceid, \@sourceids);
2748
2749 Merge the invoices identified by the IDs in \@sourceids into
2750 the invoice identified by $invoiceid.
2751
2752 =cut
2753
2754 sub MergeInvoices {
2755     my ($invoiceid, $sourceids) = @_;
2756
2757     return unless $invoiceid;
2758     foreach my $sourceid (@$sourceids) {
2759         next if $sourceid == $invoiceid;
2760         my $source = GetInvoiceDetails($sourceid);
2761         foreach my $order (@{$source->{'orders'}}) {
2762             $order->{'invoiceid'} = $invoiceid;
2763             ModOrder($order);
2764         }
2765         DelInvoice($source->{'invoiceid'});
2766     }
2767     return;
2768 }
2769
2770 =head3 GetBiblioCountByBasketno
2771
2772 $biblio_count = &GetBiblioCountByBasketno($basketno);
2773
2774 Looks up the biblio's count that has basketno value $basketno
2775
2776 Returns a quantity
2777
2778 =cut
2779
2780 sub GetBiblioCountByBasketno {
2781     my ($basketno) = @_;
2782     my $dbh          = C4::Context->dbh;
2783     my $query        = "
2784         SELECT COUNT( DISTINCT( biblionumber ) )
2785         FROM   aqorders
2786         WHERE  basketno = ?
2787             AND datecancellationprinted IS NULL
2788         ";
2789
2790     my $sth = $dbh->prepare($query);
2791     $sth->execute($basketno);
2792     return $sth->fetchrow;
2793 }
2794
2795 =head3 populate_order_with_prices
2796
2797 $order = populate_order_with_prices({
2798     order        => $order #a hashref with the order values
2799     booksellerid => $booksellerid #FIXME - should obtain from order basket
2800     receiving    => 1 # boolean representing order stage, should pass only this or ordering
2801     ordering     => 1 # boolean representing order stage
2802 });
2803
2804
2805 Sets calculated values for an order - all values are stored with full precision
2806 regardless of rounding preference except for tax value which is calculated
2807 on rounded values if requested
2808
2809 For ordering the values set are:
2810     rrp_tax_included
2811     rrp_tax_excluded
2812     ecost_tax_included
2813     ecost_tax_excluded
2814     tax_value_on_ordering
2815 For receiving the value set are:
2816     unitprice_tax_included
2817     unitprice_tax_excluded
2818     tax_value_on_receiving
2819
2820 Note: When receiving, if the rounded value of the unitprice matches the rounded
2821 value of the ecost then then ecost (full precision) is used.
2822
2823 Returns a hashref of the order
2824
2825 FIXME: Move this to Koha::Acquisition::Order.pm
2826
2827 =cut
2828
2829 sub populate_order_with_prices {
2830     my ($params) = @_;
2831
2832     my $order        = $params->{order};
2833     my $booksellerid = $params->{booksellerid};
2834     return unless $booksellerid;
2835
2836     my $bookseller = Koha::Acquisition::Booksellers->find( $booksellerid );
2837
2838     my $receiving = $params->{receiving};
2839     my $ordering  = $params->{ordering};
2840     my $discount  = $order->{discount};
2841     $discount /= 100 if $discount > 1;
2842
2843     if ($ordering) {
2844         $order->{tax_rate_on_ordering} //= $order->{tax_rate};
2845         if ( $bookseller->listincgst ) {
2846
2847             # The user entered the prices tax included
2848             $order->{unitprice} += 0;
2849             $order->{unitprice_tax_included} = $order->{unitprice};
2850             $order->{rrp_tax_included} = $order->{rrp};
2851
2852             # price tax excluded = price tax included / ( 1 + tax rate )
2853             $order->{unitprice_tax_excluded} = $order->{unitprice_tax_included} / ( 1 + $order->{tax_rate_on_ordering} );
2854             $order->{rrp_tax_excluded} = $order->{rrp_tax_included} / ( 1 + $order->{tax_rate_on_ordering} );
2855
2856             # ecost tax included = rrp tax included  ( 1 - discount )
2857             $order->{ecost_tax_included} = $order->{rrp_tax_included} * ( 1 - $discount );
2858
2859             # ecost tax excluded = rrp tax excluded * ( 1 - discount )
2860             $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount );
2861
2862             # tax value = quantity * ecost tax excluded * tax rate
2863             # we should use the unitprice if included
2864             my $cost_tax_included = $order->{unitprice_tax_included} == 0 ? $order->{ecost_tax_included} : $order->{unitprice_tax_included};
2865             my $cost_tax_excluded = $order->{unitprice_tax_excluded} == 0 ? $order->{ecost_tax_excluded} : $order->{unitprice_tax_excluded};
2866             $order->{tax_value_on_ordering} = ( get_rounded_price($cost_tax_included) - get_rounded_price($cost_tax_excluded) ) * $order->{quantity};
2867
2868         }
2869         else {
2870             # The user entered the prices tax excluded
2871             $order->{unitprice_tax_excluded} = $order->{unitprice};
2872             $order->{rrp_tax_excluded} = $order->{rrp};
2873
2874             # price tax included = price tax excluded * ( 1 - tax rate )
2875             $order->{unitprice_tax_included} = $order->{unitprice_tax_excluded} * ( 1 + $order->{tax_rate_on_ordering} );
2876             $order->{rrp_tax_included} = $order->{rrp_tax_excluded} * ( 1 + $order->{tax_rate_on_ordering} );
2877
2878             # ecost tax excluded = rrp tax excluded * ( 1 - discount )
2879             $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount );
2880
2881             # ecost tax included = rrp tax excluded * ( 1 + tax rate ) * ( 1 - discount ) = ecost tax excluded * ( 1 + tax rate )
2882             $order->{ecost_tax_included} = $order->{ecost_tax_excluded} * ( 1 + $order->{tax_rate_on_ordering} );
2883
2884             # tax value = quantity * ecost tax included * tax rate
2885             # we should use the unitprice if included
2886             my $cost_tax_excluded = $order->{unitprice_tax_excluded} == 0 ?  $order->{ecost_tax_excluded} : $order->{unitprice_tax_excluded};
2887             $order->{tax_value_on_ordering} = $order->{quantity} * get_rounded_price($cost_tax_excluded) * $order->{tax_rate_on_ordering};
2888         }
2889     }
2890
2891     if ($receiving) {
2892         $order->{tax_rate_on_receiving} //= $order->{tax_rate};
2893         if ( $bookseller->invoiceincgst ) {
2894             # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
2895             # we need to keep the exact ecost value
2896             if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_included} )->round ) {
2897                 $order->{unitprice} = $order->{ecost_tax_included};
2898             }
2899
2900             # The user entered the unit price tax included
2901             $order->{unitprice_tax_included} = $order->{unitprice};
2902
2903             # unit price tax excluded = unit price tax included / ( 1 + tax rate )
2904             $order->{unitprice_tax_excluded} = $order->{unitprice_tax_included} / ( 1 + $order->{tax_rate_on_receiving} );
2905         }
2906         else {
2907             # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
2908             # we need to keep the exact ecost value
2909             if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_excluded} )->round ) {
2910                 $order->{unitprice} = $order->{ecost_tax_excluded};
2911             }
2912
2913             # The user entered the unit price tax excluded
2914             $order->{unitprice_tax_excluded} = $order->{unitprice};
2915
2916
2917             # unit price tax included = unit price tax included * ( 1 + tax rate )
2918             $order->{unitprice_tax_included} = $order->{unitprice_tax_excluded} * ( 1 + $order->{tax_rate_on_receiving} );
2919         }
2920
2921         # tax value = quantity * unit price tax excluded * tax rate
2922         $order->{tax_value_on_receiving} = $order->{quantity} * get_rounded_price($order->{unitprice_tax_excluded}) * $order->{tax_rate_on_receiving};
2923     }
2924
2925     return $order;
2926 }
2927
2928 =head3 GetOrderUsers
2929
2930     $order_users_ids = &GetOrderUsers($ordernumber);
2931
2932 Returns a list of all borrowernumbers that are in order users list
2933
2934 =cut
2935
2936 sub GetOrderUsers {
2937     my ($ordernumber) = @_;
2938
2939     return unless $ordernumber;
2940
2941     my $query = q|
2942         SELECT borrowernumber
2943         FROM aqorder_users
2944         WHERE ordernumber = ?
2945     |;
2946     my $dbh = C4::Context->dbh;
2947     my $sth = $dbh->prepare($query);
2948     $sth->execute($ordernumber);
2949     my $results = $sth->fetchall_arrayref( {} );
2950
2951     my @borrowernumbers;
2952     foreach (@$results) {
2953         push @borrowernumbers, $_->{'borrowernumber'};
2954     }
2955
2956     return @borrowernumbers;
2957 }
2958
2959 =head3 ModOrderUsers
2960
2961     my @order_users_ids = (1, 2, 3);
2962     &ModOrderUsers($ordernumber, @basketusers_ids);
2963
2964 Delete all users from order users list, and add users in C<@order_users_ids>
2965 to this users list.
2966
2967 =cut
2968
2969 sub ModOrderUsers {
2970     my ( $ordernumber, @order_users_ids ) = @_;
2971
2972     return unless $ordernumber;
2973
2974     my $dbh   = C4::Context->dbh;
2975     my $query = q|
2976         DELETE FROM aqorder_users
2977         WHERE ordernumber = ?
2978     |;
2979     my $sth = $dbh->prepare($query);
2980     $sth->execute($ordernumber);
2981
2982     $query = q|
2983         INSERT INTO aqorder_users (ordernumber, borrowernumber)
2984         VALUES (?, ?)
2985     |;
2986     $sth = $dbh->prepare($query);
2987     foreach my $order_user_id (@order_users_ids) {
2988         $sth->execute( $ordernumber, $order_user_id );
2989     }
2990 }
2991
2992 sub NotifyOrderUsers {
2993     my ($ordernumber) = @_;
2994
2995     my @borrowernumbers = GetOrderUsers($ordernumber);
2996     return unless @borrowernumbers;
2997
2998     my $order = GetOrder( $ordernumber );
2999     for my $borrowernumber (@borrowernumbers) {
3000         my $patron = Koha::Patrons->find( $borrowernumber );
3001         my $library = $patron->library->unblessed;
3002         my $biblio = Koha::Biblios->find( $order->{biblionumber} )->unblessed;
3003         my $letter = C4::Letters::GetPreparedLetter(
3004             module      => 'acquisition',
3005             letter_code => 'ACQ_NOTIF_ON_RECEIV',
3006             branchcode  => $library->{branchcode},
3007             lang        => $patron->lang,
3008             tables      => {
3009                 'branches'    => $library,
3010                 'borrowers'   => $patron->unblessed,
3011                 'biblio'      => $biblio,
3012                 'aqorders'    => $order,
3013             },
3014         );
3015         if ( $letter ) {
3016             C4::Letters::EnqueueLetter(
3017                 {
3018                     letter         => $letter,
3019                     borrowernumber => $borrowernumber,
3020                     LibraryName    => C4::Context->preference("LibraryName"),
3021                     message_transport_type => 'email',
3022                 }
3023             ) or warn "can't enqueue letter $letter";
3024         }
3025     }
3026 }
3027
3028 =head3 FillWithDefaultValues
3029
3030 FillWithDefaultValues( $marc_record, $params );
3031
3032 This will update the record with default value defined in the ACQ framework.
3033 For all existing fields, if a default value exists and there are no subfield, it will be created.
3034 If the field does not exist, it will be created too.
3035
3036 If the parameter only_mandatory => 1 is passed via $params, only the mandatory
3037 defaults are being applied to the record.
3038
3039 =cut
3040
3041 sub FillWithDefaultValues {
3042     my ( $record, $params ) = @_;
3043     my $mandatory = $params->{only_mandatory};
3044     my $tagslib = C4::Biblio::GetMarcStructure( 1, 'ACQ', { unsafe => 1 } );
3045     if ($tagslib) {
3046         my ($itemfield) =
3047           C4::Biblio::GetMarcFromKohaField( 'items.itemnumber' );
3048         for my $tag ( sort keys %$tagslib ) {
3049             next unless $tag;
3050             next if $tag == $itemfield;
3051             for my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
3052                 next if IsMarcStructureInternal($tagslib->{$tag}{$subfield});
3053                 next if $mandatory && !$tagslib->{$tag}{$subfield}{mandatory};
3054                 my $defaultvalue = $tagslib->{$tag}{$subfield}{defaultvalue};
3055                 if ( defined $defaultvalue and $defaultvalue ne '' ) {
3056                     my @fields = $record->field($tag);
3057                     if (@fields) {
3058                         for my $field (@fields) {
3059                             if ( $field->is_control_field ) {
3060                                 $field->update($defaultvalue) if not defined $field->data;
3061                             }
3062                             elsif ( not defined $field->subfield($subfield) ) {
3063                                 $field->add_subfields(
3064                                     $subfield => $defaultvalue );
3065                             }
3066                         }
3067                     }
3068                     else {
3069                         if ( $tag < 10 ) { # is_control_field
3070                             $record->insert_fields_ordered(
3071                                 MARC::Field->new(
3072                                     $tag, $defaultvalue
3073                                 )
3074                             );
3075                         }
3076                         else {
3077                             $record->insert_fields_ordered(
3078                                 MARC::Field->new(
3079                                     $tag, '', '', $subfield => $defaultvalue
3080                                 )
3081                             );
3082                         }
3083                     }
3084                 }
3085             }
3086         }
3087     }
3088 }
3089
3090 1;
3091 __END__
3092
3093 =head1 AUTHOR
3094
3095 Koha Development Team <http://koha-community.org/>
3096
3097 =cut