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