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