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 );
  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 = $datereceived ? dt_from_string( $datereceived ) : dt_from_string;
1378     $datereceived = $datereceived->ymd;
1379
1380     my $suggestionid = GetSuggestionFromBiblionumber( $biblionumber );
1381     if ($suggestionid) {
1382         ModSuggestion( {suggestionid=>$suggestionid,
1383                         STATUS=>'AVAILABLE',
1384                         biblionumber=> $biblionumber}
1385                         );
1386     }
1387
1388     my $result_set = $dbh->selectrow_arrayref(
1389             q{SELECT aqbasket.is_standing
1390             FROM aqbasket
1391             WHERE basketno=?},{ Slice => {} }, $order->{basketno});
1392     my $is_standing = $result_set->[0];  # we assume we have a unique basket
1393
1394     my $new_ordernumber = $order->{ordernumber};
1395     if ( $is_standing || $order->{quantity} > $quantrec ) {
1396         # Split order line in two parts: the first is the original order line
1397         # without received items (the quantity is decreased),
1398         # the second part is a new order line with quantity=quantityrec
1399         # (entirely received)
1400         my $query = q|
1401             UPDATE aqorders
1402             SET quantity = ?,
1403                 orderstatus = 'partial'|;
1404         $query .= q| WHERE ordernumber = ?|;
1405         my $sth = $dbh->prepare($query);
1406
1407         $sth->execute(
1408             ( $is_standing ? 1 : ($order->{quantity} - $quantrec) ),
1409             $order->{ordernumber}
1410         );
1411
1412         if ( not $order->{subscriptionid} && defined $order->{order_internalnote} ) {
1413             $dbh->do(
1414                 q|UPDATE aqorders
1415                 SET order_internalnote = ?
1416                 WHERE ordernumber = ?|, {},
1417                 $order->{order_internalnote}, $order->{ordernumber}
1418             );
1419         }
1420
1421         # Recalculate tax_value
1422         $dbh->do(q|
1423             UPDATE aqorders
1424             SET
1425                 tax_value_on_ordering = quantity * | . get_rounding_sql(q|ecost_tax_excluded|) . q| * tax_rate_on_ordering,
1426                 tax_value_on_receiving = quantity * | . get_rounding_sql(q|unitprice_tax_excluded|) . q| * tax_rate_on_receiving
1427             WHERE ordernumber = ?
1428         |, undef, $order->{ordernumber});
1429
1430         delete $order->{ordernumber};
1431         $order->{budget_id} = ( $budget_id || $order->{budget_id} );
1432         $order->{quantity} = $quantrec;
1433         $order->{quantityreceived} = $quantrec;
1434         $order->{ecost_tax_excluded} //= 0;
1435         $order->{tax_rate_on_ordering} //= 0;
1436         $order->{unitprice_tax_excluded} //= 0;
1437         $order->{tax_rate_on_receiving} //= 0;
1438         $order->{tax_value_on_ordering} = $order->{quantity} * get_rounded_price($order->{ecost_tax_excluded}) * $order->{tax_rate_on_ordering};
1439         $order->{tax_value_on_receiving} = $order->{quantity} * get_rounded_price($order->{unitprice_tax_excluded}) * $order->{tax_rate_on_receiving};
1440         $order->{datereceived} = $datereceived;
1441         $order->{invoiceid} = $invoice->{invoiceid};
1442         $order->{orderstatus} = 'complete';
1443         $new_ordernumber = Koha::Acquisition::Order->new($order)->store->ordernumber; # TODO What if the store fails?
1444
1445         if ($received_items) {
1446             foreach my $itemnumber (@$received_items) {
1447                 ModItemOrder($itemnumber, $new_ordernumber);
1448             }
1449         }
1450     } else {
1451         my $query = q|
1452             UPDATE aqorders
1453             SET quantityreceived = ?,
1454                 datereceived = ?,
1455                 invoiceid = ?,
1456                 budget_id = ?,
1457                 orderstatus = 'complete'
1458         |;
1459
1460         $query .= q|
1461             , replacementprice = ?
1462         | if defined $order->{replacementprice};
1463
1464         $query .= q|
1465             , unitprice = ?, unitprice_tax_included = ?, unitprice_tax_excluded = ?
1466         | if defined $order->{unitprice};
1467
1468         $query .= q|
1469             ,tax_value_on_receiving = ?
1470         | if defined $order->{tax_value_on_receiving};
1471
1472         $query .= q|
1473             ,tax_rate_on_receiving = ?
1474         | if defined $order->{tax_rate_on_receiving};
1475
1476         $query .= q|
1477             , order_internalnote = ?
1478         | if defined $order->{order_internalnote};
1479
1480         $query .= q| where biblionumber=? and ordernumber=?|;
1481
1482         my $sth = $dbh->prepare( $query );
1483         my @params = ( $quantrec, $datereceived, $invoice->{invoiceid}, ( $budget_id ? $budget_id : $order->{budget_id} ) );
1484
1485         if ( defined $order->{replacementprice} ) {
1486             push @params, $order->{replacementprice};
1487         }
1488
1489         if ( defined $order->{unitprice} ) {
1490             push @params, $order->{unitprice}, $order->{unitprice_tax_included}, $order->{unitprice_tax_excluded};
1491         }
1492
1493         if ( defined $order->{tax_value_on_receiving} ) {
1494             push @params, $order->{tax_value_on_receiving};
1495         }
1496
1497         if ( defined $order->{tax_rate_on_receiving} ) {
1498             push @params, $order->{tax_rate_on_receiving};
1499         }
1500
1501         if ( defined $order->{order_internalnote} ) {
1502             push @params, $order->{order_internalnote};
1503         }
1504
1505         push @params, ( $biblionumber, $order->{ordernumber} );
1506
1507         $sth->execute( @params );
1508
1509         # All items have been received, sent a notification to users
1510         NotifyOrderUsers( $order->{ordernumber} );
1511
1512     }
1513     return ($datereceived, $new_ordernumber);
1514 }
1515
1516 =head3 CancelReceipt
1517
1518     my $parent_ordernumber = CancelReceipt($ordernumber);
1519
1520     Cancel an order line receipt and update the parent order line, as if no
1521     receipt was made.
1522     If items are created at receipt (AcqCreateItem = receiving) then delete
1523     these items.
1524
1525 =cut
1526
1527 sub CancelReceipt {
1528     my $ordernumber = shift;
1529
1530     return unless $ordernumber;
1531
1532     my $dbh = C4::Context->dbh;
1533     my $query = qq{
1534         SELECT datereceived, parent_ordernumber, quantity
1535         FROM aqorders
1536         WHERE ordernumber = ?
1537     };
1538     my $sth = $dbh->prepare($query);
1539     $sth->execute($ordernumber);
1540     my $order = $sth->fetchrow_hashref;
1541     unless($order) {
1542         warn "CancelReceipt: order $ordernumber does not exist";
1543         return;
1544     }
1545     unless($order->{'datereceived'}) {
1546         warn "CancelReceipt: order $ordernumber is not received";
1547         return;
1548     }
1549
1550     my $parent_ordernumber = $order->{'parent_ordernumber'};
1551
1552     my $order_obj = Koha::Acquisition::Orders->find( $ordernumber ); # FIXME rewrite all this subroutine using this object
1553     my @itemnumbers = $order_obj->items->get_column('itemnumber');
1554
1555     if($parent_ordernumber == $ordernumber || not $parent_ordernumber) {
1556         # The order line has no parent, just mark it as not received
1557         $query = qq{
1558             UPDATE aqorders
1559             SET quantityreceived = ?,
1560                 datereceived = ?,
1561                 invoiceid = ?,
1562                 orderstatus = 'ordered'
1563             WHERE ordernumber = ?
1564         };
1565         $sth = $dbh->prepare($query);
1566         $sth->execute(0, undef, undef, $ordernumber);
1567         _cancel_items_receipt( $order_obj );
1568     } else {
1569         # The order line has a parent, increase parent quantity and delete
1570         # the order line.
1571         unless ( $order_obj->basket->is_standing ) {
1572             $query = qq{
1573                 SELECT quantity, datereceived
1574                 FROM aqorders
1575                 WHERE ordernumber = ?
1576             };
1577             $sth = $dbh->prepare($query);
1578             $sth->execute($parent_ordernumber);
1579             my $parent_order = $sth->fetchrow_hashref;
1580             unless($parent_order) {
1581                 warn "Parent order $parent_ordernumber does not exist.";
1582                 return;
1583             }
1584             if($parent_order->{'datereceived'}) {
1585                 warn "CancelReceipt: parent order is received.".
1586                     " Can't cancel receipt.";
1587                 return;
1588             }
1589             $query = qq{
1590                 UPDATE aqorders
1591                 SET quantity = ?,
1592                     orderstatus = 'ordered'
1593                 WHERE ordernumber = ?
1594             };
1595             $sth = $dbh->prepare($query);
1596             my $rv = $sth->execute(
1597                 $order->{'quantity'} + $parent_order->{'quantity'},
1598                 $parent_ordernumber
1599             );
1600             unless($rv) {
1601                 warn "Cannot update parent order line, so do not cancel".
1602                     " receipt";
1603                 return;
1604             }
1605
1606             # Recalculate tax_value
1607             $dbh->do(q|
1608                 UPDATE aqorders
1609                 SET
1610                     tax_value_on_ordering = quantity * | . get_rounding_sql(q|ecost_tax_excluded|) . q| * tax_rate_on_ordering,
1611                     tax_value_on_receiving = quantity * | . get_rounding_sql(q|unitprice_tax_excluded|) . q| * tax_rate_on_receiving
1612                 WHERE ordernumber = ?
1613             |, undef, $parent_ordernumber);
1614         }
1615
1616         _cancel_items_receipt( $order_obj, $parent_ordernumber );
1617         # Delete order line
1618         $query = qq{
1619             DELETE FROM aqorders
1620             WHERE ordernumber = ?
1621         };
1622         $sth = $dbh->prepare($query);
1623         $sth->execute($ordernumber);
1624
1625     }
1626
1627     if( $order_obj->basket->effective_create_items eq 'ordering' ) {
1628         my @affects = split q{\|}, C4::Context->preference("AcqItemSetSubfieldsWhenReceiptIsCancelled");
1629         if ( @affects ) {
1630             for my $in ( @itemnumbers ) {
1631                 my $item = Koha::Items->find( $in ); # FIXME We do not need that, we already have Koha::Items from $order_obj->items
1632                 my $biblio = $item->biblio;
1633                 my ( $itemfield ) = GetMarcFromKohaField( 'items.itemnumber' );
1634                 my $item_marc = C4::Items::GetMarcItem( $biblio->biblionumber, $in );
1635                 for my $affect ( @affects ) {
1636                     my ( $sf, $v ) = split q{=}, $affect, 2;
1637                     foreach ( $item_marc->field($itemfield) ) {
1638                         $_->update( $sf => $v );
1639                     }
1640                 }
1641                 C4::Items::ModItemFromMarc( $item_marc, $biblio->biblionumber, $in );
1642             }
1643         }
1644     }
1645
1646     return $parent_ordernumber;
1647 }
1648
1649 sub _cancel_items_receipt {
1650     my ( $order, $parent_ordernumber ) = @_;
1651     $parent_ordernumber ||= $order->ordernumber;
1652
1653     my $items = $order->items;
1654     if ( $order->basket->effective_create_items eq 'receiving' ) {
1655         # Remove items that were created at receipt
1656         my $query = qq{
1657             DELETE FROM items, aqorders_items
1658             USING items, aqorders_items
1659             WHERE items.itemnumber = ? AND aqorders_items.itemnumber = ?
1660         };
1661         my $dbh = C4::Context->dbh;
1662         my $sth = $dbh->prepare($query);
1663         while ( my $item = $items->next ) {
1664             $sth->execute($item->itemnumber, $item->itemnumber);
1665         }
1666     } else {
1667         # Update items
1668         while ( my $item = $items->next ) {
1669             ModItemOrder($item->itemnumber, $parent_ordernumber);
1670         }
1671     }
1672 }
1673
1674 #------------------------------------------------------------#
1675
1676 =head3 SearchOrders
1677
1678 @results = &SearchOrders({
1679     ordernumber => $ordernumber,
1680     search => $search,
1681     ean => $ean,
1682     booksellerid => $booksellerid,
1683     basketno => $basketno,
1684     basketname => $basketname,
1685     basketgroupname => $basketgroupname,
1686     owner => $owner,
1687     pending => $pending
1688     ordered => $ordered
1689     biblionumber => $biblionumber,
1690     budget_id => $budget_id
1691 });
1692
1693 Searches for orders filtered by criteria.
1694
1695 C<$ordernumber> Finds matching orders or transferred orders by ordernumber.
1696 C<$search> Finds orders matching %$search% in title, author, or isbn.
1697 C<$owner> Finds order for the logged in user.
1698 C<$pending> Finds pending orders. Ignores completed and cancelled orders.
1699 C<$ordered> Finds orders to receive only (status 'ordered' or 'partial').
1700
1701
1702 C<@results> is an array of references-to-hash with the keys are fields
1703 from aqorders, biblio, biblioitems and aqbasket tables.
1704
1705 =cut
1706
1707 sub SearchOrders {
1708     my ( $params ) = @_;
1709     my $ordernumber = $params->{ordernumber};
1710     my $search = $params->{search};
1711     my $ean = $params->{ean};
1712     my $booksellerid = $params->{booksellerid};
1713     my $basketno = $params->{basketno};
1714     my $basketname = $params->{basketname};
1715     my $basketgroupname = $params->{basketgroupname};
1716     my $owner = $params->{owner};
1717     my $pending = $params->{pending};
1718     my $ordered = $params->{ordered};
1719     my $biblionumber = $params->{biblionumber};
1720     my $budget_id = $params->{budget_id};
1721
1722     my $dbh = C4::Context->dbh;
1723     my @args = ();
1724     my $query = q{
1725         SELECT aqbasket.basketno,
1726                borrowers.surname,
1727                borrowers.firstname,
1728                biblio.*,
1729                biblioitems.isbn,
1730                biblioitems.biblioitemnumber,
1731                biblioitems.publishercode,
1732                biblioitems.publicationyear,
1733                aqbasket.authorisedby,
1734                aqbasket.booksellerid,
1735                aqbasket.closedate,
1736                aqbasket.creationdate,
1737                aqbasket.basketname,
1738                aqbasketgroups.id as basketgroupid,
1739                aqbasketgroups.name as basketgroupname,
1740                aqorders.*
1741         FROM aqorders
1742             LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1743             LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
1744             LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1745             LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1746             LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1747     };
1748
1749     # If we search on ordernumber, we retrieve the transferred order if a transfer has been done.
1750     $query .= q{
1751             LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber
1752     } if $ordernumber;
1753
1754     $query .= q{
1755         WHERE (datecancellationprinted is NULL)
1756     };
1757
1758     if ( $pending or $ordered ) {
1759         $query .= q{
1760             AND (
1761                 ( aqbasket.is_standing AND aqorders.orderstatus IN ( "new", "ordered", "partial" ) )
1762                 OR (
1763                     ( quantity > quantityreceived OR quantityreceived is NULL )
1764         };
1765
1766         if ( $ordered ) {
1767             $query .= q{ AND aqorders.orderstatus IN ( "ordered", "partial" )};
1768         }
1769         $query .= q{
1770                 )
1771             )
1772         };
1773     }
1774
1775     my $userenv = C4::Context->userenv;
1776     if ( C4::Context->preference("IndependentBranches") ) {
1777         unless ( C4::Context->IsSuperLibrarian() ) {
1778             $query .= q{
1779                 AND (
1780                     borrowers.branchcode = ?
1781                     OR borrowers.branchcode  = ''
1782                 )
1783             };
1784             push @args, $userenv->{branch};
1785         }
1786     }
1787
1788     if ( $ordernumber ) {
1789         $query .= ' AND ( aqorders.ordernumber = ? OR aqorders_transfers.ordernumber_from = ? ) ';
1790         push @args, ( $ordernumber, $ordernumber );
1791     }
1792     if ( $biblionumber ) {
1793         $query .= 'AND aqorders.biblionumber = ?';
1794         push @args, $biblionumber;
1795     }
1796     if( $search ) {
1797         $query .= ' AND (biblio.title LIKE ? OR biblio.author LIKE ? OR biblioitems.isbn LIKE ?)';
1798         push @args, ("%$search%","%$search%","%$search%");
1799     }
1800     if ( $ean ) {
1801         $query .= ' AND biblioitems.ean = ?';
1802         push @args, $ean;
1803     }
1804     if ( $booksellerid ) {
1805         $query .= 'AND aqbasket.booksellerid = ?';
1806         push @args, $booksellerid;
1807     }
1808     if( $basketno ) {
1809         $query .= 'AND aqbasket.basketno = ?';
1810         push @args, $basketno;
1811     }
1812     if( $basketname ) {
1813         $query .= 'AND aqbasket.basketname LIKE ?';
1814         push @args, "%$basketname%";
1815     }
1816     if( $basketgroupname ) {
1817         $query .= ' AND aqbasketgroups.name LIKE ?';
1818         push @args, "%$basketgroupname%";
1819     }
1820
1821     if ( $owner ) {
1822         $query .= ' AND aqbasket.authorisedby=? ';
1823         push @args, $userenv->{'number'};
1824     }
1825
1826     if ( $budget_id ) {
1827         $query .= ' AND aqorders.budget_id = ?';
1828         push @args, $budget_id;
1829     }
1830
1831     $query .= ' ORDER BY aqbasket.basketno';
1832
1833     my $sth = $dbh->prepare($query);
1834     $sth->execute(@args);
1835     return $sth->fetchall_arrayref({});
1836 }
1837
1838 #------------------------------------------------------------#
1839
1840 =head3 TransferOrder
1841
1842     my $newordernumber = TransferOrder($ordernumber, $basketno);
1843
1844 Transfer an order line to a basket.
1845 Mark $ordernumber as cancelled with an internal note 'Cancelled and transferred
1846 to BOOKSELLER on DATE' and create new order with internal note
1847 'Transferred from BOOKSELLER on DATE'.
1848 Move all attached items to the new order.
1849 Received orders cannot be transferred.
1850 Return the ordernumber of created order.
1851
1852 =cut
1853
1854 sub TransferOrder {
1855     my ($ordernumber, $basketno) = @_;
1856
1857     return unless ($ordernumber and $basketno);
1858
1859     my $order = Koha::Acquisition::Orders->find( $ordernumber ) or return;
1860     return if $order->datereceived;
1861
1862     $order = $order->unblessed;
1863
1864     my $basket = GetBasket($basketno);
1865     return unless $basket;
1866
1867     my $dbh = C4::Context->dbh;
1868     my ($query, $sth, $rv);
1869
1870     $query = q{
1871         UPDATE aqorders
1872         SET datecancellationprinted = CAST(NOW() AS date), orderstatus = ?
1873         WHERE ordernumber = ?
1874     };
1875     $sth = $dbh->prepare($query);
1876     $rv = $sth->execute('cancelled', $ordernumber);
1877
1878     delete $order->{'ordernumber'};
1879     delete $order->{parent_ordernumber};
1880     $order->{'basketno'} = $basketno;
1881
1882     my $newordernumber = Koha::Acquisition::Order->new($order)->store->ordernumber;
1883
1884     $query = q{
1885         UPDATE aqorders_items
1886         SET ordernumber = ?
1887         WHERE ordernumber = ?
1888     };
1889     $sth = $dbh->prepare($query);
1890     $sth->execute($newordernumber, $ordernumber);
1891
1892     $query = q{
1893         INSERT INTO aqorders_transfers (ordernumber_from, ordernumber_to)
1894         VALUES (?, ?)
1895     };
1896     $sth = $dbh->prepare($query);
1897     $sth->execute($ordernumber, $newordernumber);
1898
1899     return $newordernumber;
1900 }
1901
1902 =head3 get_rounding_sql
1903
1904     $rounding_sql = get_rounding_sql($column_name);
1905
1906 returns the correct SQL routine based on OrderPriceRounding system preference.
1907
1908 =cut
1909
1910 sub get_rounding_sql {
1911     my ( $round_string ) = @_;
1912     my $rounding_pref = C4::Context->preference('OrderPriceRounding') // q{};
1913     if ( $rounding_pref eq "nearest_cent"  ) {
1914         return "CAST($round_string*100 AS SIGNED)/100";
1915     }
1916     return $round_string;
1917 }
1918
1919 =head3 get_rounded_price
1920
1921     $rounded_price = get_rounded_price( $price );
1922
1923 returns a price rounded as specified in OrderPriceRounding system preference.
1924
1925 =cut
1926
1927 sub get_rounded_price {
1928     my ( $price ) =  @_;
1929     my $rounding_pref = C4::Context->preference('OrderPriceRounding') // q{};
1930     if( $rounding_pref eq 'nearest_cent' ) {
1931         return Koha::Number::Price->new( $price )->round();
1932     }
1933     return $price;
1934 }
1935
1936
1937 =head2 FUNCTIONS ABOUT PARCELS
1938
1939 =head3 GetParcels
1940
1941   $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1942
1943 get a lists of parcels.
1944
1945 * Input arg :
1946
1947 =over
1948
1949 =item $bookseller
1950 is the bookseller this function has to get parcels.
1951
1952 =item $order
1953 To know on what criteria the results list has to be ordered.
1954
1955 =item $code
1956 is the booksellerinvoicenumber.
1957
1958 =item $datefrom & $dateto
1959 to know on what date this function has to filter its search.
1960
1961 =back
1962
1963 * return:
1964 a pointer on a hash list containing parcel informations as such :
1965
1966 =over
1967
1968 =item Creation date
1969
1970 =item Last operation
1971
1972 =item Number of biblio
1973
1974 =item Number of items
1975
1976 =back
1977
1978 =cut
1979
1980 sub GetParcels {
1981     my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
1982     my $dbh    = C4::Context->dbh;
1983     my @query_params = ();
1984     my $strsth ="
1985         SELECT  aqinvoices.invoicenumber,
1986                 datereceived,purchaseordernumber,
1987                 count(DISTINCT biblionumber) AS biblio,
1988                 sum(quantity) AS itemsexpected,
1989                 sum(quantityreceived) AS itemsreceived
1990         FROM   aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
1991         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
1992         WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
1993     ";
1994     push @query_params, $bookseller;
1995
1996     if ( defined $code ) {
1997         $strsth .= ' and aqinvoices.invoicenumber like ? ';
1998         # add a % to the end of the code to allow stemming.
1999         push @query_params, "$code%";
2000     }
2001
2002     if ( defined $datefrom ) {
2003         $strsth .= ' and datereceived >= ? ';
2004         push @query_params, $datefrom;
2005     }
2006
2007     if ( defined $dateto ) {
2008         $strsth .=  'and datereceived <= ? ';
2009         push @query_params, $dateto;
2010     }
2011
2012     $strsth .= "group by aqinvoices.invoicenumber,datereceived ";
2013
2014     # can't use a placeholder to place this column name.
2015     # but, we could probably be checking to make sure it is a column that will be fetched.
2016     $strsth .= "order by $order " if ($order);
2017
2018     my $sth = $dbh->prepare($strsth);
2019
2020     $sth->execute( @query_params );
2021     my $results = $sth->fetchall_arrayref({});
2022     return @{$results};
2023 }
2024
2025 #------------------------------------------------------------#
2026
2027 =head3 GetHistory
2028
2029   \@order_loop = GetHistory( %params );
2030
2031 Retreives some acquisition history information
2032
2033 params:
2034   title
2035   author
2036   name
2037   isbn
2038   ean
2039   from_placed_on
2040   to_placed_on
2041   basket                  - search both basket name and number
2042   booksellerinvoicenumber
2043   basketgroupname
2044   budget
2045   orderstatus (note that orderstatus '' will retrieve orders
2046                of any status except cancelled)
2047   is_standing
2048   managing_library
2049   biblionumber
2050   get_canceled_order (if set to a true value, cancelled orders will
2051                       be included)
2052
2053 returns:
2054     $order_loop is a list of hashrefs that each look like this:
2055             {
2056                 'author'           => 'Twain, Mark',
2057                 'basketno'         => '1',
2058                 'biblionumber'     => '215',
2059                 'count'            => 1,
2060                 'creationdate'     => 'MM/DD/YYYY',
2061                 'datereceived'     => undef,
2062                 'ecost'            => '1.00',
2063                 'id'               => '1',
2064                 'invoicenumber'    => undef,
2065                 'name'             => '',
2066                 'ordernumber'      => '1',
2067                 'quantity'         => 1,
2068                 'quantityreceived' => undef,
2069                 'title'            => 'The Adventures of Huckleberry Finn',
2070                 'managing_library' => 'CPL'
2071                 'is_standing'      => '1'
2072             }
2073
2074 =cut
2075
2076 sub GetHistory {
2077 # don't run the query if there are no parameters (list would be too long for sure !)
2078     croak "No search params" unless @_;
2079     my %params = @_;
2080     my $title = $params{title};
2081     my $author = $params{author};
2082     my $isbn   = $params{isbn};
2083     my $issn   = $params{issn};
2084     my $ean    = $params{ean};
2085     my $name = $params{name};
2086     my $internalnote = $params{internalnote};
2087     my $vendornote = $params{vendornote};
2088     my $from_placed_on = $params{from_placed_on};
2089     my $to_placed_on = $params{to_placed_on};
2090     my $basket = $params{basket};
2091     my $booksellerinvoicenumber = $params{booksellerinvoicenumber};
2092     my $basketgroupname = $params{basketgroupname};
2093     my $budget = $params{budget};
2094     my $orderstatus = $params{orderstatus};
2095     my $is_standing = $params{is_standing};
2096     my $biblionumber = $params{biblionumber};
2097     my $get_canceled_order = $params{get_canceled_order} || 0;
2098     my $ordernumber = $params{ordernumber};
2099     my $search_children_too = $params{search_children_too} || 0;
2100     my $created_by = $params{created_by} || [];
2101     my $managing_library = $params{managing_library};
2102     my $ordernumbers = $params{ordernumbers} || [];
2103     my $additional_fields = $params{additional_fields} // [];
2104
2105     my $total_qty         = 0;
2106     my $total_qtyreceived = 0;
2107     my $total_price       = 0;
2108
2109     #get variation of isbn
2110     my @isbn_params;
2111     my @isbns;
2112     if ($isbn){
2113         if ( C4::Context->preference("SearchWithISBNVariations") ){
2114             @isbns = C4::Koha::GetVariationsOfISBN( $isbn );
2115             foreach my $isb (@isbns){
2116                 push @isbn_params, '?';
2117             }
2118         }
2119         unless (@isbns){
2120             push @isbns, $isbn;
2121             push @isbn_params, '?';
2122         }
2123     }
2124
2125     #get variation of issn
2126     my @issn_params;
2127     my @issns;
2128     if ($issn){
2129         if ( C4::Context->preference("SearchWithISSNVariations") ){
2130             @issns = C4::Koha::GetVariationsOfISSN( $issn );
2131             push @issn_params, ('?') x @issns;
2132         }
2133         unless (@issns){
2134             push @issns, $issn;
2135             push @issn_params, '?';
2136         }
2137     }
2138
2139     my $dbh   = C4::Context->dbh;
2140     my $query ="
2141         SELECT
2142             COALESCE(biblio.title,     deletedbiblio.title)     AS title,
2143             COALESCE(biblio.author,    deletedbiblio.author)    AS author,
2144             COALESCE(biblioitems.isbn, deletedbiblioitems.isbn) AS isbn,
2145             COALESCE(biblioitems.ean,  deletedbiblioitems.ean)  AS ean,
2146             aqorders.basketno,
2147             aqbasket.basketname,
2148             aqbasket.basketgroupid,
2149             aqbasket.authorisedby,
2150             aqbasket.is_standing,
2151             concat( borrowers.firstname,' ',borrowers.surname) AS authorisedbyname,
2152             branch as managing_library,
2153             aqbasketgroups.name as groupname,
2154             aqbooksellers.name,
2155             aqbasket.creationdate,
2156             aqorders.datereceived,
2157             aqorders.quantity,
2158             aqorders.quantityreceived,
2159             aqorders.ecost,
2160             aqorders.ordernumber,
2161             aqorders.invoiceid,
2162             aqinvoices.invoicenumber,
2163             aqbooksellers.id as id,
2164             aqorders.biblionumber,
2165             aqorders.orderstatus,
2166             aqorders.parent_ordernumber,
2167             aqorders.order_internalnote,
2168             aqorders.order_vendornote,
2169             aqbudgets.budget_name
2170             ";
2171     $query .= ", aqbudgets.budget_id AS budget" if defined $budget;
2172     $query .= "
2173         FROM aqorders
2174         LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
2175         LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
2176         LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
2177         LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
2178         LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
2179         LEFT JOIN aqbudgets ON aqorders.budget_id=aqbudgets.budget_id
2180         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2181         LEFT JOIN deletedbiblio ON deletedbiblio.biblionumber=aqorders.biblionumber
2182         LEFT JOIN deletedbiblioitems ON deletedbiblioitems.biblionumber=aqorders.biblionumber
2183         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2184         ";
2185
2186     $query .= " WHERE 1 ";
2187
2188     unless ($get_canceled_order or (defined $orderstatus and $orderstatus eq 'cancelled')) {
2189         $query .= " AND datecancellationprinted IS NULL ";
2190     }
2191
2192     my @query_params  = ();
2193
2194     if ( $biblionumber ) {
2195         $query .= " AND biblio.biblionumber = ?";
2196         push @query_params, $biblionumber;
2197     }
2198
2199     if ( $title ) {
2200         $query .= " AND biblio.title LIKE ? ";
2201         $title =~ s/\s+/%/g;
2202         push @query_params, "%$title%";
2203     }
2204
2205     if ( $author ) {
2206         $query .= " AND biblio.author LIKE ? ";
2207         push @query_params, "%$author%";
2208     }
2209
2210     if ( @isbns ) {
2211         $query .= " AND ( biblioitems.isbn LIKE " . join (" OR biblioitems.isbn LIKE ", @isbn_params ) . ")";
2212         foreach my $isb (@isbns){
2213             push @query_params, "%$isb%";
2214         }
2215     }
2216
2217     if ( @issns ) {
2218         $query .= " AND ( biblioitems.issn LIKE " . join (" OR biblioitems.issn LIKE ", @issn_params ) . ")";
2219         foreach my $isn (@issns){
2220             push @query_params, "%$isn%";
2221         }
2222     }
2223
2224     if ( $ean ) {
2225         $query .= " AND biblioitems.ean = ? ";
2226         push @query_params, "$ean";
2227     }
2228     if ( $name ) {
2229         $query .= " AND aqbooksellers.name LIKE ? ";
2230         push @query_params, "%$name%";
2231     }
2232
2233     if ( $budget ) {
2234         $query .= " AND aqbudgets.budget_id = ? ";
2235         push @query_params, "$budget";
2236     }
2237
2238     if ( $from_placed_on ) {
2239         $query .= " AND creationdate >= ? ";
2240         push @query_params, $from_placed_on;
2241     }
2242
2243     if ( $to_placed_on ) {
2244         $query .= " AND creationdate <= ? ";
2245         push @query_params, $to_placed_on;
2246     }
2247
2248     if ( defined $orderstatus and $orderstatus ne '') {
2249         $query .= " AND aqorders.orderstatus = ? ";
2250         push @query_params, "$orderstatus";
2251     }
2252
2253     if ( $is_standing ) {
2254         $query .= " AND is_standing = ? ";
2255         push @query_params, $is_standing;
2256     }
2257
2258     if ($basket) {
2259         if ($basket =~ m/^\d+$/) {
2260             $query .= " AND aqorders.basketno = ? ";
2261             push @query_params, $basket;
2262         } else {
2263             $query .= " AND aqbasket.basketname LIKE ? ";
2264             push @query_params, "%$basket%";
2265         }
2266     }
2267
2268     if ( $internalnote ) {
2269         $query .= " AND aqorders.order_internalnote LIKE ? ";
2270         push @query_params, "%$internalnote%";
2271     }
2272
2273     if ( $vendornote ) {
2274         $query .= " AND aqorders.order_vendornote LIKE ?";
2275         push @query_params, "%$vendornote%";
2276     }
2277
2278     if ($booksellerinvoicenumber) {
2279         $query .= " AND aqinvoices.invoicenumber LIKE ? ";
2280         push @query_params, "%$booksellerinvoicenumber%";
2281     }
2282
2283     if ($basketgroupname) {
2284         $query .= " AND aqbasketgroups.name LIKE ? ";
2285         push @query_params, "%$basketgroupname%";
2286     }
2287
2288     if ($ordernumber) {
2289         $query .= " AND (aqorders.ordernumber = ? ";
2290         push @query_params, $ordernumber;
2291         if ($search_children_too) {
2292             $query .= " OR aqorders.parent_ordernumber = ? ";
2293             push @query_params, $ordernumber;
2294         }
2295         $query .= ") ";
2296     }
2297
2298     if ( @$created_by ) {
2299         $query .= ' AND aqbasket.authorisedby IN ( ' . join( ',', ('?') x @$created_by ) . ')';
2300         push @query_params, @$created_by;
2301     }
2302
2303     if ( $managing_library ) {
2304         $query .= " AND aqbasket.branch = ? ";
2305         push @query_params, $managing_library;
2306     }
2307
2308     if ( @$ordernumbers ) {
2309         $query .= ' AND (aqorders.ordernumber IN ( ' . join (',', ('?') x @$ordernumbers ) . '))';
2310         push @query_params, @$ordernumbers;
2311     }
2312     if ( @$additional_fields ) {
2313         my @baskets = Koha::Acquisition::Baskets->filter_by_additional_fields($additional_fields)->as_list;
2314
2315         return [] unless @baskets;
2316
2317         # No parameterization because record IDs come directly from DB
2318         $query .= ' AND aqbasket.basketno IN ( ' . join( ',', map { $_->basketno } @baskets ) . ' )';
2319     }
2320
2321     if ( C4::Context->preference("IndependentBranches") ) {
2322         unless ( C4::Context->IsSuperLibrarian() ) {
2323             $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
2324             push @query_params, C4::Context->userenv->{branch};
2325         }
2326     }
2327     $query .= " ORDER BY id";
2328
2329     return $dbh->selectall_arrayref( $query, { Slice => {} }, @query_params );
2330 }
2331
2332 =head2 GetRecentAcqui
2333
2334   $results = GetRecentAcqui($days);
2335
2336 C<$results> is a ref to a table which contains hashref
2337
2338 =cut
2339
2340 sub GetRecentAcqui {
2341     my $limit  = shift;
2342     my $dbh    = C4::Context->dbh;
2343     my $query = "
2344         SELECT *
2345         FROM   biblio
2346         ORDER BY timestamp DESC
2347         LIMIT  0,".$limit;
2348
2349     my $sth = $dbh->prepare($query);
2350     $sth->execute;
2351     my $results = $sth->fetchall_arrayref({});
2352     return $results;
2353 }
2354
2355 #------------------------------------------------------------#
2356
2357 =head3 AddClaim
2358
2359   &AddClaim($ordernumber);
2360
2361 Add a claim for an order
2362
2363 =cut
2364
2365 sub AddClaim {
2366     my ($ordernumber) = @_;
2367     my $dbh          = C4::Context->dbh;
2368     my $query        = "
2369         UPDATE aqorders SET
2370             claims_count = claims_count + 1,
2371             claimed_date = CURDATE()
2372         WHERE ordernumber = ?
2373         ";
2374     my $sth = $dbh->prepare($query);
2375     $sth->execute($ordernumber);
2376 }
2377
2378 =head3 GetInvoices
2379
2380     my @invoices = GetInvoices(
2381         invoicenumber => $invoicenumber,
2382         supplierid => $supplierid,
2383         suppliername => $suppliername,
2384         shipmentdatefrom => $shipmentdatefrom, # ISO format
2385         shipmentdateto => $shipmentdateto, # ISO format
2386         billingdatefrom => $billingdatefrom, # ISO format
2387         billingdateto => $billingdateto, # ISO format
2388         isbneanissn => $isbn_or_ean_or_issn,
2389         title => $title,
2390         author => $author,
2391         publisher => $publisher,
2392         publicationyear => $publicationyear,
2393         branchcode => $branchcode,
2394         order_by => $order_by
2395     );
2396
2397 Return a list of invoices that match all given criteria.
2398
2399 $order_by is "column_name (asc|desc)", where column_name is any of
2400 'invoicenumber', 'booksellerid', 'shipmentdate', 'billingdate', 'closedate',
2401 'shipmentcost', 'shipmentcost_budgetid'.
2402
2403 asc is the default if omitted
2404
2405 =cut
2406
2407 sub GetInvoices {
2408     my %args = @_;
2409
2410     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2411         closedate shipmentcost shipmentcost_budgetid);
2412
2413     my $dbh = C4::Context->dbh;
2414     my $query = qq{
2415         SELECT aqinvoices.invoiceid, aqinvoices.invoicenumber, aqinvoices.booksellerid, aqinvoices.shipmentdate, aqinvoices.billingdate, aqinvoices.closedate, aqinvoices.shipmentcost, aqinvoices.shipmentcost_budgetid, aqinvoices.message_id,
2416             aqbooksellers.name AS suppliername,
2417           COUNT(
2418             DISTINCT IF(
2419               aqorders.datereceived IS NOT NULL,
2420               aqorders.biblionumber,
2421               NULL
2422             )
2423           ) AS receivedbiblios,
2424           COUNT(
2425              DISTINCT IF(
2426               aqorders.subscriptionid IS NOT NULL,
2427               aqorders.subscriptionid,
2428               NULL
2429             )
2430           ) AS is_linked_to_subscriptions,
2431           SUM(aqorders.quantityreceived) AS receiveditems
2432         FROM aqinvoices
2433           LEFT JOIN aqbooksellers ON aqbooksellers.id = aqinvoices.booksellerid
2434           LEFT JOIN aqorders ON aqorders.invoiceid = aqinvoices.invoiceid
2435           LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
2436           LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2437           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2438           LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
2439           LEFT JOIN subscription ON biblio.biblionumber = subscription.biblionumber
2440     };
2441
2442     my @bind_args;
2443     my @bind_strs;
2444     if($args{supplierid}) {
2445         push @bind_strs, " aqinvoices.booksellerid = ? ";
2446         push @bind_args, $args{supplierid};
2447     }
2448     if($args{invoicenumber}) {
2449         push @bind_strs, " aqinvoices.invoicenumber LIKE ? ";
2450         push @bind_args, "%$args{invoicenumber}%";
2451     }
2452     if($args{suppliername}) {
2453         push @bind_strs, " aqbooksellers.name LIKE ? ";
2454         push @bind_args, "%$args{suppliername}%";
2455     }
2456     if($args{shipmentdatefrom}) {
2457         push @bind_strs, " aqinvoices.shipmentdate >= ? ";
2458         push @bind_args, $args{shipmentdatefrom};
2459     }
2460     if($args{shipmentdateto}) {
2461         push @bind_strs, " aqinvoices.shipmentdate <= ? ";
2462         push @bind_args, $args{shipmentdateto};
2463     }
2464     if($args{billingdatefrom}) {
2465         push @bind_strs, " aqinvoices.billingdate >= ? ";
2466         push @bind_args, $args{billingdatefrom};
2467     }
2468     if($args{billingdateto}) {
2469         push @bind_strs, " aqinvoices.billingdate <= ? ";
2470         push @bind_args, $args{billingdateto};
2471     }
2472     if($args{isbneanissn}) {
2473         push @bind_strs, " (biblioitems.isbn LIKE CONCAT('%', ?, '%') OR biblioitems.ean LIKE CONCAT('%', ?, '%') OR biblioitems.issn LIKE CONCAT('%', ?, '%') ) ";
2474         push @bind_args, $args{isbneanissn}, $args{isbneanissn}, $args{isbneanissn};
2475     }
2476     if($args{title}) {
2477         push @bind_strs, " biblio.title LIKE CONCAT('%', ?, '%') ";
2478         push @bind_args, $args{title};
2479     }
2480     if($args{author}) {
2481         push @bind_strs, " biblio.author LIKE CONCAT('%', ?, '%') ";
2482         push @bind_args, $args{author};
2483     }
2484     if($args{publisher}) {
2485         push @bind_strs, " biblioitems.publishercode LIKE CONCAT('%', ?, '%') ";
2486         push @bind_args, $args{publisher};
2487     }
2488     if($args{publicationyear}) {
2489         push @bind_strs, " ((biblioitems.publicationyear LIKE CONCAT('%', ?, '%')) OR (biblio.copyrightdate LIKE CONCAT('%', ?, '%'))) ";
2490         push @bind_args, $args{publicationyear}, $args{publicationyear};
2491     }
2492     if($args{branchcode}) {
2493         push @bind_strs, " borrowers.branchcode = ? ";
2494         push @bind_args, $args{branchcode};
2495     }
2496     if($args{message_id}) {
2497         push @bind_strs, " aqinvoices.message_id = ? ";
2498         push @bind_args, $args{message_id};
2499     }
2500
2501     $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2502     $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";
2503
2504     if($args{order_by}) {
2505         my ($column, $direction) = split / /, $args{order_by};
2506         if(grep  { $_ eq $column } @columns) {
2507             $direction ||= 'ASC';
2508             $query .= " ORDER BY $column $direction";
2509         }
2510     }
2511
2512     my $sth = $dbh->prepare($query);
2513     $sth->execute(@bind_args);
2514
2515     my $results = $sth->fetchall_arrayref({});
2516     return @$results;
2517 }
2518
2519 =head3 GetInvoice
2520
2521     my $invoice = GetInvoice($invoiceid);
2522
2523 Get informations about invoice with given $invoiceid
2524
2525 Return a hash filled with aqinvoices.* fields
2526
2527 =cut
2528
2529 sub GetInvoice {
2530     my ($invoiceid) = @_;
2531     my $invoice;
2532
2533     return unless $invoiceid;
2534
2535     my $dbh = C4::Context->dbh;
2536     my $query = qq{
2537         SELECT *
2538         FROM aqinvoices
2539         WHERE invoiceid = ?
2540     };
2541     my $sth = $dbh->prepare($query);
2542     $sth->execute($invoiceid);
2543
2544     $invoice = $sth->fetchrow_hashref;
2545     return $invoice;
2546 }
2547
2548 =head3 GetInvoiceDetails
2549
2550     my $invoice = GetInvoiceDetails($invoiceid)
2551
2552 Return informations about an invoice + the list of related order lines
2553
2554 Orders informations are in $invoice->{orders} (array ref)
2555
2556 =cut
2557
2558 sub GetInvoiceDetails {
2559     my ($invoiceid) = @_;
2560
2561     if ( !defined $invoiceid ) {
2562         carp 'GetInvoiceDetails called without an invoiceid';
2563         return;
2564     }
2565
2566     my $dbh = C4::Context->dbh;
2567     my $query = q{
2568         SELECT aqinvoices.*, aqbooksellers.name AS suppliername
2569         FROM aqinvoices
2570           LEFT JOIN aqbooksellers ON aqinvoices.booksellerid = aqbooksellers.id
2571         WHERE invoiceid = ?
2572     };
2573     my $sth = $dbh->prepare($query);
2574     $sth->execute($invoiceid);
2575
2576     my $invoice = $sth->fetchrow_hashref;
2577
2578     $query = q{
2579         SELECT aqorders.*,
2580                 biblio.*,
2581                 biblio.copyrightdate,
2582                 biblioitems.isbn,
2583                 biblioitems.publishercode,
2584                 biblioitems.publicationyear,
2585                 aqbasket.basketname,
2586                 aqbasketgroups.id AS basketgroupid,
2587                 aqbasketgroups.name AS basketgroupname
2588         FROM aqorders
2589           LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
2590           LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
2591           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2592           LEFT JOIN biblioitems ON aqorders.biblionumber = biblioitems.biblionumber
2593         WHERE invoiceid = ?
2594     };
2595     $sth = $dbh->prepare($query);
2596     $sth->execute($invoiceid);
2597     $invoice->{orders} = $sth->fetchall_arrayref({});
2598     $invoice->{orders} ||= []; # force an empty arrayref if fetchall_arrayref fails
2599
2600     return $invoice;
2601 }
2602
2603 =head3 AddInvoice
2604
2605     my $invoiceid = AddInvoice(
2606         invoicenumber => $invoicenumber,
2607         booksellerid => $booksellerid,
2608         shipmentdate => $shipmentdate,
2609         billingdate => $billingdate,
2610         closedate => $closedate,
2611         shipmentcost => $shipmentcost,
2612         shipmentcost_budgetid => $shipmentcost_budgetid
2613     );
2614
2615 Create a new invoice and return its id or undef if it fails.
2616
2617 =cut
2618
2619 sub AddInvoice {
2620     my %invoice = @_;
2621
2622     return unless(%invoice and $invoice{invoicenumber});
2623
2624     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2625         closedate shipmentcost shipmentcost_budgetid message_id);
2626
2627     my @set_strs;
2628     my @set_args;
2629     foreach my $key (keys %invoice) {
2630         if(0 < grep { $_ eq $key } @columns) {
2631             push @set_strs, "$key = ?";
2632             push @set_args, ($invoice{$key} || undef);
2633         }
2634     }
2635
2636     my $rv;
2637     if(@set_args > 0) {
2638         my $dbh = C4::Context->dbh;
2639         my $query = "INSERT INTO aqinvoices SET ";
2640         $query .= join (",", @set_strs);
2641         my $sth = $dbh->prepare($query);
2642         $rv = $sth->execute(@set_args);
2643         if($rv) {
2644             $rv = $dbh->last_insert_id(undef, undef, 'aqinvoices', undef);
2645         }
2646     }
2647     return $rv;
2648 }
2649
2650 =head3 ModInvoice
2651
2652     ModInvoice(
2653         invoiceid => $invoiceid,    # Mandatory
2654         invoicenumber => $invoicenumber,
2655         booksellerid => $booksellerid,
2656         shipmentdate => $shipmentdate,
2657         billingdate => $billingdate,
2658         closedate => $closedate,
2659         shipmentcost => $shipmentcost,
2660         shipmentcost_budgetid => $shipmentcost_budgetid
2661     );
2662
2663 Modify an invoice, invoiceid is mandatory.
2664
2665 Return undef if it fails.
2666
2667 =cut
2668
2669 sub ModInvoice {
2670     my %invoice = @_;
2671
2672     return unless(%invoice and $invoice{invoiceid});
2673
2674     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2675         closedate shipmentcost shipmentcost_budgetid);
2676
2677     my @set_strs;
2678     my @set_args;
2679     foreach my $key (keys %invoice) {
2680         if(0 < grep { $_ eq $key } @columns) {
2681             push @set_strs, "$key = ?";
2682             push @set_args, ($invoice{$key} || undef);
2683         }
2684     }
2685
2686     my $dbh = C4::Context->dbh;
2687     my $query = "UPDATE aqinvoices SET ";
2688     $query .= join(",", @set_strs);
2689     $query .= " WHERE invoiceid = ?";
2690
2691     my $sth = $dbh->prepare($query);
2692     $sth->execute(@set_args, $invoice{invoiceid});
2693 }
2694
2695 =head3 CloseInvoice
2696
2697     CloseInvoice($invoiceid);
2698
2699 Close an invoice.
2700
2701 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => undef);
2702
2703 =cut
2704
2705 sub CloseInvoice {
2706     my ($invoiceid) = @_;
2707
2708     return unless $invoiceid;
2709
2710     my $dbh = C4::Context->dbh;
2711     my $query = qq{
2712         UPDATE aqinvoices
2713         SET closedate = CAST(NOW() AS DATE)
2714         WHERE invoiceid = ?
2715     };
2716     my $sth = $dbh->prepare($query);
2717     $sth->execute($invoiceid);
2718 }
2719
2720 =head3 ReopenInvoice
2721
2722     ReopenInvoice($invoiceid);
2723
2724 Reopen an invoice
2725
2726 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => $closedate );
2727
2728 =cut
2729
2730 sub ReopenInvoice {
2731     my ($invoiceid) = @_;
2732
2733     return unless $invoiceid;
2734
2735     my $dbh = C4::Context->dbh;
2736     my $query = qq{
2737         UPDATE aqinvoices
2738         SET closedate = NULL
2739         WHERE invoiceid = ?
2740     };
2741     my $sth = $dbh->prepare($query);
2742     $sth->execute($invoiceid);
2743 }
2744
2745 =head3 DelInvoice
2746
2747     DelInvoice($invoiceid);
2748
2749 Delete an invoice if there are no items attached to it.
2750
2751 =cut
2752
2753 sub DelInvoice {
2754     my ($invoiceid) = @_;
2755
2756     return unless $invoiceid;
2757
2758     my $dbh   = C4::Context->dbh;
2759     my $query = qq{
2760         SELECT COUNT(*)
2761         FROM aqorders
2762         WHERE invoiceid = ?
2763     };
2764     my $sth = $dbh->prepare($query);
2765     $sth->execute($invoiceid);
2766     my $res = $sth->fetchrow_arrayref;
2767     if ( $res && $res->[0] == 0 ) {
2768         $query = qq{
2769             DELETE FROM aqinvoices
2770             WHERE invoiceid = ?
2771         };
2772         my $sth = $dbh->prepare($query);
2773         return ( $sth->execute($invoiceid) > 0 );
2774     }
2775     return;
2776 }
2777
2778 =head3 MergeInvoices
2779
2780     MergeInvoices($invoiceid, \@sourceids);
2781
2782 Merge the invoices identified by the IDs in \@sourceids into
2783 the invoice identified by $invoiceid.
2784
2785 =cut
2786
2787 sub MergeInvoices {
2788     my ($invoiceid, $sourceids) = @_;
2789
2790     return unless $invoiceid;
2791     foreach my $sourceid (@$sourceids) {
2792         next if $sourceid == $invoiceid;
2793         my $source = GetInvoiceDetails($sourceid);
2794         foreach my $order (@{$source->{'orders'}}) {
2795             $order->{'invoiceid'} = $invoiceid;
2796             ModOrder($order);
2797         }
2798         DelInvoice($source->{'invoiceid'});
2799     }
2800     return;
2801 }
2802
2803 =head3 GetBiblioCountByBasketno
2804
2805 $biblio_count = &GetBiblioCountByBasketno($basketno);
2806
2807 Looks up the biblio's count that has basketno value $basketno
2808
2809 Returns a quantity
2810
2811 =cut
2812
2813 sub GetBiblioCountByBasketno {
2814     my ($basketno) = @_;
2815     my $dbh          = C4::Context->dbh;
2816     my $query        = "
2817         SELECT COUNT( DISTINCT( biblionumber ) )
2818         FROM   aqorders
2819         WHERE  basketno = ?
2820             AND datecancellationprinted IS NULL
2821         ";
2822
2823     my $sth = $dbh->prepare($query);
2824     $sth->execute($basketno);
2825     return $sth->fetchrow;
2826 }
2827
2828 =head3 populate_order_with_prices
2829
2830 $order = populate_order_with_prices({
2831     order        => $order #a hashref with the order values
2832     booksellerid => $booksellerid #FIXME - should obtain from order basket
2833     receiving    => 1 # boolean representing order stage, should pass only this or ordering
2834     ordering     => 1 # boolean representing order stage
2835 });
2836
2837
2838 Sets calculated values for an order - all values are stored with full precision
2839 regardless of rounding preference except for tax value which is calculated
2840 on rounded values if requested
2841
2842 For ordering the values set are:
2843     rrp_tax_included
2844     rrp_tax_excluded
2845     ecost_tax_included
2846     ecost_tax_excluded
2847     tax_value_on_ordering
2848 For receiving the value set are:
2849     unitprice_tax_included
2850     unitprice_tax_excluded
2851     tax_value_on_receiving
2852
2853 Note: When receiving, if the rounded value of the unitprice matches the rounded
2854 value of the ecost then then ecost (full precision) is used.
2855
2856 Returns a hashref of the order
2857
2858 FIXME: Move this to Koha::Acquisition::Order.pm
2859
2860 =cut
2861
2862 sub populate_order_with_prices {
2863     my ($params) = @_;
2864
2865     my $order        = $params->{order};
2866     my $booksellerid = $params->{booksellerid};
2867     return unless $booksellerid;
2868
2869     my $bookseller = Koha::Acquisition::Booksellers->find( $booksellerid );
2870
2871     my $receiving = $params->{receiving};
2872     my $ordering  = $params->{ordering};
2873     my $discount  = $order->{discount};
2874     $discount /= 100 if $discount > 1;
2875
2876     if ($ordering) {
2877         $order->{tax_rate_on_ordering} //= $order->{tax_rate};
2878         if ( $bookseller->listincgst ) {
2879
2880             # The user entered the prices tax included
2881             $order->{unitprice} += 0;
2882             $order->{unitprice_tax_included} = $order->{unitprice};
2883             $order->{rrp_tax_included} = $order->{rrp};
2884
2885             # price tax excluded = price tax included / ( 1 + tax rate )
2886             $order->{unitprice_tax_excluded} = $order->{unitprice_tax_included} / ( 1 + $order->{tax_rate_on_ordering} );
2887             $order->{rrp_tax_excluded} = $order->{rrp_tax_included} / ( 1 + $order->{tax_rate_on_ordering} );
2888
2889             # ecost tax included = rrp tax included  ( 1 - discount )
2890             $order->{ecost_tax_included} = $order->{rrp_tax_included} * ( 1 - $discount );
2891
2892             # ecost tax excluded = rrp tax excluded * ( 1 - discount )
2893             $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount );
2894
2895             # tax value = quantity * ecost tax excluded * tax rate
2896             # we should use the unitprice if included
2897             my $cost_tax_included = $order->{unitprice_tax_included} == 0 ? $order->{ecost_tax_included} : $order->{unitprice_tax_included};
2898             my $cost_tax_excluded = $order->{unitprice_tax_excluded} == 0 ? $order->{ecost_tax_excluded} : $order->{unitprice_tax_excluded};
2899             $order->{tax_value_on_ordering} = ( get_rounded_price($cost_tax_included) - get_rounded_price($cost_tax_excluded) ) * $order->{quantity};
2900
2901         }
2902         else {
2903             # The user entered the prices tax excluded
2904             $order->{unitprice_tax_excluded} = $order->{unitprice};
2905             $order->{rrp_tax_excluded} = $order->{rrp};
2906
2907             # price tax included = price tax excluded * ( 1 - tax rate )
2908             $order->{unitprice_tax_included} = $order->{unitprice_tax_excluded} * ( 1 + $order->{tax_rate_on_ordering} );
2909             $order->{rrp_tax_included} = $order->{rrp_tax_excluded} * ( 1 + $order->{tax_rate_on_ordering} );
2910
2911             # ecost tax excluded = rrp tax excluded * ( 1 - discount )
2912             $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount );
2913
2914             # ecost tax included = rrp tax excluded * ( 1 + tax rate ) * ( 1 - discount ) = ecost tax excluded * ( 1 + tax rate )
2915             $order->{ecost_tax_included} = $order->{ecost_tax_excluded} * ( 1 + $order->{tax_rate_on_ordering} );
2916
2917             # tax value = quantity * ecost tax included * tax rate
2918             # we should use the unitprice if included
2919             my $cost_tax_excluded = $order->{unitprice_tax_excluded} == 0 ?  $order->{ecost_tax_excluded} : $order->{unitprice_tax_excluded};
2920             $order->{tax_value_on_ordering} = $order->{quantity} * get_rounded_price($cost_tax_excluded) * $order->{tax_rate_on_ordering};
2921         }
2922     }
2923
2924     if ($receiving) {
2925         $order->{tax_rate_on_receiving} //= $order->{tax_rate};
2926         if ( $bookseller->invoiceincgst ) {
2927             # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
2928             # we need to keep the exact ecost value
2929             if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_included} )->round ) {
2930                 $order->{unitprice} = $order->{ecost_tax_included};
2931             }
2932
2933             # The user entered the unit price tax included
2934             $order->{unitprice_tax_included} = $order->{unitprice};
2935
2936             # unit price tax excluded = unit price tax included / ( 1 + tax rate )
2937             $order->{unitprice_tax_excluded} = $order->{unitprice_tax_included} / ( 1 + $order->{tax_rate_on_receiving} );
2938         }
2939         else {
2940             # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
2941             # we need to keep the exact ecost value
2942             if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_excluded} )->round ) {
2943                 $order->{unitprice} = $order->{ecost_tax_excluded};
2944             }
2945
2946             # The user entered the unit price tax excluded
2947             $order->{unitprice_tax_excluded} = $order->{unitprice};
2948
2949
2950             # unit price tax included = unit price tax included * ( 1 + tax rate )
2951             $order->{unitprice_tax_included} = $order->{unitprice_tax_excluded} * ( 1 + $order->{tax_rate_on_receiving} );
2952         }
2953
2954         # tax value = quantity * unit price tax excluded * tax rate
2955         $order->{tax_value_on_receiving} = $order->{quantity} * get_rounded_price($order->{unitprice_tax_excluded}) * $order->{tax_rate_on_receiving};
2956     }
2957
2958     return $order;
2959 }
2960
2961 =head3 GetOrderUsers
2962
2963     $order_users_ids = &GetOrderUsers($ordernumber);
2964
2965 Returns a list of all borrowernumbers that are in order users list
2966
2967 =cut
2968
2969 sub GetOrderUsers {
2970     my ($ordernumber) = @_;
2971
2972     return unless $ordernumber;
2973
2974     my $query = q|
2975         SELECT borrowernumber
2976         FROM aqorder_users
2977         WHERE ordernumber = ?
2978     |;
2979     my $dbh = C4::Context->dbh;
2980     my $sth = $dbh->prepare($query);
2981     $sth->execute($ordernumber);
2982     my $results = $sth->fetchall_arrayref( {} );
2983
2984     my @borrowernumbers;
2985     foreach (@$results) {
2986         push @borrowernumbers, $_->{'borrowernumber'};
2987     }
2988
2989     return @borrowernumbers;
2990 }
2991
2992 =head3 ModOrderUsers
2993
2994     my @order_users_ids = (1, 2, 3);
2995     &ModOrderUsers($ordernumber, @basketusers_ids);
2996
2997 Delete all users from order users list, and add users in C<@order_users_ids>
2998 to this users list.
2999
3000 =cut
3001
3002 sub ModOrderUsers {
3003     my ( $ordernumber, @order_users_ids ) = @_;
3004
3005     return unless $ordernumber;
3006
3007     my $dbh   = C4::Context->dbh;
3008     my $query = q|
3009         DELETE FROM aqorder_users
3010         WHERE ordernumber = ?
3011     |;
3012     my $sth = $dbh->prepare($query);
3013     $sth->execute($ordernumber);
3014
3015     $query = q|
3016         INSERT INTO aqorder_users (ordernumber, borrowernumber)
3017         VALUES (?, ?)
3018     |;
3019     $sth = $dbh->prepare($query);
3020     foreach my $order_user_id (@order_users_ids) {
3021         $sth->execute( $ordernumber, $order_user_id );
3022     }
3023 }
3024
3025 sub NotifyOrderUsers {
3026     my ($ordernumber) = @_;
3027
3028     my @borrowernumbers = GetOrderUsers($ordernumber);
3029     return unless @borrowernumbers;
3030
3031     my $order = GetOrder( $ordernumber );
3032     for my $borrowernumber (@borrowernumbers) {
3033         my $patron = Koha::Patrons->find( $borrowernumber );
3034         my $library = $patron->library->unblessed;
3035         my $biblio = Koha::Biblios->find( $order->{biblionumber} )->unblessed;
3036         my $letter = C4::Letters::GetPreparedLetter(
3037             module      => 'acquisition',
3038             letter_code => 'ACQ_NOTIF_ON_RECEIV',
3039             branchcode  => $library->{branchcode},
3040             lang        => $patron->lang,
3041             tables      => {
3042                 'branches'    => $library,
3043                 'borrowers'   => $patron->unblessed,
3044                 'biblio'      => $biblio,
3045                 'aqorders'    => $order,
3046             },
3047         );
3048         if ( $letter ) {
3049             C4::Letters::EnqueueLetter(
3050                 {
3051                     letter         => $letter,
3052                     borrowernumber => $borrowernumber,
3053                     LibraryName    => C4::Context->preference("LibraryName"),
3054                     message_transport_type => 'email',
3055                 }
3056             ) or warn "can't enqueue letter $letter";
3057         }
3058     }
3059 }
3060
3061 =head3 FillWithDefaultValues
3062
3063 FillWithDefaultValues( $marc_record, $params );
3064
3065 This will update the record with default value defined in the ACQ framework.
3066 For all existing fields, if a default value exists and there are no subfield, it will be created.
3067 If the field does not exist, it will be created too.
3068
3069 If the parameter only_mandatory => 1 is passed via $params, only the mandatory
3070 defaults are being applied to the record.
3071
3072 =cut
3073
3074 sub FillWithDefaultValues {
3075     my ( $record, $params ) = @_;
3076     my $mandatory = $params->{only_mandatory};
3077     my $tagslib = C4::Biblio::GetMarcStructure( 1, 'ACQ', { unsafe => 1 } );
3078     if ($tagslib) {
3079         my ($itemfield) =
3080           C4::Biblio::GetMarcFromKohaField( 'items.itemnumber' );
3081         for my $tag ( sort keys %$tagslib ) {
3082             next unless $tag;
3083             next if $tag == $itemfield;
3084             for my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
3085                 next if IsMarcStructureInternal($tagslib->{$tag}{$subfield});
3086                 next if $mandatory && !$tagslib->{$tag}{$subfield}{mandatory};
3087                 my $defaultvalue = $tagslib->{$tag}{$subfield}{defaultvalue};
3088                 if ( defined $defaultvalue and $defaultvalue ne '' ) {
3089                     my @fields = $record->field($tag);
3090                     if (@fields) {
3091                         for my $field (@fields) {
3092                             if ( $field->is_control_field ) {
3093                                 $field->update($defaultvalue) if not defined $field->data;
3094                             }
3095                             elsif ( not defined $field->subfield($subfield) ) {
3096                                 $field->add_subfields(
3097                                     $subfield => $defaultvalue );
3098                             }
3099                         }
3100                     }
3101                     else {
3102                         if ( $tag < 10 ) { # is_control_field
3103                             $record->insert_fields_ordered(
3104                                 MARC::Field->new(
3105                                     $tag, $defaultvalue
3106                                 )
3107                             );
3108                         }
3109                         else {
3110                             $record->insert_fields_ordered(
3111                                 MARC::Field->new(
3112                                     $tag, '', '', $subfield => $defaultvalue
3113                                 )
3114                             );
3115                         }
3116                     }
3117                 }
3118             }
3119         }
3120     }
3121 }
3122
3123 1;
3124 __END__
3125
3126 =head1 AUTHOR
3127
3128 Koha Development Team <http://koha-community.org/>
3129
3130 =cut