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