C4/Acquisition.pm

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