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