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