C4/Acquisition.pm

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