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