C4/Acquisition.pm

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