C4/Acquisition.pm

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