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